청소

test/expand/core_test.clj

@@ -1,8 +1,9 @@
-(ns expand-test
-  (:require [expand :as sut]
-            [clojure.test :as t]
-            [clojure.spec.alpha :as s]
-            [scm]))
+(ns expand.core-test
+  (:require
+   [clojure.spec.alpha :as s]
+   [clojure.test :as t]
+   [expand.core :as sut]
+   [expand.scm :as scm]))
 
 (t/deftest nearest-test
   (t/is (= '#{#{a b}}

test/expand/scm_test.clj

@@ -1,7 +1,7 @@
-(ns scm-test
-  (:require [scm :as sut]
-            [clojure.test :as t])
-  (:import scm.ISyntax scm.Syntax))
+(ns expand.scm-test
+  (:require [clojure.test :as t]
+            [expand.scm :as sut])
+  (:import (expand.scm ISyntax Syntax)))
 
 (t/deftest read-test
   (t/testing "boolean"
@@ -63,8 +63,8 @@
   (t/is (= 123 (sut/syntax-e #scm/stx [123 #{}]))))
 
 (t/deftest unresolved?-test
-  (t/is (sut/unresolved? (scm/->Syntax 123 nil)))
+  (t/is (sut/unresolved? (sut/->Syntax 123 nil)))
   (t/is (sut/unresolved? #scm/stx 123)))
 
 (t/deftest resolved?-test
-  (t/is (sut/resolved? (scm/->Syntax 123 '#{a}))))
+  (t/is (sut/resolved? (sut/->Syntax 123 '#{a}))))

test/expand/syntax_rules_test.clj

@@ -2,7 +2,8 @@
   (:require [expand.syntax-rules :as sut]
             [clojure.core.match :refer [match]]
             [clojure.test :as t]
-            [clojure.walk :as walk]))
+            [clojure.walk :as walk]
+            [expand.scm :as scm]))
 
 (defmacro broken-is [form]
   `(t/is (not ~form)

test/old_test.clj

@@ -1,152 +0,0 @@
-(ns old-test
-  (:require
-   [clojure.core.match :refer [match]]
-   [clojure.spec.alpha :as s]
-   [clojure.test :as t]
-   [old :as sut]))
-
-(t/deftest scheme-base-test
-  (t/is (s/valid? ::sut/environment (:env sut/scheme-base)))
-  (t/is (s/valid? ::sut/symtable (:symtable sut/scheme-base))))
-
-(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 "var"
-    (let [pattern-var? #(match (s/conform ::pattern %)
-                          [:var _] true
-                          _ false)]
-      (t/is (pattern-var? 'abc))
-      (t/is (not (pattern-var? '_)))
-      (t/is (not (pattern-var? '...)))))
-  (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 (s/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/us-expand '(λ (x) x)))))
-  (t/testing "let-syntax"
-    (t/is (= '(let-syntax ((m (syntax-rules
-                               ()
-                               ((m) 123))))
-                456)
-             (sut/expand
-              '(let-syntax ((m (syntax-rules
-                                ()
-                                ((m) 123))))
-                 456)))))
-  (t/testing "let"
-    (t/is (= '(let ((x 123)
-                    (y 456))
-                (+ x y))
-             (sut/us-expand
-              '(let ((x 123)
-                     (y 456))
-                 (+ x y))))))
-  (t/testing "application"
-    (t/is (= '(lambda (f x) (f x))
-             (sut/us-expand '(lambda (f x) (f x))))))
-  (t/testing "macros"
-    (t/testing "when"
-      (t/is (= '(let ((x 123)) (if x 456))
-               (sut/us-expand '(let ((x 123))
-                                 (when x 456)))))
-      (t/is (= '(let (([body #{s0}] 123))
-                  (if [body #{s0}]
-                    456))
-               (sut/rg-expand '(let ((body 123))
-                                 (when body 456))))
-            "`when` does not clobber caller's scope")
-      (t/is (= '(let (([x #{s0}] 123))
-                  (let-syntax ((m (syntax-rules () ((m) x))))
-                    (lambda ([x #{s1 s2 s0}])
-                            [x #{s0 s3}])))
-               (sut/rg-expand '(let ((x 123))
-                                 (let-syntax ((m (syntax-rules
-                                                  ()
-                                                  ((m) x))))
-                                   (λ (x)
-                                      (m))))))
-            "`when` does not capture caller's scope")
-      (t/is (= '(if 123 (begin (display "hello")
-                               (newline)))
-               (sut/us-expand '(when 123
-                                 (display "hello")
-                                 (newline))))
-            "`when` captures multiple"))))
-
-(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 (= '[:list [[:var x]
-                    [:ellipsis [:var y]]
-                    [:ellipsis [:var z]]
-                    [:var a]
-                    [:var b]
-                    [:var c]]]
-           (s/conform ::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
-
-    '{b [:ellipsis ([:ellipsis (1 2)] [:ellipsis (3 4)])]}
-    '((b ...) ...)
-    '((1 2) (3 4))
-
-    {} '_ 123)
-  (t/testing "non-matches"
-    (t/are [pattern datum] (= nil (sut/unify pattern datum))
-      '(a b c) '(1 2)
-      '(a b c) '(1 2))))

test/unhygienic_test.clj

@@ -1,30 +0,0 @@
-(ns unhygienic-test
-  (:require [unhygienic :as sut]
-            [clojure.test :as t]))
-
-(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
-
-    '{b [:ellipsis ([:ellipsis (1 2)] [:ellipsis (3 4)])]}
-    '((b ...) ...)
-    '((1 2) (3 4))
-
-    {} '_ 123)
-  (t/testing "non-matches"
-    (t/are [pattern datum] (= nil (sut/unify pattern datum))
-      '(a b c) '(1 2)
-      '(a b c) '(1 2))))
-
-(t/deftest transcribe-test
-  (t/are [result datum pattern template]
-      (= result (sut/transcribe (sut/unify pattern datum) template))
-    '(1 a 2 b) '((1 2) (a b))
-    '((x y) ...) '(x ... y ...)
-
-    '(1 2 3 4) '(1 2 3 4)
-    '(x ...) '(x ...)
-
-    '(concat (1 2) (3 4) (5 6)) '((1 2) (3 4) (5 6))
-    '((a ...) ...) '(concat (a ...) ...)))