Add hashmaps, synthetics, native functions
This commit is contained in:
parent
11a51cf708
commit
85f7bc8c08
|
@ -121,6 +121,70 @@
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(defn- interpret-called-kw [kw tuple ctx]
|
||||||
|
(if (not (= 1 (:length tuple)))
|
||||||
|
;; TODO: check this statically
|
||||||
|
(throw (ex-info "Called keywords must be unary" {}))
|
||||||
|
(let [kw (interpret kw ctx)
|
||||||
|
map (second (interpret tuple ctx))]
|
||||||
|
(get map kw)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(def eq {
|
||||||
|
:name "eq"
|
||||||
|
::ast/type ::ast/clj
|
||||||
|
:body =
|
||||||
|
})
|
||||||
|
|
||||||
|
(def add {
|
||||||
|
:name "add"
|
||||||
|
::ast/type ::ast/clj
|
||||||
|
:body +
|
||||||
|
})
|
||||||
|
|
||||||
|
(def prelude {"eq" eq "add" add})
|
||||||
|
|
||||||
|
(defn- call-fn [fn tuple ctx]
|
||||||
|
(let [passed (interpret tuple ctx)]
|
||||||
|
(case (::ast/type fn)
|
||||||
|
::ast/clj (apply (:body fn) (next passed))
|
||||||
|
|
||||||
|
(throw (ex-info "I don't know how to call that" {:fn fn}))
|
||||||
|
)
|
||||||
|
))
|
||||||
|
|
||||||
|
;; TODO: add placeholder partial application
|
||||||
|
(defn- interpret-synthetic-term [prev-value curr ctx]
|
||||||
|
(let [type (::ast/type curr)]
|
||||||
|
(if (= type ::ast/atom)
|
||||||
|
(get prev-value (:value curr))
|
||||||
|
(call-fn prev-value curr ctx)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
(defn- interpret-synthetic [ast ctx]
|
||||||
|
(let [terms (:terms ast)
|
||||||
|
first (first terms)
|
||||||
|
second (second terms)
|
||||||
|
rest (rest (rest terms))
|
||||||
|
first-term-type (::ast/type first)
|
||||||
|
first-val (if (= first-term-type ::ast/atom)
|
||||||
|
(interpret-called-kw first second ctx)
|
||||||
|
(interpret-synthetic-term (interpret first ctx) second ctx))
|
||||||
|
]
|
||||||
|
(reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest)
|
||||||
|
|
||||||
|
))
|
||||||
|
|
||||||
|
(defn- map-values [f]
|
||||||
|
(map (fn [kv]
|
||||||
|
(let [[k v] kv]
|
||||||
|
[k (f v)]))))
|
||||||
|
|
||||||
(defn interpret [ast ctx]
|
(defn interpret [ast ctx]
|
||||||
(case (::ast/type ast)
|
(case (::ast/type ast)
|
||||||
|
|
||||||
|
@ -134,6 +198,8 @@
|
||||||
|
|
||||||
::ast/match (interpret-match ast ctx)
|
::ast/match (interpret-match ast ctx)
|
||||||
|
|
||||||
|
::ast/synthetic (interpret-synthetic ast ctx)
|
||||||
|
|
||||||
::ast/block
|
::ast/block
|
||||||
(let [exprs (:exprs ast)
|
(let [exprs (:exprs ast)
|
||||||
inner (pop exprs)
|
inner (pop exprs)
|
||||||
|
@ -147,7 +213,7 @@
|
||||||
(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 prelude)
|
||||||
]
|
]
|
||||||
(run! #(interpret % ctx) inner)
|
(run! #(interpret % ctx) inner)
|
||||||
(interpret last ctx)
|
(interpret last ctx)
|
||||||
|
@ -169,6 +235,10 @@
|
||||||
(let [members (:members ast)]
|
(let [members (:members ast)]
|
||||||
(into #{} (map #(interpret % ctx)) members))
|
(into #{} (map #(interpret % ctx)) members))
|
||||||
|
|
||||||
|
::ast/hash
|
||||||
|
(let [members (:members ast)]
|
||||||
|
(into {} (map-values #(interpret % ctx)) members))
|
||||||
|
|
||||||
(do
|
(do
|
||||||
(println "ERROR! Unexpected AST node:")
|
(println "ERROR! Unexpected AST node:")
|
||||||
(pp/pprint ast)
|
(pp/pprint ast)
|
||||||
|
@ -176,16 +246,10 @@
|
||||||
|
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
||||||
(do
|
(do
|
||||||
|
|
||||||
(def source "
|
(def source "
|
||||||
let foo = (1, 2)
|
add (1, 2, 3)
|
||||||
match foo with {
|
|
||||||
0 -> :zero
|
|
||||||
(_, 3) -> :one
|
|
||||||
& baz -> baz
|
|
||||||
}
|
|
||||||
")
|
")
|
||||||
|
|
||||||
(println "")
|
(println "")
|
||||||
|
|
Loading…
Reference in New Issue
Block a user