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

change mangling rule for global variables

This commit is contained in:
Yuichi Nishiwaki 2016-02-06 04:07:37 +09:00
parent 1fbc38fe55
commit 0fd529c968
9 changed files with 175 additions and 236 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extlib/benz/bool.c
View File

@ -40,11 +40,15 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
switch (pic_type(x)) { switch (pic_type(x)) {
case PIC_TT_ID: { case PIC_TT_ID: {
struct pic_id *id1, *id2; struct pic_id *id1, *id2;
pic_sym *s1, *s2;
id1 = pic_id_ptr(x); id1 = pic_id_ptr(x);
id2 = pic_id_ptr(y); id2 = pic_id_ptr(y);
return pic_resolve(pic, id1->var, id1->env) == pic_resolve(pic, id2->var, id2->env); s1 = pic_resolve_variable(pic, id1->env, id1->var);
s2 = pic_resolve_variable(pic, id2->env, id2->var);
return s1 == s2;
} }
case PIC_TT_STRING: { case PIC_TT_STRING: {
return pic_str_cmp(pic, pic_str_ptr(x), pic_str_ptr(y)) == 0; return pic_str_cmp(pic, pic_str_ptr(x), pic_str_ptr(y)) == 0;

82
extlib/benz/codegen.c
View File

@ -44,7 +44,7 @@ expand_var(pic_state *pic, pic_value var, struct pic_env *env, pic_value deferre
struct pic_proc *mac; struct pic_proc *mac;
pic_sym *functor; pic_sym *functor;
functor = pic_resolve(pic, var, env); functor = pic_resolve_variable(pic, env, var);
if ((mac = find_macro(pic, functor)) != NULL) { if ((mac = find_macro(pic, functor)) != NULL) {
return expand(pic, pic_apply2(pic, mac, var, pic_obj_value(env)), env, deferred); return expand(pic, pic_apply2(pic, mac, var, pic_obj_value(env)), env, deferred);
@ -55,7 +55,7 @@ expand_var(pic_state *pic, pic_value var, struct pic_env *env, pic_value deferre
static pic_value static pic_value
expand_quote(pic_state *pic, pic_value expr) expand_quote(pic_state *pic, pic_value expr)
{ {
return pic_cons(pic, pic_obj_value(pic->uQUOTE), pic_cdr(pic, expr)); return pic_cons(pic, pic_obj_value(pic->sQUOTE), pic_cdr(pic, expr));
} }
static pic_value static pic_value
@ -129,7 +129,7 @@ expand_lambda(pic_state *pic, pic_value expr, struct pic_env *env)
expand_deferred(pic, deferred, in); expand_deferred(pic, deferred, in);
return pic_list3(pic, pic_obj_value(pic->uLAMBDA), formal, body); return pic_list3(pic, pic_obj_value(pic->sLAMBDA), formal, body);
} }
static pic_value static pic_value
@ -146,7 +146,7 @@ expand_define(pic_state *pic, pic_value expr, struct pic_env *env, pic_value def
} }
val = expand(pic, pic_list_ref(pic, expr, 2), env, deferred); val = expand(pic, pic_list_ref(pic, expr, 2), env, deferred);
return pic_list3(pic, pic_obj_value(pic->uDEFINE), pic_obj_value(uid), val); return pic_list3(pic, pic_obj_value(pic->sDEFINE), pic_obj_value(uid), val);
} }
static pic_value static pic_value
@ -188,18 +188,18 @@ expand_node(pic_state *pic, pic_value expr, struct pic_env *env, pic_value defer
if (pic_var_p(pic_car(pic, expr))) { if (pic_var_p(pic_car(pic, expr))) {
pic_sym *functor; pic_sym *functor;
functor = pic_resolve(pic, pic_car(pic, expr), env); functor = pic_resolve_variable(pic, env, pic_car(pic, expr));
if (functor == pic->uDEFINE_MACRO) { if (functor == pic->sDEFINE_MACRO) {
return expand_defmacro(pic, expr, env); return expand_defmacro(pic, expr, env);
} }
else if (functor == pic->uLAMBDA) { else if (functor == pic->sLAMBDA) {
return expand_defer(pic, expr, deferred); return expand_defer(pic, expr, deferred);
} }
else if (functor == pic->uDEFINE) { else if (functor == pic->sDEFINE) {
return expand_define(pic, expr, env, deferred); return expand_define(pic, expr, env, deferred);
} }
else if (functor == pic->uQUOTE) { else if (functor == pic->sQUOTE) {
return expand_quote(pic, expr); return expand_quote(pic, expr);
} }
@ -268,9 +268,9 @@ optimize_beta(pic_state *pic, pic_value expr)
if (pic_sym_p(pic_list_ref(pic, expr, 0))) { if (pic_sym_p(pic_list_ref(pic, expr, 0))) {
pic_sym *sym = pic_sym_ptr(pic_list_ref(pic, expr, 0)); pic_sym *sym = pic_sym_ptr(pic_list_ref(pic, expr, 0));
if (sym == pic->uQUOTE) { if (sym == pic->sQUOTE) {
return expr; return expr;
} else if (sym == pic->uLAMBDA) { } else if (sym == pic->sLAMBDA) {
return pic_list3(pic, pic_list_ref(pic, expr, 0), pic_list_ref(pic, expr, 1), optimize_beta(pic, pic_list_ref(pic, expr, 2))); return pic_list3(pic, pic_list_ref(pic, expr, 0), pic_list_ref(pic, expr, 1), optimize_beta(pic, pic_list_ref(pic, expr, 2)));
} }
} }
@ -285,7 +285,7 @@ optimize_beta(pic_state *pic, pic_value expr)
pic_gc_protect(pic, expr); pic_gc_protect(pic, expr);
functor = pic_list_ref(pic, expr, 0); functor = pic_list_ref(pic, expr, 0);
if (pic_pair_p(functor) && pic_eq_p(pic_car(pic, functor), pic_obj_value(pic->uLAMBDA))) { if (pic_pair_p(functor) && pic_eq_p(pic_car(pic, functor), pic_obj_value(pic->sLAMBDA))) {
formals = pic_list_ref(pic, functor, 1); formals = pic_list_ref(pic, functor, 1);
if (! pic_list_p(formals)) if (! pic_list_p(formals))
goto exit; /* TODO: support ((lambda args x) 1 2) */ goto exit; /* TODO: support ((lambda args x) 1 2) */
@ -294,12 +294,12 @@ optimize_beta(pic_state *pic, pic_value expr)
goto exit; goto exit;
defs = pic_nil_value(); defs = pic_nil_value();
pic_for_each (val, args, it) { pic_for_each (val, args, it) {
pic_push(pic, pic_list3(pic, pic_obj_value(pic->uDEFINE), pic_car(pic, formals), val), defs); pic_push(pic, pic_list3(pic, pic_obj_value(pic->sDEFINE), pic_car(pic, formals), val), defs);
formals = pic_cdr(pic, formals); formals = pic_cdr(pic, formals);
} }
expr = pic_list_ref(pic, functor, 2); expr = pic_list_ref(pic, functor, 2);
pic_for_each (val, defs, it) { pic_for_each (val, defs, it) {
expr = pic_list3(pic, pic_obj_value(pic->uBEGIN), val, expr); expr = pic_list3(pic, pic_obj_value(pic->sBEGIN), val, expr);
} }
} }
exit: exit:
@ -506,7 +506,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form)
analyzer_scope_destroy(pic, scope); analyzer_scope_destroy(pic, scope);
return pic_list6(pic, pic_obj_value(pic->uLAMBDA), rest, pic_obj_value(args), pic_obj_value(locals), pic_obj_value(captures), body); return pic_list6(pic, pic_obj_value(pic->sLAMBDA), rest, pic_obj_value(args), pic_obj_value(locals), pic_obj_value(captures), body);
} }
static pic_value static pic_value
@ -553,16 +553,16 @@ analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
if (pic_sym_p(proc)) { if (pic_sym_p(proc)) {
pic_sym *sym = pic_sym_ptr(proc); pic_sym *sym = pic_sym_ptr(proc);
if (sym == pic->uDEFINE) { if (sym == pic->sDEFINE) {
return analyze_define(pic, scope, obj); return analyze_define(pic, scope, obj);
} }
else if (sym == pic->uLAMBDA) { else if (sym == pic->sLAMBDA) {
return analyze_defer(pic, scope, obj); return analyze_defer(pic, scope, obj);
} }
else if (sym == pic->uQUOTE) { else if (sym == pic->sQUOTE) {
return obj; return obj;
} }
else if (sym == pic->uBEGIN || sym == pic->uSETBANG || sym == pic->uIF) { else if (sym == pic->sBEGIN || sym == pic->sSETBANG || sym == pic->sIF) {
return pic_cons(pic, pic_car(pic, obj), analyze_list(pic, scope, pic_cdr(pic, obj))); return pic_cons(pic, pic_car(pic, obj), analyze_list(pic, scope, pic_cdr(pic, obj)));
} }
} }
@ -570,7 +570,7 @@ analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
return analyze_call(pic, scope, obj); return analyze_call(pic, scope, obj);
} }
default: default:
return pic_list2(pic, pic_obj_value(pic->uQUOTE), obj); return pic_list2(pic, pic_obj_value(pic->sQUOTE), obj);
} }
} }
@ -988,22 +988,22 @@ codegen_call(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
sym = pic_sym_ptr(pic_list_ref(pic, functor, 1)); sym = pic_sym_ptr(pic_list_ref(pic, functor, 1));
VM(pic->uCONS, OP_CONS) VM(pic->sCONS, OP_CONS)
VM(pic->uCAR, OP_CAR) VM(pic->sCAR, OP_CAR)
VM(pic->uCDR, OP_CDR) VM(pic->sCDR, OP_CDR)
VM(pic->uNILP, OP_NILP) VM(pic->sNILP, OP_NILP)
VM(pic->uSYMBOLP, OP_SYMBOLP) VM(pic->sSYMBOLP, OP_SYMBOLP)
VM(pic->uPAIRP, OP_PAIRP) VM(pic->sPAIRP, OP_PAIRP)
VM(pic->uNOT, OP_NOT) VM(pic->sNOT, OP_NOT)
VM(pic->uEQ, OP_EQ) VM(pic->sEQ, OP_EQ)
VM(pic->uLT, OP_LT) VM(pic->sLT, OP_LT)
VM(pic->uLE, OP_LE) VM(pic->sLE, OP_LE)
VM(pic->uGT, OP_GT) VM(pic->sGT, OP_GT)
VM(pic->uGE, OP_GE) VM(pic->sGE, OP_GE)
VM(pic->uADD, OP_ADD) VM(pic->sADD, OP_ADD)
VM(pic->uSUB, OP_SUB) VM(pic->sSUB, OP_SUB)
VM(pic->uMUL, OP_MUL) VM(pic->sMUL, OP_MUL)
VM(pic->uDIV, OP_DIV) VM(pic->sDIV, OP_DIV)
} }
emit_i(pic, cxt, (tailpos ? OP_TAILCALL : OP_CALL), len - 1); emit_i(pic, cxt, (tailpos ? OP_TAILCALL : OP_CALL), len - 1);
@ -1018,19 +1018,19 @@ codegen(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
if (sym == GREF || sym == CREF || sym == LREF) { if (sym == GREF || sym == CREF || sym == LREF) {
codegen_ref(pic, cxt, obj, tailpos); codegen_ref(pic, cxt, obj, tailpos);
} }
else if (sym == pic->uSETBANG || sym == pic->uDEFINE) { else if (sym == pic->sSETBANG || sym == pic->sDEFINE) {
codegen_set(pic, cxt, obj, tailpos); codegen_set(pic, cxt, obj, tailpos);
} }
else if (sym == pic->uLAMBDA) { else if (sym == pic->sLAMBDA) {
codegen_lambda(pic, cxt, obj, tailpos); codegen_lambda(pic, cxt, obj, tailpos);
} }
else if (sym == pic->uIF) { else if (sym == pic->sIF) {
codegen_if(pic, cxt, obj, tailpos); codegen_if(pic, cxt, obj, tailpos);
} }
else if (sym == pic->uBEGIN) { else if (sym == pic->sBEGIN) {
codegen_begin(pic, cxt, obj, tailpos); codegen_begin(pic, cxt, obj, tailpos);
} }
else if (sym == pic->uQUOTE) { else if (sym == pic->sQUOTE) {
codegen_quote(pic, cxt, obj, tailpos); codegen_quote(pic, cxt, obj, tailpos);
} }
else if (sym == CALL) { else if (sym == CALL) {

19
extlib/benz/gc.c
View File

@ -347,6 +347,9 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
gc_mark_object(pic, (struct pic_object *)kh_val(h, it)); gc_mark_object(pic, (struct pic_object *)kh_val(h, it));
} }
} }
if (obj->u.env.prefix) {
gc_mark_object(pic, (struct pic_object *)obj->u.env.prefix);
}
if (obj->u.env.up) { if (obj->u.env.up) {
LOOP(obj->u.env.up); LOOP(obj->u.env.up);
} }
@ -420,7 +423,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
} }
#define M(x) gc_mark_object(pic, (struct pic_object *)pic->x) #define M(x) gc_mark_object(pic, (struct pic_object *)pic->x)
#define P(x) gc_mark(pic, pic->x)
static void static void
gc_mark_phase(pic_state *pic) gc_mark_phase(pic_state *pic)
@ -469,22 +471,13 @@ gc_mark_phase(pic_state *pic)
} }
/* mark reserved symbols */ /* mark reserved symbols */
M(sDEFINE); M(sDEFINE_MACRO); M(sLAMBDA); M(sIF); M(sBEGIN); M(sSETBANG);
M(sQUOTE); M(sQUASIQUOTE); M(sUNQUOTE); M(sUNQUOTE_SPLICING); M(sQUOTE); M(sQUASIQUOTE); M(sUNQUOTE); M(sUNQUOTE_SPLICING);
M(sSYNTAX_QUOTE); M(sSYNTAX_QUASIQUOTE); M(sSYNTAX_UNQUOTE); M(sSYNTAX_UNQUOTE_SPLICING); M(sSYNTAX_QUOTE); M(sSYNTAX_QUASIQUOTE); M(sSYNTAX_UNQUOTE); M(sSYNTAX_UNQUOTE_SPLICING);
M(sDEFINE_LIBRARY); M(sIMPORT); M(sEXPORT); M(sCOND_EXPAND); M(sDEFINE_LIBRARY); M(sIMPORT); M(sEXPORT); M(sCOND_EXPAND);
M(uDEFINE); M(uLAMBDA); M(uIF); M(uBEGIN); M(uQUOTE); M(uSETBANG); M(uDEFINE_MACRO); M(sCONS); M(sCAR); M(sCDR); M(sNILP); M(sSYMBOLP); M(sPAIRP);
M(uDEFINE_LIBRARY); M(uIMPORT); M(uEXPORT); M(uCOND_EXPAND); M(sADD); M(sSUB); M(sMUL); M(sDIV); M(sEQ); M(sLT); M(sLE); M(sGT); M(sGE); M(sNOT);
M(uCONS); M(uCAR); M(uCDR); M(uNILP); M(uSYMBOLP); M(uPAIRP);
M(uADD); M(uSUB); M(uMUL); M(uDIV); M(uEQ); M(uLT); M(uLE); M(uGT); M(uGE); M(uNOT);
/* mark system procedures */
P(pCONS); P(pCAR); P(pCDR); P(pNILP); P(pSYMBOLP); P(pPAIRP); P(pNOT);
P(pADD); P(pSUB); P(pMUL); P(pDIV); P(pEQ); P(pLT); P(pLE); P(pGT); P(pGE);
M(cCONS); M(cCAR); M(cCDR); M(cNILP); M(cSYMBOLP); M(cPAIRP); M(cNOT);
M(cADD); M(cSUB); M(cMUL); M(cDIV); M(cEQ); M(cLT); M(cLE); M(cGT); M(cGE);
/* global variables */ /* global variables */
if (pic->globals) { if (pic->globals) {

15
extlib/benz/include/picrin.h
View File

@ -94,22 +94,13 @@ struct pic_state {
struct pic_lib *lib, *prev_lib; struct pic_lib *lib, *prev_lib;
pic_sym *sDEFINE, *sDEFINE_MACRO, *sLAMBDA, *sIF, *sBEGIN, *sSETBANG;
pic_sym *sQUOTE, *sQUASIQUOTE, *sUNQUOTE, *sUNQUOTE_SPLICING; pic_sym *sQUOTE, *sQUASIQUOTE, *sUNQUOTE, *sUNQUOTE_SPLICING;
pic_sym *sSYNTAX_QUOTE, *sSYNTAX_QUASIQUOTE; pic_sym *sSYNTAX_QUOTE, *sSYNTAX_QUASIQUOTE;
pic_sym *sSYNTAX_UNQUOTE, *sSYNTAX_UNQUOTE_SPLICING; pic_sym *sSYNTAX_UNQUOTE, *sSYNTAX_UNQUOTE_SPLICING;
pic_sym *sDEFINE_LIBRARY, *sIMPORT, *sEXPORT, *sCOND_EXPAND; pic_sym *sDEFINE_LIBRARY, *sIMPORT, *sEXPORT, *sCOND_EXPAND;
pic_sym *sCONS, *sCAR, *sCDR, *sNILP, *sSYMBOLP, *sPAIRP;
pic_sym *uDEFINE, *uLAMBDA, *uIF, *uBEGIN, *uQUOTE, *uSETBANG, *uDEFINE_MACRO; pic_sym *sADD, *sSUB, *sMUL, *sDIV, *sEQ, *sLT, *sLE, *sGT, *sGE, *sNOT;
pic_sym *uDEFINE_LIBRARY, *uIMPORT, *uEXPORT, *uCOND_EXPAND;
pic_sym *uCONS, *uCAR, *uCDR, *uNILP, *uSYMBOLP, *uPAIRP;
pic_sym *uADD, *uSUB, *uMUL, *uDIV, *uEQ, *uLT, *uLE, *uGT, *uGE, *uNOT;
pic_value pCONS, pCAR, pCDR, pNILP, pPAIRP, pSYMBOLP, pNOT;
pic_value pADD, pSUB, pMUL, pDIV, pEQ, pLT, pLE, pGT, pGE;
struct pic_box *cCONS, *cCAR, *cCDR, *cNILP, *cPAIRP, *cSYMBOLP, *cNOT;
struct pic_box *cADD, *cSUB, *cMUL, *cDIV, *cEQ, *cLT, *cLE, *cGT, *cGE;
struct pic_lib *PICRIN_BASE; struct pic_lib *PICRIN_BASE;
struct pic_lib *PICRIN_USER; struct pic_lib *PICRIN_USER;

8
extlib/benz/include/picrin/macro.h
View File

@ -21,6 +21,7 @@ struct pic_env {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
khash_t(env) map; khash_t(env) map;
struct pic_env *up; struct pic_env *up;
pic_str *prefix;
}; };
#define pic_id_p(v) (pic_type(v) == PIC_TT_ID) #define pic_id_p(v) (pic_type(v) == PIC_TT_ID)
@ -30,14 +31,13 @@ struct pic_env {
#define pic_env_ptr(v) ((struct pic_env *)pic_ptr(v)) #define pic_env_ptr(v) ((struct pic_env *)pic_ptr(v))
struct pic_id *pic_make_id(pic_state *, pic_value, struct pic_env *); struct pic_id *pic_make_id(pic_state *, pic_value, struct pic_env *);
struct pic_env *pic_make_topenv(pic_state *, pic_str *);
struct pic_env *pic_make_env(pic_state *, struct pic_env *); struct pic_env *pic_make_env(pic_state *, struct pic_env *);
pic_sym *pic_uniq(pic_state *, pic_value);
pic_sym *pic_add_variable(pic_state *, struct pic_env *, pic_value); pic_sym *pic_add_variable(pic_state *, struct pic_env *, pic_value);
void pic_put_variable(pic_state *, struct pic_env *, pic_value, pic_sym *); pic_sym *pic_put_variable(pic_state *, struct pic_env *, pic_value, pic_sym *);
pic_sym *pic_find_variable(pic_state *, struct pic_env *, pic_value); pic_sym *pic_find_variable(pic_state *, struct pic_env *, pic_value);
pic_sym *pic_resolve(pic_state *, pic_value, struct pic_env *); pic_sym *pic_resolve_variable(pic_state *, struct pic_env *, pic_value);
bool pic_var_p(pic_value); bool pic_var_p(pic_value);
pic_sym *pic_var_name(pic_state *, pic_value); pic_sym *pic_var_name(pic_state *, pic_value);

33
extlib/benz/lib.c
View File

@ -4,13 +4,30 @@
#include "picrin.h" #include "picrin.h"
static void static struct pic_env *
setup_default_env(pic_state *pic, struct pic_env *env) make_library_env(pic_state *pic, pic_value name)
{ {
pic_put_variable(pic, env, pic_obj_value(pic->sDEFINE_LIBRARY), pic->uDEFINE_LIBRARY); struct pic_env *env;
pic_put_variable(pic, env, pic_obj_value(pic->sIMPORT), pic->uIMPORT); pic_value dir, it;
pic_put_variable(pic, env, pic_obj_value(pic->sEXPORT), pic->uEXPORT); pic_str *prefix = NULL;
pic_put_variable(pic, env, pic_obj_value(pic->sCOND_EXPAND), pic->uCOND_EXPAND);
pic_for_each (dir, name, it) {
if (prefix == NULL) {
prefix = pic_format(pic, "~a", dir);
} else {
prefix = pic_format(pic, "~a.~a", pic_obj_value(prefix), dir);
}
}
env = pic_make_topenv(pic, prefix);
/* set up default environment */
pic_put_variable(pic, env, pic_obj_value(pic->sDEFINE_LIBRARY), pic->sDEFINE_LIBRARY);
pic_put_variable(pic, env, pic_obj_value(pic->sIMPORT), pic->sIMPORT);
pic_put_variable(pic, env, pic_obj_value(pic->sEXPORT), pic->sEXPORT);
pic_put_variable(pic, env, pic_obj_value(pic->sCOND_EXPAND), pic->sCOND_EXPAND);
return env;
} }
struct pic_lib * struct pic_lib *
@ -24,11 +41,9 @@ pic_make_library(pic_state *pic, pic_value name)
pic_errorf(pic, "library name already in use: ~s", name); pic_errorf(pic, "library name already in use: ~s", name);
} }
env = pic_make_env(pic, NULL); env = make_library_env(pic, name);
exports = pic_make_dict(pic); exports = pic_make_dict(pic);
setup_default_env(pic, env);
lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB); lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
lib->name = name; lib->name = name;
lib->env = env; lib->env = env;

50
extlib/benz/macro.c
View File

@ -30,8 +30,23 @@ pic_make_env(pic_state *pic, struct pic_env *up)
{ {
struct pic_env *env; struct pic_env *env;
assert(up != NULL);
env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV); env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
env->up = up; env->up = up;
env->prefix = NULL;
kh_init(env, &env->map);
return env;
}
struct pic_env *
pic_make_topenv(pic_state *pic, pic_str *prefix)
{
struct pic_env *env;
env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
env->up = NULL;
env->prefix = prefix;
kh_init(env, &env->map); kh_init(env, &env->map);
return env; return env;
} }
@ -48,33 +63,28 @@ pic_var_name(pic_state PIC_UNUSED(*pic), pic_value var)
} }
pic_sym * pic_sym *
pic_uniq(pic_state *pic, pic_value var) pic_add_variable(pic_state *pic, struct pic_env *env, pic_value var)
{ {
const char *name;
pic_sym *uid;
pic_str *str; pic_str *str;
assert(pic_var_p(var)); assert(pic_var_p(var));
str = pic_format(pic, "%s.%d", pic_symbol_name(pic, pic_var_name(pic, var)), pic->ucnt++); name = pic_symbol_name(pic, pic_var_name(pic, var));
return pic_intern_str(pic, str); if (env->up == NULL && pic_sym_p(var)) { /* toplevel & public */
str = pic_format(pic, "%s/%s", pic_str_cstr(pic, env->prefix), name);
} else {
str = pic_format(pic, ".%s.%d", name, pic->ucnt++);
}
uid = pic_intern_str(pic, str);
return pic_put_variable(pic, env, var, uid);
} }
pic_sym * pic_sym *
pic_add_variable(pic_state *pic, struct pic_env *env, pic_value var) pic_put_variable(pic_state *pic, struct pic_env *env, pic_value var, pic_sym *uid)
{
pic_sym *uid;
assert(pic_var_p(var));
uid = pic_uniq(pic, var);
pic_put_variable(pic, env, var, uid);
return uid;
}
void
pic_put_variable(pic_state PIC_UNUSED(*pic), struct pic_env *env, pic_value var, pic_sym *uid)
{ {
khiter_t it; khiter_t it;
int ret; int ret;
@ -83,6 +93,8 @@ pic_put_variable(pic_state PIC_UNUSED(*pic), struct pic_env *env, pic_value var,
it = kh_put(env, &env->map, pic_ptr(var), &ret); it = kh_put(env, &env->map, pic_ptr(var), &ret);
kh_val(&env->map, it) = uid; kh_val(&env->map, it) = uid;
return uid;
} }
pic_sym * pic_sym *
@ -115,7 +127,7 @@ lookup(void *var, struct pic_env *env)
} }
pic_sym * pic_sym *
pic_resolve(pic_state *pic, pic_value var, struct pic_env *env) pic_resolve_variable(pic_state *pic, struct pic_env *env, pic_value var)
{ {
pic_sym *uid; pic_sym *uid;

196
extlib/benz/state.c
View File

@ -108,19 +108,18 @@ pic_features(pic_state *pic)
return pic->features; return pic->features;
} }
#define DONE pic_gc_arena_restore(pic, ai); #define import_builtin_syntax(name) do { \
pic_sym *nick, *real; \
nick = pic_intern(pic, "builtin:" name); \
real = pic_intern(pic, name); \
pic_put_variable(pic, pic->lib->env, pic_obj_value(nick), real); \
} while (0)
#define define_builtin_syntax(uid, name) \ #define declare_vm_procedure(name) do { \
pic_put_variable(pic, pic->lib->env, pic_obj_value(pic_intern(pic, name)), uid) pic_sym *id; \
id = pic_intern(pic, name); \
#define VM(uid, name) \ pic_put_variable(pic, pic->lib->env, pic_obj_value(id), id); \
pic_put_variable(pic, pic->lib->env, pic_obj_value(pic_intern(pic, name)), uid) } while (0)
#define VM3(name) \
pic->c##name = pic_vm_gref_slot(pic, pic->u##name);
#define VM2(proc, name) \
proc = pic_ref(pic, pic->lib, name)
static void static void
pic_init_core(pic_state *pic) pic_init_core(pic_state *pic)
@ -132,32 +131,34 @@ pic_init_core(pic_state *pic)
pic_deflibrary (pic, "(picrin base)") { pic_deflibrary (pic, "(picrin base)") {
size_t ai = pic_gc_arena_preserve(pic); size_t ai = pic_gc_arena_preserve(pic);
define_builtin_syntax(pic->uDEFINE, "builtin:define"); #define DONE pic_gc_arena_restore(pic, ai);
define_builtin_syntax(pic->uSETBANG, "builtin:set!");
define_builtin_syntax(pic->uQUOTE, "builtin:quote");
define_builtin_syntax(pic->uLAMBDA, "builtin:lambda");
define_builtin_syntax(pic->uIF, "builtin:if");
define_builtin_syntax(pic->uBEGIN, "builtin:begin");
define_builtin_syntax(pic->uDEFINE_MACRO, "builtin:define-macro");
pic_defun(pic, "features", pic_features); import_builtin_syntax("define");
import_builtin_syntax("set!");
import_builtin_syntax("quote");
import_builtin_syntax("lambda");
import_builtin_syntax("if");
import_builtin_syntax("begin");
import_builtin_syntax("define-macro");
VM(pic->uCONS, "cons"); declare_vm_procedure("cons");
VM(pic->uCAR, "car"); declare_vm_procedure("car");
VM(pic->uCDR, "cdr"); declare_vm_procedure("cdr");
VM(pic->uNILP, "null?"); declare_vm_procedure("null?");
VM(pic->uSYMBOLP, "symbol?"); declare_vm_procedure("symbol?");
VM(pic->uPAIRP, "pair?"); declare_vm_procedure("pair?");
VM(pic->uNOT, "not"); declare_vm_procedure("+");
VM(pic->uADD, "+"); declare_vm_procedure("-");
VM(pic->uSUB, "-"); declare_vm_procedure("*");
VM(pic->uMUL, "*"); declare_vm_procedure("/");
VM(pic->uDIV, "/"); declare_vm_procedure("=");
VM(pic->uEQ, "="); declare_vm_procedure("<");
VM(pic->uLT, "<"); declare_vm_procedure(">");
VM(pic->uLE, "<="); declare_vm_procedure("<=");
VM(pic->uGT, ">"); declare_vm_procedure(">=");
VM(pic->uGE, ">="); declare_vm_procedure("not");
DONE;
pic_init_bool(pic); DONE; pic_init_bool(pic); DONE;
pic_init_pair(pic); DONE; pic_init_pair(pic); DONE;
@ -181,39 +182,7 @@ pic_init_core(pic_state *pic)
pic_init_lib(pic); DONE; pic_init_lib(pic); DONE;
pic_init_reg(pic); DONE; pic_init_reg(pic); DONE;
VM3(CONS); pic_defun(pic, "features", pic_features);
VM3(CAR);
VM3(CDR);
VM3(NILP);
VM3(SYMBOLP);
VM3(PAIRP);
VM3(NOT);
VM3(ADD);
VM3(SUB);
VM3(MUL);
VM3(DIV);
VM3(EQ);
VM3(LT);
VM3(LE);
VM3(GT);
VM3(GE);
VM2(pic->pCONS, "cons");
VM2(pic->pCAR, "car");
VM2(pic->pCDR, "cdr");
VM2(pic->pNILP, "null?");
VM2(pic->pSYMBOLP, "symbol?");
VM2(pic->pPAIRP, "pair?");
VM2(pic->pNOT, "not");
VM2(pic->pADD, "+");
VM2(pic->pSUB, "-");
VM2(pic->pMUL, "*");
VM2(pic->pDIV, "/");
VM2(pic->pEQ, "=");
VM2(pic->pLT, "<");
VM2(pic->pLE, "<=");
VM2(pic->pGT, ">");
VM2(pic->pGE, ">=");
pic_try { pic_try {
pic_load_cstr(pic, &pic_boot[0][0]); pic_load_cstr(pic, &pic_boot[0][0]);
@ -336,6 +305,12 @@ pic_open(pic_allocf allocf, void *userdata)
#define S(slot,name) pic->slot = pic_intern(pic, name) #define S(slot,name) pic->slot = pic_intern(pic, name)
S(sDEFINE, "define");
S(sDEFINE_MACRO, "define-macro");
S(sLAMBDA, "lambda");
S(sIF, "if");
S(sBEGIN, "begin");
S(sSETBANG, "set!");
S(sQUOTE, "quote"); S(sQUOTE, "quote");
S(sQUASIQUOTE, "quasiquote"); S(sQUASIQUOTE, "quasiquote");
S(sUNQUOTE, "unquote"); S(sUNQUOTE, "unquote");
@ -349,57 +324,25 @@ pic_open(pic_allocf allocf, void *userdata)
S(sDEFINE_LIBRARY, "define-library"); S(sDEFINE_LIBRARY, "define-library");
S(sCOND_EXPAND, "cond-expand"); S(sCOND_EXPAND, "cond-expand");
S(sCONS, "cons");
S(sCAR, "car");
S(sCDR, "cdr");
S(sNILP, "null?");
S(sSYMBOLP, "symbol?");
S(sPAIRP, "pair?");
S(sADD, "+");
S(sSUB, "-");
S(sMUL, "*");
S(sDIV, "/");
S(sEQ, "=");
S(sLT, "<");
S(sLE, "<=");
S(sGT, ">");
S(sGE, ">=");
S(sNOT, "not");
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);
#define U(slot,name) pic->slot = pic_uniq(pic, pic_obj_value(pic_intern(pic, name)))
U(uDEFINE, "define");
U(uLAMBDA, "lambda");
U(uIF, "if");
U(uBEGIN, "begin");
U(uSETBANG, "set!");
U(uQUOTE, "quote");
U(uDEFINE_MACRO, "define-macro");
U(uIMPORT, "import");
U(uEXPORT, "export");
U(uDEFINE_LIBRARY, "define-library");
U(uCOND_EXPAND, "cond-expand");
U(uCONS, "cons");
U(uCAR, "car");
U(uCDR, "cdr");
U(uNILP, "null?");
U(uSYMBOLP, "symbol?");
U(uPAIRP, "pair?");
U(uADD, "+");
U(uSUB, "-");
U(uMUL, "*");
U(uDIV, "/");
U(uEQ, "=");
U(uLT, "<");
U(uLE, "<=");
U(uGT, ">");
U(uGE, ">=");
U(uNOT, "not");
pic_gc_arena_restore(pic, ai);
/* system procedures */
pic->pCONS = pic_invalid_value();
pic->pCAR = pic_invalid_value();
pic->pCDR = pic_invalid_value();
pic->pNILP = pic_invalid_value();
pic->pSYMBOLP = pic_invalid_value();
pic->pPAIRP = pic_invalid_value();
pic->pNOT = pic_invalid_value();
pic->pADD = pic_invalid_value();
pic->pSUB = pic_invalid_value();
pic->pMUL = pic_invalid_value();
pic->pDIV = pic_invalid_value();
pic->pEQ = pic_invalid_value();
pic->pLT = pic_invalid_value();
pic->pLE = pic_invalid_value();
pic->pGT = pic_invalid_value();
pic->pGE = pic_invalid_value();
/* root tables */ /* root tables */
pic->globals = pic_make_reg(pic); pic->globals = pic_make_reg(pic);
pic->macros = pic_make_reg(pic); pic->macros = pic_make_reg(pic);
@ -427,23 +370,6 @@ pic_open(pic_allocf allocf, void *userdata)
/* turn on GC */ /* turn on GC */
pic->gc_enable = true; pic->gc_enable = true;
pic->cCONS = pic_box(pic, pic_invalid_value());
pic->cCAR = pic_box(pic, pic_invalid_value());
pic->cCDR = pic_box(pic, pic_invalid_value());
pic->cNILP = pic_box(pic, pic_invalid_value());
pic->cSYMBOLP = pic_box(pic, pic_invalid_value());
pic->cPAIRP = pic_box(pic, pic_invalid_value());
pic->cNOT = pic_box(pic, pic_invalid_value());
pic->cADD = pic_box(pic, pic_invalid_value());
pic->cSUB = pic_box(pic, pic_invalid_value());
pic->cMUL = pic_box(pic, pic_invalid_value());
pic->cDIV = pic_box(pic, pic_invalid_value());
pic->cEQ = pic_box(pic, pic_invalid_value());
pic->cLT = pic_box(pic, pic_invalid_value());
pic->cLE = pic_box(pic, pic_invalid_value());
pic->cGT = pic_box(pic, pic_invalid_value());
pic->cGE = pic_box(pic, pic_invalid_value());
pic_init_core(pic); pic_init_core(pic);
pic_gc_arena_restore(pic, ai); pic_gc_arena_restore(pic, ai);

2
extlib/benz/vm.c
View File

@ -636,8 +636,6 @@ pic_apply(pic_state *pic, struct pic_proc *proc, int argc, pic_value *argv)
} }
#define check_condition(name, n) do { \ #define check_condition(name, n) do { \
if (! pic_eq_p(pic->p##name, pic->c##name->value)) \
goto L_CALL; \
if (c.a != n + 1) \ if (c.a != n + 1) \
goto L_CALL; \ goto L_CALL; \
} while (0) } while (0)