twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

Things, mostly list & tuple splats are correct.

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
TODO.xit
View File

@ -31,9 +31,11 @@ Write a compiler: correctness
[ ] check that recur is in tail position
[ ] check that recur is only called inside loop or fn forms
[ ] check ns accesses
[ ] splattern is last member in a pattern
Write a compiler: optimization
[ ] devise tail call optimization
Next steps
[ ] Get drawing working?
[ ] Add stack traces for panics

4
src/ludus/grammar.clj
View File

@ -5,7 +5,7 @@
(declare expression pattern)
;(def separator (choice :separator [:comma :newline :break]))
(defp separator [choice] [:comma :newline :break])
(defp separator choice [:comma :newline :break])
;(def separators (quiet (one+ separator)))
(defp separators quiet one+ separator)
@ -23,7 +23,7 @@
(defp splat group order-1 [(quiet :splat) :word])
;(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)])
;(def literal (flat (choice :literal [:nil :true :false :number :string])))

71
src/ludus/interpreter.clj
View File

@ -36,23 +36,31 @@
(declare interpret-ast match interpret interpret-file)
;; TODO: actually implement this!
(defn- match-splatted-tuple [pattern value ctx-vol]
(let [length (:length pattern) members (:members pattern)
(defn- match-splatted [pattern value ctx-vol]
(let [members (:data pattern)
non-splat (pop members)
splattern (peek members)
length (count members)
ctx-diff (volatile! @ctx-vol)]
(if (> length (count value))
{:success false :reason "Could not match tuple lengths"}
(loop [i 0 ctx {}]
(if (> length (-> value count dec))
{:success false :reason "Could not match different lengths"}
(loop [i 0]
(if (= (dec length) i)
(
;; TODO: write the actual splat here
;; check if the name is already bound
;; then pack everything into a list
;; and return success with the list bound to the name
)
(let [match? (match (nth members i) (nth value (inc i)) ctx-diff)]
(let [last-binding (-> splattern :data first)
binding-type (:type last-binding)]
(if (= binding-type :word)
(let [splat-ctx (:ctx (match
last-binding
(into [::data/list] (subvec value (inc i)))
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?)
(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)}
)))))))
@ -67,8 +75,8 @@
(not (= ::data/tuple (first value))) {:success false :reason "Could not match list to tuple"}
(= ::ast/splat (::ast/type (last members)))
(match-splatted-tuple pattern value ctx-vol)
(= :splattern (:type (peek members)))
(match-splatted pattern value ctx-vol)
(not (= length (dec (count value))))
{: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?))}))))))))
;; 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]
(let [members (:data pattern)
splatted? (= :splattern (-> members peek :type))]
(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
(not (= (count (:members pattern)) (count value)))
(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)))
{:success true :ctx {}}
:else
(let [members (:members pattern)
ctx-diff (volatile! @ctx-vol)]
(let [ctx-diff (volatile! @ctx-vol)]
(loop [i (dec (count members))]
(if (> 0 i)
{: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?)
(do
(vswap! ctx-diff #(merge % (:ctx match?)))
(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
(defn- match-dict [pattern value ctx-vol]
@ -574,14 +590,14 @@
tuple-splat? (= (first splatted) ::data/tuple)]
(if splattable?
(if tuple-splat?
(into [] (concat list (rest splatted)))
(into [::data/list] (concat list (rest splatted)))
(concat list splatted))
(throw (ex-info "Cannot splat non-list into list" {:ast member}))))
(conj list (interpret-ast member ctx)))))
(defn- interpret-list [ast ctx]
(let [members (:data ast)]
(into [] (reduce (list-term ctx) [] members))))
(into [::data/list] (reduce (list-term ctx) [] members))))
(defn- set-term [ctx]
(fn [set member]
@ -866,7 +882,8 @@
(do
(def source "
if 1 then 2 else 3
let (...a) = (1, 2, 3)
a
")
(println "")

2
src/ludus/show.clj
View File

@ -8,7 +8,7 @@
(defn- show-vector [v]
(if (= (first v) ::data/tuple)
(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]
(cond