From 02616f1e94e33ce62417ee5243ef4b8236f624bd Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Sun, 23 Jun 2024 12:47:59 -0400
Subject: [PATCH] implement function calls

---
 src/main/tock/compiler/type.cljc | 24 +++++++++++++++++++-----
 src/main/tock/compiler/wasm.cljc |  5 +++++
 src/main/tock/experiment.cljs    |  6 ++++--
 3 files changed, 28 insertions(+), 7 deletions(-)

diff --git a/src/main/tock/compiler/type.cljc b/src/main/tock/compiler/type.cljc
index f5fb9d5..c3015f3 100644
--- a/src/main/tock/compiler/type.cljc
+++ b/src/main/tock/compiler/type.cljc
@@ -57,9 +57,24 @@
 ;; todo:
 ;; - implicitly coerce numeric values when it can be done losslessly
 
-;; External syntax uses simple namespaceless 'symbols, internal syntax uses `symbols
+;; External syntax uses simple namespaceless 'symbols, internal syntax uses `u/symbols
 
 (defmulti decorate-type (fn [form _ctx] (form-dispatch form)))
+(defmulti typecheck-expr (fn [form _ctx] (form-dispatch form)))
+
+(defmethod decorate-type :default [form ctx]
+  (m/match form
+    ((m/app #(typecheck-expr % ctx) (`u/funcref ?funcref) (m/app meta {:type ['fn . !param-types ... ?return-type]})) . !args ...)
+    ; validate arity, coerce !args to !param-types, wrap in ?return-type
+    (do
+      (when (not= (count !param-types) (count !args))
+        (throw (compile-error form (str "Expected " (count !param-types) " arguments, got " (count !args)))))
+      (assoc-type (apply list (concat [`u/call-func ?funcref]
+                                      (map (fn [expr type] (coerce expr type (compile-error expr ["Expected" type])))
+                                           !args
+                                           !param-types)))
+                  ?return-type))))
+
 (defmethod decorate-type 'if [form _ctx]
   (m/match form
     (_ ?test ?when-true ?when-false)
@@ -103,12 +118,11 @@
   (cond (integer? form)       (f64 `(u/lit ~form))
         (boolean? form)       (bool `(u/lit ~form))
         (simple-symbol? form) (m/match (lookup ctx form)
-                                {:local ?local-id :type ?type} (assoc-type `(u/local ~?local-id) ?type)
-                                {:funcref ?funcref}            ?funcref
+                                {:local (m/pred number? ?local-id) :type ?type} (assoc-type `(u/local ~?local-id) ?type)
+                                {:funcref (m/pred list? ?funcref)}              ?funcref
                                 _ (throw (compile-error form "Undefined symbol")))
         :else                 (throw (compile-error form "Not a valid literal"))))
 
-(defmulti typecheck-expr (fn [form _ctx] (form-dispatch form)))
 (defmethod typecheck-expr :default [form ctx]
   (decorate-type (map-subexpressions form #(typecheck-expr % ctx)) ctx))
 
@@ -147,7 +161,7 @@
             return-type (last fn-type)
             body-expr (coerce (typecheck-expr (apply list 'do !body) fn-ctx) return-type
                               (compile-error form ["Expected return type" return-type]))]
-        (assoc-type (list 'funcref (alloc-func ctx fn-type body-expr)) fn-type)))))
+        (assoc-type (list `u/funcref (alloc-func ctx fn-type body-expr)) fn-type)))))
 
 (defmethod typecheck-expr 'do [form ctx]
   (m/match form
diff --git a/src/main/tock/compiler/wasm.cljc b/src/main/tock/compiler/wasm.cljc
index aab80cc..329d8e3 100644
--- a/src/main/tock/compiler/wasm.cljc
+++ b/src/main/tock/compiler/wasm.cljc
@@ -68,6 +68,11 @@
              (= ?type 'bool) [[op/i32-const (if ?lit 1 0)]]
              :else (throw (compile-error form "Invalid literal")))))
 
+(defmethod emit-code `u/call-func [form]
+  (m/match form
+    (_ ?funcref . !args ...)
+    (concat (mapcat emit-code !args) [[op/call ?funcref]])))
+
 (defmethod emit-code 'do [form]
   (mapcat #(emit-code %) (rest form)))
 
diff --git a/src/main/tock/experiment.cljs b/src/main/tock/experiment.cljs
index bda7643..38a49dc 100644
--- a/src/main/tock/experiment.cljs
+++ b/src/main/tock/experiment.cljs
@@ -8,7 +8,9 @@
 
 (def test-wasm
   (compile 
-   '[(defn thing [^bool op ^f64 val -> f64] (if op (+ val 1) (* val 2)))]))
+   '[(defn add [^f64 left ^f64 right -> f64] (+ left right))
+     (defn double [^f64 val -> f64] (* val 2))
+     (defn add_double [^f64 left ^f64 right -> f64] (double (add left right)))]))
 
 (defn decompile-url [url]
   (-> (js/fetch url)
@@ -26,6 +28,6 @@
 (defn main []
   (js/console.log test-wasm)
   (-> (instantiate-wasm test-wasm #js {})
-      (.then #(js/console.log (-> % (.-instance) (.-exports) (.thing false 2)))))
+      (.then #(js/console.log (-> % (.-instance) (.-exports) (.add-double 2 3)))))
   (-> (decompile-url "release.wasm")
       (.then #(js/console.log (-> % :wasm/exportsec :wasm.export/func (get 0))))))