first eval commit

This commit is contained in:
Yuichi Nishiwaki 2013-10-11 17:36:51 +09:00
parent f5f1ac480b
commit 6b0c1aa668
9 changed files with 134 additions and 5 deletions

View File

@ -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

View File

@ -2,10 +2,17 @@
#define PICRIN_H__
#include <stddef.h>
#include <stdbool.h>
#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

View File

@ -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

19
src/bool.c Normal file
View File

@ -0,0 +1,19 @@
#include <string.h>
#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;
}
}

84
src/eval.c Normal file
View File

@ -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();
}
}
}

View File

@ -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");
}

View File

@ -86,7 +86,6 @@ list_tail
int
yyerror(struct parser_control *p, const char *msg)
{
pic_debug(p->pic, yylval.datum);
puts(msg);
abort();
}

View File

@ -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;
%%

View File

@ -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;
}