diff options
Diffstat (limited to 'csc/macros-test.csc')
| -rw-r--r-- | csc/macros-test.csc | 198 |
1 files changed, 108 insertions, 90 deletions
diff --git a/csc/macros-test.csc b/csc/macros-test.csc index e4451e7..6ee0596 100644 --- a/csc/macros-test.csc +++ b/csc/macros-test.csc @@ -28,6 +28,7 @@ library-define? library-ref? make-constant + make-define-syntax make-lambda make-letrec make-lexical-ref @@ -54,28 +55,31 @@ (cons sequence? %sequence) (cons lambda? %lambda) (cons letrec? %letrec) - (cons gensym? (lambda (x) 'gensym)))) + (cons gensym? (lambda (x) 'gensym)) + (cons macro-transformer? (lambda (x) 'transformer)))) (test builtin-quote (assert-equal (make-constant '(test 1 2 3)) - (expand '(quote (test 1 2 3)) builtins-environment) + (expand-body 'main + '((quote (test 1 2 3))) + builtins-environment) transform-ir1)) (test builtin-syntax-rules-literal (assert-equal (make-constant 1) - (expand - '(builtin-let-syntax - (foo - (syntax-rules (a b) - ((foo a) - 0) - ((foo b) - 1))) - (foo b)) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules (a b) + ((foo a) + 0) + ((foo b) + 1))) + (foo b))) builtins-environment) transform-ir1)) @@ -83,12 +87,12 @@ (test builtin-syntax-rules-underscore (assert-equal (make-constant 0) - (expand - '(builtin-let-syntax - (foo - (syntax-rules () - ((foo _) 0))) - (foo ignored)) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules () + ((foo _) 0))) + (foo ignored))) builtins-environment) transform-ir1)) @@ -96,12 +100,12 @@ (test builtin-syntax-rules-substitution (assert-equal (make-constant 5) - (expand - '(builtin-let-syntax - (foo - (syntax-rules () - ((foo x) x))) - (foo 5)) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules () + ((foo x) x))) + (foo 5))) builtins-environment) transform-ir1)) @@ -109,13 +113,13 @@ (test builtin-syntax-rules-nil (assert-equal (make-constant 1) - (expand - '(builtin-let-syntax - (foo - (syntax-rules () - ((foo x) 0) - ((foo) 1))) - (foo)) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules () + ((foo x) 0) + ((foo) 1))) + (foo))) builtins-environment) transform-ir1)) @@ -123,12 +127,12 @@ (test builtin-syntax-rules-improper-list (assert-equal (make-constant 1) - (expand - '(builtin-let-syntax - (foo - (syntax-rules () - ((foo a . b) a))) - (foo 1 2 3)) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules () + ((foo a . b) a))) + (foo 1 2 3))) builtins-environment) transform-ir1)) @@ -136,12 +140,12 @@ (test builtin-syntax-rules-quoted (assert-equal (make-constant 'a) - (expand - '(builtin-let-syntax - (foo - (syntax-rules () - ((foo x) (quote x)))) - (foo a)) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules () + ((foo x) (quote x)))) + (foo a))) builtins-environment) transform-ir1)) @@ -149,14 +153,14 @@ (test builtin-syntax-rules-constant (assert-equal (make-constant 2) - (expand - '(builtin-let-syntax - (foo - (syntax-rules () - ((foo "abc") 0) - ((foo "def") 1) - ((foo "ghi") 2))) - (foo "ghi")) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules () + ((foo "abc") 0) + ((foo "def") 1) + ((foo "ghi") 2))) + (foo "ghi"))) builtins-environment) transform-ir1)) @@ -164,12 +168,12 @@ (test builtin-syntax-rules-ellipsis (assert-equal (make-constant 5) - (expand - '(builtin-let-syntax - (foo - (syntax-rules () - ((foo x ...) (x ...)))) - (foo quote 5)) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules () + ((foo x ...) (x ...)))) + (foo quote 5))) builtins-environment) transform-ir1)) @@ -177,12 +181,12 @@ (test builtin-syntax-rules-ellipsis-improper (assert-equal (make-constant 5) - (expand - '(builtin-let-syntax - (foo - (syntax-rules () - ((foo x ... . y) (x ... y)))) - (foo quote . 5)) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules () + ((foo x ... . y) (x ... y)))) + (foo quote . 5))) builtins-environment) transform-ir1)) @@ -190,13 +194,13 @@ (test builtin-syntax-rules-ellipsis-zip (assert-equal (make-constant '((1 . 3) (2 . 4))) - (expand - '(builtin-let-syntax - (zip - (syntax-rules () - ((zip (x ...) (y ...)) - (quote ((x . y) ...))))) - (zip (1 2) (3 4))) + (expand-body 'main + '((let-syntax + (zip + (syntax-rules () + ((zip (x ...) (y ...)) + (quote ((x . y) ...))))) + (zip (1 2) (3 4)))) builtins-environment) transform-ir1)) @@ -204,13 +208,13 @@ (test builtin-syntax-rules-ellipsis-nested (assert-equal (make-constant '(1 2 3 4 5)) - (expand - '(builtin-let-syntax - (append - (syntax-rules () - ((append (x ...) ...) - (quote (x ... ...))))) - (append (1 2) (3 4) () (5))) + (expand-body 'main + '((let-syntax + (append + (syntax-rules () + ((append (x ...) ...) + (quote (x ... ...))))) + (append (1 2) (3 4) () (5)))) builtins-environment) transform-ir1)) @@ -218,12 +222,12 @@ (test builtin-syntax-rules-ellipsis-custom (assert-equal (make-constant 5) - (expand - '(builtin-let-syntax - (foo - (syntax-rules ::: () - ((foo x :::) (x :::)))) - (foo quote 5)) + (expand-body 'main + '((let-syntax + (foo + (syntax-rules ::: () + ((foo x :::) (x :::)))) + (foo quote 5))) builtins-environment) transform-ir1)) @@ -240,9 +244,9 @@ (test-ref 'c)) (test-ref 'd) (make-sequence (make-constant #f) (make-constant 5))) - (expand - '(lambda - (a b c . d) (quote 5)) + (expand-body 'main + '((lambda + (a b c . d) (quote 5))) builtins-environment) transform-ir1)) @@ -254,10 +258,24 @@ (list (make-constant 6) (test-ref 'a)) (make-sequence (make-constant #f) (make-constant 7)))) - (expand - '(lambda (x) - (builtin-define a (quote 6)) - (builtin-define b a) - (quote 7)) + (expand-body 'main + '((lambda (x) + (builtin-define a (quote 6)) + (builtin-define b a) + (quote 7))) + builtins-environment) + transform-ir1)) + + + (test builtin-define-syntax + (assert-equal + (make-sequence + (make-define-syntax 'five 'transformer) + (make-constant 5)) + (expand-body 'main + '((define-syntax five + (syntax-rules () + ((five _) 5))) + (five 6)) builtins-environment) transform-ir1)))) |