diff options
Diffstat (limited to 'csc/macros.csc')
| -rw-r--r-- | csc/macros.csc | 51 |
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) |