From 6b0c1aa668234c19b1fdebb88f1a19ae6cd037da Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Fri, 11 Oct 2013 17:36:51 +0900 Subject: [PATCH] first eval commit --- Makefile | 2 +- include/picrin.h | 11 ++++++ include/picrin/value.h | 2 + src/bool.c | 19 ++++++++++ src/eval.c | 84 ++++++++++++++++++++++++++++++++++++++++++ src/main.c | 2 +- src/parse.y | 1 - src/scan.l | 3 +- src/state.c | 15 +++++++- 9 files changed, 134 insertions(+), 5 deletions(-) create mode 100644 src/bool.c create mode 100644 src/eval.c diff --git a/Makefile b/Makefile index 2005ab97..c7c62840 100644 --- a/Makefile +++ b/Makefile @@ -4,7 +4,7 @@ build: cd src; \ yacc -d parse.y; \ lex scan.l - gcc -o bin/picrin -I./include src/main.c src/state.c src/gc.c src/pair.c src/write.c src/symbol.c src/value.c src/y.tab.c src/lex.yy.c + gcc -o bin/picrin -I./include src/main.c src/state.c src/gc.c src/pair.c src/write.c src/symbol.c src/value.c src/y.tab.c src/lex.yy.c src/eval.c src/bool.c clean: rm -f src/y.tab.c src/y.tab.h src/lex.yy.c diff --git a/include/picrin.h b/include/picrin.h index b5c6fece..474f2096 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -2,10 +2,17 @@ #define PICRIN_H__ #include +#include #include "picrin/value.h" +struct pic_env { + pic_value assoc; + struct pic_env *parent; +}; + typedef struct { + struct pic_env *global_env; } pic_state; void *pic_alloc(pic_state *, size_t); @@ -19,10 +26,14 @@ pic_value pic_cons(pic_state *, pic_value, pic_value); pic_value pic_car(pic_state *, pic_value); pic_value pic_cdr(pic_state *, pic_value); +bool pic_eq_p(pic_state *, pic_value, pic_value); + pic_value pic_intern_cstr(pic_state *, const char *); pic_value pic_parse(pic_state *, const char *); +pic_value pic_eval(pic_state *, pic_value, struct pic_env *); + void pic_debug(pic_state *, pic_value); #endif diff --git a/include/picrin/value.h b/include/picrin/value.h index 75ec2fd9..adc135b4 100644 --- a/include/picrin/value.h +++ b/include/picrin/value.h @@ -47,4 +47,6 @@ enum pic_tt pic_type(pic_value); pic_value pic_nil_value(); pic_value pic_obj_value(void *); +#define pic_nil_p(v) (pic_type(v) == PIC_TT_NIL) + #endif diff --git a/src/bool.c b/src/bool.c new file mode 100644 index 00000000..b2bab77e --- /dev/null +++ b/src/bool.c @@ -0,0 +1,19 @@ +#include + +#include "picrin.h" + +bool +pic_eq_p(pic_state *pic, pic_value x, pic_value y) +{ + if (pic_type(x) != pic_type(y)) + return false; + + switch (pic_type(x)) { + case PIC_TT_NIL: + return true; + case PIC_TT_SYMBOL: + return strcmp(pic_symbol_ptr(x)->name, pic_symbol_ptr(y)->name) == 0; + default: + return false; + } +} diff --git a/src/eval.c b/src/eval.c new file mode 100644 index 00000000..17c015b1 --- /dev/null +++ b/src/eval.c @@ -0,0 +1,84 @@ +#include "picrin.h" + +static pic_value +pic_assq(pic_state *pic, pic_value key, pic_value assoc) +{ + pic_value cell; + + enter: + + if (pic_nil_p(assoc)) + return assoc; + + cell = pic_car(pic, assoc); + if (pic_eq_p(pic, key, pic_car(pic, cell))) + return cell; + + assoc = pic_cdr(pic, assoc); + goto enter; +} + +static pic_value +pic_env_lookup(pic_state *pic, pic_value sym, struct pic_env *env) +{ + pic_value v; + + enter: + + v = pic_assq(pic, sym, env->assoc); + if (! pic_nil_p(v)) { + return pic_cdr(pic, v); + } + if (env->parent) { + env = env->parent; + goto enter; + } + + return pic_nil_value(); +} + +static void +pic_env_define(pic_state *pic, pic_value sym, pic_value obj, struct pic_env *env) +{ + env->assoc = pic_cons(pic, pic_cons(pic, sym, obj), env->assoc); +} + +pic_value +pic_eval(pic_state *pic, pic_value obj, struct pic_env *env) +{ + pic_value sDEFINE = pic_intern_cstr(pic, "define"); + pic_value sQUOTE = pic_intern_cstr(pic, "quote"); + + while (1) { + switch (pic_type(obj)) { + case PIC_TT_SYMBOL: { + return pic_env_lookup(pic, obj, env); + } + case PIC_TT_PAIR: { + pic_value proc; + + proc = pic_car(pic, obj); + if (pic_eq_p(pic, proc, sQUOTE)) { + return pic_car(pic, pic_cdr(pic, obj)); + } + else if (pic_eq_p(pic, proc, sDEFINE)) { + pic_value sym, data; + + sym = pic_car(pic, pic_cdr(pic, obj)); + data = pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))); + pic_env_define(pic, sym, pic_eval(pic, data, env), env); + + return pic_nil_value(); + } + else { + /* not implemented */ + } + } + case PIC_TT_NIL: { + return obj; + } + default: + return pic_nil_value(); + } + } +} diff --git a/src/main.c b/src/main.c index 28f04b18..15b28450 100644 --- a/src/main.c +++ b/src/main.c @@ -54,7 +54,7 @@ main() /* echo */ v = pic_parse(pic, line); - pic_debug(pic, v); + pic_debug(pic, pic_eval(pic, v, pic->global_env)); printf("\n"); } diff --git a/src/parse.y b/src/parse.y index 37bb0ded..c8cb37c1 100644 --- a/src/parse.y +++ b/src/parse.y @@ -86,7 +86,6 @@ list_tail int yyerror(struct parser_control *p, const char *msg) { - pic_debug(p->pic, yylval.datum); puts(msg); abort(); } diff --git a/src/scan.l b/src/scan.l index 7a11d825..cd8077fe 100644 --- a/src/scan.l +++ b/src/scan.l @@ -14,7 +14,8 @@ struct parser_control { "(" return tLPAREN; ")" return tRPAREN; -[a-z]+ { yylval.datum = pic_intern_cstr(p->pic, yytext); return tSYMBOL; } +[a-z0-9A-Z]+ { yylval.datum = pic_intern_cstr(p->pic, yytext); return tSYMBOL; } +"'" return tQUOTE; %% diff --git a/src/state.c b/src/state.c index 5855521e..6fcb5ec5 100644 --- a/src/state.c +++ b/src/state.c @@ -2,12 +2,25 @@ #include "picrin.h" +static struct pic_env * +pic_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; +} + pic_state * pic_open() { pic_state *pic; - pic = (pic_state *)calloc(1, sizeof(pic_state)); + pic = (pic_state *)malloc(sizeof(pic_state)); + pic->global_env = pic_new_empty_env(); return pic; }