diff --git a/module/Makefile.am b/module/Makefile.am
index 3f607f259..36d670002 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -74,6 +74,7 @@ SCHEME_LANG_SOURCES =						\
 TREE_IL_LANG_SOURCES =						\
   language/tree-il/spec.scm 					\
   language/tree-il/compile-glil.scm 				\
+  language/tree-il/inline.scm					\
   language/tree-il/optimize.scm
 
 GHIL_LANG_SOURCES =					\
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 3de73b9c0..774ca2ca7 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -24,25 +24,28 @@
             <lexical> make-lexical
             lexical-name lexical-gensym
 
-            <application> make-application application-src application-proc application-args
-            <conditional> make-conditional conditional-src conditional-test conditional-then conditional-else
-            <primitive-ref> make-primitive-ref primitive-ref-src primitive-ref-name
-            <lexical-ref> make-lexical-ref lexical-ref-src lexical-ref-name lexical-ref-gensym
-            <lexical-set> make-lexical-set lexical-set-src lexical-set-name lexical-set-gensym lexical-set-exp
-            <module-ref> make-module-ref module-ref-src module-ref-mod module-ref-name module-ref-public?
-            <module-set> make-module-set module-set-src module-set-mod module-set-name module-set-public? module-set-exp
-            <toplevel-ref> make-toplevel-ref toplevel-ref-src toplevel-ref-name
-            <toplevel-set> make-toplevel-set toplevel-set-src toplevel-set-name toplevel-set-exp
-            <toplevel-define> make-toplevel-define toplevel-define-src toplevel-define-name toplevel-define-exp
-            <lambda> make-lambda lambda-src lambda-vars lambda-meta lambda-body
-            <const> make-const const-src const-exp
-            <sequence> make-sequence sequence-src sequence-exps
-            <let> make-let let-src let-vars let-vals let-exp
-            <letrec> make-letrec letrec-src letrec-vars letrec-vals letrec-exp
+            <application> application? make-application application-src application-proc application-args
+            <conditional> conditional? make-conditional conditional-src conditional-test conditional-then conditional-else
+            <primitive-ref> primitive-ref? make-primitive-ref primitive-ref-src primitive-ref-name
+            <lexical-ref> lexical-ref? make-lexical-ref lexical-ref-src lexical-ref-name lexical-ref-gensym
+            <lexical-set> lexical-set? make-lexical-set lexical-set-src lexical-set-name lexical-set-gensym lexical-set-exp
+            <module-ref> module-ref? make-module-ref module-ref-src module-ref-mod module-ref-name module-ref-public?
+            <module-set> module-set? make-module-set module-set-src module-set-mod module-set-name module-set-public? module-set-exp
+            <toplevel-ref> toplevel-ref? make-toplevel-ref toplevel-ref-src toplevel-ref-name
+            <toplevel-set> toplevel-set? make-toplevel-set toplevel-set-src toplevel-set-name toplevel-set-exp
+            <toplevel-define> toplevel-define? make-toplevel-define toplevel-define-src toplevel-define-name toplevel-define-exp
+            <lambda> lambda? make-lambda lambda-src lambda-vars lambda-meta lambda-body
+            <const> const? make-const const-src const-exp
+            <sequence> sequence? make-sequence sequence-src sequence-exps
+            <let> let? make-let let-src let-vars let-vals let-exp
+            <letrec> letrec? make-letrec letrec-src letrec-vars letrec-vals letrec-exp
 
             parse-tree-il
             unparse-tree-il
-            tree-il->scheme))
+            tree-il->scheme
+
+            post-order!
+            pre-order!))
 
 (define-type (<tree-il> #:common-slots (src))
   (<application> proc args)
@@ -246,3 +249,108 @@
            ((<letrec> vars vals exp)
             `(letrec ,(map list vars (map tree-il->scheme vals)) ,(tree-il->scheme exp)))))
         (else e)))
+
+(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 (pre-order! f x)
+  (let lp ((x x))
+    (let ((x (or (f x) x)))
+      (record-case x
+        ((<application> proc args)
+         (set! (application-proc x) (lp proc))
+         (set! (application-args x) (map lp args)))
+
+        ((<conditional> test then else)
+         (set! (conditional-test x) (lp test))
+         (set! (conditional-then x) (lp then))
+         (set! (conditional-else x) (lp else)))
+
+        ((<lexical-set> name gensym exp)
+         (set! (lexical-set-exp x) (lp exp)))
+               
+        ((<module-set> mod name public? exp)
+         (set! (module-set-exp x) (lp exp)))
+
+        ((<toplevel-set> name exp)
+         (set! (toplevel-set-exp x) (lp exp)))
+
+        ((<toplevel-define> name exp)
+         (set! (toplevel-define-exp x) (lp exp)))
+
+        ((<lambda> vars meta body)
+         (set! (lambda-body x) (lp body)))
+
+        ((<sequence> exps)
+         (set! (sequence-exps x) (map lp exps)))
+
+        ((<let> vars vals exp)
+         (set! (let-vals x) (map lp vals))
+         (set! (let-exp x) (lp exp)))
+
+        ((<letrec> vars vals exp)
+         (set! (letrec-vals x) (map lp vals))
+         (set! (letrec-exp x) (lp exp)))
+
+        (else #f))
+      x)))
diff --git a/module/language/tree-il/inline.scm b/module/language/tree-il/inline.scm
new file mode 100644
index 000000000..0161faf02
--- /dev/null
+++ b/module/language/tree-il/inline.scm
@@ -0,0 +1,139 @@
+;;; GHIL macros
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; 
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; 
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language tree-il inline)
+  #:use-module (system base syntax)
+  #:use-module (language tree-il)
+  #:use-module (srfi srfi-16)
+  #:export (expand-primitives!))
+
+(define *primitive-expand-table* (make-hash-table))
+
+(define (expand-primitives! x)
+  (pre-order!
+   (lambda (x)
+     (record-case x
+       ((<application> src proc args)
+        (and (primitive-ref? proc)
+             (let ((expand (hashq-ref *primitive-expand-table*
+                                      (primitive-ref-name proc))))
+               (and expand (apply expand src args)))))
+       (else #f)))
+   x))
+
+;;; I actually did spend about 10 minutes trying to redo this with
+;;; syntax-rules. Patches appreciated.
+;;;
+(define-macro (define-primitive-expander sym . clauses)
+  (define (inline-args args)
+    (let lp ((in args) (out '()))
+      (cond ((null? in) `(list ,@(reverse out)))
+            ((symbol? in) `(cons* ,@(reverse out) ,in))
+            ((pair? (car in))
+             (lp (cdr in)
+                 (cons `(make-application src (make-primitive-ref src ',(caar in))
+                                          ,(inline-args (cdar in)))
+                       out)))
+            ((symbol? (car in))
+             ;; assume it's locally bound
+             (lp (cdr in) (cons (car in) out)))
+            ((number? (car in))
+             (lp (cdr in) (cons `(make-const src ,(car in)) out)))
+            (else
+             (error "what what" (car in))))))
+  (define (consequent exp)
+    (cond
+     ((pair? exp)
+      `(make-application src (make-primitive-ref src ',(car exp))
+                         ,(inline-args (cdr exp))))
+     ((symbol? exp)
+      ;; assume locally bound
+      exp)
+     ((number? exp)
+      `(make-const src ,exp))
+     (else (error "bad consequent yall" exp))))
+  `(hashq-set! *primitive-expand-table*
+               ',sym
+               (case-lambda
+                ,@(let lp ((in clauses) (out '()))
+                    (if (null? in)
+                        (reverse (cons '(else #f) out))
+                        (lp (cddr in)
+                            (cons `((src . ,(car in))
+                                    ,(consequent (cadr in))) out)))))))
+
+(define-primitive-expander +
+  () 0
+  (x) x
+  (x y z . rest) (+ x (+ y z . rest)))
+  
+(define-primitive-expander *
+  () 1
+  (x) x
+  (x y z . rest) (* x (* y z . rest)))
+  
+(define-primitive-expander -
+  (x) (- 0 x)
+  (x y z . rest) (- x (+ y z . rest)))
+  
+(define-primitive-expander 1-
+  (x) (- x 1))
+
+(define-primitive-expander /
+  (x) (/ 1 x)
+  (x y z . rest) (div x (* y z . rest)))
+  
+(define-primitive-expander caar (x) (car (car x)))
+(define-primitive-expander cadr (x) (car (cdr x)))
+(define-primitive-expander cdar (x) (cdr (car x)))
+(define-primitive-expander cddr (x) (cdr (cdr x)))
+(define-primitive-expander caaar (x) (car (car (car x))))
+(define-primitive-expander caadr (x) (car (car (cdr x))))
+(define-primitive-expander cadar (x) (car (cdr (car x))))
+(define-primitive-expander caddr (x) (car (cdr (cdr x))))
+(define-primitive-expander cdaar (x) (cdr (car (car x))))
+(define-primitive-expander cdadr (x) (cdr (car (cdr x))))
+(define-primitive-expander cddar (x) (cdr (cdr (car x))))
+(define-primitive-expander cdddr (x) (cdr (cdr (cdr x))))
+(define-primitive-expander caaaar (x) (car (car (car (car x)))))
+(define-primitive-expander caaadr (x) (car (car (car (cdr x)))))
+(define-primitive-expander caadar (x) (car (car (cdr (car x)))))
+(define-primitive-expander caaddr (x) (car (car (cdr (cdr x)))))
+(define-primitive-expander cadaar (x) (car (cdr (car (car x)))))
+(define-primitive-expander cadadr (x) (car (cdr (car (cdr x)))))
+(define-primitive-expander caddar (x) (car (cdr (cdr (car x)))))
+(define-primitive-expander cadddr (x) (car (cdr (cdr (cdr x)))))
+(define-primitive-expander cdaaar (x) (cdr (car (car (car x)))))
+(define-primitive-expander cdaadr (x) (cdr (car (car (cdr x)))))
+(define-primitive-expander cdadar (x) (cdr (car (cdr (car x)))))
+(define-primitive-expander cdaddr (x) (cdr (car (cdr (cdr x)))))
+(define-primitive-expander cddaar (x) (cdr (cdr (car (car x)))))
+(define-primitive-expander cddadr (x) (cdr (cdr (car (cdr x)))))
+(define-primitive-expander cdddar (x) (cdr (cdr (cdr (car x)))))
+(define-primitive-expander cddddr (x) (cdr (cdr (cdr (cdr x)))))
+
+(define-primitive-expander cons*
+  (x) x
+  (x y) (cons x y)
+  (x y . rest) (cons x (cons* y . rest)))
+
+(define-primitive-expander acons
+  (x y z) (cons (cons x y) z))
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
index 69aff6f78..52baddb08 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -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