Fix bug, add show-pattern
This commit is contained in:
parent
ab48dfa6b3
commit
7515df835e
|
@ -70,7 +70,7 @@
|
||||||
(vswap! ctx-diff #(merge % (:ctx match?)))
|
(vswap! ctx-diff #(merge % (:ctx match?)))
|
||||||
;(println "current context: " (dissoc @ctx-diff ::parent))
|
;(println "current context: " (dissoc @ctx-diff ::parent))
|
||||||
(recur (inc i)))
|
(recur (inc i)))
|
||||||
{:success :false :reason (str "Could not match " pattern " with " (show/show value))}
|
{:success :false :reason (str "Could not match " (show/show-pattern pattern) " with " (show/show value))}
|
||||||
)))))))
|
)))))))
|
||||||
|
|
||||||
;; Match-tuple is misbehaving when the first value is a function and the second is a list
|
;; Match-tuple is misbehaving when the first value is a function and the second is a list
|
||||||
|
@ -81,9 +81,9 @@
|
||||||
;; that suggets that match is hanging here
|
;; that suggets that match is hanging here
|
||||||
|
|
||||||
(defn- match-tuple [pattern value ctx-vol]
|
(defn- match-tuple [pattern value ctx-vol]
|
||||||
(println "\n\n\n**********Matching tuple")
|
;(println "\n\n\n**********Matching tuple")
|
||||||
(println "*****Value: " (show/show value))
|
;(println "*****Value: " (show/show value))
|
||||||
(println "*****Pattern: " (prettify-ast pattern))
|
;(println "*****Pattern: " (show/show-pattern pattern))
|
||||||
(let [members (:data pattern)
|
(let [members (:data pattern)
|
||||||
length (count members)]
|
length (count members)]
|
||||||
(cond
|
(cond
|
||||||
|
@ -102,16 +102,16 @@
|
||||||
:else
|
:else
|
||||||
(let [ctx-diff (volatile! @ctx-vol)]
|
(let [ctx-diff (volatile! @ctx-vol)]
|
||||||
(loop [i length]
|
(loop [i length]
|
||||||
(println "Matching tuple elements at index " i)
|
;(println "Matching tuple elements at index " i)
|
||||||
(if (= 0 i)
|
(if (= 0 i)
|
||||||
{:success true :ctx @ctx-diff}
|
{:success true :ctx @ctx-diff}
|
||||||
(let [match? (match (nth members (dec i)) (nth value i) ctx-diff)]
|
(let [match? (match (nth members (dec i)) (nth value i) ctx-diff)]
|
||||||
(println "Maybe a match?: " match?)
|
;(println "Maybe a match?: " (dissoc match? :ctx))
|
||||||
(if (:success match?)
|
(if (:success match?)
|
||||||
(do
|
(do
|
||||||
(vswap! ctx-diff #(merge % (:ctx match?)))
|
(vswap! ctx-diff #(merge % (:ctx match?)))
|
||||||
(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 " (show/show-pattern pattern) " with " (show/show value) " because " (:reason match?))}))))))))
|
||||||
|
|
||||||
;; TODO: update this to use new AST representation
|
;; TODO: update this to use new AST representation
|
||||||
;; TODO: update this to reflect first element of list is ::data/list
|
;; TODO: update this to reflect first element of list is ::data/list
|
||||||
|
@ -120,10 +120,10 @@
|
||||||
splatted? (= :splattern (-> members peek :type))]
|
splatted? (= :splattern (-> members peek :type))]
|
||||||
(cond
|
(cond
|
||||||
(not (vector? value))
|
(not (vector? value))
|
||||||
{:success false :reason "Could not match non-list value to list"}
|
{:success false :reason (str "Could not match non-list value " (show/show value) " to list pattern " (show/show-pattern pattern))}
|
||||||
|
|
||||||
(= ::data/tuple (first value))
|
(= ::data/tuple (first value))
|
||||||
{:success false :reason "Could not match tuple value to list pattern"}
|
{:success false :reason (str "Could not match tuple value " (show/show value) " to list pattern " (show/show-pattern pattern))}
|
||||||
|
|
||||||
splatted?
|
splatted?
|
||||||
(match-splatted pattern value ctx-vol)
|
(match-splatted pattern value ctx-vol)
|
||||||
|
@ -145,7 +145,7 @@
|
||||||
(do
|
(do
|
||||||
(vswap! ctx-diff #(merge % (:ctx match?)))
|
(vswap! ctx-diff #(merge % (:ctx match?)))
|
||||||
(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 " (show/show-pattern pattern) " with " (show/show value) " because " (:reason match?))}))))))))
|
||||||
|
|
||||||
(defn- member->kv [map member]
|
(defn- member->kv [map member]
|
||||||
(let [type (:type member)
|
(let [type (:type member)
|
||||||
|
@ -176,10 +176,10 @@
|
||||||
;(println "Matching with " pattern-map)
|
;(println "Matching with " pattern-map)
|
||||||
(cond
|
(cond
|
||||||
(not (map? dict))
|
(not (map? dict))
|
||||||
{:success false :reason "Could not match non-dict value to dict pattern"}
|
{:success false :reason (str "Could not match non-dict value " (show/show dict) " to dict pattern " (show/show-pattern pattern))}
|
||||||
|
|
||||||
(not (::data/dict dict))
|
(not (::data/dict dict))
|
||||||
{:success false :reason "Cannot match non-dict data types to a dict pattern"}
|
{:success false :reason (str "Cannot match non-dict data types (ns, struct) " (show/show dict) " to a dict pattern " (show/show-pattern pattern))}
|
||||||
|
|
||||||
(empty? members)
|
(empty? members)
|
||||||
{:success true :ctx {}}
|
{:success true :ctx {}}
|
||||||
|
@ -201,10 +201,10 @@
|
||||||
(vswap! ctx-diff #(merge % (:ctx match?)))
|
(vswap! ctx-diff #(merge % (:ctx match?)))
|
||||||
(recur (inc i)))
|
(recur (inc i)))
|
||||||
{:success false
|
{:success false
|
||||||
:reason (str "Could not match " pattern " with value " dict " at key " kw " because " (:reason match?))}
|
:reason (str "Could not match " (show/show-pattern pattern) " with value " (show/show dict) " at key " kw " because " (:reason match?))}
|
||||||
))
|
))
|
||||||
{:success false
|
{:success false
|
||||||
:reason (str "Could not match " pattern " with " dict " at key " kw " because there is no value at " kw)}))
|
:reason (str "Could not match " (show/show-pattern pattern) " with " (show/show dict) " at key " kw " because there is no value at " kw)}))
|
||||||
|
|
||||||
splat?
|
splat?
|
||||||
(let [splat (-> members peek)
|
(let [splat (-> members peek)
|
||||||
|
@ -216,7 +216,7 @@
|
||||||
(if (:success match?)
|
(if (:success match?)
|
||||||
{:success true :ctx (merge @ctx-diff (:ctx match?))}
|
{:success true :ctx (merge @ctx-diff (:ctx match?))}
|
||||||
{:success false
|
{:success false
|
||||||
:reason (str "Could not match " pattern " with value " dict " because " (:reason match?))}
|
:reason (str "Could not match " (show/show-pattern pattern) " with value " (show/show dict) " because " (:reason match?))}
|
||||||
))
|
))
|
||||||
{:success true :ctx @ctx-diff}
|
{:success true :ctx @ctx-diff}
|
||||||
))
|
))
|
||||||
|
@ -232,10 +232,10 @@
|
||||||
kws (keys pattern-map)]
|
kws (keys pattern-map)]
|
||||||
(cond
|
(cond
|
||||||
(not (map? dict))
|
(not (map? dict))
|
||||||
{:success false :reason "Could not match non-struct value to struct pattern"}
|
{:success false :reason (str "Could not match non-struct value " (show/show dict) " to struct pattern " (show/show-pattern pattern))}
|
||||||
|
|
||||||
(not (::data/struct dict))
|
(not (::data/struct dict))
|
||||||
{:success false :reason "Cannot match non-struct value to struct pattern"}
|
{:success false :reason (str "Cannot match non-struct value " (show/show dict) " to struct pattern " (show/show-pattern pattern))}
|
||||||
|
|
||||||
(empty? members)
|
(empty? members)
|
||||||
{:success true :ctx {}}
|
{:success true :ctx {}}
|
||||||
|
@ -257,10 +257,10 @@
|
||||||
(vswap! ctx-diff #(merge % (:ctx match?)))
|
(vswap! ctx-diff #(merge % (:ctx match?)))
|
||||||
(recur (inc i)))
|
(recur (inc i)))
|
||||||
{:success false
|
{:success false
|
||||||
:reason (str "Could not match " pattern " with value " dict " at key " kw " because " (:reason match?))}
|
:reason (str "Could not match " (show/show-pattern pattern) " with value " (show/show dict) " at key " kw " because " (:reason match?))}
|
||||||
))
|
))
|
||||||
{:success false
|
{:success false
|
||||||
:reason (str "Could not match " pattern " with " dict " at key " kw " because there is no value at " kw)}))
|
:reason (str "Could not match " (show/show-pattern pattern) " with " (show/show dict) " at key " kw " because there is no value at " kw)}))
|
||||||
|
|
||||||
splat?
|
splat?
|
||||||
(let [splat (-> members peek)
|
(let [splat (-> members peek)
|
||||||
|
@ -272,7 +272,7 @@
|
||||||
(if (:success match?)
|
(if (:success match?)
|
||||||
{:success true :ctx (merge @ctx-diff (:ctx match?))}
|
{:success true :ctx (merge @ctx-diff (:ctx match?))}
|
||||||
{:success false
|
{:success false
|
||||||
:reason (str "Could not match " pattern " with value " dict " because " (:reason match?))}
|
:reason (str "Could not match " (show/show-pattern pattern) " with value " (show/show dict) " because " (:reason match?))}
|
||||||
))
|
))
|
||||||
{:success true :ctx @ctx-diff}
|
{:success true :ctx @ctx-diff}
|
||||||
))
|
))
|
||||||
|
@ -286,11 +286,11 @@
|
||||||
type (-> data second :data first)]
|
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 (base/get-type value))) {:success false :reason (str "Could not match " pattern " with " value ", because types do not match")}
|
(not (= type (base/get-type value))) {:success false :reason (str "Could not match " (show/show-pattern pattern) " with " (show/show value) ", because types do not match")}
|
||||||
:else {:success true :ctx {name value}})))
|
:else {:success true :ctx {name value}})))
|
||||||
|
|
||||||
(defn- match [pattern value ctx-vol]
|
(defn- match [pattern value ctx-vol]
|
||||||
;(println "Matching " value " with pattern type " (:type pattern))
|
;(println "Matching " (show/show value) " with pattern " (show/show-pattern pattern))
|
||||||
(let [ctx @ctx-vol]
|
(let [ctx @ctx-vol]
|
||||||
(case (:type pattern)
|
(case (:type pattern)
|
||||||
(:placeholder :ignored :else)
|
(:placeholder :ignored :else)
|
||||||
|
@ -301,7 +301,7 @@
|
||||||
(if (= match-value value)
|
(if (= match-value value)
|
||||||
{:success true :ctx {}}
|
{:success true :ctx {}}
|
||||||
{:success false
|
{:success false
|
||||||
:reason (str "No match: Could not match " match-value " with " value)}))
|
:reason (str "No match: Could not match " (show/show-pattern match-value) " with " (show/show value))}))
|
||||||
|
|
||||||
:word
|
:word
|
||||||
(let [word (-> pattern :data first)]
|
(let [word (-> pattern :data first)]
|
||||||
|
@ -954,15 +954,16 @@
|
||||||
;; repl
|
;; repl
|
||||||
(comment
|
(comment
|
||||||
|
|
||||||
(def source "
|
(def source "#{:foo bar}")
|
||||||
")
|
|
||||||
|
|
||||||
(def tokens (-> source scanner/scan :tokens))
|
(def tokens (-> source scanner/scan :tokens))
|
||||||
|
|
||||||
(def ast (p/apply-parser g/script tokens))
|
(def ast (p/apply-parser g/pattern tokens))
|
||||||
|
|
||||||
;(def result (interpret-safe source ast {}))
|
;(def result (interpret-safe source ast {}))
|
||||||
|
|
||||||
(-> ast prettify-ast println)
|
(-> ast prettify-ast println)
|
||||||
|
|
||||||
|
(-> ast show/show-pattern println)
|
||||||
|
|
||||||
)
|
)
|
|
@ -375,9 +375,12 @@ fn get {
|
||||||
&& See interpreter.cljc line 76 for more info.
|
&& See interpreter.cljc line 76 for more info.
|
||||||
fn each {
|
fn each {
|
||||||
"Takes a list and applies a function, presumably with side effects, to each element in the list. Returns nil."
|
"Takes a list and applies a function, presumably with side effects, to each element in the list. Returns nil."
|
||||||
(f as :fn, []) -> :empty
|
(f as :fn, []) -> nil
|
||||||
(f, [x]) -> :one
|
(f as :fn, [x]) -> { f (x); nil }
|
||||||
(f, [...xs]) -> :more
|
(f, [...xs]) -> loop (xs) with {
|
||||||
|
([x]) -> { f (x); nil }
|
||||||
|
([x, ...xs]) -> { f (x); recur (xs) }
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
fn foo {
|
fn foo {
|
||||||
|
@ -409,6 +412,8 @@ fn panic! {
|
||||||
& turtleheading () -> turns
|
& turtleheading () -> turns
|
||||||
& penstate () -> @{:down :boolean, :color (r, g, b, a), :width pixels}
|
& penstate () -> @{:down :boolean, :color (r, g, b, a), :width pixels}
|
||||||
|
|
||||||
|
print ("Loaded Prelude.")
|
||||||
|
|
||||||
ns prelude {
|
ns prelude {
|
||||||
first
|
first
|
||||||
second
|
second
|
||||||
|
|
|
@ -58,3 +58,45 @@
|
||||||
(def show-keyed (comp
|
(def show-keyed (comp
|
||||||
(map #(str (show (first %)) " " (show (second %))))
|
(map #(str (show (first %)) " " (show (second %))))
|
||||||
(interpose ", ")))
|
(interpose ", ")))
|
||||||
|
|
||||||
|
(declare show-pattern)
|
||||||
|
|
||||||
|
(defn show-coll-pattern [pattern [start end]]
|
||||||
|
(let [data (:data pattern)
|
||||||
|
members (map show-pattern data)
|
||||||
|
output (apply str (interpose ", " members))]
|
||||||
|
(str start output end)))
|
||||||
|
|
||||||
|
(defn show-pattern [pattern]
|
||||||
|
(case (:type pattern)
|
||||||
|
nil ""
|
||||||
|
|
||||||
|
:placeholder "_"
|
||||||
|
|
||||||
|
:else "else"
|
||||||
|
|
||||||
|
(:word :number :keyword :true :false :nil :string) (-> pattern :data first)
|
||||||
|
|
||||||
|
:typed
|
||||||
|
(let [word (-> pattern :data first :data first)
|
||||||
|
type (-> pattern :data second :data first)]
|
||||||
|
(str word " as " type))
|
||||||
|
|
||||||
|
:splattern
|
||||||
|
(let [splatted (-> pattern :data first show-pattern)]
|
||||||
|
(str "..." splatted))
|
||||||
|
|
||||||
|
:pair-pattern
|
||||||
|
(let [key (-> pattern :data first)
|
||||||
|
value (-> pattern :data second)]
|
||||||
|
(str (show-pattern key) " " (show-pattern value)))
|
||||||
|
|
||||||
|
:tuple-pattern (show-coll-pattern pattern ["(" ")"])
|
||||||
|
|
||||||
|
:list-pattern (show-coll-pattern pattern ["[" "]"])
|
||||||
|
|
||||||
|
:dict-pattern (show-coll-pattern pattern ["#{" "}"])
|
||||||
|
|
||||||
|
:struct-pattern (show-coll-pattern pattern ["@{" "}"])
|
||||||
|
|
||||||
|
))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user