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

add primitive expander for tree-il

Browse source 
* module/Makefile.am: Add inline.scm.

* module/language/tree-il.scm (pre-order!, post-order!): pre-order! is
  new. post-order! existed but was not public. They do destructive tree
  traversals of tree-il, and need more documentation. Also, add
  predicates to tree-il's export list.

* module/language/tree-il/inline.scm: New file, which expands primitives
  into more primitive primitives. In the future perhaps it will not be
  necessary, as the general inlining infrastructure will handle these
  cases, but for now it's useful.

* module/language/tree-il/optimize.scm: Move post-order! out to better
  pastures.
This commit is contained in:
Andy Wingo 2009-05-12 22:29:34 +02:00
parent 9efc833d65
commit cb28c08537
4 changed files with 264 additions and 79 deletions
Download patch file Download diff file Expand all files Collapse all files

63
module/language/tree-il/optimize.scm
View file

@ -34,69 +34,6 @@
;; * degenerate case optimizations
;; * "fixing letrec"
(define (post-order! f x)
(let lp ((x x))
(record-case x
((<application> proc args)
(set! (application-proc x) (lp proc))
(set! (application-args x) (map lp args))
(or (f x) x))
((<conditional> test then else)
(set! (conditional-test x) (lp test))
(set! (conditional-then x) (lp then))
(set! (conditional-else x) (lp else))
(or (f x) x))
((<primitive-ref> name)
(or (f x) x))
((<lexical-ref> name gensym)
(or (f x) x))
((<lexical-set> name gensym exp)
(set! (lexical-set-exp x) (lp exp))
(or (f x) x))
((<module-ref> mod name public?)
(or (f x) x))
((<module-set> mod name public? exp)
(set! (module-set-exp x) (lp exp))
(or (f x) x))
((<toplevel-ref> name)
(or (f x) x))
((<toplevel-set> name exp)
(set! (toplevel-set-exp x) (lp exp))
(or (f x) x))
((<toplevel-define> name exp)
(set! (toplevel-define-exp x) (lp exp))
(or (f x) x))
((<lambda> vars meta body)
(set! (lambda-body x) (lp body))
(or (f x) x))
((<const> exp)
(or (f x) x))
((<sequence> exps)
(set! (sequence-exps x) (map lp exps))
(or (f x) x))
((<let> vars vals exp)
(set! (let-vals x) (map lp vals))
(set! (let-exp x) (lp exp))
(or (f x) x))
((<letrec> vars vals exp)
(set! (letrec-vals x) (map lp vals))
(set! (letrec-exp x) (lp exp))
(or (f x) x)))))
(define *interesting-primitive-names*
'(apply @apply
call-with-values @call-with-values