conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

(scheme base) is no longer the default library of benz. refer to (picrin 

base) instead.
This commit is contained in:
Yuichi Nishiwaki 2014-09-01 13:01:56 +09:00
parent a227498f5b
commit a4c82f10d2
4 changed files with 26 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
codegen.c
View File

@ -51,8 +51,8 @@ static void pop_scope(analyze_state *);
#define register_renamed_symbol(pic, state, slot, lib, id) do { \ #define register_renamed_symbol(pic, state, slot, lib, id) do { \
pic_sym sym, gsym; \ pic_sym sym, gsym; \
sym = pic_intern_cstr(pic, id); \ sym = pic_intern_cstr(pic, id); \
if (! pic_find_rename(pic, lib->env, sym, &gsym)) { \ if (! pic_find_rename(pic, lib->env, sym, &gsym)) { \
pic_error(pic, "internal error! native VM procedure not found"); \ pic_errorf(pic, "internal error! native VM procedure not found: %s", id); \
} \ } \
state->slot = gsym; \ state->slot = gsym; \
} while (0) } while (0)
@ -62,32 +62,28 @@ new_analyze_state(pic_state *pic)
{ {
analyze_state *state; analyze_state *state;
xh_iter it; xh_iter it;
struct pic_lib *stdlib, *listlib;
state = pic_alloc(pic, sizeof(analyze_state)); state = pic_alloc(pic, sizeof(analyze_state));
state->pic = pic; state->pic = pic;
state->scope = NULL; state->scope = NULL;
stdlib = pic_find_library(pic, pic_read_cstr(pic, "(scheme base)"));
listlib = pic_find_library(pic, pic_read_cstr(pic, "(picrin base list)"));
/* native VM procedures */ /* native VM procedures */
register_renamed_symbol(pic, state, rCONS, listlib, "cons"); register_renamed_symbol(pic, state, rCONS, pic->PICRIN_BASE, "cons");
register_renamed_symbol(pic, state, rCAR, listlib, "car"); register_renamed_symbol(pic, state, rCAR, pic->PICRIN_BASE, "car");
register_renamed_symbol(pic, state, rCDR, listlib, "cdr"); register_renamed_symbol(pic, state, rCDR, pic->PICRIN_BASE, "cdr");
register_renamed_symbol(pic, state, rNILP, listlib, "null?"); register_renamed_symbol(pic, state, rNILP, pic->PICRIN_BASE, "null?");
register_renamed_symbol(pic, state, rADD, stdlib, "+"); register_renamed_symbol(pic, state, rADD, pic->PICRIN_BASE, "+");
register_renamed_symbol(pic, state, rSUB, stdlib, "-"); register_renamed_symbol(pic, state, rSUB, pic->PICRIN_BASE, "-");
register_renamed_symbol(pic, state, rMUL, stdlib, "*"); register_renamed_symbol(pic, state, rMUL, pic->PICRIN_BASE, "*");
register_renamed_symbol(pic, state, rDIV, stdlib, "/"); register_renamed_symbol(pic, state, rDIV, pic->PICRIN_BASE, "/");
register_renamed_symbol(pic, state, rEQ, stdlib, "="); register_renamed_symbol(pic, state, rEQ, pic->PICRIN_BASE, "=");
register_renamed_symbol(pic, state, rLT, stdlib, "<"); register_renamed_symbol(pic, state, rLT, pic->PICRIN_BASE, "<");
register_renamed_symbol(pic, state, rLE, stdlib, "<="); register_renamed_symbol(pic, state, rLE, pic->PICRIN_BASE, "<=");
register_renamed_symbol(pic, state, rGT, stdlib, ">"); register_renamed_symbol(pic, state, rGT, pic->PICRIN_BASE, ">");
register_renamed_symbol(pic, state, rGE, stdlib, ">="); register_renamed_symbol(pic, state, rGE, pic->PICRIN_BASE, ">=");
register_renamed_symbol(pic, state, rNOT, stdlib, "not"); register_renamed_symbol(pic, state, rNOT, pic->PICRIN_BASE, "not");
register_renamed_symbol(pic, state, rVALUES, stdlib, "values"); register_renamed_symbol(pic, state, rVALUES, pic->PICRIN_BASE, "values");
register_renamed_symbol(pic, state, rCALL_WITH_VALUES, stdlib, "call-with-values"); register_renamed_symbol(pic, state, rCALL_WITH_VALUES, pic->PICRIN_BASE, "call-with-values");
register_symbol(pic, state, sCALL, "call"); register_symbol(pic, state, sCALL, "call");
register_symbol(pic, state, sTAILCALL, "tail-call"); register_symbol(pic, state, sTAILCALL, "tail-call");

4
include/picrin.h
View File

@ -137,8 +137,8 @@ pic_state *pic_open(int argc, char *argv[], char **envp);
void pic_close(pic_state *); void pic_close(pic_state *);
void pic_define(pic_state *, const char *, pic_value); /* automatic export */ void pic_define(pic_state *, const char *, pic_value); /* automatic export */
pic_value pic_ref(pic_state *, const char *); pic_value pic_ref(pic_state *, struct pic_lib *, const char *);
void pic_set(pic_state *, const char *, pic_value); void pic_set(pic_state *, struct pic_lib *, const char *, pic_value);
pic_value pic_funcall(pic_state *pic, const char *name, pic_list args); pic_value pic_funcall(pic_state *pic, const char *name, pic_list args);

4
port.c
View File

@ -28,7 +28,7 @@ pic_stdin(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
proc = pic_proc_ptr(pic_ref(pic, "current-input-port")); proc = pic_proc_ptr(pic_ref(pic, pic->PICRIN_BASE, "current-input-port"));
return pic_port_ptr(pic_apply(pic, proc, pic_nil_value())); return pic_port_ptr(pic_apply(pic, proc, pic_nil_value()));
} }
@ -38,7 +38,7 @@ pic_stdout(pic_state *pic)
{ {
struct pic_proc *proc; struct pic_proc *proc;
proc = pic_proc_ptr(pic_ref(pic, "current-output-port")); proc = pic_proc_ptr(pic_ref(pic, pic->PICRIN_BASE, "current-output-port"));
return pic_port_ptr(pic_apply(pic, proc, pic_nil_value())); return pic_port_ptr(pic_apply(pic, proc, pic_nil_value()));
} }

8
vm.c
View File

@ -426,14 +426,14 @@ pic_define(pic_state *pic, const char *name, pic_value val)
} }
pic_value pic_value
pic_ref(pic_state *pic, const char *name) pic_ref(pic_state *pic, struct pic_lib *lib, const char *name)
{ {
pic_sym sym, rename; pic_sym sym, rename;
sym = pic_intern_cstr(pic, name); sym = pic_intern_cstr(pic, name);
if (! pic_find_rename(pic, pic->lib->env, sym, &rename)) { if (! pic_find_rename(pic, lib->env, sym, &rename)) {
pic_errorf(pic, "symbol \"%s\" not defined", name); pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
} }
return xh_val(xh_get_int(&pic->globals, rename), pic_value); return xh_val(xh_get_int(&pic->globals, rename), pic_value);
@ -444,7 +444,7 @@ pic_funcall(pic_state *pic, const char *name, pic_list args)
{ {
pic_value proc; pic_value proc;
proc = pic_ref(pic, name); proc = pic_ref(pic, pic->lib, name);
pic_assert_type(pic, proc, proc); pic_assert_type(pic, proc, proc);