Start work on the interpreter
This commit is contained in:
parent
5baa4fe3ba
commit
3f0feab83b
1
src/ludus/collections.clj
Normal file
1
src/ludus/collections.clj
Normal file
|
@ -0,0 +1 @@
|
|||
(ns ludus.collections)
|
141
src/ludus/interpreter.clj
Normal file
141
src/ludus/interpreter.clj
Normal file
|
@ -0,0 +1,141 @@
|
|||
(ns ludus.interpreter
|
||||
(: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)))))))
|
||||
|
||||
(declare interpret)
|
||||
|
||||
(defn- match [pattern value ctx-atom]
|
||||
(let [ctx @ctx-atom]
|
||||
(case (::ast/type pattern)
|
||||
::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}}
|
||||
))
|
||||
|
||||
(do
|
||||
(println "ERROR! Unexpected pattern:")
|
||||
(pp/pprint pattern)
|
||||
)
|
||||
)))
|
||||
|
||||
(defn- update-ctx [ctx new-ctx]
|
||||
(merge ctx new-ctx))
|
||||
|
||||
;; TODO: get "if let" pattern working
|
||||
(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
|
||||
))
|
||||
|
||||
(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)
|
||||
)))
|
||||
|
||||
(defn interpret [ast ctx]
|
||||
(case (::ast/type ast)
|
||||
|
||||
::ast/atom (:value ast)
|
||||
|
||||
::ast/word (resolve (:word ast) ctx)
|
||||
|
||||
::ast/let (interpret-let 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/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
|
||||
::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/set
|
||||
(let [members (:members ast)]
|
||||
(into #{} (map #(interpret % ctx)) members))
|
||||
|
||||
(do
|
||||
(println "ERROR! Unexpected AST node:")
|
||||
(pp/pprint ast)
|
||||
)
|
||||
|
||||
))
|
||||
|
||||
|
||||
(do
|
||||
|
||||
(def source "
|
||||
|
||||
")
|
||||
|
||||
(println "")
|
||||
(println "****************************************")
|
||||
(println "*** *** NEW INTERPRETATION *** ***")
|
||||
(println "")
|
||||
|
||||
(-> source
|
||||
(scanner/scan)
|
||||
(parser/parse)
|
||||
(::parser/ast)
|
||||
(interpret {})
|
||||
(pp/pprint)
|
||||
))
|
Loading…
Reference in New Issue
Block a user