Things, mostly list & tuple splats are correct.
This commit is contained in:
parent
35eed84741
commit
0e9c403634
2
TODO.xit
2
TODO.xit
|
@ -31,9 +31,11 @@ Write a compiler: correctness
|
||||||
[ ] check that recur is in tail position
|
[ ] check that recur is in tail position
|
||||||
[ ] 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
|
||||||
|
|
||||||
Write a compiler: optimization
|
Write a compiler: optimization
|
||||||
[ ] devise tail call optimization
|
[ ] devise tail call optimization
|
||||||
|
|
||||||
Next steps
|
Next steps
|
||||||
[ ] Get drawing working?
|
[ ] Get drawing working?
|
||||||
|
[ ] Add stack traces for panics
|
||||||
|
|
|
@ -5,7 +5,7 @@
|
||||||
(declare expression pattern)
|
(declare expression pattern)
|
||||||
|
|
||||||
;(def separator (choice :separator [:comma :newline :break]))
|
;(def separator (choice :separator [:comma :newline :break]))
|
||||||
(defp separator [choice] [:comma :newline :break])
|
(defp separator choice [:comma :newline :break])
|
||||||
|
|
||||||
;(def separators (quiet (one+ separator)))
|
;(def separators (quiet (one+ separator)))
|
||||||
(defp separators quiet one+ separator)
|
(defp separators quiet one+ separator)
|
||||||
|
@ -23,7 +23,7 @@
|
||||||
(defp splat group order-1 [(quiet :splat) :word])
|
(defp splat group order-1 [(quiet :splat) :word])
|
||||||
|
|
||||||
;(def splattern (group (order-1 :splat [(quiet :splat) (maybe (flat (choice :splatted [:word :ignored :placeholder])))])))
|
;(def splattern (group (order-1 :splat [(quiet :splat) (maybe (flat (choice :splatted [:word :ignored :placeholder])))])))
|
||||||
(defp patt-splat-able quiet flat choice [:word :ignored :placeholder])
|
(defp patt-splat-able flat choice [:word :ignored :placeholder])
|
||||||
(defp splattern group order-1 [(quiet :splat) (maybe patt-splat-able)])
|
(defp splattern group order-1 [(quiet :splat) (maybe patt-splat-able)])
|
||||||
|
|
||||||
;(def literal (flat (choice :literal [:nil :true :false :number :string])))
|
;(def literal (flat (choice :literal [:nil :true :false :number :string])))
|
||||||
|
|
|
@ -36,23 +36,31 @@
|
||||||
|
|
||||||
(declare interpret-ast match interpret interpret-file)
|
(declare interpret-ast match interpret interpret-file)
|
||||||
|
|
||||||
;; TODO: actually implement this!
|
(defn- match-splatted [pattern value ctx-vol]
|
||||||
(defn- match-splatted-tuple [pattern value ctx-vol]
|
(let [members (:data pattern)
|
||||||
(let [length (:length pattern) members (:members pattern)
|
non-splat (pop members)
|
||||||
|
splattern (peek members)
|
||||||
|
length (count members)
|
||||||
ctx-diff (volatile! @ctx-vol)]
|
ctx-diff (volatile! @ctx-vol)]
|
||||||
(if (> length (count value))
|
(if (> length (-> value count dec))
|
||||||
{:success false :reason "Could not match tuple lengths"}
|
{:success false :reason "Could not match different lengths"}
|
||||||
(loop [i 0 ctx {}]
|
(loop [i 0]
|
||||||
(if (= (dec length) i)
|
(if (= (dec length) i)
|
||||||
(
|
(let [last-binding (-> splattern :data first)
|
||||||
;; TODO: write the actual splat here
|
binding-type (:type last-binding)]
|
||||||
;; check if the name is already bound
|
(if (= binding-type :word)
|
||||||
;; then pack everything into a list
|
(let [splat-ctx (:ctx (match
|
||||||
;; and return success with the list bound to the name
|
last-binding
|
||||||
)
|
(into [::data/list] (subvec value (inc i)))
|
||||||
(let [match? (match (nth members i) (nth value (inc i)) ctx-diff)]
|
ctx-diff))]
|
||||||
|
{:success true :ctx (merge @ctx-diff splat-ctx)})
|
||||||
|
{:success true :ctx @ctx-diff}))
|
||||||
|
(let [match? (match (nth non-splat i) (nth value (inc i)) ctx-diff)]
|
||||||
(if (:success match?)
|
(if (:success match?)
|
||||||
(recur (inc i) (vswap! ctx-diff #(merge % (:ctx match?))))
|
(do
|
||||||
|
(vswap! ctx-diff #(merge % (:ctx match?)))
|
||||||
|
(println "current context: " (dissoc @ctx-diff ::parent))
|
||||||
|
(recur (inc i)))
|
||||||
{:success :false :reason (str "Could not match " pattern " with " value)}
|
{:success :false :reason (str "Could not match " pattern " with " value)}
|
||||||
)))))))
|
)))))))
|
||||||
|
|
||||||
|
@ -67,8 +75,8 @@
|
||||||
|
|
||||||
(not (= ::data/tuple (first value))) {:success false :reason "Could not match list to tuple"}
|
(not (= ::data/tuple (first value))) {:success false :reason "Could not match list to tuple"}
|
||||||
|
|
||||||
(= ::ast/splat (::ast/type (last members)))
|
(= :splattern (:type (peek members)))
|
||||||
(match-splatted-tuple pattern value ctx-vol)
|
(match-splatted pattern value ctx-vol)
|
||||||
|
|
||||||
(not (= length (dec (count value))))
|
(not (= length (dec (count value))))
|
||||||
{:success false :reason "Cannot match tuples of different lengths"}
|
{:success false :reason "Cannot match tuples of different lengths"}
|
||||||
|
@ -88,30 +96,38 @@
|
||||||
{: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?))}))))))))
|
||||||
|
|
||||||
;; 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
|
||||||
(defn- match-list [pattern value ctx-vol]
|
(defn- match-list [pattern value ctx-vol]
|
||||||
(cond
|
(let [members (:data pattern)
|
||||||
(not (vector? value)) {:success false :reason "Could not match non-list value to list"}
|
splatted? (= :splattern (-> members peek :type))]
|
||||||
|
(cond
|
||||||
|
(not (vector? value))
|
||||||
|
{:success false :reason "Could not match non-list value to list"}
|
||||||
|
|
||||||
|
(= ::data/tuple (first value))
|
||||||
|
{:success false :reason "Could not match tuple value to list pattern"}
|
||||||
|
|
||||||
(= ::data/tuple (first value)) {:success false :reason "Could not match tuple value to list pattern"}
|
splatted?
|
||||||
|
(match-splatted pattern value ctx-vol)
|
||||||
;; TODO: fix this with splats
|
|
||||||
(not (= (count (:members pattern)) (count value)))
|
;; TODO: fix this with splats
|
||||||
{:success false :reason "Cannot match lists of different lengths"}
|
(not= (count members) (dec (count value)))
|
||||||
|
{:success false :reason "Cannot match lists of different lengths"}
|
||||||
(= 0 (count (:members pattern)) (count value)) {:success true :ctx {}}
|
|
||||||
|
(= 0 (count members) (dec (count value)))
|
||||||
:else
|
{:success true :ctx {}}
|
||||||
(let [members (:members pattern)
|
|
||||||
ctx-diff (volatile! @ctx-vol)]
|
:else
|
||||||
(loop [i (dec (count members))]
|
(let [ctx-diff (volatile! @ctx-vol)]
|
||||||
(if (> 0 i)
|
(loop [i (dec (count members))]
|
||||||
{:success true :ctx @ctx-diff}
|
(if (> 0 i)
|
||||||
(let [match? (match (nth members i) (nth value i) ctx-diff)]
|
{:success true :ctx @ctx-diff}
|
||||||
(if (:success match?)
|
(let [match? (match (nth members i) (nth value (inc i)) ctx-diff)]
|
||||||
(do
|
(if (:success match?)
|
||||||
(vswap! ctx-diff #(merge % (:ctx match?)))
|
(do
|
||||||
(recur (dec i)))
|
(vswap! ctx-diff #(merge % (:ctx match?)))
|
||||||
{:success false :reason (str "Could not match " pattern " with " value " because " (:reason match?))})))))))
|
(recur (dec i)))
|
||||||
|
{:success false :reason (str "Could not match " pattern " with " value " because " (:reason match?))}))))))))
|
||||||
|
|
||||||
;; 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 value ctx-vol]
|
||||||
|
@ -574,14 +590,14 @@
|
||||||
tuple-splat? (= (first splatted) ::data/tuple)]
|
tuple-splat? (= (first splatted) ::data/tuple)]
|
||||||
(if splattable?
|
(if splattable?
|
||||||
(if tuple-splat?
|
(if tuple-splat?
|
||||||
(into [] (concat list (rest splatted)))
|
(into [::data/list] (concat list (rest splatted)))
|
||||||
(concat list splatted))
|
(concat list splatted))
|
||||||
(throw (ex-info "Cannot splat non-list into list" {:ast member}))))
|
(throw (ex-info "Cannot splat non-list into list" {:ast member}))))
|
||||||
(conj list (interpret-ast member ctx)))))
|
(conj list (interpret-ast member ctx)))))
|
||||||
|
|
||||||
(defn- interpret-list [ast ctx]
|
(defn- interpret-list [ast ctx]
|
||||||
(let [members (:data ast)]
|
(let [members (:data ast)]
|
||||||
(into [] (reduce (list-term ctx) [] members))))
|
(into [::data/list] (reduce (list-term ctx) [] members))))
|
||||||
|
|
||||||
(defn- set-term [ctx]
|
(defn- set-term [ctx]
|
||||||
(fn [set member]
|
(fn [set member]
|
||||||
|
@ -866,7 +882,8 @@
|
||||||
|
|
||||||
(do
|
(do
|
||||||
(def source "
|
(def source "
|
||||||
if 1 then 2 else 3
|
let (...a) = (1, 2, 3)
|
||||||
|
a
|
||||||
")
|
")
|
||||||
|
|
||||||
(println "")
|
(println "")
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
(defn- show-vector [v]
|
(defn- show-vector [v]
|
||||||
(if (= (first v) ::data/tuple)
|
(if (= (first v) ::data/tuple)
|
||||||
(str "(" (apply str (into [] show-linear (next v))) ")")
|
(str "(" (apply str (into [] show-linear (next v))) ")")
|
||||||
(str "[" (apply str (into [] show-linear v)) "]")))
|
(str "[" (apply str (into [] show-linear (next v))) "]")))
|
||||||
|
|
||||||
(defn- show-map [v]
|
(defn- show-map [v]
|
||||||
(cond
|
(cond
|
||||||
|
|
Loading…
Reference in New Issue
Block a user