+ (pass-if-peval resolve-primitives
+ ;; The inliner sees through a `let'.
+ ((let ((a 10)) (lambda (b) (* b 2))) 30)
+ (const 60))
+
+ (pass-if-peval
+ ((lambda ()
+ (define (const x) (lambda (_) x))
+ (let ((v #f))
+ ((const #t) v))))
+ (const #t))
+
+ (pass-if-peval
+ ;; Applications of procedures with rest arguments can get inlined.
+ ((lambda (x y . z)
+ (list x y z))
+ 1 2 3 4)
+ (let (z) (_) ((apply (primitive list) (const 3) (const 4)))
+ (apply (primitive list) (const 1) (const 2) (lexical z _))))
+
+ (pass-if-peval resolve-primitives
+ ;; Unmutated lists can get inlined.
+ (let ((args (list 2 3)))
+ (apply (lambda (x y z w)
+ (list x y z w))
+ 0 1 args))
+ (apply (primitive list) (const 0) (const 1) (const 2) (const 3)))
+
+ (pass-if-peval resolve-primitives
+ ;; However if the list might have been mutated, it doesn't propagate.
+ (let ((args (list 2 3)))
+ (foo! args)
+ (apply (lambda (x y z w)
+ (list x y z w))
+ 0 1 args))
+ (let (args) (_) ((apply (primitive list) (const 2) (const 3)))
+ (begin
+ (apply (toplevel foo!) (lexical args _))
+ (apply (primitive @apply)
+ (lambda ()
+ (lambda-case
+ (((x y z w) #f #f #f () (_ _ _ _))
+ (apply (primitive list)
+ (lexical x _) (lexical y _)
+ (lexical z _) (lexical w _)))))
+ (const 0)
+ (const 1)
+ (lexical args _)))))
+
+ (pass-if-peval resolve-primitives
+ ;; Here the `args' that gets built by the application of the lambda
+ ;; takes more than effort "10" to visit. Test that we fall back to
+ ;; the source expression of the operand, which is still a call to
+ ;; `list', so the inlining still happens.
+ (lambda (bv offset n)
+ (let ((x (bytevector-ieee-single-native-ref
+ bv
+ (+ offset 0)))
+ (y (bytevector-ieee-single-native-ref
+ bv
+ (+ offset 4))))
+ (let ((args (list x y)))
+ (@apply
+ (lambda (bv offset x y)
+ (bytevector-ieee-single-native-set!
+ bv
+ (+ offset 0)
+ x)
+ (bytevector-ieee-single-native-set!
+ bv
+ (+ offset 4)
+ y))
+ bv
+ offset
+ args))))
+ (lambda ()
+ (lambda-case
+ (((bv offset n) #f #f #f () (_ _ _))
+ (let (x y) (_ _) ((apply (primitive bytevector-ieee-single-native-ref)
+ (lexical bv _)
+ (apply (primitive +)
+ (lexical offset _) (const 0)))
+ (apply (primitive bytevector-ieee-single-native-ref)
+ (lexical bv _)
+ (apply (primitive +)
+ (lexical offset _) (const 4))))
+ (begin
+ (apply (primitive bytevector-ieee-single-native-set!)
+ (lexical bv _)
+ (apply (primitive +)
+ (lexical offset _) (const 0))
+ (lexical x _))
+ (apply (primitive bytevector-ieee-single-native-set!)
+ (lexical bv _)
+ (apply (primitive +)
+ (lexical offset _) (const 4))
+ (lexical y _))))))))
+
+ (pass-if-peval resolve-primitives
+ ;; Here we ensure that non-constant expressions are not copied.
+ (lambda ()
+ (let ((args (list (foo!))))
+ (@apply
+ (lambda (z x)
+ (list z x))
+ ;; This toplevel ref might raise an unbound variable exception.
+ ;; The effects of `(foo!)' must be visible before this effect.
+ z
+ args)))
+ (lambda ()
+ (lambda-case
+ ((() #f #f #f () ())
+ (let (_) (_) ((apply (toplevel foo!)))
+ (let (z) (_) ((toplevel z))
+ (apply (primitive 'list)
+ (lexical z _)
+ (lexical _ _))))))))
+
+ (pass-if-peval resolve-primitives
+ ;; Rest args referenced more than once are not destructured.
+ (lambda ()
+ (let ((args (list 'foo)))
+ (set-car! args 'bar)
+ (@apply
+ (lambda (z x)
+ (list z x))
+ z
+ args)))
+ (lambda ()
+ (lambda-case
+ ((() #f #f #f () ())
+ (let (args) (_)
+ ((apply (primitive list) (const foo)))
+ (begin
+ (apply (primitive set-car!) (lexical args _) (const bar))
+ (apply (primitive @apply)
+ (lambda . _)
+ (toplevel z)
+ (lexical args _))))))))
+
+ (pass-if-peval resolve-primitives
+ ;; Let-values inlining, even with consumers with rest args.
+ (call-with-values (lambda () (values 1 2))
+ (lambda args
+ (apply list args)))
+ (apply (primitive list) (const 1) (const 2)))
+