src/common.clj

@@ -0,0 +1,9 @@
+(ns common)
+
+(defmacro inherit [& syms]
+  (let [f (if (<= 8 (count syms))
+            `hash-map
+            `array-map)]
+    `(~f ~@(mapcat #(list (keyword %) %)
+                   syms))))
+

src/expand.clj

@@ -7,14 +7,8 @@
             [spec-dict.main :refer [dict]]
             [scm]
             [clojure.java.io :as io]
-            [expand.syntax-rules :as syntax-rules]))
-
-(defmacro inherit [& syms]
-  (let [f (if (<= 8 (count syms))
-            `hash-map
-            `array-map)]
-    `(~f ~@(mapcat #(list (keyword %) %)
-                   syms))))
+            [expand.syntax-rules :as syntax-rules])
+  (:use [common]))
 
 (s/def ::scope scm/scope?)
 

src/expand/syntax_rules.clj

@@ -3,7 +3,9 @@
             [clojure.spec.alpha :as s]
             [spec-dict.main :refer [dict]]
             [scm]
-            [clojure.test :as t]))
+            [clojure.test :as t]
+            [clojure.walk :as walk])
+  (:use [common]))
 
 (s/def ::pattern scm/datum?)
 (s/def ::template scm/datum?)
@@ -100,9 +102,40 @@
     ;; no match
     :else nil))
 
-(defn transcribe [template]
-  (match template
-    [:var x] (throw (Exception. "todo"))
-    [:ellipsis _] (throw (Exception. "todo 점점점"))
-    [:lit x] (throw (Exception. "todo 점점점"))
-    [:list xs] (throw (Exception. "todo 점점점"))))
+(defn unify* [pattern datum]
+  (some-> (unify (scm/datum->syntax-recursive pattern)
+                 (scm/datum->syntax-recursive datum))
+          (update-vals scm/syntax->datum)))
+
+(defn transcribe [template unification]
+  (match (scm/syntax-e template)
+    (x :guard symbol?) (or (get unification x)
+                           (throw (Exception. "blah")))
+    ([x & xs] :seq)
+    (let [xs* (transcribe (scm/datum->syntax xs template) unification)]
+      (scm/datum->syntax
+       (cons (transcribe x unification) (scm/syntax-e xs*))
+       template))
+
+    ([] :seq)
+    template))
+
+(defn transcribe*
+  ([template unification]
+   (-> template
+       scm/datum->syntax-recursive
+       (transcribe unification)))
+  ([template pattern datum]
+   (-> (transcribe (scm/datum->syntax-recursive template)
+                   (unify (scm/datum->syntax-recursive pattern)
+                          (scm/datum->syntax-recursive datum)))
+       scm/syntax->datum)))
+
+(comment
+  (let [pattern 'x
+        template 'x
+        datum '(1 2 3)]
+    (-> template
+        (transcribe* (unify (scm/datum->syntax-recursive pattern)
+                            (scm/datum->syntax-recursive datum)))
+        #_scm/syntax->datum)))

src/scm.clj

@@ -104,7 +104,12 @@
 (declare constant?)
 
 (defn syntax->datum [stx]
-  (cond (syntax? stx) (recur (syntax-e stx))
+  (walk/prewalk
+   #(if (syntax? %)
+      (syntax-e %)
+      %)
+   stx)
+  #_(cond (syntax? stx) (recur (syntax-e stx))
         (seq? stx) (map syntax->datum stx)
         (improper-list? stx) (throw (Exception. "todo"))
         (or (constant? stx) (symbol? stx)) stx