implement function calls
This commit is contained in:
parent
fca1219d2e
commit
02616f1e94
|
@ -57,9 +57,24 @@
|
||||||
;; todo:
|
;; todo:
|
||||||
;; - implicitly coerce numeric values when it can be done losslessly
|
;; - 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 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]
|
(defmethod decorate-type 'if [form _ctx]
|
||||||
(m/match form
|
(m/match form
|
||||||
(_ ?test ?when-true ?when-false)
|
(_ ?test ?when-true ?when-false)
|
||||||
|
@ -103,12 +118,11 @@
|
||||||
(cond (integer? form) (f64 `(u/lit ~form))
|
(cond (integer? form) (f64 `(u/lit ~form))
|
||||||
(boolean? form) (bool `(u/lit ~form))
|
(boolean? form) (bool `(u/lit ~form))
|
||||||
(simple-symbol? form) (m/match (lookup ctx form)
|
(simple-symbol? form) (m/match (lookup ctx form)
|
||||||
{:local ?local-id :type ?type} (assoc-type `(u/local ~?local-id) ?type)
|
{:local (m/pred number? ?local-id) :type ?type} (assoc-type `(u/local ~?local-id) ?type)
|
||||||
{:funcref ?funcref} ?funcref
|
{:funcref (m/pred list? ?funcref)} ?funcref
|
||||||
_ (throw (compile-error form "Undefined symbol")))
|
_ (throw (compile-error form "Undefined symbol")))
|
||||||
:else (throw (compile-error form "Not a valid literal"))))
|
:else (throw (compile-error form "Not a valid literal"))))
|
||||||
|
|
||||||
(defmulti typecheck-expr (fn [form _ctx] (form-dispatch form)))
|
|
||||||
(defmethod typecheck-expr :default [form ctx]
|
(defmethod typecheck-expr :default [form ctx]
|
||||||
(decorate-type (map-subexpressions form #(typecheck-expr % ctx)) ctx))
|
(decorate-type (map-subexpressions form #(typecheck-expr % ctx)) ctx))
|
||||||
|
|
||||||
|
@ -147,7 +161,7 @@
|
||||||
return-type (last fn-type)
|
return-type (last fn-type)
|
||||||
body-expr (coerce (typecheck-expr (apply list 'do !body) fn-ctx) return-type
|
body-expr (coerce (typecheck-expr (apply list 'do !body) fn-ctx) return-type
|
||||||
(compile-error form ["Expected return type" 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]
|
(defmethod typecheck-expr 'do [form ctx]
|
||||||
(m/match form
|
(m/match form
|
||||||
|
|
|
@ -68,6 +68,11 @@
|
||||||
(= ?type 'bool) [[op/i32-const (if ?lit 1 0)]]
|
(= ?type 'bool) [[op/i32-const (if ?lit 1 0)]]
|
||||||
:else (throw (compile-error form "Invalid literal")))))
|
: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]
|
(defmethod emit-code 'do [form]
|
||||||
(mapcat #(emit-code %) (rest form)))
|
(mapcat #(emit-code %) (rest form)))
|
||||||
|
|
||||||
|
|
|
@ -8,7 +8,9 @@
|
||||||
|
|
||||||
(def test-wasm
|
(def test-wasm
|
||||||
(compile
|
(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]
|
(defn decompile-url [url]
|
||||||
(-> (js/fetch url)
|
(-> (js/fetch url)
|
||||||
|
@ -26,6 +28,6 @@
|
||||||
(defn main []
|
(defn main []
|
||||||
(js/console.log test-wasm)
|
(js/console.log test-wasm)
|
||||||
(-> (instantiate-wasm test-wasm #js {})
|
(-> (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")
|
(-> (decompile-url "release.wasm")
|
||||||
(.then #(js/console.log (-> % :wasm/exportsec :wasm.export/func (get 0))))))
|
(.then #(js/console.log (-> % :wasm/exportsec :wasm.export/func (get 0))))))
|
||||||
|
|
Loading…
Reference in a new issue