From bb97e4abd49e8094e9eb8bf767c696bf7ee1ba7e Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 27 Jun 2013 18:49:21 +0200 Subject: dynamic-wind in terms of wind and unwind; remove , @dynamic-wind * doc/ref/compiler.texi: Remove mention of . * 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 . 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 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. --- module/language/tree-il/peval.scm | 50 +++++++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 18 deletions(-) (limited to 'module/language/tree-il/peval.scm') diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index 662adb493..afa92f6de 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -104,8 +104,6 @@ (($ _ test consequent alternate) (and (singly-valued-expression? consequent) (singly-valued-expression? alternate))) - (($ _ winder body unwinder) - (singly-valued-expression? body)) (else #f))) (define (truncate-values x) @@ -543,10 +541,6 @@ top-level bindings from ENV and return the resulting expression." (($ ) #f) (($ ) #f) - ;; Bail on dynwinds, as that would cause the consumer to run in - ;; the wrong dynamic context. - (($ ) #f) - ;; Propagate to tail positions. (($ src names gensyms vals body) (let ((body (loop body))) @@ -1002,11 +996,6 @@ top-level bindings from ENV and return the resulting expression." (else #f)))) (_ #f)) (make-let-values lv-src producer (for-tail consumer))))) - (($ src winder body unwinder) - (make-dynwind src - (for-value winder) - (for-tail body) - (for-value unwinder))) (($ src fluids vals body) (make-dynlet src (map for-value fluids) (map for-value vals) (for-tail body))) @@ -1169,13 +1158,29 @@ top-level bindings from ENV and return the resulting expression." (list w u) 2 (match-lambda ((w u) - (make-seq src - (make-call src w '()) - (make-begin0 src - (make-dynwind src w - (make-call src thunk '()) - u) - (make-call src u '())))))))) + (make-seq + src + (make-seq + src + (make-conditional + src + ;; fixme: introduce logic to fold thunk? + (make-primcall src 'thunk? (list u)) + (make-call src w '()) + (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 u)) + (make-primcall #f 'list (list u))))) + (make-primcall src 'wind (list w u))) + (make-begin0 src + (make-call src thunk '()) + (make-seq src + (make-primcall src 'unwind '()) + (make-call src u '()))))))))) (($ src 'values exps) (cond @@ -1244,6 +1249,15 @@ top-level bindings from ENV and return the resulting expression." ((name . args) (make-primcall src name args)))))) + (($ src 'thunk? (proc)) + (match (for-value proc) + (($ _ _ ($ _ req)) + (for-tail (make-const src (null? req)))) + (proc + (case ctx + ((effect) (make-void src)) + (else (make-primcall src 'thunk? (list proc))))))) + (($ src (? accessor-primitive? name) args) (match (cons name (map for-value args)) ;; FIXME: these for-tail recursions could take place outside -- cgit v1.2.3