diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2015-08-10 06:43:37 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2015-08-10 06:43:37 -0700 |
commit | f2a2306a8bd6fb86b4819875f752e3a836f1533d (patch) | |
tree | 8fd5b8b11f6d114d13d8414511b134a7251f7991 | |
parent | c9f9e9419a485b383da3229ca130fdd820db3f33 (diff) | |
download | txr-f2a2306a8bd6fb86b4819875f752e3a836f1533d.tar.gz txr-f2a2306a8bd6fb86b4819875f752e3a836f1533d.tar.bz2 txr-f2a2306a8bd6fb86b4819875f752e3a836f1533d.zip |
Diagnose bad consing dot syntax like (a . b . c).
* parser.y (r_exprs): Use unique object in the terminating cons to
indicate the empty spot where the dotted cdr item will go. Check for
misplaced consing dot. (misplaced_consing_dot_check): New static
function. Checks for the terminator atom spot being taken already.
Thus, the spot may be taken only by the very last reduction, such that
the next reduction is r_exprs -> n_exprs where the terminating atom is
processed.
* parser.c (unique_s): New global variable.
(parse_init): Initialize unique_s.
* parser.h (unique_s): Declared.
* share/txr/stdlib/place.tl (sys:placelet-1): We have a misplaced
consing dot here! It was working correctly by "terminating atom
propagation" behavior, which allowed (a . b c d) to produce
(a c d . b). If a single terminating atom occurred in the middle of a list, it
was promoted to the end.
-rw-r--r-- | parser.c | 4 | ||||
-rw-r--r-- | parser.h | 1 | ||||
-rw-r--r-- | parser.y | 29 | ||||
-rw-r--r-- | share/txr/stdlib/place.tl | 2 |
4 files changed, 27 insertions, 9 deletions
@@ -47,7 +47,7 @@ #include "stream.h" #include "parser.h" -val parser_s; +val parser_s, unique_s; static val stream_parser_hash; @@ -322,7 +322,9 @@ val parser_errors(val parser) void parse_init(void) { parser_s = intern(lit("parser"), user_package); + unique_s = gensym(nil); prot1(&stream_parser_hash); + prot1(&unique_s); stream_parser_hash = make_hash(t, t, nil); parser_l_init(); } @@ -46,6 +46,7 @@ typedef struct { extern const wchar_t *spec_file; extern val form_to_ln_hash; extern val parser_s; +extern val unique_s; void yyerror(scanner_t *scanner, parser_t *, const char *s); void yyerr(scanner_t *scanner, const char *s); void yyerrorf(scanner_t *scanner, val s, ...); @@ -59,6 +59,7 @@ static wchar_t char_from_name(const wchar_t *name); static val make_expr(parser_t *, val sym, val rest, val lineno); static val check_for_include(val spec_rev); static val quasi_meta_helper(val obj); +static void misplaced_consing_dot_check(scanner_t *scanner, val term_atom_cons); #if YYBISON union YYSTYPE; @@ -739,26 +740,30 @@ exprs_opt : exprs { $$ = $1; } ; n_exprs : r_exprs { val term_atom = pop(&$1); - val tail_cons = $1; - $$ = nreverse($1); - rplacd(tail_cons, term_atom); } + val tail_cons = $1; + $$ = nreverse($1); + if (term_atom != unique_s) + rplacd(tail_cons, term_atom); } ; r_exprs : n_expr { val exprs = cons($1, nil); rlcp(exprs, $1); - $$ = rlcp(cons(nil, exprs), exprs); } + $$ = rlcp(cons(unique_s, exprs), exprs); } | r_exprs n_expr { uses_or2; val term_atom_cons = $1; val exprs = cdr($1); + misplaced_consing_dot_check(scnr, term_atom_cons); rplacd(term_atom_cons, rlcp(cons($2, exprs), or2($2, exprs))); $$ = term_atom_cons; } - | r_exprs '.' n_expr { val term_atom_cons = $1; - rplaca(term_atom_cons, $3); - $$ = $1; } + | r_exprs '.' n_expr { val term_atom_cons = $1; + misplaced_consing_dot_check(scnr, term_atom_cons); + rplaca(term_atom_cons, $3); + $$ = $1; } | r_exprs DOTDOT n_expr { uses_or2; val term_atom_cons = $1; val exprs = cdr($1); + misplaced_consing_dot_check(scnr, term_atom_cons); rplacd(term_atom_cons, rlcp(cons(list(cons_s, car(exprs), $3, nao), @@ -770,6 +775,7 @@ r_exprs : n_expr { val exprs = cons($1, nil); | r_exprs WSPLICE wordslit { val term_atom_cons = $1; val exprs = cdr($1); + misplaced_consing_dot_check(scnr, term_atom_cons); rplacd(term_atom_cons, nappend2(rl(nreverse($3), num($2)), exprs)); @@ -779,6 +785,7 @@ r_exprs : n_expr { val exprs = cons($1, nil); | r_exprs QWSPLICE wordsqlit { val term_atom_cons = $1; val exprs = cdr($1); + misplaced_consing_dot_check(scnr, term_atom_cons); rplacd(term_atom_cons, nappend2(rl(nreverse($3), num($2)), exprs)); @@ -1363,6 +1370,14 @@ expr: return rlcp(cons(expr_s, obj), obj); } +static void misplaced_consing_dot_check(scanner_t *scanner, val term_atom_cons) +{ + if (car(term_atom_cons) != unique_s) { + yyerrorf(scanner, lit("misplaced consing dot"), nao); + rplaca(term_atom_cons, unique_s); + } +} + #ifndef YYEOF #define YYEOF 0 #endif diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index 398ecbe3..270baace 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -600,7 +600,7 @@ (with-update-expander (getter setter) ,place-sym env ^(,setter (,',function (,getter) ,,*cleaned-lambda-list))))))) -(defmacro sys:placelet-1 (((sym place)) . body :env env) +(defmacro sys:placelet-1 (((sym place)) :env env . body) (with-gensyms (tmp-place pl-getter pl-setter steal-getter) (unwind-protect (progn |