rewrite-based desugar pass

src/main/tock/compiler.cljc

@@ -1,9 +1,25 @@
 (ns tock.compiler
-  (:require [tock.compiler.util :refer [form-dispatch compile-error lookup bind!] :as u] 
+  (:require [tock.compiler.util :refer [form-dispatch compile-error lookup bind!] :as u]
             [tock.compiler.type :refer [typecheck-expr]]
             [tock.compiler.wasm :refer [ctx-to-wasm]]
             [meander.epsilon :as m]))
 
+;; compiler structure:
+;; a quoted form is passed through a series of passes:
+;; 1. canonicalization pass
+;;    * remove namespaces from symbols (allows clojure code to generate code using quasiquote / unquote)
+;;    * wrap literals in ('tock/lit) forms
+;; 2. expansion pass
+;;    * recursively desugars expressions until the entire source tree is in the form of (special expr...)
+;;    * any non-typed parameters (names, types, etc) are stored in metadata
+;; 3. typechecking pass
+;;    * types are calculated for each expression in the tree, bottom-up
+;;    * parents use `coerce` or `unify` to validate each subexpression
+;; 4. codegen pass
+;;    * function expression trees are recursively walked to generate linear wasm bytecode
+;;    * tock types are lowered to wasm types?
+
+
 (defmulti compile-toplevel (fn [form _ctx] (form-dispatch form)))
 (defmethod compile-toplevel :default [form _ctx]
   (throw (compile-error form "Unrecognized form")))

src/main/tock/compiler/desugar.cljc

@@ -0,0 +1,74 @@
+(ns tock.compiler.desugar
+  (:require [meander.epsilon :as m]
+            [meander.strategy.epsilon :as r]
+            [tock.compiler.meander :refer [meta-split label typed m+]]))
+
+;; desugaring idea:
+;; - each parameter to a special is decorated with a human-readable descriptor
+;;   as well as the original syntax object it corresponds to
+
+(defn preserving-meta [strategy]
+  (fn [term]
+    (let [new-term (strategy term)]
+      (m+ (merge (meta new-term) (meta term)) new-term))))
+
+;; no namespace - source symbol
+;; l/sym - "lowered" form - special form not directly writable from source
+;; i/sym - intermediate symbol meant to be recursively expanded into a canonical
+;;         lowered form
+
+(def leaf-pass
+  (r/bottom-up 
+   (preserving-meta
+    (r/attempt
+     (r/rewrite
+      (m/pred symbol? ?sym) (m/app #(symbol (name %)) ?sym)
+      (m/pred number? ?num) ('l/lit ?num)
+      (m/pred boolean? ?b) (typed ('l/lit ?b) 'bool))))))
+
+(def type-cleanup-pass
+  (r/bottom-up 
+   (r/attempt
+    (r/rewrite
+     (meta-split {:tag (m/some ?symbol)} ?form)
+     (typed ?form ?symbol)
+
+     (meta-split {:fn [!type ... '-> ?return-type]} ?form)
+     (typed ?form ['fn !type ... ?return-type])
+
+     (meta-split {:fn [!type ...]} ?form)
+     (typed ?form ['fn !type ... 'void])))))
+
+(defn make-desugar-pass [sugars]
+  (r/top-down
+   (r/until =
+    (preserving-meta
+     (apply r/pipe (map r/attempt sugars))))))
+
+(def tock-sugars
+  [(r/rewrite
+    ('if ?cond ?body & ?more) (i/if ?cond ?body & ?more)
+    (i/if) ('do)
+    (i/if ?else) (label ?else "else block")
+    (i/if ?cond ?body & ?more) (l/if (label ?cond "condition")
+                                     (label ?body "body")
+                                     (i/if & ?more)))
+   (r/rewrite
+    ('fn (m/pred symbol? ?name) & ?rest)        ('def ?name ('fn & ?rest))
+    ('fn [!names ... '-> ?return-type] & ?body) (l/fn [!names ... (label ?return-type "return type")] & ?body)
+    ('fn [!names ...] & ?body)                  (l/fn [!names ... 'void] & ?body))
+   ])
+
+(def tock-parse-errors
+  [(r/rewrite ('if) "if statement needs at least a condition and a body"
+              ('if _) "if statement needs at least one body expression")
+   ])
+
+(defn desugar 
+  ([form] (desugar form tock-sugars))
+  ([form sugars]
+   (let [desugar-pass (make-desugar-pass sugars)]
+     (-> form
+         leaf-pass
+         type-cleanup-pass
+         desugar-pass))))

src/main/tock/compiler/meander.cljc

@@ -0,0 +1,20 @@
+(ns tock.compiler.meander
+  (:require [meander.epsilon :as m] 
+            [meander.syntax.epsilon :as r.syntax]))
+
+(defn m+ [more-meta val] 
+  (if (satisfies? #?(:clj clojure.lang.IObj :cljs IWithMeta) val)
+    (with-meta val (merge (meta val) more-meta))
+    val))
+
+(m/defsyntax meta-split [meta-pattern pattern]
+  (case (::r.syntax/phase &env)
+    :meander/substitute `(m/app m+ ~meta-pattern ~pattern)
+    :meander/match      `(m/and (m/app meta ~meta-pattern) ~pattern)
+    &form))
+
+(m/defsyntax label [form label]
+  `(meta-split {:label ~label} ~form))
+
+(m/defsyntax typed [form type]
+  `(meta-split {:type ~type} ~form))

src/main/tock/experiment.cljs

@@ -1,16 +1,17 @@
 (ns tock.experiment
   (:require [helins.wasm :as wasm]
             [helins.binf :as binf]
+            [tock.compiler.desugar :refer [desugar]]
             [tock.compiler :refer [compile]]))
 
 
 ;; ; https://github.com/kalai-transpiler/kalai
 
-(def test-wasm
+;; (def test-wasm
-  (compile 
+;;   (compile 
-   '[(defn add [^f64 left ^f64 right -> f64] (+ left right))
+;;    '[(defn add [^f64 left ^f64 right -> f64] (+ left right))
-     (defn double [^f64 val -> f64] (* val 2))
+;;      (defn double [^f64 val -> f64] (* val 2))
-     (defn add_double [^f64 left ^f64 right -> f64] (double (add left right)))]))
+;;      (defn add_double [^f64 left ^f64 right -> f64] (double (add left right)))]))
 
 (defn decompile-url [url]
   (-> (js/fetch url)
@@ -26,8 +27,9 @@
 
 #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
 (defn main []
-  (js/console.log test-wasm)
+  (js/console.log (desugar `(if true (thing bloop) false (blarp poop)))))
-  (-> (instantiate-wasm test-wasm #js {})
+  ;; (js/console.log test-wasm)
-      (.then #(js/console.log (-> % (.-instance) (.-exports) (.add-double 2 3)))))
+  ;; (-> (instantiate-wasm test-wasm #js {})
-  (-> (decompile-url "release.wasm")
+  ;;     (.then #(js/console.log (-> % (.-instance) (.-exports) (.add-double 2 3)))))
-      (.then #(js/console.log (-> % :wasm/exportsec :wasm.export/func (get 0))))))
+  ;; (-> (decompile-url "release.wasm")
+  ;;     (.then #(js/console.log (-> % :wasm/exportsec :wasm.export/func (get 0))))))