Fixes and improvements wrt pexprs

implementations/racket/preserves/preserves/block-write.rkt

@@ -37,8 +37,8 @@
        (emit* v e indent mode)
        (loop vs #t)])))
 
-(define (emit-vertical vs sep ter e indent mode)
-  (display indent (emitter-port e))
+(define (emit-vertical print-indent-if-vertical? vs sep ter e indent mode)
+  (when print-indent-if-vertical? (display indent (emitter-port e)))
   (emit-seq vs (string-append (trim-delimiter sep) indent) (trim-delimiter ter) e indent mode))
 
 (define (trim-delimiter s)
@@ -49,15 +49,21 @@
    (lambda (p)
      (emit-seq vs sep ter (emitter p (emitter-indentation e)) indent 'never))))
 
-(define (emit-separated vs sep ter e indent mode)
+(define (emit-separated print-indent-if-vertical? vs sep ter e indent mode)
   (match mode
     ['never (emit-seq vs sep ter e indent mode) #f]
     ['variable (let ((s (try-horizontal vs sep ter e indent mode)))
                  (if (> (string-length s) (pretty-print-columns))
-                     (begin (emit-vertical vs sep ter e indent mode) #t)
+                     (begin (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) #t)
                      (begin (display s (emitter-port e)) #f)))]
-    ['always (emit-vertical vs sep ter e indent mode) #t]
-    ['extra-newline (emit-vertical vs (and sep (string-append sep "\n")) ter e indent mode) #t]))
+    ['always (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) #t]
+    ['extra-newline (emit-vertical print-indent-if-vertical?
+                                   vs
+                                   (and sep (string-append sep "\n"))
+                                   ter
+                                   e
+                                   indent
+                                   mode) #t]))
 
 (define (emit* v e indent mode)
   (define (w v) (emit* v e indent mode))
@@ -66,10 +72,10 @@
     [(? list? vs) (map w vs)]
     [(grouped vs sep ter op cl)
      (display op (emitter-port e))
-     (when (emit-separated vs sep ter e (string-append indent (emitter-indentation e)) mode)
+     (when (emit-separated #t vs sep ter e (string-append indent (emitter-indentation e)) mode)
        (display indent (emitter-port e)))
      (display cl (emitter-port e))]
-    [(separated vs sep ter) (emit-separated vs sep ter e indent mode)]
+    [(separated vs sep ter) (emit-separated #f vs sep ter e indent mode)]
     [(vertical-mode new-mode v) (emit* v e indent new-mode)]))
 
 (define (emit v [o (current-output-port)]

implementations/racket/preserves/preserves/main.rkt

@@ -21,7 +21,8 @@
          port->preserves
          file->preserves
          port->pexprs
-         file->pexprs)
+         file->pexprs
+         string->pexprs)
 
 (require racket/dict)
 (require racket/match)
@@ -115,3 +116,12 @@
   (if read-syntax?
       vs
       (remove-trailer vs)))
+
+(define (string->pexprs s
+                        #:read-syntax? [read-syntax? #f]
+                        #:decode-embedded [decode-embedded #f]
+                        #:source [source "<string>"])
+  (port->pexprs (open-input-string s)
+                #:read-syntax? read-syntax?
+                #:decode-embedded decode-embedded
+                #:source source))

implementations/racket/preserves/preserves/pexprs.rkt

@@ -6,6 +6,8 @@
          pexpr->preserve
          preserve->pexpr
 
+         write-pexpr
+
          COMMA
          SEMICOLON
          TRAILER-ANCHOR
@@ -234,19 +236,29 @@
                      #:write-annotations? [write-annotations? #t])
   (local-require "block-write.rkt")
   (local-require "write-text.rkt")
-  (define block
-    (let walk ((v v0))
-      (match v
-        [(? list? ps) (grouped (map walk ps) " " "" "[" "]")]
-        [(RECORD ps ...) (grouped (map walk ps) " " "" "<" ">")]
-        [(GROUP ps ...) (grouped (map walk ps) " " "" "(" ")")]
-        [(BLOCK ps ...) (grouped (map walk ps) " " "" "{" "}")]
-        [(SET ps ...) (grouped (map walk ps) " " "" "#{" "}")]
-        [(embedded v) (list "#!" (walk (encode-embedded0 v)))]
-        [(annotated as _loc v)
-         (if write-annotations?
-             (separated (append (map (lambda (a) (list "@" (walk a))) as) v) " " "")
-             (walk v))]
-        [(strip-annotations (record 'p (list s))) (symbol->string s)]
-        [v (preserve->string v)])))
-  (emit block o #:indentation indent-amount0))
+
+  (define (convert-inner vs)
+    (map convert vs))
+
+  (define (convert v)
+    (match v
+      [(annotated as _loc v)
+       (if (and (pair? as) write-annotations?)
+           (separated (append (map (lambda (a) (list "@" (convert a))) as)
+                              (match v
+                                [(TRAILER-ANCHOR) '()]
+                                [_ (list (convert v))]))
+                      " "
+                      "")
+           (convert v))]
+      [(? list? ps) (grouped (convert-inner ps) " " "" "[" "]")]
+      [(RECORD ps ...) (grouped (convert-inner ps) " " "" "<" ">")]
+      [(GROUP ps ...) (grouped (convert-inner ps) " " "" "(" ")")]
+      [(BLOCK ps ...) (grouped (convert-inner ps) " " "" "{" "}")]
+      [(SET ps ...) (grouped (convert-inner ps) " " "" "#{" "}")]
+      [(TRAILER-ANCHOR) ""]
+      [(embedded v) (list "#!" (convert (encode-embedded0 v)))]
+      [(strip-annotations (record 'p (list s))) (symbol->string s)]
+      [v (preserve->string v)]))
+
+  (emit (convert v0) o #:indentation indent-amount0))

implementations/racket/preserves/preserves/read-text-generic.rkt

@@ -268,8 +268,8 @@
   (define (read-comment-line)
     (define pos0 (pos))
     (let loop ((acc '()))
-      (match (next-char*)
-        [(or #\newline #\return)
+      (match (read-char in-port)
+        [(or (? eof-object?) #\newline #\return)
          (wrap pos0 (list->string (reverse acc)))]
         [c (loop (cons c acc))])))