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.

5 files changed, 96 insertions, 38 deletions

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
   )