dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

peval: visit operands on-demand, to inline mutually recursive bindings

Browse source 
This commit changes to use <operand> structures to hold the context
needed to visit lexical bindings lazily, in context, instead of eagerly
visiting them for value.  This laziness enables inlining of mutually
recursive bindings.

* module/language/tree-il/peval.scm (<var>): Remove comment about copy
  propagation having to run build-var-table; things don't work like that
  any more.
  (build-var-table): Build <var> entries for all variables, even
  unreferenced variables.
  (alpha-rename): Remove.  We will rename bindings on-demand now.

  (peval lookup-var): New helper, to fetch the <var> of a gensym.

  (peval fresh-gensyms): Fold here, under peval, and in it, handle
  updating the store to record a mapping between new names and <var>
  entries from the source program.

  (peval record-source-expression): Don't call build-var-table on the
  new expression, as alpha-renaming happens on-demand now.

  (peval prune-bindings): Rewrite to work with mutually-recursive
  bindings, while optionally preserving binding order.

  (peval extend-env): New helper.

  (peval loop): OK, here goes... Remove the `operand' context, as now we
  visit operands lazily.  Add a `call' context, which does not
  copy-propagate lambda expressions, used to residualize a call after
  aborting an inlining attempt.  Change the `env' to be a mapping of
  gensym to <operand>.  Instead of looking up the operand's binding then
  alpha-renaming it, just rely on the fact that visiting the operand
  will rename it if necessary.

  If we residualize a lexical, do so with the fresh name from the
  environment.  If we visit an operand and it doesn't turn out to be
  constant, we will never be able to copy it, and so cache that fact in
  the operand.  If we residualize a binding and we know what the value
  should be, record that binding so that prune-bindings won't have to
  visit it again.  If the operand folds to a constant, cache that too,
  to save effort when unrolling loops.

  For let, letrec, fix, and lambda-case, instead of visiting the
  bindings eagerly for value, simply record the source expressions and
  environments in an <operand> and rely on copy-propagation to visit
  them later in the right context.  In the case of letrec and fix, this
  allows mutually-recursive bindings to be inlined.

  Refactor folding of "constructors" (which still need renaming) to
  avoid visiting operands twice in some contexts.

  For applications, if we have to abort, process the procedure in call
  context, which allows some folding but avoids copying lambdas.  If we
  find a recursive procedure, mark intervening counters as recursive
  too, to allow for mutual recursion at the top level.

  For lambdas, if we are processing for value, record the source
  expression so we can detect recursion.  This was previously done in
  the lexical-ref copy propagator.

* test-suite/tests/tree-il.test ("partial evaluation"): Remove unused
  recursive lexicals in a couple of cases.  Add a couple test cases for
  pruning.  Add a few recursive binding cases.
This commit is contained in:
Andy Wingo 2011-10-10 12:58:28 +02:00
commit 751708726b
2 changed files with 478 additions and 388 deletions
Download patch file Download diff file Expand all files Collapse all files

156
test-suite/tests/tree-il.test
View file

@ -716,17 +716,16 @@
(if (zero? i)
r
(loop (1- i) (cons (cons i i) r))))
(letrec (loop) (_) (_)
(let (r) (_)
((apply (primitive list)
(apply (primitive cons) (const 3) (const 3))))
(let (r) (_)
((apply (primitive cons)
(apply (primitive cons) (const 2) (const 2))
(lexical r _)))
(apply (primitive cons)
(apply (primitive cons) (const 1) (const 1))
(lexical r _))))))
(let (r) (_)
((apply (primitive list)
(apply (primitive cons) (const 3) (const 3))))
(let (r) (_)
((apply (primitive cons)
(apply (primitive cons) (const 2) (const 2))
(lexical r _)))
(apply (primitive cons)
(apply (primitive cons) (const 1) (const 1))
(lexical r _)))))
;; See above.
(pass-if-peval
@ -735,23 +734,22 @@
(if (<= i 0)
(car r)
(loop (1- i) (cons i r))))
(letrec (loop) (_) (_)
(let (r) (_)
((apply (primitive list) (const 4)))
(let (r) (_)
((apply (primitive cons)
(const 3)
(lexical r _)))
(let (r) (_)
((apply (primitive cons)
(const 2)
(lexical r _)))
(let (r) (_)
((apply (primitive cons)
(const 1)
(lexical r _)))
(apply (primitive car)
(lexical r _))))))))
(let (r) (_)
((apply (primitive list) (const 4)))
(let (r) (_)
((apply (primitive cons)
(const 3)
(lexical r _)))
(let (r) (_)
((apply (primitive cons)
(const 2)
(lexical r _)))
(let (r) (_)
((apply (primitive cons)
(const 1)
(lexical r _)))
(apply (primitive car)
(lexical r _)))))))
;; Static sums.
(pass-if-peval
@ -1049,13 +1047,30 @@
(not (eq? gensym1 gensym2))))
(_ #f)))
(pass-if-peval
;; Unused letrec bindings are pruned.
(letrec ((a (lambda () (b)))
(b (lambda () (a)))
(c (lambda (x) x)))
(c 10))
(const 10))
(pass-if-peval
;; Unused letrec bindings are pruned.
(letrec ((a (foo!))
(b (lambda () (a)))
(c (lambda (x) x)))
(c 10))
(begin (apply (toplevel foo!))
(const 10)))
(pass-if-peval
;; Higher order, mutually recursive procedures.
(letrec ((even? (lambda (x)
(or (= 0 x)
(odd? (- x 1)))))
(odd? (lambda (x)
(not (even? (- x 1))))))
(not (even? x)))))
(and (even? 4) (odd? 7)))
(const #t))
@ -1203,8 +1218,7 @@
(loop x (1- y))
(foo x y))))
(let (x) (_) ((apply (toplevel top)))
(letrec (loop) (_) (_)
(apply (toplevel foo) (lexical x _) (const 0)))))
(apply (toplevel foo) (lexical x _) (const 0))))
(pass-if-peval
;; Inlining aborted when residual code contains recursive calls.
@ -1241,6 +1255,86 @@
(letrec (loop) (_) ((lambda . _))
(apply (lexical loop _) (const 0))))
(pass-if-peval
;; This test checks that the `start' binding is indeed residualized.
;; See the `referenced?' procedure in peval's `prune-bindings'.
(let ((pos 0))
(set! pos 1) ;; Cause references to `pos' to residualize.
(let ((here (let ((start pos)) (lambda () start))))
(here)))
(let (pos) (_) ((const 0))
(begin
(set! (lexical pos _) (const 1))
(let (here) (_) (_)
(apply (lexical here _))))))
(pass-if-peval
;; FIXME: should this one residualize the binding?
(letrec ((a a))
1)
(const 1))
(pass-if-peval
;; This is a fun one for peval to handle.
(letrec ((a a))
a)
(letrec (a) (_) ((lexical a _))
(lexical a _)))
(pass-if-peval
;; Another interesting recursive case.
(letrec ((a b) (b a))
a)
(letrec (a) (_) ((lexical a _))
(lexical a _)))
(pass-if-peval
;; Another pruning case, that `a' is residualized.
(letrec ((a (lambda () (a)))
(b (lambda () (a)))
(c (lambda (x) x)))
(let ((d (foo b)))
(c d)))
;; "b c a" is the current order that we get with unordered letrec,
;; but it's not important to this test, so if it changes, just adapt
;; the test.
(letrec (b c a) (_ _ _)
((lambda _
(lambda-case
((() #f #f #f () ())
(apply (lexical a _)))))
(lambda _
(lambda-case
(((x) #f #f #f () (_))
(lexical x _))))
(lambda _
(lambda-case
((() #f #f #f () ())
(apply (lexical a _))))))
(let (d)
(_)
((apply (toplevel foo) (lexical b _)))
(apply (lexical c _)
(lexical d _)))))
(pass-if-peval
;; In this case, we can prune the bindings. `a' ends up being copied
;; because it is only referenced once in the source program. Oh
;; well.
(letrec* ((a (lambda (x) (top x)))
(b (lambda () a)))
(foo (b) (b)))
(apply (toplevel foo)
(lambda _
(lambda-case
(((x) #f #f #f () (_))
(apply (toplevel top) (lexical x _)))))
(lambda _
(lambda-case
(((x) #f #f #f () (_))
(apply (toplevel top) (lexical x _)))))))
(pass-if-peval
;; Constant folding: cons
(begin (cons 1 2) #f)