diff --git a/src/parse.y b/src/parse.y index 23d4307b..7f5ad079 100644 --- a/src/parse.y +++ b/src/parse.y @@ -1,6 +1,7 @@ %{ #include #include +#include #include "picrin.h" #include "picrin/pair.h" @@ -8,16 +9,6 @@ #define YYERROR_VERBOSE 1 -struct parser_control { - pic_state *pic; - void *yyscanner; - pic_value value; - bool incomp; - int yynerrs; -}; - -void yyerror(struct parser_control *, const char *); - /* just for supressing warnings. a little bit evil */ int yylex(); int yylex_(); @@ -25,6 +16,123 @@ void yylex_init(); void yyset_in(); void yy_scan_string(); void yylex_destroy(); + +struct parser_control { + pic_state *pic; + void *yyscanner; + pic_value value; + bool incomp; + int yynerrs; + struct pic_vector *yy_arena; + int yy_arena_idx; +}; + +#define YY_ARENA_SIZE 50 + +struct parser_control * +parser_control_new(pic_state *pic) +{ + struct parser_control *p; + + p = (struct parser_control *)pic_alloc(pic, sizeof(struct parser_control)); + p->pic = pic; + p->incomp = false; + p->yynerrs = 0; + p->yy_arena = pic_vec_new(pic, YY_ARENA_SIZE); + p->yy_arena_idx = 0; + yylex_init(&p->yyscanner); + + return p; +} + +void +parser_control_destroy(struct parser_control *p) +{ + pic_state *pic = p->pic; + + yylex_destroy(p->yyscanner); + pic_free(pic, p); +} + +void +yy_obj_protect(struct parser_control *p, struct pic_object *obj) +{ + if (p->yy_arena_idx >= p->yy_arena->len) { + pic_vec_extend_ip(p->pic, p->yy_arena, p->yy_arena->len * 2); + } + p->yy_arena->data[p->yy_arena_idx++] = pic_obj_value(obj); +} + +struct pic_object * +yy_obj_alloc(struct parser_control *p, size_t size, enum pic_tt tt) +{ + struct pic_object *obj; + + obj = pic_obj_alloc_unsafe(p->pic, size, tt); + yy_obj_protect(p, obj); + return obj; +} + +pic_value +yy_cons(struct parser_control *p, pic_value car, pic_value cdr) +{ + struct pic_pair *pair; + + pair = (struct pic_pair *)yy_obj_alloc(p, sizeof(struct pic_pair), PIC_TT_PAIR); + pair->car = car; + pair->cdr = cdr; + + return pic_obj_value(pair); +} + +pic_value +yy_abbrev(struct parser_control *p, pic_sym sym, pic_value datum) +{ + return yy_cons(p, pic_symbol_value(sym), yy_cons(p, datum, pic_nil_value())); +} + +pic_value +yy_str_new_cstr(struct parser_control *p, const char *cstr) +{ + struct pic_string *str; + + str = (struct pic_string *)yy_obj_alloc(p, sizeof(struct pic_string), PIC_TT_STRING); + str->len = strlen(cstr); + str->str = strdup(cstr); + + return pic_obj_value(str); +} + +pic_value +yy_vec_new_from_list(struct parser_control *p, pic_value data) +{ + struct pic_vector *vec; + int i, len; + + len = pic_length(p->pic, data); + + vec = (struct pic_vector *)yy_obj_alloc(p, sizeof(struct pic_vector), PIC_TT_VECTOR); + vec->len = len; + vec->data = (pic_value *)pic_alloc(p->pic, sizeof(pic_value) * len); + for (i = 0; i < len; ++i) { + vec->data[i] = pic_car(p->pic, data); + data = pic_cdr(p->pic, data); + } + return pic_obj_value(vec); +} + +pic_value +yy_blob_new(struct parser_control *p, char *dat, int len) +{ + struct pic_blob *bv; + + bv = (struct pic_blob *)yy_obj_alloc(p, sizeof(struct pic_blob), PIC_TT_BLOB); + bv->data = strndup(dat, len); + bv->len = len; + return pic_obj_value(bv); +} + +void yyerror(struct parser_control *, const char *); %} %pure_parser @@ -77,11 +185,11 @@ program program_data : datum { - $$ = pic_cons(p->pic, $1, pic_nil_value()); + $$ = yy_cons(p, $1, pic_nil_value()); } | datum program_data { - $$ = pic_cons(p->pic, $1, $2); + $$ = yy_cons(p, $1, $2); } | tDATUM_COMMENT datum { @@ -111,7 +219,7 @@ simple_datum } | tSTRING { - $$ = pic_str_new_cstr(p->pic, $1); + $$ = yy_str_new_cstr(p, $1); free($1); } | tINT @@ -132,7 +240,7 @@ simple_datum } | tBYTEVECTOR { - $$ = pic_obj_value(pic_blob_new(p->pic, $1.dat, $1.len)); + $$ = yy_blob_new(p, $1.dat, $1.len); free($1.dat); } ; @@ -165,18 +273,18 @@ list_data } | datum tDOT datum { - $$ = pic_cons(p->pic, $1, $3); + $$ = yy_cons(p, $1, $3); } | datum list_data { - $$ = pic_cons(p->pic, $1, $2); + $$ = yy_cons(p, $1, $2); } ; vector : tVPAREN vector_data tRPAREN { - $$ = pic_obj_value(pic_vec_new_from_list(p->pic, $2)); + $$ = yy_vec_new_from_list(p, $2); } ; @@ -191,26 +299,26 @@ vector_data } | datum vector_data { - $$ = pic_cons(p->pic, $1, $2); + $$ = yy_cons(p, $1, $2); } ; abbrev : tQUOTE datum { - $$ = pic_list(p->pic, 2, pic_symbol_value(p->pic->sQUOTE), $2); + $$ = yy_abbrev(p, p->pic->sQUOTE, $2); } | tQUASIQUOTE datum { - $$ = pic_list(p->pic, 2, pic_symbol_value(p->pic->sQUASIQUOTE), $2); + $$ = yy_abbrev(p, p->pic->sQUASIQUOTE, $2); } | tUNQUOTE datum { - $$ = pic_list(p->pic, 2, pic_symbol_value(p->pic->sUNQUOTE), $2); + $$ = yy_abbrev(p, p->pic->sUNQUOTE, $2); } | tUNQUOTE_SPLICING datum { - $$ = pic_list(p->pic, 2, pic_symbol_value(p->pic->sUNQUOTE_SPLICING), $2); + $$ = yy_abbrev(p, p->pic->sUNQUOTE_SPLICING, $2); } ; @@ -258,50 +366,76 @@ yylex(YYSTYPE *yylvalp, struct parser_control *p) int pic_parse_file(pic_state *pic, FILE *file, pic_value *v) { - struct parser_control p; + struct parser_control *p; + int r, ai = pic_gc_arena_preserve(pic); - p.pic = pic; - p.incomp = false; - p.yynerrs = 0; + p = parser_control_new(pic); - yylex_init(&p.yyscanner); - yyset_in(file, p.yyscanner); - yyparse(&p); - yylex_destroy(p.yyscanner); + yyset_in(file, p->yyscanner); + yyparse(p); - if (p.yynerrs > 0) { - p.value = pic_undef_value(); - return PIC_PARSER_ERROR; + if (p->yynerrs > 0) { + p->value = pic_undef_value(); + r = PIC_PARSER_ERROR; } - if (p.incomp) { - return PIC_PARSER_INCOMPLETE; + else if (p->incomp) { + r = PIC_PARSER_INCOMPLETE; + } + else { + r = pic_length(pic, p->value); } - *v = p.value; - return pic_length(pic, p.value); + parser_control_destroy(p); + +#if DEBUG + if (pic_gc_arena_preserve(pic) != ai + 1) { + puts("**logic flaw! yy obj protection failure!**"); + } +#endif + + pic_gc_arena_restore(pic, ai); + + *v = p->value; + pic_gc_protect(pic, p->value); + + return r; } enum pic_parser_res pic_parse_cstr(pic_state *pic, const char *str, pic_value *v) { - struct parser_control p; + struct parser_control *p; + int r, ai = pic_gc_arena_preserve(pic); - p.pic = pic; - p.incomp = false; - p.yynerrs = 0; + p = parser_control_new(pic); - yylex_init(&p.yyscanner); - yy_scan_string(str, p.yyscanner); - yyparse(&p); - yylex_destroy(p.yyscanner); + yy_scan_string(str, p->yyscanner); + yyparse(p); - if (p.yynerrs > 0) { - return PIC_PARSER_ERROR; + if (p->yynerrs > 0) { + p->value = pic_undef_value(); + r = PIC_PARSER_ERROR; } - if (p.incomp) { - return PIC_PARSER_INCOMPLETE; + else if (p->incomp) { + r = PIC_PARSER_INCOMPLETE; + } + else { + r = pic_length(pic, p->value); } - *v = p.value; - return pic_length(pic, p.value); + parser_control_destroy(p); + +#if DEBUG + if (pic_gc_arena_preserve(pic) != ai + 1) { + puts("**logic flaw! yy obj protection failure!**"); + printf("%d\n", pic_gc_arena_preserve(pic)); + } +#endif + + pic_gc_arena_restore(pic, ai); + + *v = p->value; + pic_gc_protect(pic, p->value); + + return r; }