diff options
Diffstat (limited to 'test-suite/tests/cse.test')
-rw-r--r-- | test-suite/tests/cse.test | 129 |
1 files changed, 62 insertions, 67 deletions
diff --git a/test-suite/tests/cse.test b/test-suite/tests/cse.test index e0219e84d..f9b85d495 100644 --- a/test-suite/tests/cse.test +++ b/test-suite/tests/cse.test @@ -70,7 +70,7 @@ (lambda _ (lambda-case (((x y) #f #f #f () (_ _)) - (apply (primitive eq?) (lexical x _) (lexical y _)))))) + (primcall eq? (lexical x _) (lexical y _)))))) ;; The eq? propagates, and (if TEST #f #t) folds to (not TEST). (pass-if-cse @@ -79,8 +79,8 @@ (lambda _ (lambda-case (((x y) #f #f #f () (_ _)) - (apply (primitive not) - (apply (primitive eq?) (lexical x _) (lexical y _))))))) + (primcall not + (primcall eq? (lexical x _) (lexical y _))))))) ;; (if TEST (not TEST) #f) ;; => (if TEST #f #f) @@ -110,13 +110,13 @@ (lambda _ (lambda-case (((x y) #f #f #f () (_ _)) - (if (apply (primitive set-car!) - (lexical x _) - (lexical y _)) - (apply (primitive not) - (apply (primitive set-car!) - (lexical x _) - (lexical y _))) + (if (primcall set-car! + (lexical x _) + (lexical y _)) + (primcall not + (primcall set-car! + (lexical x _) + (lexical y _))) (const #f)))))) ;; Primitives that access mutable memory can propagate, as long as @@ -130,11 +130,10 @@ (lambda _ (lambda-case (((x y) #f #f #f () (_ _)) - (begin - (apply (primitive string-ref) - (lexical x _) - (lexical y _)) - (const #f)))))) + (seq (primcall string-ref + (lexical x _) + (lexical y _)) + (const #f)))))) ;; However, expressions with dependencies on effects do not propagate ;; through a lambda. @@ -146,15 +145,15 @@ (lambda _ (lambda-case (((x y) #f #f #f () (_ _)) - (if (apply (primitive string-ref) - (lexical x _) - (lexical y _)) + (if (primcall string-ref + (lexical x _) + (lexical y _)) (lambda _ (lambda-case ((() #f #f #f () ()) - (if (apply (primitive string-ref) - (lexical x _) - (lexical y _)) + (if (primcall string-ref + (lexical x _) + (lexical y _)) (const #t) (const #f))))) (const #f)))))) @@ -169,17 +168,16 @@ (lambda _ (lambda-case (((x y) #f #f #f () (_ _)) - (if (apply (primitive string-ref) - (lexical x _) - (lexical y _)) - (begin - (apply (primitive string-set!) - (lexical x _) - (const #\!)) - (apply (primitive not) - (apply (primitive string-ref) - (lexical x _) - (lexical y _)))) + (if (primcall string-ref + (lexical x _) + (lexical y _)) + (seq (primcall string-set! + (lexical x _) + (const #\!)) + (primcall not + (primcall string-ref + (lexical x _) + (lexical y _)))) (const #f)))))) ;; Predicates are only added to the database if they are in a @@ -190,7 +188,7 @@ (lambda _ (lambda-case (((x y) #f #f #f () (_ _)) - (apply (primitive eq?) (lexical x _) (lexical y _)))))) + (primcall eq? (lexical x _) (lexical y _)))))) ;; Conditional bailouts do cause primitives to be added to the DB. (pass-if-cse @@ -199,12 +197,11 @@ (lambda _ (lambda-case (((x y) #f #f #f () (_ _)) - (begin - (if (apply (primitive eq?) - (lexical x _) (lexical y _)) - (void) - (apply (primitive 'throw) (const 'foo))) - (const #t)))))) + (seq (if (primcall eq? + (lexical x _) (lexical y _)) + (void) + (primcall throw (const foo))) + (const #t)))))) ;; A chain of tests in a conditional bailout add data to the DB ;; correctly. @@ -219,21 +216,20 @@ (lambda _ (lambda-case (((x y) #f #f #f () (_ _)) - (begin + (seq (fix (failure) (_) ((lambda _ (lambda-case ((() #f #f #f () ()) - (apply (primitive throw) (const foo)))))) - (if (apply (primitive struct?) (lexical x _)) - (if (apply (primitive eq?) - (apply (primitive struct-vtable) - (lexical x _)) - (toplevel x-vtable)) + (primcall throw (const foo)))))) + (if (primcall struct? (lexical x _)) + (if (primcall eq? + (primcall struct-vtable (lexical x _)) + (toplevel x-vtable)) (void) - (apply (lexical failure _))) - (apply (lexical failure _)))) - (apply (primitive struct-ref) (lexical x _) (lexical y _))))))) + (call (lexical failure _))) + (call (lexical failure _)))) + (primcall struct-ref (lexical x _) (lexical y _))))))) ;; Strict argument evaluation also adds info to the DB. (pass-if-cse @@ -254,24 +250,23 @@ ((lambda _ (lambda-case ((() #f #f #f () ()) - (apply (primitive throw) (const foo)))))) - (if (apply (primitive struct?) (lexical x _)) - (if (apply (primitive eq?) - (apply (primitive struct-vtable) - (lexical x _)) - (toplevel x-vtable)) - (apply (primitive struct-ref) (lexical x _) (const 1)) - (apply (lexical failure _))) - (apply (lexical failure _))))) - (apply (primitive +) (lexical z _) - (apply (primitive struct-ref) (lexical x _) (const 2)))))))) + (primcall throw (const foo)))))) + (if (primcall struct? (lexical x _)) + (if (primcall eq? + (primcall struct-vtable (lexical x _)) + (toplevel x-vtable)) + (primcall struct-ref (lexical x _) (const 1)) + (call (lexical failure _))) + (call (lexical failure _))))) + (primcall + (lexical z _) + (primcall struct-ref (lexical x _) (const 2)))))))) ;; Replacing named expressions with lexicals. (pass-if-cse (let ((x (car y))) (cons x (car y))) - (let (x) (_) ((apply (primitive car) (toplevel y))) - (apply (primitive cons) (lexical x _) (lexical x _)))) + (let (x) (_) ((primcall car (toplevel y))) + (primcall cons (lexical x _) (lexical x _)))) ;; Dominating expressions only provide predicates when evaluated in ;; test context. @@ -282,16 +277,16 @@ 'two)) ;; Actually this one should reduce in other ways, but this is the ;; current reduction: - (begin - (apply (primitive car) (toplevel x)) - (if (apply (primitive car) (toplevel x)) + (seq + (primcall car (toplevel x)) + (if (primcall car (toplevel x)) (const one) (const two)))) (pass-if-cse (begin (cons 1 2 3) 4) - (begin - (apply (primitive cons) (const 1) (const 2) (const 3)) + (seq + (primcall cons (const 1) (const 2) (const 3)) (const 4))) (pass-if "http://bugs.gnu.org/12883" |