From d02bc05209d49f0b8a860fa3b4b5b9e363e4c6cc Mon Sep 17 00:00:00 2001
From: Scott Richmond <kredati@users.noreply.github.com>
Date: Sun, 20 Mar 2022 19:17:15 -0400
Subject: [PATCH] Finally: add functions!

---
 src/ludus/interpreter.clj | 49 ++++++++++++++++++++++++++++++++++-----
 src/ludus/parser.clj      |  4 ++--
 src/ludus/prelude.clj     | 10 ++++----
 3 files changed, 50 insertions(+), 13 deletions(-)

diff --git a/src/ludus/interpreter.clj b/src/ludus/interpreter.clj
index 4215805..0b54337 100644
--- a/src/ludus/interpreter.clj
+++ b/src/ludus/interpreter.clj
@@ -5,6 +5,7 @@
    [ludus.ast :as ast]
    [ludus.collections :as colls]
    [ludus.prelude :as prelude]
+   [ludus.data :as data]
    [clojure.pprint :as pp]))
 
 ;; right now this is not very efficient:
@@ -88,7 +89,7 @@
   (let [if-expr (:if ast)
         then-expr (:then ast)
         else-expr (:else ast)
-        if-value (interpret if-expr ast)]
+        if-value (interpret if-expr ctx)]
     (if if-value
       (interpret then-expr ctx)
       (interpret else-expr ctx))))
@@ -114,8 +115,8 @@
         (throw (ex-info "Match Error: No match found" {}))))))
 
 (defn- interpret-called-kw [kw tuple ctx]
+  ;; TODO: check this statically
   (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))]
@@ -123,8 +124,27 @@
 
 (defn- call-fn [fn tuple ctx]
   (let [passed (interpret tuple ctx)]
-    (case (::ast/type fn)
-      ::ast/clj (apply (:body fn) (next passed))
+    (case (::data/type fn)
+      ::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})))))
 
@@ -146,6 +166,22 @@
                     (interpret-synthetic-term (interpret first ctx) second ctx))]
     (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]
   (map (fn [kv]
          (let [[k v] kv]
@@ -166,6 +202,8 @@
 
     ::ast/synthetic (interpret-synthetic ast ctx)
 
+    ::ast/fn (interpret-fn ast ctx)
+
     ::ast/block
     (let [exprs (:exprs ast)
           inner (pop exprs)
@@ -209,8 +247,7 @@
 (do
 
   (def source "
-  	fn foo () -> :foo
-    foo ()
+
 
 	")
 
diff --git a/src/ludus/parser.clj b/src/ludus/parser.clj
index 508a8fc..714b53a 100644
--- a/src/ludus/parser.clj
+++ b/src/ludus/parser.clj
@@ -487,7 +487,7 @@
 
       ::token/lbrace
       (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])
                               :clauses (get-in clauses [::ast :clauses])}))
 
@@ -499,7 +499,7 @@
       ::token/lparen
       (let [clause (parse-fn-clause first)]
         (assoc clause ::ast {::ast/type ::ast/fn
-                             :name "anonymous"
+                             :name ::ast/anon
                              :clauses [(::ast clause)]}))
 
       ::token/word (parse-named-fn first)
diff --git a/src/ludus/prelude.clj b/src/ludus/prelude.clj
index 9cc9bd0..cb9e45b 100644
--- a/src/ludus/prelude.clj
+++ b/src/ludus/prelude.clj
@@ -1,21 +1,21 @@
 (ns ludus.prelude
   (:require
-   [ludus.ast :as ast]))
+   [ludus.data :as data]))
 
 (def eq {:name "eq"
-         ::ast/type ::ast/clj
+         ::data/type ::data/clj
          :body =})
 
 (def add {:name "add"
-          ::ast/type ::ast/clj
+          ::data/type ::data/clj
           :body +})
 
 (def panic {:name "panic"
-            ::ast/type ::ast/clj
+            ::data/type ::data/clj
             :body (fn [& args] (throw (ex-info "Ludus panicked!" {:args args})))})
 
 (def print {:name "print"
-            ::ast/type ::ast/clj
+            ::data/type ::data/clj
             :body (fn [& args]
                     (println (str args))
                     :ok)})