Get dict splats working, fix match-typed
This commit is contained in:
parent
0e9c403634
commit
6c38c43727
3
TODO.xit
3
TODO.xit
|
@ -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
|
||||||
|
|
|
@ -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])
|
||||||
|
|
||||||
|
|
|
@ -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 value))
|
(not (::data/dict dict))
|
||||||
{:success false :reason "Cannot match non-dict data types to a dict pattern"}
|
{:success false :reason "Cannot match non-dict data types to a dict pattern"}
|
||||||
|
|
||||||
:else
|
(empty? members)
|
||||||
(let [members (:members pattern)
|
{:success true :ctx {}}
|
||||||
kws (keys members)
|
|
||||||
ctx-diff (volatile! @ctx-vol)]
|
:else
|
||||||
(loop [i (dec (count kws))]
|
(let [ctx-diff (volatile! @ctx-vol)
|
||||||
(if (> 0 i)
|
splat? (= :splattern (-> members peek :type))
|
||||||
{:success true :ctx @ctx-diff}
|
length (count kws)]
|
||||||
(let [kw (nth kws i)]
|
(if splat? (println "Pattern has splat!!"))
|
||||||
(if (contains? value kw)
|
(loop [i 0]
|
||||||
(let [match? (match (kw members) (kw value) ctx-diff)]
|
(cond
|
||||||
(if (:success match?)
|
(> length i)
|
||||||
(do
|
(let [kw (nth kws i)
|
||||||
;(println (:ctx match?))
|
pattern-at (kw pattern-map)
|
||||||
(vswap! ctx-diff #(merge % (:ctx match?)))
|
value (kw dict)]
|
||||||
(recur (dec i)))
|
(if (contains? dict kw)
|
||||||
{:success false :reason (str "Could not match " pattern " with " value " at key " kw " because " (:reason match?))}))
|
(let [match? (match pattern-at value ctx-diff)]
|
||||||
{:success false
|
(if (:success match?)
|
||||||
:reason (str "Could not match " pattern " with " value " at key " kw " because there is no value at " kw)})))))))
|
(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)}))
|
||||||
|
|
||||||
|
splat?
|
||||||
|
(let [splat (-> members peek)
|
||||||
|
splat-data (-> splat :data first)
|
||||||
|
splat-type (-> splat-data :type)]
|
||||||
|
(println "!!!!Matching splat")
|
||||||
|
(if (= :word splat-type)
|
||||||
|
(let [unmatched (apply dissoc dict kws)
|
||||||
|
match? (match splat-data unmatched ctx-diff)]
|
||||||
|
(println "Splatting " unmatched "\ninto " )
|
||||||
|
(if (:success match?)
|
||||||
|
{:success true :ctx (merge @ctx-diff (:ctx match?))}
|
||||||
|
{:success false
|
||||||
|
:reason (str "Could not match " pattern " with value " dict " because " (:reason match?))}
|
||||||
|
))
|
||||||
|
{:success true :ctx @ctx-diff}
|
||||||
|
))
|
||||||
|
|
||||||
|
: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
|
||||||
")
|
")
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user