Merge branch 'analyzer'

include/picrin.h

@@ -71,9 +71,9 @@ typedef struct {
   pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
   pic_sym sDEFINE_SYNTAX, sDEFINE_MACRO;
   pic_sym sDEFINE_LIBRARY, sIMPORT, sEXPORT;
-  pic_sym rCONS, rCAR, rCDR, rNILP;
+  pic_sym sCONS, sCAR, sCDR, sNILP;
-  pic_sym rADD, rSUB, rMUL, rDIV;
+  pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
-  pic_sym rEQ, rLT, rLE, rGT, rGE;
+  pic_sym sEQ, sLT, sLE, sGT, sGE;
 
   struct xhash *sym_tbl;
   const char **sym_pool;
@@ -152,7 +152,7 @@ pic_value pic_load(pic_state *, const char *);
 
 pic_value pic_apply(pic_state *pic, struct pic_proc *, pic_value);
 pic_value pic_apply_argv(pic_state *pic, struct pic_proc *, size_t, ...);
-struct pic_proc *pic_codegen(pic_state *, pic_value);
+struct pic_proc *pic_compile(pic_state *, pic_value);
 pic_value pic_macroexpand(pic_state *, pic_value);
 
 void pic_in_library(pic_state *, pic_value);

include/picrin/irep.h

@@ -69,6 +69,9 @@ struct pic_irep {
   size_t clen, ilen, plen;
 };
 
+pic_value pic_analyze(pic_state *, pic_value);
+struct pic_irep *pic_codegen(pic_state *pic, pic_value obj);
+
 void pic_dump_irep(pic_state *, struct pic_irep *);
 
 #if defined(__cplusplus)

src/init.c

@@ -74,13 +74,6 @@ pic_features(pic_state *pic)
   return fs;
 }
 
-#define register_renamed_symbol(pic, slot, name) do {                   \
-    struct xh_entry *e;                                                 \
-    if (! (e = xh_get(pic->lib->senv->tbl, name)))                      \
-      pic_error(pic, "internal error! native VM procedure not found");  \
-    pic->slot = e->val;                                                 \
-  } while (0)
-
 #define DONE pic_gc_arena_restore(pic, ai);
 
 void
@@ -122,21 +115,6 @@ pic_init_core(pic_state *pic)
   pic_init_load(pic); DONE;
   pic_init_write(pic); DONE;
 
-  /* native VM procedures */
-  register_renamed_symbol(pic, rCONS, "cons");
-  register_renamed_symbol(pic, rCAR, "car");
-  register_renamed_symbol(pic, rCDR, "cdr");
-  register_renamed_symbol(pic, rNILP, "null?");
-  register_renamed_symbol(pic, rADD, "+");
-  register_renamed_symbol(pic, rSUB, "-");
-  register_renamed_symbol(pic, rMUL, "*");
-  register_renamed_symbol(pic, rDIV, "/");
-  register_renamed_symbol(pic, rEQ, "=");
-  register_renamed_symbol(pic, rLT, "<");
-  register_renamed_symbol(pic, rLE, "<=");
-  register_renamed_symbol(pic, rGT, ">");
-  register_renamed_symbol(pic, rGE, ">=");
-
   pic_load_stdlib(pic); DONE;
 
   pic_defun(pic, "features", pic_features);

src/load.c

@@ -27,7 +27,7 @@ pic_load(pic_state *pic, const char *fn)
   for (i = 0; i < n; ++i, vs = pic_cdr(pic, vs)) {
     v = pic_car(pic, vs);
 
-    proc = pic_codegen(pic, v);
+    proc = pic_compile(pic, v);
     if (proc == NULL) {
       pic_error(pic, "load: compilation failure");
     }

src/macro.c

@@ -317,7 +317,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
           for (exprs = pic_cddr(pic, expr); ! pic_nil_p(exprs); exprs = pic_cdr(pic, exprs)) {
             v = pic_car(pic, exprs);
 
-            proc = pic_codegen(pic, v);
+            proc = pic_compile(pic, v);
             if (proc == NULL) {
               abort();
             }
@@ -364,7 +364,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	}
 
 	val = pic_cadr(pic, pic_cdr(pic, expr));
-	proc = pic_codegen(pic, val);
+	proc = pic_compile(pic, val);
 	if (pic->errmsg) {
 	  printf("macroexpand error: %s\n", pic->errmsg);
 	  abort();
@@ -406,7 +406,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 	  pic_error(pic, "syntax error");
 	}
 
-	proc = pic_codegen(pic, val);
+	proc = pic_compile(pic, val);
 	if (pic->errmsg) {
 	  printf("macroexpand error: %s\n", pic->errmsg);
 	  abort();

src/pair.c

@@ -58,6 +58,7 @@ pic_list_p(pic_state *pic, pic_value obj)
 pic_value
 pic_list(pic_state *pic, size_t c, ...)
 {
+  int ai = pic_gc_arena_preserve(pic);
   va_list ap;
   pic_value v;
 
@@ -69,6 +70,10 @@ pic_list(pic_state *pic, size_t c, ...)
   }
 
   va_end(ap);
+
+  pic_gc_arena_restore(pic, ai);
+  pic_gc_protect(pic, v);
+
   return pic_reverse(pic, v);
 }
 

src/state.c

@@ -98,6 +98,20 @@ pic_open(int argc, char *argv[], char **envp)
   register_core_symbol(pic, sDEFINE_LIBRARY, "define-library");
   register_core_symbol(pic, sIMPORT, "import");
   register_core_symbol(pic, sEXPORT, "export");
+  register_core_symbol(pic, sCONS, "cons");
+  register_core_symbol(pic, sCAR, "car");
+  register_core_symbol(pic, sCDR, "cdr");
+  register_core_symbol(pic, sNILP, "null?");
+  register_core_symbol(pic, sADD, "+");
+  register_core_symbol(pic, sSUB, "-");
+  register_core_symbol(pic, sMUL, "*");
+  register_core_symbol(pic, sDIV, "/");
+  register_core_symbol(pic, sMINUS, "minus");
+  register_core_symbol(pic, sEQ, "=");
+  register_core_symbol(pic, sLT, "<");
+  register_core_symbol(pic, sLE, "<=");
+  register_core_symbol(pic, sGT, ">");
+  register_core_symbol(pic, sGE, ">=");
   pic_gc_arena_restore(pic, ai);
 
   pic_init_core(pic);

src/vm.c

@@ -616,18 +616,13 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 	}
 
 	/* prepare env */
-	if (proc->u.irep->cv_num == 0) {
+        ci->env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
-	  ci->env = proc->env;
+        ci->env->up = proc->env;
-	}
+        ci->env->valuec = proc->u.irep->cv_num;
-	else {
+        ci->env->values = (pic_value *)pic_calloc(pic, ci->env->valuec, sizeof(pic_value));
-	  ci->env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
+        for (i = 0; i < ci->env->valuec; ++i) {
-	  ci->env->up = proc->env;
+          ci->env->values[i] = ci->fp[proc->u.irep->cv_tbl[i]];
-	  ci->env->valuec = proc->u.irep->cv_num;
+        }
-	  ci->env->values = (pic_value *)pic_calloc(pic, ci->env->valuec, sizeof(pic_value));
-	  for (i = 0; i < ci->env->valuec; ++i) {
-	    ci->env->values[i] = ci->fp[proc->u.irep->cv_tbl[i]];
-	  }
-	}
 
 	pc = proc->u.irep->code;
 	pic_gc_arena_restore(pic, ai);

src/write.c

@@ -156,6 +156,7 @@ void
 pic_debug(pic_state *pic, pic_value obj)
 {
   write(pic, obj);
+  fflush(stdout);
 }
 
 static pic_value

tools/main.c

@@ -122,7 +122,7 @@ repl(pic_state *pic)
 #endif
 
       /* eval */
-      proc = pic_codegen(pic, v);
+      proc = pic_compile(pic, v);
       if (proc == NULL) {
 	printf("compilation error: %s\n", pic->errmsg);
 	pic->errmsg = NULL;
@@ -183,7 +183,7 @@ exec_file(pic_state *pic, const char *fname)
 
     v = pic_car(pic, vs);
 
-    proc = pic_codegen(pic, v);
+    proc = pic_compile(pic, v);
     if (proc == NULL) {
       fputs(pic->errmsg, stderr);
       fprintf(stderr, "fatal error: %s compilation failure\n", fname);
@@ -223,7 +223,7 @@ exec_string(pic_state *pic, const char *str)
   for (i = 0; i < n; ++i) {
     v = pic_car(pic, vs);
 
-    proc = pic_codegen(pic, v);
+    proc = pic_compile(pic, v);
     if (proc == NULL) {
       goto abort;
     }