mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-26 05:00:28 +02:00
Code Activity

more rest argument inlining improvements

Browse source 
* module/language/tree-il/peval.scm (peval): Correct comment on
  find-definition, and allow a find-definition to fall back on a source
  expression.  Avoid copying non-constant expressions.

* test-suite/tests/peval.test ("partial evaluation"): Add a test that
  inlining rest arguments works with complicated argument expressions,
  and a test that order of effects in rest args is preserved.
This commit is contained in:
Andy Wingo 2013-02-15 14:15:15 +01:00
parent d21537efb4
commit 8598dd8d28
2 changed files with 85 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

71
test-suite/tests/peval.test
View file

@ -25,6 +25,7 @@
#:use-module (language tree-il)
#:use-module (language tree-il primitives)
#:use-module (language glil)
#:use-module (rnrs bytevectors) ;; for the bytevector primitives
#:use-module (srfi srfi-13))
(define peval
@ -879,6 +880,76 @@
(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 (args) (_)
((apply (primitive list) (apply (toplevel foo!))))
(apply (primitive @apply)
(lambda . _)
(toplevel z)
(lexical args _)))))))
(pass-if-peval
;; Constant folding: cons of #nil does not make list
(cons 1 #nil)