conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' into better-error-message2

This commit is contained in:
Sunrin SHIMURA (keen) 2015-01-27 09:36:15 +00:00
parent 6ee0fd2852 7997af4a07
commit df0b61ed92
40 changed files with 776 additions and 1122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

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

2
CMakeLists.txt
View File

@ -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)

10
contrib/03.callcc/callcc.c
View File

@ -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_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);
}
}

2
contrib/03.file/src/file.c
View File

@ -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());

4
contrib/10.partcont/docs/doc.rst
View File

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

141
docs/contrib.rst
View File

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

4
extlib/benz/blob.c
View File

@ -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)

185
extlib/benz/codegen.c
View File

@ -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(&regs, 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(&regs, *var, &n);
xh_put_ptr(&regs, 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(&regs, *var, &n);
xh_put_ptr(&regs, 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(&regs, *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(&regs, 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;

5
extlib/benz/cont.c
View File

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

4
extlib/benz/dict.c
View File

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

36
extlib/benz/gc.c
View File

@ -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);

24
extlib/benz/include/picrin.h
View File

@ -42,13 +42,14 @@ extern "C" {
#include <math.h>
#include <ctype.h>
#include "picrin/config.h"
#include "picrin/util.h"
#include "picrin/xvect.h"
#include "picrin/xhash.h"
#include "picrin/xfile.h"
#include "picrin/xrope.h"
#include "picrin/config.h"
#include "picrin/util.h"
#include "picrin/value.h"
typedef struct pic_code pic_code;
@ -87,7 +88,7 @@ typedef struct {
pic_code *ip;
struct pic_lib *lib;
struct pic_lib *lib, *prev_lib;
pic_sym *sDEFINE, *sLAMBDA, *sIF, *sBEGIN, *sQUOTE, *sSETBANG;
pic_sym *sQUASIQUOTE, *sUNQUOTE, *sUNQUOTE_SPLICING;
@ -208,25 +209,26 @@ struct pic_lib *pic_open_library(pic_state *, pic_value);
struct pic_lib *pic_find_library(pic_state *, pic_value);
#define pic_deflibrary(pic, spec) \
pic_deflibrary_helper_(pic, PIC_GENSYM(i), PIC_GENSYM(prev_lib), spec)
#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);
}

6
extlib/benz/include/picrin/config.h
View File

@ -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

2
extlib/benz/include/picrin/data.h
View File

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

9
extlib/benz/include/picrin/dict.h
View File

@ -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);

18
extlib/benz/include/picrin/error.h
View File

@ -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) \
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 \
#define pic_catch_(label) \
while (0); \
pic_pop_try(pic); \
} else
} 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)
}

4
extlib/benz/include/picrin/gc.h
View File

@ -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)
}

4
extlib/benz/include/picrin/irep.h
View File

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

13
extlib/benz/include/picrin/pair.h
View File

@ -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))

4
extlib/benz/include/picrin/port.h
View File

@ -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 {

26
extlib/benz/include/picrin/read.h
View File

@ -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)
}

14
extlib/benz/include/picrin/util.h
View File

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

78
extlib/benz/include/picrin/value.h
View File

@ -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))

134
extlib/benz/include/picrin/xfile.h
View File

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

92
extlib/benz/include/picrin/xhash.h
View File

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

46
extlib/benz/include/picrin/xrope.h
View File

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

244
extlib/benz/include/picrin/xvect.h
View File

@ -1,202 +1,76 @@
#ifndef XVECT_H__
#define XVECT_H__
/*
* Copyright (c) 2014 by Yuichi Nishiwaki <yuichi@idylls.jp>
*/
/* The MIT License
#if defined(__cplusplus)
extern "C" {
#endif
Copyright (c) 2008, by Attractive Chaos <attractor@live.co.uk>
Copyright (c) 2014, by Yuichi Nishiwaki <yuichi@idylls.jp>
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

140
extlib/benz/init.c
View File

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

24
extlib/benz/lib.c
View File

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

4
extlib/benz/macro.c
View File

@ -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);

8
extlib/benz/pair.c
View File

@ -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);

390
extlib/benz/read.c
View File

@ -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

154
extlib/benz/state.c
View File

@ -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);

4
extlib/benz/string.c
View File

@ -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);

4
extlib/benz/vector.c
View File

@ -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);

4
extlib/benz/vm.c
View File

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

5
piclib/picrin/syntax-rules.scm
View File

@ -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))))))))

6
src/main.c
View File

@ -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);
}
}
int

16
t/escape.scm Normal file
View File

@ -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)

5
t/issue/250.scm Normal file
View File

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