rename tail-call to goto/args, add some more tail instructions

* libguile/vm-i-system.c (call): Rename continuation invocation from
  `vm_call_cc' to `vm_call_continuation', because that's what it really
  does. Add a note that it doesn't handle multiple values at the moment.
  (goto/arg): Renamed from tail-call, in deference to the progenitors, on
  Dale Smith's suggestion.
  (goto/apply): New instruction, for `apply' in a tail context. Not yet
  used, or vetted for that matter.
  (call/cc): No need to pop the program, I don't think; although this
  isn't tested either.
  (goto/cc): New instruction, for call/cc in a tail context.

* module/language/scheme/translate.scm (*forbidden-primitives*): Rename
  from %forbidden-primitives.

* module/system/il/compile.scm (codegen): Adapt to goto/args instead of
  tail-call.

* module/system/il/inline.scm: Start inlining some macros used in
  r4rs.scm -- not yet fully tested.

* ice-9/boot-9.scm: Allow load of a compiled r4rs file.

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index d5e3d68..f13bf79 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -208,7 +208,7 @@
 ;;; {R4RS compliance}
 ;;;
 
-(primitive-load-path "ice-9/r4rs.scm")
+(primitive-load-path "ice-9/r4rs")
 
 \f
 

diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 23bd239..86e6578 100644 (file)
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -516,8 +516,9 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
   if (SCM_VM_CONT_P (x))
     {
       program = x;
-    vm_call_cc:
+    vm_call_continuation:
       /* Check the number of arguments */
+      /* FIXME multiple args */
       if (nargs != 1)
        scm_wrong_num_args (program);
 
@@ -534,10 +535,11 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
   goto vm_error_wrong_type_apply;
 }
 
-VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1)
 {
   register SCM x;
   nargs = FETCH ();
+ vm_goto_args:
   x = sp[-nargs];
 
   SCM_TICK;    /* allow interrupt here */
@@ -685,7 +687,7 @@ VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
    * Continuation call
    */
   if (SCM_VM_CONT_P (program))
-    goto vm_call_cc;
+    goto vm_call_continuation;
 
   goto vm_error_wrong_type_apply;
 }
@@ -711,15 +713,43 @@ VM_DEFINE_INSTRUCTION (apply, "apply", 1, -1, 1)
   goto vm_call;
 }
 
+VM_DEFINE_INSTRUCTION (goto_apply, "goto/apply", 1, -1, 1)
+{
+  int len;
+  SCM ls;
+  POP (ls);
+
+  nargs = FETCH ();
+  if (nargs < 2)
+    goto vm_error_wrong_num_args;
+
+  len = scm_ilength (ls);
+  if (len < 0)
+    goto vm_error_wrong_type_arg;
+
+  for (; !SCM_NULLP (ls); ls = SCM_CDR (ls))
+    PUSH (SCM_CAR (ls));
+
+  nargs += len - 2;
+  goto vm_goto_args;
+}
+
 VM_DEFINE_INSTRUCTION (call_cc, "call/cc", 1, 1, 1)
 {
   SYNC_BEFORE_GC ();
   PUSH (capture_vm_cont (vp));
-  POP (program);
   nargs = 1;
   goto vm_call;
 }
 
+VM_DEFINE_INSTRUCTION (goto_cc, "goto/cc", 1, 1, 1)
+{
+  SYNC_BEFORE_GC ();
+  PUSH (capture_vm_cont (vp));
+  nargs = 1;
+  goto vm_goto_args;
+}
+
 VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
 {
  vm_return:

diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm
index 87a6130..b8585e3 100644 (file)
--- a/module/language/scheme/translate.scm
+++ b/module/language/scheme/translate.scm
@@ -40,7 +40,7 @@
 ;;; Translator
 ;;;
 
-(define %forbidden-primitives
+(define *forbidden-primitives*
   ;; Guile's `procedure->macro' family is evil because it crosses the
   ;; compilation boundary.  One solution might be to evaluate calls to
   ;; `procedure->memoizing-macro' at compilation time, but it may be more
@@ -91,7 +91,7 @@
              => (lambda (t) (t e l x)))
 
             ;; FIXME: lexical/module overrides of forbidden primitives
-            ((memq head %forbidden-primitives)
+            ((memq head *forbidden-primitives*)
             (syntax-error l (format #f "`~a' is forbidden" head)
                           (cons head tail)))
 

diff --git a/module/system/il/compile.scm b/module/system/il/compile.scm
index f117579..ffc5181 100644 (file)
--- a/module/system/il/compile.scm
+++ b/module/system/il/compile.scm
@@ -296,6 +296,7 @@
        ((<ghil-inline> env loc inline args)
         ;; ARGS...
         ;; (INST NARGS)
+         ;; FIXME: translate between call and goto/args, etc
         (push-call! loc inline args)
         (maybe-drop)
         (maybe-return))
@@ -305,7 +306,7 @@
         ;; ARGS...
         ;; ([tail-]call NARGS)
         (comp-push proc)
-        (push-call! loc (if tail 'tail-call 'call) args)
+        (push-call! loc (if tail 'goto/args 'call) args)
         (maybe-drop))))
     ;;
     ;; main

diff --git a/module/system/il/glil.scm b/module/system/il/glil.scm
index a572955..ebd3529 100644 (file)
--- a/module/system/il/glil.scm
+++ b/module/system/il/glil.scm
@@ -150,7 +150,7 @@
 ;;;      (make-instl (car x) label))
 ;;;     ;; (call NARGS)
 ;;;     ;; (tail-call NARGS)
-;;;     (((or 'call 'tail-call) n)
+;;;     (((or 'call 'goto/args) n)
 ;;;      (make-instn (car x) n))
 ;;;     ;; (INST)
 ;;;     ((inst)

diff --git a/module/system/il/inline.scm b/module/system/il/inline.scm
index d50beaf..a31ae7b 100644 (file)
--- a/module/system/il/inline.scm
+++ b/module/system/il/inline.scm
@@ -194,10 +194,16 @@
 (define-inline list? (x)
   (list? x))
 
-(define-inline apply (proc . args)
-  (apply proc . args))
-
 (define-inline cons*
   (x) x
   (x y) (cons x y)
   (x y . rest) (cons x (cons* y . rest)))
+
+(define-inline apply (proc . args)
+  (apply proc . args))
+
+;; From ice-9/r4rs.scm; actually not that bad of a strategy for handling
+;; the (apply apply ...) case
+
+(define-inline @apply (proc . args)
+  (apply proc . args))