Get dict splats working, fix match-typed

This commit is contained in:
Scott Richmond 2023-05-31 11:31:04 -04:00
parent 0e9c403634
commit 6c38c43727
3 changed files with 82 additions and 28 deletions

View File

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

View File

@ -45,7 +45,7 @@
(zero+ tuple-pattern-entry) (zero+ tuple-pattern-entry)
(quiet :rbracket)]) (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]) (defp dict-pattern-term flat choice [pair-pattern :word splattern])

View File

@ -129,33 +129,84 @@
(recur (dec i))) (recur (dec i)))
{:success false :reason (str "Could not match " pattern " with " value " because " (:reason match?))})))))))) {: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 ;; 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 ;; TODO: update this to use new AST representation
(defn- match-struct [pattern value ctx-vol] (defn- match-struct [pattern value ctx-vol]
@ -185,8 +236,8 @@
(defn- match-typed [pattern value ctx] (defn- match-typed [pattern value ctx]
(let [data (:data pattern) (let [data (:data pattern)
name (-> data first :data) name (-> data first :data first)
type (-> data second :data)] type (-> data second :data first)]
(cond (cond
(contains? ctx name) {:success false :reason (str "Name " name "is already bound") :code :name-error} (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")} (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 (do
(def source " (def source "
let (...a) = (1, 2, 3) let #{:a a as :number} = #{:a 1}
a a
") ")