gistfile1.txt

diff --git a/ChangeLog b/ChangeLog
index 6487bf4..ab6422d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2012-03-10  Shiro Kawai  <[email protected]>
+
+	* src/vm.c (Scm_VMCallCC, throw_continuation): Be a bit clever to
+	  extract arity of the captured continuation if possible.  The info
+	  may be lost by valid program transformation (e.g.
+	  (receive (a b) (let/cc k (print (arity k)) (values 1 2)) (cons a b))
+	  would print 2, but
+	  (receive xs (let/cc k (print (arity k)) (values 1 2)) (apply cons x))
+	  and
+	  (call-with-values (^() (let/cc k (print (arity k)) (values 1 2)))
+	                    cons)
+          would print #<arity-at-least 0>, so this info can't be used reliably
+	  to change program behavior, but may be useful for diagnostics.
+
 2012-03-09  Shiro Kawai  <[email protected]>
 
 	* lib/gauche/portutil.scm (port-map, port-fold): Guarantee to call
diff --git a/src/builtin-syms.scm b/src/builtin-syms.scm
index 1e43ff2..9a282be 100644
--- a/src/builtin-syms.scm
+++ b/src/builtin-syms.scm
@@ -143,6 +143,11 @@
     (syntax                    SCM_SYM_SYNTAX)
     (macro                     SCM_SYM_MACRO)
     (inline                    SCM_SYM_INLINE)
+    ;; The following symbols are used as the name of SUBRs created
+    ;; for (partial) continuations.  These are for information only,
+    ;; and may be changed, so the user code shouldn't count on it.
+    (continuation              SCM_SYM_CONTINUATION)
+    (partial-continuation      SCM_SYM_PARTIAL_CONTINUATION)
 
     ;; regexp
     (seq                       SCM_SYM_SEQ)
diff --git a/src/gauche/vm.h b/src/gauche/vm.h
index d1fde10..3e7019c 100644
--- a/src/gauche/vm.h
+++ b/src/gauche/vm.h
@@ -257,6 +257,11 @@ typedef struct ScmEscapePointRec {
                                    with-error-handler uses the latter model,
                                    but SRFI-34's guard needs the former model.
                                 */
+    int reqargs;                /* keeps the required # of values if this ep
+                                   represents a captured continuation. */
+    int optargs;                /* keeps the optional # of values (in the same
+                                   sense as ScmProcedure->optargs) if this ep
+                                   represents a captured continuation. */
 } ScmEscapePoint;
 
 /* Link management */
diff --git a/src/vm.c b/src/vm.c
index 4a26257..5c7657b 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -486,11 +486,12 @@ static void vm_unregister(ScmVM *vm)
     } while (0)
 
 #define CALL_CCONT(p, v, d) p(v, d)
+#define CCONTP(c)  ((c)->argp == NULL)
 
 /* pop a continuation frame, i.e. return from a procedure. */
 #define POP_CONT()                                                      \
     do {                                                                \
-        if (CONT->argp == NULL) {                                       \
+        if (CCONTP(CONT)) {                                             \
             void *data__[SCM_CCONT_DATA_SIZE];                          \
             ScmObj v__ = VAL0;                                          \
             ScmCContinuationProc *after__;                              \
@@ -2091,6 +2092,7 @@ static ScmObj with_error_handler(ScmVM *vm, ScmObj handler,
     ep->errorReporting =
         SCM_VM_RUNTIME_FLAG_IS_SET(vm, SCM_ERROR_BEING_REPORTED);
     ep->rewindBefore = rewindBefore;
+    ep->reqargs = ep->optargs = 0; /* unused, but be a good citizen. */
     
     vm->escapePoint = ep; /* This will be done in install_ehandler, but
                              make sure ep is visible from save_cont
@@ -2239,9 +2241,24 @@ static ScmObj throw_cont_cc(ScmObj result, void **data)
 static ScmObj throw_continuation(ScmObj *argframe, int nargs, void *data)
 {
     ScmEscapePoint *ep = (ScmEscapePoint*)data;
-    ScmObj args = argframe[0];
     ScmVM *vm = theVM;
     ScmObj handlers_to_call;
+    ScmObj args;
+    int n;
+
+    /* Fold the arguments.  TODO: We can get away with these consing. */
+    SCM_ASSERT(nargs == ep->reqargs + ep->optargs);
+    if (ep->optargs > 0) {
+        args = argframe[nargs-1];
+        for (n = 1; n < ep->optargs; n++) {
+            args = Scm_Cons(argframe[nargs - 1 - n], args);
+        }
+    } else {
+        args = SCM_NIL;
+    }
+    for (n = 0; n < ep->reqargs; n++) {
+        args = Scm_Cons(argframe[nargs - 1 - ep->optargs - n], args);
+    }
 
     if (ep->cstack && vm->cstack != ep->cstack) {
         ScmCStack *cs;
@@ -2279,9 +2296,26 @@ ScmObj Scm_VMCallCC(ScmObj proc)
     ep->cont = vm->cont;
     ep->handlers = vm->handlers;
     ep->cstack = vm->cstack;
-
-    contproc = Scm_MakeSubr(throw_continuation, ep, 0, 1,
-                            SCM_MAKE_STR("continuation"));
+    ep->reqargs = 0;
+    ep->optargs = 1;
+
+    /* Try to get the arity of the continuation if possible.  We do 'best
+       effort'---if we can't figure it out for sure, we just fall back to
+       the default #<arity-at-least 0>.   NB: If we see the C continuation,
+       we fall back to the default, for we don't know what C continuation
+       expects.
+    */
+    if (vm->cont && vm->cont->pc && !CCONTP(vm->cont)) {
+        ScmWord insn = *vm->cont->pc;
+        switch (SCM_VM_INSN_CODE(insn)) {
+        case SCM_VM_RECEIVE:;
+        case SCM_VM_TAIL_RECEIVE:
+            ep->reqargs = SCM_VM_INSN_ARG0(insn);
+            ep->optargs = SCM_VM_INSN_ARG1(insn);
+        }
+    }
+    contproc = Scm_MakeSubr(throw_continuation, ep, ep->reqargs, ep->optargs,
+                            SCM_SYM_CONTINUATION);
     return Scm_VMApply1(proc, contproc);
 }
 
@@ -2317,8 +2351,11 @@ ScmObj Scm_VMCallPC(ScmObj proc)
     ep->handlers = vm->handlers;
     ep->cstack = NULL; /* so that the partial continuation can be run
                           on any cstack state. */
-    contproc = Scm_MakeSubr(throw_continuation, ep, 0, 1,
-                            SCM_MAKE_STR("partial continuation"));
+    ep->reqargs = 0;   /* we might be able to do the same thing as Scm_VMCallCC
+                          to set partial cont's arity, but for now...*/
+    ep->optargs = 1;
+    contproc = Scm_MakeSubr(throw_continuation, ep, ep->reqargs, ep->optargs,
+                            SCM_SYM_PARTIAL_CONTINUATION);
     /* Remove the saved continuation chain.
        NB: c can be NULL if we've been executing a partial continuation.
        It's ok, for a continuation pointed by cstack will be restored
diff --git a/test/dynwind.scm b/test/dynwind.scm
index 8408914..17caa43 100644
--- a/test/dynwind.scm
+++ b/test/dynwind.scm
@@ -42,12 +42,30 @@
             (lambda (c) (c 1 2 3)))
          (list x y z)))
 
-(test* "call/cc (values4)" (test-error)
+(test* "call/cc (values4)" '(1 2 (3 4))
+       (receive (x y . z)
+           (call-with-current-continuation
+            (lambda (c) (c 1 2 3 4)))
+         (list x y z)))
+
+(test* "call/cc (values5)" '(1 2 ())
+       (receive (x y . z)
+           (call-with-current-continuation
+            (lambda (c) (c 1 2)))
+         (list x y z)))
+
+(test* "call/cc (values6)" (test-error)
        (receive (x y)
            (call-with-current-continuation
             (lambda (c) (c 1 2 3)))
          (list x y)))
 
+(test* "call/cc (values7)" (test-error)
+       (receive (x y)
+           (call-with-current-continuation
+            (lambda (c) (c 1)))
+         (list x y)))
+
 ;; continuation invoked while inline procedure is prepared.
 ;; a test to see call/cc won't mess up the VM stack.