mirror of
https://github.com/janet-lang/janet
synced 2024-12-23 15:00:27 +00:00
Add new tests. Add recursion guard to compile, serialize, and
deserialize.
This commit is contained in:
Calvin Rose
parent
9d66d85778
commit
7e46ead2f4
@ -1133,12 +1133,13 @@ static SpecialFormHelper get_special(const GstValue *form) {
|
||||
name[2] == 'r') {
|
||||
return compile_var;
|
||||
}
|
||||
if (gst_string_length(name) == 6 &&
|
||||
if (gst_string_length(name) == 7 &&
|
||||
name[1] == 'a' &&
|
||||
name[2] == 'r' &&
|
||||
name[3] == 's' &&
|
||||
name[4] == 'e' &&
|
||||
name[5] == 't') {
|
||||
name[5] == 't' &&
|
||||
name[6] == '!') {
|
||||
return compile_varset;
|
||||
}
|
||||
}
|
||||
@ -1264,23 +1265,36 @@ static Slot compile_form(GstCompiler *c, FormOptions opts, const GstValue *form)
|
||||
|
||||
/* Recursively compile any value or form */
|
||||
static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x) {
|
||||
Slot ret;
|
||||
/* Check if recursion is too deep */
|
||||
if (c->recursionGuard++ > GST_RECURSION_GUARD) {
|
||||
c_error(c, "recursed too deeply");
|
||||
}
|
||||
switch (x.type) {
|
||||
case GST_NIL:
|
||||
case GST_BOOLEAN:
|
||||
case GST_REAL:
|
||||
case GST_INTEGER:
|
||||
return compile_nonref_type(c, opts, x);
|
||||
ret = compile_nonref_type(c, opts, x);
|
||||
break;
|
||||
case GST_STRING:
|
||||
return compile_symbol(c, opts, x);
|
||||
ret = compile_symbol(c, opts, x);
|
||||
break;
|
||||
case GST_TUPLE:
|
||||
return compile_form(c, opts, x.data.tuple);
|
||||
ret = compile_form(c, opts, x.data.tuple);
|
||||
break;
|
||||
case GST_ARRAY:
|
||||
return compile_array(c, opts, x.data.array);
|
||||
ret = compile_array(c, opts, x.data.array);
|
||||
break;
|
||||
case GST_TABLE:
|
||||
return compile_table(c, opts, x.data.table);
|
||||
ret = compile_table(c, opts, x.data.table);
|
||||
break;
|
||||
default:
|
||||
return compile_literal(c, opts, x);
|
||||
ret = compile_literal(c, opts, x);
|
||||
break;
|
||||
}
|
||||
c->recursionGuard--;
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Initialize a GstCompiler struct */
|
||||
@ -1290,6 +1304,7 @@ void gst_compiler(GstCompiler *c, Gst *vm) {
|
||||
c->tail = NULL;
|
||||
c->error.type = GST_NIL;
|
||||
c->env = vm->env;
|
||||
c->recursionGuard = 0;
|
||||
compiler_push_scope(c, 0);
|
||||
}
|
||||
|
||||
@ -1297,6 +1312,7 @@ void gst_compiler(GstCompiler *c, Gst *vm) {
|
||||
* given AST. Returns NULL if there was an error during compilation. */
|
||||
GstFunction *gst_compiler_compile(GstCompiler *c, GstValue form) {
|
||||
FormOptions opts = form_options_default();
|
||||
c->recursionGuard = 0;
|
||||
GstFuncDef *def;
|
||||
if (setjmp(c->onError)) {
|
||||
/* Clear all but root scope */
|
||||
|
||||
@ -106,7 +106,8 @@ static const char *gst_deserialize_impl(
|
||||
const uint8_t *end,
|
||||
const uint8_t **newData,
|
||||
GstArray *visited,
|
||||
GstValue *out) {
|
||||
GstValue *out,
|
||||
int depth) {
|
||||
|
||||
GstValue ret;
|
||||
ret.type = GST_NIL;
|
||||
@ -129,6 +130,11 @@ static const char *gst_deserialize_impl(
|
||||
#define read_dbl(out) do{deser_datacheck(8); (out)=bytes2dbl(data); data += 8; }while(0)
|
||||
#define read_i64(out) do{deser_datacheck(8); (out)=bytes2int(data); data += 8; }while(0)
|
||||
|
||||
/* Check if we have recursed too deeply */
|
||||
if (depth++ > GST_RECURSION_GUARD) {
|
||||
return "deserialize recursed too deeply";
|
||||
}
|
||||
|
||||
/* Check enough buffer left to read one byte */
|
||||
if (data >= end) deser_error(UEB);
|
||||
|
||||
@ -181,9 +187,9 @@ static const char *gst_deserialize_impl(
|
||||
buffer = gst_struct_begin(vm, length);
|
||||
for (i = 0; i < length; ++i) {
|
||||
GstValue k, v;
|
||||
if ((err = gst_deserialize_impl(vm, data, end, &data, visited, &k)))
|
||||
if ((err = gst_deserialize_impl(vm, data, end, &data, visited, &k, depth)))
|
||||
return err;
|
||||
if ((err = gst_deserialize_impl(vm, data, end, &data, visited, &v)))
|
||||
if ((err = gst_deserialize_impl(vm, data, end, &data, visited, &v, depth)))
|
||||
return err;
|
||||
gst_struct_put(buffer, k, v);
|
||||
}
|
||||
@ -217,7 +223,7 @@ static const char *gst_deserialize_impl(
|
||||
ret.data.array->capacity = length;
|
||||
gst_array_push(vm, visited, ret);
|
||||
for (i = 0; i < length; ++i)
|
||||
if ((err = gst_deserialize_impl(vm, data, end, &data, visited, buffer + i)))
|
||||
if ((err = gst_deserialize_impl(vm, data, end, &data, visited, buffer + i, depth)))
|
||||
return err;
|
||||
break;
|
||||
|
||||
@ -226,7 +232,7 @@ static const char *gst_deserialize_impl(
|
||||
read_u32(length);
|
||||
buffer = gst_tuple_begin(vm, length);
|
||||
for (i = 0; i < length; ++i)
|
||||
if ((err = gst_deserialize_impl(vm, data, end, &data, visited, buffer + i)))
|
||||
if ((err = gst_deserialize_impl(vm, data, end, &data, visited, buffer + i, depth)))
|
||||
return err;
|
||||
ret.type = GST_TUPLE;
|
||||
ret.data.tuple = gst_tuple_end(vm, buffer);
|
||||
@ -242,7 +248,7 @@ static const char *gst_deserialize_impl(
|
||||
t = gst_thread(vm, gst_wrap_nil(), 64);
|
||||
ret = gst_wrap_thread(t);
|
||||
gst_array_push(vm, visited, ret);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &ret);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &ret, depth);
|
||||
if (err != NULL) return err;
|
||||
if (ret.type == GST_NIL) {
|
||||
t->parent = NULL;
|
||||
@ -251,7 +257,7 @@ static const char *gst_deserialize_impl(
|
||||
} else {
|
||||
return "expected thread parent to be thread";
|
||||
}
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &ret);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &ret, depth);
|
||||
if (err != NULL) return err;
|
||||
if (ret.type == GST_NIL) {
|
||||
t->errorParent = NULL;
|
||||
@ -271,9 +277,9 @@ static const char *gst_deserialize_impl(
|
||||
uint32_t pcoffset;
|
||||
uint16_t ret, args, size, j;
|
||||
/* Read the stack */
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &callee);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &callee, depth);
|
||||
if (err != NULL) return err;
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &env);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &env, depth);
|
||||
if (err != NULL) return err;
|
||||
if (env.type != GST_FUNCENV && env.type != GST_NIL)
|
||||
return "expected funcenv in stackframe";
|
||||
@ -302,7 +308,7 @@ static const char *gst_deserialize_impl(
|
||||
/* Push stack args */
|
||||
for (j = 0; j < size; ++j) {
|
||||
GstValue temp;
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &temp);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &temp, depth);
|
||||
gst_thread_push(vm, t, temp);
|
||||
}
|
||||
}
|
||||
@ -315,9 +321,9 @@ static const char *gst_deserialize_impl(
|
||||
gst_array_push(vm, visited, ret);
|
||||
for (i = 0; i < length; ++i) {
|
||||
GstValue key, value;
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &key);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &key, depth);
|
||||
if (err != NULL) return err;
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &value);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &value, depth);
|
||||
if (err != NULL) return err;
|
||||
gst_table_put(vm, ret.data.table, key, value);
|
||||
}
|
||||
@ -344,7 +350,7 @@ static const char *gst_deserialize_impl(
|
||||
def->literals = NULL;
|
||||
}
|
||||
for (i = 0; i < literalsLen; ++i) {
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, def->literals + i);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, def->literals + i, depth);
|
||||
if (err != NULL) return err;
|
||||
}
|
||||
read_u32(byteCodeLen);
|
||||
@ -363,7 +369,7 @@ static const char *gst_deserialize_impl(
|
||||
ret.type = GST_FUNCENV;
|
||||
ret.data.env = gst_alloc(vm, sizeof(GstFuncEnv));
|
||||
gst_array_push(vm, visited, ret);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &thread);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &thread, depth);
|
||||
if (err != NULL) return err;
|
||||
read_u32(length);
|
||||
ret.data.env->stackOffset = length;
|
||||
@ -374,7 +380,7 @@ static const char *gst_deserialize_impl(
|
||||
ret.data.env->values = gst_alloc(vm, sizeof(GstValue) * length);
|
||||
for (i = 0; i < length; ++i) {
|
||||
GstValue item;
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &item);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &item, depth);
|
||||
if (err != NULL) return err;
|
||||
ret.data.env->values[i] = item;
|
||||
}
|
||||
@ -388,11 +394,11 @@ static const char *gst_deserialize_impl(
|
||||
ret.type = GST_FUNCTION;
|
||||
ret.data.function = gst_alloc(vm, sizeof(GstFunction));
|
||||
gst_array_push(vm, visited, ret);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &parent);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &parent, depth);
|
||||
if (err != NULL) return err;
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &env);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &env, depth);
|
||||
if (err != NULL) return err;
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &def);
|
||||
err = gst_deserialize_impl(vm, data, end, &data, visited, &def, depth);
|
||||
if (err != NULL) return err;
|
||||
if (parent.type == GST_NIL) {
|
||||
ret.data.function->parent = NULL;
|
||||
@ -460,7 +466,7 @@ const char *gst_deserialize(
|
||||
GstValue ret;
|
||||
const char *err;
|
||||
GstArray *visited = gst_array(vm, 10);
|
||||
err = gst_deserialize_impl(vm, data, data + len, nextData, visited, &ret);
|
||||
err = gst_deserialize_impl(vm, data, data + len, nextData, visited, &ret, 0);
|
||||
if (err != NULL) return err;
|
||||
*out = ret;
|
||||
return NULL;
|
||||
@ -474,12 +480,13 @@ BUFFER_DEFINE(u16, uint16_t)
|
||||
|
||||
/* Serialize a value and write to a buffer. Returns possible
|
||||
* error messages. */
|
||||
const char *gst_serialize_impl(
|
||||
static const char *gst_serialize_impl(
|
||||
Gst *vm,
|
||||
GstBuffer *buffer,
|
||||
GstTable *visited,
|
||||
uint32_t *nextId,
|
||||
GstValue x) {
|
||||
GstValue x,
|
||||
int depth) {
|
||||
|
||||
uint32_t i, count;
|
||||
const char *err;
|
||||
@ -492,6 +499,11 @@ const char *gst_serialize_impl(
|
||||
#define write_int(b) gst_buffer_push_integer(vm, buffer, (b))
|
||||
/*printf("Type: %d\n", x.type);*/
|
||||
|
||||
/* Check if we have gone too deep */
|
||||
if (depth++ > GST_RECURSION_GUARD) {
|
||||
return "serialize recursed too deeply";
|
||||
}
|
||||
|
||||
/* Check non reference types - if successful, return NULL */
|
||||
switch (x.type) {
|
||||
case GST_USERDATA:
|
||||
@ -539,9 +551,9 @@ const char *gst_serialize_impl(
|
||||
write_u32(gst_struct_length(x.data.st));
|
||||
for (i = 0; i < count; i += 2) {
|
||||
if (data[i].type != GST_NIL) {
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, data[i]);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, data[i], depth);
|
||||
if (err != NULL) return err;
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, data[i + 1]);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, data[i + 1], depth);
|
||||
if (err != NULL) return err;
|
||||
}
|
||||
}
|
||||
@ -550,7 +562,7 @@ const char *gst_serialize_impl(
|
||||
count = gst_tuple_length(x.data.tuple);
|
||||
write_u32(count);
|
||||
for (i = 0; i < count; ++i) {
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, x.data.tuple[i]);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, x.data.tuple[i], depth);
|
||||
if (err != NULL) return err;
|
||||
}
|
||||
}
|
||||
@ -598,9 +610,9 @@ const char *gst_serialize_impl(
|
||||
write_u32(x.data.table->count);
|
||||
for (i = 0; i < count; i += 2) {
|
||||
if (data[i].type != GST_NIL) {
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, data[i]);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, data[i], depth);
|
||||
if (err != NULL) return err;
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, data[i + 1]);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, data[i + 1], depth);
|
||||
if (err != NULL) return err;
|
||||
}
|
||||
}
|
||||
@ -622,7 +634,7 @@ const char *gst_serialize_impl(
|
||||
count = x.data.array->count;
|
||||
write_u32(count);
|
||||
for (i = 0; i < count; ++i) {
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, x.data.array->data[i]);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, x.data.array->data[i], depth);
|
||||
if (err != NULL) return err;
|
||||
}
|
||||
break;
|
||||
@ -635,14 +647,14 @@ const char *gst_serialize_impl(
|
||||
uint32_t i;
|
||||
write_byte(210);
|
||||
if (t->parent)
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_thread(t->parent));
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_thread(t->parent), depth);
|
||||
else
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil());
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil(), depth);
|
||||
if (t->errorParent)
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId,
|
||||
gst_wrap_thread(t->errorParent));
|
||||
gst_wrap_thread(t->errorParent), depth);
|
||||
else
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil());
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil(), depth);
|
||||
if (err != NULL) return err;
|
||||
/* Write the status byte */
|
||||
write_byte(t->status);
|
||||
@ -653,12 +665,12 @@ const char *gst_serialize_impl(
|
||||
uint32_t j, size;
|
||||
GstValue callee = gst_frame_callee(stack);
|
||||
GstFuncEnv *env = gst_frame_env(stack);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, callee);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, callee, depth);
|
||||
if (err != NULL) return err;
|
||||
if (env)
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_funcenv(env));
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_funcenv(env), depth);
|
||||
else
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil());
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil(), depth);
|
||||
if (err != NULL) return err;
|
||||
if (callee.type == GST_FUNCTION) {
|
||||
write_u32(gst_frame_pc(stack) - callee.data.function->def->byteCode);
|
||||
@ -670,7 +682,7 @@ const char *gst_serialize_impl(
|
||||
size = gst_frame_size(stack);
|
||||
write_u32(size);
|
||||
for (j = 0; j < size; ++j) {
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, stack[j]);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, stack[j], depth);
|
||||
if (err != NULL) return err;
|
||||
}
|
||||
/* Next stack frame */
|
||||
@ -688,7 +700,7 @@ const char *gst_serialize_impl(
|
||||
write_u32(def->flags);
|
||||
write_u32(def->literalsLen);
|
||||
for (i = 0; i < def->literalsLen; ++i) {
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, def->literals[i]);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, def->literals[i], depth);
|
||||
if (err != NULL) return err;
|
||||
}
|
||||
write_u32(def->byteCodeLen);
|
||||
@ -703,14 +715,14 @@ const char *gst_serialize_impl(
|
||||
GstFuncEnv *env = x.data.env;
|
||||
write_byte(213);
|
||||
if (env->thread) {
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_thread(env->thread));
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_thread(env->thread), depth);
|
||||
if (err != NULL) return err;
|
||||
write_u32(env->stackOffset);
|
||||
} else {
|
||||
write_byte(201); /* Write nil */
|
||||
write_u32(env->stackOffset);
|
||||
for (i = 0; i < env->stackOffset; ++i) {
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, env->values[i]);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, env->values[i], depth);
|
||||
if (err != NULL) return err;
|
||||
}
|
||||
}
|
||||
@ -725,11 +737,11 @@ const char *gst_serialize_impl(
|
||||
pv = fn->parent ? gst_wrap_function(fn->parent) : gst_wrap_nil();
|
||||
dv = gst_wrap_funcdef(fn->def);
|
||||
ev = fn->env ? gst_wrap_funcenv(fn->env) : gst_wrap_nil();
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, pv);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, pv, depth);
|
||||
if (err != NULL) return err;
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, ev);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, ev, depth);
|
||||
if (err != NULL) return err;
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, dv);
|
||||
err = gst_serialize_impl(vm, buffer, visited, nextId, dv, depth);
|
||||
if (err != NULL) return err;
|
||||
}
|
||||
break;
|
||||
@ -745,7 +757,7 @@ const char *gst_serialize(Gst *vm, GstBuffer *buffer, GstValue x) {
|
||||
uint32_t oldCount = buffer->count;
|
||||
const char *err;
|
||||
GstTable *visited = gst_table(vm, 10);
|
||||
err = gst_serialize_impl(vm, buffer, visited, &nextId, x);
|
||||
err = gst_serialize_impl(vm, buffer, visited, &nextId, x, 0);
|
||||
if (err != NULL) {
|
||||
buffer->count = oldCount;
|
||||
}
|
||||
|
||||
@ -1130,7 +1130,7 @@ static const GstModuleItem std_module[] = {
|
||||
{"parent", gst_stl_parent},
|
||||
{"print", gst_stl_print},
|
||||
{"tostring", gst_stl_tostring},
|
||||
{"exit", gst_stl_exit},
|
||||
{"exit!", gst_stl_exit},
|
||||
{"get", gst_stl_get},
|
||||
{"set!", gst_stl_set},
|
||||
{"next", gst_stl_next},
|
||||
|
||||
@ -5,25 +5,68 @@
|
||||
(if x
|
||||
(do
|
||||
(print " \e[32m✔\e[0m" e)
|
||||
(varset numTestsPassed (+ 1 numTestsPassed)) x)
|
||||
(varset! numTestsPassed (+ 1 numTestsPassed)) x)
|
||||
(do
|
||||
(print e)
|
||||
(exit 1)))))
|
||||
(exit! (+ numTestsPassed 1))))))
|
||||
|
||||
(assert (= 10 (+ 1 2 3 4)) "addition")
|
||||
(assert (= -8 (- 1 2 3 4)) "subtraction")
|
||||
(assert (= 24 (* 1 2 3 4)) "multiplication")
|
||||
(assert (= 4 (blshift 1 2)) "left shift")
|
||||
(assert (= 1 (brshift 4 2)) "right shift")
|
||||
(assert (< 1 2 3 4 5 6) "less than integers")
|
||||
(assert (< 1.0 2.0 3.0 4.0 5.0 6.0) "less than reals")
|
||||
(assert (> 6 5 4 3 2 1) "greater than integers")
|
||||
(assert (> 6.0 5.0 4.0 3.0 2.0 1.0) "greater then reals")
|
||||
(assert (<= 1 2 3 3 4 5 6) "less than or equal to integers")
|
||||
(assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals")
|
||||
(assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers")
|
||||
(assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals")
|
||||
|
||||
(assert (< nil 1.0 1 false true "hi"
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" false)
|
||||
(struct 1 2)
|
||||
(thread (fn [x] x))
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
+) "type ordering")
|
||||
|
||||
(assert (not false) "false literal")
|
||||
(assert true "true literal")
|
||||
(assert (not nil) "nil literal")
|
||||
(assert (= 7 (bor 3 4)) "bit or")
|
||||
(assert (= 0 (band 3 4)) "bit and")
|
||||
|
||||
(var accum 1)
|
||||
(var count 0)
|
||||
(while (< count 16)
|
||||
(varset accum (blshift accum 1))
|
||||
(varset count (+ 1 count)))
|
||||
(varset! accum (blshift accum 1))
|
||||
(varset! count (+ 1 count)))
|
||||
|
||||
(assert (= accum 65536) "loop")
|
||||
|
||||
(print "All" numTestsPassed "tests passed")
|
||||
"Serialization tests"
|
||||
(def scheck (fn [x]
|
||||
(def dat (serialize x))
|
||||
(def deser (deserialize dat))
|
||||
(assert (= x deser) (string "serialize " (debugp x)))
|
||||
))
|
||||
|
||||
(exit 0)
|
||||
(scheck 1)
|
||||
(scheck true)
|
||||
(scheck false)
|
||||
(scheck nil)
|
||||
(scheck "asdasdasd")
|
||||
(scheck (struct 1 2 3 4))
|
||||
(scheck (tuple 1 2 3))
|
||||
(scheck 123412.12)
|
||||
(scheck (struct (struct 1 2 3 "a") (struct 1 2 3 "a") false 1 "asdasd" (tuple "a" "b")))
|
||||
(scheck "psdafoilasdfbiusbdfliasbldfiubaslidufbliausdbfiluasbdfiulbasldiufbalisudhfiasudbfaisuldfbl")
|
||||
|
||||
"All tests passed"
|
||||
|
||||
(print "All" numTestsPassed "tests passed")
|
||||
(exit! 0)
|
||||
@ -88,6 +88,10 @@
|
||||
/* Size of stack frame in number of values */
|
||||
#define GST_FRAME_SIZE 5
|
||||
|
||||
/* Prevent some recursive functions from recursing too deeply
|
||||
* ands crashing. */
|
||||
#define GST_RECURSION_GUARD 2056
|
||||
|
||||
/* Macros for referencing a stack frame given a stack */
|
||||
#define gst_frame_callee(s) (*(s - 1))
|
||||
#define gst_frame_size(s) ((s - 2)->data.dwords[0])
|
||||
@ -127,12 +131,12 @@ typedef enum GstType {
|
||||
GST_STRING,
|
||||
GST_ARRAY,
|
||||
GST_TUPLE,
|
||||
GST_TABLE,
|
||||
GST_STRUCT,
|
||||
GST_THREAD,
|
||||
GST_BYTEBUFFER,
|
||||
GST_FUNCTION,
|
||||
GST_CFUNCTION,
|
||||
GST_TABLE,
|
||||
GST_USERDATA,
|
||||
GST_FUNCENV,
|
||||
GST_FUNCDEF
|
||||
@ -373,6 +377,7 @@ struct GstCompiler {
|
||||
GstScope *tail;
|
||||
GstBuffer *buffer;
|
||||
GstTable *env;
|
||||
int recursionGuard;
|
||||
};
|
||||
|
||||
/* Bytecode */
|
||||
|
||||
@ -5,9 +5,7 @@
|
||||
(print _ )
|
||||
|
||||
"Comment"
|
||||
(do
|
||||
(: i 0)
|
||||
(while (< i 1000)
|
||||
(print i)
|
||||
(: i (+ i 1)))
|
||||
)
|
||||
(var i 0)
|
||||
(while (< i 1000)
|
||||
(print i)
|
||||
(varset i (+ i 1)))
|
||||
|
||||
65
libs/pp.gst
65
libs/pp.gst
@ -1,65 +0,0 @@
|
||||
(do
|
||||
|
||||
(: pp nil)
|
||||
|
||||
"Pretty print an array or tuple"
|
||||
(: print-seq (fn [start end a seen]
|
||||
(: seen (if seen seen {}))
|
||||
(if (get seen a) (get seen a)
|
||||
(do
|
||||
(set! seen a "<cycle>")
|
||||
(: parts [])
|
||||
(: len (length a))
|
||||
(: i 0)
|
||||
(while (< i len)
|
||||
(push! parts (pp (get a i) seen))
|
||||
(push! parts " ")
|
||||
(: i (+ 1 i)))
|
||||
(if (> len 0) (pop! parts))
|
||||
(push! parts end)
|
||||
(: ret (apply string start parts))
|
||||
(set! seen a ret)
|
||||
ret))))
|
||||
|
||||
"Pretty print an object or struct"
|
||||
(: print-struct (fn [start end s seen]
|
||||
(: seen (if seen seen {}))
|
||||
(if (get seen s) (get seen s)
|
||||
(do
|
||||
(set! seen s "<cycle>")
|
||||
(: parts [])
|
||||
(: key (next s))
|
||||
(while (not (= key nil))
|
||||
(push! parts (pp key seen))
|
||||
(push! parts " ")
|
||||
(push! parts (pp (get s key) seen))
|
||||
(push! parts " ")
|
||||
(: key (next s key)))
|
||||
(if (> (length parts) 0) (pop! parts))
|
||||
(push! parts end)
|
||||
(: ret (apply string start parts))
|
||||
(set! seen s ret)
|
||||
ret))))
|
||||
|
||||
"Type handlers"
|
||||
(: handlers {
|
||||
"array" (fn [a seen] (print-seq "[" "]" a seen))
|
||||
"tuple" (fn [a seen] (print-seq "(" ")" a seen))
|
||||
"table" (fn [s seen] (print-struct "{" "}" s seen))
|
||||
"struct" (fn [s seen] (print-struct "#{" "}" s seen))
|
||||
})
|
||||
|
||||
"Define pretty print"
|
||||
(: pp (fn [x seen]
|
||||
(: handler (get handlers (type x)))
|
||||
(: handler (if handler handler tostring))
|
||||
(handler x seen)))
|
||||
|
||||
"Export pretty print"
|
||||
(export! "pp" pp)
|
||||
|
||||
(: arr [1 2 3 4])
|
||||
(push! arr arr)
|
||||
(print (pp arr))
|
||||
|
||||
)
|
||||
@ -1,22 +0,0 @@
|
||||
(export! "scheck" (fn [x]
|
||||
(: dat (serialize x))
|
||||
(: deser (deserialize dat))
|
||||
(print (debugp deser))
|
||||
deser
|
||||
))
|
||||
|
||||
(scheck 1)
|
||||
(scheck true)
|
||||
(scheck nil)
|
||||
(scheck "asdasdasd")
|
||||
(scheck (struct 1 2 3 4))
|
||||
(scheck (tuple 1 2 3))
|
||||
(scheck 123412.12)
|
||||
(scheck (funcdef (fn [] 1)))
|
||||
(scheck (funcenv (fn [] 1)))
|
||||
(do
|
||||
(: producer (fn [a] (fn [] a)))
|
||||
(: f (producer "hello!"))
|
||||
(scheck (funcenv f))
|
||||
)
|
||||
(scheck (fn [] 1))
|
||||
Loading…
Reference in New Issue
Block a user