twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

finally correctly wire up all the things?

Browse Source
This commit is contained in:
Scott Richmond 2024-06-07 13:42:11 -04:00
parent ed762c6079
commit 77b76430c1
13 changed files with 152 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
build/driver.cpp
View File

@ -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

BIN
build/ludus.jimage
View File

Binary file not shown.

2
build/out.mjs
View File

@ -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 {

BIN
build/out.wasm
View File

Binary file not shown.

12
build/test.mjs
View File

@ -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!")`))

22
src/base.janet
View File

@ -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)

131
src/json.janet Normal file
View File

@ -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))))

1
src/judge
View File

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

4
src/ludus.janet
View File

@ -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)))

0
src/judgy.fish → test/judgy.fish
View File

0
src/language.test.janet → test/language.test.janet
View File

0
src/prelude.test.janet → test/prelude.test.janet
View File

0
src/watchy.fish → test/watchy.fish
View File