From 38e9bd7a2f9d84442bc26ec4b2d91f515aedfeb1 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 27 Nov 2023 14:02:03 +0100 Subject: Avoid swallowing errors for (values) operands of elided primcalls * module/language/tree-il/peval.scm (peval): When visiting (values) in anything other than an effect or values context, residualize (values (values)), which will cause a run-time error. * test-suite/tests/peval.test ("values"): Add test. --- module/language/tree-il/peval.scm | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) (limited to 'module/language') diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index c39069f69..937a797f0 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -1306,12 +1306,16 @@ top-level bindings from ENV and return the resulting expression." '())))))))) (($ src 'values exps) - (cond - ((null? exps) - (if (eq? ctx 'effect) - (make-void #f) - exp)) - (else + (match exps + (() + (case ctx + ((effect) (make-void #f)) + ((values) exp) + ;; Zero values returned to continuation expecting a value: + ;; ensure that we raise an error. + (else (make-primcall src 'values (list exp))))) + ((($ _ 'values ())) exp) + (_ (let ((vals (map for-value exps))) (if (and (case ctx ((value test effect) #t) @@ -1357,12 +1361,11 @@ top-level bindings from ENV and return the resulting expression." ('make-prompt-tag ($ _ (? string?)))) #t) (_ #f))) - ;; Some expressions can be folded without visiting the - ;; arguments for value. (let ((res (if (eq? ctx 'effect) (make-void #f) (make-const #f #t)))) - (for-tail (list->seq src (append args (list res)))))) + (for-tail (list->seq src (append (map for-value args) + (list res)))))) (else (match (cons name (map for-value args)) (('cons x ($ _ (? (cut eq? <> '())))) -- cgit v1.2.3