From 2a099298f0e1d4b57d994cdaa62d55dbe3d0063b Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Sat, 19 Mar 2022 19:09:21 -0400 Subject: [PATCH] Reindent things --- src/ludus/interpreter.clj | 248 +++++++++++++++++++------------------- 1 file changed, 123 insertions(+), 125 deletions(-) diff --git a/src/ludus/interpreter.clj b/src/ludus/interpreter.clj index 15a1fa1..245e3cf 100644 --- a/src/ludus/interpreter.clj +++ b/src/ludus/interpreter.clj @@ -1,174 +1,172 @@ (ns ludus.interpreter - (:require - [ludus.parser :as parser] - [ludus.scanner :as scanner] - [ludus.ast :as ast] - [ludus.collections :as colls] - [clojure.pprint :as pp])) + (:require + [ludus.parser :as parser] + [ludus.scanner :as scanner] + [ludus.ast :as ast] + [ludus.collections :as colls] + [clojure.pprint :as pp])) ;; right now this is not very efficient: ;; it's got runtime checking ;; we should be able to do these checks statically ;; that's for later, tho (defn- resolve [word ctx-atom] - (let [ctx @ctx-atom] - (if (contains? ctx word) - (get ctx word) - (if (contains? ctx ::parent) - (recur word (::parent ctx)) - (throw (new Exception (str "Unbound name: " word))))))) + (let [ctx @ctx-atom] + (if (contains? ctx word) + (get ctx word) + (if (contains? ctx ::parent) + (recur word (::parent ctx)) + (throw (new Exception (str "Unbound name: " word))))))) (declare interpret match) (defn- match-tuple [pattern value ctx-atom] - (cond - (not (vector? value)) {:success false :reason "Could not match non-tuple value to tuple"} + (cond + (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)))) - {:success false :reason "Cannot match tuples of different lengths"} + (not (= (:length pattern) (dec (count value)))) + {: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)] - (loop [i (dec (:length pattern)) - ctx {}] - (if (= 0 i) - {:success true :ctx ctx} - (let [match? (match (nth members i) (nth value (inc i)) ctx-atom)] - (if (:success match?) - (recur (dec i) (merge ctx (:ctx match?))) - {:success false :reason (str "Could not match " pattern " with " value)} - )) - ) - - )) - )) + :else (let [members (:members pattern)] + (loop [i (:length pattern) + ctx {}] + (if (= 0 i) + {:success true :ctx ctx} + (let [match? (match (nth members (dec i)) (nth value i) ctx-atom)] + (if (:success match?) + (recur (dec i) (merge ctx (:ctx match?))) + {:success false :reason (str "Could not match " pattern " with " value)}))))))) (defn- match [pattern value ctx-atom] - (let [ctx @ctx-atom] - (case (::ast/type pattern) - ::ast/placeholder {:success true :ctx {}} + (let [ctx @ctx-atom] + (case (::ast/type pattern) + ::ast/placeholder {:success true :ctx {}} - ::ast/atom - (let [match-value (:value pattern)] - (if (= match-value value) - {:success true :ctx {}} - {:success false - :reason (str "No match: Could not match " match-value " with " value)})) + ::ast/atom + (let [match-value (:value pattern)] + (if (= match-value value) + {:success true :ctx {}} + {:success false + :reason (str "No match: Could not match " match-value " with " value)})) - ::ast/word - (let [word (:word pattern)] - (if (contains? ctx word) - {:success false :reason (str "Name " word " is already bound")} - {:success true :ctx {word value}} - )) + ::ast/word + (let [word (:word pattern)] + (if (contains? ctx word) + {:success false :reason (str "Name " word " is already bound")} + {:success true :ctx {word value}} + )) - ::ast/tuple (match-tuple pattern value ctx-atom) + ::ast/tuple (match-tuple pattern value ctx-atom) - (do - (println "ERROR! Unexpected pattern:") - (pp/pprint pattern) - ) - ))) + (do + (println "ERROR! Unexpected pattern:") + (pp/pprint pattern) + ) + ))) (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 typed exceptions to distinguish panics (defn- interpret-let [ast ctx] - (let [pattern (:pattern ast) - expr (:expr ast) - value (interpret expr ctx) - match (match pattern value ctx) - success (:success match)] - (if success - (swap! ctx update-ctx (:ctx match)) - (throw (new Exception (:reason match)))) - value - )) + (let [pattern (:pattern ast) + expr (:expr ast) + value (interpret expr ctx) + match (match pattern value ctx) + success (:success match)] + (if success + (swap! ctx update-ctx (:ctx match)) + (throw (new Exception (:reason match)))) + value + )) (defn- interpret-if [ast ctx] - (let [if-expr (:if ast) - then-expr (:then ast) - else-expr (:else ast) - if-value (interpret if-expr ast)] - (if if-value - (interpret then-expr ctx) - (interpret else-expr ctx) - ))) + (let [if-expr (:if ast) + then-expr (:then ast) + else-expr (:else ast) + if-value (interpret if-expr ast)] + (if if-value + (interpret then-expr ctx) + (interpret else-expr 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 - (let [exprs (:exprs ast) - inner (pop exprs) - last (peek exprs) - ctx (atom {::parent ctx})] - (run! #(interpret % ctx) inner) - (interpret last ctx) - ) + ::ast/block + (let [exprs (:exprs ast) + inner (pop exprs) + last (peek exprs) + ctx (atom {::parent ctx})] + (run! #(interpret % ctx) inner) + (interpret last ctx) + ) - ::ast/script - (let [exprs (:exprs ast) - inner (pop exprs) - last (peek exprs) - ctx (atom ctx) - ] - (run! #(interpret % ctx) inner) - (interpret last ctx) - ) + ::ast/script + (let [exprs (:exprs ast) + inner (pop exprs) + last (peek exprs) + ctx (atom ctx) + ] + (run! #(interpret % ctx) inner) + (interpret last ctx) + ) - ;; note that the runtime representations of collections is - ;; unboxed in the tree-walk interpreter - ;; tuples & lists are both vectors, the first element - ;; distinguishes them - ::ast/tuple - (let [members (:members ast)] - (into [::colls/tuple] (map #(interpret % ctx)) members)) + ;; note that the runtime representations of collections is + ;; unboxed in the tree-walk interpreter + ;; tuples & lists are both vectors, the first element + ;; distinguishes them + ::ast/tuple + (let [members (:members ast)] + (into [::colls/tuple] (map #(interpret % ctx)) members)) - ::ast/list - (let [members (:members ast)] - (into [::colls/list] (map #(interpret % ctx)) members)) + ::ast/list + (let [members (:members ast)] + (into [::colls/list] (map #(interpret % ctx)) members)) - ::ast/set - (let [members (:members ast)] - (into #{} (map #(interpret % ctx)) members)) + ::ast/set + (let [members (:members ast)] + (into #{} (map #(interpret % ctx)) members)) - (do - (println "ERROR! Unexpected AST node:") - (pp/pprint ast) - ) + (do + (println "ERROR! Unexpected AST node:") + (pp/pprint ast) + ) - )) + )) (do -(def source " - let (:foo, 1, :bar) = (:foo, 1, :bar) + (def source " + let (foo, (_, baz)) = (1, (2, 3)) + baz ") -(println "") -(println "****************************************") -(println "*** *** NEW INTERPRETATION *** ***") -(println "") + (println "") + (println "****************************************") + (println "*** *** NEW INTERPRETATION *** ***") + (println "") -(-> source - (scanner/scan) - (parser/parse) - (::parser/ast) - (interpret {}) - (pp/pprint) -)) \ No newline at end of file + (-> source + (scanner/scan) + (parser/parse) + (::parser/ast) + (interpret {}) + (pp/pprint) + )) \ No newline at end of file