diff options
Diffstat (limited to 'csc/macros-test.csc')
| -rw-r--r-- | csc/macros-test.csc | 133 |
1 files changed, 95 insertions, 38 deletions
diff --git a/csc/macros-test.csc b/csc/macros-test.csc index db78324..d1b8d2c 100644 --- a/csc/macros-test.csc +++ b/csc/macros-test.csc @@ -1,31 +1,70 @@ (import (scheme base) + (only (csc gensym) + gensym + gensym?) (only (csc ir1) + %call + %constant + %define-syntax + %if + %lambda + %letrec + %lexical-ref + %lexical-set + %library-define + %library-ref + %sequence + call? constant-expression constant? - ir1=? + define-syntax? + if? + lambda? + letrec? lexical-ref-name lexical-ref? lexical-set-expression lexical-set? + library-define? + library-ref? make-constant + make-lambda make-letrec make-lexical-ref make-library-ref - make-sequence) + make-sequence + sequence?) (only (csc testing) assert-equal test) (csc macros)) +(define transform-ir1 + (list + (cons constant? %constant) + (cons lexical-ref? %lexical-ref) + (cons library-ref? %library-ref) + (cons lexical-set? %lexical-set) + (cons library-define? %library-define) + (cons define-syntax? %define-syntax) + (cons if? %if) + (cons call? %call) + (cons sequence? %sequence) + (cons lambda? %lambda) + (cons letrec? %letrec) + (cons gensym? (lambda (x) 'gensym)))) + + (test builtin-quote - (assert-equal ir1=? + (assert-equal (make-constant '(test 1 2 3)) - (expand '(quote (test 1 2 3)) builtins-environment))) + (expand '(quote (test 1 2 3)) builtins-environment) + transform-ir1)) (test builtin-syntax-rules-literal - (assert-equal ir1=? + (assert-equal (make-constant 1) (expand '(builtin-let-syntax @@ -36,11 +75,12 @@ ((foo b) 1))) (foo b)) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-underscore - (assert-equal ir1=? + (assert-equal (make-constant 0) (expand '(builtin-let-syntax @@ -48,11 +88,12 @@ (syntax-rules () ((foo _) 0))) (foo ignored)) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-substitution - (assert-equal ir1=? + (assert-equal (make-constant 5) (expand '(builtin-let-syntax @@ -60,11 +101,12 @@ (syntax-rules () ((foo x) x))) (foo 5)) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-nil - (assert-equal ir1=? + (assert-equal (make-constant 1) (expand '(builtin-let-syntax @@ -73,11 +115,12 @@ ((foo x) 0) ((foo) 1))) (foo)) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-improper-list - (assert-equal ir1=? + (assert-equal (make-constant 1) (expand '(builtin-let-syntax @@ -85,11 +128,12 @@ (syntax-rules () ((foo a . b) a))) (foo 1 2 3)) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-quoted - (assert-equal ir1=? + (assert-equal (make-constant 'a) (expand '(builtin-let-syntax @@ -97,11 +141,12 @@ (syntax-rules () ((foo x) (quote x)))) (foo a)) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-constant - (assert-equal ir1=? + (assert-equal (make-constant 2) (expand '(builtin-let-syntax @@ -111,11 +156,12 @@ ((foo "def") 1) ((foo "ghi") 2))) (foo "ghi")) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-ellipsis - (assert-equal ir1=? + (assert-equal (make-constant 5) (expand '(builtin-let-syntax @@ -123,11 +169,12 @@ (syntax-rules () ((foo x ...) (x ...)))) (foo quote 5)) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-ellipsis-improper - (assert-equal ir1=? + (assert-equal (make-constant 5) (expand '(builtin-let-syntax @@ -135,11 +182,12 @@ (syntax-rules () ((foo x ... . y) (x ... y)))) (foo quote . 5)) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-ellipsis-zip - (assert-equal ir1=? + (assert-equal (make-constant '((1 . 3) (2 . 4))) (expand '(builtin-let-syntax @@ -148,11 +196,12 @@ ((zip (x ...) (y ...)) (quote ((x . y) ...))))) (zip (1 2) (3 4))) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-ellipsis-nested - (assert-equal ir1=? + (assert-equal (make-constant '(1 2 3 4 5)) (expand '(builtin-let-syntax @@ -161,11 +210,12 @@ ((append (x ...) ...) (quote (x ... ...))))) (append (1 2) (3 4) () (5))) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-syntax-rules-ellipsis-custom - (assert-equal ir1=? + (assert-equal (make-constant 5) (expand '(builtin-let-syntax @@ -173,33 +223,40 @@ (syntax-rules ::: () ((foo x :::) (x :::)))) (foo quote 5)) - builtins-environment))) + builtins-environment) + transform-ir1)) + + +(define (test-ref sym) + (make-lexical-ref sym (gensym))) (test builtin-lambda-rest - (assert-equal ir1=? + (assert-equal (make-lambda (list - (make-lexical-ref 'a #f) - (make-lexical-ref 'b #f) - (make-lexical-ref 'c #f)) - (make-lexical-ref 'd #f) + (test-ref 'a) + (test-ref 'b) + (test-ref 'c)) + (test-ref 'd) (make-sequence (make-constant #f) (make-constant 5))) (expand '(lambda (a b c . d) (quote 5)) - builtins-environment))) + builtins-environment) + transform-ir1)) (test builtin-case-lambda-defines - (assert-equal ir1=? - (make-lambda (list (make-lexical-ref 'x #f)) #f + (assert-equal + (make-lambda (list (test-ref 'x)) #f (make-letrec #t '(a b) #f (list (make-constant 6) - (make-lexical-ref 'a #f)) + (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)) - builtins-environment))) + builtins-environment) + transform-ir1)) |