diff options
-rw-r--r-- | module/language/tree-il/peval.scm | 35 | ||||
-rw-r--r-- | test-suite/tests/peval.test | 3 |
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 |