mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +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

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

@ -709,8 +709,9 @@ top-level bindings from ENV and return the resulting expression."
;; some special cases like `apply' or prompts if we can account
;; for all of its uses.
;;
;; You don't want to use this in general because it doesn't run the full
;; partial evaluator, so it doesn't fold constant expressions, etc.
;; You don't want to use this in general because it introduces a slight
;; nonlinearity by running peval again (though with a small effort and size
;; counter).
;;
(define (find-definition x n-aliases)
(cond
@ -719,7 +720,8 @@ top-level bindings from ENV and return the resulting expression."
((lookup (lexical-ref-gensym x))
=> (lambda (op)
(let ((y (or (operand-residual-value op)
(visit-operand op counter 'value 10 10))))
(visit-operand op counter 'value 10 10)
(operand-source op))))
(cond
((and (lexical-ref? y)
(= (lexical-refcount (lexical-ref-gensym x)) 1))
@ -1148,15 +1150,22 @@ top-level bindings from ENV and return the resulting expression."
(($ <application> src (and apply ($ <primitive-ref> _ (or 'apply '@apply)))
(proc args ... tail))
(let lp ((tail* (find-definition tail 1)) (speculative? #t))
(define (copyable? x)
;; Inlining a result from find-definition effectively copies it,
;; relying on the let-pruning to remove its original binding. We
;; shouldn't copy non-constant expressions.
(or (not speculative?) (constant-expression? x)))
(match tail*
(($ <const> _ (args* ...))
(let ((args* (map (cut make-const #f <>) args*)))
(for-tail (make-application src proc (append args args*)))))
(($ <application> _ ($ <primitive-ref> _ 'cons) (head tail))
(($ <application> _ ($ <primitive-ref> _ 'cons)
((and head (? copyable?)) (and tail (? copyable?))))
(for-tail (make-application src apply
(cons proc
(append args (list head tail))))))
(($ <application> _ ($ <primitive-ref> _ 'list) args*)
(($ <application> _ ($ <primitive-ref> _ 'list)
(and args* ((? copyable?) ...)))
(for-tail (make-application src proc (append args args*))))
(tail*
(if speculative?