Merge remote-tracking branch 'refs/remotes/origin/master'

include/picrin.h

@@ -98,10 +98,10 @@ typedef struct {
   pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
   pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT;
 
-  xhash *sym_tbl;
-  const char **sym_pool;
-  size_t slen, scapa;
-  int uniq_sym_count;
+  xhash *syms;                  /* name to symbol */
+  xhash *sym_names;             /* symbol to name */
+  int sym_cnt;
+  int uniq_sym_cnt;
 
   xhash *global_tbl;
   pic_value *globals;

src/macro.c

@@ -510,13 +510,36 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 static pic_value
 macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv)
 {
-  pic_value v;
+  int ai = pic_gc_arena_preserve(pic);
+  pic_value v, vs;
 
-  if (! pic_pair_p(list))
-    return macroexpand(pic, list, senv);
+  /* macroexpand in order */
+  vs = pic_nil_value();
+  while (pic_pair_p(list)) {
+    v = pic_car(pic, list);
 
-  v = macroexpand(pic, pic_car(pic, list), senv);
-  return pic_cons(pic, v, macroexpand_list(pic, pic_cdr(pic, list), senv));
+    vs = pic_cons(pic, macroexpand(pic, v, senv), vs);
+    list = pic_cdr(pic, list);
+
+    pic_gc_arena_restore(pic, ai);
+    pic_gc_protect(pic, vs);
+    pic_gc_protect(pic, list);
+  }
+
+  list = macroexpand(pic, list, senv);
+
+  /* reverse the result */
+  pic_for_each (v, vs) {
+    list = pic_cons(pic, v, list);
+
+    pic_gc_arena_restore(pic, ai);
+    pic_gc_protect(pic, vs);
+    pic_gc_protect(pic, list);
+  }
+
+  pic_gc_arena_restore(pic, ai);
+  pic_gc_protect(pic, list);
+  return list;
 }
 
 pic_value

src/state.c

@@ -52,11 +52,10 @@ pic_open(int argc, char *argv[], char **envp)
   init_heap(pic->heap);
 
   /* symbol table */
-  pic->sym_tbl = xh_new_str();
-  pic->sym_pool = (const char **)calloc(PIC_SYM_POOL_SIZE, sizeof(const char *));
-  pic->slen = 0;
-  pic->scapa = pic->slen + PIC_SYM_POOL_SIZE;
-  pic->uniq_sym_count = 0;
+  pic->syms = xh_new_str();
+  pic->sym_names = xh_new_int();
+  pic->sym_cnt = 0;
+  pic->uniq_sym_cnt = 0;
 
   /* global variables */
   pic->global_tbl = xh_new_int();
@@ -129,7 +128,7 @@ pic_open(int argc, char *argv[], char **envp)
 void
 pic_close(pic_state *pic)
 {
-  size_t i;
+  xh_iter it;
 
   /* free global stacks */
   free(pic->stbase);
@@ -137,7 +136,7 @@ pic_close(pic_state *pic)
   free(pic->rescue);
   free(pic->globals);
 
-  xh_destroy(pic->sym_tbl);
+  xh_destroy(pic->syms);
   xh_destroy(pic->global_tbl);
 
   pic->glen = 0;
@@ -157,10 +156,10 @@ pic_close(pic_state *pic)
   free(pic->heap);
 
   /* free symbol names */
-  for (i = 0; i < pic->slen; ++i) {
-    free((void *)pic->sym_pool[i]);
+  for (xh_begin(pic->sym_names, &it); ! xh_isend(&it); xh_next(&it)) {
+    free((void *)it.e->val);
   }
-  free(pic->sym_pool);
+  free(pic->sym_names);
 
   PIC_BLK_DECREF(pic, pic->blk);
 

src/symbol.c

@@ -14,32 +14,23 @@ pic_intern_cstr(pic_state *pic, const char *str)
   xh_entry *e;
   pic_sym id;
 
-  e = xh_get(pic->sym_tbl, str);
+  e = xh_get(pic->syms, str);
   if (e) {
     return e->val;
   }
 
   str = pic_strdup(pic, str);
 
-  if (pic->slen >= pic->scapa) {
-
-#if DEBUG
-    puts("sym_pool realloced");
-#endif
-
-    pic->scapa *= 2;
-    pic->sym_pool = pic_realloc(pic, pic->sym_pool, sizeof(const char *) * pic->scapa);
-  }
-  id = pic->slen++;
-  pic->sym_pool[id] = str;
-  xh_put(pic->sym_tbl, str, id);
+  id = pic->sym_cnt++;
+  xh_put(pic->syms, str, id);
+  xh_put_int(pic->sym_names, id, (long)str);
   return id;
 }
 
 pic_sym
 pic_gensym(pic_state *pic, pic_sym base)
 {
-  int s = ++pic->uniq_sym_count;
+  int s = ++pic->uniq_sym_cnt;
   char *str;
   pic_sym uniq;
 
@@ -47,12 +38,8 @@ pic_gensym(pic_state *pic, pic_sym base)
   sprintf(str, "%s@%d", pic_symbol_name(pic, base), s);
 
   /* don't put the symbol to pic->sym_tbl to keep it uninterned */
-  if (pic->slen >= pic->scapa) {
-    pic->scapa *= 2;
-    pic->sym_pool = pic_realloc(pic, pic->sym_pool, sizeof(const char *) * pic->scapa);
-  }
-  uniq = pic->slen++;
-  pic->sym_pool[uniq] = str;
+  uniq = pic->sym_cnt++;
+  xh_put_int(pic->sym_names, uniq, (long)str);
 
   return uniq;
 }
@@ -68,7 +55,7 @@ pic_interned_p(pic_state *pic, pic_sym sym)
 const char *
 pic_symbol_name(pic_state *pic, pic_sym sym)
 {
-  return pic->sym_pool[sym];
+  return (const char *)xh_get_int(pic->sym_names, sym)->val;
 }
 
 static pic_value