mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 08:20:20 +02:00
Code Activity

optimize (apply foo 0 (list 1 2)) => (foo 0 1 2)

Browse source 
* module/language/tree-il/peval.scm (peval): Inline applications where
  we know the contents of the tail.

* test-suite/tests/peval.test ("partial evaluation"): Add tests.
This commit is contained in:
Andy Wingo 2012-07-05 20:30:18 +02:00
parent c0cfa9ef07
commit 3d2bcd2c35
2 changed files with 20 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

11
module/language/tree-il/peval.scm
View file

@ -1094,6 +1094,17 @@ top-level bindings from ENV and return the resulting expression."
(every singly-valued-expression? vals))
(for-tail (make-sequence src (append (cdr vals) (list (car vals)))))
(make-application src (make-primitive-ref #f 'values) vals))))))
(($ <application> src (and apply ($ <primitive-ref> _ (or 'apply '@apply)))
(proc args ... tail))
(match (for-value tail)
(($ <const> _ (args* ...))
(let ((args* (map (lambda (x) (make-const #f x)) args*)))
(for-tail (make-application src proc (append args args*)))))
(($ <application> _ ($ <primitive-ref> _ 'list) args*)
(for-tail (make-application src proc (append args args*))))
(tail
(let ((args (append (map for-value args) (list tail))))
(make-application src apply (cons (for-value proc) args))))))
(($ <application> src orig-proc orig-args)
;; todo: augment the global env with specialized functions
(let ((proc (visit orig-proc 'operator)))

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

@ -1055,4 +1055,12 @@
(apply (toplevel baz) (toplevel x))
(apply (lexical failure _)))))
(apply (lexical failure _)))
(apply (lexical failure _))))))
(apply (lexical failure _)))))
(pass-if-peval resolve-primitives
(apply (lambda (x y) (cons x y)) '(1 2))
(apply (primitive cons) (const 1) (const 2)))
(pass-if-peval resolve-primitives
(apply (lambda (x y) (cons x y)) (list 1 2))
(apply (primitive cons) (const 1) (const 2))))