use xhash to manage scopes during codegin
This commit is contained in:
parent
5da1b175a7
commit
dd3adf30e6
2
Makefile
2
Makefile
|
@ -11,7 +11,7 @@ build-lib:
|
||||||
cd src; \
|
cd src; \
|
||||||
yacc -d parse.y; \
|
yacc -d parse.y; \
|
||||||
lex scan.l
|
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:
|
clean:
|
||||||
rm -f src/y.tab.c src/y.tab.h src/lex.yy.c
|
rm -f src/y.tab.c src/y.tab.h src/lex.yy.c
|
||||||
|
|
|
@ -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
|
|
@ -29,12 +29,13 @@ typedef struct {
|
||||||
pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE;
|
pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE;
|
||||||
pic_value sCONS, sCAR, sCDR, sNILP;
|
pic_value sCONS, sCAR, sCDR, sNILP;
|
||||||
pic_value sADD, sSUB, sMUL, sDIV;
|
pic_value sADD, sSUB, sMUL, sDIV;
|
||||||
struct pic_env *global_env;
|
|
||||||
|
|
||||||
struct sym_tbl *sym_tbl;
|
struct sym_tbl *sym_tbl;
|
||||||
|
|
||||||
|
struct xhash *global_tbl;
|
||||||
pic_value *globals;
|
pic_value *globals;
|
||||||
size_t glen, gcapa;
|
size_t glen, gcapa;
|
||||||
|
|
||||||
struct pic_irep **irep;
|
struct pic_irep **irep;
|
||||||
size_t ilen, icapa;
|
size_t ilen, icapa;
|
||||||
pic_value *pool;
|
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 *);
|
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);
|
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_abort(pic_state *, const char *);
|
||||||
void pic_raise(pic_state *, pic_value);
|
void pic_raise(pic_state *, pic_value);
|
||||||
|
|
|
@ -1,11 +1,6 @@
|
||||||
#ifndef PROC_H__
|
#ifndef PROC_H__
|
||||||
#define PROC_H__
|
#define PROC_H__
|
||||||
|
|
||||||
struct pic_env {
|
|
||||||
pic_value assoc;
|
|
||||||
struct pic_env *parent;
|
|
||||||
};
|
|
||||||
|
|
||||||
struct pic_proc {
|
struct pic_proc {
|
||||||
PIC_OBJECT_HEADER
|
PIC_OBJECT_HEADER
|
||||||
bool cfunc_p;
|
bool cfunc_p;
|
||||||
|
|
189
src/codegen.c
189
src/codegen.c
|
@ -4,28 +4,81 @@
|
||||||
#include "picrin/pair.h"
|
#include "picrin/pair.h"
|
||||||
#include "picrin/irep.h"
|
#include "picrin/irep.h"
|
||||||
#include "picrin/proc.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
|
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;
|
int d = 0;
|
||||||
|
|
||||||
enter:
|
enter:
|
||||||
|
|
||||||
v = pic_assq(pic, sym, env->assoc);
|
e = xh_get(scope->local_tbl, key);
|
||||||
if (! pic_nil_p(v)) {
|
if (e) {
|
||||||
if (env->parent == NULL) { /* global */
|
if (scope->up == NULL) { /* global */
|
||||||
*depth = -1;
|
*depth = -1;
|
||||||
}
|
}
|
||||||
else { /* non-global */
|
else { /* non-global */
|
||||||
*depth = d;
|
*depth = d;
|
||||||
}
|
}
|
||||||
*idx = (int)pic_float(pic_pair_ptr(v)->cdr);
|
*idx = e->val;
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
if (env->parent) {
|
if (scope->up) {
|
||||||
env = env->parent;
|
scope = scope->up;
|
||||||
++d;
|
++d;
|
||||||
goto enter;
|
goto enter;
|
||||||
}
|
}
|
||||||
|
@ -33,42 +86,18 @@ env_lookup(pic_state *pic, pic_value sym, struct pic_env *env, int *depth, int *
|
||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static int
|
||||||
env_global_define(pic_state *pic, pic_value sym)
|
scope_global_define(pic_state *pic, const char *name)
|
||||||
{
|
{
|
||||||
pic_value f;
|
struct xh_entry *e;
|
||||||
int d, idx;
|
|
||||||
|
|
||||||
if (env_lookup(pic, sym, pic->global_env, &d, &idx)) {
|
if ((e = xh_get(pic->global_tbl, name))) {
|
||||||
return idx;
|
return e->val;
|
||||||
}
|
}
|
||||||
|
e = xh_put(pic->global_tbl, name, pic->glen++);
|
||||||
idx = pic->glen++;
|
if (pic->glen >= pic->gcapa) {
|
||||||
f = pic_float_value(idx);
|
pic_error(pic, "global table overflow");
|
||||||
pic->global_env->assoc = pic_acons(pic, sym, f, pic->global_env->assoc);
|
|
||||||
|
|
||||||
return idx;
|
|
||||||
}
|
|
||||||
|
|
||||||
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 e->val;
|
||||||
return inner_env;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
|
@ -78,7 +107,7 @@ pic_defun(pic_state *pic, const char *name, pic_func_t cfunc)
|
||||||
int idx;
|
int idx;
|
||||||
|
|
||||||
proc = pic_proc_new_cfunc(pic, cfunc, pic_undef_value());
|
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);
|
pic->globals[idx] = pic_obj_value(proc);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -177,11 +206,11 @@ new_irep(pic_state *pic)
|
||||||
return irep;
|
return irep;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void pic_gen_call(pic_state *, struct pic_irep *, 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_env *);
|
static struct pic_irep *pic_gen_lambda(pic_state *, pic_value, struct pic_scope *);
|
||||||
|
|
||||||
static void
|
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 sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE;
|
||||||
pic_value sCONS, sCAR, sCDR, sNILP;
|
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: {
|
case PIC_TT_SYMBOL: {
|
||||||
bool b;
|
bool b;
|
||||||
int depth, idx;
|
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) {
|
if (! b) {
|
||||||
pic_error(pic, "unbound variable");
|
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);
|
proc = pic_car(pic, obj);
|
||||||
if (pic_eq_p(pic, proc, sDEFINE)) {
|
if (pic_eq_p(pic, proc, sDEFINE)) {
|
||||||
int idx;
|
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].insn = OP_GSET;
|
||||||
irep->code[irep->clen].u.i = idx;
|
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->code[irep->clen].u.i = pic->ilen;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
|
|
||||||
pic->irep[pic->ilen++] = pic_gen_lambda(pic, obj, env);
|
pic->irep[pic->ilen++] = pic_gen_lambda(pic, obj, scope);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else if (pic_eq_p(pic, proc, sIF)) {
|
else if (pic_eq_p(pic, proc, sIF)) {
|
||||||
int s,t;
|
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;
|
irep->code[irep->clen].insn = OP_JMPIF;
|
||||||
s = irep->clen++;
|
s = irep->clen++;
|
||||||
|
|
||||||
/* if false branch */
|
/* 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;
|
irep->code[irep->clen].insn = OP_JMP;
|
||||||
t = irep->clen++;
|
t = irep->clen++;
|
||||||
|
|
||||||
irep->code[s].u.i = irep->clen - s;
|
irep->code[s].u.i = irep->clen - s;
|
||||||
|
|
||||||
/* if true branch */
|
/* 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;
|
irep->code[t].u.i = irep->clen - t;
|
||||||
break;
|
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);
|
seq = pic_cdr(pic, obj);
|
||||||
for (v = seq; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
|
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->code[irep->clen].insn = OP_POP;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
}
|
}
|
||||||
|
@ -294,60 +327,60 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else if (pic_eq_p(pic, proc, sCONS)) {
|
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, pic_cdr(pic, obj))), scope);
|
||||||
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_CONS;
|
irep->code[irep->clen].insn = OP_CONS;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else if (pic_eq_p(pic, proc, sCAR)) {
|
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->code[irep->clen].insn = OP_CAR;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else if (pic_eq_p(pic, proc, sCDR)) {
|
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->code[irep->clen].insn = OP_CDR;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else if (pic_eq_p(pic, proc, sNILP)) {
|
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->code[irep->clen].insn = OP_NILP;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else if (pic_eq_p(pic, proc, sADD)) {
|
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, pic_cdr(pic, obj))), scope);
|
||||||
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_ADD;
|
irep->code[irep->clen].insn = OP_ADD;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else if (pic_eq_p(pic, proc, sSUB)) {
|
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, pic_cdr(pic, obj))), scope);
|
||||||
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_SUB;
|
irep->code[irep->clen].insn = OP_SUB;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else if (pic_eq_p(pic, proc, sMUL)) {
|
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, pic_cdr(pic, obj))), scope);
|
||||||
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_MUL;
|
irep->code[irep->clen].insn = OP_MUL;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else if (pic_eq_p(pic, proc, sDIV)) {
|
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, pic_cdr(pic, obj))), scope);
|
||||||
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_DIV;
|
irep->code[irep->clen].insn = OP_DIV;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
pic_gen_call(pic, irep, obj, env);
|
pic_gen_call(pic, irep, obj, scope);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -391,7 +424,7 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
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;
|
pic_value seq;
|
||||||
int i = 0;
|
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;
|
pic_value v;
|
||||||
|
|
||||||
v = pic_car(pic, seq);
|
v = pic_car(pic, seq);
|
||||||
pic_gen(pic, irep, v, env);
|
pic_gen(pic, irep, v, scope);
|
||||||
++i;
|
++i;
|
||||||
}
|
}
|
||||||
irep->code[irep->clen].insn = OP_CALL;
|
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 *
|
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;
|
pic_value args, body, v;
|
||||||
struct pic_irep *irep;
|
struct pic_irep *irep;
|
||||||
|
|
||||||
|
@ -420,19 +453,20 @@ pic_gen_lambda(pic_state *pic, pic_value obj, struct pic_env *env)
|
||||||
|
|
||||||
/* arguments */
|
/* arguments */
|
||||||
args = pic_car(pic, pic_cdr(pic, obj));
|
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 */
|
||||||
body = pic_cdr(pic, pic_cdr(pic, obj));
|
body = pic_cdr(pic, pic_cdr(pic, obj));
|
||||||
for (v = body; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
|
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->code[irep->clen].insn = OP_POP;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
}
|
}
|
||||||
irep->clen--;
|
irep->clen--;
|
||||||
irep->code[irep->clen].insn = OP_RET;
|
irep->code[irep->clen].insn = OP_RET;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
pic_free(pic, inner_env);
|
|
||||||
|
destory_scope(pic, new_scope);
|
||||||
|
|
||||||
#if VM_DEBUG
|
#if VM_DEBUG
|
||||||
printf("LAMBDA_%zd:\n", pic->ilen);
|
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 *
|
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_proc *proc;
|
||||||
struct pic_irep *irep;
|
struct pic_irep *irep;
|
||||||
|
|
||||||
|
global_scope = new_global_scope(pic);
|
||||||
|
|
||||||
irep = new_irep(pic);
|
irep = new_irep(pic);
|
||||||
proc = pic_proc_new(pic, irep);
|
proc = pic_proc_new(pic, irep);
|
||||||
|
|
||||||
|
@ -464,10 +501,12 @@ pic_codegen(pic_state *pic, pic_value obj, struct pic_env *env)
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
pic_gen(pic, irep, obj, env);
|
pic_gen(pic, irep, obj, global_scope);
|
||||||
irep->code[irep->clen].insn = OP_STOP;
|
irep->code[irep->clen].insn = OP_STOP;
|
||||||
irep->clen++;
|
irep->clen++;
|
||||||
|
|
||||||
|
destory_scope(pic, global_scope);
|
||||||
|
|
||||||
#if VM_DEBUG
|
#if VM_DEBUG
|
||||||
print_irep(pic, irep);
|
print_irep(pic, irep);
|
||||||
#endif
|
#endif
|
||||||
|
|
7
src/gc.c
7
src/gc.c
|
@ -181,7 +181,6 @@ static void
|
||||||
gc_mark_phase(pic_state *pic)
|
gc_mark_phase(pic_state *pic)
|
||||||
{
|
{
|
||||||
pic_value *stack;
|
pic_value *stack;
|
||||||
struct pic_env *env;
|
|
||||||
int i;
|
int i;
|
||||||
|
|
||||||
/* stack */
|
/* stack */
|
||||||
|
@ -195,12 +194,6 @@ gc_mark_phase(pic_state *pic)
|
||||||
gc_mark_object(pic, pic->arena[i]);
|
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 */
|
/* globals */
|
||||||
for (i = 0; i < pic->glen; ++i) {
|
for (i = 0; i < pic->glen; ++i) {
|
||||||
gc_mark(pic, pic->globals[i]);
|
gc_mark(pic, pic->globals[i]);
|
||||||
|
|
20
src/state.c
20
src/state.c
|
@ -4,18 +4,7 @@
|
||||||
#include "picrin/gc.h"
|
#include "picrin/gc.h"
|
||||||
#include "picrin/proc.h"
|
#include "picrin/proc.h"
|
||||||
#include "picrin/symbol.h"
|
#include "picrin/symbol.h"
|
||||||
|
#include "xhash/xhash.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;
|
|
||||||
}
|
|
||||||
|
|
||||||
struct sym_tbl *
|
struct sym_tbl *
|
||||||
sym_tbl_new()
|
sym_tbl_new()
|
||||||
|
@ -68,6 +57,7 @@ pic_open(int argc, char *argv[], char **envp)
|
||||||
pic->icapa = PIC_IREP_SIZE;
|
pic->icapa = PIC_IREP_SIZE;
|
||||||
|
|
||||||
/* globals */
|
/* globals */
|
||||||
|
pic->global_tbl = xh_new();
|
||||||
pic->globals = (pic_value *)malloc(sizeof(pic_value) * PIC_GLOBALS_SIZE);
|
pic->globals = (pic_value *)malloc(sizeof(pic_value) * PIC_GLOBALS_SIZE);
|
||||||
pic->glen = 0;
|
pic->glen = 0;
|
||||||
pic->gcapa = PIC_GLOBALS_SIZE;
|
pic->gcapa = PIC_GLOBALS_SIZE;
|
||||||
|
@ -84,10 +74,6 @@ pic_open(int argc, char *argv[], char **envp)
|
||||||
/* GC arena */
|
/* GC arena */
|
||||||
pic->arena_idx = 0;
|
pic->arena_idx = 0;
|
||||||
|
|
||||||
/* global environment */
|
|
||||||
pic->global_env = new_empty_env();
|
|
||||||
pic_init_core(pic);
|
|
||||||
|
|
||||||
ai = pic_gc_arena_preserve(pic);
|
ai = pic_gc_arena_preserve(pic);
|
||||||
pic->sDEFINE = pic_intern_cstr(pic, "define");
|
pic->sDEFINE = pic_intern_cstr(pic, "define");
|
||||||
pic->sLAMBDA = pic_intern_cstr(pic, "lambda");
|
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->sDIV = pic_intern_cstr(pic, "/");
|
||||||
pic_gc_arena_restore(pic, ai);
|
pic_gc_arena_restore(pic, ai);
|
||||||
|
|
||||||
|
pic_init_core(pic);
|
||||||
|
|
||||||
return pic;
|
return pic;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -80,7 +80,7 @@ main(int argc, char *argv[], char **envp)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* eval */
|
/* eval */
|
||||||
proc = pic_codegen(pic, v, pic->global_env);
|
proc = pic_codegen(pic, v);
|
||||||
if (proc == NULL) {
|
if (proc == NULL) {
|
||||||
printf("compilation error: %s\n", pic->errmsg);
|
printf("compilation error: %s\n", pic->errmsg);
|
||||||
pic->errmsg = NULL;
|
pic->errmsg = NULL;
|
||||||
|
|
Loading…
Reference in New Issue