diff options
| -rw-r--r-- | lib/csc/macros-test.csc | 24 | ||||
| -rw-r--r-- | lib/csc/macros.csc | 47 | ||||
| -rw-r--r-- | lib/scheme/base/20-let.csc | 1 |
3 files changed, 67 insertions, 5 deletions
diff --git a/lib/csc/macros-test.csc b/lib/csc/macros-test.csc index 531e3e2..9b4c128 100644 --- a/lib/csc/macros-test.csc +++ b/lib/csc/macros-test.csc @@ -32,9 +32,11 @@ make-call-builtin make-constant make-define-syntax + make-if make-lambda make-letrec make-lexical-ref + make-lexical-set make-library-ref make-sequence sequence?) @@ -291,4 +293,26 @@ (expand-body 'main '((call-builtin bbb 5)) builtins-environment) + transform-ir1)) + + + (test builtin-lexical-set + (assert-equal + (make-lambda (list (test-ref 'x)) #f + (make-sequence + (make-constant #f) + (make-lexical-set (test-ref 'x) (make-constant 5)))) + (expand-body 'main + '((lambda (x) + (set! x 5))) + builtins-environment) + transform-ir1)) + + + (test builtin-if + (assert-equal + (make-if (make-constant #t) (make-constant 5) (make-constant 10)) + (expand-body 'main + '((builtin-if #t 5 10)) + builtins-environment) transform-ir1)))) diff --git a/lib/csc/macros.csc b/lib/csc/macros.csc index 4559991..d41e9da 100644 --- a/lib/csc/macros.csc +++ b/lib/csc/macros.csc @@ -25,6 +25,7 @@ define-syntax-transformer define-syntax? lexical-ref-gensym + lexical-ref-name lexical-ref? library-define-expression library-define-ref @@ -35,9 +36,11 @@ make-call-builtin make-constant make-define-syntax + make-if make-lambda make-letrec make-lexical-ref + make-lexical-set make-library-define make-library-ref make-sequence @@ -715,14 +718,18 @@ (syntax-case x ((_ formals . body) (let-values (((args rest) (split-args-rest formals))) + (define refs (map (lambda (name) + (make-lexical-ref name (gensym))) + args)) + (define environment (syntax-object-environment body)) + (loop for ref in refs + do (set! environment (add-binding (lexical-ref-name ref) ref environment))) (make-lambda - (map (lambda (name) - (make-lexical-ref name (gensym))) - args) + refs (if rest (make-lexical-ref rest (gensym)) #f) - (expand-lambda-body body)))) + (expand-lambda-body (make-syntax-object (syntax->expression body) environment (marks body)))))) (_ (raise-syntax-error "unexpected form in lambda" x)))))) @@ -767,6 +774,34 @@ (_ (raise-syntax-error "unexpected form in call-builtin" x)))))) + (define builtin-set + (make-macro-transformer + (lambda (x) + (syntax-case x + ((_ var value) when (identifier? var) + (define var* (expand-syntax-object var)) + (define val* (expand-syntax-object value)) + (cond + ((lexical-ref? var*) + (make-lexical-set var* val*)) + ((library-ref? var*) + (make-library-define var* val*)) + (else + (error "unknown variable form in builtin-set" var*)))) + (_ (raise-syntax-error "unexpected form in builtin-set" x)))))) + + + (define builtin-if + (make-macro-transformer + (lambda (x) + (syntax-case x + ((_ test true false) + (make-if (expand-syntax-object test) + (expand-syntax-object true) + (expand-syntax-object false))) + (_ (raise-syntax-error "unexpected form in builtin-if")))))) + + (define builtins-environment (alist->substitutions (list (cons 'syntax-rules builtin-syntax-rules) @@ -777,7 +812,9 @@ (cons 'lambda builtin-lambda) (cons 'builtin-define builtin-define) (cons 'define-syntax builtin-define-syntax) - (cons 'call-builtin builtin-call-builtin)))) + (cons 'call-builtin builtin-call-builtin) + (cons 'set! builtin-set) + (cons 'builtin-if builtin-if)))) ; Expands the body of a library, or top level. expand-body can be thought diff --git a/lib/scheme/base/20-let.csc b/lib/scheme/base/20-let.csc index 96f0247..4a02dfa 100644 --- a/lib/scheme/base/20-let.csc +++ b/lib/scheme/base/20-let.csc @@ -1,4 +1,5 @@ (export + begin lambda let let* |