diff --git a/build/driver.cpp b/build/driver.cpp index 83dff79..3d193d8 100644 --- a/build/driver.cpp +++ b/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 diff --git a/build/ludus.jimage b/build/ludus.jimage index 4edde6c..eecfcee 100644 Binary files a/build/ludus.jimage and b/build/ludus.jimage differ diff --git a/build/out.mjs b/build/out.mjs index 6a1c944..59fe60c 100644 --- a/build/out.mjs +++ b/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 { diff --git a/build/out.wasm b/build/out.wasm index 542374a..c02cb9e 100755 Binary files a/build/out.wasm and b/build/out.wasm differ diff --git a/build/test.mjs b/build/test.mjs index f483a8c..95197e7 100644 --- a/build/test.mjs +++ b/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") - -const mod = await init() - -console.log("Initted module") - -console.log(mod.ludus(":hello_from_ludus").value) +console.log(run(`print! ("hello, world!")`)) diff --git a/src/base.janet b/src/base.janet index 063bdbd..4645a96 100644 --- a/src/base.janet +++ b/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) ")") - :list (string "[" (stringify x) "]") - :dict (string "#{" (stringify x) "}") - :set (string "${" (stringify x) "}") - :box (string "box " (x :name) " [ " (stringify x) " ]") + :tuple (string "(" (string/join (map show x)) ")") + :list (string "[" (string/join (map show x)) "]") + :dict (string "#{" (string/join (map show x)) "}") + :set (string "${" (string/join (map show (keys 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) diff --git a/src/json.janet b/src/json.janet new file mode 100644 index 0000000..534edf3 --- /dev/null +++ b/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)))) diff --git a/src/judge b/src/judge deleted file mode 120000 index 1ececd9..0000000 --- a/src/judge +++ /dev/null @@ -1 +0,0 @@ -./jpm_tree/bin/judge \ No newline at end of file diff --git a/src/ludus.janet b/src/ludus.janet index 02991e3..928be28 100644 --- a/src/ludus.janet +++ b/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))) + diff --git a/src/judgy.fish b/test/judgy.fish similarity index 100% rename from src/judgy.fish rename to test/judgy.fish diff --git a/src/language.test.janet b/test/language.test.janet similarity index 100% rename from src/language.test.janet rename to test/language.test.janet diff --git a/src/prelude.test.janet b/test/prelude.test.janet similarity index 100% rename from src/prelude.test.janet rename to test/prelude.test.janet diff --git a/src/watchy.fish b/test/watchy.fish similarity index 100% rename from src/watchy.fish rename to test/watchy.fish