Merge pull request #1446 from AlexKnauth/cdot-left-assoc

make cdot reader left associative

pkgs/racket-doc/scribblings/reference/reader.scrbl

@@ -955,13 +955,19 @@ equivalent prefix as discussed in @secref["parse-number"]. If these
 numbers are followed by a @litchar{.} intended to be read as a C-style
 infix dot, then there must be separating whitespace.
 
-Finally, after reading any value, @racket[_x], the reader will seek
+Finally, after reading any datum @racket[_x], the reader will seek
-over whitespace until it reaches a non-whitespace character. If the
+through whitespace and look for zero or more sequences of a
-character is not @litchar{.}, then the value, @racket[_x], is returned
+@litchar{.} followed by another datum @racket[_y]. It will then group
-as usual. If the character is @litchar{.}, then another value,
+@racket[_x] and @racket[_y] together in a @racket[#%dot] form so that
-@racket[_y], is read and the result @racket[(list '#%dot _x _y)] is
+@racket[_x.y] reads equal to @racket[(#%dot _x _y)].
-returned. In @racket[read-syntax] mode, the @racket['#%dot] symbol has
+
-the source location information of the @litchar{.} character and the
+If @racket[_x.y] has another @litchar{.} after it, the reader will
+accumulate more @litchar{.}-separated datums, grouping them from
+left-to-right. For example, @racket[_x.y.z] reads equal to
+@racket[(#%dot (#%dot _x _y) _z)].
+
+In @racket[read-syntax] mode, the @racket[#%dot] symbol has the
+source location information of the @litchar{.} character and the
 entire list has the source location information spanning from the
 start of @racket[_x] to the end of @racket[_y].
 

pkgs/racket-test-core/tests/racket/read.rktl

@@ -1241,6 +1241,27 @@
   (test 9t0 readstr "#o11.0t0")
   (test 17t0 readstr "#x11.0t0"))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; read-cdot
+
+(parameterize ([read-cdot #true])
+  (test '(#%dot a b)                     readstr "a.b")
+  (test '(#%dot (#%dot a b) c)           readstr "a.b.c")
+  (test '(#%dot (#%dot (#%dot a b) c) d) readstr "a.b.c.d")
+  (test '(#%dot a (#%dot b c))           readstr "a.(#%dot b c)")
+  (test '(#%dot a (m b c))               readstr "a.(m b c)")
+  (test '(#%dot (#%dot a (m b c)) (n d e)) readstr "a.(m b c).(n d e)")
+  (test '(#%dot (#%dot (#%dot (#%dot (#%dot a (m b c)) x) (n d e)) y) z)
+        readstr "a.(m b c).x.(n d e).y.z")
+  (test '(#%dot (f a) b)                     readstr "(f a).b")
+  (test '(#%dot (#%dot (f a) b) c)           readstr "(f a).b.c")
+  (test '(#%dot (#%dot (#%dot (f a) b) c) d) readstr "(f a).b.c.d")
+  (test '(#%dot (f a) (#%dot b c))           readstr "(f a).(#%dot b c)")
+  (test '(#%dot (f a) (m b c))               readstr "(f a).(m b c)")
+  (test '(#%dot (#%dot (f a) (m b c)) (n d e)) readstr "(f a).(m b c).(n d e)")
+  (test '(#%dot (#%dot (#%dot (#%dot (#%dot (f a) (m b c)) x) (n d e)) y) z)
+        readstr "(f a).(m b c).x.(n d e).y.z"))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; srcloc->string
 

racket/src/racket/src/read.c

@@ -2035,40 +2035,49 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
 
   if (!read_cdot) { return ret; }
 
-  found_dot = 0;
+  // read in zero or more . sequences in a left-associative way
-  while ( 1 ) {    
+  // X.Y should be read as (#%dot X Y)
-    next = scheme_peekc_special_ok(port);
+  // X.Y.Z should be read as (#%dot (#%dot X Y) Z)
-    if ( next == EOF ) { break; }
+  while ( 1 ) {
-    if ( (table && readtable_kind(table, next, params) & READTABLE_WHITESPACE)
+    found_dot = 0;
-         || (!table && scheme_isspace(next)) ) {
+    while ( 1 ) {    
-      scheme_getc_special_ok(port); continue; }
+      next = scheme_peekc_special_ok(port);
-    if ( (table && readtable_effective_char(table, next) == '.')
+      if ( next == EOF ) { break; }
-         || (!table && next == '.') ) {
+      if ( (table && readtable_kind(table, next, params) & READTABLE_WHITESPACE)
-      scheme_getc_special_ok(port); found_dot = 1; break; }
+           || (!table && scheme_isspace(next)) ) {
-    break;
+        scheme_getc_special_ok(port); continue; }
-  }
+      if ( (table && readtable_effective_char(table, next) == '.')
+           || (!table && next == '.') ) {
+        scheme_getc_special_ok(port); found_dot = 1; break; }
+      break;
+    }
 
-  if ( found_dot ) {
+    if ( !found_dot ) {
-    Scheme_Object *dot, *next;
+      return ret;
-    scheme_tell_all(port, &dline, &dcol, &dpos);
-    dot = dot_symbol;
-    if (stxsrc) {
-      dot = scheme_make_stx_w_offset(dot, dline, dcol, dpos, SPAN(port,dpos), stxsrc, STX_SRCTAG);
-    }
-    next = read_inner_inner(port, stxsrc, ht, indentation, params, comment_mode, pre_char, table, get_info);
-    if (SCHEME_EOFP(next)) {
-      scheme_read_err(port, stxsrc, dline, dcol, dpos, 1, EOF, indentation, 
-                      "read: expected a datum after cdot, found end-of-file");
-      return NULL;
     } else {
-      ret = scheme_make_pair( dot, scheme_make_pair( ret, scheme_make_pair( next, scheme_null ) ) );
+      Scheme_Object *dot, *next;
-    }
+      
-    if (stxsrc) {
+      scheme_tell_all(port, &dline, &dcol, &dpos);
-      ret = scheme_make_stx_w_offset(ret, rline, rcol, rpos, SPAN(port,rpos), stxsrc, STX_SRCTAG);
+      dot = dot_symbol;
+      if (stxsrc) {
+        dot = scheme_make_stx_w_offset(dot, dline, dcol, dpos, SPAN(port,dpos), stxsrc, STX_SRCTAG);
+      }
+      next = read_inner_inner_inner(port, stxsrc, ht, indentation, params, comment_mode, pre_char, table, get_info);
+      if (SCHEME_EOFP(next)) {
+        scheme_read_err(port, stxsrc, dline, dcol, dpos, 1, EOF, indentation, 
+                        "read: expected a datum after cdot, found end-of-file");
+        return NULL;
+      } else {
+        ret = scheme_make_pair( dot, scheme_make_pair( ret, scheme_make_pair( next, scheme_null ) ) );
+      }
+      if (stxsrc) {
+        ret = scheme_make_stx_w_offset(ret, rline, rcol, rpos, SPAN(port,rpos), stxsrc, STX_SRCTAG);
+      }
     }
+    
+    // look for more dots after this
+    continue;
   }
-  
-  return ret;
 }
 
 static Scheme_Object *