more work on tree-il compilation

* module/language/scheme/amatch.scm: Remove, this approach won't be used.

* module/Makefile.am: Adjust for additions and removals.

* module/language/scheme/compile-ghil.scm: Remove an vestigial debugging
  statement.

* module/language/scheme/spec.scm:
* module/language/scheme/compile-tree-il.scm:
* module/language/scheme/decompile-tree-il.scm: Add tree-il compiler and
  decompiler.

* module/language/tree-il/compile-glil.scm: Add some notes.

* module/language/tree-il/spec.scm: No need to wrap expressions in
  lambdas -- GHIL needs somewhere to put its variables, we don't.

8 files changed, 115 insertions, 52 deletions

diff --git a/module/Makefile.am b/module/Makefile.am
index 761b1868b..ffe159ce9 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -65,8 +65,10 @@ ice-9/psyntax-pp.scm: ice-9/psyntax.scm
 		$(srcdir)/ice-9/psyntax.scm $(srcdir)/ice-9/psyntax-pp.scm
 
 SCHEME_LANG_SOURCES =						\
-  language/scheme/amatch.scm \
-  language/scheme/compile-ghil.scm language/scheme/spec.scm	\
+  language/scheme/compile-ghil.scm 				\
+  language/scheme/spec.scm					\
+  language/scheme/compile-tree-il.scm				\
+  language/scheme/decompile-tree-il.scm				\
   language/scheme/inline.scm
 
 TREE_IL_LANG_SOURCES =	\
diff --git a/module/language/scheme/amatch.scm b/module/language/scheme/amatch.scm
deleted file mode 100644
index 190b37f6a..000000000
--- a/module/language/scheme/amatch.scm
+++ /dev/null
@@ -1,35 +0,0 @@
-(define-module (language scheme amatch)
-  #:export (amatch))
-
-;; This is exactly the same as pmatch except that it unpacks annotations
-;; as needed.
-
-(define-syntax amatch
-  (syntax-rules (else guard)
-    ((_ (op arg ...) cs ...)
-     (let ((v (op arg ...)))
-       (amatch v cs ...)))
-    ((_ v) (if #f #f))
-    ((_ v (else e0 e ...)) (begin e0 e ...))
-    ((_ v (pat (guard g ...) e0 e ...) cs ...)
-     (let ((fk (lambda () (amatch v cs ...))))
-       (apat v pat
-             (if (and g ...) (begin e0 e ...) (fk))
-             (fk))))
-    ((_ v (pat e0 e ...) cs ...)
-     (let ((fk (lambda () (amatch v cs ...))))
-       (apat v pat (begin e0 e ...) (fk))))))
-
-(define-syntax apat
-  (syntax-rules (_ quote unquote)
-    ((_ v _ kt kf) kt)
-    ((_ v () kt kf) (if (null? v) kt kf))
-    ((_ v (quote lit) kt kf)
-     (if (equal? v (quote lit)) kt kf))
-    ((_ v (unquote var) kt kf) (let ((var v)) kt))
-    ((_ v (x . y) kt kf)
-     (if (apair? v)
-         (let ((vx (acar v)) (vy (acdr v)))
-           (apat vx x (apat vy y kt kf) kf))
-         kf))
-    ((_ v lit kt kf) (if (eq? v (quote lit)) kt kf))))
diff --git a/module/language/scheme/compile-ghil.scm b/module/language/scheme/compile-ghil.scm
index 3d5b0159b..370488c05 100644
--- a/module/language/scheme/compile-ghil.scm
+++ b/module/language/scheme/compile-ghil.scm
@@ -32,8 +32,6 @@
   #:export (compile-ghil translate-1
             *translate-table* define-scheme-translator))
 
-(module-ref (current-module) 'receive)
-
 ;;; environment := #f
 ;;;                | MODULE
 ;;;                | COMPILE-ENV
diff --git a/module/language/scheme/compile-tree-il.scm b/module/language/scheme/compile-tree-il.scm
new file mode 100644
index 000000000..553a3fd43
--- /dev/null
+++ b/module/language/scheme/compile-tree-il.scm
@@ -0,0 +1,64 @@
+;;; Guile Scheme specification
+
+;; 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 scheme compile-tree-il)
+  #:use-module (language tree-il)
+  #:export (compile-tree-il))
+
+;;; environment := #f
+;;;                | MODULE
+;;;                | COMPILE-ENV
+;;; compile-env := (MODULE LEXICALS . EXTERNALS)
+(define (cenv-module env)
+  (cond ((not env) #f)
+        ((module? env) env)
+        ((and (pair? env) (module? (car env))) (car env))
+        (else (error "bad environment" env))))
+
+(define (cenv-lexicals env)
+  (cond ((not env) '())
+        ((module? env) '())
+        ((pair? env) (cadr env))
+        (else (error "bad environment" env))))
+
+(define (cenv-externals env)
+  (cond ((not env) '())
+        ((module? env) '())
+        ((pair? env) (cddr env))
+        (else (error "bad environment" env))))
+
+(define (make-cenv module lexicals externals)
+  (cons module (cons lexicals externals)))
+
+(define (location x)
+  (and (pair? x)
+       (let ((props (source-properties x)))
+	 (and (not (null? props))
+              props))))
+
+(define (compile-tree-il x e opts)
+  (save-module-excursion
+   (lambda ()
+     (and=> (cenv-module e) set-current-module)
+     (let ((x (sc-expand x 'c '(compile load eval)))
+           (cenv (make-cenv (current-module)
+                            (cenv-lexicals e) (cenv-externals e))))
+       (values x cenv cenv)))))
diff --git a/module/language/scheme/decompile-tree-il.scm b/module/language/scheme/decompile-tree-il.scm
new file mode 100644
index 000000000..c4903d87f
--- /dev/null
+++ b/module/language/scheme/decompile-tree-il.scm
@@ -0,0 +1,27 @@
+;;; Guile VM code converters
+
+;; Copyright (C) 2001,2009 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 scheme decompile-tree-il)
+  #:use-module (language tree-il)
+  #:export (decompile-tree-il))
+
+(define (decompile-tree-il x env opts)
+  (values (tree-il->scheme x) env))
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
index 8f958eb63..70085e8d7 100644
--- a/module/language/scheme/spec.scm
+++ b/module/language/scheme/spec.scm
@@ -22,6 +22,8 @@
 (define-module (language scheme spec)
   #:use-module (system base language)
   #:use-module (language scheme compile-ghil)
+  #:use-module (language scheme compile-tree-il)
+  #:use-module (language scheme decompile-tree-il)
   #:export (scheme))
 
 ;;;
@@ -45,7 +47,9 @@
   #:version	"0.5"
   #:reader	read
   #:read-file	read-file
-  #:compilers   `((ghil . ,compile-ghil))
+  #:compilers   `((ghil . ,compile-ghil)
+                  (tree-il . ,compile-tree-il))
+  #:decompilers `((tree-il . ,decompile-tree-il))
   #:evaluator	(lambda (x module) (primitive-eval x))
   #:printer	write
   )
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index 3a0225577..dbe4b25ef 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -1,6 +1,6 @@
 ;;; TREE-IL -> GLIL compiler
 
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2008,2009 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
@@ -46,6 +46,18 @@
                 (ghil-env-add! parent-env v))
               (ghil-env-variables env))))
 
+;; Possible optimizations:
+;; * compile primitives specially
+;; * turn global-refs into primitive-refs
+;; * constant folding, propagation
+;; * procedure inlining
+;;   * always when single call site
+;;   * always for "trivial" procs
+;;   * otherwise who knows
+;; * dead code elimination
+;; * degenerate case optimizations
+
+
 ;; The premise of this, unused, approach to optimization is that you can
 ;; determine the environment of a variable lexically, because they have
 ;; been alpha-renamed. It makes the transformations *much* easier.
diff --git a/module/language/tree-il/spec.scm b/module/language/tree-il/spec.scm
index d69a4ec37..c1f098230 100644
--- a/module/language/tree-il/spec.scm
+++ b/module/language/tree-il/spec.scm
@@ -29,24 +29,15 @@
 (define (write-tree-il exp . port)
   (apply write (unparse-tree-il exp) port))
 
-(define (parse x)
-  (make-lambda #f '() '() (parse-tree-il x)))
-
 (define (join exps env)
-  (if (or-map (lambda (x)
-                (or (not (lambda? x))
-                    (not (null? (lambda-vars x)))))
-              exps)
-      (error "tree-il expressions to join must be thunks"))
-
-  (make-lambda #f '() '() (make-sequence #f (map lambda-body exps))))
+  (make-sequence #f exps))
 
 (define-language tree-il
   #:title	"Tree Intermediate Language"
   #:version	"1.0"
   #:reader	read
   #:printer	write-tree-il
-  #:parser      parse
+  #:parser      parse-tree-il
   #:joiner      join
   #:compilers   `((glil . ,compile-glil))
   )