mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00
Code Activity

remove peval abort-in-tail-position optimization

Browse source 
* module/language/tree-il/peval.scm (peval): Remove abort optimization;
  the CPS compiler will do much better here, and it is complicating
  things in the meantime.
This commit is contained in:
Andy Wingo 2013-07-29 21:30:49 +02:00
parent 056e3470c4
commit c1bff87998
2 changed files with 3 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1533,41 +1533,6 @@ top-level bindings from ENV and return the resulting expression."
;; entirely.
(unrecord-operand-uses op 1)
(for-tail (make-call src body '()))))
((find-definition tag 2)
(lambda (val op)
(and (make-prompt-tag? val)
(match body
(($ <lambda> _ _
($ <lambda-case> _ () #f #f #f () ()
($ <abort> _ (? (cut tree-il=? <> tag)))))
#t)
(else #f))))
=> (lambda (val op)
;; (let ((t (make-prompt-tag)))
;; (call-with-prompt t
;; (lambda () (abort-to-prompt t val ...))
;; (lambda (k arg ...) e ...)))
;; => (call-with-values (lambda () (values values val ...))
;; (lambda (k arg ...) e ...))
(unrecord-operand-uses op 2)
(match body
(($ <lambda> _ _
($ <lambda-case> _ () #f #f #f () ()
($ <abort> _ _ args tail)))
(for-tail
(make-primcall
src 'call-with-values
(list (make-lambda
#f '()
(make-lambda-case
#f '() #f #f #f '() '()
(make-primcall #f 'apply
`(,(make-primitive-ref #f 'values)
,(make-primitive-ref #f 'values)
,@args
,tail))
#f))
handler)))))))
(else
(let ((handler (for-value handler)))
(define (escape-only-handler? handler)

3
test-suite/tests/peval.test
View file

@ -1272,6 +1272,9 @@
(apply (lambda (x y) (cons x y)) (list 1 2))
(primcall cons (const 1) (const 2)))
;; Disable after removal of abort-in-tail-position optimization, in
;; hopes that CPS does a uniformly better job.
#;
(pass-if-peval
(let ((t (make-prompt-tag)))
(call-with-prompt t