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

use xhash to manage scopes during codegin

This commit is contained in:
Yuichi Nishiwaki 2013-10-22 22:22:35 +09:00
parent 5da1b175a7
commit dd3adf30e6
8 changed files with 227 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -11,7 +11,7 @@ build-lib:
cd src; \
yacc -d parse.y; \
lex scan.l
$(CC) -Wall -shared -o lib/libpicrin.so -I./include src/*.c
$(CC) -Wall -shared -o lib/libpicrin.so -I./include -I./extlib src/*.c
clean:
rm -f src/y.tab.c src/y.tab.h src/lex.yy.c

104
extlib/xhash/xhash.h Normal file
View File

@ -0,0 +1,104 @@
#ifndef XHASH_H__
#define XHASH_H__
/*
* Copyright (c) 2013 by Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
*/
#include <stdlib.h>
#include <string.h>
/* simple string to int hash table */
#define XHASH_INIT_SIZE 11
struct xh_entry {
struct xh_entry *next;
const char *key;
int val;
};
struct xhash {
struct xh_entry **buckets;
size_t size;
};
static inline struct xhash *
xh_new()
{
struct xhash *x;
x = (struct xhash *)malloc(sizeof(struct xhash));
x->size = XHASH_INIT_SIZE;
x->buckets = (struct xh_entry **)calloc(XHASH_INIT_SIZE, sizeof(struct xh_entry *));
return x;
}
static int
xh_hash(const char *str)
{
int hash = 0;
while (*str) {
hash = hash * 31 + *str++;
}
return hash;
}
static inline struct xh_entry *
xh_get(struct xhash *x, const char *key)
{
int idx;
struct xh_entry *e;
idx = xh_hash(key) % x->size;
for (e = x->buckets[idx]; e; e = e->next) {
if (! strcmp(key, e->key))
return e;
}
return NULL;
}
static inline struct xh_entry *
xh_put(struct xhash *x, const char *key, int val)
{
int idx, len;
char *new_key;
struct xh_entry *e;
if ((e = xh_get(x, key))) {
e->val = val;
return e;
}
len = strlen(key);
new_key = (char *)malloc(len+1);
strcpy(new_key, key);
idx = xh_hash(key) % x->size;
e = (struct xh_entry *)malloc(sizeof(struct xh_entry));
e->next = x->buckets[idx];
e->key = new_key;
e->val = val;
return x->buckets[idx] = e;
}
static inline void
xh_destory(struct xhash *x)
{
int i;
struct xh_entry *e;
for (i = 0; i < x->size; ++i) {
e = x->buckets[i];
while (e) {
e = e->next;
free((void*)e->key);
free(e);
}
}
free(x);
}
#endif

6
include/picrin.h
View File

@ -29,12 +29,13 @@ typedef struct {
pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE;
pic_value sCONS, sCAR, sCDR, sNILP;
pic_value sADD, sSUB, sMUL, sDIV;
struct pic_env *global_env;
struct sym_tbl *sym_tbl;
struct xhash *global_tbl;
pic_value *globals;
size_t glen, gcapa;
struct pic_irep **irep;
size_t ilen, icapa;
pic_value *pool;
@ -74,9 +75,8 @@ pic_value pic_str_new_cstr(pic_state *, const char *);
bool pic_parse(pic_state *, const char *, pic_value *);
pic_value pic_eval(pic_state *, pic_value, struct pic_env *);
pic_value pic_run(pic_state *, struct pic_proc *, pic_value);
struct pic_proc *pic_codegen(pic_state *, pic_value, struct pic_env *);
struct pic_proc *pic_codegen(pic_state *, pic_value);
void pic_abort(pic_state *, const char *);
void pic_raise(pic_state *, pic_value);

5
include/picrin/proc.h
View File

@ -1,11 +1,6 @@
#ifndef PROC_H__
#define PROC_H__
struct pic_env {
pic_value assoc;
struct pic_env *parent;
};
struct pic_proc {
PIC_OBJECT_HEADER
bool cfunc_p;

189
src/codegen.c
View File

@ -4,28 +4,81 @@
#include "picrin/pair.h"
#include "picrin/irep.h"
#include "picrin/proc.h"
#include "xhash/xhash.h"
struct pic_scope {
struct pic_scope *up;
struct xhash *local_tbl;
size_t localc;
};
static struct pic_scope *
new_global_scope(pic_state *pic)
{
struct pic_scope *scope;
scope = (struct pic_scope *)pic_alloc(pic, sizeof(struct pic_scope));
scope->up = NULL;
scope->local_tbl = pic->global_tbl;
scope->localc = -1;
return scope;
}
static struct pic_scope *
new_local_scope(pic_state *pic, pic_value args, struct pic_scope *scope)
{
struct pic_scope *new_scope;
pic_value v;
int i;
struct xhash *x;
new_scope = (struct pic_scope *)pic_alloc(pic, sizeof(struct pic_scope));
new_scope->up = scope;
new_scope->local_tbl = x = xh_new();
i = -1;
for (v = args; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
pic_value sym;
sym = pic_car(pic, v);
xh_put(x, pic_symbol_ptr(sym)->name, i--);
}
new_scope->localc = -1-i;
return new_scope;
}
static void
destory_scope(pic_state *pic, struct pic_scope *scope)
{
if (scope->up) {
xh_destory(scope->local_tbl);
}
pic_free(pic, scope);
}
static bool
env_lookup(pic_state *pic, pic_value sym, struct pic_env *env, int *depth, int *idx)
scope_lookup(pic_state *pic, const char *key, struct pic_scope *scope, int *depth, int *idx)
{
pic_value v;
struct xh_entry *e;
int d = 0;
enter:
v = pic_assq(pic, sym, env->assoc);
if (! pic_nil_p(v)) {
if (env->parent == NULL) { /* global */
e = xh_get(scope->local_tbl, key);
if (e) {
if (scope->up == NULL) { /* global */
*depth = -1;
}
else { /* non-global */
*depth = d;
}
*idx = (int)pic_float(pic_pair_ptr(v)->cdr);
*idx = e->val;
return true;
}
if (env->parent) {
env = env->parent;
if (scope->up) {
scope = scope->up;
++d;
goto enter;
}
@ -33,42 +86,18 @@ env_lookup(pic_state *pic, pic_value sym, struct pic_env *env, int *depth, int *
}
static int
env_global_define(pic_state *pic, pic_value sym)
scope_global_define(pic_state *pic, const char *name)
{
pic_value f;
int d, idx;
struct xh_entry *e;
if (env_lookup(pic, sym, pic->global_env, &d, &idx)) {
return idx;
if ((e = xh_get(pic->global_tbl, name))) {
return e->val;
}
idx = pic->glen++;
f = pic_float_value(idx);
pic->global_env->assoc = pic_acons(pic, sym, f, pic->global_env->assoc);
return idx;
e = xh_put(pic->global_tbl, name, pic->glen++);
if (pic->glen >= pic->gcapa) {
pic_error(pic, "global table overflow");
}
static struct pic_env *
env_new(pic_state *pic, pic_value args, struct pic_env *env)
{
struct pic_env *inner_env;
pic_value v, f;
int i;
inner_env = (struct pic_env *)pic_alloc(pic, sizeof(struct pic_env));
inner_env->assoc = pic_nil_value();
inner_env->parent = env;
i = -1;
for (v = args; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
pic_value sym = pic_car(pic, v);
f = pic_float_value(i--);
inner_env->assoc = pic_acons(pic, sym, f, inner_env->assoc);
}
return inner_env;
return e->val;
}
void
@ -78,7 +107,7 @@ pic_defun(pic_state *pic, const char *name, pic_func_t cfunc)
int idx;
proc = pic_proc_new_cfunc(pic, cfunc, pic_undef_value());
idx = env_global_define(pic, pic_intern_cstr(pic, name));
idx = scope_global_define(pic, name);
pic->globals[idx] = pic_obj_value(proc);
}
@ -177,11 +206,11 @@ new_irep(pic_state *pic)
return irep;
}
static void pic_gen_call(pic_state *, struct pic_irep *, pic_value, struct pic_env *);
static struct pic_irep *pic_gen_lambda(pic_state *, pic_value, struct pic_env *);
static void pic_gen_call(pic_state *, struct pic_irep *, pic_value, struct pic_scope *);
static struct pic_irep *pic_gen_lambda(pic_state *, pic_value, struct pic_scope *);
static void
pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env)
pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_scope *scope)
{
pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE;
pic_value sCONS, sCAR, sCDR, sNILP;
@ -205,8 +234,10 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
case PIC_TT_SYMBOL: {
bool b;
int depth, idx;
const char *name;
b = env_lookup(pic, obj, env, &depth, &idx);
name = pic_symbol_ptr(obj)->name;
b = scope_lookup(pic, name, scope, &depth, &idx);
if (! b) {
pic_error(pic, "unbound variable");
}
@ -232,10 +263,12 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
proc = pic_car(pic, obj);
if (pic_eq_p(pic, proc, sDEFINE)) {
int idx;
const char *name;
idx = env_global_define(pic, pic_car(pic, pic_cdr(pic, obj)));
name = pic_symbol_ptr(pic_car(pic, pic_cdr(pic, obj)))->name;
idx = scope_global_define(pic, name);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope);
irep->code[irep->clen].insn = OP_GSET;
irep->code[irep->clen].u.i = idx;
@ -249,26 +282,26 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
irep->code[irep->clen].u.i = pic->ilen;
irep->clen++;
pic->irep[pic->ilen++] = pic_gen_lambda(pic, obj, env);
pic->irep[pic->ilen++] = pic_gen_lambda(pic, obj, scope);
break;
}
else if (pic_eq_p(pic, proc, sIF)) {
int s,t;
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope);
irep->code[irep->clen].insn = OP_JMPIF;
s = irep->clen++;
/* if false branch */
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))), scope);
irep->code[irep->clen].insn = OP_JMP;
t = irep->clen++;
irep->code[s].u.i = irep->clen - s;
/* if true branch */
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope);
irep->code[t].u.i = irep->clen - t;
break;
}
@ -277,7 +310,7 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
seq = pic_cdr(pic, obj);
for (v = seq; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
pic_gen(pic, irep, pic_car(pic, v), env);
pic_gen(pic, irep, pic_car(pic, v), scope);
irep->code[irep->clen].insn = OP_POP;
irep->clen++;
}
@ -294,60 +327,60 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
break;
}
else if (pic_eq_p(pic, proc, sCONS)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope);
irep->code[irep->clen].insn = OP_CONS;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, sCAR)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope);
irep->code[irep->clen].insn = OP_CAR;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, sCDR)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope);
irep->code[irep->clen].insn = OP_CDR;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, sNILP)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope);
irep->code[irep->clen].insn = OP_NILP;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, sADD)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope);
irep->code[irep->clen].insn = OP_ADD;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, sSUB)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope);
irep->code[irep->clen].insn = OP_SUB;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, sMUL)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope);
irep->code[irep->clen].insn = OP_MUL;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, sDIV)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), scope);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), scope);
irep->code[irep->clen].insn = OP_DIV;
irep->clen++;
break;
}
else {
pic_gen_call(pic, irep, obj, env);
pic_gen_call(pic, irep, obj, scope);
break;
}
}
@ -391,7 +424,7 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
}
static void
pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env)
pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_scope *scope)
{
pic_value seq;
int i = 0;
@ -401,7 +434,7 @@ pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_en
pic_value v;
v = pic_car(pic, seq);
pic_gen(pic, irep, v, env);
pic_gen(pic, irep, v, scope);
++i;
}
irep->code[irep->clen].insn = OP_CALL;
@ -410,9 +443,9 @@ pic_gen_call(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_en
}
static struct pic_irep *
pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_env *env)
pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_scope *scope)
{
struct pic_env *inner_env;
struct pic_scope *new_scope;
pic_value args, body, v;
struct pic_irep *irep;
@ -420,19 +453,20 @@ pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_env *env)
/* arguments */
args = pic_car(pic, pic_cdr(pic, obj));
inner_env = env_new(pic, args, env);
new_scope = new_local_scope(pic, args, scope);
/* body */
body = pic_cdr(pic, pic_cdr(pic, obj));
for (v = body; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
pic_gen(pic, irep, pic_car(pic, v), inner_env);
pic_gen(pic, irep, pic_car(pic, v), scope);
irep->code[irep->clen].insn = OP_POP;
irep->clen++;
}
irep->clen--;
irep->code[irep->clen].insn = OP_RET;
irep->clen++;
pic_free(pic, inner_env);
destory_scope(pic, new_scope);
#if VM_DEBUG
printf("LAMBDA_%zd:\n", pic->ilen);
@ -444,11 +478,14 @@ pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_env *env)
}
struct pic_proc *
pic_codegen(pic_state *pic, pic_value obj, struct pic_env *env)
pic_codegen(pic_state *pic, pic_value obj)
{
struct pic_scope *global_scope;
struct pic_proc *proc;
struct pic_irep *irep;
global_scope = new_global_scope(pic);
irep = new_irep(pic);
proc = pic_proc_new(pic, irep);
@ -464,10 +501,12 @@ pic_codegen(pic_state *pic, pic_value obj, struct pic_env *env)
return NULL;
}
}
pic_gen(pic, irep, obj, env);
pic_gen(pic, irep, obj, global_scope);
irep->code[irep->clen].insn = OP_STOP;
irep->clen++;
destory_scope(pic, global_scope);
#if VM_DEBUG
print_irep(pic, irep);
#endif

7
src/gc.c
View File

@ -181,7 +181,6 @@ static void
gc_mark_phase(pic_state *pic)
{
pic_value *stack;
struct pic_env *env;
int i;
/* stack */
@ -195,12 +194,6 @@ gc_mark_phase(pic_state *pic)
gc_mark_object(pic, pic->arena[i]);
}
/* global env */
env = pic->global_env;
do {
gc_mark(pic, env->assoc);
} while ((env = env->parent) != NULL);
/* globals */
for (i = 0; i < pic->glen; ++i) {
gc_mark(pic, pic->globals[i]);

20
src/state.c
View File

@ -4,18 +4,7 @@
#include "picrin/gc.h"
#include "picrin/proc.h"
#include "picrin/symbol.h"
static struct pic_env *
new_empty_env()
{
struct pic_env *env;
env = (struct pic_env *)malloc(sizeof(struct pic_env));
env->assoc = pic_nil_value();
env->parent = NULL;
return env;
}
#include "xhash/xhash.h"
struct sym_tbl *
sym_tbl_new()
@ -68,6 +57,7 @@ pic_open(int argc, char *argv[], char **envp)
pic->icapa = PIC_IREP_SIZE;
/* globals */
pic->global_tbl = xh_new();
pic->globals = (pic_value *)malloc(sizeof(pic_value) * PIC_GLOBALS_SIZE);
pic->glen = 0;
pic->gcapa = PIC_GLOBALS_SIZE;
@ -84,10 +74,6 @@ pic_open(int argc, char *argv[], char **envp)
/* GC arena */
pic->arena_idx = 0;
/* global environment */
pic->global_env = new_empty_env();
pic_init_core(pic);
ai = pic_gc_arena_preserve(pic);
pic->sDEFINE = pic_intern_cstr(pic, "define");
pic->sLAMBDA = pic_intern_cstr(pic, "lambda");
@ -104,6 +90,8 @@ pic_open(int argc, char *argv[], char **envp)
pic->sDIV = pic_intern_cstr(pic, "/");
pic_gc_arena_restore(pic, ai);
pic_init_core(pic);
return pic;
}

2
tools/main.c
View File

@ -80,7 +80,7 @@ main(int argc, char *argv[], char **envp)
#endif
/* eval */
proc = pic_codegen(pic, v, pic->global_env);
proc = pic_codegen(pic, v);
if (proc == NULL) {
printf("compilation error: %s\n", pic->errmsg);
pic->errmsg = NULL;