Fixes and improvements wrt pexprs
This commit is contained in:
parent
782cbd73b2
commit
831f15099d
|
@ -37,8 +37,8 @@
|
||||||
(emit* v e indent mode)
|
(emit* v e indent mode)
|
||||||
(loop vs #t)])))
|
(loop vs #t)])))
|
||||||
|
|
||||||
(define (emit-vertical vs sep ter e indent mode)
|
(define (emit-vertical print-indent-if-vertical? vs sep ter e indent mode)
|
||||||
(display indent (emitter-port e))
|
(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))
|
(emit-seq vs (string-append (trim-delimiter sep) indent) (trim-delimiter ter) e indent mode))
|
||||||
|
|
||||||
(define (trim-delimiter s)
|
(define (trim-delimiter s)
|
||||||
|
@ -49,15 +49,21 @@
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(emit-seq vs sep ter (emitter p (emitter-indentation e)) indent 'never))))
|
(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
|
(match mode
|
||||||
['never (emit-seq vs sep ter e indent mode) #f]
|
['never (emit-seq vs sep ter e indent mode) #f]
|
||||||
['variable (let ((s (try-horizontal vs sep ter e indent mode)))
|
['variable (let ((s (try-horizontal vs sep ter e indent mode)))
|
||||||
(if (> (string-length s) (pretty-print-columns))
|
(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)))]
|
(begin (display s (emitter-port e)) #f)))]
|
||||||
['always (emit-vertical vs sep ter e indent mode) #t]
|
['always (emit-vertical print-indent-if-vertical? vs sep ter e indent mode) #t]
|
||||||
['extra-newline (emit-vertical vs (and sep (string-append sep "\n")) 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 (emit* v e indent mode)
|
||||||
(define (w v) (emit* v e indent mode))
|
(define (w v) (emit* v e indent mode))
|
||||||
|
@ -66,10 +72,10 @@
|
||||||
[(? list? vs) (map w vs)]
|
[(? list? vs) (map w vs)]
|
||||||
[(grouped vs sep ter op cl)
|
[(grouped vs sep ter op cl)
|
||||||
(display op (emitter-port e))
|
(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 indent (emitter-port e)))
|
||||||
(display cl (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)]))
|
[(vertical-mode new-mode v) (emit* v e indent new-mode)]))
|
||||||
|
|
||||||
(define (emit v [o (current-output-port)]
|
(define (emit v [o (current-output-port)]
|
||||||
|
|
|
@ -21,7 +21,8 @@
|
||||||
port->preserves
|
port->preserves
|
||||||
file->preserves
|
file->preserves
|
||||||
port->pexprs
|
port->pexprs
|
||||||
file->pexprs)
|
file->pexprs
|
||||||
|
string->pexprs)
|
||||||
|
|
||||||
(require racket/dict)
|
(require racket/dict)
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
|
@ -115,3 +116,12 @@
|
||||||
(if read-syntax?
|
(if read-syntax?
|
||||||
vs
|
vs
|
||||||
(remove-trailer 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))
|
||||||
|
|
|
@ -6,6 +6,8 @@
|
||||||
pexpr->preserve
|
pexpr->preserve
|
||||||
preserve->pexpr
|
preserve->pexpr
|
||||||
|
|
||||||
|
write-pexpr
|
||||||
|
|
||||||
COMMA
|
COMMA
|
||||||
SEMICOLON
|
SEMICOLON
|
||||||
TRAILER-ANCHOR
|
TRAILER-ANCHOR
|
||||||
|
@ -234,19 +236,29 @@
|
||||||
#:write-annotations? [write-annotations? #t])
|
#:write-annotations? [write-annotations? #t])
|
||||||
(local-require "block-write.rkt")
|
(local-require "block-write.rkt")
|
||||||
(local-require "write-text.rkt")
|
(local-require "write-text.rkt")
|
||||||
(define block
|
|
||||||
(let walk ((v v0))
|
(define (convert-inner vs)
|
||||||
(match v
|
(map convert vs))
|
||||||
[(? list? ps) (grouped (map walk ps) " " "" "[" "]")]
|
|
||||||
[(RECORD ps ...) (grouped (map walk ps) " " "" "<" ">")]
|
(define (convert v)
|
||||||
[(GROUP ps ...) (grouped (map walk ps) " " "" "(" ")")]
|
(match v
|
||||||
[(BLOCK ps ...) (grouped (map walk ps) " " "" "{" "}")]
|
[(annotated as _loc v)
|
||||||
[(SET ps ...) (grouped (map walk ps) " " "" "#{" "}")]
|
(if (and (pair? as) write-annotations?)
|
||||||
[(embedded v) (list "#!" (walk (encode-embedded0 v)))]
|
(separated (append (map (lambda (a) (list "@" (convert a))) as)
|
||||||
[(annotated as _loc v)
|
(match v
|
||||||
(if write-annotations?
|
[(TRAILER-ANCHOR) '()]
|
||||||
(separated (append (map (lambda (a) (list "@" (walk a))) as) v) " " "")
|
[_ (list (convert v))]))
|
||||||
(walk v))]
|
" "
|
||||||
[(strip-annotations (record 'p (list s))) (symbol->string s)]
|
"")
|
||||||
[v (preserve->string v)])))
|
(convert v))]
|
||||||
(emit block o #:indentation indent-amount0))
|
[(? 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))
|
||||||
|
|
|
@ -268,8 +268,8 @@
|
||||||
(define (read-comment-line)
|
(define (read-comment-line)
|
||||||
(define pos0 (pos))
|
(define pos0 (pos))
|
||||||
(let loop ((acc '()))
|
(let loop ((acc '()))
|
||||||
(match (next-char*)
|
(match (read-char in-port)
|
||||||
[(or #\newline #\return)
|
[(or (? eof-object?) #\newline #\return)
|
||||||
(wrap pos0 (list->string (reverse acc)))]
|
(wrap pos0 (list->string (reverse acc)))]
|
||||||
[c (loop (cons c acc))])))
|
[c (loop (cons c acc))])))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue