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