mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

Peval: Fold `thunk?' in more cases.

Browse source 
* module/language/tree-il/peval.scm (peval): Better folding of the
  `thunk?' predicate.
This commit is contained in:
Andy Wingo 2013-10-23 10:35:30 +02:00
parent 40553c2016
commit 0f676d8725
1 changed files with 13 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

20
module/language/tree-il/peval.scm
View file

@ -1251,13 +1251,19 @@ top-level bindings from ENV and return the resulting expression."
(make-primcall src name args)))))) (make-primcall src name args))))))
(($ <primcall> src 'thunk? (proc)) (($ <primcall> src 'thunk? (proc))
(match (for-value proc) (case ctx
(($ <lambda> _ _ ($ <lambda-case> _ req)) ((effect)
(for-tail (make-const src (null? req)))) (for-tail (make-seq src proc (make-void src))))
(proc (else
(case ctx (match (for-value proc)
((effect) (make-void src)) (($ <lambda> _ _ ($ <lambda-case> _ req))
(else (make-primcall src 'thunk? (list proc))))))) (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) (($ <primcall> src (? accessor-primitive? name) args)
(match (cons name (map for-value args)) (match (cons name (map for-value args))