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.

4 files changed, 27 insertions, 9 deletions

diff --git a/parser.c b/parser.c
index b12a0a10..b79bf8ea 100644
--- a/parser.c
+++ b/parser.c
@@ -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();
 }
diff --git a/parser.h b/parser.h
index fdd45e44..9b336d70 100644
--- a/parser.h
+++ b/parser.h
@@ -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, ...);
diff --git a/parser.y b/parser.y
index f9df9531..6df8fe17 100644
--- a/parser.y
+++ b/parser.y
@@ -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