Finally: add functions!
This commit is contained in:
parent
3b1f2460a8
commit
d02bc05209
|
@ -5,6 +5,7 @@
|
||||||
[ludus.ast :as ast]
|
[ludus.ast :as ast]
|
||||||
[ludus.collections :as colls]
|
[ludus.collections :as colls]
|
||||||
[ludus.prelude :as prelude]
|
[ludus.prelude :as prelude]
|
||||||
|
[ludus.data :as data]
|
||||||
[clojure.pprint :as pp]))
|
[clojure.pprint :as pp]))
|
||||||
|
|
||||||
;; right now this is not very efficient:
|
;; right now this is not very efficient:
|
||||||
|
@ -88,7 +89,7 @@
|
||||||
(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 ctx)]
|
||||||
(if if-value
|
(if if-value
|
||||||
(interpret then-expr ctx)
|
(interpret then-expr ctx)
|
||||||
(interpret else-expr ctx))))
|
(interpret else-expr ctx))))
|
||||||
|
@ -114,8 +115,8 @@
|
||||||
(throw (ex-info "Match Error: No match found" {}))))))
|
(throw (ex-info "Match Error: No match found" {}))))))
|
||||||
|
|
||||||
(defn- interpret-called-kw [kw tuple ctx]
|
(defn- interpret-called-kw [kw tuple ctx]
|
||||||
|
;; TODO: check this statically
|
||||||
(if (not (= 1 (:length tuple)))
|
(if (not (= 1 (:length tuple)))
|
||||||
;; TODO: check this statically
|
|
||||||
(throw (ex-info "Called keywords must be unary" {}))
|
(throw (ex-info "Called keywords must be unary" {}))
|
||||||
(let [kw (interpret kw ctx)
|
(let [kw (interpret kw ctx)
|
||||||
map (second (interpret tuple ctx))]
|
map (second (interpret tuple ctx))]
|
||||||
|
@ -123,8 +124,27 @@
|
||||||
|
|
||||||
(defn- call-fn [fn tuple ctx]
|
(defn- call-fn [fn tuple ctx]
|
||||||
(let [passed (interpret tuple ctx)]
|
(let [passed (interpret tuple ctx)]
|
||||||
(case (::ast/type fn)
|
(case (::data/type fn)
|
||||||
::ast/clj (apply (:body fn) (next passed))
|
::data/clj (apply (:body fn) (next passed))
|
||||||
|
|
||||||
|
::data/fn
|
||||||
|
(let [clauses (:clauses fn)]
|
||||||
|
(loop [clause (first clauses)
|
||||||
|
clauses (rest clauses)]
|
||||||
|
(if clause
|
||||||
|
(let [pattern (:pattern clause)
|
||||||
|
body (:body clause)
|
||||||
|
new-ctx (atom {::parent ctx})
|
||||||
|
match? (match pattern passed new-ctx)
|
||||||
|
success (:success match?)
|
||||||
|
clause-ctx (:ctx match?)]
|
||||||
|
(if success
|
||||||
|
(do
|
||||||
|
(swap! new-ctx #(merge % clause-ctx))
|
||||||
|
(interpret body new-ctx))
|
||||||
|
(recur (first clauses) (rest clauses))))
|
||||||
|
|
||||||
|
(throw (ex-info "Match Error: No match found" {:fn-name (:name fn)})))))
|
||||||
|
|
||||||
(throw (ex-info "I don't know how to call that" {:fn fn})))))
|
(throw (ex-info "I don't know how to call that" {:fn fn})))))
|
||||||
|
|
||||||
|
@ -146,6 +166,22 @@
|
||||||
(interpret-synthetic-term (interpret first ctx) second ctx))]
|
(interpret-synthetic-term (interpret first ctx) second ctx))]
|
||||||
(reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest)))
|
(reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest)))
|
||||||
|
|
||||||
|
(defn- interpret-fn [ast ctx]
|
||||||
|
(let [name (:name ast)
|
||||||
|
clauses (:clauses ast)]
|
||||||
|
(if (= name ::ast/anon)
|
||||||
|
{::data/type ::data/fn
|
||||||
|
:name name
|
||||||
|
:clauses clauses}
|
||||||
|
(let [fn {::data/type ::data/fn
|
||||||
|
:name name
|
||||||
|
:clauses clauses}]
|
||||||
|
(if (contains? @ctx name)
|
||||||
|
(throw (ex-info (str "Name " name " is already bound") {}))
|
||||||
|
(do
|
||||||
|
(swap! ctx update-ctx {name fn})
|
||||||
|
fn))))))
|
||||||
|
|
||||||
(defn- map-values [f]
|
(defn- map-values [f]
|
||||||
(map (fn [kv]
|
(map (fn [kv]
|
||||||
(let [[k v] kv]
|
(let [[k v] kv]
|
||||||
|
@ -166,6 +202,8 @@
|
||||||
|
|
||||||
::ast/synthetic (interpret-synthetic ast ctx)
|
::ast/synthetic (interpret-synthetic ast ctx)
|
||||||
|
|
||||||
|
::ast/fn (interpret-fn ast ctx)
|
||||||
|
|
||||||
::ast/block
|
::ast/block
|
||||||
(let [exprs (:exprs ast)
|
(let [exprs (:exprs ast)
|
||||||
inner (pop exprs)
|
inner (pop exprs)
|
||||||
|
@ -209,8 +247,7 @@
|
||||||
(do
|
(do
|
||||||
|
|
||||||
(def source "
|
(def source "
|
||||||
fn foo () -> :foo
|
|
||||||
foo ()
|
|
||||||
|
|
||||||
")
|
")
|
||||||
|
|
||||||
|
|
|
@ -487,7 +487,7 @@
|
||||||
|
|
||||||
::token/lbrace
|
::token/lbrace
|
||||||
(let [clauses (parse-fn-clauses name)]
|
(let [clauses (parse-fn-clauses name)]
|
||||||
(assoc clauses ::ast {::ast/type ::ast/match
|
(assoc clauses ::ast {::ast/type ::ast/fn
|
||||||
:name (get-in name [::ast :word])
|
:name (get-in name [::ast :word])
|
||||||
:clauses (get-in clauses [::ast :clauses])}))
|
:clauses (get-in clauses [::ast :clauses])}))
|
||||||
|
|
||||||
|
@ -499,7 +499,7 @@
|
||||||
::token/lparen
|
::token/lparen
|
||||||
(let [clause (parse-fn-clause first)]
|
(let [clause (parse-fn-clause first)]
|
||||||
(assoc clause ::ast {::ast/type ::ast/fn
|
(assoc clause ::ast {::ast/type ::ast/fn
|
||||||
:name "anonymous"
|
:name ::ast/anon
|
||||||
:clauses [(::ast clause)]}))
|
:clauses [(::ast clause)]}))
|
||||||
|
|
||||||
::token/word (parse-named-fn first)
|
::token/word (parse-named-fn first)
|
||||||
|
|
|
@ -1,21 +1,21 @@
|
||||||
(ns ludus.prelude
|
(ns ludus.prelude
|
||||||
(:require
|
(:require
|
||||||
[ludus.ast :as ast]))
|
[ludus.data :as data]))
|
||||||
|
|
||||||
(def eq {:name "eq"
|
(def eq {:name "eq"
|
||||||
::ast/type ::ast/clj
|
::data/type ::data/clj
|
||||||
:body =})
|
:body =})
|
||||||
|
|
||||||
(def add {:name "add"
|
(def add {:name "add"
|
||||||
::ast/type ::ast/clj
|
::data/type ::data/clj
|
||||||
:body +})
|
:body +})
|
||||||
|
|
||||||
(def panic {:name "panic"
|
(def panic {:name "panic"
|
||||||
::ast/type ::ast/clj
|
::data/type ::data/clj
|
||||||
:body (fn [& args] (throw (ex-info "Ludus panicked!" {:args args})))})
|
:body (fn [& args] (throw (ex-info "Ludus panicked!" {:args args})))})
|
||||||
|
|
||||||
(def print {:name "print"
|
(def print {:name "print"
|
||||||
::ast/type ::ast/clj
|
::data/type ::data/clj
|
||||||
:body (fn [& args]
|
:body (fn [& args]
|
||||||
(println (str args))
|
(println (str args))
|
||||||
:ok)})
|
:ok)})
|
||||||
|
|
Loading…
Reference in New Issue
Block a user