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

Reindent things

Browse Source
This commit is contained in:
Scott Richmond 2022-03-19 19:09:21 -04:00
parent 90f6fa8b19
commit 2a099298f0
1 changed files with 123 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

248
src/ludus/interpreter.clj
View File

@ -1,174 +1,172 @@
(ns ludus.interpreter (ns ludus.interpreter
(:require (:require
[ludus.parser :as parser] [ludus.parser :as parser]
[ludus.scanner :as scanner] [ludus.scanner :as scanner]
[ludus.ast :as ast] [ludus.ast :as ast]
[ludus.collections :as colls] [ludus.collections :as colls]
[clojure.pprint :as pp])) [clojure.pprint :as pp]))
;; right now this is not very efficient: ;; right now this is not very efficient:
;; it's got runtime checking ;; it's got runtime checking
;; we should be able to do these checks statically ;; we should be able to do these checks statically
;; that's for later, tho ;; that's for later, tho
(defn- resolve [word ctx-atom] (defn- resolve [word ctx-atom]
(let [ctx @ctx-atom] (let [ctx @ctx-atom]
(if (contains? ctx word) (if (contains? ctx word)
(get ctx word) (get ctx word)
(if (contains? ctx ::parent) (if (contains? ctx ::parent)
(recur word (::parent ctx)) (recur word (::parent ctx))
(throw (new Exception (str "Unbound name: " word))))))) (throw (new Exception (str "Unbound name: " word)))))))
(declare interpret match) (declare interpret match)
(defn- match-tuple [pattern value ctx-atom] (defn- match-tuple [pattern value ctx-atom]
(cond (cond
(not (vector? value)) {:success false :reason "Could not match non-tuple value to tuple"} (not (vector? value)) {:success false :reason "Could not match non-tuple value to tuple"}
(not (= ::colls/tuple (first value))) {:success false :reason "Could not match list to tuple"} (not (= ::colls/tuple (first value))) {:success false :reason "Could not match list to tuple"}
(not (= (:length pattern) (dec (count value)))) (not (= (:length pattern) (dec (count value))))
{:success false :reason "Cannot match tuples of different lengths"} {:success false :reason "Cannot match tuples of different lengths"}
(= 0 (:length pattern) (dec (count value))) {:success true :ctx {}} (= 0 (:length pattern) (dec (count value))) {:success true :ctx {}}
:else (let [members (:members pattern)] :else (let [members (:members pattern)]
(loop [i (dec (:length pattern)) (loop [i (:length pattern)
ctx {}] ctx {}]
(if (= 0 i) (if (= 0 i)
{:success true :ctx ctx} {:success true :ctx ctx}
(let [match? (match (nth members i) (nth value (inc i)) ctx-atom)] (let [match? (match (nth members (dec i)) (nth value i) ctx-atom)]
(if (:success match?) (if (:success match?)
(recur (dec i) (merge ctx (:ctx match?))) (recur (dec i) (merge ctx (:ctx match?)))
{:success false :reason (str "Could not match " pattern " with " value)} {:success false :reason (str "Could not match " pattern " with " value)})))))))
))
)
))
))
(defn- match [pattern value ctx-atom] (defn- match [pattern value ctx-atom]
(let [ctx @ctx-atom] (let [ctx @ctx-atom]
(case (::ast/type pattern) (case (::ast/type pattern)
::ast/placeholder {:success true :ctx {}} ::ast/placeholder {:success true :ctx {}}
::ast/atom ::ast/atom
(let [match-value (:value pattern)] (let [match-value (:value pattern)]
(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 " match-value " with " value)}))
::ast/word ::ast/word
(let [word (:word pattern)] (let [word (:word pattern)]
(if (contains? ctx word) (if (contains? ctx word)
{:success false :reason (str "Name " word " is already bound")} {:success false :reason (str "Name " word " is already bound")}
{:success true :ctx {word value}} {:success true :ctx {word value}}
)) ))
::ast/tuple (match-tuple pattern value ctx-atom) ::ast/tuple (match-tuple pattern value ctx-atom)
(do (do
(println "ERROR! Unexpected pattern:") (println "ERROR! Unexpected pattern:")
(pp/pprint pattern) (pp/pprint pattern)
) )
))) )))
(defn- update-ctx [ctx new-ctx] (defn- update-ctx [ctx new-ctx]
(merge ctx new-ctx)) (println "Adding to context:")
(pp/pprint new-ctx)
(merge ctx new-ctx))
;; TODO: get "if let" pattern working ;; TODO: get "if let" pattern working
;; TODO: get typed exceptions to distinguish panics ;; TODO: get typed exceptions to distinguish panics
(defn- interpret-let [ast ctx] (defn- interpret-let [ast ctx]
(let [pattern (:pattern ast) (let [pattern (:pattern ast)
expr (:expr ast) expr (:expr ast)
value (interpret expr ctx) value (interpret expr ctx)
match (match pattern value ctx) match (match pattern value ctx)
success (:success match)] success (:success match)]
(if success (if success
(swap! ctx update-ctx (:ctx match)) (swap! ctx update-ctx (:ctx match))
(throw (new Exception (:reason match)))) (throw (new Exception (:reason match))))
value value
)) ))
(defn- interpret-if [ast ctx] (defn- interpret-if [ast ctx]
(let [if-expr (:if ast) (let [if-expr (:if ast)
then-expr (:then ast) then-expr (:then ast)
else-expr (:else ast) else-expr (:else ast)
if-value (interpret if-expr ast)] if-value (interpret if-expr ast)]
(if if-value (if if-value
(interpret then-expr ctx) (interpret then-expr ctx)
(interpret else-expr ctx) (interpret else-expr ctx)
))) )))
(defn interpret [ast ctx] (defn interpret [ast ctx]
(case (::ast/type ast) (case (::ast/type ast)
::ast/atom (:value ast) ::ast/atom (:value ast)
::ast/word (resolve (:word ast) ctx) ::ast/word (resolve (:word ast) ctx)
::ast/let (interpret-let ast ctx) ::ast/let (interpret-let ast ctx)
::ast/if (interpret-if ast ctx) ::ast/if (interpret-if ast ctx)
::ast/block ::ast/block
(let [exprs (:exprs ast) (let [exprs (:exprs ast)
inner (pop exprs) inner (pop exprs)
last (peek exprs) last (peek exprs)
ctx (atom {::parent ctx})] ctx (atom {::parent ctx})]
(run! #(interpret % ctx) inner) (run! #(interpret % ctx) inner)
(interpret last ctx) (interpret last ctx)
) )
::ast/script ::ast/script
(let [exprs (:exprs ast) (let [exprs (:exprs ast)
inner (pop exprs) inner (pop exprs)
last (peek exprs) last (peek exprs)
ctx (atom ctx) ctx (atom ctx)
] ]
(run! #(interpret % ctx) inner) (run! #(interpret % ctx) inner)
(interpret last ctx) (interpret last ctx)
) )
;; note that the runtime representations of collections is ;; note that the runtime representations of collections is
;; unboxed in the tree-walk interpreter ;; unboxed in the tree-walk interpreter
;; tuples & lists are both vectors, the first element ;; tuples & lists are both vectors, the first element
;; distinguishes them ;; distinguishes them
::ast/tuple ::ast/tuple
(let [members (:members ast)] (let [members (:members ast)]
(into [::colls/tuple] (map #(interpret % ctx)) members)) (into [::colls/tuple] (map #(interpret % ctx)) members))
::ast/list ::ast/list
(let [members (:members ast)] (let [members (:members ast)]
(into [::colls/list] (map #(interpret % ctx)) members)) (into [::colls/list] (map #(interpret % ctx)) members))
::ast/set ::ast/set
(let [members (:members ast)] (let [members (:members ast)]
(into #{} (map #(interpret % ctx)) members)) (into #{} (map #(interpret % ctx)) members))
(do (do
(println "ERROR! Unexpected AST node:") (println "ERROR! Unexpected AST node:")
(pp/pprint ast) (pp/pprint ast)
) )
)) ))
(do (do
(def source " (def source "
let (:foo, 1, :bar) = (:foo, 1, :bar) let (foo, (_, baz)) = (1, (2, 3))
baz
") ")
(println "") (println "")
(println "****************************************") (println "****************************************")
(println "*** *** NEW INTERPRETATION *** ***") (println "*** *** NEW INTERPRETATION *** ***")
(println "") (println "")
(-> source (-> source
(scanner/scan) (scanner/scan)
(parser/parse) (parser/parse)
(::parser/ast) (::parser/ast)
(interpret {}) (interpret {})
(pp/pprint) (pp/pprint)
)) ))