From f96579805cb0c483c261612352e31d633f23a668 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 26 Jan 2015 12:29:29 +0900 Subject: [PATCH 1/9] reserve square brackets --- extlib/benz/read.c | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/extlib/benz/read.c b/extlib/benz/read.c index 95f5011f..eeef81f2 100644 --- a/extlib/benz/read.c +++ b/extlib/benz/read.c @@ -534,8 +534,7 @@ read_blob(pic_state *pic, struct pic_port *port, int c) static pic_value read_pair(pic_state *pic, struct pic_port *port, int c) { - const int tOPEN = c; - const int tCLOSE = (c == '(') ? ')' : ']'; + static const int tCLOSE = ')'; pic_value car, cdr; retry: @@ -564,7 +563,7 @@ read_pair(pic_state *pic, struct pic_port *port, int c) goto retry; } - cdr = read_pair(pic, port, tOPEN); + cdr = read_pair(pic, port, '('); return pic_cons(pic, car, cdr); } } @@ -586,7 +585,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; @@ -749,7 +748,6 @@ reader_table_init(struct pic_reader *reader) reader->table['+'] = read_plus; reader->table['-'] = read_minus; reader->table['('] = read_pair; - reader->table['['] = read_pair; reader->table['#'] = read_dispatch; /* read number */ From 336fc21761be50da62c026213a450ebddcf2a248 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 26 Jan 2015 14:31:36 +0900 Subject: [PATCH 2/9] merge init.c into state.c --- extlib/benz/init.c | 140 -------------------------------------------- extlib/benz/state.c | 133 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 132 insertions(+), 141 deletions(-) delete mode 100644 extlib/benz/init.c 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/state.c b/extlib/benz/state.c index 18b8e438..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) From 303041abc594bae2b88270428fc800a6e3567b80 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 26 Jan 2015 14:33:48 +0900 Subject: [PATCH 3/9] fix degade --- extlib/benz/read.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/extlib/benz/read.c b/extlib/benz/read.c index eeef81f2..8e2f2c01 100644 --- a/extlib/benz/read.c +++ b/extlib/benz/read.c @@ -79,6 +79,15 @@ strcaseeq(const char *s1, const char *s2) return a == b; } +static int +case_fold(pic_state *pic, 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) { @@ -198,17 +207,14 @@ read_symbol(pic_state *pic, struct pic_port *port, int c) len = 1; buf = pic_alloc(pic, len + 1); - buf[0] = c; + 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] = c; + buf[len - 1] = case_fold(pic, c); buf[len] = 0; } From 4972de640fae81de5b8b9786c27b4399917749a6 Mon Sep 17 00:00:00 2001 From: zeptometer Date: Mon, 26 Jan 2015 15:03:04 +0900 Subject: [PATCH 4/9] rename benz's call/cc to escape in (picrin control) --- contrib/03.callcc/callcc.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/contrib/03.callcc/callcc.c b/contrib/03.callcc/callcc.c index 8342f0f2..f516e8c7 100644 --- a/contrib/03.callcc/callcc.c +++ b/contrib/03.callcc/callcc.c @@ -287,6 +287,10 @@ 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); From 9417b45005e17ea9d7d000daff4df90e58fd383b Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 26 Jan 2015 15:10:26 +0900 Subject: [PATCH 5/9] [bugfix] pic_load_point must store escape->results --- extlib/benz/cont.c | 1 + 1 file changed, 1 insertion(+) diff --git a/extlib/benz/cont.c b/extlib/benz/cont.c index 17587e95..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); From 781f27dd4800bb8b42fa7ef206f41da8e230bc43 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 26 Jan 2015 15:41:15 +0900 Subject: [PATCH 6/9] remove docs/contrib.rst --- docs/contrib.rst | 141 ----------------------------------------------- 1 file changed, 141 deletions(-) delete mode 100644 docs/contrib.rst 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. - - From 58f856a3e9b3fa596c87e58db220c9c0befc0eda Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 26 Jan 2015 15:41:38 +0900 Subject: [PATCH 7/9] update gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) 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 From 369bc4c944494ff376b7b63f4f89ffff03657337 Mon Sep 17 00:00:00 2001 From: zeptometer Date: Mon, 26 Jan 2015 15:42:46 +0900 Subject: [PATCH 8/9] add eest for escape --- t/escape.scm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 t/escape.scm 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) From 7d772fc904944e678f5087bd0de018c777b42005 Mon Sep 17 00:00:00 2001 From: zeptometer Date: Mon, 26 Jan 2015 15:46:19 +0900 Subject: [PATCH 9/9] add document for escape --- contrib/10.partcont/docs/doc.rst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/contrib/10.partcont/docs/doc.rst b/contrib/10.partcont/docs/doc.rst index 08355948..78b5945f 100644 --- a/contrib/10.partcont/docs/doc.rst +++ b/contrib/10.partcont/docs/doc.rst @@ -6,3 +6,6 @@ Delimited control operators. - **(reset h)** - **(shift k)** +Escape Continuation + +- **(escape f)**