Skip to content

Commit

Permalink
fix sorawee#21
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorawee
sorawee committed Oct 19, 2021
1 parent fa3bd85 commit e6b7e3d
Show file tree
Hide file tree
Showing 5 changed files with 58 additions and 43 deletions.
45 changes: 24 additions & 21 deletions conventions.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,41 +49,44 @@
#:type list?
#:default [format-body pretty]
#:default [format-kw-arg pretty]

(let loop ([xs doc])
(define (v-append-if x xs)
(match xs
['() x]
[_ (v-append x (loop xs))]))

(match xs
['() empty-doc]
[(list x) (format-body x)]
[(list (and dot (atom _ "." 'other)) x (and another-dot (atom _ "." 'other)) xs ...)
(v-append-if (alt (hs-append (pretty dot) (format-body x) (pretty another-dot))
(v-append (pretty dot) (format-body x) (pretty another-dot)))
xs)]
[(list (and dot (atom _ "." 'other)) x xs ...)
(v-append-if
(alt (hs-append (pretty dot) (format-body x)) (v-append (pretty dot) (format-body x)))
xs)]
[(list x (and ellipsis (atom _ (? (current-ellipsis?)) 'symbol)) xs ...)
(define doc
(alt (hs-append (format-body x) (pretty ellipsis))
(v-append (format-body x) (pretty ellipsis))))
(match xs
['() doc]
[_ (v-append doc (loop xs))])]
(v-append-if (alt (hs-append (format-body x) (pretty ellipsis))
(v-append (format-body x) (pretty ellipsis)))
xs)]
[(list (and kw (atom _ content 'hash-colon-keyword)) xs ...)
(define (fallback)
(match xs
['() (pretty kw)]
[_ (v-append (pretty kw) (loop xs))]))
(define pos (kw-map content xs))
(cond
[(zero? pos) (fallback)]
[(zero? pos) (v-append-if (pretty kw) xs)]
[else
(define count (for/last ([i (in-range pos)] [_x (in-list xs)]) i))
(cond
[(= (or count -1) (sub1 pos))
(define-values (front back) (split-at xs pos))
(cond
[(andmap visible? front)
(define doc
(alt (hs-append (pretty kw) (hs-concat (map format-kw-arg front)))
(v-append (pretty kw) (v-concat (map format-kw-arg front)))))
(match back
['() doc]
[_ (v-append doc (loop back))])]
[else (fallback)])]
[else (fallback)])])]
[(list x xs ...) (v-append (format-body x) (loop xs))])))
(v-append-if (alt (hs-append (pretty kw) (hs-concat (map format-kw-arg front)))
(v-append (pretty kw) (v-concat (map format-kw-arg front))))
back)]
[else (v-append-if (pretty kw) xs)])]
[else (v-append-if (pretty kw) xs)])])]
[(list x xs ...) (v-append-if (format-body x) xs)])))

(define-pretty (format-if-like/helper format-else)
#:type node?
Expand Down
3 changes: 1 addition & 2 deletions core.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,7 +124,6 @@
[(list (list pat ...) unfits tail)
body ...]
[_ (match/extract -xs #:as unfits tail
.
rst)]))]
. rst)]))]
[(_ xs #:as unfits tail [#:else body ...+]) #'(let ()
body ...)])
30 changes: 10 additions & 20 deletions tests/large.rkt.out
View file
Original file line number Diff line number Diff line change
Expand Up @@ -417,8 +417,7 @@
define-syntaxes
define-values)
[(begin
.
_)
. _)
(loop (append (flatten-begin e) (cdr l)))]
[(define-syntaxes (id ...) rhs)
(andmap identifier? (syntax->list #'(id ...)))
Expand Down Expand Up @@ -597,8 +596,7 @@
(syntax-local-introduce #'case-lam))))
stx)]
[(case-lambda
.
_)
. _)
(bad "ill-formed case-lambda expression for method" stx)]
[(let- ([(id) expr] ...) let-body)
(and (or (free-identifier=? (syntax let-) (quote-syntax let-values))
Expand Down Expand Up @@ -1575,8 +1573,7 @@
(syntax-case stx (rename-inner-extra-orig ...)
[(_ default-expr
rename-inner-extra-orig
.
args)
. args)
(generate-inner-call
stx
(quote-syntax the-finder)
Expand Down Expand Up @@ -1615,8 +1612,7 @@
(list pubment-temp ...
public-final-temp ...
abstract-method ...
.
public-methods)
. public-methods)
(list . override-methods)
(list . augride-methods)
;; Initialization
Expand Down Expand Up @@ -1699,8 +1695,7 @@
(void) ; in case the body is empty
(begin
'(declare-field-use-start) ; see "class-undef.rkt"
.
exprs))))))))))))))
. exprs))))))))))))))
;; Extra argument added here by `detect-field-unsafe-undefined`
#;check-undef?
;; Not primitive:
Expand Down Expand Up @@ -4463,8 +4458,7 @@ An example
#:class-name [class-name #f]
#:intf-name [intf-name #f]
#:which-class [which-class ""]
.
fields)
. fields)
(define all-fields
(append fields
(if class-name (list (string-append which-class "class name") (as-write class-name)) null)
Expand Down Expand Up @@ -4595,12 +4589,10 @@ An example
[(augment-final names ...) (extract-renamed-names (syntax (names ...)))]

[(define/augment (name . names)
.
rest)
. rest)
(extract-renamed-names (syntax (name)))]
[(define/augment name
.
rest)
. rest)
(identifier? (syntax name))
(extract-renamed-names (syntax (name)))]
[(define/augride (name . names) . rest) (extract-renamed-names (syntax (name)))]
Expand All @@ -4612,12 +4604,10 @@ An example
(identifier? (syntax name))
(extract-renamed-names (syntax (name)))]
[(define/override (name . names)
.
rest)
. rest)
(extract-renamed-names (syntax (name)))]
[(define/override name
.
rest)
. rest)
(identifier? (syntax name))
(extract-renamed-names (syntax (name)))]
[(define/overment (name . names) . rest) (extract-renamed-names (syntax (name)))]
Expand Down
6 changes: 6 additions & 0 deletions tests/test-dot.rkt
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
#lang racket

(define-syntax-rule (class x . body)
1)

(integer? integer? integer? integer? integer? integer? integer? integer? integer? integer? . -> . integer?)
17 changes: 17 additions & 0 deletions tests/test-dot.rkt.out
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
#lang racket

(define-syntax-rule (class x
. body)
1)

(integer? integer?
integer?
integer?
integer?
integer?
integer?
integer?
integer?
integer?
. -> .
integer?)

0 comments on commit e6b7e3d

Please sign in to comment.