src/expand.clj

@@ -43,7 +43,12 @@
         :list (s/and (s/* ::template-element) sequential?)))
 
 (s/def ::template-element
-  (s/cat :template ::template :ellipsis (s/? #{'...})))
+  (s/& (s/cat :template ::template :ellipsis (s/? #{'...}))
+       (s/conformer
+          (fn [{:keys [ellipsis template]}]
+            (if ellipsis
+              [:ellipsis template]
+              template)))))
 
 (s/def ::rule
   (s/and sequential?
@@ -112,9 +117,6 @@
       nil
       xs*)))
 
-(defn unify [pattern datum]
-  (unify* (s/conform ::pattern pattern) datum))
-
 (defn- unify* [pattern datum]
   (match [pattern datum]
     [[:var x] _]
@@ -143,12 +145,50 @@
      (_ :guard seq?)]
     (and (= (count datum)
             (count leading))
-         (->> (map #(unify* depth %1 %2) leading datum)
+         (->> (map #(unify* %1 %2) leading datum)
               (apply merge-unify)))
 
     ;; no match
     :else nil))
 
+(defn unify [pattern datum]
+  (unify* (s/conform ::pattern pattern) datum))
+
+
+
+(comment
+  (transcribe (unify '((a ...) ...)
+                     '((1 2) (3 4)))
+              '((a ...) ...)))
+
+(defn transcribe* [depth index unification template]
+  (match template
+    [:var x]
+    (match (get unification x)
+      [:ellipsis p]
+      (if (< 0 depth)
+        (if (seq? p)
+          (recur (dec depth) index
+                 (assoc unification x
+                        (nth p index))))
+          (throw (ex-info "ellipsis bad" {})))
+
+      (_ :guard nil?)
+      #_(throw (ex-info "unbound" {:symbol x}))
+      x ;; unhygenic but it's demo }:)
+
+      p p)
+
+    [:list ts]
+    (->> (for [[i t] (map-indexed (fn [i x] [i x]) ts)]
+           (match t
+             [:ellipsis t*] (transcribe* (inc depth) i unification t*)
+             :else [(transcribe* depth i unification t)]))
+         (apply concat))))
+
+(defn transcribe [unification template]
+  (transcribe* 0 0 unification (s/conform ::template template)))
+
 
 
 (defn symtable-for-env [env]