rewrite-based desugar pass
This commit is contained in:
parent
34a715db2f
commit
f7fd4745b7
|
@ -4,6 +4,22 @@
|
|||
[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")))
|
||||
|
|
74
src/main/tock/compiler/desugar.cljc
Normal file
74
src/main/tock/compiler/desugar.cljc
Normal file
|
@ -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))))
|
20
src/main/tock/compiler/meander.cljc
Normal file
20
src/main/tock/compiler/meander.cljc
Normal file
|
@ -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))
|
|
@ -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
|
||||
(compile
|
||||
'[(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)))]))
|
||||
;; (def test-wasm
|
||||
;; (compile
|
||||
;; '[(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,8 +27,9 @@
|
|||
|
||||
#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
|
||||
(defn main []
|
||||
(js/console.log test-wasm)
|
||||
(-> (instantiate-wasm test-wasm #js {})
|
||||
(.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))))))
|
||||
(js/console.log (desugar `(if true (thing bloop) false (blarp poop)))))
|
||||
;; (js/console.log test-wasm)
|
||||
;; (-> (instantiate-wasm test-wasm #js {})
|
||||
;; (.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))))))
|
||||
|
|
Loading…
Reference in a new issue