diff options
Diffstat (limited to 'csc/macros-test.csc')
| -rw-r--r-- | csc/macros-test.csc | 96 |
1 files changed, 14 insertions, 82 deletions
diff --git a/csc/macros-test.csc b/csc/macros-test.csc index 6529e58..4bdc3f1 100644 --- a/csc/macros-test.csc +++ b/csc/macros-test.csc @@ -7,16 +7,8 @@ lexical-set-expression lexical-set-name lexical-set? - library-ref-library - library-ref-name - library-ref-public? - library-ref? - library-set-expression - library-set-library - library-set-name - library-set-public? - library-set? make-constant + ir1=? void?) (only (csc testing) assert-equal @@ -24,69 +16,14 @@ (csc macros)) -(define (ir1= x y) - (cond - ((and (void? x) (void? y)) #t) - ((and (constant? x) (constant? y)) - (equal? (constant-expression x) (constant-expression y))) - ((and (lexical-ref? x) (lexical-ref? y)) - (symbol=? (lexical-ref-name x) (lexical-ref-name y))) - ((and (lexical-set? x) (lexical-set? y)) - (and - (symbol=? (lexical-set-name x) (lexical-set-name y)) - (ir1= (lexical-set-expression x) (lexical-set-expression y)))) - ((and (library-ref? x) (library-ref? y)) - (and - (equal? (library-ref-library x) (library-ref-library y)) - (symbol=? (library-ref-name x) (library-ref-name y)) - (boolean=? (library-ref-public? x) (library-ref-public? y)))) - ((and (library-set? x) (library-set? y)) - (and - (equal? (library-set-library x) (library-set-library y)) - (symbol=? (library-set-name x) (library-set-name y)) - (boolean=? (library-set-public? x) (library-set-public? y)) - (ir1=? (library-set-expression x) (library-set-expression y)))) - ((and (toplevel-define? x) (toplevel-define? y)) - (and - (symbol=? (toplevel-define-name x) (toplevel-define-name y)) - (ir1=? (toplevel-define-expression x) (toplevel-define-expression y)))) - ((and (if? x) (if? y)) - (and - (ir1=? (if-test x) (if-test y)) - (ir1=? (if-consequent x) (if-consequent y)) - (ir1=? (if-alternate x) (if-alternate y)))) - ((and (call? x) (call? y)) - (and - (ir1=? (call-procedure x) (call-procedure y)) - (apply (map ir1=? (call-arguments x) (call-arguments y)))) - ((and (sequence? x) (sequence? y)) - (and - (ir1=? (sequence-head x) (sequence-head y)) - (ir1=? (sequence-tail x) (sequence-tail y)))) - ((and (lambda? x) (lambda? y)) - (ir1=? (lambda-body x) (lambda-body y))) - ((and (lambda-case? x) (lambda-case? y)) - (and - (equal? (lambda-case-arguments x) (lambda-case-arguments y)) - (eq? (lambda-case-rest x) (lambda-case-rest y)) - (ir1=? (lambda-case-body x) (lambda-case-body y)) - (or (and (not (lambda-case-alternate x)) - (not (lambda-case-alternate y))) - (ir1= (lambda-case-alternate x) (lambda-case-alternate y))))) - ((and (letrec? x) (letrec? y)) - (and - (boolean=? (letrec-in-order? x) (letrec-in-order? y)) - (map symbol=? (letrec-names x) (letrec-names y)) - - (test builtin-quote - (assert-equal + (assert-equal ir1=? (make-constant '(test 1 2 3)) (expand '(quote (test 1 2 3)) builtins-environment))) (test builtin-syntax-rules-literal - (assert-equal + (assert-equal ir1=? (make-constant 1) (expand '(builtin-let-syntax @@ -101,7 +38,7 @@ (test builtin-syntax-rules-underscore - (assert-equal + (assert-equal ir1=? (make-constant 0) (expand '(builtin-let-syntax @@ -113,7 +50,7 @@ (test builtin-syntax-rules-substitution - (assert-equal + (assert-equal ir1=? (make-constant 5) (expand '(builtin-let-syntax @@ -125,7 +62,7 @@ (test builtin-syntax-rules-nil - (assert-equal + (assert-equal ir1=? (make-constant 1) (expand '(builtin-let-syntax @@ -138,7 +75,7 @@ (test builtin-syntax-rules-improper-list - (assert-equal + (assert-equal ir1=? (make-constant 1) (expand '(builtin-let-syntax @@ -150,7 +87,7 @@ (test builtin-syntax-rules-quoted - (assert-equal + (assert-equal ir1=? (make-constant 'a) (expand '(builtin-let-syntax @@ -162,7 +99,7 @@ (test builtin-syntax-rules-constant - (assert-equal + (assert-equal ir1=? (make-constant 2) (expand '(builtin-let-syntax @@ -176,7 +113,7 @@ (test builtin-syntax-rules-ellipsis - (assert-equal + (assert-equal ir1=? (make-constant 5) (expand '(builtin-let-syntax @@ -188,7 +125,7 @@ (test builtin-syntax-rules-ellipsis-improper - (assert-equal + (assert-equal ir1=? (make-constant 5) (expand '(builtin-let-syntax @@ -200,7 +137,7 @@ (test builtin-syntax-rules-ellipsis-zip - (assert-equal + (assert-equal ir1=? (make-constant '((1 . 3) (2 . 4))) (expand '(builtin-let-syntax @@ -213,7 +150,7 @@ (test builtin-syntax-rules-ellipsis-nested - (assert-equal + (assert-equal ir1=? (make-constant '(1 2 3 4 5)) (expand '(builtin-let-syntax @@ -226,7 +163,7 @@ (test builtin-syntax-rules-ellipsis-custom - (assert-equal + (assert-equal ir1=? (make-constant 5) (expand '(builtin-let-syntax @@ -235,8 +172,3 @@ ((foo x :::) (x :::)))) (foo quote 5)) builtins-environment))) - - -(test builtin-lambda-simple - (assert-equal - (make-lambda |