first eval commit

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