finally correctly wire up all the things?

build/driver.cpp

@@ -9,7 +9,6 @@ using std::string;
 
 // set all our exported Janet functions as null pointers
 static JanetFunction *janet_ludus = NULL;
-static JanetFunction *janet_hello = NULL;
 
 // these let us look up functions
 Janet env_lookup(JanetTable *env, const char *name) {
@@ -65,14 +64,6 @@ unsigned char *read_file(const char *filename, size_t *length) {
   return src;
 }
 
-// these are the C++ functions that wrap our Janet functions
-// simplest case: takes nothing, returns nothing
-void hello() {
-  Janet result; // we need a place to put the result
-  // args are: fn ptr, argc, argv, result
-  call_fn(janet_hello, 0, {}, &result);
-}
-
 // finally, getting a string back
 // this is our result type
 struct StringResult {
@@ -123,9 +114,6 @@ int main() {
   // no namespacing
   janet_ludus = env_lookup_function(janet_unwrap_table(env), "ludus");
   janet_gcroot(janet_wrap_function(janet_ludus));
-
-  janet_hello = env_lookup_function(janet_unwrap_table(env), "hello");
-  janet_gcroot(janet_wrap_function(janet_hello));
 }
 
 // these bindings are exported into javascript
@@ -134,7 +122,6 @@ EMSCRIPTEN_BINDINGS(module) {
 
   // these are the functions that will be available
   function("ludus", &ludus, allow_raw_pointers());
-  function("hello", &hello, allow_raw_pointers());
 
   // we also want a wrapper for our StringResult
   // we won't access it directly, but emcc makes it nice

build/out.mjs

@@ -6489,7 +6489,7 @@ var __emscripten_stack_alloc = (a0) => (__emscripten_stack_alloc = wasmExports['
 var _emscripten_stack_get_current = () => (_emscripten_stack_get_current = wasmExports['emscripten_stack_get_current'])();
 var ___cxa_is_pointer_type = createExportWrapper('__cxa_is_pointer_type', 1);
 var dynCall_jiji = Module['dynCall_jiji'] = createExportWrapper('dynCall_jiji', 5);
-var ___emscripten_embedded_file_data = Module['___emscripten_embedded_file_data'] = 1783292;
+var ___emscripten_embedded_file_data = Module['___emscripten_embedded_file_data'] = 1787652;
 function invoke_i(index) {
   var sp = stackSave();
   try {

build/test.mjs

@@ -1,11 +1,5 @@
-console.log("Starting wasm test run.")
+import {run} from "./ludus.mjs"
 
-import init from "./out.mjs"
+console.log("Imported ludus wasm")
 
-console.log("Imported module")
+console.log(run(`print! ("hello, world!")`))
-
-const mod = await init()
-
-console.log("Initted module")
-
-console.log(mod.ludus(":hello_from_ludus").value)

src/base.janet

@@ -8,6 +8,7 @@
 (defn ludus/or [& args] (some bool args))
 
 (defn ludus/type [value]
+  (when (= :^nil value) (break :nil))
   (def typed? (when (dictionary? value) (value :^type)))
   (def the-type (if typed? typed? (type value)))
   (case the-type
@@ -63,11 +64,11 @@
   (case (ludus/type x)
     :nil "nil"
     :string (string "\"" x "\"")
-    :tuple (string "(" (stringify x) ")")
+    :tuple (string "(" (string/join (map show x)) ")")
-    :list (string "[" (stringify x) "]")
+    :list (string "[" (string/join (map show x)) "]")
-    :dict (string "#{" (stringify x) "}")
+    :dict (string "#{" (string/join (map show x)) "}")
-    :set (string "${" (stringify x) "}")
+    :set (string "${" (string/join (map show (keys x))) "}")
-    :box (string "box " (x :name) " [ " (stringify x) " ]")
+    :box (string "box " (x :name) " [ " (show x) " ]")
     :pkg (show-pkg x)
     (stringify x)))
 
@@ -82,9 +83,9 @@
 
 (defn- json* [x]
   (case (ludus/type x)
-    :nil "null"
+    :nil "\"null\""
     :number (string x)
-    :bool (if true "true" "false")
+    :bool (if true "\"true\"" "\"false\"")
     :string (string "\"" x "\"")
     :keyword (string "\"" x "\"")
     :tuple (string "[" (string/join (map json x) ", ") "]")
@@ -187,8 +188,13 @@
     :set (-> x (dissoc :^type) keys)
     @[x]))
 
+(defn showprint [x]
+  (if (= :string (ludus/type x))
+    x
+    (show x)))
+
 (defn print! [args]
-  (print ;(map show args)))
+  (print ;(map showprint args)))
 
 (defn prn [x]
   (pp x)

src/json.janet

@@ -0,0 +1,131 @@
+# pulled from cfiggers/jayson
+
+(defmacro- letv [bindings & body]
+  ~(do ,;(seq [[k v] :in (partition 2 bindings)] ['var k v]) ,;body))
+
+(defn- read-hex [n] 
+    (scan-number (string "0x" n)))
+
+(defn- check-utf-16 [capture]
+  (let [u (read-hex capture)]
+    (if (and (>= u 0xD800)
+             (<= u 0xDBFF))
+      capture 
+      false)))
+
+(def- utf-8->bytes 
+  (peg/compile
+   ~{:double-u-esc (/ (* "\\u" (cmt (<- 4) ,|(check-utf-16 $)) "\\u" (<- 4))
+                      ,|(+ (blshift (- (read-hex $0) 0xD800) 10)
+                           (- (read-hex $1) 0xDC00) 0x10000))
+     :single-u-esc (/ (* "\\u" (<- 4)) ,|(read-hex $))
+     :unicode-esc  (/ (+ :double-u-esc :single-u-esc)
+                      ,|(string/from-bytes
+                         ;(cond
+                           (<= $ 0x7f) [$]
+                           (<= $ 0x7ff)
+                           [(bor (band (brshift $  6) 0x1F) 0xC0)
+                            (bor (band (brshift $  0) 0x3F) 0x80)]
+                           (<= $ 0xffff)
+                           [(bor (band (brshift $ 12) 0x0F) 0xE0)
+                            (bor (band (brshift $  6) 0x3F) 0x80)
+                            (bor (band (brshift $  0) 0x3F) 0x80)]
+                             # Otherwise
+                           [(bor (band (brshift $ 18) 0x07) 0xF0)
+                            (bor (band (brshift $ 12) 0x3F) 0x80)
+                            (bor (band (brshift $  6) 0x3F) 0x80)
+                            (bor (band (brshift $  0) 0x3F) 0x80)])))
+     :escape       (/ (* "\\" (<- (set "avbnfrt\"\\/")))
+                      ,|(get {"a" "\a" "v" "\v" "b" "\b"
+                              "n" "\n" "f" "\f" "r" "\r"
+                              "t" "\t"} $ $))
+     :main         (+ (some (+ :unicode-esc :escape (<- 1))) -1)}))
+
+(defn decode 
+  ``
+  Returns a janet object after parsing JSON. If `keywords` is truthy,
+  string keys will be converted to keywords. If `nils` is truthy, `null`
+  will become `nil` instead of the keyword `:json/null`.
+  ``
+  [json-source &opt keywords nils] 
+
+  (def json-parser 
+    {:null (if nils
+             ~(/ (<- (+ "null" "Null")) nil)
+             ~(/ (<- (+ "null" "Null")) :json/null))
+     :bool-t ~(/ (<- (+ "true")) true)
+     :bool-f ~(/ (<- (+ "false")) false)
+     :number ~(/ (<- (* (? "-") :d+ (? (* "." :d+)))) ,|(scan-number $))
+     :string ~(/ (* "\"" (<- (to (* (> -1 (not "\\")) "\"")))
+                    (* (> -1 (not "\\")) "\""))
+                 ,|(string/join (peg/match utf-8->bytes $))) 
+     :array ~(/ (* "[" :s* (? (* :value (any (* :s* "," :value)))) "]") ,|(array ;$&))
+     :key-value (if keywords
+                  ~(* :s* (/ :string ,|(keyword $)) :s* ":" :value)
+                  ~(* :s* :string :s* ":" :value))
+     :object ~(/ (* "{" :s* (? (* :key-value (any (* :s* "," :key-value)))) "}")
+                 ,|(from-pairs (partition 2 $&)))
+     :value ~(* :s* (+ :null :bool-t :bool-f :number :string :array :object) :s*)
+     :unmatched ~(/ (<- (to (+ :value -1))) ,|[:unmatched $])
+     :main ~(some (+ :value "\n" :unmatched))})
+  
+  (first (peg/match (peg/compile json-parser) json-source)))
+
+(def- bytes->utf-8
+  (peg/compile
+   ~{:four-byte  (/ (* (<- (range "\xf0\xff")) (<- 1) (<- 1) (<- 1))
+                    ,|(bor (blshift (band (first $0) 0x07) 18)
+                           (blshift (band (first $1) 0x3F) 12)
+                           (blshift (band (first $2) 0x3F) 6)
+                           (blshift (band (first $3) 0x3F) 0)))
+     :three-byte (/ (* (<- (range "\xe0\xef")) (<- 1) (<- 1))
+                    ,|(bor (blshift (band (first $0) 0x0F) 12)
+                           (blshift (band (first $1) 0x3F) 6)
+                           (blshift (band (first $2) 0x3F) 0)))
+     :two-byte   (/ (* (<- (range "\x80\xdf")) (<- 1))
+                    ,|(bor (blshift (band (first $0) 0x1F) 6)
+                           (blshift (band (first $1) 0x3F) 0)))
+     :multi-byte (/ (+ :two-byte :three-byte :four-byte)
+                    ,|(if (< $ 0x10000) 
+                        (string/format "\\u%04X" $)
+                        (string/format "\\u%04X\\u%04X" 
+                                       (+ (brshift (- $ 0x10000) 10) 0xD800) 
+                                       (+ (band (- $ 0x10000) 0x3FF) 0xDC00))))
+     :one-byte   (<- (range "\x20\x7f"))
+     :0to31      (/ (<- (range "\0\x1F"))
+                    ,|(or ({"\a" "\\u0007" "\b" "\\u0008"
+                            "\t" "\\u0009" "\n" "\\u000A"
+                            "\v" "\\u000B" "\f" "\\u000C"
+                            "\r" "\\u000D"} $)
+                          (string/format "\\u%04X" (first $))))
+     :backslash  (/ (<- "\\") "\\\\")
+     :quote      (/ (<- "\"") "\\\"")
+     :main       (+ (some (+ :0to31 :backslash :quote :one-byte :multi-byte)) -1)}))
+
+(defn- encodeone [x depth]
+  (if (> depth 1024) (error "recurred too deeply"))
+  (cond
+    (= x :json/null) "null"
+    (= x nil) "null"
+    (bytes? x) (string "\"" (string/join (peg/match bytes->utf-8 x)) "\"")
+    (indexed? x) (string "[" (string/join (map |(encodeone $ (inc depth)) x) ",") "]")
+    (dictionary? x) (string "{" (string/join
+                                 (seq [[k v] :in (pairs x)]
+                                   (string "\"" (string/join (peg/match bytes->utf-8 k)) "\"" ":" (encodeone v (inc depth)))) ",") "}")
+    (case (type x)
+      :nil "null"
+      :boolean (string x)
+      :number (string x)
+      (error "type not supported"))))
+
+(defn encode 
+  `` 
+  Encodes a janet value in JSON (utf-8). If `buf` is provided, the formated 
+  JSON is append to `buf` instead of a new buffer. Returns the modifed buffer.
+  ``
+  [x &opt buf]
+  
+  (letv [ret (encodeone x 0)]
+        (if (and buf (buffer? buf))
+          (buffer/push ret)
+          (thaw ret))))

src/judge

@@ -1 +0,0 @@
-./jpm_tree/bin/judge

src/ludus.janet

@@ -9,6 +9,7 @@
 (import /src/errors :as e)
 (import /src/base :as b)
 (import /src/prelude :as prelude)
+(import /src/json :as j)
 
 (defn ludus [source]
  (when (= :error prelude/pkg) (error "could not load prelude"))
@@ -50,5 +51,6 @@
   (set post (i/interpret prelude/post/ast ctx))
   ([err] (e/runtime-error err)))
  (set (out :draw) (post :draw))
- (b/json out))
+ (string (j/encode out)))
+