diff --git a/.gitignore b/.gitignore index d13a2485..7e3e70a0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ build/* src/load_piclib.c src/init_contrib.c +docs/contrib.rst .dir-locals.el GPATH GRTAGS diff --git a/CMakeLists.txt b/CMakeLists.txt index 41bfb13e..cf856238 100644 --- a/CMakeLists.txt +++ b/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) diff --git a/contrib/03.callcc/callcc.c b/contrib/03.callcc/callcc.c index eb519331..f516e8c7 100644 --- a/contrib/03.callcc/callcc.c +++ b/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_redefun(pic, pic->PICRIN_BASE, "call/cc", pic_callcc_callcc); + pic_deflibrary (pic, "(picrin control)") { + 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); + } } diff --git a/contrib/03.file/src/file.c b/contrib/03.file/src/file.c index e3aa1739..8efd2a77 100644 --- a/contrib/03.file/src/file.c +++ b/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()); diff --git a/contrib/10.partcont/docs/doc.rst b/contrib/10.partcont/docs/doc.rst index 08355948..d1b1decc 100644 --- a/contrib/10.partcont/docs/doc.rst +++ b/contrib/10.partcont/docs/doc.rst @@ -6,3 +6,7 @@ Delimited control operators. - **(reset h)** - **(shift k)** +Escape Continuation + +- **(escape f)** + diff --git a/docs/contrib.rst b/docs/contrib.rst deleted file mode 100644 index be9e7ef4..00000000 --- a/docs/contrib.rst +++ /dev/null @@ -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) - `_ - - List library. - -- `(srfi 8) - `_ - - ``receive`` macro. - -- `(srfi 17) - `_ - - Generalized set! - -- `(srfi 26) - `_ - - Cut/cute macros. - -- `(srfi 43) - `_ - - Vector library. - -- `(srfi 60) - `_ - - Bitwise operations. - -- `(srfi 95) - `_ - - Sorting and Marging. - -- `(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. - - diff --git a/extlib/benz/blob.c b/extlib/benz/blob.c index cd5be767..4ca4006d 100644 --- a/extlib/benz/blob.c +++ b/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) diff --git a/extlib/benz/codegen.c b/extlib/benz/codegen.c index 8d5a227d..b1a93200 100644 --- a/extlib/benz/codegen.c +++ b/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) { - xv_push(&state->scope->locals, &sym); + pic_dict_for_each (sym, pic->globals, it) { + 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(&locals, sizeof(pic_sym *)); - xv_init(&captures, sizeof(pic_sym *)); + xv_init(args); + xv_init(locals); + 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(&locals); + xv_destroy(args); + 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->locals); - xv_destroy(&scope->captures); + xv_destroy(scope->args); + xv_destroy(scope->locals); + 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) { - arg = xv_get(&scope->args, i); - if (*arg == sym) + for (i = 0; i < xv_size(scope->args); ++i) { + if (xv_A(scope->args, i) == sym) return true; } /* locals */ - for (i = 0; i < xv_size(&scope->locals); ++i) { - local = xv_get(&scope->locals, i); - if (*local == sym) + for (i = 0; i < xv_size(scope->locals); ++i) { + if (xv_A(scope->locals, i) == 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) { - var = xv_get(&scope->captures, i); - if (*var == sym) { + for (i = 0; i < xv_size(scope->captures); ++i) { + if (xv_A(scope->captures, i) == sym) { break; } } - if (i == xv_size(&scope->captures)) { - xv_push(&scope->captures, &sym); + if (i == xv_size(scope->captures)) { + 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) { - var = xv_get(&scope->args, i - 1); - pic_push(pic, pic_obj_value(*var), args); + for (i = xv_size(scope->args); i > 0; --i) { + pic_push(pic, pic_obj_value(xv_A(scope->args, i - 1)), 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) { - var = xv_get(&scope->locals, i - 1); - pic_push(pic, pic_obj_value(*var), locals); + for (i = xv_size(scope->locals); i > 0; --i) { + pic_push(pic, pic_obj_value(xv_A(scope->locals, i - 1)), locals); } captures = pic_nil_value(); - for (i = xv_size(&scope->captures); i > 0; --i) { - var = xv_get(&scope->captures, i - 1); - pic_push(pic, pic_obj_value(*var), captures); + for (i = xv_size(scope->captures); i > 0; --i) { + pic_push(pic, pic_obj_value(xv_A(scope->captures, i - 1)), 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(®s, sizeof(size_t)); offset = 1; - for (i = 0; i < xv_size(&cxt->args); ++i) { - var = xv_get(&cxt->args, i); + for (i = 0; i < xv_size(cxt->args); ++i) { n = i + offset; - xh_put_ptr(®s, *var, &n); + xh_put_ptr(®s, xv_A(cxt->args, i), &n); } offset += i; - for (i = 0; i < xv_size(&cxt->locals); ++i) { - var = xv_get(&cxt->locals, i); + for (i = 0; i < xv_size(cxt->locals); ++i) { n = i + offset; - xh_put_ptr(®s, *var, &n); + xh_put_ptr(®s, xv_A(cxt->locals, i), &n); } - for (i = 0; i < xv_size(&cxt->captures); ++i) { - var = xv_get(&cxt->captures, i); - if ((n = xh_val(xh_get_ptr(®s, *var), size_t)) <= xv_size(&cxt->args) || (cxt->varg && n == xv_size(&cxt->args) + 1)) { + for (i = 0; i < xv_size(cxt->captures); ++i) { + n = xh_val(xh_get_ptr(®s, xv_A(cxt->captures, i)), size_t); + 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_sym *sym; + pic_value var, it; 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->locals, sizeof(pic_sym *)); - xv_init(&cxt->captures, sizeof(pic_sym *)); + xv_init(cxt->args); + xv_init(cxt->locals); + xv_init(cxt->captures); - pic_for_each (var, args) { - sym = pic_sym_ptr(var); - xv_push(&cxt->args, &sym); + pic_for_each (var, args, it) { + xv_push_sym(cxt->args, pic_sym_ptr(var)); } - pic_for_each (var, locals) { - sym = pic_sym_ptr(var); - xv_push(&cxt->locals, &sym); + pic_for_each (var, locals, it) { + xv_push_sym(cxt->locals, pic_sym_ptr(var)); } - pic_for_each (var, captures) { - sym = pic_sym_ptr(var); - xv_push(&cxt->captures, &sym); + pic_for_each (var, captures, it) { + xv_push_sym(cxt->captures, pic_sym_ptr(var)); } 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->localc = (int)xv_size(&state->cxt->locals); - irep->capturec = (int)xv_size(&state->cxt->captures); + irep->argc = (int)xv_size(state->cxt->args) + 1; + irep->localc = (int)xv_size(state->cxt->locals); + 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->locals); - xv_destroy(&cxt->captures); + xv_destroy(cxt->args); + xv_destroy(cxt->locals); + 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) { - var = xv_get(&cxt->captures, i); - if (*var == sym) + for (i = 0; i < xv_size(cxt->captures); ++i) { + if (xv_A(cxt->captures, i) == 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) { - var = xv_get(&cxt->args, i); - if (*var == sym) + for (i = 0; i < xv_size(cxt->args); ++i) { + if (xv_A(cxt->args, i) == sym) return (int)(i + offset); } offset += i; - for (i = 0; i < xv_size(&cxt->locals); ++i) { - var = xv_get(&cxt->locals, i); - if (*var == sym) + for (i = 0; i < xv_size(cxt->locals); ++i) { + if (xv_A(cxt->locals, i) == 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; diff --git a/extlib/benz/cont.c b/extlib/benz/cont.c index 2678fb0b..391e766e 100644 --- a/extlib/benz/cont.c +++ b/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; diff --git a/extlib/benz/dict.c b/extlib/benz/dict.c index d677e935..4312c40f 100644 --- a/extlib/benz/dict.c +++ b/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)); } diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c index 0db0c4c1..6dc2be85 100644 --- a/extlib/benz/gc.c +++ b/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) { - cstr = xh_key(*(xh_entry **)xv_get(&xv, i), char *); + for (i = 0; i < xv_size(xv); ++i) { + cstr = xh_key(xv_A(xv, i), char *); xh_del_str(&pic->syms, cstr); diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index 0c950425..c5980e73 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -42,13 +42,14 @@ extern "C" { #include #include +#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) -#define pic_deflibrary_helper_(pic, i, prev_lib, spec) \ - for (int i = 0; ! i; ) \ - for (struct pic_lib *prev_lib; ! i; ) \ - 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) + for (((assert(pic->prev_lib == NULL)), \ + (pic->prev_lib = pic->lib), \ + (pic->lib = pic_open_library(pic, pic_read_cstr(pic, (spec))))); \ + pic->prev_lib != NULL; \ + ((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_errorf(pic_state *, const char *, ...); +PIC_NORETURN void pic_panic(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); } diff --git a/extlib/benz/include/picrin/config.h b/extlib/benz/include/picrin/config.h index 889e268b..7a24f77e 100644 --- a/extlib/benz/include/picrin/config.h +++ b/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 diff --git a/extlib/benz/include/picrin/data.h b/extlib/benz/include/picrin/data.h index fec4cd7d..38a20c3d 100644 --- a/extlib/benz/include/picrin/data.h +++ b/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; } diff --git a/extlib/benz/include/picrin/dict.h b/extlib/benz/include/picrin/dict.h index 13379bf5..4a3bd7ce 100644 --- a/extlib/benz/include/picrin/dict.h +++ b/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) \ - pic_dict_for_each_helper_((sym), PIC_GENSYM(tmp), (dict)) -#define pic_dict_for_each_helper_(var, tmp, dict) \ - for (xh_entry *tmp = xh_begin(&dict->hash); \ - (tmp && ((var = xh_key(tmp, pic_sym *)), 1)); \ - tmp = xh_next(tmp)) +#define pic_dict_for_each(sym, dict, it) \ + for (it = xh_begin(&(dict)->hash); it != NULL; it = xh_next(it)) \ + if ((sym = xh_key(it, pic_sym *)), true) 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); diff --git a/extlib/benz/include/picrin/error.h b/extlib/benz/include/picrin/error.h index 3a575cfe..9a290bae 100644 --- a/extlib/benz/include/picrin/error.h +++ b/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)); \ - pic_save_point(pic, escape); \ - if (setjmp(escape->jmp) == 0) { \ - pic_push_try(pic, escape); \ - do -#define pic_catch \ - while (0); \ - pic_pop_try(pic); \ - } else + do { \ + struct pic_escape *escape = pic_alloc(pic, sizeof(struct pic_escape)); \ + pic_save_point(pic, escape); \ + if (setjmp(escape->jmp) == 0) { \ + pic_push_try(pic, escape); \ + do +#define pic_catch_(label) \ + while (0); \ + 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_throw(pic_state *, pic_sym *, const char *, pic_list); -pic_noreturn void pic_error(pic_state *, const char *, pic_list); +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_error(pic_state *, const char *, pic_list); #if defined(__cplusplus) } diff --git a/extlib/benz/include/picrin/gc.h b/extlib/benz/include/picrin/gc.h index 9f165d80..c7ed0426 100644 --- a/extlib/benz/include/picrin/gc.h +++ b/extlib/benz/include/picrin/gc.h @@ -14,8 +14,8 @@ extern "C" { struct pic_heap; -struct pic_heap *pic_heap_open(); -void pic_heap_close(struct pic_heap *); +struct pic_heap *pic_heap_open(pic_state *); +void pic_heap_close(pic_state *, struct pic_heap *); #if defined(__cplusplus) } diff --git a/extlib/benz/include/picrin/irep.h b/extlib/benz/include/picrin/irep.h index 9c7932da..cf612c0e 100644 --- a/extlib/benz/include/picrin/irep.h +++ b/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; diff --git a/extlib/benz/include/picrin/pair.h b/extlib/benz/include/picrin/pair.h index 11859482..a05b23b6 100644 --- a/extlib/benz/include/picrin/pair.h +++ b/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) \ - pic_for_each_helper_(var, PIC_GENSYM(tmp), list) -#define pic_for_each_helper_(var, tmp, list) \ - for (pic_value tmp = (list); \ - pic_nil_p(tmp) ? false : ((var = pic_car(pic, tmp)), true); \ - tmp = pic_cdr(pic, tmp)) +#define pic_for_each(var, list, it) \ + for (it = (list); ! pic_nil_p(it); it = pic_cdr(pic, it)) \ + if ((var = pic_car(pic, it)), true) #define pic_push(pic, item, place) (place = pic_cons(pic, item, place)) #define pic_pop(pic, place) (place = pic_cdr(pic, place)) diff --git a/extlib/benz/include/picrin/port.h b/extlib/benz/include/picrin/port.h index 4f763902..98dcff83 100644 --- a/extlib/benz/include/picrin/port.h +++ b/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 { diff --git a/extlib/benz/include/picrin/read.h b/extlib/benz/include/picrin/read.h index 18d46ff7..705b4589 100644 --- a/extlib/benz/include/picrin/read.h +++ b/extlib/benz/include/picrin/read.h @@ -9,28 +9,20 @@ extern "C" { #endif -enum pic_typecase { - PIC_CASE_DEFAULT, - PIC_CASE_FOLD, -}; - -struct pic_trie { - struct pic_trie *table[256]; - struct pic_proc *proc; -}; +typedef pic_value (*pic_reader_t)(pic_state *, struct pic_port *port, int c); 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 *); - -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 *); +struct pic_reader *pic_reader_open(pic_state *); +void pic_reader_close(pic_state *, struct pic_reader *); #if defined(__cplusplus) } diff --git a/extlib/benz/include/picrin/util.h b/extlib/benz/include/picrin/util.h index 6f39b759..2b69b206 100644 --- a/extlib/benz/include/picrin/util.h +++ b/extlib/benz/include/picrin/util.h @@ -11,11 +11,19 @@ extern "C" { #if __STDC_VERSION__ >= 201112L # include -# 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) diff --git a/extlib/benz/include/picrin/value.h b/extlib/benz/include/picrin/value.h index a6db5b98..21a3e54d 100644 --- a/extlib/benz/include/picrin/value.h +++ b/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); -static inline const char *pic_type_repr(enum pic_tt); +PIC_INLINE enum pic_tt pic_type(pic_value); +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(); -static inline pic_value pic_true_value(); -static inline pic_value pic_false_value(); -static inline pic_value pic_bool_value(bool); -static inline pic_value pic_undef_value(); -static inline pic_value pic_obj_value(void *); -static inline pic_value pic_float_value(double); -static inline pic_value pic_int_value(int); -static inline pic_value pic_size_value(size_t); -static inline pic_value pic_char_value(char c); -static inline pic_value pic_none_value(); +PIC_INLINE pic_value pic_nil_value(); +PIC_INLINE pic_value pic_true_value(); +PIC_INLINE pic_value pic_false_value(); +PIC_INLINE pic_value pic_bool_value(bool); +PIC_INLINE pic_value pic_undef_value(); +PIC_INLINE pic_value pic_obj_value(void *); +PIC_INLINE pic_value pic_float_value(double); +PIC_INLINE pic_value pic_int_value(int); +PIC_INLINE pic_value pic_size_value(size_t); +PIC_INLINE pic_value pic_char_value(char c); +PIC_INLINE pic_value pic_none_value(); -static inline bool pic_eq_p(pic_value, pic_value); -static inline bool pic_eqv_p(pic_value, pic_value); +PIC_INLINE bool pic_eq_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)) diff --git a/extlib/benz/include/picrin/xfile.h b/extlib/benz/include/picrin/xfile.h index 4c96a9f8..0633cfae 100644 --- a/extlib/benz/include/picrin/xfile.h +++ b/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 *); -static inline xFILE *xmopen(); -static inline xFILE *xfopen(const char *, const char *); -static inline int xfclose(xFILE *); +PIC_INLINE xFILE *xfpopen(FILE *); +PIC_INLINE xFILE *xmopen(); +PIC_INLINE xFILE *xfopen(const char *, const char *); +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 *); -static inline size_t xfwrite(const void *, size_t, size_t, xFILE *); +PIC_INLINE size_t xfread(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); -static inline long xftell(xFILE *); -static inline void xrewind(xFILE *); +PIC_INLINE long xfseek(xFILE *, long offset, int whence); +PIC_INLINE long xftell(xFILE *); +PIC_INLINE void xrewind(xFILE *); /* stream status */ -static inline void xclearerr(xFILE *); -static inline int xfeof(xFILE *); -static inline int xferror(xFILE *); +PIC_INLINE void xclearerr(xFILE *); +PIC_INLINE int xfeof(xFILE *); +PIC_INLINE int xferror(xFILE *); /* character IO */ -static inline int xfgetc(xFILE *); -static inline char *xfgets(char *, int, xFILE *); -static inline int xfputc(int, xFILE *); -static inline int xfputs(const char *, xFILE *); -static inline int xgetc(xFILE *); -static inline int xgetchar(void); -static inline int xputc(int, xFILE *); -static inline int xputchar(int); -static inline int xputs(const char *); -static inline int xungetc(int, xFILE *); +PIC_INLINE int xfgetc(xFILE *); +PIC_INLINE char *xfgets(char *, int, xFILE *); +PIC_INLINE int xfputc(int, xFILE *); +PIC_INLINE int xfputs(const char *, xFILE *); +PIC_INLINE int xgetc(xFILE *); +PIC_INLINE int xgetchar(void); +PIC_INLINE int xputc(int, xFILE *); +PIC_INLINE int xputchar(int); +PIC_INLINE int xputs(const char *); +PIC_INLINE int xungetc(int, xFILE *); /* formatted I/O */ -static inline int xprintf(const char *, ...); -static inline int xfprintf(xFILE *, const char *, ...); -static inline int xvfprintf(xFILE *, const char *, va_list); +PIC_INLINE int xprintf(const char *, ...); +PIC_INLINE int xfprintf(xFILE *, const char *, ...); +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; diff --git a/extlib/benz/include/picrin/xhash.h b/extlib/benz/include/picrin/xhash.h index 1dadc7ff..60e3847d 100644 --- a/extlib/benz/include/picrin/xhash.h +++ b/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); -static inline xh_entry *xh_get_str(xhash *x, const char *key); -static 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_init_str(xhash *x, size_t width); +PIC_INLINE xh_entry *xh_get_str(xhash *x, const char *key); +PIC_INLINE xh_entry *xh_put_str(xhash *x, const char *key, void *); +PIC_INLINE void xh_del_str(xhash *x, const char *key); /* object map */ -static inline void xh_init_ptr(xhash *x, size_t width); -static inline xh_entry *xh_get_ptr(xhash *x, const void *key); -static 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_init_ptr(xhash *x, size_t width); +PIC_INLINE xh_entry *xh_get_ptr(xhash *x, const void *key); +PIC_INLINE xh_entry *xh_put_ptr(xhash *x, const void *key, void *); +PIC_INLINE void xh_del_ptr(xhash *x, const void *key); /* int map */ -static inline void xh_init_int(xhash *x, size_t width); -static inline xh_entry *xh_get_int(xhash *x, int key); -static 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_init_int(xhash *x, size_t width); +PIC_INLINE xh_entry *xh_get_int(xhash *x, int key); +PIC_INLINE xh_entry *xh_put_int(xhash *x, int key, void *); +PIC_INLINE void xh_del_int(xhash *x, int key); -static inline size_t xh_size(xhash *x); -static inline void xh_clear(xhash *x); -static inline void xh_destroy(xhash *x); +PIC_INLINE size_t xh_size(xhash *x); +PIC_INLINE void xh_clear(xhash *x); +PIC_INLINE void xh_destroy(xhash *x); -static inline xh_entry *xh_begin(xhash *x); -static inline xh_entry *xh_next(xh_entry *e); +PIC_INLINE xh_entry *xh_begin(xhash *x); +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; diff --git a/extlib/benz/include/picrin/xrope.h b/extlib/benz/include/picrin/xrope.h index 20199b85..fcdeb446 100644 --- a/extlib/benz/include/picrin/xrope.h +++ b/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); -static inline xrope *xr_new_imbed(const char *, size_t); -static inline xrope *xr_new_move(const char *, size_t); -static inline xrope *xr_new_copy(const char *, size_t); +PIC_INLINE xrope *xr_new_cstr(const char *, size_t); +PIC_INLINE xrope *xr_new_imbed(const char *, size_t); +PIC_INLINE xrope *xr_new_move(const char *, size_t); +PIC_INLINE xrope *xr_new_copy(const char *, size_t); -static inline void XROPE_INCREF(xrope *); -static inline void XROPE_DECREF(xrope *); +PIC_INLINE void XROPE_INCREF(xrope *); +PIC_INLINE void XROPE_DECREF(xrope *); -static inline size_t xr_len(xrope *); -static inline char xr_at(xrope *, size_t); -static inline xrope *xr_cat(xrope *, xrope *); -static inline xrope *xr_sub(xrope *, size_t, size_t); -static inline const char *xr_cstr(xrope *); /* returns NULL-terminated string */ +PIC_INLINE size_t xr_len(xrope *); +PIC_INLINE char xr_at(xrope *, size_t); +PIC_INLINE xrope *xr_cat(xrope *, xrope *); +PIC_INLINE xrope *xr_sub(xrope *, size_t, size_t); +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; diff --git a/extlib/benz/include/picrin/xvect.h b/extlib/benz/include/picrin/xvect.h index a04d227a..6dcabb1c 100644 --- a/extlib/benz/include/picrin/xvect.h +++ b/extlib/benz/include/picrin/xvect.h @@ -1,202 +1,76 @@ #ifndef XVECT_H__ #define XVECT_H__ -/* - * Copyright (c) 2014 by Yuichi Nishiwaki - */ +/* The MIT License -#if defined(__cplusplus) -extern "C" { -#endif + Copyright (c) 2008, by Attractive Chaos + Copyright (c) 2014, by Yuichi Nishiwaki -typedef struct xvect { - char *data; - size_t size, mask, head, tail, width; -} xvect; + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + "Software"), to deal in the Software without restriction, including + 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); -static inline void xv_destroy(xvect *); + The above copyright notice and this permission notice shall be + 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); -static inline void xv_shrink(xvect *, size_t); +#define xv_realloc(P,Z) pic_realloc(pic,P,Z) +#define xv_free(P) pic_free(pic,P) -static inline void *xv_get(xvect *, size_t); -static inline void xv_set(xvect *, size_t, void *); +#define xv_roundup32(x) \ + (--(x), (x)|=(x)>>1, (x)|=(x)>>2, (x)|=(x)>>4, (x)|=(x)>>8, (x)|=(x)>>16, ++(x)) -static inline void xv_push(xvect *, void *); -static inline void *xv_pop(xvect *); +#define xvect_t(type) struct { size_t n, m; type *a; } +#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 *); -static inline void xv_unshift(xvect *, void *); +#define xv_resize(type, v, s) \ + ((v).m = (s), (v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m)) -static inline void xv_splice(xvect *, size_t, size_t); -static inline void xv_insert(xvect *, size_t, void *); +#define xv_copy(type, v1, v0) \ + 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 -xv_init(xvect *x, size_t width) -{ - x->data = NULL; - x->width = width; - x->size = 0; - x->mask = (size_t)-1; - x->head = 0; - x->tail = 0; -} +#define xv_push(type, v, x) \ + do { \ + if ((v).n == (v).m) { \ + (v).m = (v).m? (v).m<<1 : 2; \ + (v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m); \ + } \ + (v).a[(v).n++] = (x); \ + } while (0) -static inline void -xv_destroy(xvect *x) -{ - free(x->data); -} +#define xv_pushp(type, v) \ + (((v).n == (v).m)? \ + ((v).m = ((v).m? (v).m<<1 : 2), \ + (v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m), 0) \ + : 0), ((v).a + ((v).n++)) -static inline size_t -xv_size(xvect *x) -{ - return x->tail < x->head - ? x->tail + x->size - x->head - : x->tail - x->head; -} - -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 +#define xv_a(type, v, i) \ + (((v).m <= (size_t)(i)? \ + ((v).m = (v).n = (i) + 1, xv_roundup32((v).m), \ + (v).a = (type*)xv_realloc((v).a, sizeof(type) * (v).m), 0) \ + : (v).n <= (size_t)(i)? (v).n = (i) + 1 \ + : 0), (v).a[(i)]) #endif diff --git a/extlib/benz/init.c b/extlib/benz/init.c deleted file mode 100644 index 68a58484..00000000 --- a/extlib/benz/init.c +++ /dev/null @@ -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); -} diff --git a/extlib/benz/lib.c b/extlib/benz/lib.c index 234f3833..30362ef2 100644 --- a/extlib/benz/lib.c +++ b/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; } diff --git a/extlib/benz/macro.c b/extlib/benz/macro.c index 622a28d3..f934cdd3 100644 --- a/extlib/benz/macro.c +++ b/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); diff --git a/extlib/benz/pair.c b/extlib/benz/pair.c index 03621ec1..fc865921 100644 --- a/extlib/benz/pair.c +++ b/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); diff --git a/extlib/benz/read.c b/extlib/benz/read.c index 979113c5..8e2f2c01 100644 --- a/extlib/benz/read.c +++ b/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 -read_comment(pic_state *pic, struct pic_port *port, const char *str) +static int +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); - - 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; + size_t len; char *buf; pic_sym *sym; - int c; - len = strlen(str); - buf = pic_calloc(pic, 1, len + 1); - - for (i = 0; i < len; ++i) { - if (pic->reader->typecase == PIC_CASE_FOLD) { - buf[i] = (char)tolower(str[i]); - } else { - buf[i] = str[i]; - } - } + len = 1; + buf = pic_alloc(pic, len + 1); + buf[0] = case_fold(pic, c); + buf[1] = 0; 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; - - 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)); + return pic->reader->table[c](pic, port, c); } static pic_value @@ -750,137 +732,79 @@ read(pic_state *pic, struct pic_port *port, int c) return val; } -struct pic_trie * -pic_make_trie(pic_state *pic) +static void +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++)) { - if (trie->table[c] == NULL) { - trie->table[c] = pic_make_trie(pic); - } - trie = trie->table[c]; - } - trie->proc = pic_make_proc(pic, reader, "reader"); -} + reader->table[0] = NULL; -#define DEFINE_READER(name) \ - static pic_value \ - pic_##name(pic_state *pic) \ - { \ - struct pic_port *port; \ - const char *str; \ - \ - pic_get_args(pic, "pz", &port, &str); \ - \ - return name(pic, port, str); \ + /* default reader */ + for (c = 1; c < 256; ++c) { + reader->table[c] = read_symbol; } -DEFINE_READER(read_unmatch) -DEFINE_READER(read_comment) -DEFINE_READER(read_quote) -DEFINE_READER(read_quasiquote) -DEFINE_READER(read_unquote) -DEFINE_READER(read_unquote_splicing) -DEFINE_READER(read_string) -DEFINE_READER(read_pipe) -DEFINE_READER(read_plus) -DEFINE_READER(read_minus) -DEFINE_READER(read_pair) -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); + reader->table[')'] = read_unmatch; + reader->table[';'] = read_comment; + reader->table['\''] = read_quote; + reader->table['`'] = read_quasiquote; + reader->table[','] = read_unquote; + reader->table['"'] = read_string; + reader->table['|'] = read_pipe; + reader->table['+'] = read_plus; + reader->table['-'] = read_minus; + reader->table['('] = read_pair; + reader->table['#'] = read_dispatch; /* read number */ - for (buf[0] = '0'; buf[0] <= '9'; ++buf[0]) { - pic_define_reader(pic, buf, pic_read_number); + for (c = '0'; c <= '9'; ++c) { + reader->table[c] = read_number; } - /* read symbol */ - for (buf[0] = 'a'; buf[0] <= 'z'; ++buf[0]) { - pic_define_reader(pic, buf, pic_read_symbol); + reader->dispatch['!'] = read_directive; + reader->dispatch['|'] = read_block_comment; + 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); - } - for (i = 0; i < sizeof INIT; ++i) { - buf[0] = INIT[i]; - pic_define_reader(pic, buf, pic_read_symbol); +} + +struct pic_reader * +pic_reader_open(pic_state *pic) +{ + 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 */ - buf[0] = '#'; - for (buf[1] = '0'; buf[1] <= '9'; ++buf[1]) { - pic_define_reader(pic, buf, pic_read_label); + for (c = 0; c < 256; ++c) { + reader->dispatch[c] = NULL; } + + 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 diff --git a/extlib/benz/state.c b/extlib/benz/state.c index 195f07ab..3c74f4f4 100644 --- a/extlib/benz/state.c +++ b/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->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); + pic->reader = pic_reader_open(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); diff --git a/extlib/benz/string.c b/extlib/benz/string.c index 43514b2d..abdefad0 100644 --- a/extlib/benz/string.c +++ b/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); diff --git a/extlib/benz/vector.c b/extlib/benz/vector.c index 33070d24..60004cc8 100644 --- a/extlib/benz/vector.c +++ b/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); diff --git a/extlib/benz/vm.c b/extlib/benz/vm.c index 0c82bdff..12862f9f 100644 --- a/extlib/benz/vm.c +++ b/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; } diff --git a/piclib/picrin/syntax-rules.scm b/piclib/picrin/syntax-rules.scm index 59d2b8e9..6eeef05b 100644 --- a/piclib/picrin/syntax-rules.scm +++ b/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)))))))) diff --git a/src/main.c b/src/main.c index 7d4f6fd1..f43419f1 100644 --- a/src/main.c +++ b/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 diff --git a/t/escape.scm b/t/escape.scm new file mode 100644 index 00000000..8f495a95 --- /dev/null +++ b/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) diff --git a/t/issue/250.scm b/t/issue/250.scm new file mode 100644 index 00000000..38c1fe72 --- /dev/null +++ b/t/issue/250.scm @@ -0,0 +1,5 @@ +(import (scheme base) + (scheme file)) + +(with-output-to-file "test.txt" + (write "TEST"))