92 lines
2.8 KiB
Clojure
92 lines
2.8 KiB
Clojure
(ns expand-test
|
|
(:require [expand :as sut]
|
|
[clojure.test :as t]
|
|
[clojure.spec.alpha :as s]))
|
|
|
|
(t/deftest scheme-base-env-test
|
|
(t/is (s/valid? ::sut/environment sut/scheme-base-env)))
|
|
|
|
(t/deftest symtable-for-env-test
|
|
(t/is (s/valid? ::sut/symtable (sut/symtable-for-env sut/scheme-base-env))))
|
|
|
|
(t/deftest nearest-test
|
|
(t/is (= [:primitive 'lambda]
|
|
(sut/lookup ['lambda #{}]
|
|
sut/scheme-base-env
|
|
(sut/symtable-for-env sut/scheme-base-env))))
|
|
(t/is (= [#{0 1}]
|
|
(sut/nearest ['x #{0 1 2}]
|
|
[#{0} #{0 1} #{0 3}]))))
|
|
|
|
(t/deftest pattern-spec
|
|
(t/testing "list"
|
|
(t/are [l e t x] (= [l e t]
|
|
((juxt :leading :ellipsis :trailing)
|
|
(s/conform ::pattern x)))
|
|
nil nil nil '()
|
|
'(a) nil nil '(a)
|
|
'(a b) nil nil '(a b)
|
|
'(a) 'b nil '(a b ...)
|
|
'(a) 'b '(c) '(a b ... c)
|
|
'(a) 'b '(c d) '(a b ... c d))
|
|
(t/are [p] (s/invalid? ::pattern p)
|
|
'... '(...) '(... a b c)
|
|
'(a ... b ...)))
|
|
(t/testing "simple data"
|
|
(t/is (= 'a (sut/conform ::patern 'a)))))
|
|
|
|
(t/deftest expand-test
|
|
(t/testing "unbound symbol"
|
|
(t/is (thrown? Exception (sut/expand 'x))))
|
|
(t/testing "lambda"
|
|
(t/is (= '(lambda (x) x)
|
|
(sut/expand '(λ (x) x)))))
|
|
(t/testing "let"
|
|
(t/is (= '(let ((x 123)
|
|
(y 456))
|
|
(+ x y))
|
|
(sut/expand
|
|
'(let ((x 123)
|
|
(y 456))
|
|
(+ x y))))))
|
|
(t/testing "application"
|
|
(t/is (= '(lambda (f x) (f x))
|
|
(sut/expand '(lambda (f x) (f x)))))))
|
|
|
|
(t/deftest prim-lambda-spec
|
|
(t/is (s/valid? ::sut/prim-lambda '(lambda (x) x)))
|
|
(t/is (s/valid? ::sut/prim-lambda '(lambda (x) (display x) (newline)))))
|
|
|
|
(t/deftest prim-let-spec
|
|
(t/is (s/valid? ::sut/prim-let '(let ((x 123)
|
|
(y 456))
|
|
(+ x y)))))
|
|
|
|
(t/deftest prim-let-syntax-spec
|
|
(t/is (s/valid? ::sut/prim-let-syntax
|
|
'(let-syntax ((m (syntax-rules ()
|
|
((m) 123))))
|
|
(m)))))
|
|
|
|
(t/deftest template-spec
|
|
(t/is (s/valid? ::sut/template '(x ... y)))
|
|
(t/is (s/valid? ::sut/template 123))
|
|
(t/is (s/valid? ::sut/template '(x y ... z ... a b c))))
|
|
|
|
(t/deftest pattern-spec
|
|
(t/is (s/valid? ::sut/pattern '(m))))
|
|
|
|
(t/deftest rule-spec
|
|
(t/is (s/valid? ::sut/rule '((m) 123))))
|
|
|
|
(t/deftest prim-syntax-rules-spec
|
|
(t/is (s/valid? ::sut/prim-syntax-rules
|
|
'(syntax-rules
|
|
()
|
|
((m) 123)))))
|
|
|
|
(t/deftest unify-test
|
|
(t/are [result pattern datum] (= result (sut/unify pattern datum))
|
|
{'a 123 'b 456} '(a b) '(123 456)
|
|
nil '(a b) 123))
|