Get dict splats working, fix match-typed

TODO.xit

@@ -32,6 +32,9 @@ Write a compiler: correctness
 [ ] check that recur is only called inside loop or fn forms
 [ ] check ns accesses
 [ ] splattern is last member in a pattern
+[ ] -----List/Tuple
+[ ] -----Dict/Struct/Set
+[ ] prevent import cycles
 
 Write a compiler: optimization
 [ ] devise tail call optimization

src/ludus/grammar.clj

@@ -45,7 +45,7 @@
                                  	(zero+ tuple-pattern-entry)
                                  	(quiet :rbracket)])
 
-(defp pair-pattern order-0 [:keyword #'pattern])
+(defp pair-pattern group weak-order [:keyword pattern])
 
 (defp dict-pattern-term flat choice [pair-pattern :word splattern])
 

src/ludus/interpreter.clj

@@ -129,33 +129,84 @@
                   (recur (dec i)))
                 {:success false :reason (str "Could not match " pattern " with " value " because " (:reason match?))}))))))))
 
+(defn- member->kv [map member]
+  (let [type (:type member)
+        data (:data member)]  
+    (case type
+      :word
+      (assoc map (keyword (first data)) member)
+
+      :pair-pattern
+      (assoc map (-> data first :data first) (second data))
+
+      map ;;ignore splats
+      )))
+
+(defn- pattern-to-map [pattern]
+  (let [members (:data pattern)]
+    (reduce member->kv {} members)))
+
 ;; TODO: update this to match new AST representation
-(defn- match-dict [pattern value ctx-vol]
+(defn- match-dict [pattern dict ctx-vol]
-  (cond
+  (let [
-    (not (map? value))
+        members (:data pattern)
-    {:success false :reason "Could not match non-dict value to dict pattern"}
+        pattern-map (pattern-to-map pattern)
+        kws (keys pattern-map)]
+    ;(println "Matching with " pattern-map)
+    (cond
+      (not (map? dict))
+      {:success false :reason "Could not match non-dict value to dict pattern"}
+  
+      (not (::data/dict dict))
+      {:success false :reason "Cannot match non-dict data types to a dict pattern"}
 
-    (not (::data/dict value))
+      (empty? members)
-    {:success false :reason "Cannot match non-dict data types to a dict pattern"}
+      {:success true :ctx {}}
+  
+      :else
+      (let [ctx-diff (volatile! @ctx-vol)
+            splat? (= :splattern (-> members peek :type))
+            length (count kws)]
+        (if splat? (println "Pattern has splat!!"))
+        (loop [i 0]
+          (cond
+            (> length i)
+            (let [kw (nth kws i)
+                  pattern-at (kw pattern-map)
+                  value (kw dict)]
+              (if (contains? dict kw)
+                (let [match? (match pattern-at value ctx-diff)]
+                  (if (:success match?)
+                    (do
+                      (vswap! ctx-diff #(merge % (:ctx match?)))
+                      (recur (inc i)))
+                    {:success false
+                     :reason (str "Could not match " pattern " with value " dict " at key " kw " because " (:reason match?))}
+                    ))
+                {:success false
+                 :reason (str "Could not match " pattern " with " dict " at key " kw " because there is no value at " kw)}))
 
-    :else
+            splat?
-    (let [members (:members pattern)
+            (let [splat (-> members peek)
-          kws (keys members)
+                  splat-data (-> splat :data first)
-          ctx-diff (volatile! @ctx-vol)]
+                  splat-type (-> splat-data :type)]
-      (loop [i (dec (count kws))]
+              (println "!!!!Matching splat")
-        (if (> 0 i)
+              (if (= :word splat-type)
-          {:success true :ctx @ctx-diff}
+                (let [unmatched (apply dissoc dict kws)
-          (let [kw (nth kws i)]
+                      match? (match splat-data unmatched ctx-diff)]
-            (if (contains? value kw)
+                  (println "Splatting " unmatched "\ninto " )
-              (let [match? (match (kw members) (kw value) ctx-diff)]
+                  (if (:success match?)
-                (if (:success match?)
+                    {:success true :ctx (merge @ctx-diff (:ctx match?))}
-                  (do
+                    {:success false
-                    ;(println (:ctx match?))
+                     :reason (str "Could not match " pattern " with value " dict " because " (:reason match?))}
-                    (vswap! ctx-diff #(merge % (:ctx match?)))
+                    ))
-                    (recur (dec i)))
+                {:success true :ctx @ctx-diff}
-                  {:success false :reason (str "Could not match " pattern " with " value " at key " kw " because " (:reason match?))}))
+                ))
-              {:success false
+
-               :reason (str "Could not match " pattern " with " value " at key " kw " because there is no value at " kw)})))))))
+            :else
+            {:success true :ctx @ctx-diff}
+
+            ))))))
 
 ;; TODO: update this to use new AST representation
 (defn- match-struct [pattern value ctx-vol]
@@ -185,8 +236,8 @@
 
 (defn- match-typed [pattern value ctx]
   (let [data (:data pattern)
-        name (-> data first :data)
+        name (-> data first :data first)
-        type (-> data second :data)]
+        type (-> data second :data first)]
     (cond
       (contains? ctx name) {:success false :reason (str "Name " name "is already bound") :code :name-error}
       (not (= type (prelude/get-type value))) {:success false :reason (str "Could not match " pattern " with " value ", because types do not match")}
@@ -882,7 +933,7 @@
 
 (do
   (def source "
-    let (...a) = (1, 2, 3)
+    let #{:a a as :number} = #{:a 1}
     a
       ")