From 2643cb0e3c9b241f4e73c9cf40bd766fda0c01f1 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Tue, 1 Apr 2014 11:39:35 +0900 Subject: [PATCH 1/4] add SWAP macro --- include/picrin/util.h | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/include/picrin/util.h b/include/picrin/util.h index 3475caae..1ad80950 100644 --- a/include/picrin/util.h +++ b/include/picrin/util.h @@ -35,6 +35,15 @@ extern "C" { # define UNREACHABLE() (assert(false)) #endif +#define SWAP(type,a,b) \ + SWAP_HELPER__(type,GENSYM(tmp),a,b) +#define SWAP_HELPER__(type,tmp,a,b) \ + do { \ + type tmp = (a); \ + (a) = (b); \ + (b) = tmp; \ + } while (0) + #if defined(__cplusplus) } #endif From e32e42c5f960e86d83702cdc058fbb7922d4aab7 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Tue, 1 Apr 2014 11:40:20 +0900 Subject: [PATCH 2/4] support datum label reader --- include/picrin/parse.h | 3 +- src/read.c | 72 ++++++++++++++++++++++++++++++++++++++++++ src/scan.l | 17 ++++++++++ 3 files changed, 91 insertions(+), 1 deletion(-) diff --git a/include/picrin/parse.h b/include/picrin/parse.h index afed3c34..0451d201 100644 --- a/include/picrin/parse.h +++ b/include/picrin/parse.h @@ -11,7 +11,7 @@ extern "C" { enum { tEOF = 0, - tDATUM_COMMENT, + tLABEL_SET, tLABEL_REF, tDATUM_COMMENT, tLPAREN, tRPAREN, tLBRACKET, tRBRACKET, tDOT, tVPAREN, tQUOTE, tQUASIQUOTE, tUNQUOTE, tUNQUOTE_SPLICING, tINT, tBOOLEAN, @@ -34,6 +34,7 @@ typedef union YYSTYPE { struct parser_control { pic_state *pic; YYSTYPE yylval; + xhash labels; jmp_buf jmp; const char *msg; }; diff --git a/src/read.c b/src/read.c index ac9fc247..4b0736b6 100644 --- a/src/read.c +++ b/src/read.c @@ -17,6 +17,7 @@ static pic_value read(int, yyscan_t); #define pic (yyget_extra(scanner)->pic) #define yylval (yyget_extra(scanner)->yylval) +#define yylabels (yyget_extra(scanner)->labels) #define yymsg (yyget_extra(scanner)->msg) #define yyjmp (yyget_extra(scanner)->jmp) @@ -38,6 +39,65 @@ gettok(yyscan_t scanner) return tok; } +static pic_value +read_label_set(int i, yyscan_t scanner) +{ + int tok; + pic_value val; + + switch (tok = gettok(scanner)) { + case tLPAREN: + case tLBRACKET: + { + pic_value tmp; + + val = pic_cons(pic, pic_none_value(), pic_none_value()); + + xh_put(&yylabels, i, &val); + + tmp = read(tok, scanner); + pic_pair_ptr(val)->car = pic_car(pic, tmp); + pic_pair_ptr(val)->cdr = pic_cdr(pic, tmp); + + return val; + } + case tVPAREN: + { + pic_vec *tmp; + + val = pic_obj_value(pic_vec_new(pic, 0)); + + xh_put(&yylabels, i, &val); + + tmp = pic_vec_ptr(read(tok, scanner)); + SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data); + SWAP(size_t, tmp->len, pic_vec_ptr(val)->len); + + return val; + } + default: + { + val = read(tok, scanner); + + xh_put(&yylabels, i, &val); + + return val; + } + } +} + +static pic_value +read_label_ref(int i, yyscan_t scanner) +{ + xh_entry *e; + + e = xh_get(&yylabels, i); + if (! e) { + error("label of given index not defined", scanner); + } + return xh_val(e, pic_value); +} + static pic_value read_pair(int tOPEN, yyscan_t scanner) { @@ -88,6 +148,12 @@ read_datum(int tok, yyscan_t scanner) pic_value val; switch (tok) { + case tLABEL_SET: + return read_label_set(yylval.i, scanner); + + case tLABEL_REF: + return read_label_ref(yylval.i, scanner); + case tSYMBOL: return pic_symbol_value(pic_intern(pic, yylval.buf.dat, yylval.buf.len)); @@ -207,12 +273,14 @@ pic_read(pic_state *pic, const char *cstr) pic_value val; ctrl.pic = pic; + xh_init_int(&ctrl.labels, sizeof(pic_value)); yylex_init_extra(&ctrl, &scanner); yy_scan_string(cstr, scanner); val = read_one(scanner); yylex_destroy(scanner); + xh_destroy(&ctrl.labels); return val; } @@ -225,12 +293,14 @@ pic_parse_file(pic_state *pic, FILE *file) pic_value vals; ctrl.pic = pic; + xh_init_int(&ctrl.labels, sizeof(pic_value)); yylex_init_extra(&ctrl, &scanner); yyset_in(file, scanner); vals = read_many(scanner); yylex_destroy(scanner); + xh_destroy(&ctrl.labels); return vals; } @@ -243,12 +313,14 @@ pic_parse_cstr(pic_state *pic, const char *cstr) pic_value vals; ctrl.pic = pic; + xh_init_int(&ctrl.labels, sizeof(pic_value)); yylex_init_extra(&ctrl, &scanner); yy_scan_string(cstr, scanner); vals = read_many(scanner); yylex_destroy(scanner); + xh_destroy(&ctrl.labels); return vals; } diff --git a/src/scan.l b/src/scan.l index a193dd68..c3d9b1b8 100644 --- a/src/scan.l +++ b/src/scan.l @@ -63,6 +63,10 @@ infnan "+inf.0"|"-inf.0"|"+nan.0"|"-nan.0" /* block comment */ %x BLOCK_COMMENT + /* datum label */ +label #{uinteger} +%x DATUM_LABEL + %% [ \t\n\r] /* skip whitespace */ @@ -85,6 +89,19 @@ infnan "+inf.0"|"-inf.0"|"+nan.0"|"-nan.0" /* skip block comment */ } +{label} { + BEGIN(DATUM_LABEL); + yylval.i = atoi(yytext + 1); +} += { + BEGIN(INITIAL); + return tLABEL_SET; +} +# { + BEGIN(INITIAL); + return tLABEL_REF; +} + "#;" return tDATUM_COMMENT; "." return tDOT; "(" return tLPAREN; From b5a307aa88f00a7dc935ea8edebc19ee92e8461c Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Tue, 1 Apr 2014 11:40:36 +0900 Subject: [PATCH 3/4] error on macroexpanding circular objects --- src/macro.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/macro.c b/src/macro.c index c0e70845..dd92fba9 100644 --- a/src/macro.c +++ b/src/macro.c @@ -262,6 +262,10 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_valu pic_value car, v; xh_entry *e; + if (! pic_list_p(expr)) { + pic_errorf(pic, "cannot macroexpand improper list: ~s", expr); + } + car = macroexpand(pic, pic_car(pic, expr), senv, assoc_box); if (pic_sym_p(car)) { pic_sym tag = pic_sym(car); From 55a63c7d8cf3d0d70efbcf6c90bfee4c595f40c5 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Tue, 1 Apr 2014 11:44:06 +0900 Subject: [PATCH 4/4] update readme --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index ed2cea05..f8a65e44 100644 --- a/README.md +++ b/README.md @@ -80,7 +80,7 @@ Picrin is a lightweight scheme implementation intended to comply with full R7RS | --- | --- | --- | | 2.2 Whitespace and comments | yes | | | 2.3 Other notations | incomplete | #e #i #b #o #d #x | -| 2.4 Datum labels | no | unsupported | +| 2.4 Datum labels | yes | | | 3.1 Variables, syntactic keywords, and regions | | | | 3.2 Disjointness of types | yes | | | 3.3 External representations | | |