galaxy brain: use pretty printer to print the doc

.fmt.rkt

@@ -6,5 +6,6 @@
 (define (the-formatter-map s)
   (case s
     [("match/extract") (format-uniform-body/helper 4 #:body-formatter (format-clause-2/indirect))]
-    [("define-pretty") (format-define)]
+    [("define-pretty") (standard-formatter-map "define")]
+    [("define/record") (format-uniform-body/helper 3)]
     [else #f]))

conventions.rkt

@@ -21,14 +21,17 @@
 
          syntax-parse-pattern-directive-kw-map
          syntax-parse-parse-option-kw-map
-         default-kw-map)
+         default-kw-map
+
+         all-kws)
 
 (require racket/match
          racket/list
          pprint-compact
          "core.rkt"
          "common.rkt"
-         "params.rkt")
+         "params.rkt"
+         "record.rkt")
 
 (define (default-kw-map _s _xs) 1)
 
@@ -286,7 +289,7 @@
     [([_ #t] [_ #t] [(? atom?) #f]) ((format-uniform-body/helper 3 #:require-body? #f) doc)]
     [#:else ((format-uniform-body/helper 2 #:require-body? #f) doc)]))
 
-(define (standard-formatter-map name)
+(define/record (standard-formatter-map name) #:record all-kws
   (case name
     [("if") format-if]
     [("provide" "require" "import" "export" "link" "rename") format-require]

record.rkt

@@ -0,0 +1,16 @@
+#lang racket/base
+
+(provide define/record)
+(require syntax/parse/define
+         (for-syntax racket/base))
+
+(define-syntax-parse-rule (define/record head #:record x:id
+                            ({~literal case} e
+                                             [(s ...) body ...] ...
+                                             [{~literal else} else-body ...]))
+  (begin
+    (define x (list {~@ s ...} ...))
+    (define head
+      (case e
+        [(s ...) body ...] ...
+        [else else-body ...]))))

scribblings/fmt.scrbl

@@ -2,6 +2,7 @@
 @require[scribble/bnf
          scribble/example
          "util.rkt"
+         "kws.rkt"
          @for-label[racket/base
                     racket/string
                     racket/contract
@@ -110,40 +111,11 @@ which means the @tech{formatter map} wants to let other fallback
   A @tech{formatter map} that does not handle any form.
 }
 
-
 @defthing[standard-formatter-map formatter-map/c]{
   The fallback @tech{formatter map}. It defines format styles for the following forms:
-  @racketblock[
-    'lambda 'λ 'case-lambda
-    'define 'define-values
-    'define-for-syntax 'define-values-for-syntax
-    'define-syntax 'define-syntaxes
-    'define-syntax-parameter
-    'define-syntax-parse-rule 'define-simple-macro
-    'define-syntax-parser
-    'match-define 'match-define-values
-    'let 'let-values 'let*-values 'letrec 'letrec-values
-    'let-syntax 'letrec-syntax 'let-syntaxes 'letrec-syntaxes
-    'letrec-syntaxes+values
-    'with-syntax 'with-syntax*
-    'shared
-    'parameterize 'parameterize* 'syntax-parameterize
-    'if 'cond 'when 'unless 'case
-    'match 'match*
-    'begin 'begin0 'begin-for-syntax
-    'syntax-parse 'syntax-parser
-    'syntax-rules 'syntax-case
-    'define-syntax-rule
-    'match 'match*
-    'syntax/loc 'quasisyntax/loc
-    'module 'module* 'module+
-    'provide 'require
-    'for 'for/fold 'for/list 'for/vector 'for/hash 'for/hasheq 'for/hasheqv
-    'for* 'for*/fold 'for*/list 'for*/vector 'for*/hash 'for*/hasheq 'for*/hasheqv
-    'struct 'define-struct
-    'import 'export 'link 'rename
-    'class 'instantiate 'public 'private 'override 'inherit 'field 'init
-  ]
+
+  @(verbatim (get-kws))
+
   For other forms, it uses the function application style.
 }
 

scribblings/kws.rkt

@@ -0,0 +1,24 @@
+#lang racket/base
+
+(provide get-kws)
+
+(require racket/match
+         pprint-compact
+         (only-in fmt/conventions all-kws))
+
+(define (flow xs)
+  (match xs
+    ['() empty-doc]
+    [(cons x xs)
+     (let loop ([xs xs] [acc (text x)])
+       (match xs
+         ['() acc]
+         [(list x xs ...)
+          (define elem (text x))
+          (loop xs
+                (alt (v-append acc elem)
+                     (hs-append acc elem)))]))]))
+
+(define (get-kws)
+  (define xs (sort all-kws string<?))
+  (pretty-format (flow xs) #:width 64))