unify

src/expand/syntax_rules.clj

@@ -1,4 +1,26 @@
-(ns expand.syntax-rules)
+(ns expand.syntax-rules
+  (:require [clojure.core.match :refer [match]]
+            [clojure.spec.alpha :as s]
+            [scm]))
+
+(s/def ::pattern
+  (s/or :wildcard #{'_}
+        :var (s/and symbol? (complement #{'... '_}))
+        :lit scm/constant?
+        :list (s/and seq?
+                     (s/cat :leading (s/* ::pattern)
+                            :rest (s/? (s/cat :ellipsis #{'...}
+                                              :trailing (s/* ::pattern))))
+                     (s/conformer
+                      (fn [pat]
+                        (if-some [{:keys [ellipsis trailing]} (:rest pat)]
+                          (let [{:keys [leading]} pat]
+                            (if-some [variadic (last leading)]
+                              {:leading (vec (butlast leading))
+                               :ellipsis variadic
+                               :trailing trailing}
+                              ::s/invalid))
+                          pat))))))
 
 (defn- report-conflict [x y]
   (throw (ex-info "너무 정의합니다"
@@ -48,22 +70,12 @@
 (defn unify [pattern datum]
   (unify* (s/conform ::pattern pattern) datum))
 
-(defn transcribe [template env symtable scopes]
+(defn transcribe [template]
   (match template
-    [:var x] (let [x* (offer-scopes x scopes)]
-               (match (lookup x* env symtable)
-                 [:syntax [:ellipsis fuckoffmanjustshadowit]] (todo "점점점")
-                 [:syntax syn] syn
-                 :else x*))
-    [:ellipsis _] (todo "점점점")
-    [:lit x] x
-    [:list xs]
-    (do (tap> xs)
-        (map #(transcribe % env symtable scopes) xs))))
+    [:var x] (throw (Exception. "todo"))
+    [:ellipsis _] (throw (Exception. "todo 점점점"))
+    [:lit x] (throw (Exception. "todo 점점점"))
+    [:list xs] (throw (Exception. "todo 점점점"))))
 
-(defn resolve-template [template scopes]
-  (clojure.walk/postwalk
-   #(if (variable? %)
-      (offer-scopes % scopes)
-      %)
-   template))
+(comment
+  (unify 'x '(1 2 3)))

test/expand/syntax_rules_test.clj

@@ -0,0 +1,23 @@
+(ns expand.syntax-rules-test
+  (:require [expand.syntax-rules :as sut]
+            [clojure.test :as t]))
+
+(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/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) (1 2 3))))))