First code for elisp compilation, handling a very limited set of operations (but not really usable yet).

* module/language/elisp/README: New file containing some notes.
* module/language/elisp/compile-tree-il.scm: New file with compilation code.
* module/language/elisp/spec.scm: Updated language definition.

module/language/elisp/README

@@ -0,0 +1,23 @@
+Guile's Emacs Lisp compiler
+===========================
+
+This is more or less a lot of work in progress.  Here are some notes as well
+as status information.
+
+Already implemented:
+  * progn
+  * if, cond
+  * and
+  * quote
+
+Especially still missing:
+  * other progX forms, will be done in macros
+  * where, unless, will be done in macros
+  * or
+  * while, other loops using macros
+  * catch/throw, unwind-protect
+  * real elisp reader instead of Scheme's
+  * handling of variables: setq, referencing, let -- using fluids for scoping
+  * macros
+  * general primitives (+, -, *, cons, ...)
+  * functions, lambdas

module/language/elisp/compile-tree-il.scm

@@ -0,0 +1,124 @@
+;;; Guile Emac Lisp
+
+;; 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 elisp compile-tree-il)
+  #:use-module (language tree-il)
+  #:use-module (system base pmatch)
+  #:export (compile-tree-il))
+
+
+; Find the source properties of some parsed expression if there are any
+; associated with it.
+
+(define (location x)
+  (and (pair? x)
+       (let ((props (source-properties x)))
+         (and (not (null? props))
+              props))))
+
+
+; Compile a symbol expression.  This is a variable reference or maybe some
+; special value like nil.
+
+(define (compile-symbol loc sym)
+  (case sym
+
+    ((nil)
+     (make-const loc #f))
+
+    ((t)
+     (make-const loc #t))
+    
+    ; FIXME: Use fluids.
+    (else
+      (make-module-ref loc '(language elisp variables) sym #f))))
+
+
+; Compile a pair-expression (that is, any structure-like construct).
+
+(define (compile-pair loc expr)
+  (pmatch expr
+
+    ((progn . ,forms)
+     (make-sequence loc (map compile-expr forms)))
+
+    ((if ,condition ,ifclause)
+     (make-conditional loc (compile-expr condition)
+                           (compile-expr ifclause)
+                           (make-const loc #f)))
+    ((if ,condition ,ifclause ,elseclause)
+     (make-conditional loc (compile-expr condition)
+                           (compile-expr ifclause)
+                           (compile-expr elseclause)))
+    ((if ,condition ,ifclause . ,elses)
+     (make-conditional loc (compile-expr condition)
+                           (compile-expr ifclause)
+                           (make-sequence loc (map compile-expr elses))))
+
+    ; FIXME: Handle returning of condition value for empty clauses!
+    ((cond . ,clauses) (guard (and-map (lambda (el)
+                                         (and (list? el) (not (null? el))))
+                                       clauses))
+     (let iterate ((tail clauses))
+       (if (null? tail)
+         (make-const loc #f)
+         (let ((cur (car tail)))
+           (make-conditional loc
+             (compile-expr (car cur))
+             (make-sequence loc (map compile-expr (cdr cur)))
+             (iterate (cdr tail)))))))
+
+    ((and) (make-const loc #t))
+    ((and . ,expressions)
+     (let iterate ((tail expressions))
+       (if (null? (cdr tail))
+         (compile-expr (car tail))
+         (make-conditional loc
+           (compile-expr (car tail))
+           (iterate (cdr tail))
+           (make-const loc #f)))))
+
+    (('quote ,val)
+     (make-const loc val))
+
+    (else
+      (error "unrecognized elisp" expr))))
+
+
+; Compile a single expression to TreeIL.
+
+(define (compile-expr expr)
+  (let ((loc (location expr)))
+    (cond
+      ((symbol? expr)
+       (compile-symbol loc expr))
+      ((pair? expr)
+       (compile-pair loc expr))
+      (else (make-const loc expr)))))
+
+
+; Entry point for compilation to TreeIL.
+
+(define (compile-tree-il expr env opts)
+  (values
+    (compile-expr expr)
+    env
+    env))

module/language/elisp/spec.scm

@@ -19,45 +19,15 @@
 
 ;;; Code:
 
-(define-module (lang elisp spec)
-  #:use-module (system lang language)
+(define-module (language elisp spec)
+  #:use-module (language elisp compile-tree-il)
+  #:use-module (system base language)
   #:export (elisp))
 
-
-;;;
-;;; Translator
-;;;
-
-(define (translate x)
-  (if (pair? x)
-      (translate-pair x)
-      x))
-
-(define (translate-pair x)
-  (let ((name (car x)) (args (cdr x)))
-    (case name
-      ((quote) `(@quote ,@args))
-      ((defvar) `(@define ,@(map translate args)))
-      ((setq) `(@set! ,@(map translate args)))
-      ((if) `(@if ,(translate (car args))
-		  (@begin ,@(map translate (cdr args)))))
-      ((and) `(@and ,@(map translate args)))
-      ((or) `(@or ,@(map translate args)))
-      ((progn) `(@begin ,@(map translate args)))
-      ((defun) `(@define ,(car args)
-			 (@lambda ,(cadr args) ,@(map translate (cddr args)))))
-      ((lambda) `(@lambda ,(car args) ,@(map translate (cdr args))))
-      (else x))))
-
-
-;;;
-;;; Language definition
-;;;
-
 (define-language elisp
   #:title	"Emacs Lisp"
   #:version	"0.0"
   #:reader	read
-  #:expander	id
-  #:translator	translate
+  #:printer	write
+  #:compilers	`((tree-il . ,compile-tree-il))
   )