summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-07-29 21:30:49 +0200
committerAndy Wingo <wingo@pobox.com>2013-08-11 16:45:31 +0200
commitc1bff879980c3a2f107e8d7b54d0a6d8a18eefe4 (patch)
treec828594c18808ddd6751bf8a522f6df6dd887188
parent056e3470c4a0c18366c1da4f5052f36761824b70 (diff)
downloadguile-c1bff879980c3a2f107e8d7b54d0a6d8a18eefe4.tar.gz
remove peval abort-in-tail-position optimization
* 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.
-rw-r--r--module/language/tree-il/peval.scm35
-rw-r--r--test-suite/tests/peval.test3
2 files changed, 3 insertions, 35 deletions
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index af00e9904..57832a698 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -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)
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index cb01b4b68..6d83fb79c 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -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