점점점과 빈 리스트는 맞음

src/expand/syntax_rules.clj

@@ -68,6 +68,18 @@
   (or (= '... x)
       (and (scm/syntax? x) (-> x scm/syntax-e ellipsis?))))
 
+(defn pattern-vars [pattern]
+  ;; 안 예쁘는데ㅠㅠ
+  (let [vs (atom #{})]
+    (walk/prewalk (fn [x]
+                    (when (and (scm/identifier? x)
+                               (not (wildcard? x))
+                               (not (ellipsis? x)))
+                      (swap! vs #(conj % x)))
+                    x)
+                  pattern)
+    @vs))
+
 (defn unify [pattern datum]
   (match [(scm/syntax-e pattern) (scm/syntax-e datum)]
     [(_ :guard wildcard?) _] {}
@@ -79,13 +91,22 @@
 
     [([p (_ :guard ellipsis?) & ps] :seq)
      (ds :guard seq?)]
-    (let [ds-end (take-last (count ps) ds)
-          ds-start (drop-last (count ps) ds)]
+    (let [ds-end (or (take-last (count ps) ds)
+                     (list))
+          ds-start (or (drop-last (count ps) ds)
+                       (list))]
       (merge-unify
        (some->> ds
                 (map #(some-> (unify p %)
                               (update-vals list)))
-                (apply merge-unify-with concat)
+                (apply merge-unify-with concat
+                       ;; 여기에 이 map이 없으면 ds 빌 때 `unify`는
+                       ;; {}을 생성할 잘못되게 것이다. 그때
+                       ;; variable들은 bound을 안 될 것이다. 대신에
+                       ;; empty ellipsis로 bind해야 한다.
+                       (into {}
+                             (for [v (pattern-vars p)]
+                               [(scm/syntax-e v) (list)])))
                 (map (fn [[k v]]
                        [k [:ellipsis v]]))
                 (into {}))))

test/expand/syntax_rules_test.clj

@@ -4,12 +4,50 @@
             [clojure.test :as t]
             [clojure.walk :as walk]))
 
+(defmacro broken-is [form]
+  `(t/is (not ~form)
+         "(expected failure, broken)"))
+
+(defn- pattern-vars [p]
+  (->> p
+       scm/datum->syntax-recursive
+       sut/pattern-vars
+       (map #(if (scm/syntax? %)
+               (scm/syntax-e %)
+               %))
+       (into #{})))
+
+(t/deftest pattern-vars-test
+  (t/testing "no variables"
+    (t/are [x] (= #{} (pattern-vars x))
+      '()
+      '(_ ...)
+      123
+      true
+      '(123 456)
+      '(() ())
+      '(_ (_ _) ... _)))
+  (t/is (= '#{a b c}
+           (pattern-vars '(a b c))))
+  (t/is (= '#{a c}
+           (pattern-vars '(a _ c))))
+  (t/is (= '#{a c}
+           (pattern-vars '(a ... _ c))))
+  (t/is (= '#{a b}
+           (pattern-vars '((a b) ...)))))
+
 (t/deftest unify-test
-  (t/is (= '{x (1 2 3)}
-           (sut/unify* 'x '(1 2 3))))
-  (t/is (= '{x 1 y 2}
-           (sut/unify* '(x y) '(1 2))))
-  (t/testing "literals"
+  (t/testing "variable"
+    (t/is (= '{x (1 2 3)}
+             (sut/unify* 'x '(1 2 3)))))
+  (t/testing "wildcard"
+    (t/is (= {}
+             (sut/unify* '_ '(1 2 3))))
+    (t/is (= {}
+             (sut/unify* '(_ _) '(1 2))))
+    (t/is (= nil
+             (sut/unify* '(_ _ _) '(1 2)))))
+  (t/testing "constants"
     (t/is (= {}
              (sut/unify* 123 123)))
     (t/is (= nil
@@ -18,18 +56,32 @@
              (sut/unify* true 456)))
     (t/is (= {}
              (sut/unify* true true))))
-  (t/is (= '{x [:ellipsis (1 2 3 4)]}
-           (sut/unify* '(x ...) '(1 2 3 4))))
-  (t/is (= '{x [:ellipsis (1 3)]
-             y [:ellipsis (2 4)]}
-           (sut/unify* '((x y) ...) '((1 2) (3 4)))))
-  (t/is (= nil
-           (sut/unify* '(x y z) '(1 2))))
-  (t/is (= nil
-           (sut/unify* '(x y) '(1 2 3))))
-  (t/is (= nil
-           (sut/unify* '((x y) ...)
-                       '((1 2) (1 2 3)))))
+  (t/testing "known-length lists"
+    (t/is (= '{x 1 y 2}
+             (sut/unify* '(x y) '(1 2))))
+    (t/is (= nil
+             (sut/unify* '(x y z) '(1 2))))
+    (t/is (= nil
+             (sut/unify* '(x y) '(1 2 3))))
+    (t/is (= '{a 1 b 2 c 3 d 4 e 5}
+             (sut/unify* '((a b) (c d e)) '((1 2) (3 4 5))))))
+  (t/testing "trailing ellipsis"
+    (t/is (= '{x [:ellipsis (1 2 3 4)]}
+             (sut/unify* '(x ...) '(1 2 3 4))))
+    (t/is (= '{x [:ellipsis (1 3)]
+               y [:ellipsis (2 4)]}
+             (sut/unify* '((x y) ...) '((1 2) (3 4)))))
+    (t/is (= nil
+             (sut/unify* '((x y) ...)
+                         '((1 2) (1 2 3)))))
+    (t/testing "ellipsis matches empty list"
+      (t/is (= '{x [:ellipsis ()]}
+               (sut/unify* '(x ...)
+                           '())))
+      (t/is (= '{x [:ellipsis ()]
+                 y [:ellipsis ()]}
+               (sut/unify* '((x y) ...)
+                           '())))))
   (t/is (= '{x (1 2 3)}
            (sut/unify* 'x '(1 2 3))))
   (t/is (= '{x [:ellipsis (1 2 3)]}