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

introduce immediate symbol value

This commit is contained in:
Yuichi Nishiwaki 2013-10-29 02:11:31 +09:00
parent a19c59ba87
commit 63b52991da
12 changed files with 298 additions and 377 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
include/picconf.h
View File

@ -13,7 +13,7 @@
#define PIC_STACK_SIZE 1024 #define PIC_STACK_SIZE 1024
#define PIC_IREP_SIZE 256 #define PIC_IREP_SIZE 256
#define PIC_GLOBALS_SIZE 1024 #define PIC_GLOBALS_SIZE 1024
#define PIC_SYM_TBL_SIZE 128 #define PIC_SYM_POOL_SIZE 128
#define PIC_POOL_SIZE 1024 #define PIC_POOL_SIZE 1024
/* enable all debug flags */ /* enable all debug flags */

19
include/picrin.h
View File

@ -27,13 +27,15 @@ typedef struct {
pic_callinfo *ci; pic_callinfo *ci;
pic_callinfo *cibase, *ciend; pic_callinfo *cibase, *ciend;
pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG; pic_sym sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG;
pic_value sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING; pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
pic_value sCONS, sCAR, sCDR, sNILP; pic_sym sCONS, sCAR, sCDR, sNILP;
pic_value sADD, sSUB, sMUL, sDIV; pic_sym sADD, sSUB, sMUL, sDIV;
pic_value sEQ, sLT, sLE, sGT, sGE; pic_sym sEQ, sLT, sLE, sGT, sGE;
struct sym_tbl *sym_tbl; struct xhash *sym_tbl;
const char **sym_pool;
size_t slen, scapa;
struct xhash *global_tbl; struct xhash *global_tbl;
pic_value *globals; pic_value *globals;
@ -71,8 +73,11 @@ int pic_get_args(pic_state *, const char *, ...);
void pic_defun(pic_state *, const char *, pic_func_t); void pic_defun(pic_state *, const char *, pic_func_t);
bool pic_eq_p(pic_state *, pic_value, pic_value); bool pic_eq_p(pic_state *, pic_value, pic_value);
bool pic_eqv_p(pic_state *, pic_value, pic_value);
bool pic_equql_p(pic_state *, pic_value, pic_value);
pic_value pic_intern_cstr(pic_state *, const char *); pic_sym pic_intern_cstr(pic_state *, const char *);
const char *pic_symbol_name(pic_state *, pic_sym);
pic_value pic_str_new(pic_state *, const char *, size_t); pic_value pic_str_new(pic_state *, const char *, size_t);
pic_value pic_str_new_cstr(pic_state *, const char *); pic_value pic_str_new_cstr(pic_state *, const char *);

11
include/picrin/symbol.h
View File

@ -1,11 +0,0 @@
#ifndef SYMBOL_H__
#define SYMBOL_H__
struct sym_tbl {
pic_value tbl[PIC_SYM_TBL_SIZE];
size_t size;
};
pic_value sym_tbl_get(struct sym_tbl *, const char *);
#endif

16
include/picrin/value.h
View File

@ -1,6 +1,8 @@
#ifndef VALUE_H__ #ifndef VALUE_H__
#define VALUE_H__ #define VALUE_H__
typedef int pic_sym;
enum pic_vtype { enum pic_vtype {
PIC_VTYPE_NIL, PIC_VTYPE_NIL,
PIC_VTYPE_TRUE, PIC_VTYPE_TRUE,
@ -8,6 +10,7 @@ enum pic_vtype {
PIC_VTYPE_UNDEF, PIC_VTYPE_UNDEF,
PIC_VTYPE_FLOAT, PIC_VTYPE_FLOAT,
PIC_VTYPE_INT, PIC_VTYPE_INT,
PIC_VTYPE_SYMBOL,
PIC_VTYPE_EOF, PIC_VTYPE_EOF,
PIC_VTYPE_HEAP PIC_VTYPE_HEAP
}; };
@ -18,6 +21,7 @@ typedef struct {
void *data; void *data;
double f; double f;
int i; int i;
pic_sym sym;
} u; } u;
} pic_value; } pic_value;
@ -27,11 +31,11 @@ enum pic_tt {
PIC_TT_BOOL, PIC_TT_BOOL,
PIC_TT_FLOAT, PIC_TT_FLOAT,
PIC_TT_INT, PIC_TT_INT,
PIC_TT_SYMBOL,
PIC_TT_EOF, PIC_TT_EOF,
PIC_TT_UNDEF, PIC_TT_UNDEF,
/* heap */ /* heap */
PIC_TT_PAIR, PIC_TT_PAIR,
PIC_TT_SYMBOL,
PIC_TT_PROC, PIC_TT_PROC,
PIC_TT_PORT, PIC_TT_PORT,
PIC_TT_STRING, PIC_TT_STRING,
@ -51,11 +55,6 @@ struct pic_pair {
pic_value cdr; pic_value cdr;
}; };
struct pic_symbol {
PIC_OBJECT_HEADER
char *name;
};
struct pic_string { struct pic_string {
PIC_OBJECT_HEADER PIC_OBJECT_HEADER
char *str; char *str;
@ -67,7 +66,6 @@ struct pic_port;
#define pic_obj_ptr(o) ((struct pic_object *)o.u.data) #define pic_obj_ptr(o) ((struct pic_object *)o.u.data)
#define pic_pair_ptr(o) ((struct pic_pair *)o.u.data) #define pic_pair_ptr(o) ((struct pic_pair *)o.u.data)
#define pic_symbol_ptr(o) ((struct pic_symbol *)o.u.data)
#define pic_str_ptr(v) ((struct pic_string *)v.u.data) #define pic_str_ptr(v) ((struct pic_string *)v.u.data)
enum pic_tt pic_type(pic_value); enum pic_tt pic_type(pic_value);
@ -80,9 +78,11 @@ pic_value pic_undef_value();
pic_value pic_obj_value(void *); pic_value pic_obj_value(void *);
pic_value pic_float_value(double); pic_value pic_float_value(double);
pic_value pic_int_value(int); pic_value pic_int_value(int);
pic_value pic_symbol_value(pic_sym);
#define pic_float(v) ((v).u.f) #define pic_float(v) ((v).u.f)
#define pic_int(v) ((v).u.i) #define pic_int(v) ((v).u.i)
#define pic_sym(v) ((v).u.sym)
#define pic_nil_p(v) ((v).type == PIC_VTYPE_NIL) #define pic_nil_p(v) ((v).type == PIC_VTYPE_NIL)
#define pic_true_p(v) ((v).type == PIC_VTYPE_TRUE) #define pic_true_p(v) ((v).type == PIC_VTYPE_TRUE)
@ -90,8 +90,8 @@ pic_value pic_int_value(int);
#define pic_undef_p(v) ((v).type == PIC_VTYPE_UNDEF) #define pic_undef_p(v) ((v).type == PIC_VTYPE_UNDEF)
#define pic_float_p(v) ((v).type == PIC_VTYPE_FLOAT) #define pic_float_p(v) ((v).type == PIC_VTYPE_FLOAT)
#define pic_int_p(v) ((v).type == PIC_VTYPE_INT) #define pic_int_p(v) ((v).type == PIC_VTYPE_INT)
#define pic_symbol_p(v) ((v).type == PIC_VTYPE_SYMBOL)
#define pic_pair_p(v) (pic_type(v) == PIC_TT_PAIR) #define pic_pair_p(v) (pic_type(v) == PIC_TT_PAIR)
#define pic_symbol_p(v) (pic_type(v) == PIC_TT_SYMBOL)
#define pic_str_p(v) (pic_type(v) == PIC_TT_STRING) #define pic_str_p(v) (pic_type(v) == PIC_TT_STRING)
#endif #endif

2
src/bool.c
View File

@ -12,7 +12,7 @@ pic_eq_p(pic_state *pic, pic_value x, pic_value y)
case PIC_TT_NIL: case PIC_TT_NIL:
return true; return true;
case PIC_TT_SYMBOL: case PIC_TT_SYMBOL:
return pic_symbol_ptr(x) == pic_symbol_ptr(y); return pic_sym(x) == pic_sym(y);
default: default:
return false; return false;
} }

473
src/codegen.c
View File

@ -51,14 +51,14 @@ new_local_scope(pic_state *pic, pic_value args, codegen_scope *scope)
pic_value sym; pic_value sym;
sym = pic_car(pic, v); sym = pic_car(pic, v);
xh_put(x, pic_symbol_ptr(sym)->name, i++); xh_put(x, pic_symbol_name(pic, pic_sym(sym)), i++);
} }
if (pic_nil_p(v)) { if (pic_nil_p(v)) {
/* pass */ /* pass */
} }
else if (pic_symbol_p(v)) { else if (pic_symbol_p(v)) {
new_scope->varg = true; new_scope->varg = true;
xh_put(x, pic_symbol_ptr(v)->name, i); xh_put(x, pic_symbol_name(pic, pic_sym(v)), i);
} }
else { else {
pic_error(pic, "logic flaw"); pic_error(pic, "logic flaw");
@ -179,7 +179,7 @@ codegen(codegen_state *state, pic_value obj)
int depth, idx; int depth, idx;
const char *name; const char *name;
name = pic_symbol_ptr(obj)->name; name = pic_symbol_name(pic, pic_sym(obj));
s = scope_lookup(state, name, &depth, &idx); s = scope_lookup(state, name, &depth, &idx);
if (! s) { if (! s) {
pic_error(pic, "unbound variable"); pic_error(pic, "unbound variable");
@ -213,256 +213,259 @@ codegen(codegen_state *state, pic_value obj)
} }
proc = pic_car(pic, obj); proc = pic_car(pic, obj);
if (pic_eq_p(pic, proc, pic->sDEFINE)) { if (pic_symbol_p(proc)) {
int idx; pic_sym sym = pic_sym(proc);
pic_value var, val;
if (pic_length(pic, obj) < 3) { if (sym == pic->sDEFINE) {
pic_error(pic, "syntax error"); int idx;
} pic_value var, val;
var = pic_car(pic, pic_cdr(pic, obj)); if (pic_length(pic, obj) < 3) {
if (pic_pair_p(var)) {
val = pic_cons(pic, pic->sLAMBDA,
pic_cons(pic, pic_cdr(pic, var),
pic_cdr(pic, pic_cdr(pic, obj))));
var = pic_car(pic, var);
}
else {
if (pic_length(pic, obj) != 3) {
pic_error(pic, "syntax error"); pic_error(pic, "syntax error");
} }
val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)));
}
if (! pic_symbol_p(var)) {
pic_error(pic, "syntax error");
}
idx = scope_global_define(pic, pic_symbol_ptr(var)->name); var = pic_car(pic, pic_cdr(pic, obj));
if (pic_pair_p(var)) {
val = pic_cons(pic, pic_symbol_value(pic->sLAMBDA),
pic_cons(pic, pic_cdr(pic, var),
pic_cdr(pic, pic_cdr(pic, obj))));
var = pic_car(pic, var);
}
else {
if (pic_length(pic, obj) != 3) {
pic_error(pic, "syntax error");
}
val = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)));
}
if (! pic_symbol_p(var)) {
pic_error(pic, "syntax error");
}
codegen(state, val); idx = scope_global_define(pic, pic_symbol_name(pic, pic_sym(var)));
irep->code[irep->clen].insn = OP_GSET;
irep->code[irep->clen].u.i = idx;
irep->clen++;
irep->code[irep->clen].insn = OP_PUSHFALSE;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sLAMBDA)) {
int k = pic->ilen++;
irep->code[irep->clen].insn = OP_LAMBDA;
irep->code[irep->clen].u.i = k;
irep->clen++;
pic->irep[k] = codegen_lambda(state, obj); codegen(state, val);
break;
}
else if (pic_eq_p(pic, proc, pic->sIF)) {
int s,t;
if (pic_length(pic, obj) != 4) {
pic_error(pic, "syntax error");
}
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_JMPIF;
s = irep->clen++;
/* if false branch */
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))));
irep->code[irep->clen].insn = OP_JMP;
t = irep->clen++;
irep->code[s].u.i = irep->clen - s;
/* if true branch */
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[t].u.i = irep->clen - t;
break;
}
else if (pic_eq_p(pic, proc, pic->sBEGIN)) {
pic_value v, seq;
seq = pic_cdr(pic, obj);
for (v = seq; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
codegen(state, pic_car(pic, v));
irep->code[irep->clen].insn = OP_POP;
irep->clen++;
}
irep->clen--;
break;
}
else if (pic_eq_p(pic, proc, pic->sSETBANG)) {
codegen_scope *s;
pic_value var;
int depth, idx;
if (pic_length(pic, obj) != 3) {
pic_error(pic, "syntax error");
}
var = pic_car(pic, pic_cdr(pic, obj));
if (! pic_symbol_p(var)) {
pic_error(pic, "syntax error");
}
s = scope_lookup(state, pic_symbol_ptr(var)->name, &depth, &idx);
if (! s) {
pic_error(pic, "unbound variable");
}
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
switch (depth) {
case -1: /* global */
irep->code[irep->clen].insn = OP_GSET; irep->code[irep->clen].insn = OP_GSET;
irep->code[irep->clen].u.i = idx; irep->code[irep->clen].u.i = idx;
irep->clen++; irep->clen++;
irep->code[irep->clen].insn = OP_PUSHFALSE;
irep->clen++;
break; break;
default: /* nonlocal */ }
/* dirty flag */ else if (sym == pic->sLAMBDA) {
s->cv_tbl[idx] = 1; int k = pic->ilen++;
/* at this stage, lset and cset are not distinguished */ irep->code[irep->clen].insn = OP_LAMBDA;
FALLTHROUGH; irep->code[irep->clen].u.i = k;
case 0: /* local */ irep->clen++;
irep->code[irep->clen].insn = OP_CSET;
irep->code[irep->clen].u.c.depth = depth; pic->irep[k] = codegen_lambda(state, obj);
irep->code[irep->clen].u.c.idx = idx; break;
}
else if (sym == pic->sIF) {
int s,t;
if (pic_length(pic, obj) != 4) {
pic_error(pic, "syntax error");
}
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_JMPIF;
s = irep->clen++;
/* if false branch */
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))));
irep->code[irep->clen].insn = OP_JMP;
t = irep->clen++;
irep->code[s].u.i = irep->clen - s;
/* if true branch */
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[t].u.i = irep->clen - t;
break;
}
else if (sym == pic->sBEGIN) {
pic_value v, seq;
seq = pic_cdr(pic, obj);
for (v = seq; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
codegen(state, pic_car(pic, v));
irep->code[irep->clen].insn = OP_POP;
irep->clen++;
}
irep->clen--;
break;
}
else if (sym == pic->sSETBANG) {
codegen_scope *s;
pic_value var;
int depth, idx;
if (pic_length(pic, obj) != 3) {
pic_error(pic, "syntax error");
}
var = pic_car(pic, pic_cdr(pic, obj));
if (! pic_symbol_p(var)) {
pic_error(pic, "syntax error");
}
s = scope_lookup(state, pic_symbol_name(pic, pic_sym(var)), &depth, &idx);
if (! s) {
pic_error(pic, "unbound variable");
}
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
switch (depth) {
case -1: /* global */
irep->code[irep->clen].insn = OP_GSET;
irep->code[irep->clen].u.i = idx;
irep->clen++;
break;
default: /* nonlocal */
/* dirty flag */
s->cv_tbl[idx] = 1;
/* at this stage, lset and cset are not distinguished */
FALLTHROUGH;
case 0: /* local */
irep->code[irep->clen].insn = OP_CSET;
irep->code[irep->clen].u.c.depth = depth;
irep->code[irep->clen].u.c.idx = idx;
irep->clen++;
break;
}
irep->code[irep->clen].insn = OP_PUSHFALSE;
irep->clen++;
break;
}
else if (sym == pic->sQUOTE) {
int pidx;
if (pic_length(pic, obj) != 2) {
pic_error(pic, "syntax error");
}
pidx = pic->plen++;
pic->pool[pidx] = pic_car(pic, pic_cdr(pic, obj));
irep->code[irep->clen].insn = OP_PUSHCONST;
irep->code[irep->clen].u.i = pidx;
irep->clen++; irep->clen++;
break; break;
} }
irep->code[irep->clen].insn = OP_PUSHFALSE;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sQUOTE)) {
int pidx;
if (pic_length(pic, obj) != 2) {
pic_error(pic, "syntax error");
}
pidx = pic->plen++;
pic->pool[pidx] = pic_car(pic, pic_cdr(pic, obj));
irep->code[irep->clen].insn = OP_PUSHCONST;
irep->code[irep->clen].u.i = pidx;
irep->clen++;
break;
}
#define ARGC_ASSERT(n) do { \ #define ARGC_ASSERT(n) do { \
if (pic_length(pic, obj) != (n) + 1) { \ if (pic_length(pic, obj) != (n) + 1) { \
pic_error(pic, "wrong number of arguments"); \ pic_error(pic, "wrong number of arguments"); \
} \ } \
} while (0) } while (0)
else if (pic_eq_p(pic, proc, pic->sCONS)) { else if (sym == pic->sCONS) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[irep->clen].insn = OP_CONS; irep->code[irep->clen].insn = OP_CONS;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sCAR)) { else if (sym == pic->sCAR) {
ARGC_ASSERT(1); ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_CAR; irep->code[irep->clen].insn = OP_CAR;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sCDR)) { else if (sym == pic->sCDR) {
ARGC_ASSERT(1); ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_CDR; irep->code[irep->clen].insn = OP_CDR;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sNILP)) { else if (sym == pic->sNILP) {
ARGC_ASSERT(1); ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_NILP; irep->code[irep->clen].insn = OP_NILP;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sADD)) { else if (sym == pic->sADD) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[irep->clen].insn = OP_ADD; irep->code[irep->clen].insn = OP_ADD;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sSUB)) { else if (sym == pic->sSUB) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[irep->clen].insn = OP_SUB; irep->code[irep->clen].insn = OP_SUB;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sMUL)) { else if (sym == pic->sMUL) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[irep->clen].insn = OP_MUL; irep->code[irep->clen].insn = OP_MUL;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sDIV)) { else if (sym == pic->sDIV) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[irep->clen].insn = OP_DIV; irep->code[irep->clen].insn = OP_DIV;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sEQ)) { else if (sym == pic->sEQ) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[irep->clen].insn = OP_EQ; irep->code[irep->clen].insn = OP_EQ;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sLT)) { else if (sym == pic->sLT) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[irep->clen].insn = OP_LT; irep->code[irep->clen].insn = OP_LT;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sLE)) { else if (sym == pic->sLE) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
irep->code[irep->clen].insn = OP_LE; irep->code[irep->clen].insn = OP_LE;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sGT)) { else if (sym == pic->sGT) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_LT; irep->code[irep->clen].insn = OP_LT;
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, pic->sGE)) { else if (sym == pic->sGE) {
ARGC_ASSERT(2); ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_LE; irep->code[irep->clen].insn = OP_LE;
irep->clen++; irep->clen++;
break; break;
} }
else {
codegen_call(state, obj);
break;
} }
codegen_call(state, obj);
break;
} }
case PIC_TT_BOOL: { case PIC_TT_BOOL: {
if (pic_true_p(obj)) { if (pic_true_p(obj)) {

41
src/gc.c
View File

@ -4,7 +4,6 @@
#include "picrin/gc.h" #include "picrin/gc.h"
#include "picrin/irep.h" #include "picrin/irep.h"
#include "picrin/proc.h" #include "picrin/proc.h"
#include "picrin/symbol.h"
#include "picrin/port.h" #include "picrin/port.h"
#if GC_DEBUG #if GC_DEBUG
@ -156,9 +155,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
gc_mark(pic, ((struct pic_pair *)obj)->cdr); gc_mark(pic, ((struct pic_pair *)obj)->cdr);
break; break;
} }
case PIC_TT_SYMBOL: {
break;
}
case PIC_TT_ENV: { case PIC_TT_ENV: {
struct pic_env *env = (struct pic_env *)obj; struct pic_env *env = (struct pic_env *)obj;
int i; int i;
@ -186,6 +182,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_BOOL: case PIC_TT_BOOL:
case PIC_TT_FLOAT: case PIC_TT_FLOAT:
case PIC_TT_INT: case PIC_TT_INT:
case PIC_TT_SYMBOL:
case PIC_TT_EOF: case PIC_TT_EOF:
case PIC_TT_UNDEF: case PIC_TT_UNDEF:
pic_abort(pic, "logic flaw"); pic_abort(pic, "logic flaw");
@ -214,7 +211,6 @@ gc_mark_phase(pic_state *pic)
for (stack = pic->stbase; stack != pic->sp; ++stack) { for (stack = pic->stbase; stack != pic->sp; ++stack) {
gc_mark(pic, *stack); gc_mark(pic, *stack);
} }
gc_mark(pic, *stack);
/* arena */ /* arena */
for (i = 0; i < pic->arena_idx; ++i) { for (i = 0; i < pic->arena_idx; ++i) {
@ -230,34 +226,6 @@ gc_mark_phase(pic_state *pic)
for (i = 0; i < pic->plen; ++i) { for (i = 0; i < pic->plen; ++i) {
gc_mark(pic, pic->pool[i]); gc_mark(pic, pic->pool[i]);
} }
/* symbol table */
for (i = 0; i < pic->sym_tbl->size; ++i) {
gc_mark(pic, pic->sym_tbl->tbl[i]);
}
gc_mark(pic, pic->sDEFINE);
gc_mark(pic, pic->sLAMBDA);
gc_mark(pic, pic->sIF);
gc_mark(pic, pic->sBEGIN);
gc_mark(pic, pic->sSETBANG);
gc_mark(pic, pic->sQUOTE);
gc_mark(pic, pic->sQUASIQUOTE);
gc_mark(pic, pic->sUNQUOTE);
gc_mark(pic, pic->sUNQUOTE_SPLICING);
gc_mark(pic, pic->sCONS);
gc_mark(pic, pic->sCAR);
gc_mark(pic, pic->sCDR);
gc_mark(pic, pic->sNILP);
gc_mark(pic, pic->sADD);
gc_mark(pic, pic->sSUB);
gc_mark(pic, pic->sMUL);
gc_mark(pic, pic->sEQ);
gc_mark(pic, pic->sLT);
gc_mark(pic, pic->sLE);
gc_mark(pic, pic->sGT);
gc_mark(pic, pic->sGE);
gc_mark(pic, pic->sDIV);
} }
static bool static bool
@ -280,12 +248,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
#endif #endif
switch (obj->tt) { switch (obj->tt) {
case PIC_TT_SYMBOL: {
char *name;
name = ((struct pic_symbol *)obj)->name;
pic_free(pic, name);
break;
}
case PIC_TT_PAIR: { case PIC_TT_PAIR: {
break; break;
} }
@ -311,6 +273,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_BOOL: case PIC_TT_BOOL:
case PIC_TT_FLOAT: case PIC_TT_FLOAT:
case PIC_TT_INT: case PIC_TT_INT:
case PIC_TT_SYMBOL:
case PIC_TT_EOF: case PIC_TT_EOF:
case PIC_TT_UNDEF: case PIC_TT_UNDEF:
pic_abort(pic, "logic flaw"); pic_abort(pic, "logic flaw");

4
src/parse.y
View File

@ -58,7 +58,7 @@ program
} }
/* if multiple? */ /* if multiple? */
else { else {
p->value = pic_cons(p->pic, p->pic->sBEGIN, $1); p->value = pic_cons(p->pic, pic_symbol_value(p->pic->sBEGIN), $1);
} }
} }
| incomplete_program_data | incomplete_program_data
@ -92,7 +92,7 @@ datum
simple_datum simple_datum
: tSYMBOL : tSYMBOL
{ {
$$ = pic_intern_cstr(p->pic, $1); $$ = pic_symbol_value(pic_intern_cstr(p->pic, $1));
free($1); free($1);
} }
| tSTRING | tSTRING

2
src/port.c
View File

@ -27,7 +27,7 @@ write(pic_state *pic, pic_value obj)
printf(")"); printf(")");
break; break;
case PIC_TT_SYMBOL: case PIC_TT_SYMBOL:
printf("%s", pic_symbol_ptr(obj)->name); printf("%s", pic_symbol_name(pic, pic_sym(obj)));
break; break;
case PIC_TT_FLOAT: case PIC_TT_FLOAT:
printf("%f", pic_float(obj)); printf("%f", pic_float(obj));

21
src/state.c
View File

@ -3,24 +3,8 @@
#include "picrin.h" #include "picrin.h"
#include "picrin/gc.h" #include "picrin/gc.h"
#include "picrin/proc.h" #include "picrin/proc.h"
#include "picrin/symbol.h"
#include "xhash/xhash.h" #include "xhash/xhash.h"
struct sym_tbl *
sym_tbl_new()
{
struct sym_tbl *s_tbl;
int i;
s_tbl = (struct sym_tbl *)malloc(sizeof(struct sym_tbl));
s_tbl->size = PIC_SYM_TBL_SIZE;
for (i = 0; i < PIC_SYM_TBL_SIZE; ++i) {
s_tbl->tbl[i] = pic_nil_value();
}
return s_tbl;
}
void pic_init_core(pic_state *); void pic_init_core(pic_state *);
pic_state * pic_state *
@ -49,7 +33,10 @@ pic_open(int argc, char *argv[], char **envp)
init_heap_page(pic->heap); init_heap_page(pic->heap);
/* symbol table */ /* symbol table */
pic->sym_tbl = sym_tbl_new(); pic->sym_tbl = xh_new();
pic->sym_pool = (const char **)malloc(sizeof(const char *) * PIC_SYM_POOL_SIZE);
pic->slen = 0;
pic->scapa = pic->slen + PIC_SYM_POOL_SIZE;
/* irep */ /* irep */
pic->irep = (struct pic_irep **)malloc(sizeof(struct pic_irep *) * PIC_IREP_SIZE); pic->irep = (struct pic_irep **)malloc(sizeof(struct pic_irep *) * PIC_IREP_SIZE);

72
src/symbol.c
View File

@ -2,65 +2,27 @@
#include <stdlib.h> #include <stdlib.h>
#include "picrin.h" #include "picrin.h"
#include "picrin/pair.h" #include "xhash/xhash.h"
#include "picrin/symbol.h"
static int pic_sym
str_hash(const char *str)
{
int hash = 0, len, i;
len = strlen(str);
for (i = 0; i < len; ++i) {
hash = hash * 31 + str[i];
}
return hash;
}
pic_value
sym_tbl_get(struct sym_tbl *s_tbl, const char *key)
{
int hash, idx;
pic_value v, k;
char *name;
hash = str_hash(key);
idx = hash % s_tbl->size;
for (v = s_tbl->tbl[idx]; ! pic_nil_p(v); v = pic_pair_ptr(v)->cdr) {
k = pic_pair_ptr(v)->car;
name = pic_symbol_ptr(k)->name;
if (strcmp(name, key) == 0) {
return k;
}
}
return pic_undef_value();
}
pic_value
pic_intern_cstr(pic_state *pic, const char *str) pic_intern_cstr(pic_state *pic, const char *str)
{ {
pic_value v; struct xh_entry *e;
int len, hash, idx; pic_sym id;
char *new_str;
struct pic_symbol *sym;
v = sym_tbl_get(pic->sym_tbl, str); e = xh_get(pic->sym_tbl, str);
if (! pic_undef_p(v)) { if (e) {
return v; return e->val;
} }
/* clone name string */ id = pic->slen++;
len = strlen(str); pic->sym_pool[id] = strdup(str);
new_str = (char *)pic_alloc(pic, len + 1); xh_put(pic->sym_tbl, str, id);
strncpy(new_str, str, len + 1); return id;
}
sym = (struct pic_symbol*)pic_obj_alloc(pic, sizeof(struct pic_symbol), PIC_TT_SYMBOL);
sym->name = new_str; const char *
v = pic_obj_value(sym); pic_symbol_name(pic_state *pic, pic_sym sym)
{
hash = str_hash(str); return pic->sym_pool[sym];
idx = hash % pic->sym_tbl->size;
pic->sym_tbl->tbl[idx] = pic_cons(pic, v, pic->sym_tbl->tbl[idx]);
return v;
} }

12
src/value.c
View File

@ -19,6 +19,8 @@ pic_type(pic_value v)
return PIC_TT_FLOAT; return PIC_TT_FLOAT;
case PIC_VTYPE_INT: case PIC_VTYPE_INT:
return PIC_TT_INT; return PIC_TT_INT;
case PIC_VTYPE_SYMBOL:
return PIC_TT_SYMBOL;
case PIC_VTYPE_EOF: case PIC_VTYPE_EOF:
return PIC_TT_EOF; return PIC_TT_EOF;
case PIC_VTYPE_HEAP: case PIC_VTYPE_HEAP:
@ -98,6 +100,16 @@ pic_int_value(int i)
return v; return v;
} }
pic_value
pic_symbol_value(pic_sym sym)
{
pic_value v;
v.type = PIC_VTYPE_SYMBOL;
v.u.sym = sym;
return v;
}
pic_value pic_value
pic_undef_value() pic_undef_value()
{ {