first eval commit
This commit is contained in:
parent
f5f1ac480b
commit
6b0c1aa668
2
Makefile
2
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
|
@ -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();
|
||||
}
|
||||
}
|
||||
}
|
|
@ -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");
|
||||
}
|
||||
|
||||
|
|
|
@ -86,7 +86,6 @@ list_tail
|
|||
int
|
||||
yyerror(struct parser_control *p, const char *msg)
|
||||
{
|
||||
pic_debug(p->pic, yylval.datum);
|
||||
puts(msg);
|
||||
abort();
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
|
||||
%%
|
||||
|
||||
|
|
15
src/state.c
15
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;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue