[Chicken-hackers] [PATCH] Avoid invalid specializations for multi-valued foreign-primitives

[Evan Hanson]

The foreign-primitive form may return multiple values with the C_values
function, but its expansion is always declared to return a (single)
undefined value. This triggers invalid ##sys#c-w-v specializations for
single-valued producers where multiple values may in fact result.

This fixes that declaration so that multiple values are expected when no
return type is specified.
---
 chicken-ffi-syntax.scm            |    6 ++++--
 manual/Accessing external objects |   14 +++++++-------
 tests/specialization-test-1.scm   |    9 +++++++++
 3 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/chicken-ffi-syntax.scm b/chicken-ffi-syntax.scm
index d07764f..d48b0f9 100644
--- a/chicken-ffi-syntax.scm
+++ b/chicken-ffi-syntax.scm
@@ -211,12 +211,14 @@
   (lambda (form r c)
     (##sys#check-syntax 'foreign-primitive form '(_ _ . _))
     (let* ((hasrtype (and (pair? (cddr form)) (not (string? (caddr form)))))
-          (rtype (or (and hasrtype (##sys#strip-syntax (cadr form))) 'void))
+          (rtype (and hasrtype (##sys#strip-syntax (cadr form))))
           (args (##sys#strip-syntax (if hasrtype (caddr form) (cadr form))))
           (argtypes (map car args)))
       `(##core#the (procedure
                    ,(map (cut ##compiler#foreign-type->scrutiny-type <> 'arg) 
argtypes)
-                   ,(##compiler#foreign-type->scrutiny-type rtype 'result))
+                   ,@(if (not rtype)
+                         '* ; special case for C_values(...)
+                         (list (##compiler#foreign-type->scrutiny-type rtype 
'result))))
                   #f
                   (##core#foreign-primitive ,@(cdr form)))))))
 
diff --git a/manual/Accessing external objects b/manual/Accessing external 
objects
index 2fcec62..2310702 100644
--- a/manual/Accessing external objects 
+++ b/manual/Accessing external objects 
@@ -167,13 +167,13 @@ function to call Scheme functions and allocate Scheme 
data-objects. See [[Callba
 
 <macro>(foreign-primitive [RETURNTYPE] ((ARGTYPE VARIABLE) ...) STRING 
...)</macro>
 
-This is also similar to {{foreign-lambda*}} but the code will be executed
-in a ''primitive'' CPS context, which means it will not actually return, but
-call its continuation on exit. This means that code inside this form may
-allocate Scheme data on the C stack (the ''nursery'') with {{C_alloc}}
-(see below). If the {{RETURNTYPE}} is omitted it defaults to {{void}}.
-You can return multiple values inside the body of the {{foreign-primitive}}
-form by calling this C function:
+This is also similar to {{foreign-lambda*}} but the code will be
+executed in a ''primitive'' CPS context, which means it will not
+actually return, but call its continuation on exit. This means that code
+inside this form may allocate Scheme data on the C stack (the
+''nursery'') with {{C_alloc}} (see below). You can return multiple
+values inside the body of the {{foreign-primitive}} form by calling this
+C function:
 
 <enscript highlight=scheme>
 C_values(N + 2, C_SCHEME_UNDEFINED, C_k, X1, ...)
diff --git a/tests/specialization-test-1.scm b/tests/specialization-test-1.scm
index 37e8d6b..344e445 100644
--- a/tests/specialization-test-1.scm
+++ b/tests/specialization-test-1.scm
@@ -46,5 +46,14 @@ return n;}
 
 (assert (null? (the (or undefined *) (list))))
 
+;; Ensure a foreign-primitive returning multiple values with C_values()
+;; isn't specialized to a single result.
+(let ((result (receive ((foreign-primitive ()
+                         "C_values(4,"
+                         "         C_SCHEME_UNDEFINED,"
+                         "         C_k,"
+                         "         C_fix(1),"
+                         "         C_fix(2));")))))
+  (assert (equal? '(1 2) result)))
 
 )
-- 
1.7.10.4