Merge branch 'master' into better-error-message2

.gitignore

@@ -1,6 +1,7 @@
 build/*
 src/load_piclib.c
 src/init_contrib.c
+docs/contrib.rst
 .dir-locals.el
 GPATH
 GRTAGS

CMakeLists.txt

@@ -12,7 +12,7 @@ set(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} "${CMAKE_SOURCE_DIR}/cmake/")
 set(CMAKE_RUNTIME_OUTPUT_DIRECTORY bin)
 set(CMAKE_LIBRARY_OUTPUT_DIRECTORY lib)
 set(CMAKE_C_FLAGS "-O2 -Wall -Wextra")
-set(CMAKE_C_FLAGS_DEBUG "-g -DDEBUG=1")
+set(CMAKE_C_FLAGS_DEBUG "-O0 -g -DDEBUG=1")
 
 option(USE_C11_FEATURE "Enable c11 feature" OFF)
 if(USE_C11_FEATURE)

contrib/03.callcc/callcc.c

@@ -161,7 +161,7 @@ native_stack_extend(pic_state *pic, struct pic_cont *cont)
   restore_cont(pic, cont);
 }
 
-pic_noreturn static void
+PIC_NORETURN static void
 restore_cont(pic_state *pic, struct pic_cont *cont)
 {
   char v;
@@ -203,7 +203,7 @@ restore_cont(pic_state *pic, struct pic_cont *cont)
   longjmp(tmp->jmp, 1);
 }
 
-pic_noreturn static pic_value
+PIC_NORETURN static pic_value
 cont_call(pic_state *pic)
 {
   struct pic_proc *proc;
@@ -287,6 +287,12 @@ pic_callcc_callcc(pic_state *pic)
 void
 pic_init_callcc(pic_state *pic)
 {
-  pic_redefun(pic, pic->PICRIN_BASE, "call-with-current-continuation", pic_callcc_callcc);
+  pic_deflibrary (pic, "(picrin control)") {
-  pic_redefun(pic, pic->PICRIN_BASE, "call/cc", pic_callcc_callcc);
+    pic_define(pic, "escape", pic_ref(pic, pic->PICRIN_BASE, "call-with-current-continuation"));
+  }
+
+  pic_deflibrary (pic, "(scheme base)") {
+    pic_redefun(pic, pic->PICRIN_BASE, "call-with-current-continuation", pic_callcc_callcc);
+    pic_redefun(pic, pic->PICRIN_BASE, "call/cc", pic_callcc_callcc);
+  }
 }

contrib/03.file/src/file.c

@@ -6,7 +6,7 @@
 #include "picrin/port.h"
 #include "picrin/error.h"
 
-pic_noreturn static void
+PIC_NORETURN static void
 file_error(pic_state *pic, const char *msg)
 {
   pic_throw(pic, pic->sFILE, msg, pic_nil_value());

contrib/10.partcont/docs/doc.rst

@@ -6,3 +6,7 @@ Delimited control operators.
 - **(reset h)**
 - **(shift k)**
 
+Escape Continuation
+
+- **(escape f)**
+

docs/contrib.rst

@@ -1,141 +0,0 @@
-Contrib Libraries (a.k.a nitros)
-================================
-
-Scheme standard libraries
--------------------------
-
-- (scheme write)
-- (scheme cxr)
-- (scheme file)
-- (scheme inexact)
-- (scheme time)
-- (scheme process-context)
-- (scheme load)
-- (scheme lazy)
-
-(picrin control)
-----------------
-
-Delimited control operators.
-
-- **(reset h)**
-- **(shift k)**
-
-(picrin pretty-print)
----------------------
-
-Pretty-printer.
-
-- **(pretty-print obj)**
-
-  Prints obj with human-readable indention to current-output-port.
-
-
-(picrin regexp)
----------------
-
-- **(regexp ptrn [flags])**
-
-  Compiles pattern string into a regexp object. A string flags may contain any of #\g, #\i, #\m.
-
-- **(regexp? obj)**
-
-  Judges if obj is a regexp object or not.
-
-- **(regexp-match re input)**
-
-  Returns two values: a list of match strings, and a list of match indeces.
-
-- **(regexp-replace re input txt)**
-- **(regexp-split re input)**
-
-
-SRFI libraries
---------------
-
-- `(srfi 1)
-  <http://srfi.schemers.org/srfi-1/>`_
-
-  List library.
-
-- `(srfi 8)
-  <http://srfi.schemers.org/srfi-8/>`_
-
-  ``receive`` macro.
-
-- `(srfi 17)
-  <http://srfi.schemers.org/srfi-17/>`_
-
-  Generalized set!
-
-- `(srfi 26)
-  <http://srfi.schemers.org/srfi-26/>`_
-
-  Cut/cute macros.
-
-- `(srfi 43)
-  <http://srfi.schemers.org/srfi-43/>`_
-
-  Vector library.
-
-- `(srfi 60)
-  <http://srfi.schemers.org/srfi-60/>`_
-
-  Bitwise operations.
-
-- `(srfi 95)
-  <http://srfi.schemers.org/srfi-95/>`_
-
-  Sorting and Marging.
-
-- `(srfi 111)
-  <http://srfi.schemers.org/srfi-111/>`_
-
-  Boxes
-
-(picrin control list)
----------------------
-
-Monadic list operators.
-
-The triple of for/in/yield enables you to write a list operation in a very easy and simple code. One of the best examples is list composition::
-
-  (for (let ((a (in '(1 2 3)))
-             (b (in '(2 3 4))))
-         (yield (+ a b))))
-
-  ;=> (5 6 7 6 7 8 7 8 9)
-
-All monadic operations are done in *for* macro. In this example, *in* operators choose an element from the given lists, a and b are bound here, then *yielding* the sum of them. Because a and b are values moving around in the list elements, the expression (+ a b) can become every possible result. *yield* operator is a operator that gathers the possibilities into a list, so *for* macro returns a list of 3 * 3 results in total. Since expression inside *for* macro is a normal expression, you can write everything that you can write elsewhere. The code below has perfectly the same effect to above one::
-
-  (for (yield (+ (in '(1 2 3))
-                 (in '(4 5 6)))))
-
-The second best exmaple is filtering. In the next case, we show that you can do something depending on the condition of chosen elements::
-
-  (for (let ((x (in (iota 10))))
-         (if (even? x)
-             (yield x)
-             (null))))
-
-  ;=> (0 2 4 6 8)
-
-This expression is equivalent to ``(filter even? (iota 10))`` but it is more procedual and non-magical.
-
-- **(for expr)**
-
-  [Macro] Executes expr in a list monad context.
-
-- **(in list)**
-
-  Choose a value from list. *in* function must only appear in *for* macro. The delimited continuation from the position of *in* function to the outside *for* macro is executed for each element in list. If list contains no values, that is ``(in '())``, the continuation is discarded.
-
-- **(yield value)**
-
-  Yields value from the monad context. The result of *for* will be a list of yielded values.
-
-- **(null . value)**
-
-  Returns ``()`` whatever value is given. The identity element of list composition. This operator corresponds to Haskell's fail method of Monad class.
-
-

extlib/benz/blob.c

@@ -203,7 +203,7 @@ pic_blob_list_to_bytevector(pic_state *pic)
 {
   pic_blob *blob;
   unsigned char *data;
-  pic_value list, e;
+  pic_value list, e, it;
 
   pic_get_args(pic, "o", &list);
 
@@ -211,7 +211,7 @@ pic_blob_list_to_bytevector(pic_state *pic)
 
   data = blob->data;
 
-  pic_for_each (e, list) {
+  pic_for_each (e, list, it) {
     pic_assert_type(pic, e, int);
 
     if (pic_int(e) < 0 || pic_int(e) > 255)

extlib/benz/codegen.c

@@ -17,6 +17,10 @@
 # error enable PIC_NONE_IS_FALSE
 #endif
 
+typedef xvect_t(pic_sym *) xvect;
+
+#define xv_push_sym(v, x) xv_push(pic_sym *, (v), (x))
+
 /**
  * scope object
  */
@@ -64,6 +68,7 @@ new_analyze_state(pic_state *pic)
 {
   analyze_state *state;
   pic_sym *sym;
+  xh_entry *it;
 
   state = pic_alloc(pic, sizeof(analyze_state));
   state->pic = pic;
@@ -92,8 +97,8 @@ new_analyze_state(pic_state *pic)
   /* push initial scope */
   push_scope(state, pic_nil_value());
 
-  pic_dict_for_each (sym, pic->globals) {
+  pic_dict_for_each (sym, pic->globals, it) {
-    xv_push(&state->scope->locals, &sym);
+    xv_push_sym(state->scope->locals, sym);
   }
 
   return state;
@@ -118,7 +123,7 @@ analyze_args(pic_state *pic, pic_value formals, bool *varg, xvect *args, xvect *
       return false;
     }
     sym = pic_sym_ptr(t);
-    xv_push(args, &sym);
+    xv_push_sym(*args, sym);
   }
   if (pic_nil_p(v)) {
     *varg = false;
@@ -126,7 +131,7 @@ analyze_args(pic_state *pic, pic_value formals, bool *varg, xvect *args, xvect *
   else if (pic_sym_p(v)) {
     *varg = true;
     sym = pic_sym_ptr(v);
-    xv_push(locals, &sym);
+    xv_push_sym(*locals, sym);
   }
   else {
     return false;
@@ -143,9 +148,9 @@ push_scope(analyze_state *state, pic_value formals)
   bool varg;
   xvect args, locals, captures;
 
-  xv_init(&args, sizeof(pic_sym *));
+  xv_init(args);
-  xv_init(&locals, sizeof(pic_sym *));
+  xv_init(locals);
-  xv_init(&captures, sizeof(pic_sym *));
+  xv_init(captures);
 
   if (analyze_args(pic, formals, &varg, &args, &locals)) {
     scope = pic_alloc(pic, sizeof(analyze_scope));
@@ -162,8 +167,8 @@ push_scope(analyze_state *state, pic_value formals)
     return true;
   }
   else {
-    xv_destroy(&args);
+    xv_destroy(args);
-    xv_destroy(&locals);
+    xv_destroy(locals);
     return false;
   }
 }
@@ -171,12 +176,13 @@ push_scope(analyze_state *state, pic_value formals)
 static void
 pop_scope(analyze_state *state)
 {
+  pic_state *pic = state->pic;
   analyze_scope *scope;
 
   scope = state->scope;
-  xv_destroy(&scope->args);
+  xv_destroy(scope->args);
-  xv_destroy(&scope->locals);
+  xv_destroy(scope->locals);
-  xv_destroy(&scope->captures);
+  xv_destroy(scope->captures);
 
   scope = scope->up;
   pic_free(state->pic, state->scope);
@@ -186,38 +192,33 @@ pop_scope(analyze_state *state)
 static bool
 lookup_scope(analyze_scope *scope, pic_sym *sym)
 {
-  pic_sym **arg, **local;
   size_t i;
 
   /* args */
-  for (i = 0; i < xv_size(&scope->args); ++i) {
+  for (i = 0; i < xv_size(scope->args); ++i) {
-    arg = xv_get(&scope->args, i);
+    if (xv_A(scope->args, i) == sym)
-    if (*arg == sym)
       return true;
   }
   /* locals */
-  for (i = 0; i < xv_size(&scope->locals); ++i) {
+  for (i = 0; i < xv_size(scope->locals); ++i) {
-    local = xv_get(&scope->locals, i);
+    if (xv_A(scope->locals, i) == sym)
-    if (*local == sym)
       return true;
   }
   return false;
 }
 
 static void
-capture_var(analyze_scope *scope, pic_sym *sym)
+capture_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
 {
-  pic_sym **var;
   size_t i;
 
-  for (i = 0; i < xv_size(&scope->captures); ++i) {
+  for (i = 0; i < xv_size(scope->captures); ++i) {
-    var = xv_get(&scope->captures, i);
+    if (xv_A(scope->captures, i) == sym) {
-    if (*var == sym) {
       break;
     }
   }
-  if (i == xv_size(&scope->captures)) {
+  if (i == xv_size(scope->captures)) {
-    xv_push(&scope->captures, &sym);
+    xv_push_sym(scope->captures, sym);
   }
 }
 
@@ -230,7 +231,7 @@ find_var(analyze_state *state, pic_sym *sym)
   while (scope) {
     if (lookup_scope(scope, sym)) {
       if (depth > 0) {
-        capture_var(scope, sym);
+        capture_var(state->pic, scope, sym);
       }
       return depth;
     }
@@ -251,7 +252,7 @@ define_var(analyze_state *state, pic_sym *sym)
     return;
   }
 
-  xv_push(&scope->locals, &sym);
+  xv_push_sym(scope->locals, sym);
 }
 
 static pic_value analyze_node(analyze_state *, pic_value, bool);
@@ -344,9 +345,9 @@ static void
 analyze_deferred(analyze_state *state)
 {
   pic_state *pic = state->pic;
-  pic_value defer, val, name, formal, body, dst;
+  pic_value defer, val, name, formal, body, dst, it;
 
-  pic_for_each (defer, pic_reverse(pic, state->scope->defer)) {
+  pic_for_each (defer, pic_reverse(pic, state->scope->defer), it) {
     name = pic_list_ref(pic, defer, 0);
     formal = pic_list_ref(pic, defer, 1);
     body = pic_list_ref(pic, defer, 2);
@@ -372,13 +373,11 @@ analyze_procedure(analyze_state *state, pic_value name, pic_value formals, pic_v
 
   if (push_scope(state, formals)) {
     analyze_scope *scope = state->scope;
-    pic_sym **var;
     size_t i;
 
     args = pic_nil_value();
-    for (i = xv_size(&scope->args); i > 0; --i) {
+    for (i = xv_size(scope->args); i > 0; --i) {
-      var = xv_get(&scope->args, i - 1);
+      pic_push(pic, pic_obj_value(xv_A(scope->args, i - 1)), args);
-      pic_push(pic, pic_obj_value(*var), args);
     }
 
     varg = scope->varg
@@ -391,15 +390,13 @@ analyze_procedure(analyze_state *state, pic_value name, pic_value formals, pic_v
     analyze_deferred(state);
 
     locals = pic_nil_value();
-    for (i = xv_size(&scope->locals); i > 0; --i) {
+    for (i = xv_size(scope->locals); i > 0; --i) {
-      var = xv_get(&scope->locals, i - 1);
+      pic_push(pic, pic_obj_value(xv_A(scope->locals, i - 1)), locals);
-      pic_push(pic, pic_obj_value(*var), locals);
     }
 
     captures = pic_nil_value();
-    for (i = xv_size(&scope->captures); i > 0; --i) {
+    for (i = xv_size(scope->captures); i > 0; --i) {
-      var = xv_get(&scope->captures, i - 1);
+      pic_push(pic, pic_obj_value(xv_A(scope->captures, i - 1)), captures);
-      pic_push(pic, pic_obj_value(*var), captures);
     }
 
     pop_scope(state);
@@ -570,7 +567,7 @@ analyze_quote(analyze_state *state, pic_value obj)
 
 #define FOLD_ARGS(sym) do {                             \
     obj = analyze(state, pic_car(pic, args), false);    \
-    pic_for_each (arg, pic_cdr(pic, args)) {            \
+    pic_for_each (arg, pic_cdr(pic, args), it) {        \
       obj = pic_list3(pic, pic_obj_value(sym), obj,     \
                       analyze(state, arg, false));      \
     }                                                   \
@@ -581,7 +578,7 @@ static pic_value
 analyze_add(analyze_state *state, pic_value obj, bool tailpos)
 {
   pic_state *pic = state->pic;
-  pic_value args, arg;
+  pic_value args, arg, it;
 
   ARGC_ASSERT_GE(0, "+");
   switch (pic_length(pic, obj)) {
@@ -600,7 +597,7 @@ static pic_value
 analyze_sub(analyze_state *state, pic_value obj)
 {
   pic_state *pic = state->pic;
-  pic_value args, arg;
+  pic_value args, arg, it;
 
   ARGC_ASSERT_GE(1, "-");
   switch (pic_length(pic, obj)) {
@@ -618,7 +615,7 @@ static pic_value
 analyze_mul(analyze_state *state, pic_value obj, bool tailpos)
 {
   pic_state *pic = state->pic;
-  pic_value args, arg;
+  pic_value args, arg, it;
 
   ARGC_ASSERT_GE(0, "*");
   switch (pic_length(pic, obj)) {
@@ -637,7 +634,7 @@ static pic_value
 analyze_div(analyze_state *state, pic_value obj)
 {
   pic_state *pic = state->pic;
-  pic_value args, arg;
+  pic_value args, arg, it;
 
   ARGC_ASSERT_GE(1, "/");
   switch (pic_length(pic, obj)) {
@@ -656,7 +653,7 @@ static pic_value
 analyze_call(analyze_state *state, pic_value obj, bool tailpos)
 {
   pic_state *pic = state->pic;
-  pic_value seq, elt;
+  pic_value seq, elt, it;
   pic_sym *call;
 
   if (! tailpos) {
@@ -665,7 +662,7 @@ analyze_call(analyze_state *state, pic_value obj, bool tailpos)
     call = pic->sTAILCALL;
   }
   seq = pic_list1(pic, pic_obj_value(call));
-  pic_for_each (elt, obj) {
+  pic_for_each (elt, obj, it) {
     seq = pic_cons(pic, analyze(state, elt, false), seq);
   }
   return pic_reverse(pic, seq);
@@ -675,14 +672,14 @@ static pic_value
 analyze_values(analyze_state *state, pic_value obj, bool tailpos)
 {
   pic_state *pic = state->pic;
-  pic_value v, seq;
+  pic_value v, seq, it;
 
   if (! tailpos) {
     return analyze_call(state, obj, false);
   }
 
   seq = pic_list1(pic, pic_obj_value(pic->sRETURN));
-  pic_for_each (v, pic_cdr(pic, obj)) {
+  pic_for_each (v, pic_cdr(pic, obj), it) {
     seq = pic_cons(pic, analyze(state, v, false), seq);
   }
   return pic_reverse(pic, seq);
@@ -931,27 +928,24 @@ create_activation(codegen_context *cxt)
 {
   size_t i, n;
   xhash regs;
-  pic_sym **var;
   size_t offset;
 
   xh_init_ptr(&regs, sizeof(size_t));
 
   offset = 1;
-  for (i = 0; i < xv_size(&cxt->args); ++i) {
+  for (i = 0; i < xv_size(cxt->args); ++i) {
-    var = xv_get(&cxt->args, i);
     n = i + offset;
-    xh_put_ptr(&regs, *var, &n);
+    xh_put_ptr(&regs, xv_A(cxt->args, i), &n);
   }
   offset += i;
-  for (i = 0; i < xv_size(&cxt->locals); ++i) {
+  for (i = 0; i < xv_size(cxt->locals); ++i) {
-    var = xv_get(&cxt->locals, i);
     n = i + offset;
-    xh_put_ptr(&regs, *var, &n);
+    xh_put_ptr(&regs, xv_A(cxt->locals, i), &n);
   }
 
-  for (i = 0; i < xv_size(&cxt->captures); ++i) {
+  for (i = 0; i < xv_size(cxt->captures); ++i) {
-    var = xv_get(&cxt->captures, i);
+    n = xh_val(xh_get_ptr(&regs, xv_A(cxt->captures, i)), size_t);
-    if ((n = xh_val(xh_get_ptr(&regs, *var), size_t)) <= xv_size(&cxt->args) || (cxt->varg && n == xv_size(&cxt->args) + 1)) {
+    if (n <= xv_size(cxt->args) || (cxt->varg && n == xv_size(cxt->args) + 1)) {
       /* copy arguments to capture variable area */
       cxt->code[cxt->clen].insn = OP_LREF;
       cxt->code[cxt->clen].u.i = (int)n;
@@ -971,8 +965,7 @@ push_codegen_context(codegen_state *state, pic_value name, pic_value args, pic_v
 {
   pic_state *pic = state->pic;
   codegen_context *cxt;
-  pic_value var;
+  pic_value var, it;
-  pic_sym *sym;
 
   assert(pic_sym_p(name) || pic_false_p(name));
 
@@ -983,21 +976,18 @@ push_codegen_context(codegen_state *state, pic_value name, pic_value args, pic_v
     : pic_sym_ptr(name);
   cxt->varg = varg;
 
-  xv_init(&cxt->args, sizeof(pic_sym *));
+  xv_init(cxt->args);
-  xv_init(&cxt->locals, sizeof(pic_sym *));
+  xv_init(cxt->locals);
-  xv_init(&cxt->captures, sizeof(pic_sym *));
+  xv_init(cxt->captures);
 
-  pic_for_each (var, args) {
+  pic_for_each (var, args, it) {
-    sym = pic_sym_ptr(var);
+    xv_push_sym(cxt->args, pic_sym_ptr(var));
-    xv_push(&cxt->args, &sym);
   }
-  pic_for_each (var, locals) {
+  pic_for_each (var, locals, it) {
-    sym = pic_sym_ptr(var);
+    xv_push_sym(cxt->locals, pic_sym_ptr(var));
-    xv_push(&cxt->locals, &sym);
   }
-  pic_for_each (var, captures) {
+  pic_for_each (var, captures, it) {
-    sym = pic_sym_ptr(var);
+    xv_push_sym(cxt->captures, pic_sym_ptr(var));
-    xv_push(&cxt->captures, &sym);
   }
 
   cxt->code = pic_calloc(pic, PIC_ISEQ_SIZE, sizeof(pic_code));
@@ -1012,9 +1002,9 @@ push_codegen_context(codegen_state *state, pic_value name, pic_value args, pic_v
   cxt->plen = 0;
   cxt->pcapa = PIC_POOL_SIZE;
 
-  cxt->syms = pic_calloc(pic, PIC_POOL_SIZE, sizeof(pic_sym *));
+  cxt->syms = pic_calloc(pic, PIC_SYMS_SIZE, sizeof(pic_sym *));
   cxt->slen = 0;
-  cxt->scapa = PIC_POOL_SIZE;
+  cxt->scapa = PIC_SYMS_SIZE;
 
   state->cxt = cxt;
 
@@ -1032,9 +1022,9 @@ pop_codegen_context(codegen_state *state)
   irep = (struct pic_irep *)pic_obj_alloc(pic, sizeof(struct pic_irep), PIC_TT_IREP);
   irep->name = state->cxt->name;
   irep->varg = state->cxt->varg;
-  irep->argc = (int)xv_size(&state->cxt->args) + 1;
+  irep->argc = (int)xv_size(state->cxt->args) + 1;
-  irep->localc = (int)xv_size(&state->cxt->locals);
+  irep->localc = (int)xv_size(state->cxt->locals);
-  irep->capturec = (int)xv_size(&state->cxt->captures);
+  irep->capturec = (int)xv_size(state->cxt->captures);
   irep->code = pic_realloc(pic, state->cxt->code, sizeof(pic_code) * state->cxt->clen);
   irep->clen = state->cxt->clen;
   irep->irep = pic_realloc(pic, state->cxt->irep, sizeof(struct pic_irep *) * state->cxt->ilen);
@@ -1045,9 +1035,9 @@ pop_codegen_context(codegen_state *state)
   irep->slen = state->cxt->slen;
 
   /* finalize */
-  xv_destroy(&cxt->args);
+  xv_destroy(cxt->args);
-  xv_destroy(&cxt->locals);
+  xv_destroy(cxt->locals);
-  xv_destroy(&cxt->captures);
+  xv_destroy(cxt->captures);
 
   /* destroy context */
   cxt = cxt->up;
@@ -1062,15 +1052,13 @@ index_capture(codegen_state *state, pic_sym *sym, int depth)
 {
   codegen_context *cxt = state->cxt;
   size_t i;
-  pic_sym **var;
 
   while (depth-- > 0) {
     cxt = cxt->up;
   }
 
-  for (i = 0; i < xv_size(&cxt->captures); ++i) {
+  for (i = 0; i < xv_size(cxt->captures); ++i) {
-    var = xv_get(&cxt->captures, i);
+    if (xv_A(cxt->captures, i) == sym)
-    if (*var == sym)
       return (int)i;
   }
   return -1;
@@ -1081,18 +1069,15 @@ index_local(codegen_state *state, pic_sym *sym)
 {
   codegen_context *cxt = state->cxt;
   size_t i, offset;
-  pic_sym **var;
 
   offset = 1;
-  for (i = 0; i < xv_size(&cxt->args); ++i) {
+  for (i = 0; i < xv_size(cxt->args); ++i) {
-    var = xv_get(&cxt->args, i);
+    if (xv_A(cxt->args, i) == sym)
-    if (*var == sym)
       return (int)(i + offset);
   }
   offset += i;
-  for (i = 0; i < xv_size(&cxt->locals); ++i) {
+  for (i = 0; i < xv_size(cxt->locals); ++i) {
-    var = xv_get(&cxt->locals, i);
+    if (xv_A(cxt->locals, i) == sym)
-    if (*var == sym)
       return (int)(i + offset);
   }
   return -1;
@@ -1151,7 +1136,7 @@ codegen(codegen_state *state, pic_value obj)
     name = pic_sym_ptr(pic_list_ref(pic, obj, 1));
     if ((i = index_capture(state, name, 0)) != -1) {
       cxt->code[cxt->clen].insn = OP_LREF;
-      cxt->code[cxt->clen].u.i = i + (int)xv_size(&cxt->args) + (int)xv_size(&cxt->locals) + 1;
+      cxt->code[cxt->clen].u.i = i + (int)xv_size(cxt->args) + (int)xv_size(cxt->locals) + 1;
       cxt->clen++;
       return;
     }
@@ -1197,7 +1182,7 @@ codegen(codegen_state *state, pic_value obj)
       name = pic_sym_ptr(pic_list_ref(pic, var, 1));
       if ((i = index_capture(state, name, 0)) != -1) {
         cxt->code[cxt->clen].insn = OP_LSET;
-        cxt->code[cxt->clen].u.i = i + (int)xv_size(&cxt->args) + (int)xv_size(&cxt->locals) + 1;
+        cxt->code[cxt->clen].u.i = i + (int)xv_size(cxt->args) + (int)xv_size(cxt->locals) + 1;
         cxt->clen++;
         cxt->code[cxt->clen].insn = OP_PUSHNONE;
         cxt->clen++;
@@ -1247,10 +1232,10 @@ codegen(codegen_state *state, pic_value obj)
     return;
   }
   else if (sym == pic->sBEGIN) {
-    pic_value elt;
+    pic_value elt, it;
     int i = 0;
 
-    pic_for_each (elt, pic_cdr(pic, obj)) {
+    pic_for_each (elt, pic_cdr(pic, obj), it) {
       if (i++ != 0) {
         cxt->code[cxt->clen].insn = OP_POP;
         cxt->clen++;
@@ -1413,9 +1398,9 @@ codegen(codegen_state *state, pic_value obj)
   }
   else if (sym == pic->sCALL || sym == pic->sTAILCALL) {
     int len = (int)pic_length(pic, obj);
-    pic_value elt;
+    pic_value elt, it;
 
-    pic_for_each (elt, pic_cdr(pic, obj)) {
+    pic_for_each (elt, pic_cdr(pic, obj), it) {
       codegen(state, elt);
     }
     cxt->code[cxt->clen].insn = (sym == pic->sCALL) ? OP_CALL : OP_TAILCALL;
@@ -1439,9 +1424,9 @@ codegen(codegen_state *state, pic_value obj)
   }
   else if (sym == pic->sRETURN) {
     int len = (int)pic_length(pic, obj);
-    pic_value elt;
+    pic_value elt, it;
 
-    pic_for_each (elt, pic_cdr(pic, obj)) {
+    pic_for_each (elt, pic_cdr(pic, obj), it) {
       codegen(state, elt);
     }
     cxt->code[cxt->clen].insn = OP_RET;

extlib/benz/cont.c

@@ -99,6 +99,7 @@ escape_call(pic_state *pic)
   pic_get_args(pic, "*", &argc, &argv);
 
   e = pic_data_ptr(pic_attr_ref(pic, pic_obj_value(pic_get_proc(pic)), "@@escape"));
+  ((struct pic_escape *)e->data)->results = pic_list_by_array(pic, argc, argv);
 
   pic_load_point(pic, e->data);
 
@@ -195,11 +196,11 @@ pic_values_by_array(pic_state *pic, size_t argc, pic_value *argv)
 pic_value
 pic_values_by_list(pic_state *pic, pic_value list)
 {
-  pic_value v;
+  pic_value v, it;
   int i;
 
   i = 0;
-  pic_for_each (v, list) {
+  pic_for_each (v, list, it) {
     pic->sp[i++] = v;
   }
   pic->ci->retc = i;

extlib/benz/dict.c

@@ -273,13 +273,13 @@ static pic_value
 pic_dict_alist_to_dictionary(pic_state *pic)
 {
   struct pic_dict *dict;
-  pic_value alist, e;
+  pic_value alist, e, it;
 
   pic_get_args(pic, "o", &alist);
 
   dict = pic_make_dict(pic);
 
-  pic_for_each (e, pic_reverse(pic, alist)) {
+  pic_for_each (e, pic_reverse(pic, alist), it) {
     pic_assert_type(pic, pic_car(pic, e), sym);
     pic_dict_set(pic, dict, pic_sym_ptr(pic_car(pic, e)), pic_cdr(pic, e));
   }

extlib/benz/gc.c

@@ -57,24 +57,24 @@ heap_init(struct pic_heap *heap)
 }
 
 struct pic_heap *
-pic_heap_open()
+pic_heap_open(pic_state *pic)
 {
   struct pic_heap *heap;
 
-  heap = (struct pic_heap *)calloc(1, sizeof(struct pic_heap));
+  heap = pic_calloc(pic, 1, sizeof(struct pic_heap));
   heap_init(heap);
   return heap;
 }
 
 void
-pic_heap_close(struct pic_heap *heap)
+pic_heap_close(pic_state *pic, struct pic_heap *heap)
 {
   struct heap_page *page;
 
   while (heap->pages) {
     page = heap->pages;
     heap->pages = heap->pages->next;
-    free(page);
+    pic_free(pic, page);
   }
 }
 
@@ -510,21 +510,6 @@ gc_mark(pic_state *pic, pic_value v)
   gc_mark_object(pic, obj);
 }
 
-static void
-gc_mark_trie(pic_state *pic, struct pic_trie *trie)
-{
-  size_t i;
-
-  for (i = 0; i < sizeof trie->table / sizeof(struct pic_trie *); ++i) {
-    if (trie->table[i] != NULL) {
-      gc_mark_trie(pic, trie->table[i]);
-    }
-  }
-  if (trie->proc != NULL) {
-    gc_mark_object(pic, (struct pic_object *)trie->proc);
-  }
-}
-
 #define M(x) gc_mark_object(pic, (struct pic_object *)pic->x)
 
 static void
@@ -606,9 +591,6 @@ gc_mark_phase(pic_state *pic)
   /* features */
   gc_mark(pic, pic->features);
 
-  /* readers */
-  gc_mark_trie(pic, pic->reader->trie);
-
   /* library table */
   gc_mark(pic, pic->libs);
 
@@ -722,20 +704,20 @@ static void
 gc_sweep_symbols(pic_state *pic)
 {
   xh_entry *it;
-  xvect xv;
+  xvect_t(xh_entry *) xv;
   size_t i;
   char *cstr;
 
-  xv_init(&xv, sizeof(xh_entry *));
+  xv_init(xv);
 
   for (it = xh_begin(&pic->syms); it != NULL; it = xh_next(it)) {
     if (! gc_obj_is_marked((struct pic_object *)xh_val(it, pic_sym *))) {
-      xv_push(&xv, &it);
+      xv_push(xh_entry *, xv, it);
     }
   }
 
-  for (i = 0; i < xv_size(&xv); ++i) {
+  for (i = 0; i < xv_size(xv); ++i) {
-    cstr = xh_key(*(xh_entry **)xv_get(&xv, i), char *);
+    cstr = xh_key(xv_A(xv, i), char *);
 
     xh_del_str(&pic->syms, cstr);
 

extlib/benz/include/picrin.h

@@ -42,13 +42,14 @@ extern "C" {
 #include <math.h>
 #include <ctype.h>
 
+#include "picrin/config.h"
+#include "picrin/util.h"
+
 #include "picrin/xvect.h"
 #include "picrin/xhash.h"
 #include "picrin/xfile.h"
 #include "picrin/xrope.h"
 
-#include "picrin/config.h"
-#include "picrin/util.h"
 #include "picrin/value.h"
 
 typedef struct pic_code pic_code;
@@ -87,7 +88,7 @@ typedef struct {
 
   pic_code *ip;
 
-  struct pic_lib *lib;
+  struct pic_lib *lib, *prev_lib;
 
   pic_sym *sDEFINE, *sLAMBDA, *sIF, *sBEGIN, *sQUOTE, *sSETBANG;
   pic_sym *sQUASIQUOTE, *sUNQUOTE, *sUNQUOTE_SPLICING;
@@ -208,25 +209,26 @@ struct pic_lib *pic_open_library(pic_state *, pic_value);
 struct pic_lib *pic_find_library(pic_state *, pic_value);
 
 #define pic_deflibrary(pic, spec)                                       \
-  pic_deflibrary_helper_(pic, PIC_GENSYM(i), PIC_GENSYM(prev_lib), spec)
+  for (((assert(pic->prev_lib == NULL)),                                \
-#define pic_deflibrary_helper_(pic, i, prev_lib, spec)                  \
+        (pic->prev_lib = pic->lib),                                     \
-  for (int i = 0; ! i; )                                                \
+        (pic->lib = pic_open_library(pic, pic_read_cstr(pic, (spec))))); \
-    for (struct pic_lib *prev_lib; ! i; )                               \
+       pic->prev_lib != NULL;                                           \
-      for ((prev_lib = pic->lib), pic_open_library(pic, pic_read_cstr(pic, spec)), pic_in_library(pic, pic_read_cstr(pic, spec)); ! i++; pic->lib = prev_lib)
+       ((pic->lib = pic->prev_lib),                                     \
+        (pic->prev_lib = NULL)))
 
 void pic_import(pic_state *, pic_value);
 void pic_import_library(pic_state *, struct pic_lib *);
 void pic_export(pic_state *, pic_sym *);
 
-pic_noreturn void pic_panic(pic_state *, const char *);
+PIC_NORETURN void pic_panic(pic_state *, const char *);
-pic_noreturn void pic_errorf(pic_state *, const char *, ...);
+PIC_NORETURN void pic_errorf(pic_state *, const char *, ...);
 void pic_warnf(pic_state *, const char *, ...);
 const char *pic_errmsg(pic_state *);
 pic_str *pic_get_backtrace(pic_state *);
 void pic_print_backtrace(pic_state *);
 
 /* obsoleted */
-static inline void pic_warn(pic_state *pic, const char *msg)
+PIC_INLINE void pic_warn(pic_state *pic, const char *msg)
 {
   pic_warnf(pic, msg);
 }

extlib/benz/include/picrin/config.h

@@ -26,6 +26,8 @@
 
 /* #define PIC_POOL_SIZE 8 */
 
+/* #define PIC_SYMS_SIZE 32 */
+
 /* #define PIC_ISEQ_SIZE 1024 */
 
 /** enable all debug flags */
@@ -85,6 +87,10 @@
 # define PIC_POOL_SIZE 8
 #endif
 
+#ifndef PIC_SYMS_SIZE
+# define PIC_SYMS_SIZE 32
+#endif
+
 #ifndef PIC_ISEQ_SIZE
 # define PIC_ISEQ_SIZE 1024
 #endif

extlib/benz/include/picrin/data.h

@@ -25,7 +25,7 @@ struct pic_data {
 #define pic_data_p(o) (pic_type(o) == PIC_TT_DATA)
 #define pic_data_ptr(o) ((struct pic_data *)pic_ptr(o))
 
-static inline bool pic_data_type_p(const pic_value obj, const pic_data_type *type) {
+PIC_INLINE bool pic_data_type_p(const pic_value obj, const pic_data_type *type) {
   return pic_data_p(obj) && pic_data_ptr(obj)->type == type;
 }
 

extlib/benz/include/picrin/dict.h

@@ -19,12 +19,9 @@ struct pic_dict {
 
 struct pic_dict *pic_make_dict(pic_state *);
 
-#define pic_dict_for_each(sym, dict)                    \
+#define pic_dict_for_each(sym, dict, it)                                \
-  pic_dict_for_each_helper_((sym), PIC_GENSYM(tmp), (dict))
+  for (it = xh_begin(&(dict)->hash); it != NULL; it = xh_next(it))      \
-#define pic_dict_for_each_helper_(var, tmp, dict)                       \
+    if ((sym = xh_key(it, pic_sym *)), true)
-  for (xh_entry *tmp = xh_begin(&dict->hash);                           \
-       (tmp && ((var = xh_key(tmp, pic_sym *)), 1));                    \
-       tmp = xh_next(tmp))
 
 pic_value pic_dict_ref(pic_state *, struct pic_dict *, pic_sym *);
 void pic_dict_set(pic_state *, struct pic_dict *, pic_sym *, pic_value);

extlib/benz/include/picrin/error.h

@@ -28,24 +28,32 @@ struct pic_error *pic_make_error(pic_state *, pic_sym *, const char *, pic_list)
 
 #define pic_try                                 \
   pic_try_(PIC_GENSYM(escape))
+#define pic_catch                               \
+  pic_catch_(PIC_GENSYM(label))
 #define pic_try_(escape)                                                \
-  struct pic_escape *escape = pic_alloc(pic, sizeof(struct pic_escape)); \
+  do {                                                                  \
-  pic_save_point(pic, escape);                                          \
+    struct pic_escape *escape = pic_alloc(pic, sizeof(struct pic_escape)); \
-  if (setjmp(escape->jmp) == 0) {                                       \
+    pic_save_point(pic, escape);                                        \
-    pic_push_try(pic, escape);                                          \
+    if (setjmp(escape->jmp) == 0) {                                     \
-    do
+      pic_push_try(pic, escape);                                        \
-#define pic_catch                                         \
+      do
-    while (0);                                            \
+#define pic_catch_(label)                                 \
-    pic_pop_try(pic);                                     \
+      while (0);                                          \
-  } else
+      pic_pop_try(pic);                                   \
+    } else {                                              \
+      goto label;                                         \
+    }                                                     \
+  } while (0);                                            \
+  if (0)                                                  \
+  label:
 
 void pic_push_try(pic_state *, struct pic_escape *);
 void pic_pop_try(pic_state *);
 
 pic_value pic_raise_continuable(pic_state *, pic_value);
-pic_noreturn void pic_raise(pic_state *, pic_value);
+PIC_NORETURN void pic_raise(pic_state *, pic_value);
-pic_noreturn void pic_throw(pic_state *, pic_sym *, const char *, pic_list);
+PIC_NORETURN void pic_throw(pic_state *, pic_sym *, const char *, pic_list);
-pic_noreturn void pic_error(pic_state *, const char *, pic_list);
+PIC_NORETURN void pic_error(pic_state *, const char *, pic_list);
 
 #if defined(__cplusplus)
 }

extlib/benz/include/picrin/gc.h

@@ -14,8 +14,8 @@ extern "C" {
 
 struct pic_heap;
 
-struct pic_heap *pic_heap_open();
+struct pic_heap *pic_heap_open(pic_state *);
-void pic_heap_close(struct pic_heap *);
+void pic_heap_close(pic_state *, struct pic_heap *);
 
 #if defined(__cplusplus)
 }

extlib/benz/include/picrin/irep.h

@@ -75,7 +75,7 @@ struct pic_irep {
 pic_value pic_analyze(pic_state *, pic_value);
 struct pic_irep *pic_codegen(pic_state *, pic_value);
 
-static inline void
+PIC_INLINE void
 pic_dump_code(pic_code c)
 {
   printf("[%2d] ", c.insn);
@@ -191,7 +191,7 @@ pic_dump_code(pic_code c)
   }
 }
 
-static inline void
+PIC_INLINE void
 pic_dump_irep(struct pic_irep *irep)
 {
   unsigned i;

extlib/benz/include/picrin/pair.h

@@ -18,7 +18,7 @@ struct pic_pair {
 #define pic_pair_p(v) (pic_type(v) == PIC_TT_PAIR)
 #define pic_pair_ptr(o) ((struct pic_pair *)pic_ptr(o))
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_car(pic_state *pic, pic_value obj)
 {
   struct pic_pair *pair;
@@ -31,7 +31,7 @@ pic_car(pic_state *pic, pic_value obj)
   return pair->car;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_cdr(pic_state *pic, pic_value obj)
 {
   struct pic_pair *pair;
@@ -59,12 +59,9 @@ pic_value pic_list7(pic_state *, pic_value, pic_value, pic_value, pic_value, pic
 pic_value pic_list_by_array(pic_state *, size_t, pic_value *);
 pic_value pic_make_list(pic_state *, size_t, pic_value);
 
-#define pic_for_each(var, list)                         \
+#define pic_for_each(var, list, it)                             \
-  pic_for_each_helper_(var, PIC_GENSYM(tmp), list)
+  for (it = (list); ! pic_nil_p(it); it = pic_cdr(pic, it))     \
-#define pic_for_each_helper_(var, tmp, list)                            \
+    if ((var = pic_car(pic, it)), true)
-  for (pic_value tmp = (list);                                          \
-       pic_nil_p(tmp) ? false : ((var = pic_car(pic, tmp)), true);      \
-       tmp = pic_cdr(pic, tmp))
 
 #define pic_push(pic, item, place) (place = pic_cons(pic, item, place))
 #define pic_pop(pic, place) (place = pic_cdr(pic, place))

extlib/benz/include/picrin/port.h

@@ -13,12 +13,12 @@ enum pic_port_flag {
   PIC_PORT_IN = 1,
   PIC_PORT_OUT = 2,
   PIC_PORT_TEXT = 4,
-  PIC_PORT_BINARY = 8,
+  PIC_PORT_BINARY = 8
 };
 
 enum pic_port_status {
   PIC_PORT_OPEN,
-  PIC_PORT_CLOSE,
+  PIC_PORT_CLOSE
 };
 
 struct pic_port {

extlib/benz/include/picrin/read.h

@@ -9,28 +9,20 @@
 extern "C" {
 #endif
 
-enum pic_typecase {
+typedef pic_value (*pic_reader_t)(pic_state *, struct pic_port *port, int c);
-  PIC_CASE_DEFAULT,
-  PIC_CASE_FOLD,
-};
-
-struct pic_trie {
-  struct pic_trie *table[256];
-  struct pic_proc *proc;
-};
 
 struct pic_reader {
-  short typecase;
+  enum pic_typecase {
+    PIC_CASE_DEFAULT,
+    PIC_CASE_FOLD,
+  } typecase;
   xhash labels;
-  struct pic_trie *trie;
+  pic_reader_t table[256];
+  pic_reader_t dispatch[256];
 };
 
-void pic_init_reader(pic_state *);
+struct pic_reader *pic_reader_open(pic_state *);
-
+void pic_reader_close(pic_state *, struct pic_reader *);
-void pic_define_reader(pic_state *, const char *, pic_func_t);
-
-struct pic_trie *pic_make_trie(pic_state *);
-void pic_trie_delete(pic_state *, struct pic_trie *);
 
 #if defined(__cplusplus)
 }

extlib/benz/include/picrin/util.h

@@ -11,11 +11,19 @@ extern "C" {
 
 #if __STDC_VERSION__ >= 201112L
 # include <stdnoreturn.h>
-# define pic_noreturn noreturn
+# define PIC_NORETURN noreturn
 #elif __GNUC__ || __clang__
-# define pic_noreturn __attribute__((noreturn))
+# define PIC_NORETURN __attribute__((noreturn))
 #else
-# define pic_noreturn
+# define PIC_NORETURN
+#endif
+
+#if __STDC_VERSION__ >= 199901L
+# define PIC_INLINE static inline
+#elif __GNUC__ || __clang__
+# define PIC_INLINE static __attribute__((unused))
+#else
+# define PIC_INLINE static
 #endif
 
 #define PIC_FALLTHROUGH ((void)0)

extlib/benz/include/picrin/value.h

@@ -111,7 +111,7 @@ enum pic_tt {
   PIC_TT_IREP,
   PIC_TT_DATA,
   PIC_TT_DICT,
-  PIC_TT_RECORD,
+  PIC_TT_RECORD
 };
 
 #define PIC_OBJECT_HEADER			\
@@ -153,32 +153,32 @@ typedef struct pic_blob pic_blob;
 
 #define pic_test(v) (! pic_false_p(v))
 
-static inline enum pic_tt pic_type(pic_value);
+PIC_INLINE enum pic_tt pic_type(pic_value);
-static inline const char *pic_type_repr(enum pic_tt);
+PIC_INLINE const char *pic_type_repr(enum pic_tt);
 
 #define pic_assert_type(pic, v, type)                           \
   if (! pic_##type##_p(v)) {                                    \
     pic_errorf(pic, "expected " #type ", but got ~s", v);       \
   }
 
-static inline bool pic_valid_int(double);
+PIC_INLINE bool pic_valid_int(double);
 
-static inline pic_value pic_nil_value();
+PIC_INLINE pic_value pic_nil_value();
-static inline pic_value pic_true_value();
+PIC_INLINE pic_value pic_true_value();
-static inline pic_value pic_false_value();
+PIC_INLINE pic_value pic_false_value();
-static inline pic_value pic_bool_value(bool);
+PIC_INLINE pic_value pic_bool_value(bool);
-static inline pic_value pic_undef_value();
+PIC_INLINE pic_value pic_undef_value();
-static inline pic_value pic_obj_value(void *);
+PIC_INLINE pic_value pic_obj_value(void *);
-static inline pic_value pic_float_value(double);
+PIC_INLINE pic_value pic_float_value(double);
-static inline pic_value pic_int_value(int);
+PIC_INLINE pic_value pic_int_value(int);
-static inline pic_value pic_size_value(size_t);
+PIC_INLINE pic_value pic_size_value(size_t);
-static inline pic_value pic_char_value(char c);
+PIC_INLINE pic_value pic_char_value(char c);
-static inline pic_value pic_none_value();
+PIC_INLINE pic_value pic_none_value();
 
-static inline bool pic_eq_p(pic_value, pic_value);
+PIC_INLINE bool pic_eq_p(pic_value, pic_value);
-static inline bool pic_eqv_p(pic_value, pic_value);
+PIC_INLINE bool pic_eqv_p(pic_value, pic_value);
 
-static inline enum pic_tt
+PIC_INLINE enum pic_tt
 pic_type(pic_value v)
 {
   switch (pic_vtype(v)) {
@@ -205,7 +205,7 @@ pic_type(pic_value v)
   PIC_UNREACHABLE();
 }
 
-static inline const char *
+PIC_INLINE const char *
 pic_type_repr(enum pic_tt tt)
 {
   switch (tt) {
@@ -257,13 +257,13 @@ pic_type_repr(enum pic_tt tt)
   PIC_UNREACHABLE();
 }
 
-static inline bool
+PIC_INLINE bool
 pic_valid_int(double v)
 {
   return INT_MIN <= v && v <= INT_MAX;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_nil_value()
 {
   pic_value v;
@@ -272,7 +272,7 @@ pic_nil_value()
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_true_value()
 {
   pic_value v;
@@ -281,7 +281,7 @@ pic_true_value()
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_false_value()
 {
   pic_value v;
@@ -290,7 +290,7 @@ pic_false_value()
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_bool_value(bool b)
 {
   pic_value v;
@@ -299,7 +299,7 @@ pic_bool_value(bool b)
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_size_value(size_t s)
 {
   if (sizeof(unsigned) < sizeof(size_t)) {
@@ -312,7 +312,7 @@ pic_size_value(size_t s)
 
 #if PIC_NAN_BOXING
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_obj_value(void *ptr)
 {
   pic_value v;
@@ -322,7 +322,7 @@ pic_obj_value(void *ptr)
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_float_value(double f)
 {
   union { double f; uint64_t i; } u;
@@ -335,7 +335,7 @@ pic_float_value(double f)
   }
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_int_value(int i)
 {
   union { int i; unsigned u; } u;
@@ -348,7 +348,7 @@ pic_int_value(int i)
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_char_value(char c)
 {
   pic_value v;
@@ -360,7 +360,7 @@ pic_char_value(char c)
 
 #else
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_obj_value(void *ptr)
 {
   pic_value v;
@@ -370,7 +370,7 @@ pic_obj_value(void *ptr)
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_float_value(double f)
 {
   pic_value v;
@@ -380,7 +380,7 @@ pic_float_value(double f)
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_int_value(int i)
 {
   pic_value v;
@@ -390,7 +390,7 @@ pic_int_value(int i)
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_char_value(char c)
 {
   pic_value v;
@@ -402,7 +402,7 @@ pic_char_value(char c)
 
 #endif
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_undef_value()
 {
   pic_value v;
@@ -411,7 +411,7 @@ pic_undef_value()
   return v;
 }
 
-static inline pic_value
+PIC_INLINE pic_value
 pic_none_value()
 {
 #if PIC_NONE_IS_FALSE
@@ -423,13 +423,13 @@ pic_none_value()
 
 #if PIC_NAN_BOXING
 
-static inline bool
+PIC_INLINE bool
 pic_eq_p(pic_value x, pic_value y)
 {
   return x == y;
 }
 
-static inline bool
+PIC_INLINE bool
 pic_eqv_p(pic_value x, pic_value y)
 {
   return x == y;
@@ -437,7 +437,7 @@ pic_eqv_p(pic_value x, pic_value y)
 
 #else
 
-static inline bool
+PIC_INLINE bool
 pic_eq_p(pic_value x, pic_value y)
 {
   if (pic_type(x) != pic_type(y))
@@ -453,7 +453,7 @@ pic_eq_p(pic_value x, pic_value y)
   }
 }
 
-static inline bool
+PIC_INLINE bool
 pic_eqv_p(pic_value x, pic_value y)
 {
   if (pic_type(x) != pic_type(y))

extlib/benz/include/picrin/xfile.h

@@ -20,47 +20,47 @@ typedef struct {
 } xFILE;
 
 /* generic file constructor */
-static inline xFILE *xfunopen(void *cookie, int (*read)(void *, char *, int), int (*write)(void *, const char *, int), long (*seek)(void *, long, int), int (*flush)(void *), int (*close)(void *));
+PIC_INLINE xFILE *xfunopen(void *cookie, int (*read)(void *, char *, int), int (*write)(void *, const char *, int), long (*seek)(void *, long, int), int (*flush)(void *), int (*close)(void *));
 
 /* resource aquisition */
-static inline xFILE *xfpopen(FILE *);
+PIC_INLINE xFILE *xfpopen(FILE *);
-static inline xFILE *xmopen();
+PIC_INLINE xFILE *xmopen();
-static inline xFILE *xfopen(const char *, const char *);
+PIC_INLINE xFILE *xfopen(const char *, const char *);
-static inline int xfclose(xFILE *);
+PIC_INLINE int xfclose(xFILE *);
 
 /* buffer management */
-static inline int xfflush(xFILE *);
+PIC_INLINE int xfflush(xFILE *);
 
 /* direct IO with buffering */
-static inline size_t xfread(void *, size_t, size_t, xFILE *);
+PIC_INLINE size_t xfread(void *, size_t, size_t, xFILE *);
-static inline size_t xfwrite(const void *, size_t, size_t, xFILE *);
+PIC_INLINE size_t xfwrite(const void *, size_t, size_t, xFILE *);
 
 /* indicator positioning */
-static inline long xfseek(xFILE *, long offset, int whence);
+PIC_INLINE long xfseek(xFILE *, long offset, int whence);
-static inline long xftell(xFILE *);
+PIC_INLINE long xftell(xFILE *);
-static inline void xrewind(xFILE *);
+PIC_INLINE void xrewind(xFILE *);
 
 /* stream status */
-static inline void xclearerr(xFILE *);
+PIC_INLINE void xclearerr(xFILE *);
-static inline int xfeof(xFILE *);
+PIC_INLINE int xfeof(xFILE *);
-static inline int xferror(xFILE *);
+PIC_INLINE int xferror(xFILE *);
 
 /* character IO */
-static inline int xfgetc(xFILE *);
+PIC_INLINE int xfgetc(xFILE *);
-static inline char *xfgets(char *, int, xFILE *);
+PIC_INLINE char *xfgets(char *, int, xFILE *);
-static inline int xfputc(int, xFILE *);
+PIC_INLINE int xfputc(int, xFILE *);
-static inline int xfputs(const char *, xFILE *);
+PIC_INLINE int xfputs(const char *, xFILE *);
-static inline int xgetc(xFILE *);
+PIC_INLINE int xgetc(xFILE *);
-static inline int xgetchar(void);
+PIC_INLINE int xgetchar(void);
-static inline int xputc(int, xFILE *);
+PIC_INLINE int xputc(int, xFILE *);
-static inline int xputchar(int);
+PIC_INLINE int xputchar(int);
-static inline int xputs(const char *);
+PIC_INLINE int xputs(const char *);
-static inline int xungetc(int, xFILE *);
+PIC_INLINE int xungetc(int, xFILE *);
 
 /* formatted I/O */
-static inline int xprintf(const char *, ...);
+PIC_INLINE int xprintf(const char *, ...);
-static inline int xfprintf(xFILE *, const char *, ...);
+PIC_INLINE int xfprintf(xFILE *, const char *, ...);
-static inline int xvfprintf(xFILE *, const char *, va_list);
+PIC_INLINE int xvfprintf(xFILE *, const char *, va_list);
 
 /* standard I/O */
 #define xstdin (xstdin_())
@@ -73,7 +73,7 @@ static inline int xvfprintf(xFILE *, const char *, va_list);
 #define XF_EOF 1
 #define XF_ERR 2
 
-static inline xFILE *
+PIC_INLINE xFILE *
 xfunopen(void *cookie, int (*read)(void *, char *, int), int (*write)(void *, const char *, int), long (*seek)(void *, long, int), int (*flush)(void *), int (*close)(void *))
 {
   xFILE *file;
@@ -99,7 +99,7 @@ xfunopen(void *cookie, int (*read)(void *, char *, int), int (*write)(void *, co
  * Derieved xFILE Classes
  */
 
-static inline int
+PIC_INLINE int
 xf_file_read(void *cookie, char *ptr, int size)
 {
   FILE *file = cookie;
@@ -115,7 +115,7 @@ xf_file_read(void *cookie, char *ptr, int size)
   return r;
 }
 
-static inline int
+PIC_INLINE int
 xf_file_write(void *cookie, const char *ptr, int size)
 {
   FILE *file = cookie;
@@ -128,25 +128,25 @@ xf_file_write(void *cookie, const char *ptr, int size)
   return r;
 }
 
-static inline long
+PIC_INLINE long
 xf_file_seek(void *cookie, long pos, int whence)
 {
   return fseek(cookie, pos, whence);
 }
 
-static inline int
+PIC_INLINE int
 xf_file_flush(void *cookie)
 {
   return fflush(cookie);
 }
 
-static inline int
+PIC_INLINE int
 xf_file_close(void *cookie)
 {
   return fclose(cookie);
 }
 
-static inline xFILE *
+PIC_INLINE xFILE *
 xfpopen(FILE *fp)
 {
   xFILE *file;
@@ -161,7 +161,7 @@ xfpopen(FILE *fp)
 
 #define XF_FILE_VTABLE xf_file_read, xf_file_write, xf_file_seek, xf_file_flush, xf_file_close
 
-static inline xFILE *
+PIC_INLINE xFILE *
 xstdin_()
 {
   static xFILE x = { -1, 0, { NULL, XF_FILE_VTABLE } };
@@ -172,7 +172,7 @@ xstdin_()
   return &x;
 }
 
-static inline xFILE *
+PIC_INLINE xFILE *
 xstdout_()
 {
   static xFILE x = { -1, 0, { NULL, XF_FILE_VTABLE } };
@@ -183,7 +183,7 @@ xstdout_()
   return &x;
 }
 
-static inline xFILE *
+PIC_INLINE xFILE *
 xstderr_()
 {
   static xFILE x = { -1, 0, { NULL, XF_FILE_VTABLE } };
@@ -199,7 +199,7 @@ struct xf_membuf {
   long pos, end, capa;
 };
 
-static inline int
+PIC_INLINE int
 xf_mem_read(void *cookie, char *ptr, int size)
 {
   struct xf_membuf *mem;
@@ -213,7 +213,7 @@ xf_mem_read(void *cookie, char *ptr, int size)
   return size;
 }
 
-static inline int
+PIC_INLINE int
 xf_mem_write(void *cookie, const char *ptr, int size)
 {
   struct xf_membuf *mem;
@@ -231,7 +231,7 @@ xf_mem_write(void *cookie, const char *ptr, int size)
   return size;
 }
 
-static inline long
+PIC_INLINE long
 xf_mem_seek(void *cookie, long pos, int whence)
 {
   struct xf_membuf *mem;
@@ -253,7 +253,7 @@ xf_mem_seek(void *cookie, long pos, int whence)
   return mem->pos;
 }
 
-static inline int
+PIC_INLINE int
 xf_mem_flush(void *cookie)
 {
   (void)cookie;
@@ -261,7 +261,7 @@ xf_mem_flush(void *cookie)
   return 0;
 }
 
-static inline int
+PIC_INLINE int
 xf_mem_close(void *cookie)
 {
   struct xf_membuf *mem;
@@ -272,7 +272,7 @@ xf_mem_close(void *cookie)
   return 0;
 }
 
-static inline xFILE *
+PIC_INLINE xFILE *
 xmopen()
 {
   struct xf_membuf *mem;
@@ -288,7 +288,7 @@ xmopen()
 
 #undef XF_FILE_VTABLE
 
-static inline xFILE *
+PIC_INLINE xFILE *
 xfopen(const char *filename, const char *mode)
 {
   FILE *fp;
@@ -307,7 +307,7 @@ xfopen(const char *filename, const char *mode)
   return file;
 }
 
-static inline int
+PIC_INLINE int
 xfclose(xFILE *file)
 {
   int r;
@@ -321,13 +321,13 @@ xfclose(xFILE *file)
   return 0;
 }
 
-static inline int
+PIC_INLINE int
 xfflush(xFILE *file)
 {
   return file->vtable.flush(file->vtable.cookie);
 }
 
-static inline size_t
+PIC_INLINE size_t
 xfread(void *ptr, size_t block, size_t nitems, xFILE *file)
 {
   char *dst = (char *)ptr;
@@ -362,7 +362,7 @@ xfread(void *ptr, size_t block, size_t nitems, xFILE *file)
   return i;
 }
 
-static inline size_t
+PIC_INLINE size_t
 xfwrite(const void *ptr, size_t block, size_t nitems, xFILE *file)
 {
   char *dst = (char *)ptr;
@@ -386,44 +386,44 @@ xfwrite(const void *ptr, size_t block, size_t nitems, xFILE *file)
   return i;
 }
 
-static inline long
+PIC_INLINE long
 xfseek(xFILE *file, long offset, int whence)
 {
   file->ungot = -1;
   return file->vtable.seek(file->vtable.cookie, offset, whence);
 }
 
-static inline long
+PIC_INLINE long
 xftell(xFILE *file)
 {
   return xfseek(file, 0, SEEK_CUR);
 }
 
-static inline void
+PIC_INLINE void
 xrewind(xFILE *file)
 {
   xfseek(file, 0, SEEK_SET);
 }
 
-static inline void
+PIC_INLINE void
 xclearerr(xFILE *file)
 {
   file->flags = 0;
 }
 
-static inline int
+PIC_INLINE int
 xfeof(xFILE *file)
 {
   return file->flags & XF_EOF;
 }
 
-static inline int
+PIC_INLINE int
 xferror(xFILE *file)
 {
   return file->flags & XF_ERR;
 }
 
-static inline int
+PIC_INLINE int
 xfgetc(xFILE *file)
 {
   char buf[1];
@@ -437,13 +437,13 @@ xfgetc(xFILE *file)
   return buf[0];
 }
 
-static inline int
+PIC_INLINE int
 xgetc(xFILE *file)
 {
   return xfgetc(file);
 }
 
-static inline char *
+PIC_INLINE char *
 xfgets(char *str, int size, xFILE *file)
 {
   int c = EOF, i;
@@ -465,7 +465,7 @@ xfgets(char *str, int size, xFILE *file)
   return str;
 }
 
-static inline int
+PIC_INLINE int
 xungetc(int c, xFILE *file)
 {
   file->ungot = c;
@@ -475,13 +475,13 @@ xungetc(int c, xFILE *file)
   return c;
 }
 
-static inline int
+PIC_INLINE int
 xgetchar(void)
 {
   return xfgetc(xstdin);
 }
 
-static inline int
+PIC_INLINE int
 xfputc(int c, xFILE *file)
 {
   char buf[1];
@@ -495,19 +495,19 @@ xfputc(int c, xFILE *file)
   return buf[0];
 }
 
-static inline int
+PIC_INLINE int
 xputc(int c, xFILE *file)
 {
   return xfputc(c, file);
 }
 
-static inline int
+PIC_INLINE int
 xputchar(int c)
 {
   return xfputc(c, xstdout);
 }
 
-static inline int
+PIC_INLINE int
 xfputs(const char *str, xFILE *file)
 {
   size_t len;
@@ -521,13 +521,13 @@ xfputs(const char *str, xFILE *file)
   return 0;
 }
 
-static inline int
+PIC_INLINE int
 xputs(const char *s)
 {
   return xfputs(s, xstdout);
 }
 
-static inline int
+PIC_INLINE int
 xprintf(const char *fmt, ...)
 {
   va_list ap;
@@ -539,7 +539,7 @@ xprintf(const char *fmt, ...)
   return n;
 }
 
-static inline int
+PIC_INLINE int
 xfprintf(xFILE *stream, const char *fmt, ...)
 {
   va_list ap;
@@ -551,7 +551,7 @@ xfprintf(xFILE *stream, const char *fmt, ...)
   return n;
 }
 
-static inline int
+PIC_INLINE int
 xvfprintf(xFILE *stream, const char *fmt, va_list ap)
 {
   va_list ap2;

extlib/benz/include/picrin/xhash.h

@@ -50,32 +50,32 @@ typedef struct xhash {
  */
 
 /* string map */
-static inline void xh_init_str(xhash *x, size_t width);
+PIC_INLINE void xh_init_str(xhash *x, size_t width);
-static inline xh_entry *xh_get_str(xhash *x, const char *key);
+PIC_INLINE xh_entry *xh_get_str(xhash *x, const char *key);
-static inline xh_entry *xh_put_str(xhash *x, const char *key, void *);
+PIC_INLINE xh_entry *xh_put_str(xhash *x, const char *key, void *);
-static inline void xh_del_str(xhash *x, const char *key);
+PIC_INLINE void xh_del_str(xhash *x, const char *key);
 
 /* object map */
-static inline void xh_init_ptr(xhash *x, size_t width);
+PIC_INLINE void xh_init_ptr(xhash *x, size_t width);
-static inline xh_entry *xh_get_ptr(xhash *x, const void *key);
+PIC_INLINE xh_entry *xh_get_ptr(xhash *x, const void *key);
-static inline xh_entry *xh_put_ptr(xhash *x, const void *key, void *);
+PIC_INLINE xh_entry *xh_put_ptr(xhash *x, const void *key, void *);
-static inline void xh_del_ptr(xhash *x, const void *key);
+PIC_INLINE void xh_del_ptr(xhash *x, const void *key);
 
 /* int map */
-static inline void xh_init_int(xhash *x, size_t width);
+PIC_INLINE void xh_init_int(xhash *x, size_t width);
-static inline xh_entry *xh_get_int(xhash *x, int key);
+PIC_INLINE xh_entry *xh_get_int(xhash *x, int key);
-static inline xh_entry *xh_put_int(xhash *x, int key, void *);
+PIC_INLINE xh_entry *xh_put_int(xhash *x, int key, void *);
-static inline void xh_del_int(xhash *x, int key);
+PIC_INLINE void xh_del_int(xhash *x, int key);
 
-static inline size_t xh_size(xhash *x);
+PIC_INLINE size_t xh_size(xhash *x);
-static inline void xh_clear(xhash *x);
+PIC_INLINE void xh_clear(xhash *x);
-static inline void xh_destroy(xhash *x);
+PIC_INLINE void xh_destroy(xhash *x);
 
-static inline xh_entry *xh_begin(xhash *x);
+PIC_INLINE xh_entry *xh_begin(xhash *x);
-static inline xh_entry *xh_next(xh_entry *e);
+PIC_INLINE xh_entry *xh_next(xh_entry *e);
 
 
-static inline void
+PIC_INLINE void
 xh_bucket_realloc(xhash *x, size_t newsize)
 {
   x->size = newsize;
@@ -83,7 +83,7 @@ xh_bucket_realloc(xhash *x, size_t newsize)
   memset(x->buckets, 0, (x->size + 1) * sizeof(xh_entry *));
 }
 
-static inline void
+PIC_INLINE void
 xh_init_(xhash *x, size_t kwidth, size_t vwidth, xh_hashf hashf, xh_equalf equalf, void *data)
 {
   x->size = 0;
@@ -102,7 +102,7 @@ xh_init_(xhash *x, size_t kwidth, size_t vwidth, xh_hashf hashf, xh_equalf equal
   xh_bucket_realloc(x, XHASH_INIT_SIZE);
 }
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_get_(xhash *x, const void *key)
 {
   int hash;
@@ -118,7 +118,7 @@ xh_get_(xhash *x, const void *key)
   return e;
 }
 
-static inline void
+PIC_INLINE void
 xh_resize_(xhash *x, size_t newsize)
 {
   xhash y;
@@ -145,7 +145,7 @@ xh_resize_(xhash *x, size_t newsize)
   memcpy(x, &y, sizeof(xhash));
 }
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_put_(xhash *x, const void *key, void *val)
 {
   int hash;
@@ -186,7 +186,7 @@ xh_put_(xhash *x, const void *key, void *val)
   return x->buckets[idx] = e;
 }
 
-static inline void
+PIC_INLINE void
 xh_del_(xhash *x, const void *key)
 {
   int hash;
@@ -235,13 +235,13 @@ xh_del_(xhash *x, const void *key)
   x->count--;
 }
 
-static inline size_t
+PIC_INLINE size_t
 xh_size(xhash *x)
 {
   return x->count;
 }
 
-static inline void
+PIC_INLINE void
 xh_clear(xhash *x)
 {
   size_t i;
@@ -261,7 +261,7 @@ xh_clear(xhash *x)
   x->count = 0;
 }
 
-static inline void
+PIC_INLINE void
 xh_destroy(xhash *x)
 {
   xh_clear(x);
@@ -270,7 +270,7 @@ xh_destroy(xhash *x)
 
 /* string map */
 
-static inline int
+PIC_INLINE int
 xh_str_hash(const void *key, void *data)
 {
   const char *str = *(const char **)key;
@@ -284,7 +284,7 @@ xh_str_hash(const void *key, void *data)
   return hash;
 }
 
-static inline int
+PIC_INLINE int
 xh_str_equal(const void *key1, const void *key2, void *data)
 {
   (void)data;
@@ -292,25 +292,25 @@ xh_str_equal(const void *key1, const void *key2, void *data)
   return strcmp(*(const char **)key1, *(const char **)key2) == 0;
 }
 
-static inline void
+PIC_INLINE void
 xh_init_str(xhash *x, size_t width)
 {
   xh_init_(x, sizeof(const char *), width, xh_str_hash, xh_str_equal, NULL);
 }
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_get_str(xhash *x, const char *key)
 {
   return xh_get_(x, &key);
 }
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_put_str(xhash *x, const char *key, void *val)
 {
   return xh_put_(x, &key, val);
 }
 
-static inline void
+PIC_INLINE void
 xh_del_str(xhash *x, const char *key)
 {
   xh_del_(x, &key);
@@ -318,7 +318,7 @@ xh_del_str(xhash *x, const char *key)
 
 /* object map */
 
-static inline int
+PIC_INLINE int
 xh_ptr_hash(const void *key, void *data)
 {
   (void)data;
@@ -326,7 +326,7 @@ xh_ptr_hash(const void *key, void *data)
   return (int)(size_t)*(const void **)key;
 }
 
-static inline int
+PIC_INLINE int
 xh_ptr_equal(const void *key1, const void *key2, void *data)
 {
   (void) data;
@@ -334,25 +334,25 @@ xh_ptr_equal(const void *key1, const void *key2, void *data)
   return *(const void **)key1 == *(const void **)key2;
 }
 
-static inline void
+PIC_INLINE void
 xh_init_ptr(xhash *x, size_t width)
 {
   xh_init_(x, sizeof(const void *), width, xh_ptr_hash, xh_ptr_equal, NULL);
 }
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_get_ptr(xhash *x, const void *key)
 {
   return xh_get_(x, &key);
 }
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_put_ptr(xhash *x, const void *key, void *val)
 {
   return xh_put_(x, &key, val);
 }
 
-static inline void
+PIC_INLINE void
 xh_del_ptr(xhash *x, const void *key)
 {
   xh_del_(x, &key);
@@ -360,7 +360,7 @@ xh_del_ptr(xhash *x, const void *key)
 
 /* int map */
 
-static inline int
+PIC_INLINE int
 xh_int_hash(const void *key, void *data)
 {
   (void)data;
@@ -368,7 +368,7 @@ xh_int_hash(const void *key, void *data)
   return *(int *)key;
 }
 
-static inline int
+PIC_INLINE int
 xh_int_equal(const void *key1, const void *key2, void *data)
 {
   (void)data;
@@ -376,25 +376,25 @@ xh_int_equal(const void *key1, const void *key2, void *data)
   return *(int *)key1 == *(int *)key2;
 }
 
-static inline void
+PIC_INLINE void
 xh_init_int(xhash *x, size_t width)
 {
   xh_init_(x, sizeof(int), width, xh_int_hash, xh_int_equal, NULL);
 }
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_get_int(xhash *x, int key)
 {
   return xh_get_(x, &key);
 }
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_put_int(xhash *x, int key, void *val)
 {
   return xh_put_(x, &key, val);
 }
 
-static inline void
+PIC_INLINE void
 xh_del_int(xhash *x, int key)
 {
   xh_del_(x, &key);
@@ -402,13 +402,13 @@ xh_del_int(xhash *x, int key)
 
 /** iteration */
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_begin(xhash *x)
 {
   return x->head;
 }
 
-static inline xh_entry *
+PIC_INLINE xh_entry *
 xh_next(xh_entry *e)
 {
   return e->bw;

extlib/benz/include/picrin/xrope.h

@@ -20,19 +20,19 @@ typedef struct xrope xrope;
 
 #define xr_new(cstr) xr_new_cstr(cstr, strlen(cstr))
 #define xr_new_lit(cstr) xr_new_cstr(cstr, sizeof(cstr) - 1)
-static inline xrope *xr_new_cstr(const char *, size_t);
+PIC_INLINE xrope *xr_new_cstr(const char *, size_t);
-static inline xrope *xr_new_imbed(const char *, size_t);
+PIC_INLINE xrope *xr_new_imbed(const char *, size_t);
-static inline xrope *xr_new_move(const char *, size_t);
+PIC_INLINE xrope *xr_new_move(const char *, size_t);
-static inline xrope *xr_new_copy(const char *, size_t);
+PIC_INLINE xrope *xr_new_copy(const char *, size_t);
 
-static inline void XROPE_INCREF(xrope *);
+PIC_INLINE void XROPE_INCREF(xrope *);
-static inline void XROPE_DECREF(xrope *);
+PIC_INLINE void XROPE_DECREF(xrope *);
 
-static inline size_t xr_len(xrope *);
+PIC_INLINE size_t xr_len(xrope *);
-static inline char xr_at(xrope *, size_t);
+PIC_INLINE char xr_at(xrope *, size_t);
-static inline xrope *xr_cat(xrope *, xrope *);
+PIC_INLINE xrope *xr_cat(xrope *, xrope *);
-static inline xrope *xr_sub(xrope *, size_t, size_t);
+PIC_INLINE xrope *xr_sub(xrope *, size_t, size_t);
-static inline const char *xr_cstr(xrope *); /* returns NULL-terminated string */
+PIC_INLINE const char *xr_cstr(xrope *); /* returns NULL-terminated string */
 
 
 /* impl */
@@ -65,12 +65,12 @@ struct xrope {
   struct xrope *left, *right;
 };
 
-static inline void
+PIC_INLINE void
 XROPE_INCREF(xrope *x) {
   x->refcnt++;
 }
 
-static inline void
+PIC_INLINE void
 XROPE_DECREF(xrope *x) {
   if (! --x->refcnt) {
     if (x->chunk) {
@@ -84,7 +84,7 @@ XROPE_DECREF(xrope *x) {
   }
 }
 
-static inline xrope *
+PIC_INLINE xrope *
 xr_new_cstr(const char *cstr, size_t len)
 {
   xr_chunk *c;
@@ -108,7 +108,7 @@ xr_new_cstr(const char *cstr, size_t len)
   return x;
 }
 
-static inline xrope *
+PIC_INLINE xrope *
 xr_new_imbed(const char *str, size_t len)
 {
   xr_chunk *c;
@@ -132,7 +132,7 @@ xr_new_imbed(const char *str, size_t len)
   return x;
 }
 
-static inline xrope *
+PIC_INLINE xrope *
 xr_new_move(const char *cstr, size_t len)
 {
   xr_chunk *c;
@@ -156,7 +156,7 @@ xr_new_move(const char *cstr, size_t len)
   return x;
 }
 
-static inline xrope *
+PIC_INLINE xrope *
 xr_new_copy(const char *str, size_t len)
 {
   char *buf;
@@ -185,13 +185,13 @@ xr_new_copy(const char *str, size_t len)
   return x;
 }
 
-static inline size_t
+PIC_INLINE size_t
 xr_len(xrope *x)
 {
   return x->weight;
 }
 
-static inline char
+PIC_INLINE char
 xr_at(xrope *x, size_t i)
 {
   if (x->weight <= i) {
@@ -205,7 +205,7 @@ xr_at(xrope *x, size_t i)
     : xr_at(x->right, i - x->left->weight);
 }
 
-static inline xrope *
+PIC_INLINE xrope *
 xr_cat(xrope *x, xrope *y)
 {
   xrope *z;
@@ -224,7 +224,7 @@ xr_cat(xrope *x, xrope *y)
   return z;
 }
 
-static inline struct xrope *
+PIC_INLINE struct xrope *
 xr_sub(xrope *x, size_t i, size_t j)
 {
   assert(i <= j);
@@ -271,7 +271,7 @@ xr_sub(xrope *x, size_t i, size_t j)
   }
 }
 
-static inline void
+PIC_INLINE void
 xr_fold(xrope *x, xr_chunk *c, size_t offset)
 {
   if (x->chunk) {
@@ -294,7 +294,7 @@ xr_fold(xrope *x, xr_chunk *c, size_t offset)
   XR_CHUNK_INCREF(c);
 }
 
-static inline const char *
+PIC_INLINE const char *
 xr_cstr(xrope *x)
 {
   xr_chunk *c;

extlib/benz/include/picrin/xvect.h

@@ -1,202 +1,76 @@
 #ifndef XVECT_H__
 #define XVECT_H__
 
-/*
+/* The MIT License
- * Copyright (c) 2014 by Yuichi Nishiwaki <yuichi@idylls.jp>
- */
 
-#if defined(__cplusplus)
+   Copyright (c) 2008, by Attractive Chaos <attractor@live.co.uk>
-extern "C" {
+   Copyright (c) 2014, by Yuichi Nishiwaki <yuichi@idylls.jp>
-#endif
 
-typedef struct xvect {
+   Permission is hereby granted, free of charge, to any person obtaining
-  char *data;
+   a copy of this software and associated documentation files (the
-  size_t size, mask, head, tail, width;
+   "Software"), to deal in the Software without restriction, including
-} xvect;
+   without limitation the rights to use, copy, modify, merge, publish,
+   distribute, sublicense, and/or sell copies of the Software, and to
+   permit persons to whom the Software is furnished to do so, subject to
+   the following conditions:
 
-static inline void xv_init(xvect *, size_t);
+   The above copyright notice and this permission notice shall be
-static inline void xv_destroy(xvect *);
+   included in all copies or substantial portions of the Software.
 
-static inline size_t xv_size(xvect *);
+   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+   NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+   BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+   ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+   CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+   SOFTWARE.
+*/
 
-static inline void xv_reserve(xvect *, size_t);
+#define xv_realloc(P,Z) pic_realloc(pic,P,Z)
-static inline void xv_shrink(xvect *, size_t);
+#define xv_free(P) pic_free(pic,P)
 
-static inline void *xv_get(xvect *, size_t);
+#define xv_roundup32(x)                                                 \
-static inline void xv_set(xvect *, size_t, void *);
+  (--(x), (x)|=(x)>>1, (x)|=(x)>>2, (x)|=(x)>>4, (x)|=(x)>>8, (x)|=(x)>>16, ++(x))
 
-static inline void xv_push(xvect *, void *);
+#define xvect_t(type) struct { size_t n, m; type *a; }
-static inline void *xv_pop(xvect *);
+#define xv_init(v) ((v).n = (v).m = 0, (v).a = 0)
+#define xv_destroy(v) xv_free((v).a)
+#define xv_A(v, i) ((v).a[(i)])
+#define xv_pop(v) ((v).a[--(v).n])
+#define xv_size(v) ((v).n)
+#define xv_max(v) ((v).m)
 
-static inline void *xv_shift(xvect *);
+#define xv_resize(type, v, s)                                           \
-static inline void xv_unshift(xvect *, void *);
+  ((v).m = (s), (v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m))
 
-static inline void xv_splice(xvect *, size_t, size_t);
+#define xv_copy(type, v1, v0)                           \
-static inline void xv_insert(xvect *, size_t, void *);
+  do {                                                  \
+    if ((v1).m < (v0).n) xv_resize(type, v1, (v0).n);	\
+    (v1).n = (v0).n;                                    \
+    memcpy((v1).a, (v0).a, sizeof(type) * (v0).n);      \
+  } while (0)                                           \
 
-static inline void
+#define xv_push(type, v, x)                                     \
-xv_init(xvect *x, size_t width)
+  do {                                                          \
-{
+    if ((v).n == (v).m) {                                       \
-  x->data = NULL;
+      (v).m = (v).m? (v).m<<1 : 2;                              \
-  x->width = width;
+      (v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m);	\
-  x->size = 0;
+    }                                                           \
-  x->mask = (size_t)-1;
+    (v).a[(v).n++] = (x);                                       \
-  x->head = 0;
+  } while (0)
-  x->tail = 0;
-}
 
-static inline void
+#define xv_pushp(type, v)                                       \
-xv_destroy(xvect *x)
+  (((v).n == (v).m)?                                            \
-{
+   ((v).m = ((v).m? (v).m<<1 : 2),                              \
-  free(x->data);
+    (v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m), 0)     \
-}
+   : 0), ((v).a + ((v).n++))
 
-static inline size_t
+#define xv_a(type, v, i)                                        \
-xv_size(xvect *x)
+  (((v).m <= (size_t)(i)?                                       \
-{
+    ((v).m = (v).n = (i) + 1, xv_roundup32((v).m),              \
-  return x->tail < x->head
+     (v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m), 0)    \
-    ? x->tail + x->size - x->head
+    : (v).n <= (size_t)(i)? (v).n = (i) + 1                     \
-    : x->tail - x->head;
+    : 0), (v).a[(i)])
-}
-
-static inline size_t
-xv_round2(size_t x)
-{
-  x -= 1;
-  x |= (x >> 1);
-  x |= (x >> 2);
-  x |= (x >> 4);
-  x |= (x >> 8);
-  x |= (x >> 16);
-  x |= (x >> 32);
-  x++;
-  return x;
-}
-
-static inline void
-xv_rotate(xvect *x)
-{
-  if (x->tail < x->head) {
-    char buf[x->size * x->width];
-
-    /* perform rotation */
-    memcpy(buf, x->data, sizeof buf);
-    memcpy(x->data, buf + x->head * x->width, (x->size - x->head) * x->width);
-    memcpy(x->data + (x->size - x->head) * x->width, buf, x->tail * x->width);
-    x->tail = x->size - x->head + x->tail;
-    x->head = 0;
-  }
-}
-
-static inline void
-xv_adjust(xvect *x, size_t size)
-{
-  size = xv_round2(size);
-  if (size != x->size) {
-    xv_rotate(x);
-    x->data = realloc(x->data, size * x->width);
-    x->size = size;
-    x->mask = size - 1;
-  }
-}
-
-static inline void
-xv_reserve(xvect *x, size_t mincapa)
-{
-  if (x->size < mincapa + 1) {
-    xv_adjust(x, mincapa + 1);  /* capa == size - 1 */
-  }
-}
-
-static inline void
-xv_shrink(xvect *x, size_t maxcapa)
-{
-  if (x->size > maxcapa + 1) {
-    xv_adjust(x, maxcapa + 1);  /* capa == size - 1 */
-  }
-}
-
-static inline void *
-xv_get(xvect *x, size_t i)
-{
-  assert(i < xv_size(x));
-
-  return x->data + ((x->head + i) & x->mask) * x->width;
-}
-
-static inline void
-xv_set(xvect *x, size_t i, void *src)
-{
-  memcpy(xv_get(x, i), src, x->width);
-}
-
-static inline void
-xv_push(xvect *x, void *src)
-{
-  xv_reserve(x, xv_size(x) + 1);
-  x->tail = (x->tail + 1) & x->mask;
-  xv_set(x, xv_size(x) - 1, src);
-}
-
-static inline void *
-xv_pop(xvect *x)
-{
-  void *dat;
-
-  assert(xv_size(x) >= 1);
-
-  dat = xv_get(x, xv_size(x) - 1);
-  x->tail = (x->tail - 1) & x->mask;
-  return dat;
-}
-
-static inline void *
-xv_shift(xvect *x)
-{
-  void *dat;
-
-  assert(xv_size(x) >= 1);
-
-  dat = xv_get(x, 0);
-  x->head = (x->head + 1) & x->mask;
-  return dat;
-}
-
-static inline void
-xv_unshift(xvect *x, void *src)
-{
-  xv_reserve(x, xv_size(x) + 1);
-  x->head = (x->head - 1) & x->mask;
-  xv_set(x, 0, src);
-}
-
-static inline void
-xv_splice(xvect *x, size_t i, size_t j)
-{
-  assert(i <= j && j < xv_size(x));
-
-  xv_rotate(x);
-  memmove(xv_get(x, i), xv_get(x, j), (xv_size(x) - j) * x->width);
-  x->tail = (x->tail - j + i) & x->mask;
-}
-
-static inline void
-xv_insert(xvect *x, size_t i, void *src)
-{
-  assert(i <= xv_size(x));
-
-  xv_reserve(x, xv_size(x) + 1);
-  xv_rotate(x);
-  x->tail = (x->tail + 1) & x->mask;
-
-  if (xv_size(x) - 1 != i) {
-    memmove(xv_get(x, i + 1), xv_get(x, i), (xv_size(x) - 1 - i) * x->width);
-  }
-  xv_set(x, i, src);
-}
-
-#if defined(__cplusplus)
-}
-#endif
 
 #endif

extlib/benz/init.c

@@ -1,140 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#include "picrin.h"
-#include "picrin/pair.h"
-#include "picrin/lib.h"
-#include "picrin/macro.h"
-#include "picrin/error.h"
-
-void
-pic_add_feature(pic_state *pic, const char *feature)
-{
-  pic_push(pic, pic_obj_value(pic_intern_cstr(pic, feature)), pic->features);
-}
-
-void pic_init_bool(pic_state *);
-void pic_init_pair(pic_state *);
-void pic_init_port(pic_state *);
-void pic_init_number(pic_state *);
-void pic_init_proc(pic_state *);
-void pic_init_symbol(pic_state *);
-void pic_init_vector(pic_state *);
-void pic_init_blob(pic_state *);
-void pic_init_cont(pic_state *);
-void pic_init_char(pic_state *);
-void pic_init_error(pic_state *);
-void pic_init_str(pic_state *);
-void pic_init_macro(pic_state *);
-void pic_init_var(pic_state *);
-void pic_init_write(pic_state *);
-void pic_init_read(pic_state *);
-void pic_init_dict(pic_state *);
-void pic_init_record(pic_state *);
-void pic_init_eval(pic_state *);
-void pic_init_lib(pic_state *);
-void pic_init_attr(pic_state *);
-
-extern const char pic_boot[];
-
-static void
-pic_init_features(pic_state *pic)
-{
-  pic_add_feature(pic, "picrin");
-  pic_add_feature(pic, "ieee-float");
-
-#if _POSIX_SOURCE
-  pic_add_feature(pic, "posix");
-#endif
-
-#if _WIN32
-  pic_add_feature(pic, "windows");
-#endif
-
-#if __unix__
-  pic_add_feature(pic, "unix");
-#endif
-#if __gnu_linux__
-  pic_add_feature(pic, "gnu-linux");
-#endif
-#if __FreeBSD__
-  pic_add_feature(pic, "freebsd");
-#endif
-
-#if __i386__
-  pic_add_feature(pic, "i386");
-#elif __x86_64__
-  pic_add_feature(pic, "x86-64");
-#elif __ppc__
-  pic_add_feature(pic, "ppc");
-#elif __sparc__
-  pic_add_feature(pic, "sparc");
-#endif
-
-#if __ILP32__
-  pic_add_feature(pic, "ilp32");
-#elif __LP64__
-  pic_add_feature(pic, "lp64");
-#endif
-
-#if defined(__BYTE_ORDER__)
-# if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
-  pic_add_feature(pic, "little-endian");
-# elif __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
-  pic_add_feature(pic, "big-endian");
-# endif
-#else
-# if __LITTLE_ENDIAN__
-  pic_add_feature(pic, "little-endian");
-# elif __BIG_ENDIAN__
-  pic_add_feature(pic, "big-endian");
-# endif
-#endif
-}
-
-#define DONE pic_gc_arena_restore(pic, ai);
-
-void
-pic_init_core(pic_state *pic)
-{
-  size_t ai = pic_gc_arena_preserve(pic);
-
-  pic_init_features(pic);
-
-  pic_deflibrary (pic, "(picrin base)") {
-    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sDEFINE, pic->rDEFINE);
-    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sSETBANG, pic->rSETBANG);
-    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sQUOTE, pic->rQUOTE);
-    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sLAMBDA, pic->rLAMBDA);
-    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sIF, pic->rIF);
-    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sBEGIN, pic->rBEGIN);
-    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sDEFINE_SYNTAX, pic->rDEFINE_SYNTAX);
-
-    pic_init_bool(pic); DONE;
-    pic_init_pair(pic); DONE;
-    pic_init_port(pic); DONE;
-    pic_init_number(pic); DONE;
-    pic_init_proc(pic); DONE;
-    pic_init_symbol(pic); DONE;
-    pic_init_vector(pic); DONE;
-    pic_init_blob(pic); DONE;
-    pic_init_cont(pic); DONE;
-    pic_init_char(pic); DONE;
-    pic_init_error(pic); DONE;
-    pic_init_str(pic); DONE;
-    pic_init_macro(pic); DONE;
-    pic_init_var(pic); DONE;
-    pic_init_write(pic); DONE;
-    pic_init_read(pic); DONE;
-    pic_init_dict(pic); DONE;
-    pic_init_record(pic); DONE;
-    pic_init_eval(pic); DONE;
-    pic_init_lib(pic); DONE;
-    pic_init_attr(pic); DONE;
-
-    pic_load_cstr(pic, pic_boot);
-  }
-
-  pic_import_library(pic, pic->PICRIN_BASE);
-}

extlib/benz/lib.c

@@ -73,8 +73,9 @@ import_table(pic_state *pic, pic_value spec, struct pic_dict *imports)
 {
   struct pic_lib *lib;
   struct pic_dict *table;
-  pic_value val, tmp, prefix;
+  pic_value val, tmp, prefix, it;
   pic_sym *sym, *id, *tag;
+  xh_entry *iter;
 
   table = pic_make_dict(pic);
 
@@ -85,7 +86,7 @@ import_table(pic_state *pic, pic_value spec, struct pic_dict *imports)
     if (tag == pic->sONLY) {
       import_table(pic, pic_cadr(pic, spec), table);
 
-      pic_for_each (val, pic_cddr(pic, spec)) {
+      pic_for_each (val, pic_cddr(pic, spec), it) {
         pic_dict_set(pic, imports, pic_sym_ptr(val), pic_dict_ref(pic, table, pic_sym_ptr(val)));
       }
       return;
@@ -93,7 +94,7 @@ import_table(pic_state *pic, pic_value spec, struct pic_dict *imports)
     if (tag == pic->sRENAME) {
       import_table(pic, pic_cadr(pic, spec), imports);
 
-      pic_for_each (val, pic_cddr(pic, spec)) {
+      pic_for_each (val, pic_cddr(pic, spec), it) {
         tmp = pic_dict_ref(pic, imports, pic_sym_ptr(pic_car(pic, val)));
         pic_dict_del(pic, imports, pic_sym_ptr(pic_car(pic, val)));
         pic_dict_set(pic, imports, pic_sym_ptr(pic_cadr(pic, val)), tmp);
@@ -104,7 +105,7 @@ import_table(pic_state *pic, pic_value spec, struct pic_dict *imports)
       import_table(pic, pic_cadr(pic, spec), table);
 
       prefix = pic_list_ref(pic, spec, 2);
-      pic_dict_for_each (sym, table) {
+      pic_dict_for_each (sym, table, iter) {
         id = pic_intern(pic, pic_format(pic, "~s~s", prefix, pic_obj_value(sym)));
         pic_dict_set(pic, imports, id, pic_dict_ref(pic, table, sym));
       }
@@ -112,7 +113,7 @@ import_table(pic_state *pic, pic_value spec, struct pic_dict *imports)
     }
     if (tag == pic->sEXCEPT) {
       import_table(pic, pic_cadr(pic, spec), imports);
-      pic_for_each (val, pic_cddr(pic, spec)) {
+      pic_for_each (val, pic_cddr(pic, spec), it) {
         pic_dict_del(pic, imports, pic_sym_ptr(val));
       }
       return;
@@ -122,7 +123,7 @@ import_table(pic_state *pic, pic_value spec, struct pic_dict *imports)
   if (! lib) {
     pic_errorf(pic, "library not found: ~a", spec);
   }
-  pic_dict_for_each (sym, lib->exports) {
+  pic_dict_for_each (sym, lib->exports, iter) {
     pic_dict_set(pic, imports, sym, pic_dict_ref(pic, lib->exports, sym));
   }
 }
@@ -132,12 +133,13 @@ import(pic_state *pic, pic_value spec)
 {
   struct pic_dict *imports;
   pic_sym *sym;
+  xh_entry *it;
 
   imports = pic_make_dict(pic);
 
   import_table(pic, spec, imports);
 
-  pic_dict_for_each (sym, imports) {
+  pic_dict_for_each (sym, imports, it) {
     pic_put_rename(pic, pic->lib->env, sym, pic_sym_ptr(pic_dict_ref(pic, imports, sym)));
   }
 }
@@ -202,13 +204,13 @@ static bool
 condexpand(pic_state *pic, pic_value clause)
 {
   pic_sym *tag;
-  pic_value c, feature;
+  pic_value c, feature, it;
 
   if (pic_eq_p(clause, pic_obj_value(pic->sELSE))) {
     return true;
   }
   if (pic_sym_p(clause)) {
-    pic_for_each (feature, pic->features) {
+    pic_for_each (feature, pic->features, it) {
       if(pic_eq_p(feature, clause))
         return true;
     }
@@ -228,14 +230,14 @@ condexpand(pic_state *pic, pic_value clause)
     return ! condexpand(pic, pic_list_ref(pic, clause, 1));
   }
   if (tag == pic->sAND) {
-    pic_for_each (c, pic_cdr(pic, clause)) {
+    pic_for_each (c, pic_cdr(pic, clause), it) {
       if (! condexpand(pic, c))
         return false;
     }
     return true;
   }
   if (tag == pic->sOR) {
-    pic_for_each (c, pic_cdr(pic, clause)) {
+    pic_for_each (c, pic_cdr(pic, clause), it) {
       if (condexpand(pic, c))
         return true;
     }

extlib/benz/macro.c

@@ -124,9 +124,9 @@ macroexpand_defer(pic_state *pic, pic_value expr, struct pic_senv *senv)
 static void
 macroexpand_deferred(pic_state *pic, struct pic_senv *senv)
 {
-  pic_value defer, val, src, dst;
+  pic_value defer, val, src, dst, it;
 
-  pic_for_each (defer, pic_reverse(pic, senv->defer)) {
+  pic_for_each (defer, pic_reverse(pic, senv->defer), it) {
     src = pic_car(pic, defer);
     dst = pic_cdr(pic, defer);
 

extlib/benz/pair.c

@@ -204,10 +204,10 @@ pic_value
 pic_reverse(pic_state *pic, pic_value list)
 {
   size_t ai = pic_gc_arena_preserve(pic);
-  pic_value v, acc;
+  pic_value v, acc, it;
 
   acc = pic_nil_value();
-  pic_for_each(v, list) {
+  pic_for_each(v, list, it) {
     acc = pic_cons(pic, v, acc);
 
     pic_gc_arena_restore(pic, ai);
@@ -220,10 +220,10 @@ pic_value
 pic_append(pic_state *pic, pic_value xs, pic_value ys)
 {
   size_t ai = pic_gc_arena_preserve(pic);
-  pic_value x;
+  pic_value x, it;
 
   xs = pic_reverse(pic, xs);
-  pic_for_each (x, xs) {
+  pic_for_each (x, xs, it) {
     ys = pic_cons(pic, x, ys);
 
     pic_gc_arena_restore(pic, ai);

extlib/benz/read.c

@@ -16,7 +16,7 @@
 static pic_value read(pic_state *pic, struct pic_port *port, int c);
 static pic_value read_nullable(pic_state *pic, struct pic_port *port, int c);
 
-pic_noreturn static void
+PIC_NORETURN static void
 read_error(pic_state *pic, const char *msg)
 {
   pic_throw(pic, pic->sREAD, msg, pic_nil_value());
@@ -79,13 +79,19 @@ strcaseeq(const char *s1, const char *s2)
   return a == b;
 }
 
-static pic_value
+static int
-read_comment(pic_state *pic, struct pic_port *port, const char *str)
+case_fold(pic_state *pic, int c)
 {
-  int c;
+  if (pic->reader->typecase == PIC_CASE_FOLD) {
+    c = tolower(c);
+  }
+  return c;
+}
 
+static pic_value
+read_comment(pic_state *pic, struct pic_port *port, int c)
+{
   PIC_UNUSED(pic);
-  PIC_UNUSED(str);
 
   do {
     c = next(port);
@@ -95,13 +101,13 @@ read_comment(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_block_comment(pic_state *pic, struct pic_port *port, const char *str)
+read_block_comment(pic_state *pic, struct pic_port *port, int c)
 {
   int x, y;
   int i = 1;
 
   PIC_UNUSED(pic);
-  PIC_UNUSED(str);
+  PIC_UNUSED(c);
 
   y = next(port);
 
@@ -120,9 +126,9 @@ read_block_comment(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_datum_comment(pic_state *pic, struct pic_port *port, const char *str)
+read_datum_comment(pic_state *pic, struct pic_port *port, int c)
 {
-  PIC_UNUSED(str);
+  PIC_UNUSED(c);
 
   read(pic, port, next(port));
 
@@ -130,7 +136,7 @@ read_datum_comment(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_directive(pic_state *pic, struct pic_port *port, const char *str)
+read_directive(pic_state *pic, struct pic_port *port, int c)
 {
   switch (peek(port)) {
   case 'n':
@@ -147,15 +153,15 @@ read_directive(pic_state *pic, struct pic_port *port, const char *str)
     break;
   }
 
-  return read_comment(pic, port, str);
+  return read_comment(pic, port, c);
 }
 
 static pic_value
-read_eval(pic_state *pic, struct pic_port *port, const char *str)
+read_eval(pic_state *pic, struct pic_port *port, int c)
 {
   pic_value form;
 
-  PIC_UNUSED(str);
+  PIC_UNUSED(c);
 
   form = read(pic, port, next(port));
 
@@ -163,67 +169,55 @@ read_eval(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_quote(pic_state *pic, struct pic_port *port, const char *str)
+read_quote(pic_state *pic, struct pic_port *port, int c)
 {
-  PIC_UNUSED(str);
+  PIC_UNUSED(c);
 
   return pic_list2(pic, pic_obj_value(pic->sQUOTE), read(pic, port, next(port)));
 }
 
 static pic_value
-read_quasiquote(pic_state *pic, struct pic_port *port, const char *str)
+read_quasiquote(pic_state *pic, struct pic_port *port, int c)
 {
-  PIC_UNUSED(str);
+  PIC_UNUSED(c);
 
   return pic_list2(pic, pic_obj_value(pic->sQUASIQUOTE), read(pic, port, next(port)));
 }
 
 static pic_value
-read_unquote(pic_state *pic, struct pic_port *port, const char *str)
+read_unquote(pic_state *pic, struct pic_port *port, int c)
 {
-  PIC_UNUSED(str);
+  pic_sym *tag = pic->sUNQUOTE;
 
-  return pic_list2(pic, pic_obj_value(pic->sUNQUOTE), read(pic, port, next(port)));
+  PIC_UNUSED(c);
+
+  if (peek(port) == '@') {
+    tag = pic->sUNQUOTE_SPLICING;
+    next(port);
+  }
+  return pic_list2(pic, pic_obj_value(tag), read(pic, port, next(port)));
 }
 
 static pic_value
-read_unquote_splicing(pic_state *pic, struct pic_port *port, const char *str)
+read_symbol(pic_state *pic, struct pic_port *port, int c)
 {
-  PIC_UNUSED(str);
+  size_t len;
-
-  return pic_list2(pic, pic_obj_value(pic->sUNQUOTE_SPLICING), read(pic, port, next(port)));
-}
-
-static pic_value
-read_symbol(pic_state *pic, struct pic_port *port, const char *str)
-{
-  size_t len, i;
   char *buf;
   pic_sym *sym;
-  int c;
 
-  len = strlen(str);
+  len = 1;
-  buf = pic_calloc(pic, 1, len + 1);
+  buf = pic_alloc(pic, len + 1);
-
+  buf[0] = case_fold(pic, c);
-  for (i = 0; i < len; ++i) {
+  buf[1] = 0;
-    if (pic->reader->typecase == PIC_CASE_FOLD) {
-      buf[i] = (char)tolower(str[i]);
-    } else {
-      buf[i] = str[i];
-    }
-  }
 
   while (! isdelim(peek(port))) {
     c = next(port);
-    if (pic->reader->typecase == PIC_CASE_FOLD) {
-      c = tolower(c);
-    }
     len += 1;
     buf = pic_realloc(pic, buf, len + 1);
-    buf[len - 1] = (char)c;
+    buf[len - 1] = case_fold(pic, c);
+    buf[len] = 0;
   }
 
-  buf[len] = 0;
   sym = pic_intern_cstr(pic, buf);
   pic_free(pic, buf);
 
@@ -295,9 +289,9 @@ read_unsigned(pic_state *pic, struct pic_port *port, int c)
 }
 
 static pic_value
-read_number(pic_state *pic, struct pic_port *port, const char *str)
+read_number(pic_state *pic, struct pic_port *port, int c)
 {
-  return read_unsigned(pic, port, str[0]);
+  return read_unsigned(pic, port, c);
 }
 
 static pic_value
@@ -311,7 +305,7 @@ negate(pic_value n)
 }
 
 static pic_value
-read_minus(pic_state *pic, struct pic_port *port, const char *str)
+read_minus(pic_state *pic, struct pic_port *port, int c)
 {
   pic_value sym;
 
@@ -319,7 +313,7 @@ read_minus(pic_state *pic, struct pic_port *port, const char *str)
     return negate(read_unsigned(pic, port, next(port)));
   }
   else {
-    sym = read_symbol(pic, port, str);
+    sym = read_symbol(pic, port, c);
     if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "-inf.0")) {
       return pic_float_value(-INFINITY);
     }
@@ -331,7 +325,7 @@ read_minus(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_plus(pic_state *pic, struct pic_port *port, const char *str)
+read_plus(pic_state *pic, struct pic_port *port, int c)
 {
   pic_value sym;
 
@@ -339,7 +333,7 @@ read_plus(pic_state *pic, struct pic_port *port, const char *str)
     return read_unsigned(pic, port, next(port));
   }
   else {
-    sym = read_symbol(pic, port, str);
+    sym = read_symbol(pic, port, c);
     if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "+inf.0")) {
       return pic_float_value(INFINITY);
     }
@@ -351,32 +345,40 @@ read_plus(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_true(pic_state *pic, struct pic_port *port, const char *str)
+read_true(pic_state *pic, struct pic_port *port, int c)
 {
   PIC_UNUSED(pic);
-  PIC_UNUSED(port);
+
-  PIC_UNUSED(str);
+  if ((c = peek(port)) == 'r') {
+    if (! expect(port, "rue")) {
+      read_error(pic, "unexpected character while reading #true");
+    }
+  } else if (! isdelim(c)) {
+    read_error(pic, "non-delimiter character given after #t");
+  }
 
   return pic_true_value();
 }
 
 static pic_value
-read_false(pic_state *pic, struct pic_port *port, const char *str)
+read_false(pic_state *pic, struct pic_port *port, int c)
 {
   PIC_UNUSED(pic);
-  PIC_UNUSED(port);
+
-  PIC_UNUSED(str);
+  if ((c = peek(port)) == 'a') {
+    if (! expect(port, "alse")) {
+      read_error(pic, "unexpected character while reading #false");
+    }
+  } else if (! isdelim(c)) {
+    read_error(pic, "non-delimiter character given after #f");
+  }
 
   return pic_false_value();
 }
 
 static pic_value
-read_char(pic_state *pic, struct pic_port *port, const char *str)
+read_char(pic_state *pic, struct pic_port *port, int c)
 {
-  int c;
-
-  PIC_UNUSED(str);
-
   c = next(port);
 
   if (! isdelim(peek(port))) {
@@ -410,15 +412,12 @@ read_char(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_string(pic_state *pic, struct pic_port *port, const char *name)
+read_string(pic_state *pic, struct pic_port *port, int c)
 {
-  int c;
   char *buf;
   size_t size, cnt;
   pic_str *str;
 
-  PIC_UNUSED(name);
-
   size = 256;
   buf = pic_alloc(pic, size);
   cnt = 0;
@@ -448,7 +447,7 @@ read_string(pic_state *pic, struct pic_port *port, const char *name)
 }
 
 static pic_value
-read_pipe(pic_state *pic, struct pic_port *port, const char *str)
+read_pipe(pic_state *pic, struct pic_port *port, int c)
 {
   char *buf;
   size_t size, cnt;
@@ -456,9 +455,6 @@ read_pipe(pic_state *pic, struct pic_port *port, const char *str)
   /* Currently supports only ascii chars */
   char HEX_BUF[3];
   size_t i = 0;
-  int c;
-
-  PIC_UNUSED(str);
 
   size = 256;
   buf = pic_alloc(pic, size);
@@ -495,16 +491,14 @@ read_pipe(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_blob(pic_state *pic, struct pic_port *port, const char *str)
+read_blob(pic_state *pic, struct pic_port *port, int c)
 {
-  int nbits, n, c;
+  int nbits, n;
   size_t len, i;
   char buf[256];
   unsigned char *dat;
   pic_blob *blob;
 
-  PIC_UNUSED(str);
-
   nbits = 0;
 
   while (isdigit(c = next(port))) {
@@ -544,11 +538,10 @@ read_blob(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_pair(pic_state *pic, struct pic_port *port, const char *str)
+read_pair(pic_state *pic, struct pic_port *port, int c)
 {
-  const int tCLOSE = (str[0] == '(') ? ')' : ']';
+  static const int tCLOSE = ')';
   pic_value car, cdr;
-  int c;
 
  retry:
 
@@ -576,17 +569,17 @@ read_pair(pic_state *pic, struct pic_port *port, const char *str)
       goto retry;
     }
 
-    cdr = read_pair(pic, port, str);
+    cdr = read_pair(pic, port, '(');
     return pic_cons(pic, car, cdr);
   }
 }
 
 static pic_value
-read_vector(pic_state *pic, struct pic_port *port, const char *str)
+read_vector(pic_state *pic, struct pic_port *port, int c)
 {
   pic_value list;
 
-  list = read(pic, port, str[1]);
+  list = read(pic, port, c);
 
   return pic_obj_value(pic_make_vec_from_list(pic, list));
 }
@@ -598,7 +591,7 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
   int c;
 
   switch ((c = skip(port, ' '))) {
-  case '(': case '[':
+  case '(':
     {
       pic_value tmp;
 
@@ -664,14 +657,13 @@ read_label_ref(pic_state *pic, struct pic_port *port, int i)
 }
 
 static pic_value
-read_label(pic_state *pic, struct pic_port *port, const char *str)
+read_label(pic_state *pic, struct pic_port *port, int c)
 {
-  int i, c;
+  int i;
 
   i = 0;
-  c = str[1];                   /* initial index letter */
   do {
-    i = i * 10 + c;
+    i = i * 10 + c - '0';
   } while (isdigit(c = next(port)));
 
   if (c == '=') {
@@ -684,54 +676,44 @@ read_label(pic_state *pic, struct pic_port *port, const char *str)
 }
 
 static pic_value
-read_unmatch(pic_state *pic, struct pic_port *port, const char *str)
+read_unmatch(pic_state *pic, struct pic_port *port, int c)
 {
   PIC_UNUSED(port);
-  PIC_UNUSED(str);
+  PIC_UNUSED(c);
 
   read_error(pic, "unmatched parenthesis");
 }
 
+static pic_value
+read_dispatch(pic_state *pic, struct pic_port *port, int c)
+{
+  c = next(port);
+
+  if (c == EOF) {
+    read_error(pic, "unexpected EOF");
+  }
+
+  if (pic->reader->dispatch[c] == NULL) {
+    read_error(pic, "invalid character at the seeker head");
+  }
+
+  return pic->reader->dispatch[c](pic, port, c);
+}
+
 static pic_value
 read_nullable(pic_state *pic, struct pic_port *port, int c)
 {
-  struct pic_trie *trie = pic->reader->trie;
-  char buf[128];
-  size_t i = 0;
-  pic_str *str;
-
   c = skip(port, c);
 
   if (c == EOF) {
     read_error(pic, "unexpected EOF");
   }
 
-  if (trie->table[c] == NULL) {
+  if (pic->reader->table[c] == NULL) {
     read_error(pic, "invalid character at the seeker head");
   }
 
-  buf[i++] = (char)c;
+  return pic->reader->table[c](pic, port, c);
-
-  while (i < sizeof buf) {
-    trie = trie->table[c];
-
-    if ((c = peek(port)) == EOF) {
-      break;
-    }
-    if (trie->table[c] == NULL) {
-      break;
-    }
-    buf[i++] = (char)next(port);
-  }
-  if (i == sizeof buf) {
-    read_error(pic, "too long dispatch string");
-  }
-
-  if (trie->proc == NULL) {
-    read_error(pic, "no reader registered for current string");
-  }
-  str = pic_make_str(pic, buf, i);
-  return pic_apply2(pic, trie->proc, pic_obj_value(port), pic_obj_value(str));
 }
 
 static pic_value
@@ -750,137 +732,79 @@ read(pic_state *pic, struct pic_port *port, int c)
   return val;
 }
 
-struct pic_trie *
+static void
-pic_make_trie(pic_state *pic)
+reader_table_init(struct pic_reader *reader)
 {
-  struct pic_trie *trie;
-
-  trie = pic_alloc(pic, sizeof(struct pic_trie));
-  trie->proc = NULL;
-  memset(trie->table, 0, sizeof trie->table);
-
-  return trie;
-}
-
-void
-pic_trie_delete(pic_state *pic, struct pic_trie *trie)
-{
-  size_t i;
-
-  for (i = 0; i < sizeof trie->table / sizeof(struct pic_trie *); ++i) {
-    if (trie->table[i] != NULL) {
-      pic_trie_delete(pic, trie->table[i]);
-    }
-  }
-
-  pic_free(pic, trie);
-}
-
-void
-pic_define_reader(pic_state *pic, const char *str, pic_func_t reader)
-{
-  struct pic_trie *trie = pic->reader->trie;
   int c;
 
-  while ((c = *str++)) {
+  reader->table[0] = NULL;
-    if (trie->table[c] == NULL) {
-      trie->table[c] = pic_make_trie(pic);
-    }
-    trie = trie->table[c];
-  }
-  trie->proc = pic_make_proc(pic, reader, "reader");
-}
 
-#define DEFINE_READER(name)                     \
+  /* default reader */
-  static pic_value                              \
+  for (c = 1; c < 256; ++c) {
-  pic_##name(pic_state *pic)                    \
+    reader->table[c] = read_symbol;
-  {                                             \
-    struct pic_port *port;                      \
-    const char *str;                            \
-                                                \
-    pic_get_args(pic, "pz", &port, &str);       \
-                                                \
-    return name(pic, port, str);                \
   }
 
-DEFINE_READER(read_unmatch)
+  reader->table[')'] = read_unmatch;
-DEFINE_READER(read_comment)
+  reader->table[';'] = read_comment;
-DEFINE_READER(read_quote)
+  reader->table['\''] = read_quote;
-DEFINE_READER(read_quasiquote)
+  reader->table['`'] = read_quasiquote;
-DEFINE_READER(read_unquote)
+  reader->table[','] = read_unquote;
-DEFINE_READER(read_unquote_splicing)
+  reader->table['"'] = read_string;
-DEFINE_READER(read_string)
+  reader->table['|'] = read_pipe;
-DEFINE_READER(read_pipe)
+  reader->table['+'] = read_plus;
-DEFINE_READER(read_plus)
+  reader->table['-'] = read_minus;
-DEFINE_READER(read_minus)
+  reader->table['('] = read_pair;
-DEFINE_READER(read_pair)
+  reader->table['#'] = read_dispatch;
-DEFINE_READER(read_directive)
-DEFINE_READER(read_block_comment)
-DEFINE_READER(read_datum_comment)
-DEFINE_READER(read_true)
-DEFINE_READER(read_false)
-DEFINE_READER(read_char)
-DEFINE_READER(read_vector)
-DEFINE_READER(read_blob)
-DEFINE_READER(read_eval)
-DEFINE_READER(read_symbol)
-DEFINE_READER(read_number)
-DEFINE_READER(read_label)
-
-void
-pic_init_reader(pic_state *pic)
-{
-  static const char INIT[] = "!$%&*./:<=>?@^_~";
-  char buf[3] = { 0 };
-  size_t i;
-
-  pic_define_reader(pic, ")", pic_read_unmatch);
-  pic_define_reader(pic, ";", pic_read_comment);
-  pic_define_reader(pic, "'", pic_read_quote);
-  pic_define_reader(pic, "`", pic_read_quasiquote);
-  pic_define_reader(pic, ",", pic_read_unquote);
-  pic_define_reader(pic, ",@", pic_read_unquote_splicing);
-  pic_define_reader(pic, "\"", pic_read_string);
-  pic_define_reader(pic, "|", pic_read_pipe);
-  pic_define_reader(pic, "+", pic_read_plus);
-  pic_define_reader(pic, "-", pic_read_minus);
-  pic_define_reader(pic, "(", pic_read_pair);
-  pic_define_reader(pic, "[", pic_read_pair);
-
-  pic_define_reader(pic, "#!", pic_read_directive);
-  pic_define_reader(pic, "#|", pic_read_block_comment);
-  pic_define_reader(pic, "#;", pic_read_datum_comment);
-  pic_define_reader(pic, "#t", pic_read_true);
-  pic_define_reader(pic, "#true", pic_read_true);
-  pic_define_reader(pic, "#f", pic_read_false);
-  pic_define_reader(pic, "#false", pic_read_false);
-  pic_define_reader(pic, "#\\", pic_read_char);
-  pic_define_reader(pic, "#(", pic_read_vector);
-  pic_define_reader(pic, "#u", pic_read_blob);
-  pic_define_reader(pic, "#.", pic_read_eval);
 
   /* read number */
-  for (buf[0] = '0'; buf[0] <= '9'; ++buf[0]) {
+  for (c = '0'; c <= '9'; ++c) {
-    pic_define_reader(pic, buf, pic_read_number);
+    reader->table[c] = read_number;
   }
 
-  /* read symbol */
+  reader->dispatch['!'] = read_directive;
-  for (buf[0] = 'a'; buf[0] <= 'z'; ++buf[0]) {
+  reader->dispatch['|'] = read_block_comment;
-    pic_define_reader(pic, buf, pic_read_symbol);
+  reader->dispatch[';'] = read_datum_comment;
+  reader->dispatch['t'] = read_true;
+  reader->dispatch['f'] = read_false;
+  reader->dispatch['\\'] = read_char;
+  reader->dispatch['('] = read_vector;
+  reader->dispatch['u'] = read_blob;
+  reader->dispatch['.'] = read_eval;
+
+  /* read labels */
+  for (c = '0'; c <= '9'; ++c) {
+    reader->dispatch[c] = read_label;
   }
-  for (buf[0] = 'A'; buf[0] <= 'Z'; ++buf[0]) {
+}
-    pic_define_reader(pic, buf, pic_read_symbol);
+
-  }
+struct pic_reader *
-  for (i = 0; i < sizeof INIT; ++i) {
+pic_reader_open(pic_state *pic)
-    buf[0] = INIT[i];
+{
-    pic_define_reader(pic, buf, pic_read_symbol);
+  struct pic_reader *reader;
+  int c;
+
+  reader = pic_alloc(pic, sizeof(struct pic_reader));
+  reader->typecase = PIC_CASE_DEFAULT;
+  xh_init_int(&reader->labels, sizeof(pic_value));
+
+  for (c = 0; c < 256; ++c) {
+    reader->table[c] = NULL;
   }
 
-  /* read label */
+  for (c = 0; c < 256; ++c) {
-  buf[0] = '#';
+    reader->dispatch[c] = NULL;
-  for (buf[1] = '0'; buf[1] <= '9'; ++buf[1]) {
-    pic_define_reader(pic, buf, pic_read_label);
   }
+
+  reader_table_init(reader);
+
+  return reader;
+}
+
+void
+pic_reader_close(pic_state *pic, struct pic_reader *reader)
+{
+  xh_destroy(&reader->labels);
+  pic_free(pic, reader);
 }
 
 pic_value

extlib/benz/state.c

@@ -11,8 +11,139 @@
 #include "picrin/port.h"
 #include "picrin/error.h"
 #include "picrin/dict.h"
+#include "picrin/pair.h"
+#include "picrin/lib.h"
 
-void pic_init_core(pic_state *);
+void
+pic_add_feature(pic_state *pic, const char *feature)
+{
+  pic_push(pic, pic_obj_value(pic_intern_cstr(pic, feature)), pic->features);
+}
+
+void pic_init_bool(pic_state *);
+void pic_init_pair(pic_state *);
+void pic_init_port(pic_state *);
+void pic_init_number(pic_state *);
+void pic_init_proc(pic_state *);
+void pic_init_symbol(pic_state *);
+void pic_init_vector(pic_state *);
+void pic_init_blob(pic_state *);
+void pic_init_cont(pic_state *);
+void pic_init_char(pic_state *);
+void pic_init_error(pic_state *);
+void pic_init_str(pic_state *);
+void pic_init_macro(pic_state *);
+void pic_init_var(pic_state *);
+void pic_init_write(pic_state *);
+void pic_init_read(pic_state *);
+void pic_init_dict(pic_state *);
+void pic_init_record(pic_state *);
+void pic_init_eval(pic_state *);
+void pic_init_lib(pic_state *);
+void pic_init_attr(pic_state *);
+
+extern const char pic_boot[];
+
+static void
+pic_init_features(pic_state *pic)
+{
+  pic_add_feature(pic, "picrin");
+  pic_add_feature(pic, "ieee-float");
+
+#if _POSIX_SOURCE
+  pic_add_feature(pic, "posix");
+#endif
+
+#if _WIN32
+  pic_add_feature(pic, "windows");
+#endif
+
+#if __unix__
+  pic_add_feature(pic, "unix");
+#endif
+#if __gnu_linux__
+  pic_add_feature(pic, "gnu-linux");
+#endif
+#if __FreeBSD__
+  pic_add_feature(pic, "freebsd");
+#endif
+
+#if __i386__
+  pic_add_feature(pic, "i386");
+#elif __x86_64__
+  pic_add_feature(pic, "x86-64");
+#elif __ppc__
+  pic_add_feature(pic, "ppc");
+#elif __sparc__
+  pic_add_feature(pic, "sparc");
+#endif
+
+#if __ILP32__
+  pic_add_feature(pic, "ilp32");
+#elif __LP64__
+  pic_add_feature(pic, "lp64");
+#endif
+
+#if defined(__BYTE_ORDER__)
+# if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
+  pic_add_feature(pic, "little-endian");
+# elif __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
+  pic_add_feature(pic, "big-endian");
+# endif
+#else
+# if __LITTLE_ENDIAN__
+  pic_add_feature(pic, "little-endian");
+# elif __BIG_ENDIAN__
+  pic_add_feature(pic, "big-endian");
+# endif
+#endif
+}
+
+#define DONE pic_gc_arena_restore(pic, ai);
+
+static void
+pic_init_core(pic_state *pic)
+{
+  size_t ai = pic_gc_arena_preserve(pic);
+
+  pic_init_features(pic);
+
+  pic_deflibrary (pic, "(picrin base)") {
+    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sDEFINE, pic->rDEFINE);
+    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sSETBANG, pic->rSETBANG);
+    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sQUOTE, pic->rQUOTE);
+    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sLAMBDA, pic->rLAMBDA);
+    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sIF, pic->rIF);
+    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sBEGIN, pic->rBEGIN);
+    pic_define_syntactic_keyword(pic, pic->lib->env, pic->sDEFINE_SYNTAX, pic->rDEFINE_SYNTAX);
+
+    pic_init_bool(pic); DONE;
+    pic_init_pair(pic); DONE;
+    pic_init_port(pic); DONE;
+    pic_init_number(pic); DONE;
+    pic_init_proc(pic); DONE;
+    pic_init_symbol(pic); DONE;
+    pic_init_vector(pic); DONE;
+    pic_init_blob(pic); DONE;
+    pic_init_cont(pic); DONE;
+    pic_init_char(pic); DONE;
+    pic_init_error(pic); DONE;
+    pic_init_str(pic); DONE;
+    pic_init_macro(pic); DONE;
+    pic_init_var(pic); DONE;
+    pic_init_write(pic); DONE;
+    pic_init_read(pic); DONE;
+    pic_init_dict(pic); DONE;
+    pic_init_record(pic); DONE;
+    pic_init_eval(pic); DONE;
+    pic_init_lib(pic); DONE;
+    pic_init_attr(pic); DONE;
+
+    pic_load_cstr(pic, pic_boot);
+  }
+
+  pic_import_library(pic, pic->PICRIN_BASE);
+}
 
 pic_state *
 pic_open(int argc, char *argv[], char **envp)
@@ -49,7 +180,7 @@ pic_open(int argc, char *argv[], char **envp)
   pic->xpend = pic->xpbase + PIC_RESCUE_SIZE;
 
   /* memory heap */
-  pic->heap = pic_heap_open();
+  pic->heap = pic_heap_open(pic);
 
   /* symbol table */
   xh_init_str(&pic->syms, sizeof(pic_sym *));
@@ -170,18 +301,13 @@ pic_open(int argc, char *argv[], char **envp)
   pic->wind->in = pic->wind->out = NULL;
 
   /* reader */
-  pic->reader = malloc(sizeof(struct pic_reader));
+  pic->reader = pic_reader_open(pic);
-  pic->reader->typecase = PIC_CASE_DEFAULT;
-  pic->reader->trie = pic_make_trie(pic);
-  xh_init_int(&pic->reader->labels, sizeof(pic_value));
-
-  /* init readers */
-  pic_init_reader(pic);
 
   /* standard libraries */
   pic->PICRIN_BASE = pic_open_library(pic, pic_read_cstr(pic, "(picrin base)"));
   pic->PICRIN_USER = pic_open_library(pic, pic_read_cstr(pic, "(picrin user)"));
   pic->lib = pic->PICRIN_USER;
+  pic->prev_lib = NULL;
 
   /* standard I/O */
   pic->xSTDIN = pic_make_standard_port(pic, xstdin, PIC_PORT_IN);
@@ -233,18 +359,16 @@ pic_close(pic_state *pic)
   pic_gc_run(pic);
 
   /* free heaps */
-  pic_heap_close(pic->heap);
+  pic_heap_close(pic, pic->heap);
+
+  /* free reader struct */
+  pic_reader_close(pic, pic->reader);
 
   /* free runtime context */
   free(pic->stbase);
   free(pic->cibase);
   free(pic->xpbase);
 
-  /* free reader struct */
-  xh_destroy(&pic->reader->labels);
-  pic_trie_delete(pic, pic->reader->trie);
-  free(pic->reader);
-
   /* free global stacks */
   xh_destroy(&pic->syms);
   xh_destroy(&pic->attrs);

extlib/benz/string.c

@@ -425,7 +425,7 @@ static pic_value
 pic_str_list_to_string(pic_state *pic)
 {
   pic_str *str;
-  pic_value list, e;
+  pic_value list, e, it;
   size_t i = 0;
 
   pic_get_args(pic, "o", &list);
@@ -435,7 +435,7 @@ pic_str_list_to_string(pic_state *pic)
   } else {
     char buf[pic_length(pic, list)];
 
-    pic_for_each (e, list) {
+    pic_for_each (e, list, it) {
       pic_assert_type(pic, e, char);
 
       buf[i++] = pic_char(e);

extlib/benz/vector.c

@@ -302,7 +302,7 @@ static pic_value
 pic_vec_list_to_vector(pic_state *pic)
 {
   struct pic_vector *vec;
-  pic_value list, e, *data;
+  pic_value list, e, it, *data;
 
   pic_get_args(pic, "o", &list);
 
@@ -310,7 +310,7 @@ pic_vec_list_to_vector(pic_state *pic)
 
   data = vec->data;
 
-  pic_for_each (e, list) {
+  pic_for_each (e, list, it) {
     *data++ = e;
   }
   return pic_obj_value(vec);

extlib/benz/vm.c

@@ -1153,13 +1153,13 @@ pic_apply_trampoline(pic_state *pic, struct pic_proc *proc, pic_value args)
     { OP_TAILCALL, { .i = -1 } }
   };
 
-  pic_value v, *sp;
+  pic_value v, it, *sp;
   pic_callinfo *ci;
 
   *pic->sp++ = pic_obj_value(proc);
 
   sp = pic->sp;
-  pic_for_each (v, args) {
+  pic_for_each (v, args, it) {
     *sp++ = v;
   }
 

piclib/picrin/syntax-rules.scm

@@ -1,5 +1,6 @@
 (define-library (picrin syntax-rules)
   (import (picrin base)
+          (picrin control)
           (picrin macro))
 
   (define-syntax define-auxiliary-syntax
@@ -74,7 +75,7 @@
        (define _unquote (r 'unquote))
        (define _unquote-splicing (r 'unquote-splicing))
        (define _syntax-error (r 'syntax-error))
-       (define _call/cc (r 'call/cc))
+       (define _escape (r 'escape))
        (define _er-macro-transformer (r 'er-macro-transformer))
 
        (define (var->sym v)
@@ -303,7 +304,7 @@
 		      (match (list-ref (car clauses) 1))
 		      (expand (list-ref (car clauses) 2)))
 		  `(,_let ,(map (lambda (v) (list (var->sym v) '())) vars)
-			  (,_let ((result (,_call/cc (,_lambda (exit) ,match))))
+			  (,_let ((result (,_escape (,_lambda (exit) ,match))))
 				 (,_if result
 				       ,expand
 				       ,(expand-clauses (cdr clauses) rename))))))))

src/main.c

@@ -20,11 +20,11 @@ pic_features(pic_state *pic)
 static pic_value
 pic_libraries(pic_state *pic)
 {
-  pic_value libs = pic_nil_value(), lib;
+  pic_value libs = pic_nil_value(), lib, it;
 
   pic_get_args(pic, "");
 
-  pic_for_each (lib, pic->libs) {
+  pic_for_each (lib, pic->libs, it) {
     libs = pic_cons(pic, pic_car(pic, lib), libs);
   }
 
@@ -42,10 +42,10 @@ pic_init_picrin(pic_state *pic)
 
   pic_deflibrary (pic, "(scheme base)") {
     pic_defun(pic, "features", pic_features);
-
-    pic_init_contrib(pic);
-    pic_load_piclib(pic);
   }
+
+  pic_init_contrib(pic);
+  pic_load_piclib(pic);
 }
 
 int

t/escape.scm

@@ -0,0 +1,16 @@
+(import (scheme base)
+		(picrin control)
+        (picrin test))
+
+(test-begin)
+
+(test 1 (escape (lambda (exit) (begin (exit 1) 2))))
+
+(define cont #f)
+
+(test "calling dead escape continuation"
+	  (guard (c ((error-object? c) (error-object-message c)))
+			 (escape (lambda (exit) (set! cont exit)))
+			 (cont 3)))
+
+(test-end)

t/issue/250.scm

@@ -0,0 +1,5 @@
+(import (scheme base)
+        (scheme file))
+
+(with-output-to-file "test.txt"
+    (write "TEST"))