diff options
| author | Andy Wingo <wingo@pobox.com> | 2011-11-09 15:23:58 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2011-11-09 16:54:30 +0100 |
| commit | 8ee0b28b4d51dac704c151bf7f6d1874018ed3ae (patch) | |
| tree | 006f566a1f8502e9b46a0995957b173da6c1288c /module | |
| parent | 5e9b9059a334be0427eeb37eee6627dd595dc567 (diff) | |
peval: fix dynwind bug.
* module/language/tree-il/peval.scm (peval): The <dynwind> compiler will
copy the winder and unwinder values, so make sure that they are
constant, and if not, create lexical bindings. Fixes
http://debbugs.gnu.org/9844.
* test-suite/tests/tree-il.test ("partial evaluation"): Add a couple
<dynwind> tests.
Diffstat (limited to 'module')
| -rw-r--r-- | module/language/tree-il/peval.scm | 35 |
1 files changed, 33 insertions, 2 deletions
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index 9524133bf..634c6c91c 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -870,8 +870,39 @@ top-level bindings from ENV and return the resulting expression." (_ #f)) (make-let-values lv-src producer (for-tail consumer))))) (($ <dynwind> src winder body unwinder) - (make-dynwind src (for-value winder) (for-tail body) - (for-value unwinder))) + (let ((pre (for-value winder)) + (body (for-tail body)) + (post (for-value unwinder))) + (cond + ((not (constant-expression? pre)) + (cond + ((not (constant-expression? post)) + (let ((pre-sym (gensym "pre ")) (post-sym (gensym "post "))) + (record-new-temporary! 'pre pre-sym 1) + (record-new-temporary! 'post post-sym 1) + (make-let src '(pre post) (list pre-sym post-sym) (list pre post) + (make-dynwind src + (make-lexical-ref #f 'pre pre-sym) + body + (make-lexical-ref #f 'post post-sym))))) + (else + (let ((pre-sym (gensym "pre "))) + (record-new-temporary! 'pre pre-sym 1) + (make-let src '(pre) (list pre-sym) (list pre) + (make-dynwind src + (make-lexical-ref #f 'pre pre-sym) + body + post)))))) + ((not (constant-expression? post)) + (let ((post-sym (gensym "post "))) + (record-new-temporary! 'post post-sym 1) + (make-let src '(post) (list post-sym) (list post) + (make-dynwind src + pre + body + (make-lexical-ref #f 'post post-sym))))) + (else + (make-dynwind src pre body post))))) (($ <dynlet> src fluids vals body) (make-dynlet src (map for-value fluids) (map for-value vals) (for-tail body))) |