;;; cp0.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;; 
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;; 
;;; http://www.apache.org/licenses/LICENSE-2.0
;;; 
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(define-syntax cp0-mat
  (syntax-rules ()
    [(_ name form ...)
     (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
       (mat name form ...))]))

(cp0-mat cp0-regression
 ; test to keep cp0 honest about letrec's implicit assignment
  #;(letrec ((x (call/cc (lambda (k) k)))) ; invalid in r6rs
    (let ((y x))
      (y (lambda (z) (not (eq? x y))))))
 ; make sure compiler doesn't loop...
  (begin
    (define omega
      (lambda ()
        ((lambda (x) (x x)) (lambda (x) (x x)))))
    (procedure? omega))
 ; make sure cp0 doesn't assume read returns #t
  (not (read (open-input-string "#f")))
 ; test proper visiting of assigned variables
  (letrec ((x (lambda () x)) (y (lambda () x)))
    (set! y (y))
    (eq? y (y)))
 ; test proper quote propagation from seq w/side effect
  (equal?
    (let ((x 0))
      (let ((y (begin (set! x (+ x 1)) 0)))
        (let ((z (+ y 1)))
          (list x z))))
    '(1 1))
 ; test that we reset integrated? flags for outer calls when we bug out of
 ; an inner call in cases where operator of call is itself a call
  (begin
    (define whack! (lambda () (set! whack! 'okay)))
    (define ignore list)
    (letrec ([g
              (lambda x
                  ((lambda (x)
                     (ignore)
                     (when (null? x) (g #f))
                     (lambda (y) (ignore x y y y)))
                   (ignore (ignore ignore))))])
      ((g) (whack!)))
    (eq? whack! 'okay))
 ; make sure cp0 does not go to lala land
  (error? (letrec ((x x)) x))
 ; make sure residual assignments to unref'd vars don's blow
  (eq? (let ((x (void)))
         (set! x 0)
         (letrec ((f (lambda () (set! x (+ x 1)) x)) (g (lambda (x) x)))
           (g 3)))
       3)
  (eq? (let ()
         (define kons-proc
           (lambda (a) (lambda (b) (lambda (g) ((g a) b)))))
         (define-syntax kons
           (syntax-rules () [(_ x y) ((kons-proc x) y)]))
         (define kar (lambda (pr) (pr (lambda (a) (lambda (b) a)))))
         (define kdr (lambda (pr) (pr (lambda (a) (lambda (b) b)))))
         ((kar (kons (lambda (x y) (kar (kons x y)))
                 (kons (lambda (x y) (kdr (kons x y)))
                       (lambda (x y) (kdr (kar (kons (kons x y) 'nil)))))))
          3 4))
       3)
 ; test for various bugs fixed in 5.9i, all relating to resetting an
 ; outer context when we abort from an inner one
  (begin
    (define **a 1)
    (define-syntax **huge
      (identifier-syntax
        (set! **output
          (cons
            (list (list **a **a **a **a **a **a **a **a **a **a)
                  (list **a **a **a **a **a **a **a **a **a **a)
                  (list **a **a **a **a **a **a **a **a **a **a)
                  (list **a **a **a **a **a **a **a **a **a **a)
                  (list **a **a **a **a **a **a **a **a **a **a))
            **output))))
    (define **test-output
      (case-lambda
        [(th) (**test-output 1 th)]
        [(n th)
         (set! **output '())
         (and (th)
           (equal? **output
             (make-list n
               '((1 1 1 1 1 1 1 1 1 1)
                 (1 1 1 1 1 1 1 1 1 1)
                 (1 1 1 1 1 1 1 1 1 1)
                 (1 1 1 1 1 1 1 1 1 1)
                 (1 1 1 1 1 1 1 1 1 1)))))]))
    (**test-output (lambda () **huge #t)))
  (**test-output
    (lambda ()
      (equal?
        (let ((f (lambda ()
                   (let ((x **huge))
                     (let ((g (lambda () x)))
                       (g) memq)))))
          ((f) (+ 1 2) '(1 2 3 4 5)))
        '(3 4 5))))
  (**test-output
    (lambda ()
      (equal?
        (let ((f (lambda ()
                   (let ((x **huge))
                     (let ((g (begin 0 (lambda () x)))) (g) memq)))))
          ((f) (+ 1 2) '(1 2 3 4 5)))
        '(3 4 5))))
  (**test-output
    (lambda ()
      (equal?
        (let ((f (lambda ()
                   (let ((x **huge))
                     (let ((g (lambda () x))) (g) (g) memq)))))
          ((f) (+ 1 2) '(1 2 3 4 5)))
        '(3 4 5))))
  (**test-output
    (lambda ()
      (eq?
        (let ((f (lambda () (let ((x **huge)) (lambda (y z) (or (= y 3) x))))))
          ((f) (+ 1 2) 4))
        #t)))
  (**test-output 2
    (lambda ()
      (eq? (let ((f (lambda ()
                      (let ((x **huge)) (lambda (y z) (or (= y 3) x))))))
            ((f) (+ 1 2) 4)
            ((f) (+ 1 2) 4))
        #t)))
  (**test-output 2
    (lambda ()
      (eq?
        (let ((f (lambda ()
                   (let ((x **huge)) (lambda (y z) (if (y z) 'ok x))))))
          ((f) + 3)
          ((f) + 3))
        'ok)))
  (eq?
    (let ((f (lambda () (let ((x 0)) (lambda (y z) (if (y z) 'ok x))))))
      ((f) + 3))
    'ok)
  (not (let ((f (lambda (x)
             (eq? (begin (set! x 4) x)
                  (begin (set! x 5) x)))))
         (f 'a)))
  (not (let ((f #f) (g #f))
         (let ((x 0))
           (set! g (lambda () (eq? (begin (f) x) (begin (f) x))))
           (set! f (lambda () (set! x (+ x 1))))
           (g))))
  (eq? (let ([g% (lambda (cp)
                   (let ([t1 0])
                     (set! t1 (car cp))
                     (let ([t2 t1]) 4)))])
         g%
         (g% '(0)))
       4)
  (error? (let ((f (lambda (x) x))) (let ((g f)) (g))))
  (begin
    (define $foo$
      (letrec ((func1
                (lambda (cont0)
                  (cont0 'x)))) ; incorrect # args to cont0 (func3)
         (lambda ()
           (letrec ((func3
                     (lambda (cont2 x)
                       (cont2 x))))
              (lambda ()
                (func1 func3))))))
    #t)
  (error? (($foo$)))
  (begin
    (define $foo$
      (letrec ((func1
                (lambda (cont0)
                  (cont0 list 'x)))) ; correct # args to cont0 (func3)
         (lambda ()
           (letrec ((func3
                     (lambda (cont2 x)
                       (cont2 x))))
              (lambda ()
                (func1 func3))))))
    #t)
  (equal? (($foo$)) '(x))
 ; make sure cpletrec doesn't toss bindings for assigned variables
  (equal?
    (let ()
      (define *root* '())
      (define (init-traverse) (set! *root* 0))
      (define (run-traverse) (traverse *root*))
      (init-traverse))
    (void))
 ; make sure nested cp0 doesn't assimilate letrec bindings when
 ; body is simple but not pure
  ((lambda (x ls) (and (member x ls) #t))
    (let ([x 0])
      (letrec ([a (letrec ([b (set! x 1)]) x)]
               [c (letrec ([d (set! x 2)]) x)])
        (list a c)))
    '((1 2) (2 1)))
  ((lambda (x ls) (and (member x ls) #t))
    (let ([x 0])
      (letrec ([a (letrec ([b x]) (set! x 1) b)]
               [c (letrec ([d x]) (set! x 2) d)])
        (list a c x)))
    '((2 0 1) (0 1 2)))
 ; make sure (r6rs:fx+ x 0) isn't folded to (r6rs:fx+ x), since
 ; r6rs:fx+ doesn't accept just one argument.
  (begin
    (define $cp0-f (let ([z 0]) (lambda (x) (r6rs:fx+ x z))))
    (define $cp0-g (let ([z 0]) (lambda (x) (r6rs:fx* x 1))))
    #t)
  (eqv? ($cp0-f 17) 17)
  (eqv? ($cp0-g 17) 17)
  (error? ($cp0-f 'a))
  (error? ($cp0-g 'a))
 ; make sure cp0 isn't overeager about moving discardable but
 ; not pure primitive calls
  (and
    (member
      (let ([p (cons 1 2)])
        (list
          (let ([x (car p)]) (set-car! p 3) x)
          (let ([x (car p)]) (set-car! p 4) x)))
      '((4 1) (1 3)))
    #t)
  ; make sure cp0 doesn't screw up on an "almost" or pattern
  (error? ; #f is not a number
    (if (let ([x (eqv? (random 2) 2)]) (if x x (+ x 1))) 4 5))
   (begin
     (define f
       (lambda (x)
         (letrec ([foo (lambda (ls)
                         (let loop ([ls ls] [rls '()])
                           (if (null? ls)
                               rls
                               (loop (cdr ls) (cons (car ls) rls)))))])
           (apply foo (list x)))))
     #t)
   (equal?
     (f (list 1 2))
     '(2 1))
   (begin
     (define f
       (lambda (x)
         (letrec ([foo (lambda (x ls)
                         (let loop ([ls ls] [rls '()])
                           (if (null? ls)
                               (cons x rls)
                               (loop (cdr ls) (cons (car ls) rls)))))])
           (apply (begin (write 'a) foo) (begin (write 'b) 'bar) (begin (write 'c) (list x))))))
     #t)
   (equal?
     (f (list 1 2))
     '(bar 2 1))
   ((lambda (x ls) (and (member x ls) #t))
    (with-output-to-string (lambda () (f (list 1 2))))
    '("abc" "acb" "bac" "bca" "cab" "cba"))
   (begin
     (define $x 17)
     #t)
   ((lambda (x ls) (and (member x ls) #t))
    (with-output-to-string
      (lambda ()
        (apply
          (begin (write 'a) member)
          (begin (write 'b) $x)
          (begin (write 'c) (list (begin (write 'd) '()))))))
    '("abcd" "acdb" "bacd" "bcda" "cdab" "cdba"))
   ((lambda (x ls) (and (member x ls) #t))
    (with-output-to-string
      (lambda ()
        (apply
          (begin (write 'a) ash)
          (begin (write 'b) $x)
          (begin (write 'c) (list (begin (write 'd) 0))))))
    '("abcd" "acdb" "bacd" "bcda" "cdab" "cdba"))
   ; check to see if this turns up a missing referenced flag due to an extra
   ; binding for p.  (missing referenced flags are presently detected only when
   ; cpletrec is compiled with d=k, k > 0.)
   (equal?
     (apply (let ([p (box 0)]) (lambda () p)) '())
     '#&0)
   ; check for some corrected flags
   (not (and (record-type-parent #!base-rtd) #t))
   (error? ; invalid report specifier
     (begin
       (null-environment #f)
       #t))
   (error? ; not a source object
     (begin
       (source-object-bfp #f)
       #t))
   (error? ; not a source object
     (begin
       (source-object-efp #f)
       #t))
   (error? ; not a source object
     (begin
       (source-object-sfd #f)
       #t))
   (error? ; not a condition
     (begin
       (condition #f)
       #t))
   ; nested if optimization
   (begin
     (define $cp0-f
       (lambda (x y a b c)
         (if (if (if (if (#3%zero? (a)) #f #t) (begin (b) #t) #f)
                 (c)
                 #f)
             (x)
             (y))))
     #t)
   (equal?
     (with-output-to-string
       (lambda ()
         ($cp0-f
           (lambda () (printf "x\n"))
           (lambda () (printf "y\n"))
           (lambda () (printf "a\n") 0)
           (lambda () (printf "b\n"))
           (lambda () (printf "c\n") #t))))
     "a\ny\n")
   (equivalent-expansion?
     (expand/optimize
       '(lambda (x y a b c)
          (if (if (if (if (#3%zero? (a)) #f #t) (begin (b) #t) #f)
                  (c)
                  #f)
              (x)
              (y))))
     '(lambda (x y a b c)
        (if (if (#3%zero? (a))
                #f
                (begin (b) (c)))
            (x)
            (y))))
   (equivalent-expansion?
     (expand/optimize
       '(lambda (x y a b c)
          (if (if (if (not (#3%zero? (a))) (begin (b) #t) #f)
                  (c)
                  #f)
              (x)
              (y))))
     '(lambda (x y a b c)
        (if (if (#3%zero? (a))
                #f
                (begin (b) (c)))
            (x)
            (y))))
  (error? (apply zero? 0))
  (error? (if (apply eof-object 1 2) 3 4))
)

(cp0-mat cp0-mrvs
  (eqv? (call-with-values (lambda () (values 1 2 3)) +) 6)
  (begin
    (define **cwv-test
      (lambda (out p)
        (define x '())
        (define pp (lambda (a) (set! x (cons a x))))
        (and (p pp)
             (if (procedure? out)
                 (out (reverse x))
                 (equal? (reverse x) out)))))
    (**cwv-test '(1 2 2 3)
      (lambda (pretty-print)
        (pretty-print 1)
        (pretty-print 2)
        (pretty-print 2)
        (pretty-print 3)
        #t)))
  (**cwv-test '(1 1 2 3)
    (lambda (pretty-print)
      (equal?
        (call-with-values
          (begin
            (pretty-print 1)
            (lambda () (pretty-print 2) (+ 1 2 3)))
          (begin
            (pretty-print 1)
            (lambda (n) (pretty-print 3) (list n n n))))
        '(6 6 6))))
  (**cwv-test '(1 1 2 3)
    (lambda (pretty-print)
      (eqv?
        (call-with-values
          (begin
            (pretty-print '1)
            (lambda () (pretty-print '2) (values 1 2 3)))
          (begin
            (pretty-print '1)
            (lambda (a b c) (pretty-print '3) (+ c b a))))
        6)))
  (**cwv-test '(1 1 2 3 4)
    (lambda (pretty-print)
      (eqv?
        (call-with-values
          (begin
            (pretty-print '1)
            (lambda ()
              (pretty-print '2)
              (values 1 (begin (pretty-print '3) 2) 3)))
          (begin
            (pretty-print '1)
            (lambda (a b c) (pretty-print '4) (+ c b a))))
        6)))
  (begin
    (define **foo (lambda () (values 'a 'b 'c)))
    (define **bar vector)
    (equal? (call-with-values **foo **bar) '#(a b c)))
  (equal?
    (call-with-values
      (lambda () (values 1 2 3))
      (case-lambda [(x) (list x x x)] [(a b c) (list c b a)]))
    '(3 2 1))
  (equal? (call-with-values (lambda () (values 1 2 3)) **bar) '#(1 2 3))
  (**cwv-test '(1 2)
    (lambda (pretty-print)
      (equal?
        (call-with-values
          (lambda () (pretty-print '2) (values 1 2 3))
          (begin (pretty-print '1) **bar))
        '#(1 2 3))))
  (**cwv-test '(1 1 2)
    (lambda (pretty-print)
      (equal?
        (call-with-values
          (begin
            (pretty-print '1)
            (lambda () (pretty-print '2) (values 1 2 3)))
          (begin (pretty-print '1) **bar))
        '#(1 2 3))))
  (equal? (call-with-values **foo (lambda (a b c) (list c b a))) '(c b a))
  (equal? (let ((f (lambda (a b c) (list c b a))))
            (call-with-values **foo f))
    '(c b a))
  (**cwv-test '(1)
    (lambda (pretty-print)
      (equal? (call-with-values
                **foo
                (begin
                  (pretty-print '1)
                  (lambda (a b c) (vector c b a))))
        '#(c b a))))
  (**cwv-test (lambda (x) (or (equal? x '(1 2 3)) (equal? x '(2 3 4))))
    (lambda (pretty-print)
      (define n 1)
      (define boof
        (lambda ()
          (pretty-print 3)
          (lambda (a b c) (list c b a))))
      (equal?
        (call-with-values
          (begin (pretty-print n) **foo)
          (begin (set! n 4) (pretty-print 2) (boof)))
        '(c b a))))
  (**cwv-test '(1 2 3)
    (lambda (pretty-print)
      (define n 1)
      (define boof
        (lambda ()
          (pretty-print 3)
          (lambda (a b c) (list c b a))))
      (equal?
        (let* ((prod (begin (pretty-print n) **foo))
               (csmr (begin (set! n 4) (pretty-print 2) (boof))))
          (call-with-values prod csmr))
        '(c b a))))
  (**cwv-test '(2 3 4)
    (lambda (pretty-print)
      (define n 1)
      (define boof
        (lambda ()
          (pretty-print 3)
          (lambda (a b c) (list c b a))))
      (equal?
        (let* ((csmr (begin (set! n 4) (pretty-print 2) (boof)))
               (prod (begin (pretty-print n) **foo)))
          (call-with-values prod csmr))
        '(c b a))))
  (**cwv-test '(1 1)
    (lambda (pretty-print)
      (equal?
        (call-with-values
          (begin
            (pretty-print '1)
            **foo)
          (begin
            (pretty-print '1)
            (lambda (a b c) (list c b a))))
        '(c b a))))
  (begin
    (set! **a #t)
    (equal?
      (call-with-values
        (lambda () (if **a (values 1) (values 1 2 3)))
        (case-lambda [(x) (list x x x)] [(a b c) (list c b a)]))
      '(1 1 1)))
  (begin
    (set! **a #f)
    (equal?
      (call-with-values
        (lambda () (if **a (values 1) (values 1 2 3)))
        (case-lambda [(x) (list x x x)] [(a b c) (list c b a)]))
      '(3 2 1)))
  (begin
    (set! **a #t)
    (equal?
      (let ((f (lambda (a) (if **a (values 1) (values 1 2 3)))))
        (call-with-values
          (lambda () (f #t))
          (case-lambda [(x) (list x x x)] [(a b c) (list c b a)])))
      '(1 1 1)))
  (begin
    (set! **a #f)
    (equal?
      (let ((f (lambda (a) (if **a (values 1) (values 1 2 3)))))
        (call-with-values
          (lambda () (f #t))
          (case-lambda [(x) (list x x x)] [(a b c) (list c b a)])))
      '(3 2 1)))
  (equal?
    (call-with-values
      (lambda ()
        (define foo
          (lambda (x)
            (if (zero? x)
                (values 1 2 3)
                (call-with-values
                  (lambda () (foo (- x 1)))
                  (lambda (a b c)
                    (values (+ a 1) (+ b a) (+ c 2)))))))
        (call-with-values
          (lambda () (foo 0))
          (lambda (a b c)
            (foo (+ a b c)))))
      list)
    '(7 23 15))
  (equal?
    (let ((f (lambda ()
               (let loop ((n 10))
                 (if (zero? n)
                     call-with-values
                     (loop (fx- n 1)))))))
      ((f) (lambda () (values 1 2)) cons))
    '(1 . 2))
  (equal?
    (let ()
      (define (go n)
        (let ((f (lambda ()
                   (let loop ((n n))
                     (if (zero? n)
                         call-with-values
                         (loop (fx- n 1)))))))
          ((f) (lambda () (values 1 2)) cons)))
      (go 1000))
    '(1 . 2))
  (begin
    (define **bozo
      (lambda (pretty-print)
        (pretty-print '3)
        (lambda x
          (pretty-print 6)
          x)))
    (define **clown (lambda () (values 1 2 3)))
    (**cwv-test '(3 6)
      (lambda (pretty-print)
        (equal?
          (call-with-values **clown (**bozo pretty-print))
          '(1 2 3)))))
  (**cwv-test '(1 2)
    (lambda (pretty-print)
      (equal?
        (let ((f (lambda () (pretty-print '2) (values 1 2 3))))
          (call-with-values
            (begin (pretty-print '1) f)
            (lambda x x)))
        '(1 2 3))))
  (**cwv-test '(1 2)
    (lambda (pretty-print)
      (equal?
        (let ((f (lambda () (pretty-print '2) (**foo))))
          (call-with-values
            (begin (pretty-print '1) f)
            (lambda x x)))
        '(a b c))))
  (**cwv-test '(1 2 3 4)
    (lambda (pretty-print)
      (equal?
        (let ([f
               (lambda ()
                 (pretty-print '2)
                 (lambda () (pretty-print '3) (**foo)))])
          (call-with-values
            (begin (pretty-print '1) (f))
            (lambda x (pretty-print 4) x)))
        '(a b c))))
  (**cwv-test '(1)
    (lambda (pretty-print)
      (equal?
        (call-with-values
          (begin (pretty-print '1) (lambda () (**foo)))
          (lambda (x y z) (list y z x)))
        '(b c a))))
  (procedure?
    (lambda ()
      (define test1 (lambda () void))
      (define test2
        (lambda ()
          (call-with-values test1 (lambda (tester) (tester)))))
      (test2)))
  (eqv?
    (let ()
      (define test1 (lambda (x) (values (lambda () (+ x 1)))))
      (define test2
        (lambda (x)
          (let-values ([(tester) (test1 x)])
            (tester))))
      (test2 10))
    11)
  (test-cp0-expansion
    '(lambda (x)
       (call-with-values (lambda () (unbox x)) display))
    (if (eqv? (optimize-level) 3)
        '(lambda (x) (#3%display (#3%unbox x)))
        '(lambda (x) (#2%display (#2%unbox x)))))
  (test-cp0-expansion
    '(lambda (x)
       (call-with-values (lambda () (if x 1 2)) display))
    (if (eqv? (optimize-level) 3)
        '(lambda (x) (#3%display (if x 1 2)))
        '(lambda (x) (#2%display (if x 1 2)))))
  ; verify optimization of begin0 pattern
  (test-cp0-expansion
    '(lambda (x)
       (call-with-values (lambda ()
                           (call-with-values (lambda () (unbox x))
                             (case-lambda
                               [(x) (values x #f)]
                               [args (values args #t)])))
         (lambda (l apply?)
           (newline)
           (if apply?
               (apply values l)
               l))))
    (if (eqv? (optimize-level) 3)
        '(lambda (x)
           (let ([temp (#3%unbox x)])
             (#3%newline)
             temp))
        '(lambda (x)
           (let ([temp (#2%unbox x)])
             (#2%newline)
             temp))))
)

(cp0-mat apply-partial-folding
  (test-cp0-expansion
    '(apply fx+ '(1 2 3 4 5))
    15)
  (test-cp0-expansion
    '(apply fx+ 3 x 4 '(5 7 9))
    (if (eqv? (optimize-level) 3)
        '(#3%fx+ 28 x)
        '(#2%fx+ 28 x)))
  (test-cp0-expansion
    '(apply fx+ 3 x 4 (begin (write 'hi) '(5 7 9)))
    (if (eqv? (optimize-level) 3)
        '(let ([g x]) (#3%write 'hi) (#3%fx+ 28 g))
        '(let ([g x]) (#2%write 'hi) (#2%fx+ 28 g))))
  (test-cp0-expansion
    '(apply fx+ 3 x 4 '(5 7 9.0))
    (if (eqv? (optimize-level) 3)
        '(#3%fx+ 19 x 9.0)
        '(#2%fx+ 19 x 9.0)))
  (test-cp0-expansion
    `(apply apply '(,list 2 3 (4 5 6)))
    `(',list 2 3 4 5 6))
  (test-cp0-expansion
    `(#3%apply #3%apply #3%+ '(1 (2 3 4)))
    10)
  (test-cp0-expansion
    `(apply apply apply + 1 '(2 3 (4 5 (6 7))))
    28)
  (test-cp0-expansion
    `(let ([f apply]) (f f f * 1 '(2 3 (4 5 (6)))))
    720)
  (test-cp0-expansion
   `(lambda (x) (apply (lambda (prim ls) (apply prim ls)) zero? (list x)))
   (if (eqv? (optimize-level) 3)
       '(lambda (x) (#3%apply #3%zero? x))
       '(lambda (x) (#2%apply #2%zero? x))))
  (test-cp0-expansion
   `(apply (lambda (prim ls) (apply prim ls)) zero? (list (cons 0 '())))
   #t)
  (test-cp0-expansion
   `(apply (lambda (prim ls) (apply prim ls)) zero? (cons 0 '()))
   (if (eqv? (optimize-level) 3)
       '(#3%apply #3%zero? 0)
       '(#2%apply #2%zero? 0)))
)

(mat expand/optimize
  (error? (expand/optimize))
  (error? (expand/optimize 'a 'b))
  (error? (expand/optimize 'a 'b 'c))
  (eqv? (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))])
          (expand/optimize 3))
        3)
  (equal? (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))])
            (expand/optimize '(#2%cdr '(3 4))))
          ''(4))
  (eqv? (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2])
          (expand/optimize ; from cp0 talk
            '(let ([n (expt 2 10)])
               (define even?
                 (lambda (x) (or (zero? x) (not (odd? x)))))
               (define odd?
                 (lambda (x) (not (even? (- x 1)))))
               (define f
                 (lambda (x)
                   (lambda (y)
                     (lambda (z)
                       (if (= z 0) (omega) (+ x y z))))))
               (define omega
                 (lambda ()
                   ((lambda (x) (x x)) (lambda (x) (x x)))))
               (let ([g (f 1)] [m (f n)])
                 (let ([h
                        (if (> ((g 2) 3) 5)
                            (lambda (x) (+ x 1))
                            odd?)])
                   (h n))))))
        1025)
  (let ([x (parameterize ([#%$suppress-primitive-inlining #f]
                          [run-cp0 (lambda (cp0 x) (cp0 x))]
                          [optimize-level 3])
             (expand/optimize ; from mwbor talk
               '(let ()
                  (import scheme)
                  (define opcode-pos 27)
                  (define src1-pos 22)
                  (define src2-pos 0)
                  (define dst-pos 17)
                  (define imm-bit (ash 1 16))
                  (define regops '((ld . 22) (add . 28)))
                  (define immops '((addi . 28)))
                  (define regcodes
                    '((r0 . 0) (r1 . 1) (r2 . 2) (r3 . 3)))
                  (define-syntax reg
                    (syntax-rules ()
                      [(_ r) (cdr (assq 'r regcodes))]))
                  (define imm
                    (lambda (n)
                      (unless (< -32768 n 32767)
                        (errorf 'imm "invalid immediate ~s" n))
                      n))
                  (define $emit!
                    (lambda (op a1 a2 a3)
                      (emit-word!
                        (+ (cond
                             [(assq op regops) =>
                              (lambda (a)
                                (ash (cdr a) opcode-pos))]
                             [(assq op immops) =>
                              (lambda (a)
                                (+ (ash (cdr a) opcode-pos)
                                   imm-bit))]
                             [else
                              (errorf 'emit
                                "unrecognized operator ~s"
                                op)])
                           (ash a1 src1-pos)
                           (ash a2 src2-pos)
                           (ash a3 dst-pos)))))
                  (define-syntax emit
                    (syntax-rules ()
                      [(_ op a1 a2 a3) ($emit! 'op a1 a2 a3)]))
                  (set! test
                    (lambda (r)
                      (emit ld (reg r0) (reg r1) (reg r2))
                      (emit addi (reg r2) 320 (reg r2))
                      (emit add (reg r2) r (reg r2)))))))])
    (and
      (equivalent-expansion? x
        '(set! test
           (lambda (r)
             (emit-word! 2953052161)
             (emit-word! 3766812992)
             (emit-word! (#3%+ 3766747136 r)))))
      (syntax-case x ()
        [(set! test
           (lambda (r1)
             (ew1! 2953052161)
             (ew2! 3766812992)
             (ew3! (#3%+ 3766747136 r2))))
         (eq? #'r1 #'r2)])))
  (let ([x (parameterize ([#%$suppress-primitive-inlining #f]
                          [run-cp0 (lambda (cp0 x) (cp0 x))]
                          [optimize-level 2])
             (expand/optimize ; from mwbor talk
               '(let ()
                  (import scheme)
                  (define opcode-pos 27)
                  (define src1-pos 22)
                  (define src2-pos 0)
                  (define dst-pos 17)
                  (define imm-bit (ash 1 16))
                  (define regops '((ld . 22) (add . 28)))
                  (define immops '((addi . 28)))
                  (define regcodes
                    '((r0 . 0) (r1 . 1) (r2 . 2) (r3 . 3)))
                  (define-syntax reg
                    (syntax-rules ()
                      [(_ r) (cdr (assq 'r regcodes))]))
                  (define imm
                    (lambda (n)
                      (unless (< -32768 n 32767)
                        (errorf 'imm "invalid immediate ~s" n))
                      n))
                  (define $emit!
                    (lambda (op a1 a2 a3)
                      (emit-word!
                        (+ (cond
                             [(assq op regops) =>
                              (lambda (a)
                                (ash (cdr a) opcode-pos))]
                             [(assq op immops) =>
                              (lambda (a)
                                (+ (ash (cdr a) opcode-pos)
                                   imm-bit))]
                             [else
                              (errorf 'emit
                                "unrecognized operator ~s"
                                op)])
                           (ash a1 src1-pos)
                           (ash a2 src2-pos)
                           (ash a3 dst-pos)))))
                  (define-syntax emit
                    (syntax-rules ()
                      [(_ op a1 a2 a3) ($emit! 'op a1 a2 a3)]))
                  (set! test
                    (lambda (r)
                      (emit ld (reg r0) (reg r1) (reg r2))
                      (emit addi (reg r2) 320 (reg r2))
                      (emit add (reg r2) r (reg r2)))))))])
    (and
      (equivalent-expansion? x
        '(set! test
           (lambda (r)
             (emit-word! 2953052161)
             (emit-word! 3766812992)
             (emit-word! (#3%+ 3766747136 (#2%ash r 0))))))
      (syntax-case x ($primitive)
        [(set! test
           (lambda (r1)
             (ew1! 2953052161)
             (ew2! 3766812992)
             (ew3! (#3%+ 3766747136 (#2%ash r2 0)))))
         (eq? #'r1 #'r2)])))
 ; verify optimization of (if e s s) => (begin e s)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2] [compile-profile #f])
      (expand/optimize
        '(lambda (x) (if e x x))))
    '(lambda (x) e x))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2] [compile-profile #f])
      (expand/optimize
        '(lambda (y x) (if y x x))))
    '(lambda (y x) x))
 ; verify optimization of (if s s #f) => s
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2] [compile-profile #f])
      (expand/optimize
        '(lambda (x) (if x x #f))))
    '(lambda (x) x))
 ; verify optimization of (if s s #f) => s
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2] [compile-profile #f])
      (expand/optimize
        '(let ()
           (define-syntax broken-or
             (syntax-rules ()
               [(_) #f]
               [(_ x y ...)
                (let ([t x])
                  (if t t (broken-or y ...)))]))
           (broken-or a))))
    'a)
 ; verify optimization of or pattern
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2] [compile-profile #f])
      (expand/optimize
        '(lambda (x y) (if (not (or (fx< x y) (fx> y x))) x y))))
    '(lambda (x.0 y.1)
       (if (if (#2%fx< x.0 y.1) #t (#3%fx> y.1 x.0))
           y.1
           x.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2] [compile-profile #f])
      (expand/optimize
        '(lambda (x y) (if (or (fx< x y) (fx> y x)) x y))))
    '(lambda (x y) (if (if (#2%fx< x y) #t (#3%fx> y x)) x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        '(let ([q #f])
           (lambda (x y) (if (or q (fx> x y)) x y)))))
    '(lambda (x y) (if (#2%fx> x y) x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        '(let ([q #t])
           (lambda (x y) (if (or q (fx> x y)) x y)))))
    '(lambda (x y) x))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        '(begin 3 4)))
    4)
  ; verify expansion of not pattern
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        `(not #t)))
    #f)
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        `(not #f)))
    #t)
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        `(not '(a b c))))
    #f)
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        `(let ([x 2] [y 3])
           (not (begin (set! x (* x y)) (set! y (* x y)) 10)))))
    `(let ([x 2] [y 3])
       (set! x (#2%* x y))
       (set! y (#2%* x y))
       #f))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        `(not (let ([x 2] [y 3]) (set! x (* x y)) (set! y (* x y)) 10))))
    `(let ([x 2])
       (let ([y 3])
         (set! x (#2%* x y))
         (set! y (#2%* x y))
         #f)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        `(if (not (or #t (futz))) 17 32)))
    32)
)

(mat expand-output
  (error? ; not a textual output port or #f
    (expand-output #t))
  (error?  ; not a textual output port or #f
    (let-values ([(bop get) (open-bytevector-output-port)])
      (expand-output bop)))
  (begin
    (define $eospam 17)
    #t)
  (equal?
    (with-output-to-string
      (lambda ()
        (parameterize ([expand-output (current-output-port)] [#%$suppress-primitive-inlining #f])
          (pretty-print (compile '(let () (import (chezscheme)) (+ 3 4 $eospam)))))))
    (if (eqv? (optimize-level) 3)
        "(#3%+ 3 4 $eospam)\n24\n"
        "(#2%+ 3 4 $eospam)\n24\n"))
  (equal?
    (with-output-to-string
      (lambda ()
        (parameterize ([expand-output (current-output-port)] [#%$suppress-primitive-inlining #f])
          (pretty-print (interpret '(let () (import (chezscheme)) (+ 3 4 $eospam)))))))
    (if (eqv? (optimize-level) 3)
        "(#3%+ 3 4 $eospam)\n24\n"
        "(#2%+ 3 4 $eospam)\n24\n"))
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print '(eval-when (visit revisit) (define $eo-q (* 2 2))))
        (pretty-print '(define $eo-x 3))
        (pretty-print '(define-syntax $eo-a (identifier-syntax 5)))
        (pretty-print '(pretty-print (vector $eo-x $eo-q (+ $eo-a 1)))))
      'replace)
    #t)
  (begin
    (define $eo-sop
      (let ()
        (define syntax-record-writer
          (case-lambda
            [() (record-writer (record-rtd #'a))]
            [(x) (record-writer (record-rtd #'a) x)]))
        (open-input-string
          (with-output-to-string
            (lambda ()
              (parameterize ([expand-output (current-output-port)]
                             [print-gensym #t]
                             [optimize-level 2]
                             [compile-file-message #f]
                             [enable-cp0 #t]
                             [#%$suppress-primitive-inlining #f]
                             [syntax-record-writer (lambda (x p wr) (display "syntax-object" p))])
                (compile-file "testfile")))))))
    #t)
  (equivalent-expansion?
    (read $eo-sop)
    `(begin
       (recompile-requirements () ())
       (begin
         (set! $eo-q (#2%* 2 2))
         (#3%$sc-put-cte
           'syntax-object
           '(global . ,gensym?)
           '*top*))))
  (equivalent-expansion?
    (read $eo-sop)
    `(begin
       (recompile-requirements () ())
       (eval-when (revisit)
         (set! $eo-x 3))
       (eval-when (visit)
         (#3%$sc-put-cte
           'syntax-object
           '(global . ,gensym?)
           '*top*))))
  (equivalent-expansion?
    (read $eo-sop)
    `(begin
       (recompile-requirements () ())
       (eval-when (visit)
         (#3%$sc-put-cte
           'syntax-object
           ,list?
           '*top*))))
  (equivalent-expansion?
    (read $eo-sop)
    `(begin
       (recompile-requirements () ())
       (eval-when (revisit)
         (#2%pretty-print (#2%vector $eo-x $eo-q (#2%+ 5 1))))))
  (begin (set! $eo-sop #f) #t)
)

(mat expand/optimize-output
  (error? ; not a textual output port or #f
    (expand/optimize-output #t))
  (error?  ; not a textual output port or #f
    (let-values ([(bop get) (open-bytevector-output-port)])
      (expand/optimize-output bop)))
  (equal?
    (with-output-to-string
      (lambda ()
        (parameterize ([expand/optimize-output (current-output-port)]
                       [enable-cp0 #t]
                       [#%$suppress-primitive-inlining #f])
          (pretty-print (compile '(let () (import (chezscheme)) (+ 3 4 $eospam)))))))
    (if (eqv? (optimize-level) 3)
        "(#3%+ 7 $eospam)\n24\n"
        "(#2%+ 7 $eospam)\n24\n"))
  (equal?
    (with-output-to-string
      (lambda ()
        (parameterize ([expand/optimize-output (current-output-port)]
                       [enable-cp0 #t]
                       [#%$suppress-primitive-inlining #f])
          (pretty-print (interpret '(let () (import (chezscheme)) (+ 3 4 $eospam)))))))
    (if (eqv? (optimize-level) 3)
        "(#3%+ 7 $eospam)\n24\n"
        "(#2%+ 7 $eospam)\n24\n"))
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print '(eval-when (visit revisit) (define $eo-q (* 2 2))))
        (pretty-print '(define $eo-x 3))
        (pretty-print '(define-syntax $eo-a (identifier-syntax 5)))
        (pretty-print '(pretty-print (vector $eo-x $eo-q (+ $eo-a 1)))))
      'replace)
    #t)
  (begin
    (define $eo-sop
      (let ()
        (define syntax-record-writer
          (case-lambda
            [() (record-writer (record-rtd #'a))]
            [(x) (record-writer (record-rtd #'a) x)]))
        (open-input-string
          (with-output-to-string
            (lambda ()
              (parameterize ([expand/optimize-output (current-output-port)]
                             [print-gensym #t]
                             [optimize-level 2]
                             [compile-file-message #f]
                             [enable-cp0 #t]
                             [#%$suppress-primitive-inlining #f]
                             [syntax-record-writer (lambda (x p wr) (display "syntax-object" p))])
                (compile-file "testfile")))))))
    #t)
  (equivalent-expansion?
    (read $eo-sop)
    `(begin
       (recompile-requirements () ())
       (begin
         (set! $eo-q 4)
         (#3%$sc-put-cte
           'syntax-object
           '(global . ,gensym?)
           '*top*))))
  (equivalent-expansion?
    (read $eo-sop)
    `(begin
       (recompile-requirements () ())
       (eval-when (revisit)
         (set! $eo-x 3))
       (eval-when (visit)
         (#3%$sc-put-cte
           'syntax-object
           '(global . ,gensym?)
           '*top*))))
  (equivalent-expansion?
    (read $eo-sop)
    `(begin
       (recompile-requirements () ())
       (eval-when (visit)
         (#3%$sc-put-cte
           'syntax-object
           ,list?
           '*top*))))
  (equivalent-expansion?
    (read $eo-sop)
    `(begin
       (recompile-requirements () ())
       (eval-when (revisit)
         (#2%pretty-print (#2%vector $eo-x $eo-q 6)))))
  (begin (set! $eo-sop #f) #t)
)

(mat cp0-partial-folding
 ; check partial folding of +, fx+, fl+, and cfl+
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] 
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (+) (+ 3) (+ 3 4) (+ x) (+ x 0) (+ 0 x) (+ x 3)
           (+ x 3 4) (+ 3 x 4) (+ 3 x -3) (+ 3 x 4 y 5)
           (+ +nan.0 x 4 y 5))))
    '(#2%list 0 3 7 (#2%+ x) (#2%+ x) (#2%+ x) (#2%+ 3 x)
       (#2%+ 7 x) (#2%+ 7 x) (#2%+ x) (#2%+ 12 x y)
       (begin (#2%+ x y) +nan.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (+) (+ 3) (+ 3 4) (+ x) (+ x 0) (+ 0 x) (+ x 3)
           (+ x 3 4) (+ 3 x 4) (+ 3 x -3) (+ 3 x 4 y 5)
           (+ +nan.0 x 4 y 5))))
    '(#3%list 0 3 7 x x x (#3%+ 3 x)
       (#3%+ 7 x) (#3%+ 7 x) x (#3%+ 12 x y)
       +nan.0))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fx+) (fx+ 3) (fx+ 3 4) (fx+ x) (fx+ x 0) (fx+ 0 x) (fx+ x 3)
           (fx+ x 3 4) (fx+ 3 x 4) (fx+ 3 x -3) (fx+ 3 x 4 y 5))))
    '(#2%list 0 3 7 (#2%fx+ x) (#2%fx+ x) (#2%fx+ x) (#2%fx+ 3 x)
       (#2%fx+ 7 x) (#2%fx+ 7 x) (#2%fx+ x) (#2%fx+ 12 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fx+) (fx+ 3) (fx+ 3 4) (fx+ x) (fx+ x 0) (fx+ 0 x) (fx+ x 3)
           (fx+ x 3 4) (fx+ 3 x 4) (fx+ 3 x -3) (fx+ 3 x 4 y 5))))
    '(#3%list 0 3 7 x x x (#3%fx+ 3 x)
       (#3%fx+ 7 x) (#3%fx+ 7 x) x (#3%fx+ 12 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fl+) (fl+ 3.0) (fl+ 3.0 4.0) (fl+ x) (fl+ x 0.0) (fl+ x -0.0) (fl+ 0.0 x) (fl+ -0.0 x) (fl+ x 3.0)
           (fl+ x 3.0 4.0) (fl+ 3.0 x 4.0) (fl+ 3.0 x -3.0) (fl+ (truncate -.5) x (/ -inf.0)) (fl+ 3.0 x 4.0 y 5.0)
           (fl+ 3.0 x +nan.0 y 5.0))))
    '(#2%list 0.0 3.0 7.0 (#2%fl+ x) (#2%fl+ 0.0 x) (#2%fl+ x) (#2%fl+ 0.0 x) (#2%fl+ x) (#2%fl+ 3.0 x)
       (#2%fl+ 7.0 x) (#2%fl+ 7.0 x) (#2%fl+ 0.0 x) (#2%fl+ x) (#2%fl+ 12.0 x y)
       (begin (#2%fl+ x y) +nan.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fl+) (fl+ 3.0) (fl+ 3.0 4.0) (fl+ x) (fl+ x 0.0) (fl+ x -0.0) (fl+ 0.0 x) (fl+ -0.0 x) (fl+ x 3.0)
           (fl+ x 3.0 4.0) (fl+ 3.0 x 4.0) (fl+ 3.0 x -3.0) (fl+ (truncate -.5) x (/ -inf.0)) (fl+ 3.0 x 4.0 y 5.0)
           (fl+ 3.0 x +nan.0 y 5.0))))
    '(#3%list 0.0 3.0 7.0 x (#3%fl+ 0.0 x) x (#3%fl+ 0.0 x) x (#3%fl+ 3.0 x)
       (#3%fl+ 7.0 x) (#3%fl+ 7.0 x) (#3%fl+ 0.0 x) x (#3%fl+ 12.0 x y)
       +nan.0))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (cfl+) (cfl+ 3.0) (cfl+ 3.0 4.0) (cfl+ x) (cfl+ x 0.0) (cfl+ x -0.0) (cfl+ 0.0 x) (cfl+ -0.0 x) (cfl+ x 3.0)
           (cfl+ x 3.0 4.0) (cfl+ 3.0 x 4.0) (cfl+ 3.0 x -3.0) (cfl+ (truncate -.5) x (/ -inf.0)) (cfl+ 3.0 x 4.0 y 5.0)
           (cfl+ 3.0 x +nan.0+nan.0i y 5.0))))
    '(#2%list 0.0 3.0 7.0 (#2%cfl+ x) (#2%cfl+ 0.0 x) (#2%cfl+ x) (#2%cfl+ 0.0 x) (#2%cfl+ x) (#2%cfl+ 3.0 x)
       (#2%cfl+ 7.0 x) (#2%cfl+ 7.0 x) (#2%cfl+ 0.0 x) (#2%cfl+ x) (#2%cfl+ 12.0 x y)
       (begin (#2%cfl+ x y) +nan.0+nan.0i)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (cfl+) (cfl+ 3.0) (cfl+ 3.0 4.0) (cfl+ x) (cfl+ x 0.0) (cfl+ x -0.0) (cfl+ 0.0 x) (cfl+ -0.0 x) (cfl+ x 3.0)
           (cfl+ x 3.0 4.0) (cfl+ 3.0 x 4.0) (cfl+ 3.0 x -3.0) (cfl+ (truncate -.5) x (/ -inf.0)) (cfl+ 3.0 x 4.0 y 5.0)
           (cfl+ 3.0 x +nan.0+nan.0i y 5.0))))
    '(#3%list 0.0 3.0 7.0 x (#3%cfl+ 0.0 x) x (#3%cfl+ 0.0 x) x (#3%cfl+ 3.0 x)
       (#3%cfl+ 7.0 x) (#3%cfl+ 7.0 x) (#3%cfl+ 0.0 x) x (#3%cfl+ 12.0 x y)
       +nan.0+nan.0i))

 ; check partial folding of *, fx*, fl*, and cfl*
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (*) (* 3) (* 3 4) (* x) (* x 1) (* 1 x) (* x 3)
           (* x 3 4) (* 3 x 4) (* 3 x 1/3) (* 3 x 4 y 5)
           (* 3 x 0 y 5))))
    '(#2%list 1 3 12 (#2%* x) (#2%* x) (#2%* x) (#2%* 3 x)
       (#2%* 12 x) (#2%* 12 x) (#2%* x) (#2%* 60 x y)
       (begin (#2%* x y) 0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (*) (* 3) (* 3 4) (* x) (* x 1) (* 1 x) (* x 3)
           (* x 3 4) (* 3 x 4) (* 3 x 1/3) (* 3 x 4 y 5)
           (* 3 x 0 y 5))))
    '(#3%list 1 3 12 x x x (#3%* 3 x)
       (#3%* 12 x) (#3%* 12 x) x (#3%* 60 x y)
       0))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fx*) (fx* 3) (fx* 3 4) (fx* x) (fx* x 1) (fx* 1 x) (fx* x 3)
           (fx* x 3 4) (fx* 3 x 4) (fx* 1 x 1) (fx* 3 x 4 y 5)
           (fx* 3 x 0 y 5))))
    '(#2%list 1 3 12 (#2%fx* x) (#2%fx* x) (#2%fx* x) (#2%fx* 3 x)
       (#2%fx* 12 x) (#2%fx* 12 x) (#2%fx* x) (#2%fx* 60 x y)
       (begin (#2%fx* x y) 0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fx*) (fx* 3) (fx* 3 4) (fx* x) (fx* x 1) (fx* 1 x) (fx* x 3)
           (fx* x 3 4) (fx* 3 x 4) (fx* 1 x 1) (fx* 3 x 4 y 5)
           (fx* 3 x 0 y 5))))
    '(#3%list 1 3 12 x x x (#3%fx* 3 x)
       (#3%fx* 12 x) (#3%fx* 12 x) x (#3%fx* 60 x y)
       0))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fl*) (fl* 3.0) (fl* 3.0 4.0) (fl* x) (fl* x 1.0) (fl* 1.0 x) (fl* x 3.0)
           (fl* x 3.0 4.0) (fl* 3.0 x 4.0) (fl* 3.0 x #i1/3) (fl* 3.0 x 4.0 y 5.0)
           (fl* 3.0 x 4.0 y +nan.0))))
    '(#2%list 1.0 3.0 12.0 (#2%fl* x) (#2%fl* x) (#2%fl* x) (#2%fl* 3.0 x)
       (#2%fl* 12.0 x) (#2%fl* 12.0 x) (#2%fl* x) (#2%fl* 60.0 x y)
       (begin (#2%fl* x y) +nan.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fl*) (fl* 3.0) (fl* 3.0 4.0) (fl* x) (fl* x 1.0) (fl* 1.0 x) (fl* x 3.0)
           (fl* x 3.0 4.0) (fl* 3.0 x 4.0) (fl* 3.0 x #i1/3) (fl* 3.0 x 4.0 y 5.0)
           (fl* 3.0 x 4.0 y +nan.0))))
    '(#3%list 1.0 3.0 12.0 x x x (#3%fl* 3.0 x)
       (#3%fl* 12.0 x) (#3%fl* 12.0 x) x (#3%fl* 60.0 x y)
       +nan.0))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (cfl*) (cfl* 3.0) (cfl* 3.0 4.0) (cfl* x) (cfl* x 1.0) (cfl* 1.0 x) (cfl* x 3.0)
           (cfl* x 3.0 4.0) (cfl* 3.0 x 4.0) (cfl* 3.0 x #i1/3) (cfl* 3.0 x 4.0 y 5.0)
           (cfl* 3.0 x 4.0 y +nan.0+nan.0i))))
    '(#2%list 1.0 3.0 12.0 (#2%cfl* x) (#2%cfl* x) (#2%cfl* x) (#2%cfl* 3.0 x)
       (#2%cfl* 12.0 x) (#2%cfl* 12.0 x) (#2%cfl* x) (#2%cfl* 60.0 x y)
       (begin (#2%cfl* x y) +nan.0+nan.0i)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (cfl*) (cfl* 3.0) (cfl* 3.0 4.0) (cfl* x) (cfl* x 1.0) (cfl* 1.0 x) (cfl* x 3.0)
           (cfl* x 3.0 4.0) (cfl* 3.0 x 4.0) (cfl* 3.0 x #i1/3) (cfl* 3.0 x 4.0 y 5.0)
           (cfl* 3.0 x 4.0 y +nan.0+nan.0i))))
    '(#3%list 1.0 3.0 12.0 x x x (#3%cfl* 3.0 x)
       (#3%cfl* 12.0 x) (#3%cfl* 12.0 x) x (#3%cfl* 60.0 x y)
       +nan.0+nan.0i))

 ; check partial folding of -, fx-, fl-, and cfl-
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (- 3) (- 3 4) (- x) (- x 0) (- 0 x) (- x 3) (- x 3 4)
           (- 3 x 4) (- 3 x 3) (- x 3 -3) (- 4 x 3 -3) (- 3 x 4 y 5))))
    '(#2%list -3 -1 (#2%- x) (#2%- x 0) (#2%- x) (#2%- x 3) (#2%- x 3 4) (#2%- 3 x 4)
       (#2%- 3 x 3) (#2%- x 3 -3) (#2%- 4 x 3 -3) (#2%- 3 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (- 3) (- 3 4) (- x) (- x 0) (- 0 x) (- x 3) (- x 3 4)
           (- 3 x 4) (- 3 x 3) (- x 3 -3) (- 4 x 3 -3) (- 3 x 4 y 5))))
    '(#3%list -3 -1 (#3%- x) (#3%- x 0) (#3%- x) (#3%- x 3) (#3%- x 3 4) (#3%- 3 x 4)
       (#3%- 3 x 3) (#3%- x 3 -3) (#3%- 4 x 3 -3) (#3%- 3 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fx- 3) (fx- 3 4) (fx- x) (fx- x 0) (fx- 0 x) (fx- x 3) (fx- x 3 4)
           (fx- 3 x 4) (fx- 3 x 3) (fx- x 3 -3) (fx- 4 x 3 -3) (fx- 3 x 4 y 5))))
    '(#2%list -3 -1 (#2%fx- x) (#2%fx- x 0) (#2%fx- x) (#2%fx- x 3) (#2%fx- x 3 4) (#2%fx- 3 x 4)
       (#2%fx- 3 x 3) (#2%fx- x 3 -3) (#2%fx- 4 x 3 -3) (#2%fx- 3 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fx- 3) (fx- 3 4) (fx- x) (fx- x 0) (fx- 0 x) (fx- x 3) (fx- x 3 4)
           (fx- 3 x 4) (fx- 3 x 3) (fx- x 3 -3) (fx- 4 x 3 -3) (fx- 3 x 4 y 5))))
    '(#3%list -3 -1 (#3%fx- x) (#3%fx- x 0) (#3%fx- x) (#3%fx- x 3) (#3%fx- x 3 4) (#3%fx- 3 x 4)
       (#3%fx- 3 x 3) (#3%fx- x 3 -3) (#3%fx- 4 x 3 -3) (#3%fx- 3 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fl- 3.0) (fl- 3.0 4.0) (fl- x) (fl- x 0.0) (fl- x -0.0) (fl- 0.0 x) (fl- -0.0 x) (fl- x 3.0) (fl- x 3.0 4.0)
           (fl- 3.0 x 4.0) (fl- 3.0 x 3.0) (fl- -0.0 x 0.0) (fl- x 3.0 -3.0) (fl- x 0.0 y) (fl- x -0.0 3.0) (fl- 4.0 x 3.0 -3.0)
           (fl- 3.0 x 4.0 y 5.0))))
    '(#2%list -3.0 -1.0 (#2%fl- x) (#2%fl- x 0.0) (#2%fl- x -0.0) (#2%fl- 0.0 x) (#2%fl- x) (#2%fl- x 3.0)
       (#2%fl- x 3.0 4.0) (#2%fl- 3.0 x 4.0) (#2%fl- 3.0 x 3.0) (#2%fl- -0.0 x 0.0) (#2%fl- x 3.0 -3.0)
       (#2%fl- x 0.0 y) (#2%fl- x -0.0 3.0) (#2%fl- 4.0 x 3.0 -3.0) (#2%fl- 3.0 x 4.0 y 5.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fl- 3.0) (fl- 3.0 4.0) (fl- x) (fl- x 0.0) (fl- x -0.0) (fl- 0.0 x) (fl- -0.0 x) (fl- x 3.0) (fl- x 3.0 4.0)
           (fl- 3.0 x 4.0) (fl- 3.0 x 3.0) (fl- -0.0 x 0.0) (fl- x 3.0 -3.0) (fl- x 0.0 y) (fl- x -0.0 3.0) (fl- 4.0 x 3.0 -3.0)
           (fl- 3.0 x 4.0 y 5.0))))
    '(#3%list -3.0 -1.0 (#3%fl- x) (#3%fl- x 0.0) (#3%fl- x -0.0) (#3%fl- 0.0 x) (#3%fl- x) (#3%fl- x 3.0)
       (#3%fl- x 3.0 4.0) (#3%fl- 3.0 x 4.0) (#3%fl- 3.0 x 3.0) (#3%fl- -0.0 x 0.0) (#3%fl- x 3.0 -3.0)
       (#3%fl- x 0.0 y) (#3%fl- x -0.0 3.0) (#3%fl- 4.0 x 3.0 -3.0) (#3%fl- 3.0 x 4.0 y 5.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (cfl- 3.0) (cfl- 3.0 4.0) (cfl- x) (cfl- x 0.0) (cfl- x -0.0) (cfl- 0.0 x) (cfl- -0.0 x) (cfl- x 3.0) (cfl- x 3.0 4.0)
           (cfl- 3.0 x 4.0) (cfl- 3.0 x 3.0) (cfl- -0.0 x 0.0) (cfl- x 3.0 -3.0) (cfl- x 0.0 y) (cfl- x -0.0 3.0) (cfl- 4.0 x 3.0 -3.0)
           (cfl- 3.0 x 4.0 y 5.0))))
    '(#2%list
       -3.0 -1.0 (#2%cfl- x) (#2%cfl- x 0.0) (#2%cfl- x -0.0) (#2%cfl- 0.0 x) (#2%cfl- x) (#2%cfl- x 3.0) (#2%cfl- x 3.0 4.0)
       (#2%cfl- 3.0 x 4.0) (#2%cfl- 3.0 x 3.0) (#2%cfl- -0.0 x 0.0) (#2%cfl- x 3.0 -3.0) (#2%cfl- x 0.0 y) (#2%cfl- x -0.0 3.0) (#2%cfl- 4.0 x 3.0 -3.0)
       (#2%cfl- 3.0 x 4.0 y 5.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (cfl- 3.0) (cfl- 3.0 4.0) (cfl- x) (cfl- x 0.0) (cfl- x -0.0) (cfl- 0.0 x) (cfl- -0.0 x) (cfl- x 3.0) (cfl- x 3.0 4.0)
           (cfl- 3.0 x 4.0) (cfl- 3.0 x 3.0) (cfl- -0.0 x 0.0) (cfl- x 3.0 -3.0) (cfl- x 0.0 y) (cfl- x -0.0 3.0) (cfl- 4.0 x 3.0 -3.0)
           (cfl- 3.0 x 4.0 y 5.0))))
    '(#3%list
       -3.0 -1.0 (#3%cfl- x) (#3%cfl- x 0.0) (#3%cfl- x -0.0) (#3%cfl- 0.0 x) (#3%cfl- x) (#3%cfl- x 3.0) (#3%cfl- x 3.0 4.0)
       (#3%cfl- 3.0 x 4.0) (#3%cfl- 3.0 x 3.0) (#3%cfl- -0.0 x 0.0) (#3%cfl- x 3.0 -3.0) (#3%cfl- x 0.0 y) (#3%cfl- x -0.0 3.0) (#3%cfl- 4.0 x 3.0 -3.0)
       (#3%cfl- 3.0 x 4.0 y 5.0)))

 ; check partial folding of /, fx/, fl/, and cfl/
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (/ 3) (/ 9 4) (/ x) (/ x 1) (/ 1 x) (/ x 3) (/ x 3 4)
           (/ 9 x 4) (/ 3 x 3) (/ x 3 1/3) (/ 4 x 3 1/3) (/ 50 x 4 y 5))))
    '(#2%list
       1/3 9/4 (#2%/ x) (#2%/ x 1) (#2%/ x) (#2%/ x 3) (#2%/ x 3 4)
       (#2%/ 9 x 4) (#2%/ 3 x 3) (#2%/ x 3 1/3) (#2%/ 4 x 3 1/3) (#2%/ 50 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (/ 3) (/ 9 4) (/ x) (/ x 1) (/ 1 x) (/ x 3) (/ x 3 4)
           (/ 9 x 4) (/ 3 x 3) (/ x 3 1/3) (/ 4 x 3 1/3) (/ 50 x 4 y 5))))
    '(#3%list
       1/3 9/4 (#3%/ x) (#3%/ x 1) (#3%/ x) (#3%/ x 3) (#3%/ x 3 4)
       (#3%/ 9 x 4) (#3%/ 3 x 3) (#3%/ x 3 1/3) (#3%/ 4 x 3 1/3) (#3%/ 50 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fx/ 3) (fx/ 9 4) (fx/ x) (fx/ x 1) (fx/ 1 x) (fx/ x 3) (fx/ x 3 4)
           (fx/ 9 x 4) (fx/ 1 x 1) (fx/ x 1 1) (fx/ 4 x 1 1) (fx/ 50 x 4 y 5))))
    '(#2%list
       0 2 (#2%fx/ x) (#2%fx/ x 1) (#2%fx/ x) (#2%fx/ x 3) (#2%fx/ x 3 4)
       (#2%fx/ 9 x 4) (#2%fx/ 1 x 1) (#2%fx/ x 1 1) (#2%fx/ 4 x 1 1) (#2%fx/ 50 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fx/ 3) (fx/ 9 4) (fx/ x) (fx/ x 1) (fx/ 1 x) (fx/ x 3) (fx/ x 3 4)
           (fx/ 9 x 4) (fx/ 1 x 1) (fx/ x 1 1) (fx/ 4 x 1 1) (fx/ 50 x 4 y 5))))
    '(#3%list
       0 2 (#3%fx/ x) (#3%fx/ x 1) (#3%fx/ x) (#3%fx/ x 3) (#3%fx/ x 3 4)
       (#3%fx/ 9 x 4) (#3%fx/ 1 x 1) (#3%fx/ x 1 1) (#3%fx/ 4 x 1 1) (#3%fx/ 50 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fxquotient 3) (fxquotient 9 4) (fxquotient x) (fxquotient x 1) (fxquotient 1 x) (fxquotient x 3) (fxquotient x 3 4)
           (fxquotient 9 x 4) (fxquotient 1 x 1) (fxquotient x 1 1) (fxquotient 4 x 1 1) (fxquotient 50 x 4 y 5))))
    '(#2%list
       0 2 (#2%fxquotient x) (#2%fxquotient x 1) (#2%fxquotient x) (#2%fxquotient x 3) (#2%fxquotient x 3 4)
       (#2%fxquotient 9 x 4) (#2%fxquotient 1 x 1) (#2%fxquotient x 1 1) (#2%fxquotient 4 x 1 1) (#2%fxquotient 50 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fxquotient 3) (fxquotient 9 4) (fxquotient x) (fxquotient x 1) (fxquotient 1 x) (fxquotient x 3) (fxquotient x 3 4)
           (fxquotient 9 x 4) (fxquotient 1 x 1) (fxquotient x 1 1) (fxquotient 4 x 1 1) (fxquotient 50 x 4 y 5))))
    '(#3%list
       0 2 (#3%fxquotient x) (#3%fxquotient x 1) (#3%fxquotient x) (#3%fxquotient x 3) (#3%fxquotient x 3 4)
       (#3%fxquotient 9 x 4) (#3%fxquotient 1 x 1) (#3%fxquotient x 1 1) (#3%fxquotient 4 x 1 1) (#3%fxquotient 50 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fl/ 2.0) (fl/ 9.0 4.0) (fl/ x) (fl/ x 1.0) (fl/ 1.0 x) (fl/ x 3.0) (fl/ x 3.0 4.0)
           (fl/ 9.0 x 4.0) (fl/ 3.0 x 3.0) (fl/ x 2.0 .5) (fl/ 4.0 x 2.0 .5)
           (fl/ 50.0 x 4.0 y 5.0))))
    '(#2%list
       .5 2.25 (#2%fl/ x) (#2%fl/ x 1.0) (#2%fl/ x) (#2%fl/ x 3.0) (#2%fl/ x 3.0 4.0)
       (#2%fl/ 9.0 x 4.0) (#2%fl/ 3.0 x 3.0) (#2%fl/ x 2.0 .5) (#2%fl/ 4.0 x 2.0 .5)
       (#2%fl/ 50.0 x 4.0 y 5.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fl/ 2.0) (fl/ 9.0 4.0) (fl/ x) (fl/ x 1.0) (fl/ 1.0 x) (fl/ x 3.0) (fl/ x 3.0 4.0)
           (fl/ 9.0 x 4.0) (fl/ 3.0 x 3.0) (fl/ x 2.0 .5) (fl/ 4.0 x 2.0 .5)
           (fl/ 50.0 x 4.0 y 5.0))))
    '(#3%list
       .5 2.25 (#3%fl/ x) (#3%fl/ x 1.0) (#3%fl/ x) (#3%fl/ x 3.0) (#3%fl/ x 3.0 4.0)
       (#3%fl/ 9.0 x 4.0) (#3%fl/ 3.0 x 3.0) (#3%fl/ x 2.0 .5) (#3%fl/ 4.0 x 2.0 .5)
       (#3%fl/ 50.0 x 4.0 y 5.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (cfl/ 2.0) (cfl/ 9.0 4.0) (cfl/ x) (cfl/ x 1.0) (cfl/ 1.0 x) (cfl/ x 3.0) (cfl/ x 3.0 4.0)
           (cfl/ 9.0 x 4.0) (cfl/ 3.0 x 3.0) (cfl/ x 2.0 .5) (cfl/ 4.0 x 2.0 .5)
           (cfl/ 50.0 x 4.0 y 5.0))))
    '(#2%list
       .5 2.25 (#2%cfl/ x) (#2%cfl/ x 1.0) (#2%cfl/ x) (#2%cfl/ x 3.0) (#2%cfl/ x 3.0 4.0)
       (#2%cfl/ 9.0 x 4.0) (#2%cfl/ 3.0 x 3.0) (#2%cfl/ x 2.0 .5) (#2%cfl/ 4.0 x 2.0 .5)
       (#2%cfl/ 50.0 x 4.0 y 5.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (cfl/ 2.0) (cfl/ 9.0 4.0) (cfl/ x) (cfl/ x 1.0) (cfl/ 1.0 x) (cfl/ x 3.0) (cfl/ x 3.0 4.0)
           (cfl/ 9.0 x 4.0) (cfl/ 3.0 x 3.0) (cfl/ x 2.0 .5) (cfl/ 4.0 x 2.0 .5)
           (cfl/ 50.0 x 4.0 y 5.0))))
    '(#3%list
       .5 2.25 (#3%cfl/ x) (#3%cfl/ x 1.0) (#3%cfl/ x) (#3%cfl/ x 3.0) (#3%cfl/ x 3.0 4.0)
       (#3%cfl/ 9.0 x 4.0) (#3%cfl/ 3.0 x 3.0) (#3%cfl/ x 2.0 .5) (#3%cfl/ 4.0 x 2.0 .5)
       (#3%cfl/ 50.0 x 4.0 y 5.0)))

 ; check partial folding of #{2,3}%{fx,}log{and,or,xor}
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (logand)
           (logand -1) (logand 0) (logand 7)
           (logand 5 0) (logand 0 5) (logand 5 -1) (logand -1 x) (logand x 0) (logand 5 3) (logand 5 x) (logand x y)
           (logand 5 0 3) (logand 5 7 -1 6) (logand x -1 y) (logand 13 x 7 y) (logand 13 x 7 0 y) (logand 13 x 7 -1 y))))
    '(#2%list
       -1
       -1 0 7
       0 0 5 (#2%logand x) (begin (#2%logand x) 0) 1 (#2%logand 5 x) (#2%logand x y)
       0 4 (#2%logand x y) (#2%logand 5 x y) (begin (#2%logand x y) 0) (#2%logand 5 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (logand)
           (logand -1) (logand 0) (logand 7)
           (logand 5 0) (logand 0 5) (logand 5 -1) (logand -1 x) (logand x 0) (logand 5 3) (logand 5 x) (logand x y)
           (logand 5 0 3) (logand 5 7 -1 6) (logand x -1 y) (logand 13 x 7 y) (logand 13 x 7 0 y) (logand 13 x 7 -1 y))))
    '(#3%list
       -1
       -1 0 7
       0 0 5 x 0 1 (#3%logand 5 x) (#3%logand x y)
       0 4 (#3%logand x y) (#3%logand 5 x y) 0 (#3%logand 5 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fxlogand)
           (fxlogand -1) (fxlogand 0) (fxlogand 7)
           (fxlogand 5 0) (fxlogand 0 5) (fxlogand 5 -1) (fxlogand -1 x) (fxlogand x 0) (fxlogand 5 3) (fxlogand 5 x) (fxlogand x y)
           (fxlogand 5 0 3) (fxlogand 5 7 -1 6) (fxlogand x -1 y) (fxlogand 13 x 7 y) (fxlogand 13 x 7 0 y) (fxlogand 13 x 7 -1 y))))
    '(#2%list
       -1
       -1 0 7
       0 0 5 (#2%fxlogand x) (begin (#2%fxlogand x) 0) 1 (#2%fxlogand 5 x) (#2%fxlogand x y)
       0 4 (#2%fxlogand x y) (#2%fxlogand 5 x y) (begin (#2%fxlogand x y) 0) (#2%fxlogand 5 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fxlogand)
           (fxlogand -1) (fxlogand 0) (fxlogand 7)
           (fxlogand 5 0) (fxlogand 0 5) (fxlogand 5 -1) (fxlogand -1 x) (fxlogand x 0) (fxlogand 5 3) (fxlogand 5 x) (fxlogand x y)
           (fxlogand 5 0 3) (fxlogand 5 7 -1 6) (fxlogand x -1 y) (fxlogand 13 x 7 y) (fxlogand 13 x 7 0 y) (fxlogand 13 x 7 -1 y))))
    '(#3%list
       -1
       -1 0 7
       0 0 5 x 0 1 (#3%fxlogand 5 x) (#3%fxlogand x y)
       0 4 (#3%fxlogand x y) (#3%fxlogand 5 x y) 0 (#3%fxlogand 5 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fxlogor)
           (fxlogor -1) (fxlogor 0) (fxlogor 7)
           (fxlogor 5 0) (fxlogor 0 5) (fxlogor 5 -1) (fxlogor -1 x) (fxlogor x 0) (fxlogor 5 3) (fxlogor 5 x) (fxlogor x y)
           (fxlogor 5 0 3) (fxlogor 5 7 -1 6) (fxlogor x 0 y) (fxlogor 13 x 7 y) (fxlogor 13 x 7 -1 y) (fxlogor 13 x 7 0 y))))
    '(#2%list
       0
       -1 0 7
       5 5 -1 (begin (#2%fxlogor x) -1) (#2%fxlogor x) 7 (#2%fxlogor 5 x) (#2%fxlogor x y)
       7 -1 (#2%fxlogor x y) (#2%fxlogor 15 x y) (begin (#2%fxlogor x y) -1) (#2%fxlogor 15 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fxlogor)
           (fxlogor -1) (fxlogor 0) (fxlogor 7)
           (fxlogor 5 0) (fxlogor 0 5) (fxlogor 5 -1) (fxlogor -1 x) (fxlogor x 0) (fxlogor 5 3) (fxlogor 5 x) (fxlogor x y)
           (fxlogor 5 0 3) (fxlogor 5 7 -1 6) (fxlogor x 0 y) (fxlogor 13 x 7 y) (fxlogor 13 x 7 -1 y) (fxlogor 13 x 7 0 y))))
    '(#3%list
       0
       -1 0 7
       5 5 -1 -1 x 7 (#3%fxlogor 5 x) (#3%fxlogor x y)
       7 -1 (#3%fxlogor x y) (#3%fxlogor 15 x y) -1 (#3%fxlogor 15 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (logor)
           (logor -1) (logor 0) (logor 7)
           (logor 5 0) (logor 0 5) (logor 5 -1) (logor -1 x) (logor x 0) (logor 5 3) (logor 5 x) (logor x y)
           (logor 5 0 3) (logor 5 7 -1 6) (logor x 0 y) (logor 13 x 7 y) (logor 13 x 7 -1 y) (logor 13 x 7 0 y))))
    '(#2%list
       0
       -1 0 7
       5 5 -1 (begin (#2%logor x) -1) (#2%logor x) 7 (#2%logor 5 x) (#2%logor x y)
       7 -1 (#2%logor x y) (#2%logor 15 x y) (begin (#2%logor x y) -1) (#2%logor 15 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (logor)
           (logor -1) (logor 0) (logor 7)
           (logor 5 0) (logor 0 5) (logor 5 -1) (logor -1 x) (logor x 0) (logor 5 3) (logor 5 x) (logor x y)
           (logor 5 0 3) (logor 5 7 -1 6) (logor x 0 y) (logor 13 x 7 y) (logor 13 x 7 -1 y) (logor 13 x 7 0 y))))
    '(#3%list
       0
       -1 0 7
       5 5 -1 -1 x 7 (#3%logor 5 x) (#3%logor x y)
       7 -1 (#3%logor x y) (#3%logor 15 x y) -1 (#3%logor 15 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (logxor)
           (logxor -1) (logxor 0) (logxor 7)
           (logxor 5 0) (logxor 0 5) (logxor 5 -1) (logxor -1 x) (logxor x 0) (logxor 5 3) (logxor 5 x) (logxor x y)
           (logxor 5 0 3) (logxor 5 7 -1 6) (logxor x 0 y) (logxor 13 x 7 y) (logxor 13 x 7 -1 y) (logxor 13 x 7 0 y))))
    '(#2%list
       0
       -1 0 7
       5 5 -6 (#2%logxor -1 x) (#2%logxor x) 6 (#2%logxor 5 x) (#2%logxor x y)
       6 -5 (#2%logxor x y) (#2%logxor 10 x y) (#2%logxor -11 x y) (#2%logxor 10 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (logxor)
           (logxor -1) (logxor 0) (logxor 7)
           (logxor 5 0) (logxor 0 5) (logxor 5 -1) (logxor -1 x) (logxor x 0) (logxor 5 3) (logxor 5 x) (logxor x y)
           (logxor 5 0 3) (logxor 5 7 -1 6) (logxor x 0 y) (logxor 13 x 7 y) (logxor 13 x 7 -1 y) (logxor 13 x 7 0 y))))
    '(#3%list
       0
       -1 0 7
       5 5 -6 (#3%logxor -1 x) x 6 (#3%logxor 5 x) (#3%logxor x y)
       6 -5 (#3%logxor x y) (#3%logxor 10 x y) (#3%logxor -11 x y) (#3%logxor 10 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fxlogxor)
           (fxlogxor -1) (fxlogxor 0) (fxlogxor 7)
           (fxlogxor 5 0) (fxlogxor 0 5) (fxlogxor 5 -1) (fxlogxor -1 x) (fxlogxor x 0) (fxlogxor 5 3) (fxlogxor 5 x) (fxlogxor x y)
           (fxlogxor 5 0 3) (fxlogxor 5 7 -1 6) (fxlogxor x 0 y) (fxlogxor 13 x 7 y) (fxlogxor 13 x 7 -1 y) (fxlogxor 13 x 7 0 y))))
    '(#2%list
       0
       -1 0 7
       5 5 -6 (#2%fxlogxor -1 x) (#2%fxlogxor x) 6 (#2%fxlogxor 5 x) (#2%fxlogxor x y)
       6 -5 (#2%fxlogxor x y) (#2%fxlogxor 10 x y) (#2%fxlogxor -11 x y) (#2%fxlogxor 10 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fxlogxor)
           (fxlogxor -1) (fxlogxor 0) (fxlogxor 7)
           (fxlogxor 5 0) (fxlogxor 0 5) (fxlogxor 5 -1) (fxlogxor -1 x) (fxlogxor x 0) (fxlogxor 5 3) (fxlogxor 5 x) (fxlogxor x y)
           (fxlogxor 5 0 3) (fxlogxor 5 7 -1 6) (fxlogxor x 0 y) (fxlogxor 13 x 7 y) (fxlogxor 13 x 7 -1 y) (fxlogxor 13 x 7 0 y))))
    '(#3%list
       0
       -1 0 7
       5 5 -6 (#3%fxlogxor -1 x) x 6 (#3%fxlogxor 5 x) (#3%fxlogxor x y)
       6 -5 (#3%fxlogxor x y) (#3%fxlogxor 10 x y) (#3%fxlogxor -11 x y) (#3%fxlogxor 10 x y)))
)



(mat cp0-partial-folding-left-assoc
 ; check partial folding of +, fx+, fl+, and cfl+ when constraint to left-associative
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] 
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (+) (+ 3) (+ 3 4) (+ x) (+ x 0) (+ 0 x) (+ x 3)
           (+ x 3 4) (+ 3 x 4) (+ 3 x -3) (+ 3 x 4 y 5)
           (+ +nan.0 x 4 y 5))))
    '(#2%list 0 3 7 (#2%+ x) (#2%+ x 0) (#2%+ x) (#2%+ x 3)
       (#2%+ x 3 4) (#2%+ 3 x 4) (#2%+ 3 x -3) (#2%+ 3 x 4 y 5)
       (begin (#2%+ +nan.0 x 4 y 5) +nan.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (+) (+ 3) (+ 3 4) (+ x) (+ x 0) (+ 0 x) (+ x 3)
           (+ x 3 4) (+ 3 x 4) (+ 3 x -3) (+ 3 x 4 y 5)
           (+ +nan.0 x 4 y 5))))
    '(#3%list 0 3 7 x (#3%+ x 0) x (#3%+ x 3)
       (#3%+ x 3 4) (#3%+ 3 x 4) (#3%+ 3 x -3) (#3%+ 3 x 4 y 5)
       +nan.0))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fx+) (fx+ 3) (fx+ 3 4) (fx+ x) (fx+ x 0) (fx+ 0 x) (fx+ x 3)
           (fx+ x 3 4) (fx+ 3 x 4) (fx+ 3 x -3) (fx+ 3 x 4 y 5))))
    '(#2%list 0 3 7 (#2%fx+ x) (#2%fx+ x 0) (#2%fx+ x) (#2%fx+ x 3)
       (#2%fx+ x 3 4) (#2%fx+ 3 x 4) (#2%fx+ 3 x -3) (#2%fx+ 3 x 4 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fx+) (fx+ 3) (fx+ 3 4) (fx+ x) (fx+ x 0) (fx+ 0 x) (fx+ x 3)
           (fx+ x 3 4) (fx+ 3 x 4) (fx+ 3 x -3) (fx+ 3 x 4 y 5))))
    '(#3%list 0 3 7 x x x (#3%fx+ 3 x)
       (#3%fx+ 7 x) (#3%fx+ 7 x) x (#3%fx+ 12 x y)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fl+) (fl+ 3.0) (fl+ 3.0 4.0) (fl+ x) (fl+ x 0.0) (fl+ x -0.0) (fl+ 0.0 x) (fl+ -0.0 x) (fl+ x 3.0)
           (fl+ x 3.0 4.0) (fl+ 3.0 x 4.0) (fl+ 3.0 x -3.0) (fl+ (truncate -.5) x (/ -inf.0)) (fl+ 3.0 x 4.0 y 5.0)
           (fl+ +nan.0 x 3.0 y 5.0) (fl+ 3.0 x +nan.0 y 5.0))))
    '(#2%list 0.0 3.0 7.0 (#2%fl+ x) (#2%fl+ x 0.0) (#2%fl+ x -0.0) (#2%fl+ 0.0 x) (#2%fl+ x) (#2%fl+ x 3.0)
       (#2%fl+ x 3.0 4.0) (#2%fl+ 3.0 x 4.0) (#2%fl+ 3.0 x -3.0) (#2%fl+ x -0.0) (#2%fl+ 3.0 x 4.0 y 5.0)
       (begin (#2%fl+ +nan.0 x 3.0 y 5.0) +nan.0) (#2%fl+ 3.0 x +nan.0 y 5.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fl+) (fl+ 3.0) (fl+ 3.0 4.0) (fl+ x) (fl+ x 0.0) (fl+ x -0.0) (fl+ 0.0 x) (fl+ -0.0 x) (fl+ x 3.0)
           (fl+ x 3.0 4.0) (fl+ 3.0 x 4.0) (fl+ 3.0 x -3.0) (fl+ (truncate -.5) x (/ -inf.0)) (fl+ 3.0 x 4.0 y 5.0)
           (fl+ +nan.0 x 3.0 y 5.0) (fl+ 3.0 x +nan.0 y 5.0))))
    '(#3%list 0.0 3.0 7.0 x (#3%fl+ x 0.0) (#3%fl+ x -0.0) (#3%fl+ 0.0 x) x (#3%fl+ x 3.0)
       (#3%fl+ x 3.0 4.0) (#3%fl+ 3.0 x 4.0) (#3%fl+ 3.0 x -3.0) (#3%fl+ x -0.0) (#3%fl+ 3.0 x 4.0 y 5.0)
       +nan.0 (#3%fl+ 3.0 x +nan.0 y 5.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (cfl+) (cfl+ 3.0) (cfl+ 3.0 4.0) (cfl+ x) (cfl+ x 0.0) (cfl+ x -0.0) (cfl+ 0.0 x) (cfl+ -0.0 x) (cfl+ x 3.0)
           (cfl+ x 3.0 4.0) (cfl+ 3.0 x 4.0) (cfl+ 3.0 x -3.0) (cfl+ (truncate -.5) x (/ -inf.0)) (cfl+ 3.0 x 4.0 y 5.0)
           (cfl+ +nan.0+nan.0i x 3.0 y 5.0) (cfl+ 3.0 x +nan.0+nan.0i y 5.0))))
    '(#2%list 0.0 3.0 7.0 (#2%cfl+ x) (#2%cfl+ x 0.0) (#2%cfl+ x -0.0) (#2%cfl+ 0.0 x) (#2%cfl+ x) (#2%cfl+ x 3.0)
       (#2%cfl+ x 3.0 4.0) (#2%cfl+ 3.0 x 4.0) (#2%cfl+ 3.0 x -3.0) (#2%cfl+ x -0.0) (#2%cfl+ 3.0 x 4.0 y 5.0)
       (begin (#2%cfl+ +nan.0+nan.0i x 3.0 y 5.0) +nan.0+nan.0i) (#2%cfl+ 3.0 x +nan.0+nan.0i y 5.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (cfl+) (cfl+ 3.0) (cfl+ 3.0 4.0) (cfl+ x) (cfl+ x 0.0) (cfl+ x -0.0) (cfl+ 0.0 x) (cfl+ -0.0 x) (cfl+ x 3.0)
           (cfl+ x 3.0 4.0) (cfl+ 3.0 x 4.0) (cfl+ 3.0 x -3.0) (cfl+ (truncate -.5) x (/ -inf.0)) (cfl+ 3.0 x 4.0 y 5.0)
           (cfl+ +nan.0+nan.0i x 3.0 y 5.0) (cfl+ 3.0 x +nan.0+nan.0i y 5.0))))
    '(#3%list 0.0 3.0 7.0 x (#3%cfl+ x 0.0) (#3%cfl+ x -0.0) (#3%cfl+ 0.0 x) x (#3%cfl+ x 3.0)
       (#3%cfl+ x 3.0 4.0) (#3%cfl+ 3.0 x 4.0) (#3%cfl+ 3.0 x -3.0) (#3%cfl+ x -0.0) (#3%cfl+ 3.0 x 4.0 y 5.0)
       +nan.0+nan.0i (#3%cfl+ 3.0 x +nan.0+nan.0i y 5.0)))

 ; check partial folding of *, fx*, fl*, and cfl*
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (*) (* 3) (* 3 4) (* x) (* x 1) (* 1 x) (* x 3)
           (* x 3 4) (* 3 x 4) (* 3 x 1/3) (* 3 x 4 y 5)
           (* 0 x 3 y 5) (* 3 x 0 y 5))))
    '(#2%list 1 3 12 (#2%* x) (#2%* x 1) (#2%* x) (#2%* x 3)
       (#2%* x 3 4) (#2%* 3 x 4) (#2%* 3 x 1/3) (#2%* 3 x 4 y 5)
       (begin (#2%* 0 x 3 y 5) 0) (#2%* 3 x 0 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (*) (* 3) (* 3 4) (* x) (* x 1) (* 1 x) (* x 3)
           (* x 3 4) (* 3 x 4) (* 3 x 1/3) (* 3 x 4 y 5)
           (* 0 x 3 y 5) (* 3 x 0 y 5))))
    '(#3%list 1 3 12 x (#3%* x 1) x (#3%* x 3)
       (#3%* x 3 4) (#3%* 3 x 4) (#3%* 3 x 1/3) (#3%* 3 x 4 y 5)
       0 (#3%* 3 x 0 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fx*) (fx* 3) (fx* 3 4) (fx* x) (fx* x 1) (fx* 1 x) (fx* x 3)
           (fx* x 3 4) (fx* 3 x 4) (fx* 1 x 1) (fx* 3 x 4 y 5)
           (fx* 0 x 3 y 5) (fx* 3 x 0 y 5))))
    '(#2%list 1 3 12 (#2%fx* x) (#2%fx* x 1) (#2%fx* x) (#2%fx* x 3)
       (#2%fx* x 3 4) (#2%fx* 3 x 4) (#2%fx* x 1) (#2%fx* 3 x 4 y 5)
       (begin (#2%fx* 0 x 3 y 5) 0) (#2%fx* 3 x 0 y 5)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fx*) (fx* 3) (fx* 3 4) (fx* x) (fx* x 1) (fx* 1 x) (fx* x 3)
           (fx* x 3 4) (fx* 3 x 4) (fx* 1 x 1) (fx* 3 x 4 y 5)
           (fx* 3 x 0 y 5))))
    '(#3%list 1 3 12 x x x (#3%fx* 3 x)
       (#3%fx* 12 x) (#3%fx* 12 x) x (#3%fx* 60 x y)
       0))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (fl*) (fl* 3.0) (fl* 3.0 4.0) (fl* x) (fl* x 1.0) (fl* 1.0 x) (fl* x 3.0)
           (fl* x 3.0 4.0) (fl* 3.0 x 4.0) (fl* 3.0 x #i1/3) (fl* 3.0 x 4.0 y 5.0)
           (fl* +nan.0 x 3.0 y 4.0) (fl* 3.0 x 4.0 y +nan.0))))
    '(#2%list 1.0 3.0 12.0 (#2%fl* x) (#2%fl* x 1.0) (#2%fl* x) (#2%fl* x 3.0)
       (#2%fl* x 3.0 4.0) (#2%fl* 3.0 x 4.0) (#2%fl* 3.0 x #i1/3) (#2%fl* 3.0 x 4.0 y 5.0)
       (begin (#2%fl* +nan.0 x 3.0 y 4.0) +nan.0) (#2%fl* +3.0 x 4.0 y +nan.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (fl*) (fl* 3.0) (fl* 3.0 4.0) (fl* x) (fl* x 1.0) (fl* 1.0 x) (fl* x 3.0)
           (fl* x 3.0 4.0) (fl* 3.0 x 4.0) (fl* 3.0 x #i1/3) (fl* 3.0 x 4.0 y 5.0)
           (fl* +nan.0 x 3.0 y 4.0) (fl* 3.0 x 4.0 y +nan.0))))
    '(#3%list 1.0 3.0 12.0 x (#3%fl* x 1.0) x (#3%fl* x 3.0)
       (#3%fl* x 3.0 4.0) (#3%fl* 3.0 x 4.0) (#3%fl* 3.0 x #i1/3) (#3%fl* 3.0 x 4.0 y 5.0)
       +nan.0 (#3%fl* +3.0 x 4.0 y +nan.0)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 2])
      (expand/optimize
        '(list
           (cfl*) (cfl* 3.0) (cfl* 3.0 4.0) (cfl* x) (cfl* x 1.0) (cfl* 1.0 x) (cfl* x 3.0)
           (cfl* x 3.0 4.0) (cfl* 3.0 x 4.0) (cfl* 3.0 x #i1/3) (cfl* 3.0 x 4.0 y 5.0)
           (cfl* +nan.0+nan.0i x 3.0 y 4.0) (cfl* 3.0 x 4.0 y +nan.0+nan.0i))))
    '(#2%list 1.0 3.0 12.0 (#2%cfl* x) (#2%cfl* x 1.0) (#2%cfl* x) (#2%cfl* x 3.0)
       (#2%cfl* x 3.0 4.0) (#2%cfl* 3.0 x 4.0) (#2%cfl* 3.0 x #i1/3) (#2%cfl* 3.0 x 4.0 y 5.0)
       (begin (#2%cfl* +nan.0+nan.0i x 3.0 y 4.0) +nan.0+nan.0i) (#2%cfl* 3.0 x 4.0 y +nan.0+nan.0i)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f]
                   [run-cp0 (lambda (cp0 x) (cp0 x))]
                   [enable-arithmetic-left-associative #t]
                   [optimize-level 3])
      (expand/optimize
        '(list
           (cfl*) (cfl* 3.0) (cfl* 3.0 4.0) (cfl* x) (cfl* x 1.0) (cfl* 1.0 x) (cfl* x 3.0)
           (cfl* x 3.0 4.0) (cfl* 3.0 x 4.0) (cfl* 3.0 x #i1/3) (cfl* 3.0 x 4.0 y 5.0)
           (cfl* +nan.0+nan.0i x 3.0 y 4.0) (cfl* 3.0 x 4.0 y +nan.0+nan.0i))))
    '(#3%list 1.0 3.0 12.0 x (#3%cfl* x 1.0) x (#3%cfl* x 3.0)
       (#3%cfl* x 3.0 4.0) (#3%cfl* 3.0 x 4.0) (#3%cfl* 3.0 x #i1/3) (#3%cfl* 3.0 x 4.0 y 5.0)
       +nan.0+nan.0i (#3%cfl* 3.0 x 4.0 y +nan.0+nan.0i)))
  )

(mat cp0-apply
  (begin
    (define $permutations
      (rec permutations
        (lambda (x*)
          (if (null? x*)
              '()
              (if (null? (cdr x*))
                  (list x*)
                  (let f ([x* x*] [rx* '()])
                    (if (null? x*)
                        '()
                        (append
                          (map (lambda (ls) (cons (car x*) ls)) (permutations (append (cdr x*) rx*)))
                          (f (cdr x*) (cons (car x*) rx*))))))))))
    #t)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(#%apply (lambda () 7) '())))
    '7)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply (lambda (x y z) (#%+ x y z)) '(3 4 5))))
    '12)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply (lambda (x y z) (#%+ x y z)) (#%list 3 4 5))))
    '12)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply
           (lambda (x y z) (#%+ (begin (#%write 'a) x) y z))
           (#%list e1 e2 e3))))
    (if (= (optimize-level) 3)
        '(let ([x e1] [y e2] [z e3])
           (#3%+ (begin (#3%write 'a) x) y z))
        '(let ([x e1] [y e2] [z e3])
           (#2%+ (begin (#2%write 'a) x) y z))))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(#%apply #%+ '(1 2 3 4))))
    '10)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(#%apply #%+ (#%list 1 2 3 4))))
    '10)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(lambda (x) (#%apply #%+ (#%list 1 2 x 4)))))
    (if (= (optimize-level) 3)
        '(lambda (x) (#3%+ 7 x))
        '(lambda (x) (#2%+ 7 x))))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply (lambda (x y z) (#%+ x y z)) (#%list e1 e2 e3))))
    (if (= (optimize-level) 3)
        '(#3%+ e1 e2 e3)
        '(#2%+ e1 e2 e3)))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply #%+ (#%list 1 (begin (#%write 'a) 2) 3))))
    (if (= (optimize-level) 3)
        '(begin (#3%write 'a) 6)
        '(begin (#2%write 'a) 6)))
  (let ([expr (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
                (expand/optimize
                  '(#%apply (begin (#%write 'a) #%+)
                     (begin (#%write 'b) 4)
                     (begin
                       (#%write 'c)
                       (#%list
                         1
                         (begin (#%write 'd) 2)
                         (begin (#%write 'e) 3))))))])
    (ormap
      (lambda (groups) (equivalent-expansion? expr `(begin ,@(apply append groups) 10)))
      ($permutations
        (if (= (optimize-level) 3)
            '(((#3%write 'a)) ((#3%write 'b)) ((#3%write 'c) (#3%write 'e) (#3%write 'd)))
            '(((#2%write 'a)) ((#2%write 'b)) ((#2%write 'c) (#2%write 'e) (#2%write 'd)))))))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply (lambda (x y z) (#%vector x y)) (#%list e1 2 e3))))
    (if (= (optimize-level) 3)
        '(#3%vector e1 2)
        '(begin e3 (#2%vector e1 2))))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(lambda (x) (#%apply x '(1 2 3)))))
    '(lambda (x) (x 1 2 3)))
  (let ([q (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
             (expand/optimize '(#%apply e0 (#%list e1 e2 e3))))])
    (or (equivalent-expansion?  q '(let ([t1 e1] [t2 e2] [t3 e3]) (e0 t1 t2 t3)))
        (equivalent-expansion?  q '(let ([t0 e0]) (t0 e1 e2 e3)))))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply
           (case-lambda [(x y) x] [(a b c d e) c])
           (#%list 1 2 3 4 5))))
    '3)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply (case-lambda [(x y) x] [r r]) (#%list 1 2 3 4 5))))
    '(#3%list 1 2 3 4 5))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply (case-lambda [(x y) x] [r r]) (#%list 1 2 q 4 5))))
    '(#3%list 1 2 q 4 5))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(#%apply #%apply #%+ (#%list 1 2 3 (#%list 4 5)))))
    15)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(#%apply #%apply #%apply #%apply #%apply #%+ (#%list 1 2 3 (#%list 4 5 (#%list 6 7 (#%list* 8 9 (#%list (#%list 10)))))))))
    55)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(#%apply #%apply #%apply #%apply #%+ (#%cons 1 (#%list 2 3 (#%cons* 4 (#%list 5 (#%cons 6 (#%list* 7 (#%list 8 (#%cons 9 '(10))))))))))))
    55)
  (begin
    (define $check-writes
      (lambda (eepat x)
        (define ordered?
          (lambda (ls)
            (define same-prefix?
              (lambda (ls1 ls2)
                (or (null? ls2)
                    (and (eqv? (car ls1) (car ls2))
                         (same-prefix? (cdr ls1) (cdr ls2))))))
            (null?
              (let f ([ls ls] [q '()] [qlen 0])
                (if (null? ls)
                    '()
                    (let ([x (car ls)])
                      (let ([xlen (length x)])
                        (cond
                          [(fx= xlen qlen) (f (cdr ls) x xlen)]
                          [(fx< xlen qlen) ls]
                          [else (and (fx= xlen (fx+ qlen 1))
                                     (same-prefix? x q)
                                     (let ([ls (f (cdr ls) x xlen)])
                                       (and ls (f ls q qlen))))]))))))))
        (syntax-case x (begin $primitive quote)
          [(begin
             (($primitive level write) (quote (d ...)))
             ...
             ans)
           (begin
             (unless (equivalent-expansion? #'ans eepat) (errorf #f "~s is not equivalent to ~s" #'ans eepat))
             (unless (ordered? #'((d ...) ...)) (errorf #f "writes are out-of-order in ~s" x))
             #t)]
          [_ (errorf #f "unexpected output pattern for ~s" x)])))
    #t)
  ($check-writes 55
   (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
     (expand/optimize '(let ()
                         (import (chezscheme))
                         (let ([list (begin (write '()) list)] [list* (if #t list* list)])
                           (write '(1))
                           ((begin (write '(1 1)) apply)
                            (begin (write '(1 2)) apply)
                            (begin (write '(1 3)) apply)
                            (let ([waste (write '(1 4))]) apply)
                            (begin (write '(1 5)) apply)
                            (begin (write '(1 6)) +)
                            (begin (write '(1 7))
                              ((begin (write '(1 7 1)) list)
                               (begin (write '(1 7 2)) 1)
                               (begin (write '(1 7 3)) 2)
                               (begin (write '(1 7 4)) 3)
                               (begin (write '(1 7 5))
                                 ((begin (write '(1 7 5 1)) list)
                                  (begin (write '(1 7 5 2)) 4)
                                  (begin (write '(1 7 5 3)) 5)
                                  (begin (write '(1 7 5 4))
                                    ((begin (write '(1 7 5 4 1)) list)
                                     (begin (write '(1 7 5 4 2)) 6)
                                     (begin (write '(1 7 5 4 3)) 7)
                                     (begin (write '(1 7 5 4 4))
                                       ((begin (write '(1 7 5 4 4 1)) list*)
                                        (begin (write '(1 7 5 4 4 2)) 8)
                                        (begin (write '(1 7 5 4 4 3)) 9)
                                        (begin (write '(1 7 5 4 4 4))
                                          ((begin (write '(1 7 5 4 4 1)) list)
                                           (begin (write '(1 7 5 4 4 2))
                                             ((begin (write '(1 7 5 4 4 2 1)) list)
                                              (begin (write '(1 7 5 4 4 2 2)) 10)))))))))))))))))))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 (cp0 (cp0 x))))])
      (expand/optimize '(#%apply #%apply #%+ (#%list 1 2 3 (#%list 4 5)))))
    '15)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(#%apply (lambda () 7) (#%list* '()))))
    '7)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply (lambda (x y z) (#%+ x y z)) (#%list* 3 4 '(5)))))
    '12)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(#%apply #%+ (#%list* e '(2 3)))))
    (if (= (optimize-level) 3)
        '(#3%+ 5 e)
        '(#2%+ 5 e)))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply
           (lambda (x y z) (#%+ (begin (#%write 'a) x) y z))
           (#%list* e1 e2 e3 '()))))
    (if (= (optimize-level) 3)
        '(let ([x e1] [y e2] [z e3])
           (#3%+ (begin (#3%write 'a) x) y z))
        '(let ([x e1] [y e2] [z e3])
           (#2%+ (begin (#2%write 'a) x) y z))))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply (lambda (x y z) (#%+ x y z)) (#%list* e1 e2 e3 '()))))
    (if (= (optimize-level) 3)
        '(#3%+ e1 e2 e3)
        '(#2%+ e1 e2 e3)))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply #%+ (#%list* 1 (begin (#%write 'a) 2) '(3)))))
    (if (= (optimize-level) 3)
        '(begin (#3%write 'a) 6)
        '(begin (#2%write 'a) 6)))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize
        '(#%apply (lambda (x y z) (#%vector x y)) (#%list* e1 2 e3 '()))))
    (if (= (optimize-level) 3)
        '(#3%vector e1 2)
        '(begin e3 (#2%vector e1 2))))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(#%apply (lambda (x y z) (#%vector x y z)) (#%list* 1 '(2 3)))))
    (if (= (optimize-level) 3)
        '(#3%vector 1 2 3)
        '(#2%vector 1 2 3)))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(lambda (r) (#%apply (lambda (x y z) (#%vector x y z)) (#%list* 1 r)))))
    (if (= (optimize-level) 3)
        '(lambda (r) (let ([y (#3%car r)]) (#3%vector 1 y (#3%car (#3%cdr r)))))
        '(lambda (r) (#2%apply (lambda (x y z) (#2%vector x y z)) 1 r))))
  (let ([expr (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
                (expand/optimize
                  '(#%apply (begin (#%write 'a) #%+)
                     (begin (#%write 'b) 4)
                     (begin
                       (#%write 'c)
                       (#%list*
                         1
                         (begin (#%write 'd) 2)
                         (begin (#%write 'e) '(3)))))))])
    (ormap
      (lambda (groups) (equivalent-expansion? expr `(begin ,@(apply append groups) 10)))
      ($permutations
        (if (= (optimize-level) 3)
            '(((#3%write 'a)) ((#3%write 'b)) ((#3%write 'c) (#3%write 'd) (#3%write 'e)))
            '(((#2%write 'a)) ((#2%write 'b)) ((#2%write 'c) (#2%write 'd) (#2%write 'e)))))))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      (expand/optimize '(let ([x (cons 0 (list))]) (#%apply #%zero? x))))
    #t)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      ;; don't fold primitive in value context with bad apply convention
      (expand/optimize '(#%apply #%zero? 0)))
    (if (= (optimize-level) 3)
        '(#3%apply #3%zero? 0)
        '(#2%apply #2%zero? 0)))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      ;; don't fold primitive in test context with bad apply convention
      (expand/optimize '(if (#%apply #%pair? 1 2 3) 4 5)))
    (if (= (optimize-level) 3)
        '(if (#3%apply #3%pair? 1 2 3) 4 5)
        '(if (#2%apply #2%pair? 1 2 3) 4 5)))
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
      ;; don't fold primitive in effect context with bad apply convention
      (expand/optimize '(begin (#%apply #%box? 'step) 3)))
    (if (= (optimize-level) 3)
        '(begin (#3%apply #3%box? 'step) 3)
        '(begin (#2%apply #2%box? 'step) 3)))
 )

(mat cp0-car/cdr
  (begin
    (define (expansion-matches? src expect)
      ;; Check that expansion matches or doesn't match under various conditions.
      ;; Expansion should not match in safe mode for expression involving the names
      ;; `$xxx`, `$yyy`, and `$zzz`, but it should match when those are wrapped with
      ;; `add1` (whcih makes the expression known-single-valued).
      ;; The names `$nontail-xxx`, `$nontail-yyy`, and `$nontail-zzz` must similarly
      ;; be wrapped to match in either safe or unsafe mode, since unsafe mode is obliged
      ;; to preserve non-tailness.
      ;; Other names, including `$xxx-ok`, can match without wrapping.
      (define (contains-id? id l)
        (or (eq? id l)
            (and (pair? l) (or (contains-id? id (car l)) (contains-id? id (cdr l))))))
      (define (primitive->level l)
        (cond
         [(pair? l)
          (if (and (eq? (car l) '$primitive)
                   (null? (cddr l)))
              (cons* (car l) (if (= (optimize-level) 3) 3 2) (cdr l))
              (cons (primitive->level (car l)) (primitive->level (cdr l))))]
         [else l]))
      (define (add-add1s l around-ids)
        (cond
         [(pair? l)
          (if (memq (car l) around-ids)
              `(#%add1 ,l)
              (cons (add-add1s (car l) around-ids) (add-add1s (cdr l) around-ids)))]
         [else l]))      
      (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
        (let* ([nontail-ids '($nontail-xxx $nontail-yyy $nontail-zzz)]
               [non-nontail-ids '($xxx $yyy $zzz)]
               [all-ids (if (= (optimize-level) 3)
                            nontail-ids
                            (append non-nontail-ids nontail-ids))])
          (and (if (andmap (lambda (id) (not (contains-id? id src))) all-ids)
                   (equivalent-expansion? (expand/optimize src)
                                          (primitive->level expect))
                   (not (equivalent-expansion? (expand/optimize src)
                                               (primitive->level expect))))
               (equivalent-expansion? (expand/optimize (add-add1s src all-ids))
                                      (primitive->level (add-add1s expect all-ids)))
               ;; Try subsets:
               (andmap (lambda (ids)
                         (if (ormap (lambda (id) (and (not (member id ids)) (contains-id? id src))) all-ids)
                             (not (equivalent-expansion? (expand/optimize (add-add1s src ids))
                                                         (primitive->level (add-add1s expect ids))))
                             (equivalent-expansion? (expand/optimize (add-add1s src ids))
                                                    (primitive->level (add-add1s expect ids)))))
                       (let loop ([ids all-ids])
                         (if (null? ids)
                             '()
                             (let ([subs (loop (cdr ids))])
                               (append (list (list (car ids)))
                                       subs
                                       (map (lambda (sub) (cons (car ids) sub)) subs))))))))))
    #t)
  (expansion-matches?
    '(begin (#%write 'a)
           ((begin (#%write 'b) #%car)
            (begin (#%write 'c)
              ((begin (#%write 'd) #%cons)
               (begin (#%write 'e) ($nontail-xxx))
               (begin (#%write 'f) ($yyy))))))
    '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'f) ($yyy) (#%write 'e) ($nontail-xxx)))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%car)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%cons)
                    (begin (#%write 'e) ($nontail-xxx))
                    (begin (#%write 'f) ($yyy))))))
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'f) ($yyy) (#%write 'e) ($nontail-xxx)))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%car)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%list)
                    (begin (#%write 'e) ($nontail-xxx))
                    (begin (#%write 'f) ($yyy))
                    (begin (#%write 'g) ($zzz))))))
    ; other possibilities exist but are too many to list and too difficult to construct with $permutations.
    ; if you see a problem, convert to use $check-writes (defined above)
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'f) ($yyy) (#%write 'g) ($zzz) (#%write 'e) ($nontail-xxx)))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%car)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%list*)
                    (begin (#%write 'e) ($nontail-xxx))
                    (begin (#%write 'f) ($yyy))
                    (begin (#%write 'g) ($zzz))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'f) ($yyy) (#%write 'g) ($zzz) (#%write 'e) ($nontail-xxx)))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%car)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%cons*)
                    (begin (#%write 'e) ($nontail-xxx))
                    (begin (#%write 'f) ($yyy))
                    (begin (#%write 'g) ($zzz))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'f) ($yyy) (#%write 'g) ($zzz) (#%write 'e) ($nontail-xxx)))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%cdr)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%cons)
                    (begin (#%write 'e) ($xxx))
                    (begin (#%write 'f) ($nontail-yyy))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%write 'f) ($nontail-yyy)))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%cdr)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%list)
                    (begin (#%write 'e) ($xxx))
                    (begin (#%write 'f) ($yyy-ok))
                    (begin (#%write 'g) ($zzz-ok))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%list (begin (#%write 'f) ($yyy-ok)) (begin (#%write 'g) ($zzz-ok)))))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%cdr)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%list*)
                    (begin (#%write 'e) ($xxx))
                    (begin (#%write 'f) ($yyy-ok))
                    (begin (#%write 'g) ($zzz-ok))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%list* (begin (#%write 'f) ($yyy-ok)) (begin (#%write 'g) ($zzz-ok)))))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%cdr)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%cons*)
                    (begin (#%write 'e) ($xxx))
                    (begin (#%write 'f) ($yyy-ok))
                    (begin (#%write 'g) ($zzz-ok))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%cons* (begin (#%write 'f) ($yyy-ok)) (begin (#%write 'g) ($zzz-ok)))))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%cdr)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%list*)
                    (begin (#%write 'e) ($xxx))
                    (begin (#%write 'f) ($nontail-yyy))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%write 'f) ($nontail-yyy)))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%cdr)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%cons*)
                    (begin (#%write 'e) ($xxx))
                    (begin (#%write 'f) ($nontail-yyy))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%write 'f) ($nontail-yyy)))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%cdr)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%list*)
                    (begin (#%write 'e) ($xxx-ok))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%cdr (begin (#%write 'c) (#%write 'd) (#%write 'e) ($xxx-ok)))))
  (expansion-matches?
   '(begin (#%write 'a)
           ((begin (#%write 'b) #%cdr)
            (begin (#%write 'c)
                   ((begin (#%write 'd) #%cons*)
                    (begin (#%write 'e) ($xxx-ok))))))
    ; other possibilities exist...
   '(begin (#%write 'a) (#%write 'b) (#%cdr (begin (#%write 'c) (#%write 'd) (#%write 'e) ($xxx-ok)))))
 )

(mat cp0-seq-ref
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level (max (optimize-level) 2)])
      (expand/optimize
        '(vector-ref (vector 1 2 3) 1)))
    2)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level (max (optimize-level) 2)])
      (expand/optimize
        '(list-ref (list 1 2 3) 1)))
    2)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level (max (optimize-level) 2)])
      (expand/optimize
        '(list-ref (list* 1 2 3) 1)))
    2)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level (max (optimize-level) 2)])
      (expand/optimize
        '(list-ref (cons* 1 2 3) 1)))
    2)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level (max (optimize-level) 2)])
      (expand/optimize
        '(fxvector-ref (fxvector 1 2 3) 1)))
    2)
  (equivalent-expansion?
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level (max (optimize-level) 2)])
      (expand/optimize
        '(string-ref (string #\1 #\2 #\3) 1)))
    #\2)
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) vector-ref)
            (begin (write 'c)
              ((begin (write 'd) vector)
               (begin (write 'e) ($xxx))
               (begin (write 'f) ($nontail-yyy))
               (begin (write 'g) ($zzz))))
            (begin (write 'h) 1)))
    ; other possibilities exist ...
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%write 'g) ($zzz) (#%write 'f) ($nontail-yyy)))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) vector-ref)
            (begin (write 'c)
              ((begin (write 'd) vector)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) ($yyy-ok))
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 3)))
    ; other possibilities exist...
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%vector-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%vector
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) ($yyy-ok))
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 3))))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) list-ref)
            (begin (write 'c)
              ((begin (write 'd) list)
               (begin (write 'e) ($xxx))
               (begin (write 'f) ($nontail-yyy))
               (begin (write 'g) ($zzz))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%write 'g) ($zzz) (#%write 'f) ($nontail-yyy)))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) list-ref)
            (begin (write 'c)
              ((begin (write 'd) list*)
               (begin (write 'e) ($xxx))
               (begin (write 'f) ($nontail-yyy))
               (begin (write 'g) ($zzz))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%write 'g) ($zzz) (#%write 'f) ($nontail-yyy)))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) list-ref)
            (begin (write 'c)
              ((begin (write 'd) cons*)
               (begin (write 'e) ($xxx))
               (begin (write 'f) ($nontail-yyy))
               (begin (write 'g) ($zzz))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx) (#%write 'g) ($zzz) (#%write 'f) ($nontail-yyy)))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) list-ref)
            (begin (write 'c)
              ((begin (write 'd) cons*)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) ($yyy-ok))
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 2)))
    ; other possibilities exist...
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%list-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%cons*
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) ($yyy-ok))
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 2))))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) string-ref)
            (begin (write 'c)
              ((begin (write 'd) string)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) #\y)
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
    (if (= (optimize-level) 3)
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx-ok) (#%write 'g) ($zzz-ok) (#%write 'f) #\y)
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%string-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%string
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) #\y)
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 1)))))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) string-ref)
            (begin (write 'c)
              ((begin (write 'd) string)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) 'oops)
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
    (if (= (optimize-level) 3)
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx-ok) (#%write 'g) ($zzz-ok) (#%write 'f) 'oops)
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%string-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%string
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) 'oops)
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 1)))))
  (expansion-matches?
        `(begin (write 'a)
           ((begin (write 'b) string-ref)
            (begin (write 'c)
              ((begin (write 'd) string)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) (,(if (= (optimize-level) 3) '$nontail-yyy '$yyy-ok)))
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
    (if (= (optimize-level) 3)
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx-ok) (#%write 'g) ($zzz-ok) (#%write 'f) ($nontail-yyy))
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%string-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%string
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) ($yyy-ok))
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 1)))))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) string-ref)
            (begin (write 'c)
              ((begin (write 'd) #2%string)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) ($yyy-ok))
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%string-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#2%string
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) ($yyy-ok))
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 1))))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) string-ref)
            (begin (write 'c)
              ((begin (write 'd) string)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) ($yyy-ok))
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 3)))
    ; other possibilities exist...
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%string-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%string
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) ($yyy-ok))
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 3))))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) fxvector-ref)
            (begin (write 'c)
              ((begin (write 'd) fxvector)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) 121)
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
    (if (= (optimize-level) 3)
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx-ok) (#%write 'g) ($zzz-ok) (#%write 'f) 121)
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%fxvector-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%fxvector
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) 121)
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 1)))))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) fxvector-ref)
            (begin (write 'c)
              ((begin (write 'd) fxvector)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) 'oops)
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
    (if (= (optimize-level) 3)
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx-ok) (#%write 'g) ($zzz-ok) (#%write 'f) 'oops)
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%fxvector-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%fxvector
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) 'oops)
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 1)))))
  (expansion-matches?
        `(begin (write 'a)
           ((begin (write 'b) fxvector-ref)
            (begin (write 'c)
              ((begin (write 'd) fxvector)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) (,(if (= (optimize-level) 3) '$nontail-yyy '$yyy-ok)))
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
    (if (= (optimize-level) 3)
        '(begin (#%write 'a) (#%write 'b) (#%write 'h) (#%write 'c) (#%write 'd) (#%write 'e) ($xxx-ok) (#%write 'g) ($zzz-ok) (#%write 'f) ($nontail-yyy))
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%fxvector-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%fxvector
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) ($yyy-ok))
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 1)))))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) fxvector-ref)
            (begin (write 'c)
              ((begin (write 'd) #2%fxvector)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) ($yyy-ok))
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 1)))
    ; other possibilities exist...
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%fxvector-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#2%fxvector
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) ($yyy-ok))
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 1))))
  (expansion-matches?
        '(begin (write 'a)
           ((begin (write 'b) fxvector-ref)
            (begin (write 'c)
              ((begin (write 'd) fxvector)
               (begin (write 'e) ($xxx-ok))
               (begin (write 'f) ($yyy-ok))
               (begin (write 'g) ($zzz-ok))))
            (begin (write 'h) 3)))
    ; other possibilities exist...
        '(begin
           (#%write 'a)
           (#%write 'b)
           (#%fxvector-ref
             (begin
               (#%write 'c)
               (#%write 'd)
               (#%fxvector
                 (begin (#%write 'e) ($xxx-ok))
                 (begin (#%write 'f) ($yyy-ok))
                 (begin (#%write 'g) ($zzz-ok))))
             (begin (#%write 'h) 3))))
 )

(mat let-pushing
  ; make sure letify doesn't drop the let binding for x into the call to cons which would
  ; cause the allocation of z's location not to be in the continuation of the rhs of x.
  (equal?
    (let ([ls '()])
      (let ([th.k (let ([x (call/cc (lambda (k) k))] [z 0])
                    (cons (lambda () (set! z (+ z 1)) z) x))])
        (and (set! ls (cons ((car th.k)) ls))
             (set! ls (cons ((car th.k)) ls))
             ((cdr th.k) (lambda (x) (set! ls (cons 17 ls))))))
      ls)
    '(17 2 1 2 1))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        '(lambda (x) (letrec ([y (if (pair? x) (#3%car x) x)]) 4))))
    '(lambda (x) 4))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        '(let ([x e]) (list (list x)))))
    '(#2%list (#2%list e)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        '(let ([x (lambda (x) x)]) (list (list x) (list 3)))))
    '(#2%list (#2%list (lambda (x) x)) (#2%list 3)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        '(lambda (y) (let ([x (+ y y)] [z #f]) (list (lambda () (set! z 15) z) x)))))
    '(lambda (y) (let ([x (#2%+ y y)] [z #f]) (#2%list (lambda () (set! z 15) z) x))))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 3])
      (expand/optimize
        '(lambda (y) (let ([x (+ y y)] [z #f]) (list (lambda () (set! z 15) z) x)))))
    ; doesn't push (+ y y) because it's not pure and one of the vars (z) is assigned
    '(lambda (y) (let ([x (#3%+ y y)] [z #f]) (#3%list (lambda () (set! z 15) z) x))))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 3])
      (expand/optimize
        '(lambda (y) (let ([x (make-message-condition y)] [z #f]) (list (lambda () (set! z 15) z) x)))))
    ; does push (make-message-condition y) because it is pure, even though one of the vars (z) is assigned
    '(lambda (y) (let ([z #f]) (#3%list (lambda () (set! z 15) z) (#3%make-message-condition y)))))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2] [compile-profile #f])
      (expand/optimize
        '(let ()
           (define-record foo ((immutable boolean x)))
           (or (foo-x e1) e2))))
    `(if (let ([g0 e1])
           (if (#3%record? g0 ',record-type-descriptor?)
               (#2%void)
               (#3%$record-oops 'foo-x g0 ',record-type-descriptor?))
           (#3%$object-ref 'boolean g0 ,fixnum?))
         #t
         e2))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 3] [compile-profile #f])
      (expand/optimize
        '(let ()
           (define-record foo ((immutable boolean x)))
           (or (foo-x e1) e2))))
    `(if (#3%$object-ref 'boolean e1 ,fixnum?) #t e2))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        '(lambda (v)
           (let ([v2 (if (vector? v) v (error))])
             (let ([q (vector-sort v2)] [n (#3%vector-length v)])
               (display "1")
               (list q n))))))
    '(lambda (v)
       (let ([v2 (begin (if (#2%vector? v) (#2%void) (#2%error)) v)])
         (let ([q (#2%vector-sort v2)] [n (#3%vector-length v)])
           (#2%display "1")
           (#2%list q n)))))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))] [optimize-level 2])
      (expand/optimize
        '(lambda (v)
           (let ([v2 (if (vector? v) v (error))])
             (let ([q (vector-sort v2)] [n (or v 72)])
               (display "1")
               (list q n))))))
    '(lambda (v)
       (let ([q (#2%vector-sort (begin (if (#2%vector? v) (#2%void) (#2%error)) v))]
             [n (if v v 72)])
         (#2%display "1")
         (#2%list q n))))
)

(mat equality-of-refs
  (begin
    (define-syntax eqtest
      (syntax-rules ()
        [(_ eqprim) (eqtest eqprim #f)]
        [(_ eqprim generic?)
         (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
           (let ([arity-mask (procedure-arity-mask eqprim)] [primref `($primitive ,(if (= (optimize-level) 3) 3 2) eqprim)])
             (define-syntax ifsafe
               (syntax-rules ()
                 [(_ n e1 e2)
                  (if (and (fxbit-set? arity-mask n) (or generic? (= (optimize-level) 3))) e1 e2)]))
             (and
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim x)))
                 (ifsafe 1
                   `(lambda (x) #t)
                   `(lambda (x) (,primref x))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim (begin (x) x))))
                 (ifsafe 1
                   `(lambda (x) (x) #t)
                   `(lambda (x) (,primref (begin (x) x)))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (set! x (x x)) (x (eqprim x))))
                 (ifsafe 1
                   `(lambda (x) (set! x (x x)) (x #t))
                   `(lambda (x) (set! x (x x)) (x (,primref x)))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim (x x))))
                 (ifsafe 1
                   `(lambda (x) (x x) #t)
                   `(lambda (x) (,primref (x x)))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim x x)))
                 (ifsafe 2
                   `(lambda (x) #t)
                   `(lambda (x) (,primref x x))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim (begin (x) x) x)))
                 (ifsafe 2
                   `(lambda (x) (x) #t)
                   `(lambda (x) (,primref (begin (x) x) x))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim x (begin (x) x))))
                 (ifsafe 2
                   `(lambda (x) (x) #t)
                   `(lambda (x) (,primref x (begin (x) x)))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim (begin (x) x) (begin (x x) x))))
                 (ifsafe 2
                   `(lambda (x) (x) (x x) #t)
                   `(lambda (x) (,primref (begin (x) x) (begin (x x) x)))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x y) (eqprim x y)))
                 `(lambda (x y) (,primref x y)))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim x x x x x)))
                 (ifsafe 5
                   `(lambda (x) #t)
                   `(lambda (x) (,primref x x x x x))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x y) (eqprim x x x x y)))
                 `(lambda (x y) (,primref x x x x y)))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim x x (begin (x) x) x x)))
                 (ifsafe 5
                   `(lambda (x) (x) #t)
                   `(lambda (x) (,primref x x (begin (x) x) x x))))
               (equivalent-expansion?
                 (expand/optimize
                   `(lambda (x) (eqprim x x (begin (set! x 15) x) x x)))
                 `(lambda (x) (,primref x x (begin (set! x 15) x) x x)))
               )))]))
    #t)
  (eqtest eq? #t)
  (eqtest eqv? #t)
  (eqtest equal? #t)
  (eqtest bytevector=?)
  (eqtest enum-set=?)
  (eqtest bound-identifier=?)
  (eqtest free-identifier=?)
  (eqtest ftype-pointer=?)
  (eqtest literal-identifier=?)
  (eqtest time=?)
  (eqtest boolean=?)
  (eqtest symbol=?)
  (eqtest char=?)
  (eqtest char-ci=?)
  (eqtest string=?)
  (eqtest string-ci=?)
  (eqtest r6rs:char=?)
  (eqtest r6rs:char-ci=?)
  (eqtest r6rs:string=?)
  (eqtest r6rs:string-ci=?)
  (eqtest fx=)
  (eqtest fx=?)
  (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
    (equivalent-expansion?
      (expand/optimize
        `(lambda (x) (fl= x x))) ; x could be +nan.0
      `(lambda (x) (($primitive ,(if (fx= (optimize-level) 3) 3 2) fl=) x x))))
  (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
    (equivalent-expansion?
      (expand/optimize
        `(lambda (x) (= x x))) ; x could be +nan.0
      `(lambda (x) (($primitive ,(if (fx= (optimize-level) 3) 3 2) =) x x))))
)

(mat cp0-non-tail
  ;; Make sure that an expression that might depend on a specific
  ;; continuation is not moved out of its continuation --- that is,
  ;; that it's not moved from non-taul to tail position within a
  ;; function. This constaint applies even with optimization level 3,
  ;; since it's about the behavior of programs without errors. Also
  ;; make sure that redudant wrappers are not left around expressions
  ;; where the context otherwise enforces a single-valued result.
  (begin
    (define (simplify-only-nontail? mk)
      (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
        (and
         ;; Identifier is known single-valued, doesn't use continuation:
         (equivalent-expansion?
          (expand/optimize `(lambda (g) ,(mk `g)))
          '(lambda (g) g))
         ;; Call to identifier is not known single-valued, might depend
         ;; on the continuation:
         (not (equivalent-expansion?
               (expand/optimize `(lambda (g) ,(mk `(g))))
               '(lambda (g) (g))))
         ;; Ditto, but in a nested procedure:
         (not (equivalent-expansion?
               (expand/optimize `(lambda () (lambda (g) ,(mk `(g)))))
               '(lambda () (lambda (g) (g)))))
         ;; Argument position already enforces single-valued and no
         ;; dependency on surrounding continuation:
         (equivalent-expansion?
          (expand/optimize `(lambda (g) (#2%list ,(mk `(g)))))
          '(lambda (g) (#2%list (g))))
         (equivalent-expansion?
          (expand/optimize `(lambda (g) (#3%list ,(mk `(g)))))
          '(lambda (g) (#3%list (g))))
         ;; Same for the test position of `if`:
         (equivalent-expansion?
          (expand/optimize `(lambda (g) (if ,(mk `(g)) 1 2)))
          '(lambda (g) (if (g) 1 2))))))
     #t)
   (simplify-only-nontail? (lambda (e) `(let ([x ,e]) x)))
   (simplify-only-nontail? (lambda (e) `(letrec ([x ,e]) x)))
   (simplify-only-nontail? (lambda (e) `(values ,e)))
   (simplify-only-nontail? (lambda (e) `(list* ,e)))
   (simplify-only-nontail? (lambda (e) `(append ,e)))
   (simplify-only-nontail? (lambda (e) `(append! ,e)))
   (simplify-only-nontail? (lambda (e) `(car (list ,e))))
   (simplify-only-nontail? (lambda (e) `(car (cons ,e 2))))
   (simplify-only-nontail? (lambda (e) `(cdr (cons 2 ,e))))
)

(mat cp0-single-valued
  ;; Make sure that lifted-out expressions retain a single-result
  ;; check in safe mode even when the result is not used, but no
  ;; check in unsafe mode.
  (begin
    (define adds-needed-$value?
      (case-lambda
       [(mk safe-extras)
        (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
          (and
           (equivalent-expansion?
            (expand/optimize `(lambda (g) ,(mk '(g) 3)))
            (if (= (optimize-level) 3)
                '(lambda (g) (g) 3)
                `(lambda (g) ,@safe-extras (#3%$value (g)) 3)))))]
       [(mk) (adds-needed-$value? mk '())]))
    (define posn-decl-expanded
      '((#2%$make-record-type-descriptor
         #!base-rtd 'posn #f #f #f #f
         '#((immutable x) (immutable y)) 'define-record-type)))
     #t)
   (adds-needed-$value? (lambda (e v) `(if (let ([x ,e]) #t) ,v 'other)))
   (adds-needed-$value? (lambda (e v) `(if (list ,e) ,v 'other)))
   (adds-needed-$value? (lambda (e v) `(if (if ,e #t 'yes) ,v 'other)))
   (adds-needed-$value? (lambda (e v) `(if (if ,e #f #f) 'other ,v)))
   (adds-needed-$value? (lambda (e v) `(if (if ,e #f #t) ,v ,v)))
   (adds-needed-$value? (lambda (e v) `(let ([unused 0]) (set! unused ,e) ,v)))
   (adds-needed-$value? (lambda (e v) `(car (cons ,v ,e))))
   (adds-needed-$value? (lambda (e v) `(vector-ref (vector ,v ,e) 0)))
   (adds-needed-$value? (lambda (e v) `(begin
                                         (define-record-type posn
                                           (fields x y))
                                         (make-posn -1 ,e)
                                         ,v))
                        posn-decl-expanded)
   (adds-needed-$value? (lambda (e v) `(let ()
                                         (define-record-type posn
                                           (fields x y))
                                         (posn-x (make-posn ,v ,e))))
                        posn-decl-expanded)
   (adds-needed-$value? (lambda (e v) `(let ()
                                         (define-record-type posn
                                           (fields x y))
                                         (if (make-posn 0 ,e) ,v 'other)))
                        posn-decl-expanded)
   (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f])
     (equivalent-expansion?
      (expand/optimize '(let ([g1 (begin (unknown) (void))]) 10))
      '(begin (unknown) 10)))
)