├── .gitignore ├── deps.edn ├── test └── src │ └── core_test.clj ├── sample.wat ├── README.md └── src └── wasm └── core.cljc /.gitignore: -------------------------------------------------------------------------------- 1 | .idea 2 | *.iml 3 | .nrepl-port 4 | .cpcache 5 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clojure/clojure {:mvn/version "1.10.1"} 2 | org.clojure/clojurescript {:mvn/version "1.10.597"}}} 3 | -------------------------------------------------------------------------------- /test/src/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns src.core-test 2 | (:require [clojure.test :refer :all] 3 | [wasm.core :as wasm] 4 | [clojure.java.shell :as sh])) 5 | 6 | (do 7 | (->> (wasm/compile-wasm 8 | '(module 9 | 10 | (defn true? [^i32 x] 11 | (= x true)) 12 | 13 | (defn false? [^i32 x] 14 | (= x false)) 15 | 16 | (defn add [^i32 a ^i32 b] 17 | (let [x 1] 18 | (if (= a x) 19 | (+ a x) 20 | (+ a b)))) 21 | 22 | (defn ^:export main [] 23 | (add 9 8)))) 24 | (spit "sample.wat")) 25 | 26 | (->> (sh/sh "wasmtime" "sample.wat" "--invoke=main"))) 27 | -------------------------------------------------------------------------------- /sample.wat: -------------------------------------------------------------------------------- 1 | (module (type $return_true? (func (param $x i32) (result i32))) 2 | (func $true_QMARK_ (param $x i32) (result i32) 3 | (i32.eq 4 | (i32.const 1) 5 | (local.get $x))) 6 | (export "$true_QMARK_" (func $true_QMARK_))(type $return_false? (func (param $x i32) (result i32))) 7 | (func $false_QMARK_ (param $x i32) (result i32) 8 | (i32.eq 9 | (i32.const 0) 10 | (local.get $x))) 11 | (export "$false_QMARK_" (func $false_QMARK_))(type $return_add (func (param $a i32) (param $b i32) (result i32))) 12 | (func $add (param $a i32) (param $b i32) (result i32)(local $x i32) 13 | 14 | (block (result i32) 15 | 16 | (local.set $x 17 | (i32.const 1)) 18 | 19 | (if (result i32) (i32.eq 20 | (local.get $x) 21 | (local.get $a)) 22 | (then (i32.add 23 | (local.get $x) 24 | (local.get $a))) 25 | (else (i32.add 26 | (local.get $b) 27 | (local.get $a)))))) 28 | (export "$add" (func $add))(type $return_main (func (result i32))) 29 | (func $main (result i32) 30 | 31 | (call $add 32 | (i32.const 9) 33 | (i32.const 8))) 34 | (export "main" (func $main))) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | _Clojure-flavored WASM's text format_ 2 | 3 | Turns this 4 | 5 | ```clojure 6 | (module 7 | (defn add [^i32 a ^i32 b] 8 | (let [x 1] 9 | (if (= a x) 10 | (+ a x) 11 | (+ a b)))) 12 | 13 | (defn main [] 14 | (add 9 8))) 15 | ``` 16 | 17 | into this 18 | 19 | ```lisp 20 | (module 21 | (type $return_add (func (param $a i32) (param $b i32) (result i32))) 22 | 23 | (func $add (param $a i32) (param $b i32) (result i32) (local $x i32) 24 | (block (result i32) 25 | (local.set $x (i32.const 1)) 26 | (if (result i32) 27 | (i32.eq 28 | (local.get $x) 29 | (local.get $a)) 30 | (then 31 | (i32.add 32 | (local.get $x) 33 | (local.get $a))) 34 | (else 35 | (i32.add 36 | (local.get $b) 37 | (local.get $a)))))) 38 | 39 | (export "add" (func $add)) 40 | 41 | (type $return_main (func (result i32))) 42 | 43 | (func $main (result i32) 44 | (call $add 45 | (i32.const 9) 46 | (i32.const 8))) 47 | 48 | (export "main" (func $main))) 49 | ``` 50 | -------------------------------------------------------------------------------- /src/wasm/core.cljc: -------------------------------------------------------------------------------- 1 | (ns wasm.core 2 | #?(:cljs (:import [goog.string StringBuffer])) 3 | (:require [clojure.string :as str])) 4 | 5 | (def ^:dynamic ^StringBuilder out) 6 | (def ^:dynamic compiler-env) 7 | (def ^:dynamic *fn-locals*) 8 | 9 | (defn default-compiler-env [] 10 | (atom {:defs {} 11 | :defs-order []})) 12 | 13 | (def specials 14 | '#{module ns 15 | def fn defn do 16 | if and let 17 | = + - / *}) 18 | 19 | (def types '#{i32 i64 f32 f64}) 20 | 21 | (defn emits [& strs] 22 | (doseq [s strs] 23 | (.append out (str s)))) 24 | 25 | (defn emitln 26 | ([] 27 | (emits "\n")) 28 | ([s] 29 | (emits "\n" s))) 30 | 31 | (defn munge-name [s] 32 | (str "$" 33 | (-> s 34 | (str/replace "?" "_QMARK_") 35 | (str/replace "!" "_BANG_") 36 | (str/replace "*" "_STAR_") 37 | (str/replace "-" "_") 38 | (str/replace "+" "_PLUS_") 39 | (str/replace ">" "_GT_") 40 | (str/replace "<" "_LT_") 41 | (str/replace "=" "_EQ_")))) 42 | 43 | (defmulti emit (fn [ast] (:op ast))) 44 | 45 | (defmethod emit 'module [{:keys [body]}] 46 | (emits "(module ") 47 | (doseq [expr body] 48 | (emit expr)) 49 | (emits ")")) 50 | 51 | (defmethod emit 'ns [{:keys [name]}] 52 | (prn @compiler-env) 53 | (emitln "(table 0 funcref)")) 54 | 55 | (defmethod emit 'id [{:keys [name]}] 56 | (emits (munge-name name))) 57 | 58 | (defmethod emit 'param [{:keys [tag id]}] 59 | (emits "(param ") 60 | (emit id) 61 | (emits " " tag ") ")) 62 | 63 | (defmethod emit 'def [{:keys [name tag]}] 64 | (emits "(global ") 65 | (emit name) 66 | (emits " (import \"js\" \"global\") " tag ")")) 67 | 68 | (defn emit-fn-ret-type [{:keys [name ret-tag args]}] 69 | (emits "(type $return_" (:name name) " (func ") 70 | (doseq [arg args] 71 | (emit arg)) 72 | (emits "(result " ret-tag ")") 73 | (emits "))")) 74 | 75 | (defn emit-local [id] 76 | (emits "(local ") 77 | (emit id) 78 | (emits " " (:tag id)) 79 | (emits ") ")) 80 | 81 | (defmethod emit 'fn [{:keys [ret-tag name locals args body] :as ast}] 82 | #_#_#_(emits "(elem (i32.const " 83 | (dec (count (:defs-order @compiler-env))) 84 | ") ") 85 | (emit name) 86 | (emits ")") 87 | (emit-fn-ret-type ast) 88 | 89 | (emitln "(func ") 90 | (emit name) 91 | (emits " ") 92 | (doseq [arg args] 93 | (emit arg)) 94 | (when ret-tag 95 | (emits "(result " ret-tag ")")) 96 | (doseq [local (filter #(not= 'param (:op %)) locals)] 97 | (emit-local local)) 98 | (doseq [expr body] 99 | (emitln) 100 | (emit expr)) 101 | (emits ")") 102 | (emitln "(export ") 103 | (let [var-name (cond-> (:name name) 104 | (-> ast :meta :export true? not) munge-name)] 105 | (emits "\"" var-name "\" (func ")) 106 | (emit name) 107 | (emits "))")) 108 | 109 | (defmethod emit '+ [{:keys [tag left right]}] 110 | (emits "(" tag ".add ") 111 | (emit right) 112 | (emits " ") 113 | (emit left) 114 | (emits ")")) 115 | 116 | (defmethod emit '= [{:keys [tag left right]}] 117 | (emits "(" tag ".eq ") 118 | (emit right) 119 | (emits " ") 120 | (emit left) 121 | (emits ")")) 122 | 123 | (defmethod emit 'and [{:keys [tag left right]}] 124 | (emits "(" tag ".and ") 125 | (emit right) 126 | (emits " ") 127 | (emit left) 128 | (emits ")")) 129 | 130 | (defmethod emit 'block [{:keys [tag body]}] 131 | (emitln "(block (result ") 132 | (emits tag ")") 133 | (doseq [expr body] 134 | (emitln) 135 | (emit expr)) 136 | (emits ")")) 137 | 138 | (defmethod emit 'local-get [{:keys [id]}] 139 | (emitln "(local.get ") 140 | (emit id) 141 | (emits ")")) 142 | 143 | (defmethod emit 'local-set [{:keys [id value]}] 144 | (emitln "(local.set ") 145 | (emit id) 146 | (emits " ") 147 | (emit value) 148 | (emits ")")) 149 | 150 | (defmethod emit 'const [{:keys [tag form]}] 151 | (case tag 152 | 'string (do (emitln "(data (i32.const 16) ") 153 | (emits "\"" form "\")")) 154 | (do (emitln "(") 155 | (emits tag ".const " form ")")))) 156 | 157 | (defn emit-type [type] 158 | (emits "(type $return_" type ")")) 159 | 160 | (defmethod emit 'invoke [{:keys [name args]}] 161 | (emitln "(call ") 162 | #_#_(emitln "(call_indirect ") 163 | (emit-type (:name name)) 164 | (emit name) 165 | (emits " ") 166 | (doseq [expr args] 167 | (emits " ") 168 | (emit expr)) 169 | (emits ")") 170 | #_(emits " (i32.const " 171 | (.indexOf ^PersistentVector (:defs-order @compiler-env) (:name name)) 172 | "))")) 173 | 174 | (defmethod emit 'if [{:keys [tag test then else]}] 175 | (emitln "(if ") (emits "(result " tag ") ") (emit test) 176 | (emitln " ") (emits "(then ") 177 | (emit then) (emits ")") 178 | (emitln " ") (emits "(else ") 179 | (emit else) 180 | (emits "))")) 181 | 182 | (declare analyze) 183 | 184 | 185 | (defmulti parse (fn [form env] (first form))) 186 | 187 | (defn parse-symbol [v] 188 | {:op 'id 189 | :name v}) 190 | 191 | (defn parse-argument [id] 192 | (let [tag (-> id :name meta :tag) 193 | _ (assert (some? tag) "function argument should declare type") 194 | _ (assert (contains? types tag) "invalid function argument type")] 195 | {:op 'param 196 | :tag tag 197 | :id id 198 | :children [:id]})) 199 | 200 | (defn parse-local [id] 201 | {:op 'local-get 202 | :id id 203 | :children [:id]}) 204 | 205 | (defn index-by [f coll] 206 | (->> coll 207 | (reduce (fn [ret v] 208 | (assoc! ret (f v) v) 209 | ret) 210 | (transient {})) 211 | persistent!)) 212 | 213 | (defmethod parse 'module [[_ & body] env] 214 | {:op 'module 215 | :body (map #(analyze % env) body) 216 | :children [:body]}) 217 | 218 | (defmethod parse 'def [[_ name] env] 219 | (let [tag (:tag (meta name))] 220 | {:op 'def 221 | :name (parse-symbol name) 222 | :tag tag})) 223 | 224 | (defmethod parse 'fn [[_ args & body] env] 225 | (let [{ret-tag :tag name :name} (meta args) 226 | _ (when (some? ret-tag) 227 | (assert (contains? types ret-tag) "invalid function return type")) 228 | args (map (comp parse-argument #(analyze % env)) args) 229 | [body fn-locals] (binding [*fn-locals* (atom (index-by (comp :name :id) args))] 230 | [(doall 231 | (for [expr body] 232 | (let [ast (analyze expr nil)] 233 | (if (= 'id (:op ast)) 234 | (parse-local ast) 235 | ast)))) 236 | @*fn-locals*]) 237 | inferred-ret-tag (-> body last :tag) 238 | _ (assert (or (some? inferred-ret-tag) (some? ret-tag)) 239 | (str "Couldn't infer return type of " name 240 | ", add manual return type hint")) 241 | _ (when (and (some? inferred-ret-tag) (some? ret-tag)) 242 | (assert (= inferred-ret-tag ret-tag) 243 | (str "Return type " ret-tag " doesn't match inferred type " 244 | inferred-ret-tag " in " name))) 245 | ast {:op 'fn 246 | :meta (meta name) 247 | :ret-tag (or inferred-ret-tag ret-tag) 248 | :name (parse-symbol name) 249 | :args args 250 | :locals (vals fn-locals) 251 | :body body 252 | :children [:name :args :locals :body]}] 253 | (swap! compiler-env assoc-in [:defs name] ast) 254 | (swap! compiler-env update :defs-order conj name) 255 | ast)) 256 | 257 | (defmethod parse 'defn [[_ name args & body] env] 258 | (parse `(~'fn ~(vary-meta args #(assoc % :name name)) ~@body) 259 | env)) 260 | 261 | (defmethod parse '+ [[_ left right] env] 262 | (let [left (let [e (analyze left env)] 263 | (if (= 'id (:op e)) 264 | (parse-local e) 265 | e)) 266 | right (let [e (analyze right env)] 267 | (if (= 'id (:op e)) 268 | (parse-local e) 269 | e)) 270 | ltag (if (= 'const (:op left)) 271 | (:tag left) 272 | (get-in @*fn-locals* [(-> left :id :name) :tag])) 273 | rtag (if (= 'const (:op right)) 274 | (:tag right) 275 | (get-in @*fn-locals* [(-> right :id :name) :tag])) 276 | _ (assert (= ltag rtag) (str "Can't + values of different types " ltag " and " rtag))] 277 | {:op '+ 278 | :tag ltag 279 | :left left 280 | :right right 281 | :children [:left :right]})) 282 | 283 | (defmethod parse '= [[_ left right] env] 284 | (let [left (let [e (analyze left env)] 285 | (if (= 'id (:op e)) 286 | (parse-local e) 287 | e)) 288 | right (let [e (analyze right env)] 289 | (if (= 'id (:op e)) 290 | (parse-local e) 291 | e)) 292 | ltag (if (= 'const (:op left)) 293 | (:tag left) 294 | (get-in @*fn-locals* [(-> left :id :name) :tag])) 295 | rtag (if (= 'const (:op right)) 296 | (:tag right) 297 | (get-in @*fn-locals* [(-> right :id :name) :tag])) 298 | _ (assert (= ltag rtag) (str "Can't = values of different types " ltag " and " rtag))] 299 | {:op '= 300 | :tag ltag 301 | :left left 302 | :right right 303 | :children [:left :right]})) 304 | 305 | (defn add-types [& types] 306 | (let [tags (into #{} types)] 307 | (if (== 1 (count tags)) 308 | (first tags) 309 | tags))) 310 | 311 | (defmethod parse 'if [[_ test then else] env] 312 | (let [then (analyze then env) 313 | else (analyze else env) 314 | then-tag (:tag then) 315 | else-tag (:tag else) 316 | _ (assert (= then-tag else-tag) 317 | (str "Can't return different types from if expression " 318 | (or then-tag "nil") " and " (or else-tag "nil")))] 319 | {:op 'if 320 | :tag then-tag 321 | :test (analyze test env) 322 | :then then 323 | :else else 324 | :children [:test :then :else]})) 325 | 326 | (defmethod parse 'and [[_ left right] env] 327 | (let [left (analyze left env) 328 | right (analyze right env) 329 | ltag (:tag left) 330 | rtag (:tag right) 331 | _ (assert (= ltag rtag) (str "Can't `and` values of different types " ltag " and " rtag))] 332 | {:op 'and 333 | :tag ltag 334 | :left left 335 | :right right 336 | :children [:left :right]})) 337 | 338 | (defmethod parse 'do [[_ & body] env] 339 | (let [body (map #(analyze % env) body) 340 | tag (:tag (last body))] 341 | {:op 'block 342 | :tag tag 343 | :body body})) 344 | 345 | (defn parse-local-binding [[sym value] env] 346 | (let [id (parse-symbol sym) 347 | value (analyze value env) 348 | _ (->> (:tag value) 349 | (assoc id :tag) 350 | (swap! *fn-locals* assoc (:name id)))] 351 | {:op 'local-set 352 | :id id 353 | :value value})) 354 | 355 | (defmethod parse 'let [[_ bindings & let-body] env] 356 | (let [bindings (partition-all 2 bindings) 357 | _ (assert (== 2 (count (last bindings))) "let takes even number of forms") 358 | body (doall (map #(parse-local-binding % env) bindings)) 359 | let-body (map #(analyze % env) let-body) 360 | tag (-> let-body last :tag)] 361 | {:op 'block 362 | :tag tag 363 | :body (concat body let-body)})) 364 | 365 | (defmethod parse 'ns [[_ ns-name] env] 366 | {:op 'ns 367 | :name ns-name}) 368 | 369 | (defn parse-invoke [[s & args] env] 370 | (let [{tag :ret-tag fargs :args} (get-in @compiler-env [:defs s]) 371 | _ (assert (== (count args) (count fargs)) 372 | (str "Wrong number of args (" (count args) ") " 373 | "passed to: " s))] 374 | {:op 'invoke 375 | :name (parse-symbol s) 376 | :tag tag 377 | :args (map #(analyze % env) args) 378 | :children [:name :args]})) 379 | 380 | (defn parse-number [form] 381 | (let [tag (cond 382 | (int? form) 'i32 383 | (float? form) 'f64)] 384 | {:op 'const 385 | :tag tag 386 | :form form})) 387 | 388 | (defn parse-boolean [form] 389 | (if (true? form) 390 | (parse-number 1) 391 | (parse-number 0))) 392 | 393 | (defn parse-string [form] 394 | {:op 'const 395 | :tag 'string 396 | :form form}) 397 | 398 | (defn analyze-seq [form env] 399 | (cond 400 | (contains? specials (first form)) (parse form env) 401 | :else (parse-invoke form env))) 402 | 403 | (defn analyze [form env] 404 | (cond 405 | (list? form) (analyze-seq form env) 406 | (symbol? form) (parse-symbol form) 407 | (number? form) (parse-number form) 408 | (boolean? form) (parse-boolean form) 409 | (string? form) (parse-string form) 410 | :else form)) 411 | 412 | (defn compile-wasm [form] 413 | (binding [out #?(:clj (StringBuilder.) 414 | :cljs (StringBuffer.)) 415 | compiler-env (default-compiler-env)] 416 | (let [env (atom {:constants {}})] 417 | (emit (analyze form nil)) 418 | (.toString out)))) 419 | --------------------------------------------------------------------------------