twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

Interpret partially applied functions

Browse Source
This commit is contained in:
Scott Richmond 2022-04-05 20:27:22 -04:00
parent 7309622a2b
commit d8e8a1b17e
1 changed files with 33 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
src/ludus/interpreter.clj
View File

@ -122,12 +122,21 @@
(get map kw)) (get map kw))
))) )))
(defn- call-fn [fn tuple ctx] (defn- call-fn [lfn tuple ctx]
(case (::data/type fn) (cond
::data/clj (apply (:body fn) (next tuple)) (= ::data/partial (first tuple))
{::data/type ::data/clj
:name (str (:name lfn) "{partial}")
:body (fn [arg]
(call-fn
lfn
(concat [::data/tuple] (replace {::data/placeholder arg} (rest tuple)))
ctx))}
::data/fn (= (::data/type lfn) ::data/clj) (apply (:body lfn) (next tuple))
(let [clauses (:clauses fn)]
(= (::data/type lfn) ::data/fn)
(let [clauses (:clauses lfn)]
(loop [clause (first clauses) (loop [clause (first clauses)
clauses (rest clauses)] clauses (rest clauses)]
(if clause (if clause
@ -143,20 +152,19 @@
(interpret-ast body new-ctx)) (interpret-ast body new-ctx))
(recur (first clauses) (rest clauses)))) (recur (first clauses) (rest clauses))))
(throw (ex-info "Match Error: No match found" {:fn-name (:name fn)}))))) (throw (ex-info "Match Error: No match found" {:fn-name (:name lfn)})))))
;; TODO: clean this up (= clojure.lang.Keyword (type lfn))
;; TODO: error with a passed tuple longer than 1
(if (= clojure.lang.Keyword (type fn))
(if (= 2 (count tuple)) (if (= 2 (count tuple))
(let [target (second tuple) kw fn] (let [target (second tuple) kw lfn]
(if (::data/struct target) (if (::data/struct target)
(if (contains? target kw) (if (contains? target kw)
(kw target) (kw target)
(throw (ex-info (str "Struct error: no member at " kw) {}))) (throw (ex-info (str "Struct error: no member at " kw) {})))
(kw target))) (kw target)))
(throw (ex-info "Called keywords take a single argument" {}))) (throw (ex-info "Called keywords take a single argument" {})))
(throw (ex-info "I don't know how to call that" {:fn fn})))))
:else (throw (ex-info "I don't know how to call that" {:fn lfn}))))
;; TODO: add placeholder partial application ;; TODO: add placeholder partial application
(defn- interpret-synthetic-term [prev-value curr ctx] (defn- interpret-synthetic-term [prev-value curr ctx]
@ -226,6 +234,8 @@
::ast/pipeline (interpret-do ast ctx) ::ast/pipeline (interpret-do ast ctx)
::ast/placeholder ::data/placeholder
::ast/block ::ast/block
(let [exprs (:exprs ast) (let [exprs (:exprs ast)
inner (pop exprs) inner (pop exprs)
@ -247,7 +257,9 @@
;; tuples are vectors with a special first member ;; tuples are vectors with a special first member
::ast/tuple ::ast/tuple
(let [members (:members ast)] (let [members (:members ast)]
(into [::data/tuple] (map #(interpret-ast % ctx)) members)) (into
[(if (:partial ast) ::data/partial ::data/tuple)]
(map #(interpret-ast % ctx)) members))
::ast/list ::ast/list
(let [members (:members ast)] (let [members (:members ast)]
@ -270,14 +282,18 @@
(defn interpret [parsed] (defn interpret [parsed]
(interpret-ast (::parser/ast parsed) {})) (interpret-ast (::parser/ast parsed) {}))
(comment (do
(def source " (def source "
let foo = do 1 > inc > inc fn square (x) -> mult (x, x)
> inc
do 12
> square
> div (_, 2)
> inc
> print
foo
") ")