summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-09-13 19:19:10 +0200
committerAndy Wingo <wingo@pobox.com>2008-09-13 19:24:03 +0200
commitf03c31dbaddba733757e3d9161c8d9c8e8f363a7 (patch)
tree4f1530269500ca4ac25c500950c1ff3bbf2eb6c1
parentda320011a31f4b58570d8cb7e67cde39133572eb (diff)
downloadguile-f03c31dbaddba733757e3d9161c8d9c8e8f363a7.tar.gz
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.
-rw-r--r--ice-9/boot-9.scm2
-rw-r--r--libguile/vm-i-system.c38
-rw-r--r--module/language/scheme/translate.scm4
-rw-r--r--module/system/il/compile.scm3
-rw-r--r--module/system/il/glil.scm2
-rw-r--r--module/system/il/inline.scm12
6 files changed, 49 insertions, 12 deletions
diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index d5e3d686b..f13bf79f6 100644
--- 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")
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 23bd239ab..86e65787b 100644
--- 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 87a61304d..b8585e3cd 100644
--- 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 f11757945..ffc51810a 100644
--- 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 a57295519..ebd352977 100644
--- 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 d50beaf50..a31ae7bce 100644
--- 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))