Reindent things
This commit is contained in:
parent
90f6fa8b19
commit
2a099298f0
|
@ -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)
|
||||||
))
|
))
|
Loading…
Reference in New Issue
Block a user