From f7fd4745b72698932f46a8f90c6d8d5189022e02 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Sat, 13 Jul 2024 22:35:43 -0400 Subject: [PATCH] rewrite-based desugar pass --- src/main/tock/compiler.cljc | 18 ++++++- src/main/tock/compiler/desugar.cljc | 74 +++++++++++++++++++++++++++++ src/main/tock/compiler/meander.cljc | 20 ++++++++ src/main/tock/experiment.cljs | 22 +++++---- 4 files changed, 123 insertions(+), 11 deletions(-) create mode 100644 src/main/tock/compiler/desugar.cljc create mode 100644 src/main/tock/compiler/meander.cljc diff --git a/src/main/tock/compiler.cljc b/src/main/tock/compiler.cljc index db0a394..3e4a9e2 100644 --- a/src/main/tock/compiler.cljc +++ b/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"))) diff --git a/src/main/tock/compiler/desugar.cljc b/src/main/tock/compiler/desugar.cljc new file mode 100644 index 0000000..ab0d663 --- /dev/null +++ b/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)))) diff --git a/src/main/tock/compiler/meander.cljc b/src/main/tock/compiler/meander.cljc new file mode 100644 index 0000000..f87bd58 --- /dev/null +++ b/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)) diff --git a/src/main/tock/experiment.cljs b/src/main/tock/experiment.cljs index 38a49dc..9c6c15c 100644 --- a/src/main/tock/experiment.cljs +++ b/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 - (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))))))