Merge branch 'datum-label'

This commit is contained in:
Yuichi Nishiwaki 2014-04-01 22:32:38 +09:00
commit af064e384a
6 changed files with 105 additions and 2 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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);
}
<DATUM_LABEL>= {
BEGIN(INITIAL);
return tLABEL_SET;
}
<DATUM_LABEL># {
BEGIN(INITIAL);
return tLABEL_REF;
}
"#;" return tDATUM_COMMENT;
"." return tDOT;
"(" return tLPAREN;