diff options
| author | Andy Wingo <wingo@pobox.com> | 2013-10-23 10:35:30 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2013-10-26 13:13:17 +0200 |
| commit | 0f676d8725ebc79cd166047203c5400d8c639a25 (patch) | |
| tree | f9c711b5209307c4f703edfec1c34acba8c4394a /module/language/tree-il/peval.scm | |
| parent | 40553c2016298e84d01c09429eede129d2d8a53a (diff) | |
| download | guile-0f676d8725ebc79cd166047203c5400d8c639a25.tar.gz | |
Peval: Fold `thunk?' in more cases.
* module/language/tree-il/peval.scm (peval): Better folding of the
`thunk?' predicate.
Diffstat (limited to 'module/language/tree-il/peval.scm')
| -rw-r--r-- | module/language/tree-il/peval.scm | 20 |
1 files changed, 13 insertions, 7 deletions
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index f3c016137..676ac89a8 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -1251,13 +1251,19 @@ top-level bindings from ENV and return the resulting expression." (make-primcall src name args)))))) (($ <primcall> src 'thunk? (proc)) - (match (for-value proc) - (($ <lambda> _ _ ($ <lambda-case> _ req)) - (for-tail (make-const src (null? req)))) - (proc - (case ctx - ((effect) (make-void src)) - (else (make-primcall src 'thunk? (list proc))))))) + (case ctx + ((effect) + (for-tail (make-seq src proc (make-void src)))) + (else + (match (for-value proc) + (($ <lambda> _ _ ($ <lambda-case> _ req)) + (for-tail (make-const src (null? req)))) + (proc + (match (find-definition proc 2) + (($ <lambda> _ _ ($ <lambda-case> _ req)) + (for-tail (make-const src (null? req)))) + (_ + (make-primcall src 'thunk? (list proc))))))))) (($ <primcall> src (? accessor-primitive? name) args) (match (cons name (map for-value args)) |