aboutsummaryrefslogtreecommitdiffstats
path: root/lib/csc/macros-test.csc
diff options
context:
space:
mode:
Diffstat (limited to 'lib/csc/macros-test.csc')
-rw-r--r--lib/csc/macros-test.csc357
1 files changed, 0 insertions, 357 deletions
diff --git a/lib/csc/macros-test.csc b/lib/csc/macros-test.csc
deleted file mode 100644
index 9c4aced..0000000
--- a/lib/csc/macros-test.csc
+++ /dev/null
@@ -1,357 +0,0 @@
-(define-library (csc macros-test)
- (import (scheme base)
- (only (csc gensym)
- gensym
- gensym?)
- (only (csc ir1)
- %call
- %call-builtin
- %constant
- %define-syntax
- %if
- %lambda
- %letrec
- %lexical-ref
- %lexical-set
- %library-define
- %library-ref
- %sequence
- call-builtin?
- call?
- constant?
- define-syntax?
- if?
- lambda?
- letrec?
- lexical-ref-name
- lexical-ref?
- lexical-set-expression
- lexical-set?
- library-define?
- library-ref?
- 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
- sequence?)
- (only (csc testing)
- assert-equal
- test)
- (csc macros))
- (begin
-
-
- (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 call-builtin? %call-builtin)
- (cons sequence? %sequence)
- (cons lambda? %lambda)
- (cons letrec? %letrec)
- (cons gensym? (lambda (x) 'gensym))
- (cons macro-transformer? (lambda (x) 'transformer))))
-
-
- (test builtin-quote
- (assert-equal
- (make-constant '(test 1 2 3))
- (expand-body 'main
- '((quote (test 1 2 3)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-literal
- (assert-equal
- (make-constant 1)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules (a b)
- ((foo a)
- 0)
- ((foo b)
- 1))))
- (foo b)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-underscore
- (assert-equal
- (make-constant 0)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules ()
- ((foo _) 0))))
- (foo ignored)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-substitution
- (assert-equal
- (make-constant 5)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules ()
- ((foo x) x))))
- (foo 5)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-nil
- (assert-equal
- (make-constant 1)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules ()
- ((foo x) 0)
- ((foo) 1))))
- (foo)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-improper-list
- (assert-equal
- (make-constant 1)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules ()
- ((foo a . b) a))))
- (foo 1 2 3)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-quoted
- (assert-equal
- (make-constant 'a)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules ()
- ((foo x) (quote x)))))
- (foo a)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-constant
- (assert-equal
- (make-constant 2)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules ()
- ((foo "abc") 0)
- ((foo "def") 1)
- ((foo "ghi") 2))))
- (foo "ghi")))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-ellipsis
- (assert-equal
- (make-constant 5)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules ()
- ((foo x ...) (x ...)))))
- (foo quote 5)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-ellipsis-improper
- (assert-equal
- (make-constant 5)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules ()
- ((foo x ... . y) (x ... y)))))
- (foo quote . 5)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-ellipsis-zip
- (assert-equal
- (make-constant '((1 . 3) (2 . 4)))
- (expand-body 'main
- '((let-syntax
- ((zip
- (syntax-rules ()
- ((zip (x ...) (y ...))
- (quote ((x . y) ...))))))
- (zip (1 2) (3 4))))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-ellipsis-nested
- (assert-equal
- (make-constant '(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))
-
-
- (test builtin-syntax-rules-ellipsis-custom
- (assert-equal
- (make-constant 5)
- (expand-body 'main
- '((let-syntax
- ((foo
- (syntax-rules ::: ()
- ((foo x :::) (x :::)))))
- (foo quote 5)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-define
- (assert-equal
- (make-library-define (make-library-ref 'exit 'main)
- (make-lambda (test-ref 'args) (make-call-builtin 'exit (list (make-library-ref 'code 'main)))))
- (expand-body 'main
- '((let-syntax
- ((define
- (syntax-rules ()
- ((define (f) body ...)
- (builtin-define f (builtin-lambda args body ...))))))
- (define (exit)
- (call-builtin exit code))))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-syntax-rules-recursive
- (assert-equal
- (make-call-builtin 'add
- (list (make-constant 1)
- (make-call-builtin 'add
- (list (make-constant 1)
- (make-call-builtin 'add (list (make-constant 1) (make-constant 0)))))))
- (expand-body 'main
- '((let-syntax
- ((macro-len
- (syntax-rules ()
- ((macro-len ()) 0)
- ((macro-len (_ tail ...))
- (call-builtin add 1 (macro-len (tail ...)))))))
- (macro-len (a b c))))
- builtins-environment)
- transform-ir1))
-
-
- (define (test-ref sym)
- (make-lexical-ref sym (gensym)))
-
-
- (test builtin-lambda-ref
- (assert-equal
- (make-lambda (test-ref 'args)
- (test-ref 'args))
- (expand-body 'main
- '((builtin-lambda args args))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-lambda-defines
- (assert-equal
- (make-lambda (test-ref 'args)
- (make-letrec #t '(a b) (list (gensym) (gensym))
- (list (make-constant 6)
- (test-ref 'a))
- (make-constant 7)))
- (expand-body 'main
- '((builtin-lambda args
- (builtin-define a (quote 6))
- (builtin-define b a)
- (quote 7)))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-lambda-empty
- (assert-equal
- (make-lambda (test-ref 'args)
- (make-constant #f))
- (expand-body 'main
- '((builtin-lambda args))
- 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))
-
-
- (test builtin-call-builtin
- (assert-equal
- (make-call-builtin 'bbb (list (make-constant 5)))
- (expand-body 'main
- '((call-builtin bbb 5))
- builtins-environment)
- transform-ir1))
-
-
- (test builtin-lexical-set
- (assert-equal
- (make-lambda (test-ref 'args)
- (make-lexical-set (test-ref 'args) (make-constant 5)))
- (expand-body 'main
- '((builtin-lambda args
- (set! args 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))))
generated by cgit v1.3.1 (git 2.54.0) at 2026-09-04 02:05:11 +0000