diff --git a/implementations/racket/preserves/preserves/block-write.rkt b/implementations/racket/preserves/preserves/block-write.rkt new file mode 100644 index 0000000..bb8f754 --- /dev/null +++ b/implementations/racket/preserves/preserves/block-write.rkt @@ -0,0 +1,80 @@ +#lang racket/base + +(provide emit + (struct-out vertical-mode) + (struct-out separated) + (struct-out grouped)) + +(require racket/match) +(require (only-in racket/string string-trim)) +(require (only-in racket/pretty pretty-print-columns)) +(require (only-in racket/port call-with-output-string)) + +;; mode ∈ {'never, 'variable, 'always, 'extra-newline} +;; +;; Things that don't know how to write themselves vertically always write horizontally. +;; Otherwise, mode is relevant: +;; +;; - 'never: always horizontally +;; - 'variable: horizontally, unless it doesn't fit, in which case vertically +;; - 'always: always vertically +;; - 'extra-newline: as 'normal, but with extra newlines separating items +;; +(struct vertical-mode (mode item) #:transparent) + +(struct separated (items separator terminator) #:transparent) +(struct grouped separated (opener closer) #:transparent) + +(struct emitter (port indentation) #:transparent) + +(define (emit-seq vs sep ter e indent mode) + (let loop ((vs vs) (need-sep #f)) + (match vs + ['() + (when need-sep (display ter (emitter-port e)))] + [(cons v vs) + (when need-sep (display sep (emitter-port e))) + (emit* v e indent mode) + (loop vs #t)]))) + +(define (emit-vertical vs sep ter e indent mode) + (display indent (emitter-port e)) + (emit-seq vs (string-append (trim-delimiter sep) indent) (trim-delimiter ter) e indent mode)) + +(define (trim-delimiter s) + (string-trim #:left? #f s #px"[ \t\f\v]+")) + +(define (try-horizontal vs sep ter e indent mode) + (call-with-output-string + (lambda (p) + (emit-seq vs sep ter (emitter p (emitter-indentation e)) indent 'never)))) + +(define (emit-separated 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 (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])) + +(define (emit* v e indent mode) + (define (w v) (emit* v e indent mode)) + (match v + [(? string? s) (display s (emitter-port e))] + [(? 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) + (display indent (emitter-port e))) + (display cl (emitter-port e))] + [(separated vs sep ter) (emit-separated vs sep ter e indent mode)] + [(vertical-mode new-mode v) (emit* v e indent new-mode)])) + +(define (emit v [o (current-output-port)] + #:mode [initial-mode 'variable] + #:indentation [indentation0 " "] + #:initial-indent [initial-indent "\n"]) + (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 88dce23..63e4b0c 100644 --- a/implementations/racket/preserves/preserves/pexprs.rkt +++ b/implementations/racket/preserves/preserves/pexprs.rkt @@ -227,3 +227,26 @@ [(embedded v) (map-embedded walk v)] [(annotated as loc v) (annotated (map walk as) loc (walk v))] [v v]))) + +(define (write-pexpr v0 [o (current-output-port)] + #:indent [indent-amount0 4] + #:encode-embedded [encode-embedded0 #f] + #: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)) diff --git a/preserves-expressions.md b/preserves-expressions.md index 31d390f..c89b15d 100644 --- a/preserves-expressions.md +++ b/preserves-expressions.md @@ -61,10 +61,16 @@ in that uses of `Value` are replaced with `SimpleExpr`. Annotation = "@" SimpleExpr / "#" [(%x20 / %x09) linecomment] (CR / LF) linecomment = * -P-expression special punctuation marks are comma, semicolon, and sequences of one or more colons. +P-expression special punctuation marks are comma, semicolon, and +sequences of one or more colons.[^greedy-colons] Punct = "," / ";" / 1*":" +[^greedy-colons]: Colon matching is greedy: when reading, all adjacent + colons are always taken into a single token, and when writing, + adjacent colon-sequence punctuation marks must be written with + whitespace separating them. + Compound expressions are sequences of `Expr`s with optional trailing `Annotation`s, surrounded by various kinds of parentheses.