From 56299b20c376e77244158d7c182eb5172b08f78d Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Tue, 6 Aug 2024 22:30:42 -0400 Subject: [PATCH] Fix "if", cleanup clj-kondo warnings, pointless indirection --- .vscode/settings.json | 14 +++++ src/main/tock/compiler.cljc | 4 +- src/main/tock/compiler/bind.cljc | 2 +- src/main/tock/compiler/desugar.cljc | 58 +++++++++---------- src/main/tock/compiler/meander.cljc | 2 + src/main/tock/compiler/specials.cljc | 5 +- .../tock/compiler/{util.cljs => util.cljc} | 6 +- src/main/tock/experiment.cljs | 25 ++++---- 8 files changed, 63 insertions(+), 53 deletions(-) create mode 100644 .vscode/settings.json rename src/main/tock/compiler/{util.cljs => util.cljc} (81%) diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..5c6b445 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,14 @@ +{ + "calva.replConnectSequences": [ + { + "name": "Experiment", + "autoSelectForJackIn": true, + "projectType": "shadow-cljs", + "cljsType": "shadow-cljs", + "menuSelections": { + "cljsDefaultBuild": "experiment", + "cljsLaunchBuilds": ["experiment"] + } + } + ] +} \ No newline at end of file diff --git a/src/main/tock/compiler.cljc b/src/main/tock/compiler.cljc index 24174ad..24ee71b 100644 --- a/src/main/tock/compiler.cljc +++ b/src/main/tock/compiler.cljc @@ -49,8 +49,8 @@ (typecheck specials) (collect-definitions program)))) -(defn compile - ([forms] (compile forms specials)) +(defn compile-wasm + ([forms] (compile-wasm forms specials)) ([forms specials] (-> (reduce compile-form (make-empty-program specials) forms) generate-wasm))) diff --git a/src/main/tock/compiler/bind.cljc b/src/main/tock/compiler/bind.cljc index 97e4aad..f7bb61d 100644 --- a/src/main/tock/compiler/bind.cljc +++ b/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]])) + [tock.compiler.meander :refer [bottom-up all-subexpressions merge-metafield]])) (defn decorate-ctx [specials ctx form] (let [special (get-special specials form) diff --git a/src/main/tock/compiler/desugar.cljc b/src/main/tock/compiler/desugar.cljc index 75bf6fd..b37c0dc 100644 --- a/src/main/tock/compiler/desugar.cljc +++ b/src/main/tock/compiler/desugar.cljc @@ -1,7 +1,6 @@ (ns tock.compiler.desugar (:require [meander.epsilon :as m] [meander.strategy.epsilon :as r] - [tock.compiler.specials :refer [specials]] [tock.compiler.meander :refer [parse-type to-sym label]])) (def leaf-pass @@ -23,35 +22,32 @@ ; [vectors] and {maps} are _not_ expressions and are parsed by special form's desugaring only ?syntax ?syntax))) -(defn make-desugar-pass [specials] - (let [desugar-strat (apply r/pipe (mapcat (fn [[_ {:keys [desugar]}]] (if desugar [(r/attempt desugar)] [])) specials))] - (r/until = - (r/rewrite - ((m/cata ?special) ?m . (m/cata !args) ...) - (m/app desugar-strat (?special ?m . !args ...)) - - ?form ?form)))) +(defn desugar-pass [form specials] + (let [desugar-strat (apply r/pipe (mapcat (fn [[_ {:keys [desugar]}]] (if desugar [(r/attempt desugar)] [])) specials)) + pass (r/until = + (r/rewrite + ((m/cata ?special) ?m . (m/cata !args) ...) + (m/app desugar-strat (?special ?m . !args ...)) + + ?form ?form))] + (pass form))) -(defn make-call-pass [specials] - (let [special? (fn [key] (and (symbol? key) (contains? specials key)))] - (r/rewrite - (m/and (m/pred symbol? ?sym) (m/app meta ?m)) ('l/lookup {:name ?sym & ?m}) +(defn call-pass [form specials] + (let [special? (fn [key] (and (symbol? key) (contains? specials key))) + pass (r/rewrite + (m/and (m/pred symbol? ?sym) (m/app meta ?m)) ('l/lookup {:name ?sym & ?m}) + + ((m/pred special? ?special) ?m . (m/cata !args) ...) + (?special ?m . !args ...) + + ((m/cata ?func) ?m . (m/cata !args) ...) + ('l/call ?m (label ?func "function") . (label !args "argument") ...) + + ?unknown ('l/compile-error {:form ?unknown :error "Unrecognized form"}))] + (pass form))) - ((m/pred special? ?special) ?m . (m/cata !args) ...) - (?special ?m . !args ...) - - ((m/cata ?func) ?m . (m/cata !args) ...) - ('l/call ?m (label ?func "function") . (label !args "argument") ...) - - ?unknown ('l/compile-error {:form ?unknown :error "Unrecognized form"})))) - -(defn desugar - ([form] (desugar form specials)) - ([form specials] - (let [desugar-pass (make-desugar-pass specials) - call-pass (make-call-pass specials)] - (-> form - leaf-pass - desugar-pass - call-pass - )))) +(defn desugar [form specials] + (-> form + leaf-pass + (desugar-pass specials) + (call-pass specials))) diff --git a/src/main/tock/compiler/meander.cljc b/src/main/tock/compiler/meander.cljc index 52e58ca..cf9034c 100644 --- a/src/main/tock/compiler/meander.cljc +++ b/src/main/tock/compiler/meander.cljc @@ -10,6 +10,8 @@ (list? form) (apply list (first form) (merge (second form) m) (rest (rest form))) :else (do (print "m+ " form meta "\n") form))) +(declare m+ label typed) + (m/defsyntax m+ [meta-pattern pattern] (case (::r.syntax/phase &env) diff --git a/src/main/tock/compiler/specials.cljc b/src/main/tock/compiler/specials.cljc index 325fd54..a8d83f9 100644 --- a/src/main/tock/compiler/specials.cljc +++ b/src/main/tock/compiler/specials.cljc @@ -2,7 +2,8 @@ (:require [meander.epsilon :as m] [meander.strategy.epsilon :as r] [helins.wasm.bin :as op] - [tock.compiler.meander :refer [parse-type to-sym label m+]])) + [tock.compiler.meander :refer [parse-type to-sym label m+]] + [tock.compiler.wasm :refer [type-to-wasmtype]])) ;; no namespace - source symbol ;; l/sym - "lowered" form - special form not directly writable from source @@ -45,7 +46,7 @@ (m/match form ('l/if {:type ?type} ?cond ?l ?r) (concat (emit ?cond) - [[op/if- [:wasm/valtype ?type] (emit ?l) (emit ?r)]])))} + [[op/if- [:wasm/valtype (type-to-wasmtype ?type)] (emit ?l) (emit ?r)]])))} 'l/fn {:desugar (r/rewrite diff --git a/src/main/tock/compiler/util.cljs b/src/main/tock/compiler/util.cljc similarity index 81% rename from src/main/tock/compiler/util.cljs rename to src/main/tock/compiler/util.cljc index c6fad61..4defc73 100644 --- a/src/main/tock/compiler/util.cljs +++ b/src/main/tock/compiler/util.cljc @@ -1,9 +1,5 @@ (ns tock.compiler.util) -(defn compile-error [term message] - ; todo: extract location of error term - (js/Error. [term message])) - ; ctx is a vector of atoms of maps (defn new-scope ([ctx base] (conj ctx (atom base))) @@ -26,4 +22,4 @@ (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)) \ No newline at end of file +(defn get-meta [form key] (get (second form) key)) diff --git a/src/main/tock/experiment.cljs b/src/main/tock/experiment.cljs index 01ab63e..568515f 100644 --- a/src/main/tock/experiment.cljs +++ b/src/main/tock/experiment.cljs @@ -1,24 +1,25 @@ (ns tock.experiment (:require [helins.wasm :as wasm] [helins.binf :as binf] - [tock.compiler :refer [compile]] - [cljs.pprint :as pp])) + [tock.compiler :refer [compile-wasm]])) -;; ; https://github.com/kalai-transpiler/kalai (def test-wasm - (compile + (compile-wasm '[(fn add [^f64 left ^f64 right -> f64] (+ left right)) (fn double [^f64 val -> f64] (* val 2)) - (fn add_double [^f64 left ^f64 right -> f64] (double (add left right)))])) + (fn add_double [^bool add-first? ^f64 left ^f64 right -> f64] + (if add-first? + (double (add left right)) + (add (double left) right)))])) -(defn decompile-url [url] - (-> (js/fetch url) - (.then #(.arrayBuffer %)) - (.then #(let [v (binf/view %)] - (binf/endian-set v :little-endian) - (wasm/decompile v))))) +;; (defn decompile-url [url] +;; (-> (js/fetch url) +;; (.then #(.arrayBuffer %)) +;; (.then #(let [v (binf/view %)] +;; (binf/endian-set v :little-endian) +;; (wasm/decompile v))))) (defn instantiate-wasm [wasm importObject] (-> (wasm/compile wasm) @@ -29,7 +30,7 @@ (defn main [] (js/console.log test-wasm) (-> (instantiate-wasm test-wasm #js {}) - (.then #(js/console.log (-> % (.-instance) (.-exports) (.add-double 2 3))))) + (.then (fn [^js x] (js/console.log (-> x (.-instance) (.-exports) (.add-double false 2 3)))))) ;; (-> (decompile-url "release.wasm") ;; (.then #(js/console.log (-> % :wasm/exportsec :wasm.export/func (get 0))))) )