diff --git a/.fmt.rkt b/.fmt.rkt index 0dae5e3..df2dc63 100644 --- a/.fmt.rkt +++ b/.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])) diff --git a/conventions.rkt b/conventions.rkt index fad4ee6..7e15903 100644 --- a/conventions.rkt +++ b/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] diff --git a/record.rkt b/record.rkt new file mode 100644 index 0000000..d07457a --- /dev/null +++ b/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 ...])))) diff --git a/scribblings/fmt.scrbl b/scribblings/fmt.scrbl index 1310bba..0e6a43c 100644 --- a/scribblings/fmt.scrbl +++ b/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. } diff --git a/scribblings/kws.rkt b/scribblings/kws.rkt new file mode 100644 index 0000000..700b375 --- /dev/null +++ b/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