mirrors
/
janet
mirror of https://github.com/janet-lang/janet
1
0
Fork 0
Code Issues 1 Releases Wiki Activity

Allow marshaling of more functions for core. 

Fix indentation in some files.
This commit is contained in:
Calvin Rose 2018-08-22 21:41:25 -04:00
parent 50aefc8865
commit 510feeed7f
14 changed files with 234 additions and 193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@ -32,8 +32,8 @@ BINDIR=$(PREFIX)/bin
# TODO - when api is finalized, only export public symbols instead of using rdynamic
# which exports all symbols. Saves a few KB in binary.
#CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -g
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -g
#CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden
CLIBS=-lm -ldl
PREFIX=/usr/local
DST_TARGET=dst

24
examples/3sum.dst
View File

@ -1,13 +1,13 @@
(defn sum3
"Solve the 3SUM problem in O(n^2) time."
[s]
(def tab @{})
(def solutions @{})
(def len (length s))
(loop [k :range [0 len]]
(put tab (get s k) k))
(loop [i :range [0 len], j :range [0 len]]
(def k (get tab (- 0 (get s i) (get s j))))
(when (and k (not= k i) (not= k j) (not= i j))
(put solutions {i true j true k true} true)))
(map keys (keys solution)))
"Solve the 3SUM problem in O(n^2) time."
[s]
(def tab @{})
(def solutions @{})
(def len (length s))
(loop [k :range [0 len]]
(put tab (get s k) k))
(loop [i :range [0 len], j :range [0 len]]
(def k (get tab (- 0 (get s i) (get s j))))
(when (and k (not= k i) (not= k j) (not= i j))
(put solutions {i true j true k true} true)))
(map keys (keys solution)))

20
examples/fizzbuzz.dst
View File

@ -1,13 +1,13 @@
# A simple fizz buzz example
(defn fizzbuzz
"Prints the fizzbuzz problem."
[]
(loop [i :range [1 101]]
(let [fizz (zero? (% i 3))
buzz (zero? (% i 5))]
(print (cond
(and fizz buzz) "fizzbuzz"
fizz "fizz"
buzz "buzz"
i)))))
"Prints the fizzbuzz problem."
[]
(loop [i :range [1 101]]
(let [fizz (zero? (% i 3))
buzz (zero? (% i 5))]
(print (cond
(and fizz buzz) "fizzbuzz"
fizz "fizz"
buzz "buzz"
i)))))

146
examples/iterators.dst
View File

@ -5,105 +5,103 @@
###
(def iter (do
(defn array-iter [x]
(def len (length x))
(var i 0)
{
:more (fn [] (< i len))
:next (fn []
(def ret (get x i))
(:= i (+ i 1))
ret)
})
(def iters {
:array array-iter
:tuple array-iter
:struct identity})
(fn [x]
(def makei (get iters (type x)))
(if makei (makei x) (error "expected sequence")))))
(defn array-iter [x]
(def len (length x))
(var i 0)
{:more (fn [] (< i len))
:next (fn []
(def ret (get x i))
(:= i (+ i 1))
ret)})
(def iters {
:array array-iter
:tuple array-iter
:struct identity})
(fn [x]
(def makei (get iters (type x)))
(if makei (makei x) (error "expected sequence")))))
(defn range2 [bottom top]
(var i bottom)
{
:more (fn [] (< i top))
:next (fn []
(def ret i)
(:= i (+ i 1))
ret)
})
:more (fn [] (< i top))
:next (fn []
(def ret i)
(:= i (+ i 1))
ret)
})
(defn range [top] (range2 0 top))
(defn doiter [itr]
(def {:more more :next next} (iter itr))
(while (more) (next)))
(def {:more more :next next} (iter itr))
(while (more) (next)))
(defn foreach [itr f]
(def {:more more :next next} (iter itr))
(while (more) (f (next))))
(def {:more more :next next} (iter itr))
(while (more) (f (next))))
(defn iter2array [itr]
(def {:more more :next next} (iter itr))
(def a @[])
(while (more) (array.push a (next)))
a)
(def {:more more :next next} (iter itr))
(def a @[])
(while (more) (array.push a (next)))
a)
(defn map [f itr]
(def {:more more :next next} (iter itr))
{:more more :next (fn [] (f (next)))})
(def {:more more :next next} (iter itr))
{:more more :next (fn [] (f (next)))})
(defn reduce [f start itr]
(def itr (iter itr))
(def {:more more :next next} itr)
(if (more)
(reduce f (f start (next)) itr)
start))
(reduce f (f start (next)) itr)
start))
(defn filter [pred itr]
(def itr (iter itr))
(def {:more more :next next} itr)
(var alive true)
(var temp nil)
(var isnew true)
(defn nextgood []
(if alive
(if (more)
(do
(def n (next))
(if (pred n) n (nextgood)))
(:= alive false))))
(defn nnext [] (def ret temp) (:= temp (nextgood)) ret)
(defn nmore [] (when isnew (:= isnew false) (nnext)) alive)
{:more nmore :next nnext})
(def itr (iter itr))
(def {:more more :next next} itr)
(var alive true)
(var temp nil)
(var isnew true)
(defn nextgood []
(if alive
(if (more)
(do
(def n (next))
(if (pred n) n (nextgood)))
(:= alive false))))
(defn nnext [] (def ret temp) (:= temp (nextgood)) ret)
(defn nmore [] (when isnew (:= isnew false) (nnext)) alive)
{:more nmore :next nnext})
(defn pairs [x]
(var lastkey (next x nil))
{
:more (fn [] lastkey)
:next (fn []
(def ret (tuple lastkey (get x lastkey)))
(:= lastkey (next x lastkey))
ret)
})
(var lastkey (next x nil))
{
:more (fn [] lastkey)
:next (fn []
(def ret (tuple lastkey (get x lastkey)))
(:= lastkey (next x lastkey))
ret)
})
(defn keys [x]
(var lastkey (next x nil))
{
:more (fn [] lastkey)
:next (fn []
(def ret lastkey)
(:= lastkey (next x lastkey))
ret)
})
(var lastkey (next x nil))
{
:more (fn [] lastkey)
:next (fn []
(def ret lastkey)
(:= lastkey (next x lastkey))
ret)
})
(defn values [x]
(var lastkey (next x nil))
{
:more (fn [] lastkey)
:next (fn []
(def ret (get x lastkey))
(:= lastkey (next x lastkey))
ret)
})
(var lastkey (next x nil))
{
:more (fn [] lastkey)
:next (fn []
(def ret (get x lastkey))
(:= lastkey (next x lastkey))
ret)
})

16
examples/maxtriangle.dst
View File

@ -1,6 +1,6 @@
# Find the maximum path from the top (root)
# of the triangle to the leaves of the triangle.
(defn myfold [xs ys]
(let [xs1 (tuple.prepend xs 0)
xs2 (tuple.append xs 0)
@ -9,16 +9,16 @@
(map max m1 m2)))
(defn maxpath [t]
(extreme > (reduce myfold () t)))
(extreme > (reduce myfold () t)))
# Test it
# Maximum path is 3 -> 10 -> 3 -> 9 for a total of 25
(def triangle '[
[3]
[7 10]
[4 3 7]
[8 9 1 3]
])
(def triangle
'[[3]
[7 10]
[4 3 7]
[8 9 1 3]
])
(print (maxpath triangle))

22
examples/primes.dst
View File

@ -1,14 +1,14 @@
# Return an array of primes. This is a trivial and extremely naive algorithm.
(defn primes
"Returns a list of prime numbers less than n."
[n]
(def list @[])
(loop [i :range [2 n]]
(var isprime? true)
(def len (length list))
(loop [j :range [0 len]]
(def trial (get list j))
(if (zero? (% i trial)) (:= isprime? false)))
(if isprime? (array.push list i)))
list)
"Returns a list of prime numbers less than n."
[n]
(def list @[])
(loop [i :range [2 n]]
(var isprime? true)
(def len (length list))
(loop [j :range [0 len]]
(def trial (get list j))
(if (zero? (% i trial)) (:= isprime? false)))
(if isprime? (array.push list i)))
list)

11
src/core/io.c
View File

@ -370,21 +370,26 @@ static const DstReg cfuns[] = {
{NULL, NULL}
};
static void addf(DstTable *env, const char *name, Dst val) {
dst_env_def(env, name, val);
dst_register(name, val);
}
/* Module entry point */
int dst_lib_io(DstArgs args) {
DstTable *env = dst_env_arg(args);
dst_env_cfuns(env, cfuns);
/* stdout */
dst_env_def(env, "stdout",
addf(env, "stdout",
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE));
/* stderr */
dst_env_def(env, "stderr",
addf(env, "stderr",
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE));
/* stdin */
dst_env_def(env, "stdin",
addf(env, "stdin",
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE));
return 0;

170
src/core/marsh.c
View File

@ -41,6 +41,7 @@ enum {
MR_STACKOVERFLOW,
MR_NYI,
MR_NRV,
MR_C_STACKFRAME,
MR_OVERFLOW
} MarshalResult;
@ -49,6 +50,7 @@ const char *mr_strings[] = {
"stack overflow",
"type NYI",
"no registry value",
"fiber has c stack frame",
"buffer overflow"
};
@ -104,6 +106,8 @@ static void marshal_one(MarshalState *st, Dst x, int flags);
/* Marshal a function env */
static void marshal_one_env(MarshalState *st, DstFuncEnv *env, int flags) {
if ((flags & 0xFFFF) > DST_RECURSION_GUARD)
longjmp(st->err, MR_STACKOVERFLOW);
for (int32_t i = 0; i < dst_v_count(st->seen_envs); i++) {
if (st->seen_envs[i] == env) {
pushbyte(st, LB_FUNCENV_REF);
@ -114,7 +118,7 @@ static void marshal_one_env(MarshalState *st, DstFuncEnv *env, int flags) {
dst_v_push(st->seen_envs, env);
pushint(st, env->offset);
pushint(st, env->length);
if (env->offset >= 0) {
if (env->offset) {
/* On stack variant */
marshal_one(st, dst_wrap_fiber(env->as.fiber), flags);
} else {
@ -135,6 +139,8 @@ static void dst_func_addflags(DstFuncDef *def) {
/* Marshal a function def */
static void marshal_one_def(MarshalState *st, DstFuncDef *def, int flags) {
if ((flags & 0xFFFF) > DST_RECURSION_GUARD)
longjmp(st->err, MR_STACKOVERFLOW);
for (int32_t i = 0; i < dst_v_count(st->seen_defs); i++) {
if (st->seen_defs[i] == def) {
pushbyte(st, LB_FUNCDEF_REF);
@ -189,13 +195,51 @@ static void marshal_one_def(MarshalState *st, DstFuncDef *def, int flags) {
}
}
#define DST_FIBER_FLAG_HASCHILD (1 << 29)
#define DST_STACKFRAME_HASENV 2
/* Marshal a fiber */
static void marshal_one_fiber(MarshalState *st, DstFiber *fiber, int flags) {
if ((flags & 0xFFFF) > DST_RECURSION_GUARD)
longjmp(st->err, MR_STACKOVERFLOW);
if (fiber->child) fiber->flags |= DST_FIBER_FLAG_HASCHILD;
dst_table_put(&st->seen, dst_wrap_fiber(fiber), dst_wrap_integer(st->nextid++));
pushint(st, fiber->flags);
pushint(st, fiber->frame);
pushint(st, fiber->stackstart);
pushint(st, fiber->stacktop);
pushint(st, fiber->maxstack);
marshal_one(st, dst_wrap_function(fiber->root), flags + 1);
/* Do frames */
int32_t i = fiber->frame;
int32_t j = fiber->stackstart - DST_FRAME_SIZE;
while (i > 0) {
DstStackFrame *frame = (DstStackFrame *)(fiber->data + i - DST_FRAME_SIZE);
if (frame->env) frame->flags |= DST_STACKFRAME_HASENV;
pushint(st, frame->flags);
pushint(st, frame->prevframe);
if (!frame->func) longjmp(st->err, MR_C_STACKFRAME);
int32_t pcdiff = frame->pc - frame->func->def->bytecode;
pushint(st, pcdiff);
marshal_one(st, dst_wrap_function(frame->func), flags + 1);
if (frame->env) marshal_one_env(st, frame->env, flags + 1);
/* Marshal all values in the stack frame */
for (int32_t k = i; k < j; k++)
marshal_one(st, fiber->data[k], flags + 1);
j = i - DST_FRAME_SIZE;
i = frame->prevframe;
}
if (fiber->child)
marshal_one_fiber(st, fiber->child, flags + 1);
fiber->flags &= ~DST_FIBER_FLAG_HASCHILD;
}
/* The main body of the marshaling function. Is the main
* entry point for the mutually recursive functions. */
static void marshal_one(MarshalState *st, Dst x, int flags) {
DstType type = dst_type(x);
if ((flags & 0xFFFF) > DST_RECURSION_GUARD) {
if ((flags & 0xFFFF) > DST_RECURSION_GUARD)
longjmp(st->err, MR_STACKOVERFLOW);
}
/* Check simple primitvies (non reference types, no benefit from memoization) */
switch (type) {
@ -351,53 +395,8 @@ static void marshal_one(MarshalState *st, Dst x, int flags) {
return;
case DST_FIBER:
{
/*
struct DstFiber {
Dst *data;
DstFiber *child;
DstFunction *root;
int32_t frame;
int32_t stackstart;
int32_t stacktop;
int32_t capacity;
int32_t maxstack;
int32_t flags;
};
*/
pushbyte(st, LB_FIBER);
DstFiber *fiber = dst_unwrap_fiber(x);
if (fiber->child) fiber->flags |= DST_FIBER_FLAG_HASCHILD;
MARK_SEEN();
pushint(st, fiber->flags);
pushint(st, fiber->frame);
pushint(st, fiber->stackstart);
pushint(st, fiber->stacktop);
pushint(st, fiber->maxstack);
marshal_one(st, dst_wrap_function(fiber->root), flags + 1);
/* Do frames */
int32_t i = fiber->frame;
int32_t j = fiber->stackstart - DST_FRAME_SIZE;
while (i > 0) {
pushint(st, j - i); /* Push number of stack values */
DstStackFrame *frame = (DstStackFrame *)(fiber->data + i - DST_FRAME_SIZE);
if (NULL != frame->func)
marshal_one(st, dst_wrap_function(frame->func), flags + 1);
else
pushbyte(st, LB_NIL);
if (NULL != frame->env)
marshal_one_env(st, frame->env, flags + 1);
else
pushbyte(st, LB_NIL);
/* Marshal all values in the stack frame */
for (int32_t k = i; k < j; k++)
marshal_one(st, fiber->data[k], flags + 1);
j = i - DST_FRAME_SIZE;
i = frame->prevframe;
}
if (fiber->child)
marshal_one(st, dst_wrap_fiber(fiber), flags + 1);
else
pushbyte(st, LB_NIL);
marshal_one_fiber(st, dst_unwrap_fiber(x), flags + 1);
}
return;
default:
@ -510,7 +509,7 @@ static const uint8_t *unmarshal_one_env(
dst_v_push(st->lookup_envs, env);
env->offset = readint(st, &data);
env->length = readint(st, &data);
if (env->offset >= 0) {
if (env->offset) {
/* On stack variant */
Dst fiberv;
data = unmarshal_one(st, data, &fiberv, flags);
@ -547,24 +546,37 @@ static const uint8_t *unmarshal_one_def(
longjmp(st->err, UMR_INVALID_REFERENCE);
*out = st->lookup_defs[index];
} else {
/* Initialize with values that will not break garbage collection
* if unmarshaling fails. */
DstFuncDef *def = dst_gcalloc(DST_MEMORY_FUNCDEF, sizeof(DstFuncDef));
def->environments_length = 0;
def->defs_length = 0;
def->constants_length = 0;
def->bytecode_length = 0;
def->name = NULL;
def->source = NULL;
dst_v_push(st->lookup_defs, def);
/* Set default lengths to zero */
int32_t bytecode_length = 0;
int32_t constants_length = 0;
int32_t environments_length = 0;
int32_t defs_length = 0;
/* Read flags and other fixed values */
def->flags = readint(st, &data);
def->slotcount = readint(st, &data);
def->arity = readint(st, &data);
def->constants_length = readint(st, &data);
def->bytecode_length = readint(st, &data);
/* Read some lengths */
constants_length = readint(st, &data);
bytecode_length = readint(st, &data);
if (def->flags & DST_FUNCDEF_FLAG_HASENVS)
def->environments_length = readint(st, &data);
environments_length = readint(st, &data);
if (def->flags & DST_FUNCDEF_FLAG_HASDEFS)
def->defs_length = readint(st, &data);
defs_length = readint(st, &data);
/* Check name and source (optional) */
if (def->flags & DST_FUNCDEF_FLAG_HASNAME) {
Dst x;
data = unmarshal_one(st, data, &x, flags + 1);
@ -579,26 +591,25 @@ static const uint8_t *unmarshal_one_def(
}
/* Unmarshal constants */
if (def->constants_length) {
def->constants = malloc(sizeof(Dst) * def->constants_length);
if (constants_length) {
def->constants = malloc(sizeof(Dst) * constants_length);
if (!def->constants) {
DST_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < def->constants_length; i++)
def->constants[i] = dst_wrap_nil();
for (int32_t i = 0; i < def->constants_length; i++)
for (int32_t i = 0; i < constants_length; i++)
data = unmarshal_one(st, data, def->constants + i, flags + 1);
} else {
def->constants = NULL;
}
def->constants_length = constants_length;
/* Unmarshal bytecode */
def->bytecode = malloc(sizeof(uint32_t) * def->bytecode_length);
def->bytecode = malloc(sizeof(uint32_t) * bytecode_length);
if (!def->bytecode) {
DST_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < def->bytecode_length; i++) {
if (data + 4 > st->end) longjmp(st->err, UMR_EOS);
for (int32_t i = 0; i < bytecode_length; i++) {
if (data + 4 > end) longjmp(st->err, UMR_EOS);
def->bytecode[i] =
(uint32_t)(data[0]) |
((uint32_t)(data[1]) << 8) |
@ -606,40 +617,43 @@ static const uint8_t *unmarshal_one_def(
((uint32_t)(data[3]) << 24);
data += 4;
}
def->bytecode_length = bytecode_length;
/* Unmarshal environments */
if (def->flags & DST_FUNCDEF_FLAG_HASENVS) {
def->environments = calloc(1, sizeof(int32_t) * def->environments_length);
def->environments = calloc(1, sizeof(int32_t) * environments_length);
if (!def->environments) {
DST_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < def->environments_length; i++) {
for (int32_t i = 0; i < environments_length; i++) {
def->environments[i] = readint(st, &data);
}
} else {
def->environments = NULL;
}
def->environments_length = environments_length;
/* Unmarshal sub funcdefs */
if (def->flags & DST_FUNCDEF_FLAG_HASDEFS) {
def->defs = calloc(1, sizeof(DstFuncDef *) * def->defs_length);
def->defs = calloc(1, sizeof(DstFuncDef *) * defs_length);
if (!def->defs) {
DST_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < def->defs_length; i++) {
for (int32_t i = 0; i < defs_length; i++) {
data = unmarshal_one_def(st, data, def->defs + i, flags + 1);
}
} else {
def->defs = NULL;
}
def->defs_length = defs_length;
/* Unmarshal source maps if needed */
if (def->flags & DST_FUNCDEF_FLAG_HASSOURCEMAP) {
def->sourcemap = malloc(sizeof(DstSourceMapping) * def->bytecode_length);
def->sourcemap = malloc(sizeof(DstSourceMapping) * bytecode_length);
if (!def->sourcemap) {
DST_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < def->bytecode_length; i++) {
for (int32_t i = 0; i < bytecode_length; i++) {
def->sourcemap[i].line = readint(st, &data);
def->sourcemap[i].column = readint(st, &data);
}
@ -656,6 +670,17 @@ static const uint8_t *unmarshal_one_def(
return data;
}
static const uint8_t *unmarshal_one_fiber(
UnmarshalState *st,
const uint8_t *data,
DstFiber **out,
int flags) {
longjmp(st->err, UMR_UNKNOWN);
(void) out;
(void) flags;
return data + 1;
}
static const uint8_t *unmarshal_one(
UnmarshalState *st,
const uint8_t *data,
@ -742,6 +767,13 @@ static const uint8_t *unmarshal_one(
dst_array_push(&st->lookup, *out);
return data + len;
}
case LB_FIBER:
{
DstFiber *fiber;
data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
*out = dst_wrap_fiber(fiber);
return data;
}
case LB_FUNCTION:
{
DstFunction *func;

2
src/core/parse.c
View File

@ -229,7 +229,7 @@ static int escape1(DstParser *p, DstParseState *state, uint8_t c) {
p->error = "invalid string escape sequence";
return 1;
}
if (c == 'h') {
if (c == 'x') {
state->qcount = 2;
state->argn = 0;
state->consumer = escapeh;

2
src/core/string.c
View File

@ -268,7 +268,7 @@ static void dst_escape_string_impl(uint8_t *buf, const uint8_t *str, int32_t len
default:
if (c < 32 || c > 127) {
buf[j++] = '\\';
buf[j++] = 'h';
buf[j++] = 'x';
buf[j++] = dst_base64[(c >> 4) & 0xF];
buf[j++] = dst_base64[c & 0xF];
} else {

6
src/core/util.c
View File

@ -137,6 +137,12 @@ const void *dst_strbinsearch(
return NULL;
}
void dst_register(const char *name, Dst value) {
Dst regkey = dst_cstringv(name);
dst_table_put(dst_vm_registry, regkey, value);
dst_table_put(dst_vm_registry, value, regkey);
}
/* Add a module definition */
void dst_env_def(DstTable *env, const char *name, Dst val) {
DstTable *subt = dst_table(1);

2
src/include/dst/dst.h
View File

@ -531,7 +531,6 @@ struct DstArgs {
/* Fiber flags */
#define DST_FIBER_FLAG_SIGNAL_WAITING (1 << 30)
#define DST_FIBER_FLAG_HASCHILD (1 << 29)
/* Fiber signal masks. */
#define DST_FIBER_MASK_ERROR 2
@ -1032,6 +1031,7 @@ DST_API int dst_equals(Dst x, Dst y);
DST_API int32_t dst_hash(Dst x);
DST_API int dst_compare(Dst x, Dst y);
DST_API int dst_cstrcmp(const uint8_t *str, const char *other);
DST_API void dst_register(const char *name, Dst value);
/* VM functions */
DST_API int dst_init(void);

1
src/mainclient/main.c
View File

@ -42,6 +42,7 @@ int main(int argc, char **argv) {
/* Expose line getter */
dst_env_def(env, "getline", dst_wrap_cfunction(dst_line_getter));
dst_register("getline", dst_wrap_cfunction(dst_line_getter));
dst_line_init();
/* Run startup script */

1
test/suite2.dst
View File

@ -1,4 +1,3 @@
# Copyright (c) 2018 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy