Things, mostly list & tuple splats are correct.

This commit is contained in:
Scott Richmond 2023-05-31 09:30:12 -04:00
parent 35eed84741
commit 0e9c403634
4 changed files with 63 additions and 44 deletions

View File

@ -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

View File

@ -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])))

View File

@ -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]
(let [members (:data pattern)
splatted? (= :splattern (-> members peek :type))]
(cond (cond
(not (vector? value)) {:success false :reason "Could not match non-list value to list"} (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 ;; TODO: fix this with splats
(not (= (count (:members pattern)) (count value))) (not= (count members) (dec (count value)))
{:success false :reason "Cannot match lists of different lengths"} {:success false :reason "Cannot match lists of different lengths"}
(= 0 (count (:members pattern)) (count value)) {:success true :ctx {}} (= 0 (count members) (dec (count value)))
{:success true :ctx {}}
:else :else
(let [members (:members pattern) (let [ctx-diff (volatile! @ctx-vol)]
ctx-diff (volatile! @ctx-vol)]
(loop [i (dec (count members))] (loop [i (dec (count members))]
(if (> 0 i) (if (> 0 i)
{:success true :ctx @ctx-diff} {:success true :ctx @ctx-diff}
(let [match? (match (nth members i) (nth value i) ctx-diff)] (let [match? (match (nth members i) (nth value (inc i)) ctx-diff)]
(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 " 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 "")

View File

@ -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