86 lines
2.7 KiB
Clojure
86 lines
2.7 KiB
Clojure
(ns expand-test
|
|
(:require [expand :as sut]
|
|
[clojure.test :as t]
|
|
[clojure.spec.alpha :as s]
|
|
[scm]))
|
|
|
|
(t/deftest nearest-test
|
|
(t/is (= '#{#{a b}}
|
|
(sut/nearest '#{a b c}
|
|
'[#{a} #{a b} #{a d}]))
|
|
"unambiguous")
|
|
(t/is (= '#{#{a b} #{a c}}
|
|
(sut/nearest
|
|
'#{a b c} '[#{a} #{a b} #{a c}]))
|
|
"ambiguous")
|
|
(t/is (= #{}
|
|
(sut/nearest
|
|
'#{a b c} '[#{d} #{d e} #{f}]))
|
|
"undefined"))
|
|
|
|
(t/deftest lookup-test
|
|
(t/is (= [:primitive 'lambda]
|
|
(sut/lookup #scm/stx [lambda #{}]
|
|
{[:global 'lambda] [:primitive 'lambda]}
|
|
{['lambda #{}] [:global 'lambda]})))
|
|
(t/is (= [:primitive 'lambda]
|
|
(sut/lookup #scm/stx [lambda #{a b c}]
|
|
{[:global 'lambda] [:primitive 'lambda]}
|
|
{['lambda #{}] [:global 'lambda]})))
|
|
(t/is (= [:var]
|
|
(sut/lookup #scm/stx [x #{a b c}]
|
|
'{[:lexical x A] [:var]
|
|
[:lexical x B] [:primitive lambda]}
|
|
'{[x #{a b}] [:lexical x A]
|
|
[x #{a}] [:lexical x B]}))))
|
|
|
|
(defn- expand [stx]
|
|
(-> #:library {:name '(user)
|
|
:declarations [[:import '(primitives+builtins)]
|
|
[:begin stx]]}
|
|
sut/expand-library
|
|
:library/declarations
|
|
second
|
|
second
|
|
scm/syntax->datum))
|
|
|
|
(t/deftest expand-test
|
|
(t/is (thrown? Exception (expand #scm/stx x)))
|
|
(t/testing "primitive forms"
|
|
(t/testing "lambda"
|
|
(t/is (= '(lambda (x) x)
|
|
(expand #scm/stx (#scm/stx lambda
|
|
#scm/stx (#scm/stx x)
|
|
#scm/stx x)))))
|
|
(t/testing "let"
|
|
(t/is (= '(let ((x 123))
|
|
x)
|
|
(expand #scm/stx (#scm/stx let
|
|
#scm/stx (#scm/stx (#scm/stx x
|
|
#scm/stx 123))
|
|
#scm/stx x)))))
|
|
(t/testing "if"
|
|
(t/is (= '(if 123 true false)
|
|
(expand #scm/stx (#scm/stx if
|
|
#scm/stx 123
|
|
#scm/stx true
|
|
#scm/stx false)))))))
|
|
|
|
|
|
;;; specs
|
|
|
|
(t/deftest spec-lambda-formals-test
|
|
(t/are [x] (s/valid? ::sut/lambda-formals x)
|
|
#scm/stx ()
|
|
#scm/stx (#scm/stx a #scm/stx b)
|
|
#scm/stx xs
|
|
(scm/datum->syntax
|
|
(scm/improper-list #scm/stx a
|
|
#scm/stx b))))
|
|
|
|
(t/deftest spec-prim-lambda-test
|
|
(t/are [x] (s/valid? ::sut/prim-lambda x)
|
|
#scm/stx (#scm/stx lambda
|
|
#scm/stx (#scm/stx a)
|
|
#scm/stx a)))
|