first eval commit

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

include/picrin.h

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

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

src/bool.c

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

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

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

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

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

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