src/expand.clj

@@ -171,6 +171,38 @@
     (swap! symtable-ref #(assoc-in % [sym scopes] bind))
     {bind denot}))
 
+(defn symtable [[sym scopes] bind]
+  {sym {scopes bind}})
+
+
+
+(defn- merge-unify-with
+  ([f] {})
+  ([f a] a)
+  ([f a b] (and a b (merge-with f a b)))
+  ([f a b & xs] (reduce #(merge-unify-with f %1 %2) (cons a (cons b xs)))))
+
+(defn- merge-unify [& xs]
+  (apply merge-unify-with (fn [_ x] x) xs))
+
+(defn- unify* [pattern datum env symtable-ref scopes]
+  (match [pattern datum]
+    [[:wildcard _] _] {}
+
+    [[:var x] _] (symtable [x scopes] )))
+
+(defn unify
+  ([pattern datum]
+   (unify* (s/conform ::pattern pattern) datum
+           scheme-base-env
+           (symtable-for-env scheme-base-env)
+           #{}))
+  ([pattern datum env symtable-ref scopes]
+   (unify* (s/conform ::pattern pattern) datum env symtable-ref scopes)))
+
+
+;;; expand
+
 (declare expand)
 
 (defmethod expand-primitive 'lambda