diff --git a/eval.c b/eval.c new file mode 100644 index 00000000..5a037c94 --- /dev/null +++ b/eval.c @@ -0,0 +1,39 @@ +/** + * See Copyright Notice in picrin.h + */ + +#include "picrin.h" +#include "picrin/macro.h" + +pic_value +pic_eval(pic_state *pic, pic_value program, struct pic_lib *lib) +{ + struct pic_proc *proc; + + proc = pic_compile(pic, program, lib); + + return pic_apply(pic, proc, pic_nil_value()); +} + +static pic_value +pic_eval_eval(pic_state *pic) +{ + pic_value program, spec; + struct pic_lib *lib; + + pic_get_args(pic, "oo", &program, &spec); + + lib = pic_find_library(pic, spec); + if (lib == NULL) { + pic_errorf(pic, "no library found: ~s", spec); + } + return pic_eval(pic, program, lib); +} + +void +pic_init_eval(pic_state *pic) +{ + pic_deflibrary (pic, "(scheme eval)") { + pic_defun(pic, "eval", pic_eval_eval); + } +} diff --git a/include/picrin.h b/include/picrin.h index 0be5663a..3d22718d 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -163,6 +163,9 @@ char *pic_strndup(pic_state *, const char *, size_t); pic_value pic_read(pic_state *, struct pic_port *); pic_value pic_read_cstr(pic_state *, const char *); +pic_value pic_load(pic_state *, const char *); +pic_value pic_load_cstr(pic_state *, const char *); + pic_value pic_apply(pic_state *, struct pic_proc *, pic_value); pic_value pic_apply0(pic_state *, struct pic_proc *); pic_value pic_apply1(pic_state *, struct pic_proc *, pic_value); diff --git a/init.c b/init.c index 731e9408..73dd8caf 100644 --- a/init.c +++ b/init.c @@ -23,10 +23,12 @@ void pic_init_error(pic_state *); void pic_init_str(pic_state *); void pic_init_macro(pic_state *); void pic_init_var(pic_state *); +void pic_init_load(pic_state *); void pic_init_write(pic_state *); void pic_init_read(pic_state *); void pic_init_dict(pic_state *); void pic_init_record(pic_state *); +void pic_init_eval(pic_state *); void pic_init_lib(pic_state *); #define DONE pic_gc_arena_restore(pic, ai); @@ -60,10 +62,12 @@ pic_init_core(pic_state *pic) pic_init_str(pic); DONE; pic_init_macro(pic); DONE; pic_init_var(pic); DONE; + pic_init_load(pic); DONE; pic_init_write(pic); DONE; pic_init_read(pic); DONE; pic_init_dict(pic); DONE; pic_init_record(pic); DONE; + pic_init_eval(pic); DONE; pic_init_lib(pic); DONE; } } diff --git a/load.c b/load.c new file mode 100644 index 00000000..440b45e2 --- /dev/null +++ b/load.c @@ -0,0 +1,87 @@ +/** + * See Copyright Notice in picrin.h + */ + +#include "picrin.h" +#include "picrin/pair.h" + +pic_value +pic_load_cstr(pic_state *pic, const char *src) +{ + size_t ai; + pic_value v, exprs; + struct pic_proc *proc; + + exprs = pic_parse_cstr(pic, src); + if (pic_undef_p(exprs)) { + pic_errorf(pic, "load: read failure (%s)", pic_errmsg(pic)); + } + + pic_for_each (v, exprs) { + ai = pic_gc_arena_preserve(pic); + + proc = pic_compile(pic, v, pic->lib); + if (proc == NULL) { + pic_error(pic, "load: compilation failure"); + } + + pic_apply(pic, proc, pic_nil_value()); + + pic_gc_arena_restore(pic, ai); + } + + return pic_none_value(); +} + +pic_value +pic_load(pic_state *pic, const char *fn) +{ + FILE *file; + size_t ai; + pic_value v, exprs; + struct pic_proc *proc; + + file = fopen(fn, "r"); + if (file == NULL) { + pic_errorf(pic, "load: could not read file \"%s\"", fn); + } + + exprs = pic_parse_file(pic, file); + if (pic_undef_p(exprs)) { + pic_errorf(pic, "load: read failure (%s)", pic_errmsg(pic)); + } + + pic_for_each (v, exprs) { + ai = pic_gc_arena_preserve(pic); + + proc = pic_compile(pic, v, pic->lib); + if (proc == NULL) { + pic_error(pic, "load: compilation failure"); + } + + pic_apply(pic, proc, pic_nil_value()); + + pic_gc_arena_restore(pic, ai); + } + + return pic_none_value(); +} + +static pic_value +pic_load_load(pic_state *pic) +{ + pic_value envid; + char *fn; + + pic_get_args(pic, "z|o", &fn, &envid); + + return pic_load(pic, fn); +} + +void +pic_init_load(pic_state *pic) +{ + pic_deflibrary (pic, "(scheme load)") { + pic_defun(pic, "load", pic_load_load); + } +} diff --git a/vm.c b/vm.c index 46034214..0d1eb93f 100644 --- a/vm.c +++ b/vm.c @@ -1075,13 +1075,3 @@ pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, pic_value args) return pic_car(pic, args); } } - -pic_value -pic_eval(pic_state *pic, pic_value program, struct pic_lib *lib) -{ - struct pic_proc *proc; - - proc = pic_compile(pic, program, lib); - - return pic_apply(pic, proc, pic_nil_value()); -}