mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-10-25 20:57:40 +00:00
Code Issues 1 Releases Wiki Activity

Add macros in compiler.

Browse Source
This commit is contained in:
bakpakin
2018-01-28 15:29:47 -05:00
parent 8fe9881187
commit b305a7c9bb
12 changed files with 213 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
src/compiler/compile.c
View File

@@ -731,29 +731,6 @@ static DstSlot dstc_call(DstFopts opts, DstAst *ast, DstSM *sms, DstSlot fun) {
return retslot;
}
/* Compile a tuple */
DstSlot dstc_tuple(DstFopts opts, DstAst *ast, Dst x) {
Dst headval;
DstSlot head;
DstCompiler *c = opts.compiler;
DstFopts subopts = dstc_fopts_default(c);
const Dst *tup = dst_unwrap_tuple(x);
/* Empty tuple is tuple literal */
if (dst_tuple_length(tup) == 0) return dstc_cslot(x);
/* Symbols could be specials */
headval = dst_ast_unwrap1(tup[0]);
if (dst_checktype(headval, DST_SYMBOL)) {
const DstSpecial *s = dstc_special(dst_unwrap_symbol(headval));
if (NULL != s) {
return s->compile(opts, ast, dst_tuple_length(tup) - 1, tup + 1);
}
}
/* Compile the head of the tuple */
subopts.flags = DST_FUNCTION | DST_CFUNCTION;
head = dstc_value(subopts, tup[0]);
return dstc_call(opts, ast, dstc_toslots(c, tup + 1, dst_tuple_length(tup) - 1), head);
}
static DstSlot dstc_array(DstFopts opts, DstAst *ast, Dst x) {
DstCompiler *c = opts.compiler;
DstArray *a = dst_unwrap_array(x);
@@ -770,7 +747,11 @@ static DstSlot dstc_tablector(DstFopts opts, DstAst *ast, Dst x, DstCFunction cf
/* Compile a single value */
DstSlot dstc_value(DstFopts opts, Dst x) {
DstSlot ret;
DstAst *ast = dst_ast_node(x);
DstAst *ast;
DstCompiler *c = opts.compiler;
opts.compiler->recursion_guard--;
recur:
ast = dst_ast_node(x);
x = dst_ast_unwrap1(x);
if (dstc_iserr(&opts)) {
return dstc_cslot(dst_wrap_nil());
@@ -779,7 +760,6 @@ DstSlot dstc_value(DstFopts opts, Dst x) {
dstc_cerror(opts.compiler, ast, "recursed too deeply");
return dstc_cslot(dst_wrap_nil());
}
opts.compiler->recursion_guard--;
switch (dst_type(x)) {
default:
ret = dstc_cslot(x);
@@ -791,7 +771,52 @@ DstSlot dstc_value(DstFopts opts, Dst x) {
break;
}
case DST_TUPLE:
ret = dstc_tuple(opts, ast, x);
{
int compiled = 0;
Dst headval;
DstSlot head;
DstFopts subopts = dstc_fopts_default(c);
const Dst *tup = dst_unwrap_tuple(x);
/* Empty tuple is tuple literal */
if (dst_tuple_length(tup) == 0) {
compiled = 1;
ret = dstc_cslot(x);
} else {
/* Symbols could be specials */
headval = dst_ast_unwrap1(tup[0]);
if (dst_checktype(headval, DST_SYMBOL)) {
const DstSpecial *s = dstc_special(dst_unwrap_symbol(headval));
if (NULL != s) {
ret = s->compile(opts, ast, dst_tuple_length(tup) - 1, tup + 1);
compiled = 1;
} else {
/* Check macro */
DstTable *env = c->env;
int status;
Dst fn;
Dst entry = dst_table_get(env, headval);
for (;;) {
if (dst_checktype(entry, DST_NIL)) break;
if (dst_checktype(dst_get(entry, dst_csymbolv("macro")), DST_NIL)) break;
fn = dst_get(entry, dst_csymbolv("value"));
if (!dst_checktype(fn, DST_FUNCTION)) break;
status = dst_call(fn, &x, dst_tuple_length(tup) - 1, tup + 1);
if (status) {
dstc_cerror(c, ast, "error in macro expansion");
}
/* Tail recur on the value */
goto recur;
}
}
}
if (!compiled) {
/* Compile the head of the tuple */
subopts.flags = DST_FUNCTION | DST_CFUNCTION;
head = dstc_value(subopts, tup[0]);
ret = dstc_call(opts, ast, dstc_toslots(c, tup + 1, dst_tuple_length(tup) - 1), head);
}
}
}
break;
case DST_ARRAY:
ret = dstc_array(opts, ast, x);
@@ -881,7 +906,6 @@ DstFuncDef *dstc_pop_funcdef(DstCompiler *c) {
return def;
}
/* Initialize a compiler */
static void dstc_init(DstCompiler *c, DstTable *env) {
c->scopes = NULL;

20
src/core/buffer.c
View File

@@ -179,10 +179,24 @@ static int cfun_chars(DstArgs args) {
return dst_return(args, args.v[0]);
}
static int cfun_clear(DstArgs args) {
DstBuffer *buffer;
if (args.n < 1 || !dst_checktype(args.v[0], DST_BUFFER)) return dst_throw(args, "expected buffer");
buffer = dst_unwrap_buffer(args.v[0]);
buffer->count = 0;
return dst_return(args, args.v[0]);
}
static const DstReg cfuns[] = {
{"buffer-push-byte", cfun_u8},
{"buffer-push-integer", cfun_int},
{"buffer-push-string", cfun_chars},
{"buffer-clear", cfun_clear},
{NULL, NULL}
};
int dst_lib_buffer(DstArgs args) {
DstTable *env = dst_env_arg(args);
dst_env_def(env, "buffer-push-byte", dst_wrap_cfunction(cfun_u8));
dst_env_def(env, "buffer-push-integer", dst_wrap_cfunction(cfun_int));
dst_env_def(env, "buffer-push-string", dst_wrap_cfunction(cfun_chars));
dst_env_cfuns(env, cfuns);
return 0;
}

2
src/core/gc.c
View File

@@ -28,6 +28,7 @@
void *dst_vm_blocks;
uint32_t dst_vm_gc_interval;
uint32_t dst_vm_next_collection;
int dst_vm_gc_suspend = 0;
/* Roots */
Dst *dst_vm_roots;
@@ -303,6 +304,7 @@ void *dst_gcalloc(DstMemoryType type, size_t size) {
/* Run garbage collection */
void dst_collect() {
uint32_t i;
if (dst_vm_gc_suspend) return;
if (dst_vm_fiber)
dst_mark_fiber(dst_vm_fiber);
for (i = 0; i < dst_vm_root_count; i++)

10
src/core/io.c
View File

@@ -231,11 +231,11 @@ static int dst_io_fclose(DstArgs args) {
#endif
static const DstReg cfuns[] = {
{"fopen", dst_io_fopen},
{"fclose", dst_io_fclose},
{"fread", dst_io_fread},
{"fwrite", dst_io_fwrite},
{"fflush", dst_io_fflush},
{"file-open", dst_io_fopen},
{"file-close", dst_io_fclose},
{"file-read", dst_io_fread},
{"file-write", dst_io_fwrite},
{"file-flush", dst_io_fflush},
{NULL, NULL}
};

26
src/core/tuple.c
View File

@@ -125,9 +125,35 @@ static int cfun_slice(DstArgs args) {
return dst_return(args, dst_wrap_tuple(dst_tuple_end(ret)));
}
static int cfun_prepend(DstArgs args) {
const Dst *t;
Dst *n;
if (args.n != 2) return dst_throw(args, "expected 2 arguments");
if (!dst_checktype(args.v[0], DST_TUPLE)) return dst_throw(args, "expected tuple");
t = dst_unwrap_tuple(args.v[0]);
n = dst_tuple_begin(dst_tuple_length(t) + 1);
memcpy(n + 1, t, sizeof(Dst) * dst_tuple_length(t));
n[0] = args.v[1];
return dst_return(args, dst_wrap_tuple(dst_tuple_end(n)));
}
static int cfun_append(DstArgs args) {
const Dst *t;
Dst *n;
if (args.n != 2) return dst_throw(args, "expected 2 arguments");
if (!dst_checktype(args.v[0], DST_TUPLE)) return dst_throw(args, "expected tuple");
t = dst_unwrap_tuple(args.v[0]);
n = dst_tuple_begin(dst_tuple_length(t) + 1);
memcpy(n, t, sizeof(Dst) * dst_tuple_length(t));
n[dst_tuple_length(t)] = args.v[1];
return dst_return(args, dst_wrap_tuple(dst_tuple_end(n)));
}
/* Load the tuple module */
int dst_lib_tuple(DstArgs args) {
DstTable *env = dst_env_arg(args);
dst_env_def(env, "tuple-slice", dst_wrap_cfunction(cfun_slice));
dst_env_def(env, "tuple-append", dst_wrap_cfunction(cfun_append));
dst_env_def(env, "tuple-prepend", dst_wrap_cfunction(cfun_prepend));
return 0;
}

30
src/core/vm.c
View File

@@ -685,6 +685,36 @@ int dst_run(Dst callee, Dst *returnreg) {
return 1;
}
/* Run from inside a cfunction. This should only be used for
* short functions as it prevents re-entering the current fiber
* and suspend garbage collection. */
int dst_call(Dst callee, Dst *returnreg, int32_t argn, const Dst *argv) {
int ret;
int lock;
DstFiber *oldfiber = dst_vm_fiber;
lock = dst_vm_gc_suspend++;
dst_vm_fiber = dst_fiber(0);
dst_fiber_pushn(dst_vm_fiber, argv, argn);
if (dst_checktype(callee, DST_CFUNCTION)) {
DstArgs args;
*returnreg = dst_wrap_nil();
dst_fiber_cframe(dst_vm_fiber);
args.n = argn;
args.v = dst_vm_fiber->data + dst_vm_fiber->frame;
args.ret = returnreg;
ret = dst_unwrap_cfunction(callee)(args);
} else if (dst_checktype(callee, DST_FUNCTION)) {
dst_fiber_funcframe(dst_vm_fiber, dst_unwrap_function(callee));
ret = dst_continue(returnreg);
} else {
*returnreg = dst_cstringv("expected function");
ret = 1;
}
dst_vm_fiber = oldfiber;
dst_vm_gc_suspend = lock;
return ret;
}
/* Setup functions */
int dst_init() {
/* Garbage collection */

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

@@ -164,6 +164,8 @@ int dst_gcunroot(Dst root);
int dst_gcunrootall(Dst root);
#define dst_maybe_collect() do {\
if (dst_vm_next_collection >= dst_vm_gc_interval) dst_collect(); } while (0)
#define dst_gclock() (dst_vm_gc_suspend++)
#define dst_gcunlock() (dst_vm_gc_suspend--)
/* Functions */
DstFuncDef *dst_funcdef_alloc();
@@ -191,6 +193,7 @@ DstCFunction dst_native(const char *name, const uint8_t **error);
int dst_init();
void dst_deinit();
int dst_run(Dst callee, Dst *returnreg);
int dst_call(Dst callee, Dst *returnreg, int32_t argn, const Dst *argv);
/* C Function helpers */
#define dst_throw(a, e) (*((a).ret) = dst_cstringv(e), 1)

1
src/include/dst/dststate.h
View File

@@ -41,6 +41,7 @@ extern const char *dst_type_names[16];
extern void *dst_vm_blocks;
extern uint32_t dst_vm_gc_interval;
extern uint32_t dst_vm_next_collection;
extern int dst_vm_gc_suspend;
/* Immutable value cache */
extern const uint8_t **dst_vm_cache;