diff --git a/implementations/racket/preserves/preserves/block-write.rkt b/implementations/racket/preserves/preserves/block-write.rkt index fa94c52..0500c99 100644 --- a/implementations/racket/preserves/preserves/block-write.rkt +++ b/implementations/racket/preserves/preserves/block-write.rkt @@ -82,5 +82,6 @@ #:mode [initial-mode 'variable] #:indentation [indentation0 " "] #:initial-indent [initial-indent "\n"]) + ;; (local-require racket/pretty) (pretty-write v) (define indentation (if (number? indentation0) (make-string indentation0 #\space) indentation0)) (emit* v (emitter o indentation) initial-indent initial-mode)) diff --git a/implementations/racket/preserves/preserves/pexprs.rkt b/implementations/racket/preserves/preserves/pexprs.rkt index 0be4399..ff14356 100644 --- a/implementations/racket/preserves/preserves/pexprs.rkt +++ b/implementations/racket/preserves/preserves/pexprs.rkt @@ -236,9 +236,30 @@ #:write-annotations? [write-annotations? #t]) (local-require "block-write.rkt") (local-require "write-text.rkt") + (local-require (only-in racket/string string-prefix?)) (define (convert-inner vs) - (map convert vs)) + (define (finish-span span spans) + (if (null? span) + spans + (cons (reverse span) spans))) + (define (colons? s) + (string-prefix? s ":")) + (define (starts-with-delimiter? s) + (and (not (zero? (string-length s))) + (preserves-delimiter? (string-ref s 0)))) + (let loop ((es (map convert vs)) (spans '()) (span '())) + (match es + ['() (reverse (finish-span span spans))] + [(cons ";" more) (loop more (finish-span (cons ";" span) spans) '())] + [(cons "," more) (loop more (finish-span (cons "," span) spans) '())] + [(cons ":" more) (loop more spans (cons ":" span))] + [(cons (? string? (? colons? s)) (cons (? string? (? colons? e)) more)) + (loop (cons e more) spans (cons " " (cons s span)))] + [(cons (? string? (? starts-with-delimiter? s)) more) (loop more spans (cons s span))] + [(cons (? string? s) more) (loop more spans (cons s (if (null? span) '() (cons " " span))))] + [(cons (? separated? e) more) (loop more (finish-span span spans) (list e))] + [(cons e more) (loop more spans (cons e span))]))) (define (convert v) (match v diff --git a/implementations/racket/preserves/preserves/read-text-generic.rkt b/implementations/racket/preserves/preserves/read-text-generic.rkt index 7e031ad..c7d18bf 100644 --- a/implementations/racket/preserves/preserves/read-text-generic.rkt +++ b/implementations/racket/preserves/preserves/read-text-generic.rkt @@ -6,7 +6,8 @@ parse-error skip-whitespace skip-whitespace/commas - eof-guard) + eof-guard + preserves-delimiter?) (require racket/match) (require "embedded.rkt") @@ -58,6 +59,13 @@ (define (next-char reader-name in-port source) (eof-guard reader-name in-port source (read-char in-port))) +(define (preserves-delimiter? c) + (or (eof-object? c) + (char-whitespace? c) + (eqv? c PIPE) + (memv c '(#\< #\> #\[ #\] #\{ #\} #\( #\) + #\# #\: #\" #\@ #\; #\,)))) + (define-match-expander px (syntax-rules () [(_ re pat) (app (lambda (v) (regexp-try-match re v)) pat)])) @@ -277,12 +285,7 @@ ;; "Raw" symbols and numbers (define (delimiter-follows?) - (define c (peek-char in-port)) - (or (eof-object? c) - (char-whitespace? c) - (eqv? c PIPE) - (memv c '(#\< #\> #\[ #\] #\{ #\} #\( #\) - #\# #\: #\" #\@ #\; #\,)))) + (preserves-delimiter? (peek-char in-port))) (define (read-raw-symbol-or-number acc) (if (delimiter-follows?)