diff options
author | Andy Wingo <wingo@pobox.com> | 2013-06-27 18:49:21 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-06-27 22:02:43 +0200 |
commit | bb97e4abd49e8094e9eb8bf767c696bf7ee1ba7e (patch) | |
tree | 4a266c032b794c87f7ebd8f8101339b21f51607d /module/language/tree-il/compile-glil.scm | |
parent | 0fcc39a0a962e44d509dbb659529165c7ce5b91d (diff) | |
download | guile-bb97e4abd49e8094e9eb8bf767c696bf7ee1ba7e.tar.gz |
dynamic-wind in terms of wind and unwind; remove <dynwind>, @dynamic-wind
* doc/ref/compiler.texi: Remove mention of <dynwind>.
* libguile/eval.c (eval): Remove SCM_M_DYNWIND case.
* libguile/expand.c: Remove scm_sym_at_dynamic_wind.
* libguile/memoize.c (do_wind, do_unwind): A couple of hacky subrs. If
we see a wind or unwind primcall, we expand to a call of a quoted subr
value. It works and removes a kind of memoized value from the
interpreter. For the compiler,primcalls to wind and unwind are
handled specially.
(MAKMEMO_DYNWIND): Remove.
(scm_tc16_memoizer): Remove. Yay!
(memoize): Remove speculative lookup for toplevels to see if they are
memoizers: there are no more memoizers. Memoize calls to the wind and
unwind primitives.
(m_dynamic_wind): Remove.
(unmemoize): Remove dynwind case.
(scm_init_memoize): Add wind and unwind local definitions.
* module/ice-9/boot-9.scm (dynamic-wind): Reimplement in terms of "wind"
and "unwind" primitives. These primitives are not exposed to other
modules.
* module/ice-9/eval.scm (primitive-eval): Remove dynwind case.
* module/language/scheme/decompile-tree-il.scm (do-decompile):
(choose-output-names): Remove dynwind cases.
* module/language/tree-il.scm: Remove <dynwind>. Yaaay!
* module/language/tree-il/analyze.scm (analyze-lexicals): Remove dynwind
cases.
* module/language/tree-il/compile-glil.scm (*primcall-ops*): Add wind
and unwind.
(flatten-lambda-case): Remove dynwind case. Yay!
* module/language/tree-il/cse.scm (cse):
* module/language/tree-il/debug.scm (verify-tree-il):
* module/language/tree-il/effects.scm (make-effects-analyzer):
* module/language/tree-il/peval.scm (singly-valued-expression?, peval):
Remove <dywind> cases. Inline primcalls to dynamic-wind. Add
constant folding for thunk?.
* module/language/tree-il/primitives.scm (*interesting-primitive-names*):
Remove @dynamic-wind, and add procedure? and thunk?.
(*effect+exception-free-primitives*): Add procedure? and thunk?.
(*multiply-valued-primitives*): Remove @dynamic-wind.
Remove @dynamic-wind expander.
* test-suite/tests/peval.test ("partial evaluation"): Update tests for
dynwind desugaring.
Diffstat (limited to 'module/language/tree-il/compile-glil.scm')
-rw-r--r-- | module/language/tree-il/compile-glil.scm | 71 |
1 files changed, 3 insertions, 68 deletions
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm index 2aad6a1f2..85b87b067 100644 --- a/module/language/tree-il/compile-glil.scm +++ b/module/language/tree-il/compile-glil.scm @@ -135,6 +135,9 @@ ;; hack for lua (return/values . return/values) + ((wind . 2) . wind) + ((unwind . 0) . unwind) + ((bytevector-u8-ref . 2) . bv-u8-ref) ((bytevector-u8-set! . 3) . bv-u8-set) ((bytevector-s8-ref . 2) . bv-s8-ref) @@ -940,74 +943,6 @@ (clear-stack-slots context gensyms) (emit-code #f (make-glil-unbind)))))) - ((<dynwind> src winder body unwinder) - (define (thunk? x) - (and (lambda? x) - (null? (lambda-case-gensyms (lambda-body x))))) - (define (make-wrong-type-arg x) - (make-primcall src 'scm-error - (list - (make-const #f 'wrong-type-arg) - (make-const #f "dynamic-wind") - (make-const #f "Wrong type (expecting thunk): ~S") - (make-primcall #f 'list (list x)) - (make-primcall #f 'list (list x))))) - (define (emit-thunk-check x) - (comp-drop (make-conditional - src - (make-primcall src 'thunk? (list x)) - (make-void #f) - (make-wrong-type-arg x)))) - - ;; The `winder' and `unwinder' of a dynwind are constant - ;; expressions and can be duplicated. - (if (not (thunk? winder)) - (emit-thunk-check winder)) - (comp-push winder) - (if (not (thunk? unwinder)) - (emit-thunk-check unwinder)) - (comp-push unwinder) - (emit-code #f (make-glil-call 'wind 2)) - - (case context - ((tail) - (let ((MV (make-label))) - (comp-vals body MV) - ;; One value. Unwind and return the value. - (emit-code #f (make-glil-call 'unwind 0)) - (emit-code #f (make-glil-call 'return 1)) - - (emit-label MV) - ;; Multiple values. Unwind and return the values. - (emit-code #f (make-glil-call 'unwind 0)) - (emit-code #f (make-glil-call 'return/nvalues 1)))) - - ((push) - ;; We only want one value, so ask for one value and then - ;; unwind, leaving the value on the stack. - (comp-push body) - (emit-code #f (make-glil-call 'unwind 0))) - - ((vals) - (let ((MV (make-label))) - (comp-vals body MV) - ;; Transform a singly-valued return to a multiple-value - ;; return and fall through to MV case. - (emit-code #f (make-glil-const 1)) - - (emit-label MV) - ;; Multiple values: unwind and go to the MVRA. - (emit-code #f (make-glil-call 'unwind 0)) - (emit-branch #f 'br MVRA))) - - ((drop) - ;; Compile body, discarding values. Then unwind and fall - ;; through, or goto RA if there is one. - (comp-drop body) - (emit-code #f (make-glil-call 'unwind 0)) - (if RA - (emit-branch #f 'br RA))))) - ((<dynlet> src fluids vals body) (for-each comp-push fluids) (for-each comp-push vals) |