Use a better interface for macros.

1 files changed, 32 insertions, 19 deletions

diff --git a/csc/macros.csc b/csc/macros.csc
index 859f72d..288865d 100644
--- a/csc/macros.csc
+++ b/csc/macros.csc
@@ -1,10 +1,9 @@
 (define-library (csc macros)
   (export
     builtins-environment
-    expand
     expand-body
     macro-syntax-error?
-    make-environment)
+    macro-transformer?)
   (import (scheme base)
           (only (csc assert) assert)
           (only (csc format) sprintf)
@@ -18,6 +17,7 @@
             key-not-found-error?
             lookup
             make-comparer
+            make-map
             map-for-each
             merge)
           (only (csc ir1)
@@ -33,6 +33,7 @@
             library-ref?
             make-call
             make-constant
+            make-define-syntax
             make-lambda
             make-letrec
             make-lexical-ref
@@ -325,9 +326,6 @@
         (_ (raise-syntax-error "unexpected expression type" (clean-syntax syntax)))))
 
 
-    ; expand can be thought of as a compiler from Scheme to IR1. Macros
-    ; included in the environment can be used to extend the syntax. Returns an
-    ; IR1 expression.
     (define (expand expression environment)
       (expand-syntax-object (wrap-syntax expression environment)))
 
@@ -740,23 +738,38 @@
             (_ (raise-syntax-error "unexpected form in builtin-define" x))))))
 
 
+    (define builtin-define-syntax
+      (make-macro-transformer
+        (lambda (x)
+          (syntax-case x
+            ((_ ident transformer-form) when (identifier? ident)
+              (make-define-syntax (identifier-name ident)
+                (expand-syntax-object transformer-form)))
+            (_ (raise-syntax-error "unexpected form in builtin-define-syntax" x))))))
+
+
     (define builtins-environment
-      (make-environment
-        (alist->substitutions
-          (list (cons 'syntax-rules builtin-syntax-rules)
-                (cons '_ (make-library-ref '_ '(scheme base)))
-                (cons '... (make-library-ref '... '(scheme base)))
-                (cons 'builtin-let-syntax builtin-let-syntax)
-                (cons 'quote builtin-quote)
-                (cons 'lambda builtin-lambda)
-                (cons 'builtin-define builtin-define)))
-        'main))
+      (alist->substitutions
+        (list (cons 'syntax-rules builtin-syntax-rules)
+              (cons '_ (make-library-ref '_ '(scheme base)))
+              (cons '... (make-library-ref '... '(scheme base)))
+              (cons 'let-syntax builtin-let-syntax)
+              (cons 'quote builtin-quote)
+              (cons 'lambda builtin-lambda)
+              (cons 'builtin-define builtin-define)
+              (cons 'define-syntax builtin-define-syntax))))
 
 
-    ; Expands the body of a library, or top level.
-    (define (expand-body body)
-      (loop with environment = (syntax-object-environment body)
-            for expr in (syntax->expression body)
+    ; Expands the body of a library, or top level. expand-body can be thought
+    ; of as a compiler from Scheme to IR1. Macros included in the environment
+    ; can be used to extend the syntax. Returns an IR1 expression.
+    (define (expand-body name body env)
+      (define ident-map (make-map compare-identifiers))
+      (map-for-each (lambda (k v)
+                      (set! ident-map (insert ident-map k v)))
+        env)
+      (define environment (make-environment ident-map name))
+      (loop for expr in body
             for expanded-expr = (expand expr environment)
             for res = expanded-expr then (make-sequence res expanded-expr)
             finally (return res)