diff options
author | Andy Wingo <wingo@pobox.com> | 2008-09-13 19:19:10 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-09-13 19:24:03 +0200 |
commit | f03c31dbaddba733757e3d9161c8d9c8e8f363a7 (patch) | |
tree | 4f1530269500ca4ac25c500950c1ff3bbf2eb6c1 | |
parent | da320011a31f4b58570d8cb7e67cde39133572eb (diff) | |
download | guile-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.scm | 2 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 38 | ||||
-rw-r--r-- | module/language/scheme/translate.scm | 4 | ||||
-rw-r--r-- | module/system/il/compile.scm | 3 | ||||
-rw-r--r-- | module/system/il/glil.scm | 2 | ||||
-rw-r--r-- | module/system/il/inline.scm | 12 |
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)) |