Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Automated Resyntax fixes #494

Open
wants to merge 11 commits into
base: master
Choose a base branch
from
Open

Automated Resyntax fixes #494

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
2ac65f6
Fix 2 occurrences of `always-throwing-if-to-when`
resyntax-ci[bot] Apr 2, 2025
130975d
Fix 2 occurrences of `provide/contract-to-contract-out`
resyntax-ci[bot] Apr 2, 2025
c717a6d
Fix 4 occurrences of `map-to-for`
resyntax-ci[bot] Apr 2, 2025
7a1c24c
Fix 2 occurrences of `let-to-define`
resyntax-ci[bot] Apr 2, 2025
219adcd
Fix 2 occurrences of `for-each-to-for`
resyntax-ci[bot] Apr 2, 2025
6ec20b2
Fix 1 occurrence of `unless-expression-in-for-loop-to-unless-keyword`
resyntax-ci[bot] Apr 2, 2025
e617356
Fix 1 occurrence of `for/fold-result-keyword`
resyntax-ci[bot] Apr 2, 2025
74d5c16
Fix 1 occurrence of `if-begin-to-cond`
resyntax-ci[bot] Apr 2, 2025
325aacd
Fix 2 occurrences of `map-to-for`
resyntax-ci[bot] Apr 2, 2025
8477076
Fix 2 occurrences of `cond-else-if-to-cond`
resyntax-ci[bot] Apr 2, 2025
277fe72
Fix 1 occurrence of `nested-if-to-cond`
resyntax-ci[bot] Apr 2, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 13 additions & 14 deletions scribble-lib/scribble/core.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -348,9 +348,9 @@
(cond
[(collect-info? i)
(define p (hash-ref (collect-info-fp i) b #f))
(if (block? p)
p
(error 'traverse-block-block "no block computed for traverse-block: ~e" b))]
(unless (block? p)
(error 'traverse-block-block "no block computed for traverse-block: ~e" b))
p]
[(resolve-info? i)
(traverse-block-block b (resolve-info-ci i))]))

Expand Down Expand Up @@ -391,9 +391,9 @@
(cond
[(collect-info? i)
(define c (hash-ref (collect-info-fp i) e #f))
(if (content? c)
c
(error 'traverse-block-block "no block computed for traverse-block: ~e" e))]
(unless (content? c)
(error 'traverse-block-block "no block computed for traverse-block: ~e" e))
c]
[(resolve-info? i)
(traverse-element-content e (resolve-info-ci i))]))

Expand Down Expand Up @@ -424,10 +424,10 @@
(or (current-load-relative-directory) (current-directory)))
#:transparent)

(provide/contract
(struct delayed-element ([resolve (any/c part? resolve-info? . -> . content?)]
[sizer (-> any)]
[plain (-> any)])))
(provide (contract-out (struct delayed-element
([resolve (any/c part? resolve-info? . -> . content?)] [sizer (-> any)]
[plain
(-> any)]))))

(module+ deserialize-info
(provide deserialize-delayed-element))
Expand Down Expand Up @@ -473,10 +473,9 @@
(or (current-load-relative-directory) (current-directory)))
#:transparent)

(provide/contract
(struct part-relative-element ([collect (collect-info? . -> . content?)]
[sizer (-> any)]
[plain (-> any)])))
(provide (contract-out (struct part-relative-element
([collect (collect-info? . -> . content?)] [sizer (-> any)]
[plain (-> any)]))))

(module+ deserialize-info
(provide deserialize-part-relative-element))
Expand Down
38 changes: 18 additions & 20 deletions scribble-lib/scribble/markdown-render.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -104,26 +104,24 @@
(displayln "```")]

[else
(define strs (map (lambda (flows)
(map (lambda (d)
(cond
[(eq? d 'cont) d]
[else
(define o (open-output-string))
(parameterize ([current-indent 0]
[current-output-port o])
(render-block d part ht #f))
(regexp-split
#rx"\n"
(regexp-replace #rx"\n$" (get-output-string o) ""))]))
flows))
flowss))
(define widths (map (lambda (col)
(for/fold ([d 0]) ([i (in-list col)])
(if (eq? i 'cont)
0
(apply max d (map string-length i)))))
(apply map list strs)))
(define strs (for/list ([flows (in-list flowss)])
(map
(lambda (d)
(cond
[(eq? d 'cont) d]
[else
(define o (open-output-string))
(parameterize ([current-indent 0]
[current-output-port o])
(render-block d part ht #f))
(regexp-split #rx"\n"
(regexp-replace #rx"\n$" (get-output-string o) ""))]))
flows)))
(define widths (for/list ([col (in-list (apply map list strs))])
(for/fold ([d 0]) ([i (in-list col)])
(if (eq? i 'cont)
0
(apply max d (map string-length i))))))
(define (x-length col)
(if (eq? col 'cont) 0 (length col)))
(for/fold ([indent? #f]) ([row (in-list strs)])
Expand Down
175 changes: 84 additions & 91 deletions scribble-lib/scribble/srcdoc.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -74,18 +74,14 @@
(syntax-local-introduce
(syntax-shift-phase-level s #f)))
(with-syntax ([((req ...) ...)
(map (lambda (rs)
(map (lambda (r)
(syntax-case r ()
[(op arg ...)
(with-syntax ([(arg ...)
(map shift-and-introduce
(for/list ([rs (in-list (reverse requires))])
(for/list ([r (in-list (syntax->list rs))])
(syntax-case r ()
[(op arg ...)
(with-syntax ([(arg ...) (map shift-and-introduce
(syntax->list #'(arg ...)))])
#'(op arg ...))]
[else
(shift-and-introduce r)]))
(syntax->list rs)))
(reverse requires))]
#'(op arg ...))]
[else (shift-and-introduce r)])))]
[(expr ...)
(map shift-and-introduce (reverse doc-exprs))]
[doc-body
Expand Down Expand Up @@ -124,30 +120,19 @@
(define-for-syntax (do-provide/doc stx modes)
(let ([forms (list stx)])
(with-syntax ([((for-provide/contract (req ...) d id) ...)
(map (lambda (form)
(syntax-case form ()
[(id . _)
(identifier? #'id)
(let ([t (syntax-local-value #'id (lambda () #f))])
(unless (provide/doc-transformer? t)
(raise-syntax-error
#f
"not bound as a provide/doc transformer"
stx
#'id))
(let* ([i (make-syntax-introducer)]
[i2 (lambda (x) (syntax-local-introduce (i x)))])
(let-values ([(p/c d req/d id)
((provide/doc-transformer-proc t)
(i (syntax-local-introduce form)))])
(list (i2 p/c) (i req/d) (i d) (i id)))))]
[_
(raise-syntax-error
#f
"not a provide/doc sub-form"
stx
form)]))
forms)])
(for/list ([form (in-list forms)])
(syntax-case form ()
[(id . _)
(identifier? #'id)
(let ([t (syntax-local-value #'id (lambda () #f))])
(unless (provide/doc-transformer? t)
(raise-syntax-error #f "not bound as a provide/doc transformer" stx #'id))
(let* ([i (make-syntax-introducer)]
[i2 (lambda (x) (syntax-local-introduce (i x)))])
(let-values ([(p/c d req/d id) ((provide/doc-transformer-proc t)
(i (syntax-local-introduce form)))])
(list (i2 p/c) (i req/d) (i d) (i id)))))]
[_ (raise-syntax-error #f "not a provide/doc sub-form" stx form)]))])
(with-syntax ([(p/c ...)
(map (lambda (form f)
(if (identifier? f)
Expand Down Expand Up @@ -359,44 +344,52 @@

(let ([build-mandatories/optionals
(λ (names contracts extras)
(let ([names-length (length names)]
[contracts-length (length contracts)])
(let loop ([contracts contracts]
[names names]
[extras extras])
(cond
[(and (null? names) (null? contracts)) '()]
[(or (null? names) (null? contracts))
(raise-syntax-error #f
(format "mismatched ~a argument list count and domain contract count (~a)"
(if extras "optional" "mandatory")
(if (null? names)
"ran out of names"
"ran out of contracts"))
stx)]
[else
(let ([fst-name (car names)]
[fst-ctc (car contracts)])
(if (keyword? (syntax-e fst-ctc))
(begin
(unless (pair? (cdr contracts))
(raise-syntax-error #f
"keyword not followed by a contract"
stx))
(cons (if extras
(list fst-ctc fst-name (cadr contracts) (car extras))
(list fst-ctc fst-name (cadr contracts)))
(loop (cddr contracts)
(cdr names)
(if extras
(cdr extras)
extras))))
(cons (if extras
(list fst-name fst-ctc (car extras))
(list fst-name fst-ctc))
(loop (cdr contracts) (cdr names) (if extras
(cdr extras)
extras)))))]))))])
(length names)
(length contracts)
(let loop ([contracts contracts]
[names names]
[extras extras])
(cond
[(and (null? names) (null? contracts)) '()]
[(or (null? names) (null? contracts))
(raise-syntax-error
#f
(format
"mismatched ~a argument list count and domain contract count (~a)"
(if extras "optional" "mandatory")
(if (null? names)
"ran out of names"
"ran out of contracts"))
stx)]
[else
(let ([fst-name (car names)]
[fst-ctc (car contracts)])
(if (keyword? (syntax-e fst-ctc))
(begin
(unless (pair? (cdr contracts))
(raise-syntax-error
#f
"keyword not followed by a contract"
stx))
(cons (if extras
(list fst-ctc
fst-name
(cadr contracts)
(car extras))
(list fst-ctc fst-name (cadr contracts)))
(loop (cddr contracts)
(cdr names)
(if extras
(cdr extras)
extras))))
(cons (if extras
(list fst-name fst-ctc (car extras))
(list fst-name fst-ctc))
(loop (cdr contracts)
(cdr names)
(if extras
(cdr extras)
extras)))))])))])

#`([(id #,@(build-mandatories/optionals (syntax->list #'(mandatory-names ...))
(syntax->list #'(mandatory ...))
Expand All @@ -418,19 +411,22 @@
[((x y) ...)
(andmap identifier? (syntax->list #'(x ... y ...)))]
[((x y) ...)
(for-each
(λ (var)
(unless (identifier? var)
(raise-syntax-error #f "expected an identifier in the optional names" stx var)))
(syntax->list #'(x ... y ...)))]
(for ([var (in-list (syntax->list #'(x ... y ...)))])
(unless (identifier? var)
(raise-syntax-error
#f
"expected an identifier in the optional names"
stx
var)))]
[(a ...)
(for-each
(λ (a)
(syntax-case stx ()
[(x y) (void)]
[other
(raise-syntax-error #f "expected an sequence of two idenfiers" stx #'other)]))
(syntax->list #'(a ...)))]))]
(for ([a (in-list (syntax->list #'(a ...)))])
(syntax-case stx ()
[(x y) (void)]
[other
(raise-syntax-error #f
"expected an sequence of two idenfiers"
stx
#'other)]))]))]
[x
(raise-syntax-error
#f
Expand Down Expand Up @@ -506,12 +502,9 @@
"expected an identifier or sequence of two identifiers"
stx
#'struct-name)])
(for ([f (in-list (syntax->list #'(field-name ...)))])
(unless (identifier? f)
(raise-syntax-error #f
"expected an identifier"
stx
f)))
(for ([f (in-list (syntax->list #'(field-name ...)))]
#:unless (identifier? f))
(raise-syntax-error #f "expected an identifier" stx f))
(define omit-constructor? #f)
(define-values (ds-args desc)
(let loop ([ds-args '()]
Expand Down
Loading