summaryrefslogtreecommitdiff
path: root/test-suite/tests/tree-il.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/tree-il.test')
-rw-r--r--test-suite/tests/tree-il.test111
1 files changed, 91 insertions, 20 deletions
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index a913541ac..6299f14d4 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -650,20 +650,27 @@
(const 3))
(pass-if-peval
- ;; First order, coalesced.
+ ;; First order, coalesced, mutability preserved.
(cons 0 (cons 1 (cons 2 (list 3 4 5))))
- (const (0 1 2 3 4 5)))
+ (apply (primitive list)
+ (const 0) (const 1) (const 2) (const 3) (const 4) (const 5)))
(pass-if-peval
- ;; First order, coalesced, mutability preserved.
- (define mutable
- (cons 0 (cons 1 (cons 2 (list 3 4 5)))))
- (define mutable
- ;; This must not be a constant.
- (apply (primitive list)
- (const 0) (const 1) (const 2) (const 3) (const 4) (const 5))))
-
- ;; These two tests doesn't work any more because we changed the way we
+ ;; First order, coalesced, mutability preserved.
+ (cons 0 (cons 1 (cons 2 (list 3 4 5))))
+ ;; This must not be a constant.
+ (apply (primitive list)
+ (const 0) (const 1) (const 2) (const 3) (const 4) (const 5)))
+
+ (pass-if-peval
+ ;; First order, coalesced, immutability preserved.
+ (cons 0 (cons 1 (cons 2 '(3 4 5))))
+ (apply (primitive cons) (const 0)
+ (apply (primitive cons) (const 1)
+ (apply (primitive cons) (const 2)
+ (const (3 4 5))))))
+
+ ;; These two tests doesn't work any more because we changed the way we
;; deal with constants -- now the algorithm will see a construction as
;; being bound to the lexical, so it won't propagate it. It can't
;; even propagate it in the case that it is only referenced once,
@@ -746,12 +753,18 @@
(apply (primitive car)
(lexical r _))))))))
+ ;; Static sums.
(pass-if-peval
- ;; Mutability preserved.
- (define mutable
- ((lambda (x y z) (list x y z)) 1 2 3))
- (define mutable
- (apply (primitive list) (const 1) (const 2) (const 3))))
+ (let loop ((l '(1 2 3 4)) (sum 0))
+ (if (null? l)
+ sum
+ (loop (cdr l) (+ sum (car l)))))
+ (const 10))
+
+ (pass-if-peval
+ ;; Mutability preserved.
+ ((lambda (x y z) (list x y z)) 1 2 3)
+ (apply (primitive list) (const 1) (const 2) (const 3)))
(pass-if-peval
;; Don't propagate effect-free expressions that operate on mutable
@@ -1084,14 +1097,15 @@
(apply (primitive +) (lexical bar _) (lexical bar _)))))
(pass-if-peval
- ;; Fresh objects are not turned into constants.
+ ;; Fresh objects are not turned into constants, nor are constants
+ ;; turned into fresh objects.
(let* ((c '(2 3))
(x (cons 1 c))
(y (cons 0 x)))
y)
- (let (x) (_) ((apply (primitive list) (const 1) (const 2) (const 3)))
+ (let (x) (_) ((apply (primitive cons) (const 1) (const (2 3))))
(apply (primitive cons) (const 0) (lexical x _))))
-
+
(pass-if-peval
;; Bindings mutated.
(let ((x 2))
@@ -1181,7 +1195,64 @@
(g (lambda (x) (h (1+ x))))
(h (lambda (x) (f x))))
(f 0))
- (letrec _ . _)))
+ (letrec _ . _))
+
+ (pass-if-peval
+ ;; Constant folding: cons
+ (begin (cons 1 2) #f)
+ (const #f))
+
+ (pass-if-peval
+ ;; Constant folding: cons
+ (begin (cons (foo) 2) #f)
+ (begin (apply (toplevel foo)) (const #f)))
+
+ (pass-if-peval
+ ;; Constant folding: cons
+ (if (cons 0 0) 1 2)
+ (const 1))
+
+ (pass-if-peval
+ ;; Constant folding: car+cons
+ (car (cons 1 0))
+ (const 1))
+
+ (pass-if-peval
+ ;; Constant folding: cdr+cons
+ (cdr (cons 1 0))
+ (const 0))
+
+ (pass-if-peval
+ ;; Constant folding: car+cons, impure
+ (car (cons 1 (bar)))
+ (begin (apply (toplevel bar)) (const 1)))
+
+ (pass-if-peval
+ ;; Constant folding: cdr+cons, impure
+ (cdr (cons (bar) 0))
+ (begin (apply (toplevel bar)) (const 0)))
+
+ (pass-if-peval
+ ;; Constant folding: car+list
+ (car (list 1 0))
+ (const 1))
+
+ (pass-if-peval
+ ;; Constant folding: cdr+list
+ (cdr (list 1 0))
+ (apply (primitive list) (const 0)))
+
+ (pass-if-peval
+ ;; Constant folding: car+list, impure
+ (car (list 1 (bar)))
+ (begin (apply (toplevel bar)) (const 1)))
+
+ (pass-if-peval
+ ;; Constant folding: cdr+list, impure
+ (cdr (list (bar) 0))
+ (begin (apply (toplevel bar)) (apply (primitive list) (const 0))))
+
+ )
(with-test-prefix "tree-il-fold"