Initial commit

Author: vshymanskyy

.gitignore

@@ -0,0 +1,5 @@
+# Logs
+*.log
+
+# Dependency directories
+node_modules/

package.json

@@ -0,0 +1,20 @@
+{
+  "name": "wasm-run",
+  "version": "0.1.0",
+  "description": "Run arbitrary WASM/WASI files",
+  "author": "Volodymyr Shymanskyy",
+  "main": "wasm-run.js",
+  "license": "MIT",
+  "scripts": {
+    "test": "echo \"Error: no test specified\" && exit 1"
+  },
+  "bin": {
+    "wasm-run": "wasm-run.js"
+  },
+  "dependencies": {
+    "binaryen": "^101.0.0",
+    "chalk": "^4.1.1",
+    "restructure": "^0.5.4",
+    "yargs": "^16.2.0"
+  }
+}

test/fib32.wasm

@@ -0,0 +1,30 @@
+(module
+ (export "fib" (func $fib))   ;; fib exported function
+ (func $fib (param $n i32) (result i32)
+  (if
+   (i32.lt_u
+    (get_local $n)
+    (i32.const 2)
+   )
+   (return
+    (get_local $n)
+   )
+  )
+  (return
+   (i32.add
+    (call $fib
+     (i32.sub
+      (get_local $n)
+      (i32.const 2)
+     )
+    )
+    (call $fib
+     (i32.sub
+      (get_local $n)
+      (i32.const 1)
+     )
+    )
+   )
+  )
+ )
+)

test/fib32.wat

@@ -0,0 +1,72 @@
+(def! _macro? (fn* [x]
+  (if (map? x)
+    (contains? x :__MAL_MACRO__)
+    false)))
+
+(def! core_ns
+  [['= =]
+   ['throw throw]
+   ['nil? nil?]
+   ['true? true?]
+   ['false? false?]
+   ['number? number?]
+   ['string? string?]
+   ['symbol symbol]
+   ['symbol? symbol?]
+   ['keyword keyword]
+   ['keyword? keyword?]
+   ['fn? fn?]
+   ['macro? _macro?]
+
+   ['pr-str pr-str]
+   ['str str]
+   ['prn prn]
+   ['println println]
+   ['readline readline]
+   ['read-string read-string]
+   ['slurp slurp]
+   ['< <]
+   ['<= <=]
+   ['> >]
+   ['>= >=]
+   ['+ +]
+   ['- -]
+   ['* *]
+   ['/ /]
+   ['time-ms time-ms]
+
+   ['list list]
+   ['list? list?]
+   ['vector vector]
+   ['vector? vector?]
+   ['hash-map hash-map]
+   ['map? map?]
+   ['assoc assoc]
+   ['dissoc dissoc]
+   ['get get]
+   ['contains? contains?]
+   ['keys keys]
+   ['vals vals]
+
+   ['sequential? sequential?]
+   ['cons cons]
+   ['concat concat]
+   ['vec vec]
+   ['nth nth]
+   ['first first]
+   ['rest rest]
+   ['empty? empty?]
+   ['count count]
+   ['apply apply]
+   ['map map]
+
+   ['conj conj]
+   ['seq seq]
+
+   ['with-meta with-meta]
+   ['meta meta]
+   ['atom atom]
+   ['atom? atom?]
+   ['deref deref]
+   ['reset! reset!]
+   ['swap! swap!]])

test/fib64.wasm

@@ -0,0 +1,34 @@
+(def! bind-env (fn* [env b e]
+  (if (empty? b)
+    env
+    (let* [b0 (first b)]
+      (if (= '& b0)
+        (assoc env (str (nth b 1)) e)
+        (bind-env (assoc env (str b0) (first e)) (rest b) (rest e)))))))
+
+(def! new-env (fn* [& args]
+  (if (<= (count args) 1)
+    (atom {:outer (first args)})
+    (atom (apply bind-env {:outer (first args)} (rest args))))))
+
+(def! env-find (fn* [env k]
+  (env-find-str env (str k))))
+
+(def! env-find-str (fn* [env ks]
+  (if env
+    (let* [data @env]
+      (if (contains? data ks)
+        env
+        (env-find-str (get data :outer) ks))))))
+
+(def! env-get (fn* [env k]
+  (let* [ks (str k)
+         e (env-find-str env ks)]
+    (if e
+      (get @e ks)
+      (throw (str "'" ks "' not found"))))))
+
+(def! env-set (fn* [env k v]
+  (do
+    (swap! env assoc (str k) v)
+    v)))

test/mal/core.mal

@@ -0,0 +1,8 @@
+;; Compute a Fibonacci number with two recursions.
+(def! fib
+  (fn* [n]                              ; non-negative number
+    (if (<= n 1)
+      n
+      (+ (fib (- n 1)) (fib (- n 2))))))
+
+(println (fib (read-string (first *ARGV*))))

test/mal/env.mal

@@ -0,0 +1,152 @@
+(load-file "./env.mal")
+(load-file "./core.mal")
+
+;; read
+(def! READ read-string)
+
+
+;; eval
+
+(def! qq-loop (fn* [elt acc]
+  (if (if (list? elt) (= (first elt) 'splice-unquote)) ; 2nd 'if' means 'and'
+    (list 'concat (nth elt 1) acc)
+    (list 'cons (QUASIQUOTE elt) acc))))
+(def! qq-foldr (fn* [xs]
+  (if (empty? xs)
+    (list)
+    (qq-loop (first xs) (qq-foldr (rest xs))))))
+(def! QUASIQUOTE (fn* [ast]
+  (cond
+    (vector? ast)            (list 'vec (qq-foldr ast))
+    (map? ast)               (list 'quote ast)
+    (symbol? ast)            (list 'quote ast)
+    (not (list? ast))        ast
+    (= (first ast) 'unquote) (nth ast 1)
+    "else"                   (qq-foldr ast))))
+
+(def! MACROEXPAND (fn* [ast env]
+  (let* [a0 (if (list? ast) (first ast))
+         e  (if (symbol? a0) (env-find env a0))
+         m  (if e (env-get e a0))]
+    (if (_macro? m)
+      (MACROEXPAND (apply (get m :__MAL_MACRO__) (rest ast)) env)
+      ast))))
+
+(def! eval-ast (fn* [ast env]
+  ;; (do (prn "eval-ast" ast "/" (keys env)) )
+  (cond
+    (symbol? ast) (env-get env ast)
+
+    (list? ast)   (map (fn* [exp] (EVAL exp env)) ast)
+
+    (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast))
+
+    (map? ast)    (apply hash-map
+                    (apply concat
+                      (map (fn* [k] [k (EVAL (get ast k) env)])
+                           (keys ast))))
+
+    "else"        ast)))
+
+(def! LET (fn* [env binds form]
+  (if (empty? binds)
+    (EVAL form env)
+    (do
+      (env-set env (first binds) (EVAL (nth binds 1) env))
+      (LET env (rest (rest binds)) form)))))
+
+(def! EVAL (fn* [ast env]
+  ;; (do (prn "EVAL" ast "/" (keys @env)) )
+  (let* [ast (MACROEXPAND ast env)]
+    (if (not (list? ast))
+      (eval-ast ast env)
+
+      ;; apply list
+      (let* [a0 (first ast)]
+        (cond
+          (empty? ast)
+          ast
+
+          (= 'def! a0)
+          (env-set env (nth ast 1) (EVAL (nth ast 2) env))
+
+          (= 'let* a0)
+          (LET (new-env env) (nth ast 1) (nth ast 2))
+
+          (= 'quote a0)
+          (nth ast 1)
+
+          (= 'quasiquoteexpand a0)
+          (QUASIQUOTE (nth ast 1))
+
+          (= 'quasiquote a0)
+          (EVAL (QUASIQUOTE (nth ast 1)) env)
+
+          (= 'defmacro! a0)
+          (env-set env (nth ast 1) (hash-map :__MAL_MACRO__
+                                             (EVAL (nth ast 2) env)))
+
+          (= 'macroexpand a0)
+          (MACROEXPAND (nth ast 1) env)
+
+          (= 'try* a0)
+          (if (< (count ast) 3)
+            (EVAL (nth ast 1) env)
+            (try*
+              (EVAL (nth ast 1) env)
+              (catch* exc
+                (let* [a2 (nth ast 2)]
+                  (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))
+
+          (= 'do a0)
+          (let* [el (eval-ast (rest ast) env)]
+            (nth el (- (count el) 1)))
+
+          (= 'if a0)
+          (if (EVAL (nth ast 1) env)
+            (EVAL (nth ast 2) env)
+            (if (> (count ast) 3)
+              (EVAL (nth ast 3) env)))
+
+          (= 'fn* a0)
+          (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args)))
+
+          "else"
+          (let* [el (eval-ast ast env)]
+            (apply (first el) (rest el)))))))))
+
+
+;; print
+(def! PRINT pr-str)
+
+;; repl
+(def! repl-env (new-env))
+(def! rep (fn* [strng]
+  (PRINT (EVAL (READ strng) repl-env))))
+
+;; core.mal: defined directly using mal
+(map (fn* [data] (apply env-set repl-env data)) core_ns)
+(env-set repl-env 'eval (fn* [ast] (EVAL ast repl-env)))
+(env-set repl-env '*ARGV* (rest *ARGV*))
+
+;; core.mal: defined using the new language itself
+(rep (str "(def! *host-language* \"" *host-language* "-mal\")"))
+(rep "(def! not (fn* [a] (if a false true)))")
+(rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))")
+(rep "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))")
+
+;; repl loop
+(def! repl-loop (fn* [line]
+  (if line
+    (do
+      (if (not (= "" line))
+        (try*
+          (println (rep line))
+          (catch* exc
+            (println "Uncaught exception:" exc))))
+      (repl-loop (readline "mal-user> "))))))
+
+;; main
+(if (empty? *ARGV*)
+  (repl-loop "(println (str \"Mal [\" *host-language* \"]\"))")
+  (rep (str "(load-file \"" (first *ARGV*) "\")")))

test/mal/mal-fib.mal

@@ -0,0 +1,18 @@
+(module
+  (type $t0 (func (param i32 i32) (result i32 i32)))
+  (type $t1 (func (param i64 i64) (result i64 i64)))
+  (type $t2 (func (param f32 f32) (result f32 f32)))
+  (type $t3 (func (param f64 f64) (result f64 f64)))
+  (func $swap_i32 (export "swap_i32") (type $t0) (param $p0 i32) (param $p1 i32) (result i32 i32)
+    (local.get $p1)
+    (local.get $p0))
+  (func $swap_i64 (export "swap_i64") (type $t1) (param $p0 i64) (param $p1 i64) (result i64 i64)
+    (local.get $p1)
+    (local.get $p0))
+  (func $swap_f32 (export "swap_f32") (type $t2) (param $p0 f32) (param $p1 f32) (result f32 f32)
+    (local.get $p1)
+    (local.get $p0))
+  (func $swap_f64 (export "swap_f64") (type $t3) (param $p0 f64) (param $p1 f64) (result f64 f64)
+    (local.get $p1)
+    (local.get $p0))
+)