From a4c7fe5cde907f3bc4cbc5190bfc7e748d6bac45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 21 Sep 2011 22:56:45 +0200 Subject: [PATCH] peval: Add test for multiple-value returns. * test-suite/tests/tree-il.test (pass-if-peval): Support the `resolve-primitives' keyword. ("partial evaluation"): Add test for `call-with-values'. --- test-suite/tests/tree-il.test | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test index bdff6434e..b6418832b 100644 --- a/test-suite/tests/tree-il.test +++ b/test-suite/tests/tree-il.test @@ -23,6 +23,7 @@ #:use-module (system base pmatch) #:use-module (system base message) #:use-module (language tree-il) + #:use-module (language tree-il primitives) #:use-module (language glil) #:use-module (srfi srfi-13)) @@ -73,11 +74,19 @@ (@@ (language tree-il optimize) peval)) (define-syntax pass-if-peval - (syntax-rules () + (syntax-rules (resolve-primitives) ((_ in pat) + (pass-if-peval in pat + (compile 'in #:from 'scheme #:to 'tree-il))) + ((_ resolve-primitives in pat) + (pass-if-peval in pat + (expand-primitives! + (resolve-primitives! + (compile 'in #:from 'scheme #:to 'tree-il) + (current-module))))) + ((_ in pat code) (pass-if 'in - (let ((evaled (unparse-tree-il - (peval (compile 'in #:from 'scheme #:to 'tree-il))))) + (let ((evaled (unparse-tree-il (peval code)))) (pmatch evaled (pat #t) (_ (pk 'peval-mismatch evaled) #f))))))) @@ -620,6 +629,16 @@ (f))) (const 3)) + (pass-if-peval resolve-primitives + ;; First order, let-values (requires primitive expansion for + ;; `call-with-values'.) + (let ((x 0)) + (call-with-values + (lambda () (if (zero? x) (values 1 2) (values 3 4))) + (lambda (a b) + (+ a b)))) + (const 3)) + (pass-if-peval ;; First order, coalesced. (cons 0 (cons 1 (cons 2 (list 3 4 5))))