Merge branch 'datum-label'
This commit is contained in:
commit
af064e384a
|
@ -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 | | |
|
||||
|
|
|
@ -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;
|
||||
};
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
72
src/read.c
72
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;
|
||||
}
|
||||
|
|
17
src/scan.l
17
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);
|
||||
}
|
||||
<DATUM_LABEL>= {
|
||||
BEGIN(INITIAL);
|
||||
return tLABEL_SET;
|
||||
}
|
||||
<DATUM_LABEL># {
|
||||
BEGIN(INITIAL);
|
||||
return tLABEL_REF;
|
||||
}
|
||||
|
||||
"#;" return tDATUM_COMMENT;
|
||||
"." return tDOT;
|
||||
"(" return tLPAREN;
|
||||
|
|
Loading…
Reference in New Issue