diff options
Diffstat (limited to 'macros.csc')
| -rw-r--r-- | macros.csc | 184 |
1 files changed, 0 insertions, 184 deletions
diff --git a/macros.csc b/macros.csc deleted file mode 100644 index a41a4a7..0000000 --- a/macros.csc +++ /dev/null @@ -1,184 +0,0 @@ -(define-library (csc macros) - (export - expand - test-environment) - (import (scheme base) - (only (csc gensym) gensym) - (only (csc hash-map) - alist->map - hash-bytevector - insert - key-not-found-error? - lookup) - (only (csc ir1) - make-call - make-constant - make-lambda - make-lambda-case) - (only (csc list) revappend) - (only (csc match) match)) - (begin - - - (define-record-type <macro-transformer> - (make-macro-transformer transformer) - macro-transformer? - (transformer transformer-function)) - - - (define-record-type <macro-syntax-error> - (make-macro-syntax-error message irritants) - macro-syntax-error? - (message syntax-error-object-message) - (irritants syntax-error-object-irritants)) - - - (define (raise-syntax-error message . irritants) - (raise (make-macro-syntax-error message irritants))) - - - ; symbols is a map with symbols as keys, and the values can be one of: - ; - <lexical-ref>, - ; - <module-ref>, - ; - or <macro-transformer>. - ; The first two correspond to variables bound lexically or from a module, - ; and the third represents a macro transformer bound in the - ; current context. - ; - ; library is the current library name being compiled. A nil library - ; corresponds to top level expressions. - (define-record-type <environment> - (make-environment symbols library) - environment? - (symbols environment-symbols) - (library environment-library)) - - - (define (with-binding environment symbol binding) - (make-environment (insert (environment-symbols environment) symbol binding) (environment-library environment))) - - - (define (expand-procedure-call procedure arguments environment) - (let*-values (((expanded-procedure environment) (expand procedure environment)) - ((expanded-arguments environment) - (let loop ((arguments arguments) - (environment environment) - (expanded-arguments '())) - (match arguments - ('() (values (reverse expanded-arguments) environment)) - ((argument . rest) - (let-values (((expanded-argument environment) (expand argument environment))) - (loop - rest - environment - (cons expanded-argument expanded-arguments)))) - (_ (raise-syntax-error "arguments to a procedure call must be a list" procedure arguments)))))) - (make-call expanded-procedure expanded-arguments))) - - - ; 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 and an environment which has been modified with any new - ; bindings introduced by the expression. - (define (expand expression environment) - (cond - ((null? expression) (raise-syntax-error "nil by itself is an error (did you mean to use quote?)" expression)) - ((and (pair? expression) - (symbol? (car expression))) - (let* ((macro-name (car expression)) - (macro-body - (guard (e ((key-not-found-error? e) (raise-syntax-error "undefined symbol" macro-name))) - (lookup (environment-symbols environment) macro-name)))) - (if (macro-transformer? macro-body) - ((transformer-function macro-body) expression environment) - (expand-procedure-call macro-name (cdr expression) environment)))) - ((pair? expression) - (let ((procedure (car expression)) - (arguments (cdr expression))) - (expand-procedure-call procedure arguments environment))) - ((symbol? expression) - (let ((binding - (guard (e ((key-not-found-error? e) (raise-syntax-error "undefined symbol" expression))) - (lookup (environment-symbols environment) expression)))) - (if (macro-transformer? binding) - (raise-syntax-error "macro is not allowed in this context" expression) - (values binding environment)))) - ((or (boolean? expression) - (bytevector? expression) - (char? expression) - (number? expression) - (string? expression) - (vector? expression)) - (values (make-constant expression) environment)) - (else (raise-syntax-error "unexpected expression type" expression)))) - - - (define builtin-quote - (make-macro-transformer - (lambda (expression environment) - (match expression - ((_ datum) (values (make-constant datum) environment)) - (_ (raise-syntax-error "invalid form for quote" expression)))))) - - - (define builtin-lambda - (make-macro-transformer - (lambda (expression environment) - (match expression - ((_ formals body) - (let loop ((formals formals) - (environment environment) - (argument-names '()) - (gensyms '())) - (match formals - ('() - (make-lambda - (make-lambda-case - (reverse argument-names) - #f - (reverse gensyms) - (expand body environment) - #f))) - ((variable . variables) (when (symbol? variable)) - (let ((sym (gensym))) - (loop - variables - (with-binding environment variable sym) - (cons variable argument-names) - (cons sym gensyms)))) - (variable (when (symbol? variable)) - (let ((sym (gensym))) - (make-lambda - (make-lambda-case - (reverse argument-names) - variable - (revappend gensyms (list sym)) - (expand body (with-binding environment variable sym)) - #f)))) - (_ (raise-syntax-error "invalid form for lambda arguments" expression))))) - (_ (raise-syntax-error "invalid form for lambda" expression)))))) - - - #;(define builtin-syntax-rules - (make-macro-transformer - (lambda (expression environment) - (match expression)))) - - - (define (hash-symbol s) - (hash-bytevector (string->utf8 (symbol->string s)))) - - - (define (symbol<? s1 s2) - (string<? (symbol->string s1) (symbol->string s2))) - - - (define test-environment - (make-environment - (alist->map - hash-symbol - symbol<? - (list - (cons 'quote builtin-quote) - (cons 'lambda builtin-lambda))) - '())))) |