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_IREP_SIZE 256
#define PIC_GLOBALS_SIZE 1024
#define PIC_SYM_TBL_SIZE 128
#define PIC_SYM_POOL_SIZE 128
#define PIC_POOL_SIZE 1024
/* enable all debug flags */

19
include/picrin.h
View File

@ -27,13 +27,15 @@ typedef struct {
pic_callinfo *ci;
pic_callinfo *cibase, *ciend;
pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG;
pic_value sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
pic_value sCONS, sCAR, sCDR, sNILP;
pic_value sADD, sSUB, sMUL, sDIV;
pic_value sEQ, sLT, sLE, sGT, sGE;
pic_sym sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG;
pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
pic_sym sCONS, sCAR, sCDR, sNILP;
pic_sym sADD, sSUB, sMUL, sDIV;
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;
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);
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_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__
#define VALUE_H__
typedef int pic_sym;
enum pic_vtype {
PIC_VTYPE_NIL,
PIC_VTYPE_TRUE,
@ -8,6 +10,7 @@ enum pic_vtype {
PIC_VTYPE_UNDEF,
PIC_VTYPE_FLOAT,
PIC_VTYPE_INT,
PIC_VTYPE_SYMBOL,
PIC_VTYPE_EOF,
PIC_VTYPE_HEAP
};
@ -18,6 +21,7 @@ typedef struct {
void *data;
double f;
int i;
pic_sym sym;
} u;
} pic_value;
@ -27,11 +31,11 @@ enum pic_tt {
PIC_TT_BOOL,
PIC_TT_FLOAT,
PIC_TT_INT,
PIC_TT_SYMBOL,
PIC_TT_EOF,
PIC_TT_UNDEF,
/* heap */
PIC_TT_PAIR,
PIC_TT_SYMBOL,
PIC_TT_PROC,
PIC_TT_PORT,
PIC_TT_STRING,
@ -51,11 +55,6 @@ struct pic_pair {
pic_value cdr;
};
struct pic_symbol {
PIC_OBJECT_HEADER
char *name;
};
struct pic_string {
PIC_OBJECT_HEADER
char *str;
@ -67,7 +66,6 @@ struct pic_port;
#define pic_obj_ptr(o) ((struct pic_object *)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)
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_float_value(double);
pic_value pic_int_value(int);
pic_value pic_symbol_value(pic_sym);
#define pic_float(v) ((v).u.f)
#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_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_float_p(v) ((v).type == PIC_VTYPE_FLOAT)
#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_symbol_p(v) (pic_type(v) == PIC_TT_SYMBOL)
#define pic_str_p(v) (pic_type(v) == PIC_TT_STRING)
#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:
return true;
case PIC_TT_SYMBOL:
return pic_symbol_ptr(x) == pic_symbol_ptr(y);
return pic_sym(x) == pic_sym(y);
default:
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;
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)) {
/* pass */
}
else if (pic_symbol_p(v)) {
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 {
pic_error(pic, "logic flaw");
@ -179,7 +179,7 @@ codegen(codegen_state *state, pic_value obj)
int depth, idx;
const char *name;
name = pic_symbol_ptr(obj)->name;
name = pic_symbol_name(pic, pic_sym(obj));
s = scope_lookup(state, name, &depth, &idx);
if (! s) {
pic_error(pic, "unbound variable");
@ -213,256 +213,259 @@ codegen(codegen_state *state, pic_value obj)
}
proc = pic_car(pic, obj);
if (pic_eq_p(pic, proc, pic->sDEFINE)) {
int idx;
pic_value var, val;
if (pic_symbol_p(proc)) {
pic_sym sym = pic_sym(proc);
if (pic_length(pic, obj) < 3) {
pic_error(pic, "syntax error");
}
if (sym == pic->sDEFINE) {
int idx;
pic_value var, val;
var = pic_car(pic, pic_cdr(pic, obj));
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) {
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");
}
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);
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++;
idx = scope_global_define(pic, pic_symbol_name(pic, pic_sym(var)));
pic->irep[k] = codegen_lambda(state, obj);
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 */
codegen(state, val);
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;
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;
}
else if (sym == 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);
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++;
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 { \
if (pic_length(pic, obj) != (n) + 1) { \
pic_error(pic, "wrong number of arguments"); \
} \
} while (0)
if (pic_length(pic, obj) != (n) + 1) { \
pic_error(pic, "wrong number of arguments"); \
} \
} while (0)
else if (pic_eq_p(pic, proc, pic->sCONS)) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sCAR)) {
ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_CAR;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sCDR)) {
ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_CDR;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sNILP)) {
ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_NILP;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sADD)) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sSUB)) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sMUL)) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sDIV)) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sEQ)) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sLT)) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sLE)) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sGT)) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_LT;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, pic->sGE)) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_LE;
irep->clen++;
break;
}
else {
codegen_call(state, obj);
break;
else if (sym == pic->sCONS) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (sym == pic->sCAR) {
ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_CAR;
irep->clen++;
break;
}
else if (sym == pic->sCDR) {
ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_CDR;
irep->clen++;
break;
}
else if (sym == pic->sNILP) {
ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_NILP;
irep->clen++;
break;
}
else if (sym == pic->sADD) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (sym == pic->sSUB) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (sym == pic->sMUL) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (sym == pic->sDIV) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (sym == pic->sEQ) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (sym == pic->sLT) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (sym == pic->sLE) {
ARGC_ASSERT(2);
codegen(state, pic_car(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->clen++;
break;
}
else if (sym == pic->sGT) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_LT;
irep->clen++;
break;
}
else if (sym == pic->sGE) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
codegen(state, pic_car(pic, pic_cdr(pic, obj)));
irep->code[irep->clen].insn = OP_LE;
irep->clen++;
break;
}
}
codegen_call(state, obj);
break;
}
case PIC_TT_BOOL: {
if (pic_true_p(obj)) {

41
src/gc.c
View File

@ -4,7 +4,6 @@
#include "picrin/gc.h"
#include "picrin/irep.h"
#include "picrin/proc.h"
#include "picrin/symbol.h"
#include "picrin/port.h"
#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);
break;
}
case PIC_TT_SYMBOL: {
break;
}
case PIC_TT_ENV: {
struct pic_env *env = (struct pic_env *)obj;
int i;
@ -186,6 +182,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_BOOL:
case PIC_TT_FLOAT:
case PIC_TT_INT:
case PIC_TT_SYMBOL:
case PIC_TT_EOF:
case PIC_TT_UNDEF:
pic_abort(pic, "logic flaw");
@ -214,7 +211,6 @@ gc_mark_phase(pic_state *pic)
for (stack = pic->stbase; stack != pic->sp; ++stack) {
gc_mark(pic, *stack);
}
gc_mark(pic, *stack);
/* arena */
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) {
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
@ -280,12 +248,6 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
#endif
switch (obj->tt) {
case PIC_TT_SYMBOL: {
char *name;
name = ((struct pic_symbol *)obj)->name;
pic_free(pic, name);
break;
}
case PIC_TT_PAIR: {
break;
}
@ -311,6 +273,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_BOOL:
case PIC_TT_FLOAT:
case PIC_TT_INT:
case PIC_TT_SYMBOL:
case PIC_TT_EOF:
case PIC_TT_UNDEF:
pic_abort(pic, "logic flaw");

4
src/parse.y
View File

@ -58,7 +58,7 @@ program
}
/* if multiple? */
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
@ -92,7 +92,7 @@ datum
simple_datum
: tSYMBOL
{
$$ = pic_intern_cstr(p->pic, $1);
$$ = pic_symbol_value(pic_intern_cstr(p->pic, $1));
free($1);
}
| tSTRING

2
src/port.c
View File

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

21
src/state.c
View File

@ -3,24 +3,8 @@
#include "picrin.h"
#include "picrin/gc.h"
#include "picrin/proc.h"
#include "picrin/symbol.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 *);
pic_state *
@ -49,7 +33,10 @@ pic_open(int argc, char *argv[], char **envp)
init_heap_page(pic->heap);
/* 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 */
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 "picrin.h"
#include "picrin/pair.h"
#include "picrin/symbol.h"
#include "xhash/xhash.h"
static int
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_sym
pic_intern_cstr(pic_state *pic, const char *str)
{
pic_value v;
int len, hash, idx;
char *new_str;
struct pic_symbol *sym;
struct xh_entry *e;
pic_sym id;
v = sym_tbl_get(pic->sym_tbl, str);
if (! pic_undef_p(v)) {
return v;
e = xh_get(pic->sym_tbl, str);
if (e) {
return e->val;
}
/* clone name string */
len = strlen(str);
new_str = (char *)pic_alloc(pic, len + 1);
strncpy(new_str, str, len + 1);
sym = (struct pic_symbol*)pic_obj_alloc(pic, sizeof(struct pic_symbol), PIC_TT_SYMBOL);
sym->name = new_str;
v = pic_obj_value(sym);
hash = str_hash(str);
idx = hash % pic->sym_tbl->size;
pic->sym_tbl->tbl[idx] = pic_cons(pic, v, pic->sym_tbl->tbl[idx]);
return v;
id = pic->slen++;
pic->sym_pool[id] = strdup(str);
xh_put(pic->sym_tbl, str, id);
return id;
}
const char *
pic_symbol_name(pic_state *pic, pic_sym sym)
{
return pic->sym_pool[sym];
}

12
src/value.c
View File

@ -19,6 +19,8 @@ pic_type(pic_value v)
return PIC_TT_FLOAT;
case PIC_VTYPE_INT:
return PIC_TT_INT;
case PIC_VTYPE_SYMBOL:
return PIC_TT_SYMBOL;
case PIC_VTYPE_EOF:
return PIC_TT_EOF;
case PIC_VTYPE_HEAP:
@ -98,6 +100,16 @@ pic_int_value(int i)
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_undef_value()
{