From f707950256be3d5ab1035c31141bb4264e972c95 Mon Sep 17 00:00:00 2001 From: Sorawee Porncharoenwase Date: Sat, 2 Dec 2023 19:23:19 -0800 Subject: [PATCH] convention: fix header styling for forms like lambda Fixes #48 --- conventions.rkt | 24 ++++++++++-- tests/benchmarks/class-internal.rkt.out | 49 +++++++++++++------------ tests/test-cases/large.rkt.out | 49 +++++++++++++------------ tests/test-cases/test-lambda.rkt | 3 ++ tests/test-cases/test-lambda.rkt.out | 5 +++ 5 files changed, 80 insertions(+), 50 deletions(-) create mode 100644 tests/test-cases/test-lambda.rkt create mode 100644 tests/test-cases/test-lambda.rkt.out diff --git a/conventions.rkt b/conventions.rkt index 23b80c0..3a9e192 100644 --- a/conventions.rkt +++ b/conventions.rkt @@ -261,6 +261,20 @@ ((format-horizontal/helper #:body-formatter (format-clause-2/indirect #:flat? #f)) xs))))] [_ (pretty doc)])) +(define-pretty format-define-args/indirect + #:type values + (match doc + [(node _ _ _ #f #f xs) + (pretty-node + (try-indent + #:n 0 + #:because-of xs + ;; general case + (alt ((format-vertical/helper) xs) + ;; try to fit in one line + ((format-horizontal/helper) xs))))] + [_ (pretty doc)])) + (define format-if (format-if-like/helper format-#%app)) ;; try to fit in one line if the body has exactly one form, @@ -440,16 +454,18 @@ [("pubment" "public-final" "overment" "override-final" "augride" "augment-final") format-require] [("define") (format-define)] - [("define-for-syntax" "define-values") (format-define-like)] + [("define-for-syntax") (format-define-like)] [("define-syntax-rule") (format-define-like)] - [("define-syntax" "define-syntaxes" "define-values-for-syntax") (format-define-like)] + [("define-syntax") (format-define-like)] [("define-syntax-parameter") (format-define-like)] [("define/public" "define/private" "define/override" "define/augment") (format-define-like)] [("define/pubment" "define/augride" "define/overment") (format-define-like)] [("define/public-final" "define/override-final" "define/augment-final") (format-define-like)] - [("λ" "lambda") (format-define-like)] - [("match-define" "match-define-values") (format-define-like)] + [("λ" "lambda") (format-define-like #:head-formatter format-define-args/indirect)] + [("match-define") (format-define-like)] + [("match-define-values" "define-values" "define-syntaxes" "define-values-for-syntax") + (format-define-like #:head-formatter format-define-args/indirect)] [("define/contract") (format-define-like)] diff --git a/tests/benchmarks/class-internal.rkt.out b/tests/benchmarks/class-internal.rkt.out index dad1495..210c63e 100644 --- a/tests/benchmarks/class-internal.rkt.out +++ b/tests/benchmarks/class-internal.rkt.out @@ -1632,11 +1632,12 @@ ;; Attach srcloc (useful for profiling) #, (quasisyntax/loc stx - (lambda (the-obj super-go - si_c - si_inited? - si_leftovers - init-args) + (lambda (the-obj + super-go + si_c + si_inited? + si_leftovers + init-args) (syntax-parameterize ([the-finder (quote-syntax the-obj)]) (syntax-parameterize @@ -1790,15 +1791,16 @@ (class-syntax-protect #'(-define-serializable-class orig-stx name super-expression () defn-or-expr ...)))])) -(define-syntaxes (private* public* - pubment* - override* - overment* - augride* - augment* - public-final* - override-final* - augment-final*) +(define-syntaxes (private* + public* + pubment* + override* + overment* + augride* + augment* + public-final* + override-final* + augment-final*) (let ([mk (lambda (who decl-form) (lambda (stx) (unless (class-top-level-context? (syntax-local-context)) @@ -1836,15 +1838,16 @@ (mk 'override-final* (syntax override-final)) (mk 'augment-final* (syntax augment))))) -(define-syntaxes (define/private define/public - define/pubment - define/override - define/overment - define/augride - define/augment - define/public-final - define/override-final - define/augment-final) +(define-syntaxes (define/private + define/public + define/pubment + define/override + define/overment + define/augride + define/augment + define/public-final + define/override-final + define/augment-final) (let ([mk (lambda (decl-form) (lambda (stx) (unless (class-top-level-context? (syntax-local-context)) diff --git a/tests/test-cases/large.rkt.out b/tests/test-cases/large.rkt.out index acac2ba..8b42a8b 100644 --- a/tests/test-cases/large.rkt.out +++ b/tests/test-cases/large.rkt.out @@ -1627,11 +1627,12 @@ ;; Attach srcloc (useful for profiling) #, (quasisyntax/loc stx - (lambda (the-obj super-go - si_c - si_inited? - si_leftovers - init-args) + (lambda (the-obj + super-go + si_c + si_inited? + si_leftovers + init-args) (syntax-parameterize ([the-finder (quote-syntax the-obj)]) (syntax-parameterize @@ -1785,15 +1786,16 @@ (class-syntax-protect #'(-define-serializable-class orig-stx name super-expression () defn-or-expr ...)))])) -(define-syntaxes (private* public* - pubment* - override* - overment* - augride* - augment* - public-final* - override-final* - augment-final*) +(define-syntaxes (private* + public* + pubment* + override* + overment* + augride* + augment* + public-final* + override-final* + augment-final*) (let ([mk (lambda (who decl-form) (lambda (stx) (unless (class-top-level-context? (syntax-local-context)) @@ -1831,15 +1833,16 @@ (mk 'override-final* (syntax override-final)) (mk 'augment-final* (syntax augment))))) -(define-syntaxes (define/private define/public - define/pubment - define/override - define/overment - define/augride - define/augment - define/public-final - define/override-final - define/augment-final) +(define-syntaxes (define/private + define/public + define/pubment + define/override + define/overment + define/augride + define/augment + define/public-final + define/override-final + define/augment-final) (let ([mk (lambda (decl-form) (lambda (stx) (unless (class-top-level-context? (syntax-local-context)) diff --git a/tests/test-cases/test-lambda.rkt b/tests/test-cases/test-lambda.rkt new file mode 100644 index 0000000..1cc6303 --- /dev/null +++ b/tests/test-cases/test-lambda.rkt @@ -0,0 +1,3 @@ +#lang racket + +(lambda (#:key xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx #:word y) 1) diff --git a/tests/test-cases/test-lambda.rkt.out b/tests/test-cases/test-lambda.rkt.out new file mode 100644 index 0000000..616fa74 --- /dev/null +++ b/tests/test-cases/test-lambda.rkt.out @@ -0,0 +1,5 @@ +#lang racket + +(lambda (#:key xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + #:word y) + 1)