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

[bugfix] native operators such as = or + are not inline-expanded

This commit is contained in:
Yuichi Nishiwaki 2014-01-13 14:39:21 +09:00
parent daf67c34d9
commit 0753b12f60
4 changed files with 39 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
include/picrin.h
View File

@ -44,9 +44,9 @@ typedef struct {
pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
pic_sym sDEFINE_SYNTAX, sDEFINE_MACRO;
pic_sym sDEFINE_LIBRARY, sIMPORT, sEXPORT;
pic_sym sCONS, sCAR, sCDR, sNILP;
pic_sym sADD, sSUB, sMUL, sDIV;
pic_sym sEQ, sLT, sLE, sGT, sGE;
pic_sym rCONS, rCAR, rCDR, rNILP;
pic_sym rADD, rSUB, rMUL, rDIV;
pic_sym rEQ, rLT, rLE, rGT, rGE;
struct xhash *sym_tbl;
const char **sym_pool;

26
src/codegen.c
View File

@ -435,7 +435,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
} \
} while (0)
else if (sym == pic->sCONS) {
else if (sym == pic->rCONS) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj)), false);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false);
@ -443,21 +443,21 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
irep->clen++;
break;
}
else if (sym == pic->sCAR) {
else if (sym == pic->rCAR) {
ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj)), false);
irep->code[irep->clen].insn = OP_CAR;
irep->clen++;
break;
}
else if (sym == pic->sCDR) {
else if (sym == pic->rCDR) {
ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj)), false);
irep->code[irep->clen].insn = OP_CDR;
irep->clen++;
break;
}
else if (sym == pic->sNILP) {
else if (sym == pic->rNILP) {
ARGC_ASSERT(1);
codegen(state, pic_car(pic, pic_cdr(pic, obj)), false);
irep->code[irep->clen].insn = OP_NILP;
@ -471,7 +471,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
} \
} while (0)
else if (sym == pic->sADD) {
else if (sym == pic->rADD) {
pic_value args;
ARGC_ASSERT_GE(0);
@ -497,7 +497,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
}
break;
}
else if (sym == pic->sSUB) {
else if (sym == pic->rSUB) {
pic_value args;
ARGC_ASSERT_GE(1);
@ -520,7 +520,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
}
break;
}
else if (sym == pic->sMUL) {
else if (sym == pic->rMUL) {
pic_value args;
ARGC_ASSERT_GE(0);
@ -546,7 +546,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
}
break;
}
else if (sym == pic->sDIV) {
else if (sym == pic->rDIV) {
pic_value args;
ARGC_ASSERT_GE(1);
@ -572,7 +572,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
}
break;
}
else if (sym == pic->sEQ) {
else if (sym == pic->rEQ) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj)), false);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false);
@ -580,7 +580,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
irep->clen++;
break;
}
else if (sym == pic->sLT) {
else if (sym == pic->rLT) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj)), false);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false);
@ -588,7 +588,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
irep->clen++;
break;
}
else if (sym == pic->sLE) {
else if (sym == pic->rLE) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, obj)), false);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false);
@ -596,7 +596,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
irep->clen++;
break;
}
else if (sym == pic->sGT) {
else if (sym == pic->rGT) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false);
codegen(state, pic_car(pic, pic_cdr(pic, obj)), false);
@ -604,7 +604,7 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
irep->clen++;
break;
}
else if (sym == pic->sGE) {
else if (sym == pic->rGE) {
ARGC_ASSERT(2);
codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), false);
codegen(state, pic_car(pic, pic_cdr(pic, obj)), false);

23
src/init.c
View File

@ -5,6 +5,7 @@
#include "picrin/pair.h"
#include "picrin/lib.h"
#include "picrin/macro.h"
#include "xhash/xhash.h"
void pic_init_bool(pic_state *);
void pic_init_pair(pic_state *);
@ -89,6 +90,13 @@ pic_features(pic_state *pic)
return fs;
}
#define register_renamed_symbol(pic, slot, name) do { \
struct xh_entry *e; \
if (! (e = xh_get(pic->lib->senv->tbl, name))) \
pic_error(pic, "internal error! native VM procedure not found"); \
pic->slot = e->val; \
} while (0)
#define DONE pic_gc_arena_restore(pic, ai);
void
@ -129,6 +137,21 @@ pic_init_core(pic_state *pic)
pic_init_var(pic); DONE;
pic_init_load(pic); DONE;
/* native VM procedures */
register_renamed_symbol(pic, rCONS, "cons");
register_renamed_symbol(pic, rCAR, "car");
register_renamed_symbol(pic, rCDR, "cdr");
register_renamed_symbol(pic, rNILP, "null?");
register_renamed_symbol(pic, rADD, "+");
register_renamed_symbol(pic, rSUB, "-");
register_renamed_symbol(pic, rMUL, "*");
register_renamed_symbol(pic, rDIV, "/");
register_renamed_symbol(pic, rEQ, "=");
register_renamed_symbol(pic, rLT, "<");
register_renamed_symbol(pic, rLE, "<=");
register_renamed_symbol(pic, rGT, ">");
register_renamed_symbol(pic, rGE, ">=");
pic_load_stdlib(pic); DONE;
pic_defun(pic, "features", pic_features);

13
src/state.c
View File

@ -103,19 +103,6 @@ pic_open(int argc, char *argv[], char **envp)
register_core_symbol(pic, sDEFINE_LIBRARY, "define-library");
register_core_symbol(pic, sIMPORT, "import");
register_core_symbol(pic, sEXPORT, "export");
register_core_symbol(pic, sCONS, "cons");
register_core_symbol(pic, sCAR, "car");
register_core_symbol(pic, sCDR, "cdr");
register_core_symbol(pic, sNILP, "null?");
register_core_symbol(pic, sADD, "+");
register_core_symbol(pic, sSUB, "-");
register_core_symbol(pic, sMUL, "*");
register_core_symbol(pic, sDIV, "/");
register_core_symbol(pic, sEQ, "=");
register_core_symbol(pic, sLT, "<");
register_core_symbol(pic, sLE, "<=");
register_core_symbol(pic, sGT, ">");
register_core_symbol(pic, sGE, ">=");
pic_gc_arena_restore(pic, ai);
pic_init_core(pic);