From 3710864c997c890064337e10456caeccda2eb614 Mon Sep 17 00:00:00 2001 From: Sorawee Porncharoenwase Date: Sun, 13 Aug 2023 14:43:39 -0700 Subject: [PATCH] core: define big-text in terms of reset + hard-nl --- conventions.rkt | 81 ++++++++++++------------ core.rkt | 3 + scribblings/fmt.scrbl | 2 +- tests/test-cases/test-herestring.rkt.out | 3 +- 4 files changed, 48 insertions(+), 41 deletions(-) diff --git a/conventions.rkt b/conventions.rkt index 295cf85..23b80c0 100644 --- a/conventions.rkt +++ b/conventions.rkt @@ -30,8 +30,8 @@ all-kws) (require racket/match - racket/list - (except-in pretty-expressive flatten) + (except-in racket/list flatten) + pretty-expressive "core.rkt" "common.rkt" "params.rkt" @@ -84,7 +84,7 @@ (define dot-formatted (pretty dot)) (define x-formatted (format-body x)) (define another-dot-formatted (pretty another-dot)) - (v-append-if (alt (flat ( dot-formatted x-formatted another-dot-formatted)) + (v-append-if (alt (flatten ( dot-formatted x-formatted another-dot-formatted)) (<$> dot-formatted x-formatted another-dot-formatted)) xs)] [(list (and dot (atom _ "." 'other)) x xs ...) @@ -113,21 +113,22 @@ #:default [format-body pretty] #:default [format-kw-arg pretty] - (flat (let loop ([xs doc]) - (define (h-append-if x xs) - (match xs - ['() x] - [_ ( x (loop xs))])) - - (match xs - ['() empty-doc] - [(list (and kw (atom _ content 'hash-colon-keyword)) xs ...) - ((format-kw-args kw - (kw-map content xs) - (λ (xs docs) (h-append-if (as-concat docs) xs)) - format-kw-arg) - xs)] - [(list x xs ...) (h-append-if (format-body x) xs)])))) + (flatten + (let loop ([xs doc]) + (define (h-append-if x xs) + (match xs + ['() x] + [_ ( x (loop xs))])) + + (match xs + ['() empty-doc] + [(list (and kw (atom _ content 'hash-colon-keyword)) xs ...) + ((format-kw-args kw + (kw-map content xs) + (λ (xs docs) (h-append-if (as-concat docs) xs)) + format-kw-arg) + xs)] + [(list x xs ...) (h-append-if (format-body x) xs)])))) (define-pretty (format-if-like/helper format-else #:expel-first-comment? [expel-first-comment? #t] @@ -137,7 +138,7 @@ [([-if expel-first-comment?] [-conditional #f]) (pretty-node #:unfits unfits #:adjust adjust - (<+s> (flat (pretty -if)) + (<+s> (flatten (pretty -if)) (try-indent #:n 0 #:because-of (cons -conditional tail) ;; multiple lines @@ -147,7 +148,7 @@ (alt ((format-vertical/helper) (cons -conditional tail)) ;; or one line #;(if a b c) - (flat (as-concat (map pretty (cons -conditional tail))))))))] + (flatten (as-concat (map pretty (cons -conditional tail))))))))] [#:else (format-else doc)])) (define-pretty format-#%app @@ -185,7 +186,7 @@ ;; general case (alt ((format-vertical/helper) xs) ;; try to fit in one line - (flat (as-concat (map pretty xs))))))])) + (flatten (as-concat (map pretty xs))))))])) (define-pretty (format-uniform-body/helper n #:arg-formatter [format-arg #f] @@ -205,7 +206,7 @@ ['() (pretty -macro-name)] [_ (define args (map format-arg -e)) - (<+s> (pretty -macro-name) (alt (v-concat args) (flat (as-concat args))))])) + (<+s> (pretty -macro-name) (alt (v-concat args) (flatten (as-concat args))))])) (pretty-node #:unfits unfits (try-indent @@ -240,8 +241,8 @@ #:unfits unfits (try-indent #:n 0 #:because-of (list -something) - (let ([line (<+s> (flat (pretty -head)) (pretty -something))]) - (if flat? (flat line) line))))] + (let ([line (<+s> (flatten (pretty -head)) (pretty -something))]) + (if flat? (flatten line) line))))] [_ fail])] [#:else fail]))] [_ (pretty doc)])) @@ -288,13 +289,14 @@ #:unfits unfits (try-indent #:because-of tail - (flat (match -head - [(? node?) fail] - [_ - (match tail - ['() ( (pretty -define) (format-head -head))] - [(list -e) ( (pretty -define) (format-head -head) (pretty -e))] - [_ fail])])))))] + (flatten + (match -head + [(? node?) fail] + [_ + (match tail + ['() ( (pretty -define) (format-head -head))] + [(list -e) ( (pretty -define) (format-head -head) (pretty -e))] + [_ fail])])))))] [#:else (format-#%app doc)])) ;; try to fit in one line if the body has exactly one form, @@ -319,10 +321,11 @@ #:unfits unfits (try-indent #:because-of tail - (flat (match tail - ['() ( (pretty -define) (format-head -head))] - [(list -e) ( (pretty -define) (format-head -head) (pretty -e))] - [_ fail])))))] + (flatten + (match tail + ['() ( (pretty -define) (format-head -head))] + [(list -e) ( (pretty -define) (format-head -head) (pretty -e))] + [_ fail])))))] [#:else (format-#%app doc)])) ;; this is similar to let*, but because the macro name is so long, @@ -335,9 +338,9 @@ (<> (pretty-node #:unfits unfits (<> (pretty -parameterize) - (alt (cost '(0 0 3) (<> nl (text " ") bindings)) + (alt (cost '(0 0 3) (<> hard-nl (text " ") bindings)) (<> (text " ") bindings)) - nl + hard-nl space (align (try-indent #:because-of tail ((format-vertical/helper) tail))))))] [#:else (format-#%app doc)])) @@ -370,7 +373,7 @@ (match/extract (node-content doc) #:as unfits tail [([-provide #t] [-first-arg #f]) (pretty-node #:unfits unfits - (<+s> (flat (pretty -provide)) + (<+s> (flatten (pretty -provide)) (try-indent #:n 0 #:because-of (cons -first-arg tail) ((format-vertical/helper) (cons -first-arg tail)))))] @@ -425,7 +428,7 @@ (define first-line (<+s> (pretty -for-name) - (<$> kwds (alt (v-concat groups) (flat (as-concat groups)))))) + (<$> kwds (alt (v-concat groups) (flatten (as-concat groups)))))) (pretty-node #:unfits unfits (try-indent #:because-of (list* -for-name -kwd tail) (<$> first-line body)))] [#:else ((format-uniform-body/helper n #:arg-formatter format-binding-pairs/indirect) doc)])) diff --git a/core.rkt b/core.rkt index 99c14b8..f05cbf8 100644 --- a/core.rkt +++ b/core.rkt @@ -49,6 +49,9 @@ (define table (backend)) (λ (x) (hash-ref! table x (λ () (f x))))) +(define (big-text s) + (reset (u-concat (add-between (map text (string-split s "\n")) hard-nl)))) + (define (pretty-doc xs hook) (define loop (memoize (λ (d) diff --git a/scribblings/fmt.scrbl b/scribblings/fmt.scrbl index e7196ed..2d11e27 100644 --- a/scribblings/fmt.scrbl +++ b/scribblings/fmt.scrbl @@ -4,7 +4,7 @@ "util.rkt" "kws.rkt" (only-in fmt/conventions all-kws) - @for-label[racket/base + @for-label[(except-in racket/base newline) racket/string racket/contract fmt diff --git a/tests/test-cases/test-herestring.rkt.out b/tests/test-cases/test-herestring.rkt.out index e052811..be4aeec 100644 --- a/tests/test-cases/test-herestring.rkt.out +++ b/tests/test-cases/test-herestring.rkt.out @@ -1,6 +1,7 @@ #lang racket -(define x #<