Wasm generation rewrite, lots of bugfixes

src/main/tock/compiler.cljc

@@ -3,8 +3,7 @@
             [tock.compiler.bind :refer [bind]]
             [tock.compiler.specials :refer [specials]]
             [tock.compiler.type :refer [typecheck]]
-            ;; [tock.compiler.wasm :refer [ctx-to-wasm]]
+            [tock.compiler.wasm :refer [collect-definitions]]))
-            [meander.epsilon :as m]))
 
 ;; compiler structure:
 ;; a quoted form is passed through a series of passes:
@@ -30,32 +29,26 @@
 ;;    * binding expressions must be checked against the metadata in scope before typechecking happens - perhaps l/lookup replacement
 ;;      should happen here??
 ;; 5. type-lowering pass
-;;    * static allocation of globals
+;;    * all function definitions are lifted to a top-level collection, and replaced
+;;      with references
 ;;    * allocation of locals
+;;    * static allocation of globals
 ;;    * memory-based stack frame allocation (so structs can be passed by reference)
-;;    * tock types are converted into wasm types
 ;;    * struct access is converted into pointer arithmetic
+;;    * tock types are converted into wasm types
 ;; 6. codegen pass
 ;;    * function expression trees are recursively walked to generate linear wasm bytecode
 
+(def empty-program tock.compiler.wasm/empty-program)
+(def generate-wasm tock.compiler.wasm/generate-wasm)
 
-;; (defmulti compile-toplevel (fn [form _ctx] (form-dispatch form)))
+(defn compile-form [program form]
-;; (defmethod compile-toplevel :default [form _ctx]
-;;   (throw (compile-error form "Unrecognized form")))
-
-;; (defmethod compile-toplevel 'defn [form ctx]
-;;   (m/match form
-;;     (_ (m/pred simple-symbol? ?name) . !fndef ...)
-;;     (let [funcref (typecheck-expr (apply list 'fn !fndef) ctx)
-;;           exported-funcs (lookup ctx ::u/exported-funcs)]
-;;       (bind! ctx ?name {:funcref funcref})
-;;       (swap! exported-funcs assoc (name ?name) (last funcref)))))
-
-(defn new-ctx [] [(atom {:function-count 0})])
-
-(defn compile [form]
-  (let [ctx (new-ctx)]
   (-> form
       (desugar specials)
-        (bind specials ctx)
+      (bind specials [(atom (:globals program))])
-        (typecheck specials))))
+      (typecheck specials)
+      (collect-definitions program)))
+
+(defn compile [forms]
+  (-> (reduce compile-form empty-program forms)
+      generate-wasm))

src/main/tock/compiler/bind.cljc

@@ -1,7 +1,7 @@
 (ns tock.compiler.bind
   (:require [meander.epsilon :as m]
             [tock.compiler.util :refer [get-special new-scope bind! lookup]]
-            [tock.compiler.meander :refer [bottom-up all-subexpressions m+ merge-metafield] :include-macros true]))
+            [tock.compiler.meander :refer [bottom-up all-subexpressions m+ merge-metafield]]))
 
 (defn decorate-ctx [specials ctx form]
   (let [special (get-special specials form)
@@ -12,8 +12,7 @@
         marker (or (:mark-bound-subexpressions special) identity)
         form (marker form)
         form (if new-bindings (merge-metafield form {:bindings bindings}) form)
-        add-ctx? (or (= (first form) 'l/lookup) (:binding (second form)) new-bindings)
+        form (merge-metafield form {:ctx ctx})]
-        form (if add-ctx? (merge-metafield form {:ctx ctx}) form)]
     (doseq [[symbol binding] bindings]
       (bind! ctx symbol binding))
     ((all-subexpressions (partial decorate-ctx specials ctx)) form)))

src/main/tock/compiler/desugar.cljc

@@ -2,7 +2,7 @@
   (:require [meander.epsilon :as m]
             [meander.strategy.epsilon :as r]
             [tock.compiler.specials :refer [specials]]
-            [tock.compiler.meander :refer [parse-type to-sym label] :include-macros true]))
+            [tock.compiler.meander :refer [parse-type to-sym label]]))
 
 (def leaf-pass
   (r/pipe

src/main/tock/compiler/meander.cljc

@@ -1,4 +1,5 @@
 (ns tock.compiler.meander
+  #?(:cljs (:require-macros [tock.compiler.meander]))
   (:require [meander.epsilon :as m]
             [meander.strategy.epsilon :as r]
             [meander.syntax.epsilon :as r.syntax]))
@@ -13,7 +14,7 @@
   [meta-pattern pattern]
   (case (::r.syntax/phase &env)
     :meander/substitute `(m/app merge-metafield ~pattern ~meta-pattern)
-    :meander/match      `(m/and (_ ~meta-pattern . _ ...) ~pattern)
+    :meander/match      `(m/and (~'_ ~meta-pattern ~'. ~'_ ~'...) ~pattern)
     &form))
 
 (m/defsyntax label [form label]
@@ -50,3 +51,41 @@
 (defn bottom-up [s]
   (fn rec [t]
     ((r/pipe (all-subexpressions rec) s) t)))
+
+(defn reduce-all-subexpressions [s]
+  (fn [[t ctx]]
+    (let [subexprs (rest (rest t))
+          [reduced-subexprs reduced-ctx]
+          (reduce (fn [[new-subexprs ctx] subexpr]
+                    (let [[subexpr2 ctx2] (s [subexpr ctx])]
+                      [(conj new-subexprs subexpr2) ctx2]))
+                  [[] ctx]
+                  subexprs)]
+      [(apply list (first t) (second t) reduced-subexprs) reduced-ctx])))
+
+(defn reduce-td [s]
+  (fn rec [t]
+    ((r/pipe s (reduce-all-subexpressions rec)) t)))
+
+(defn reduce-bu [s]
+  (fn rec [t]
+    ((r/pipe (reduce-all-subexpressions rec) s) t)))
+
+(defn join-ctx [s] (fn [t ctx] (s [t ctx])))
+(defn tree-reducer [s]
+  (fn [t-ctx]
+    (let [[_ ctx] t-ctx
+          new-t (s t-ctx)]
+      (if (r/fail? new-t) new-t [new-t ctx]))))
+
+(defn ctx-reducer [s]
+  (fn [t-ctx]
+    (let [[t _] t-ctx
+          new-ctx (s t-ctx)]
+      (if (r/fail? new-ctx) new-ctx [t new-ctx]))))
+
+(defn rewrite-map [m]
+  (fn [form]
+    (let [special (first form)
+          rewriter (get m special)]
+      (if rewriter (rewriter form) form))))

src/main/tock/compiler/specials.cljc

@@ -1,8 +1,7 @@
 (ns tock.compiler.specials
   (:require [meander.epsilon :as m]
             [meander.strategy.epsilon :as r]
-            [tock.compiler.meander :refer [parse-type to-sym label m+] :include-macros true]
+            [tock.compiler.meander :refer [parse-type to-sym label m+]]))
-            [tock.compiler.util :refer [get-meta]]))
 
 ;; no namespace - source symbol
 ;; l/sym - "lowered" form - special form not directly writable from source
@@ -18,10 +17,10 @@
 (defn left-binop-desugar [symbol]
   (r/choice (left-associative symbol) (simple-identity symbol)))
 
-(defn equatable-type? [typesym] (contains? #{'f64 'i32 'bool} typesym))
+(defn equatable-type? [typesym] (contains? #{'f64 'i64 'i32 'bool} typesym))
-(defn ordered-type? [typesym] (= typesym 'f64))
+(defn ordered-type? [typesym] (contains? #{'f64 'i64 'i32} typesym))
 (defn logical-type? [typesym] (= typesym 'bool))
-(defn numerical-type? [typesym] (= typesym 'f64))
+(defn numerical-type? [typesym] (contains? #{'f64 'i64 'i32} typesym))
 
 (defn combinator-typecheck [valid?]
   (r/rewrite (_ (m/pred valid? ?l) (m/pred valid? ?r)) [[?l ?l ?l] [?r ?r ?r]]))

src/main/tock/compiler/type.cljc

@@ -1,7 +1,7 @@
 (ns tock.compiler.type
   (:require [meander.epsilon :as m]
             [meander.strategy.epsilon :as r]
-            [tock.compiler.meander :refer [bottom-up m+ merge-metafield] :include-macros true]
+            [tock.compiler.meander :refer [bottom-up m+ merge-metafield]]
             [tock.compiler.util :refer [lookup get-meta get-special lookup update-binding!]]))
 
 ; typechecking happens bottom-up. by the time a node is called to be typechecked, the system has verified that all of the children
@@ -19,14 +19,16 @@
 ; the metadata, or that the form is a binding lookup and the type can be read from context
 (def default-typechecker 
   (r/rewrite 
-   ({:ctx ?ctx :name ?name}) [[(m/app #(get-meta (lookup %1 %2) :type) ?ctx ?name)]]
+   ({:ctx (m/some ?ctx) :name (m/some ?name)}) [[(m/app #(get-meta (lookup %1 %2) :type) ?ctx ?name)]]
    ({:type ?type}) [[?type]]))
 
 (defn coerce [expr to-type]
   (m/rewrite [(get-meta expr :type) to-type]
              [?t ?t] ~expr
+             [(m/or 'i32 'i64) 'f64] ('l/cast {:type 'f64} ~expr)
+             ['i32 'i64] ('l/cast {:type 'i64} ~expr)
              [_ 'void] ('l/cast {:type 'void} ~expr)
-             _ (m+ {:type-mismatch ~to-type} ~expr)))
+             ?coercion (m+ {:type-mismatch ?coercion} ~expr)))
 
 (defn coerce-form [form typing]
   (m/rewrite [form typing]
@@ -37,9 +39,9 @@
   (let [special (get-special specials form)
         typechecker (or (:typecheck special) default-typechecker)
         input (m/rewrite form (_ ?m . (m/and (_ {:type !subtype} . _ ...) _) ...) (?m . !subtype ...))
-        _ (print (first form) input)
         typings (typechecker input) 
         rewrites (map #(coerce-form form %) typings)
+        ;; _ (print (first form) typings input)
         valid-rewrites (filter #(nil? (get-meta % :type-mismatch)) rewrites)
         rewrite (or (first valid-rewrites) (first rewrites))]
     

src/main/tock/compiler/util.cljs

@@ -22,5 +22,8 @@
 (defn update-binding! [ctx key f & rest]
   (apply swap! (first (filter #(contains? @% key) ctx)) update key f rest))
 
+(defn update-root! [ctx key f & rest]
+  (apply swap! (peek ctx) update key f rest))
+
 (defn get-special [specials form] (get specials (first form)))
 (defn get-meta [form key] (get (second form) key))

src/main/tock/compiler/wasm.cljc

@@ -3,104 +3,210 @@
             [helins.wasm.ir :as ir]
             [helins.wasm.bin :as op]
             [helins.binf.string :as binf.string]
-            [tock.compiler.util :refer [compile-error form-dispatch lookup] :as u]
+            [tock.compiler.meander :refer [typed m+ join-ctx reduce-bu ctx-reducer]]
-            [meander.epsilon :as m]))
+            [tock.compiler.util :refer [get-meta]]
+            [meander.epsilon :as m]
+            [meander.strategy.epsilon :as r]))
 
-(defn expr-type [form] (m/match form (_ {:type ?type} & _) ?type))
+;; Wasm preprocessing:
+;; functions need to be assigned numeric ids that correspond to their wasm index.
+;; function _types_ also need to be assigned numeric IDs corresponding to their wasm index.
+;; replace function definitions with 'l/funcref nodes.
 
-(def operator-assembly
+;; local definitions also need to be hoisted
-  {['= 'f64] [[op/f64-eq]]
+;; 'bool is 'i32 internally, but it's simpler to support it directly in the emitter than rewrite it
-   ['= 'i32] [[op/i32-eq]]
+
-   ['= 'bool] [[op/i32-eq]]
+(def lift-functions
-   ['not= 'f64] [[op/f64-eq] [op/i32-eqz]]
+  (r/rewrite
-   ['not= 'i32] [[op/i32-ne]]
+   [(m/and ('l/fn {:type ?type} . _ ...) ?fn) {:fndefs ?funcs & ?r}]
-   ['not= 'bool] [[op/i32-ne]]
+   [('l/funcref {:id (m/app count ?funcs)
-   ['< 'f64] [[op/f64-lt]]
+                 :type ?type})
-   ['<= 'f64] [[op/f64-le]]
+    {:fndefs (m/app conj ?funcs (m+ {:id (m/app count ?funcs)} ?fn)) & ?r}]))
-   ['> 'f64] [[op/f64-gt]]
+
-   ['>= 'f64] [[op/f64-ge]]
+(def collect-function-types
-   ['< 'i32] [[op/i32-lt_s]]
+  (ctx-reducer
-   ['<= 'i32] [[op/i32-le_s]]
+   (r/rewrite
-   ['> 'i32] [[op/i32-gt_s]]
+    [(typed ?form (m/and ['fn . !params ...] ?type))
-   ['>= 'i32] [[op/i32-ge_s]]
+     {:fntypes (m/and ?types (m/not {?type _index})) & ?r}]
-   ['and 'bool] [[op/i32-and]]
+    {:fntypes {?type (m/app count ?types) & ?types} & ?r})))
-   ['or 'bool] [[op/i32-or]]
+
-   ['+ 'f64] [[op/f64-add]]
+(def collect-globals
-   ['+ 'i32] [[op/i32-add]]
+  (r/rewrite
-   ['- 'f64] [[op/f64-sub]]
+   [('def {:name ?name} ?expr) {:globals ?g & ?r}]
-   ['- 'i32] [[op/i32-sub]]
+   {:globals {?name ?expr & ?g} & ?r}))
-   ['* 'f64] [[op/f64-mul]]
+
-   ['* 'i32] [[op/i32-mul]]
+(def collect-definitions
-   ['/ 'f64] [[op/f64-div]]
+  (join-ctx
-   ['/ 'i32] [[op/i32-div_s]]})
+   (r/pipe
+    (reduce-bu
+     (r/pipe
+      (r/attempt lift-functions)
+      (r/attempt collect-function-types)))
+    collect-globals)))
+
+(def wasm-specials
+  {'l/if
+   {:emit (fn [form emit]
+            (m/match form
+              ('l/if {:type ?type} ?cond ?l ?r)
+              (concat (emit ?cond)
+                      [[op/if- [:wasm/valtype ?type] (emit ?l) (emit ?r)]])))}
+   '+ {:ops {['i64 'i64] [[op/i64-add]]
+             ['i32 'i32] [[op/i32-add]]
+             ['f64 'f64] [[op/f64-add]]}}
+   '- {:ops {['i64 'i64] [[op/i64-sub]]
+             ['i32 'i32] [[op/i32-sub]]
+             ['f64 'f64] [[op/f64-sub]]}}
+   '* {:ops {['i64 'i64] [[op/i64-mul]]
+             ['i32 'i32] [[op/i32-mul]]
+             ['f64 'f64] [[op/f64-mul]]}}
+   '/ {:ops {['i64 'i64] [[op/i64-div_s]]
+             ['i32 'i32] [[op/i32-div_s]]
+             ['f64 'f64] [[op/f64-div]]}}
+   '= {:ops {['i64 'i64] [[op/i64-eq]]
+             ['i32 'i32] [[op/i32-eq]]
+             ['f64 'f64] [[op/f64-eq]]
+             ['fn  'fn]   [[op/i32-eq]]
+             ['bool 'bool] [[op/i32-eq]]}}
+   'not= {:ops {['i64 'i64] [[op/i64-ne]]
+                ['i32 'i32] [[op/i32-ne]]
+                ['f64 'f64] [[op/f64-eq] [op/i32-eqz]]
+                ['fn  'fn]  [[op/i32-ne]]
+                ['bool 'bool] [[op/i32-ne]]}}
+   '< {:ops {['i64 'i64] [[op/i64-lt_s]]
+             ['i32 'i32] [[op/i32-lt_s]]
+             ['f64 'f64] [[op/f64-lt]]}}
+   '<= {:ops {['i64 'i64] [[op/i64-le_s]]
+              ['i32 'i32] [[op/i32-le_s]]
+              ['f64 'f64] [[op/f64-le]]}}
+   '> {:ops {['i64 'i64] [[op/i64-gt_s]]
+             ['i32 'i32] [[op/i32-gt_s]]
+             ['f64 'f64] [[op/f64-gt]]}}
+   '>= {:ops {['i64 'i64] [[op/i64-ge_s]]
+              ['i32 'i32] [[op/i32-ge_s]]
+              ['f64 'f64] [[op/f64-ge]]}}
+   'not {:ops {['bool] [[op/i32-eqz]]}}
+   'and
+   {:emit (fn [form emit]
+            (m/match form
+              ('and _ ?l ?r)
+              [[op/if- [:wasm/valtype 'i32] (emit ?l) (emit ?r) [[op/i32-const 0]]]]))}
+   'or
+   {:emit (fn [form emit]
+            (m/match form
+              ('or _ ?l ?r)
+              [[op/if- [:wasm/valtype 'i32] (emit ?l) [[op/i32-const -1]] (emit ?r)]]))}
+   'do
+   {:emit (fn [form emit]
+            (m/match form
+              ('do _ . !exprs ...)
+              (mapcat emit !exprs)))}
+   'l/call
+   {:emit-meta (fn [form {:keys [emit program]}]
+                 (m/match form
+                   ('l/call _ ('l/funcref {:id ?id}) . !args ...)
+                   (concat (mapcat emit !args) [[op/call ?id]])
+
+                   ('l/call _ (typed ?expr ?fntype) . !args ...)
+                   (concat (mapcat emit !args) 
+                           [[op/call_indirect (get-in program [:fntypes ?fntype])]])))}
+   'l/funcref
+   {:emit (fn [form _emit]
+            (m/match form
+              ('l/funcref {:id ?id}) [[op/i32-const ?id]]))}
+   'l/lit
+   {:emit (fn [form _emit]
+            (m/match form
+              ('l/lit {:type 'i64 :value ?num}) [[op/i64-const ?num]]
+              ('l/lit {:type 'i32 :value ?num}) [[op/i32-const ?num]]
+              ('l/lit {:type 'bool :value ?b}) [[op/i32-const (if ?b -1 0)]]))}
+   'l/param
+   {:emit (fn [form _emit]
+            (m/match form
+              ('l/param {:index ?id}) [[op/local-get ?id]]))}
+   'l/cast
+   {:emit (fn [form emit]
+            (m/match form
+              ('l/cast {:type ?type} (typed ?expr ?type))
+              (emit ?expr)
+
+              ('l/cast {:type 'void} ?expr)
+              (concat (emit ?expr) [[op/drop]])
+
+              ('l/cast {:type 'f64} ('l/lit {:type (m/or 'i32 'i64) :value ?val}))
+              [[op/f64-const ?val]]
+
+              ('l/cast {:type 'i64} ('l/lit {:type 'i32 :value ?val}))
+              [[op/i32-const ?val]]
+
+              ('l/cast {:type 'i64} (typed ?expr 'i32))
+              (concat (emit ?expr) [[op/i64-extend_i32_s]])
+
+              ('l/cast {:type 'f64} (typed ?expr 'i32))
+              (concat (emit ?expr) [[op/f64-convert_i32_s]])
+
+              ('l/cast {:type 'f64} (typed ?expr 'i64))
+              (concat (emit ?expr) [[op/f64-convert_i64_s]])))}
+   'l/fn
+   {:emit (fn [form emit]
+            (m/match form ('l/fn _ ?expr) (emit ?expr)))}})
+
+(defn type-based-emit [form opmap emit]
+  (let [subexprs (rest (rest form))
+        types (into [] (map #(get-meta % :type) subexprs))
+        ops (get opmap types)]
+    (or (concat (mapcat emit subexprs) ops) [[:compile-error form "Unexpected types" types]])))
+
+(defn make-emitter [specials]
+  (fn [form program]
+    ((fn emit [form]
+       (let [special (first form)
+             emitter (get specials special)]
+         (try
+           (cond
+             (contains? emitter :ops) (type-based-emit form (:ops emitter) emit)
+             (contains? emitter :emit) ((:emit emitter) form emit)
+             (contains? emitter :emit-meta) ((:emit-meta emitter) form {:emit emit :program program})
+             :else [[:compile-error form "No wasm emitter defined for special" special]])
+           (catch :default e
+             [[:compile-error form "Error during emission:" e]]))))
+     form)))
+
+(def wasm-emit (make-emitter wasm-specials))
+
+(def empty-program {:fndefs [] :fntypes {} :globals {}})
 
 (defn type-to-wasmtype [type]
   (m/match type
     'f64 op/numtype-f64
-    'bool op/numtype-i32
+    'i32 op/numtype-i32
+    'i64 op/numtype-i64
     'void op/blocktype-nil
-    ['fn . _ ...] op/numtype-i32))
+    _ op/numtype-i32))
 
 (defn wasm-function-signature [type]
   (m/match type
     ['fn . !types ... ?return-type]
     [(apply vector (map type-to-wasmtype !types))
      (if (= ?return-type 'void) [] [(type-to-wasmtype ?return-type)])]))
-(defmulti emit-code (fn [form] (form-dispatch form)))
-(defmethod emit-code :default [form]
-  (m/match form
-    ((m/and (funcref ?func-id) (m/app meta {:type ?type})) . !params ...)
-    (concat (mapcat emit-code !params) [[op/call ?func-id]])
 
-    (?op . !params ...)
+(defn generate-wasm [{:keys [fndefs fntypes globals]}]
-    (if-let [ops (get operator-assembly [?op (expr-type form)])]
+  (let [index-to-fntype (into {} (map (fn [[sym index]] [index sym]) fntypes))
-      (concat (mapcat emit-code !params) ops)
+        fntypes (into [] (map #(get index-to-fntype %) (range (count index-to-fntype))))]
-      (throw (compile-error form ["Don't know how to compile" ?op])))))
-
-(defmethod emit-code `u/local [form]
-  (m/match form (_ ?local-id) [[op/local-get ?local-id]]))
-
-(defmethod emit-code `u/lit [form]
-  (m/match form (m/and (_ ?lit) (m/app meta {:type ?type}))
-           (cond
-             (= ?type 'i32)  [[op/i32-const ?lit]]
-             (= ?type 'i64)  [[op/i64-const ?lit]]
-             (= ?type 'f64)  [[op/f64-const ?lit]]
-             (= ?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 `u/cast-void [form]
-  (m/match form
-    (_ ?expr)
-    (concat (emit-code ?expr) [[op/drop]])))
-
-(defmethod emit-code 'do [form]
-  (mapcat #(emit-code %) (rest form)))
-
-(defmethod emit-code 'if [form]
-  (m/match form
-    (_ ?cond ?when-true ?when-false)
-    (concat (emit-code ?cond) [[op/if- [:wasm/valtype (type-to-wasmtype (expr-type form))] (emit-code ?when-true) (emit-code ?when-false)]])))
-
-(defn ctx-to-wasm [ctx]
-  (let [funcs (deref (lookup ctx ::u/module-funcs))
-        exported-funcs (deref (lookup ctx ::u/exported-funcs))]
-    (pr "generating" funcs exported-funcs)
     (as-> (wasm/ctx) wasm
-      (reduce (fn [wasm i]
+      (reduce (fn [wasm fntype]
-                (let [{:keys [body type]} (get funcs i)]
+                (ir/assoc-type wasm (ir/type-signature {} (wasm-function-signature fntype))))
+              wasm fntypes)
+      (reduce (fn [wasm funcdef]
+                (let [id (get-meta funcdef :id)]
                   (-> wasm
-                      (ir/assoc-type (ir/type-signature {} (wasm-function-signature type)))
+                      (ir/assoc-func (ir/func {} id))
-                      (ir/assoc-func (ir/func {} i))
+                      (assoc-in [:wasm/codesec id]
-                      (assoc-in [:wasm/codesec i] (ir/func' {} [] (apply vector (emit-code body)))))))
+                                (ir/func' {} [] (wasm-emit funcdef))))))
-              wasm
+              wasm fndefs)
-              (range (count funcs)))
+      (reduce (fn [wasm [name form]]
-      (reduce (fn [wasm [name funcid]]
+                (m/match form
-                (assoc-in wasm [:wasm/exportsec :wasm.export/func funcid] [(ir/export' {} (binf.string/encode name))]))
+                  ('l/funcref {:id ?id})
-              wasm
+                  (assoc-in wasm [:wasm/exportsec :wasm.export/func ?id] [(ir/export' {} (binf.string/encode name))])
-              exported-funcs))))
+                  _ wasm))
+              wasm globals))))

src/main/tock/experiment.cljs

@@ -1,16 +1,17 @@
 (ns tock.experiment
   (:require [helins.wasm :as wasm]
             [helins.binf :as binf]
-            [tock.compiler :refer [compile]]))
+            [tock.compiler :refer [compile compile-form empty-program]]
+            [cljs.pprint :as pp]))
 
 
 ;; ; https://github.com/kalai-transpiler/kalai
 
-;; (def test-wasm
+(def test-wasm
-;;   (compile 
+  (compile 
-;;    '[(defn add [^f64 left ^f64 right -> f64] (+ left right))
+   '[(fn add [^f64 left ^f64 right -> f64] (+ left right))
-;;      (defn double [^f64 val -> f64] (* val 2))
+     (fn double [^f64 val -> f64] (* val 2))
-;;      (defn add_double [^f64 left ^f64 right -> f64] (double (add left right)))]))
+     (fn add_double [^f64 left ^f64 right -> f64] (double (add left right)))]))
 
 (defn decompile-url [url]
   (-> (js/fetch url)
@@ -26,9 +27,9 @@
 
 #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
 (defn main []
-  (js/console.log (compile `(fn add [^f64 left ^f64 right -> f64] (+ left right)))))
+  (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) (.add-double 2 3)))))
-  ;;     (.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))))))
+  ;;     (.then #(js/console.log (-> % :wasm/exportsec :wasm.export/func (get 0)))))
+  )