Finally: add functions!

This commit is contained in:
Scott Richmond 2022-03-20 19:17:15 -04:00
parent 3b1f2460a8
commit d02bc05209
3 changed files with 50 additions and 13 deletions

View File

@ -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 ()
") ")

View File

@ -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)

View File

@ -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)})