Skip to content

Automated Resyntax fixes #503

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

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

Automated Resyntax fixes #503

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
11bf0ac
Fix 1 occurrence of `define-lambda-to-define`
resyntax-ci[bot] May 7, 2025
db35126
Fix 4 occurrences of `let-to-define`
resyntax-ci[bot] May 7, 2025
529ee73
Fix 2 occurrences of `map-to-for`
resyntax-ci[bot] May 7, 2025
ab634ca
Fix 2 occurrences of `if-begin-to-cond`
resyntax-ci[bot] May 7, 2025
cf08849
Fix 1 occurrence of `or-hash-ref-set!-to-hash-ref!`
resyntax-ci[bot] May 7, 2025
dfe9d12
Fix 1 occurrence of `inline-unnecessary-begin`
resyntax-ci[bot] May 7, 2025
b8f8109
Fix 2 occurrences of `if-let-to-cond`
resyntax-ci[bot] May 7, 2025
46841e7
Fix 1 occurrence of `quasiquote-to-append`
resyntax-ci[bot] May 7, 2025
b950ede
Fix 1 occurrence of `always-throwing-if-to-when`
resyntax-ci[bot] May 7, 2025
4fb1474
Fix 2 occurrences of `provide/contract-to-contract-out`
resyntax-ci[bot] May 7, 2025
b8dbd32
Fix 1 occurrence of `always-throwing-cond-to-when`
resyntax-ci[bot] May 7, 2025
430f356
Fix 1 occurrence of `cond-let-to-cond-define`
resyntax-ci[bot] May 7, 2025
3e295d0
Fix 1 occurrence of `when-expression-in-for-loop-to-when-keyword`
resyntax-ci[bot] May 7, 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
178 changes: 91 additions & 87 deletions scribble-lib/scribble/decode.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -64,27 +64,22 @@
pre-flow?
pre-part?)

(provide/contract
[decode (-> (listof pre-part?)
part?)]
[decode-part (-> (listof pre-part?)
(listof string?)
(or/c #f content?)
exact-nonnegative-integer?
part?)]
[decode-flow (-> (listof pre-flow?)
(listof block?))]
[decode-paragraph (-> (listof pre-content?)
paragraph?)]
[decode-compound-paragraph (-> (listof pre-flow?)
block?)]
[decode-content (-> (listof pre-content?)
content?)]
[rename decode-content decode-elements
(-> (listof pre-content?)
content?)]
[decode-string (-> string? content?)]
[clean-up-index-string (-> string? string?)])
(provide (contract-out [decode (-> (listof pre-part?) part?)]
[decode-part
(-> (listof pre-part?)
(listof string?)
(or/c #f content?)
exact-nonnegative-integer?
part?)]
[decode-flow (-> (listof pre-flow?) (listof block?))]
[decode-paragraph (-> (listof pre-content?) paragraph?)]
[decode-compound-paragraph (-> (listof pre-flow?) block?)]
[decode-content (-> (listof pre-content?) content?)]
(rename decode-content
decode-elements
(-> (listof pre-content?) content?))
[decode-string (-> string? content?)]
[clean-up-index-string (-> string? string?)]))

(define (spliceof c)
(define name `(spliceof ,(contract-name c)))
Expand All @@ -93,8 +88,7 @@
#:first-order (lambda (x)
(and (splice? x)
(andmap p (splice-run x))))))
(provide/contract
[spliceof (flat-contract? . -> . flat-contract?)])
(provide (contract-out [spliceof (flat-contract? . -> . flat-contract?)]))

(define the-part-index-desc (index-desc (hash 'kind "part"
'part? #t)))
Expand Down Expand Up @@ -192,18 +186,21 @@
(loop (cdr l) next? keys colls accum title tag-prefix tags vers style index-desc)]
[(title-decl? (car l))
(let ([t (car l)])
(cond
[(not part-depth) (error 'decode "misplaced title: ~e" t)]
[title (error 'decode "found extra title: ~v" t)]
[else (loop (cdr l) next? keys colls accum
(title-decl-content t)
(title-decl-tag-prefix t)
(title-decl-tags t)
(title-decl-version t)
(title-decl-style t)
(or (and (title-decl*? t)
(title-decl*-index-desc t))
index-desc))]))]
(unless part-depth
(error 'decode "misplaced title: ~e" t))
(when title
(error 'decode "found extra title: ~v" t))
(loop (cdr l)
next?
keys
colls
accum
(title-decl-content t)
(title-decl-tag-prefix t)
(title-decl-tags t)
(title-decl-version t)
(title-decl-style t)
(or (and (title-decl*? t) (title-decl*-index-desc t)) index-desc)))]
#;
;; Blocks are now handled by decode-accum-para
[(block? (car l))
Expand Down Expand Up @@ -237,21 +234,29 @@
(error 'decode
"misplaced part (the part is more than one layer deeper than its container); title: ~s"
(part-start-title (car l))))
(let ([s (car l)])
(let loop ([l (cdr l)] [s-accum null])
(if (or (null? l)
(and (part-start? (car l))
((part-start-depth (car l)) . <= . part-depth))
(part? (car l)))
(define s (car l))
(let loop ([l (cdr l)]
[s-accum null])
(if (or (null? l)
(and (part-start? (car l)) ((part-start-depth (car l)) . <= . part-depth))
(part? (car l)))
(let ([para (decode-accum-para accum)]
[s (decode-styled-part (reverse s-accum)
(part-start-tag-prefix s)
(part-start-tags s)
(part-start-style s)
(part-start-title s)
(add1 part-depth))]
[part (decode-flow* l keys colls tag-prefix tags vers style
title (and (part-start*? s) (part-start*-index-desc s)) part-depth)])
[part (decode-flow* l
keys
colls
tag-prefix
tags
vers
style
title
(and (part-start*? s) (part-start*-index-desc s))
part-depth)])
(make-part (part-tag-prefix part)
(part-tags part)
(part-title-content part)
Expand All @@ -260,12 +265,9 @@
para
(cons s (part-parts part))))
(cond
[(splice? (car l))
(loop (append (splice-run (car l)) (cdr l)) s-accum)]
[(list? (car l))
(loop (append (car l) (cdr l)) s-accum)]
[else
(loop (cdr l) (cons (car l) s-accum))]))))]
[(splice? (car l)) (loop (append (splice-run (car l)) (cdr l)) s-accum)]
[(list? (car l)) (loop (append (car l) (cdr l)) s-accum)]
[else (loop (cdr l) (cons (car l) s-accum))])))]
[(splice? (car l))
(loop (append (splice-run (car l)) (cdr l))
next? keys colls accum title tag-prefix tags vers style index-desc)]
Expand All @@ -292,23 +294,30 @@
(loop (cons (car l) (append ((if (splice? (cadr l)) splice-run values) (cadr l)) (cddr l)))
next? keys colls accum title tag-prefix tags vers style index-desc)]
[(line-break? (car l))
(if next?
(loop (cdr l) #t keys colls accum title tag-prefix tags vers style index-desc)
(let ([m (match-newline-whitespace (cdr l))])
(if m
(let ([part (loop m #t keys colls null title tag-prefix tags vers
style index-desc)])
(make-part
(part-tag-prefix part)
(part-tags part)
(part-title-content part)
(part-style part)
(part-to-collect part)
(append (decode-accum-para accum)
(part-blocks part))
(part-parts part)))
(loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix
tags vers style index-desc))))]
(cond
[next? (loop (cdr l) #t keys colls accum title tag-prefix tags vers style index-desc)]
[else
(define m (match-newline-whitespace (cdr l)))
(if m
(let ([part (loop m #t keys colls null title tag-prefix tags vers style index-desc)])
(make-part (part-tag-prefix part)
(part-tags part)
(part-title-content part)
(part-style part)
(part-to-collect part)
(append (decode-accum-para accum) (part-blocks part))
(part-parts part)))
(loop (cdr l)
#f
keys
colls
(cons (car l) accum)
title
tag-prefix
tags
vers
style
index-desc))])]
[else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix
tags vers style index-desc)])))

Expand Down Expand Up @@ -359,24 +368,19 @@
(if (null? para-accum)
null
(list (make-paragraph plain (skip-whitespace (apply append (reverse para-accum)))))))
(let ([r (let loop ([l (skip-whitespace l)]
[para-accum null])
(cond
[(null? l)
(finish-accum para-accum)]
[else
(let ([s (car l)])
(cond
[(block? s) (append
(finish-accum para-accum)
(cons s (loop (skip-whitespace (cdr l)) null)))]
[(string? s) (loop (cdr l)
(cons (decode-string s) para-accum))]
[else (loop (cdr l)
(cons (list (car l)) para-accum))]))]))])
(cond
[(null? r)
(make-paragraph plain null)]
[(null? (cdr r))
(car r)]
[(make-compound-paragraph plain r)])))
(define r
(let loop ([l (skip-whitespace l)]
[para-accum null])
(cond
[(null? l) (finish-accum para-accum)]
[else
(let ([s (car l)])
(cond
[(block? s)
(append (finish-accum para-accum) (cons s (loop (skip-whitespace (cdr l)) null)))]
[(string? s) (loop (cdr l) (cons (decode-string s) para-accum))]
[else (loop (cdr l) (cons (list (car l)) para-accum))]))])))
(cond
[(null? r) (make-paragraph plain null)]
[(null? (cdr r)) (car r)]
[(make-compound-paragraph plain r)]))
2 changes: 1 addition & 1 deletion scribble-lib/scribble/lp/lang/common.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@
(cons id (mapping-get chunk-groups id)))
(free-identifier-mapping-put!
chunks id
`(,@(mapping-get chunks id) ,@exprs))))
(append (mapping-get chunks id) exprs))))

(define-syntax (tangle stx)
(define chunk-mentions '())
Expand Down
62 changes: 30 additions & 32 deletions scribble-lib/scribble/run.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,8 @@

(module test racket/base)

(define multi-html:render-mixin
(lambda (%) (html:render-multi-mixin (html:render-mixin %))))
(define (multi-html:render-mixin %)
(html:render-multi-mixin (html:render-mixin %)))

(define current-render-mixin (make-parameter html:render-mixin))
(define current-html (make-parameter #t))
Expand All @@ -37,10 +37,9 @@
(define current-image-prefs (make-parameter null)) ; reverse order

(define (read-one str)
(let ([i (open-input-string str)])
(with-handlers ([exn:fail:read? (lambda (x) #f)])
(let ([v (read i)])
(and (eof-object? (read i)) v)))))
(define i (open-input-string str))
(with-handlers ([exn:fail:read? (lambda (x) #f)])
(let ([v (read i)]) (and (eof-object? (read i)) v))))

(define (run)
(define doc-binding 'doc)
Expand Down Expand Up @@ -171,32 +170,29 @@
(make-compilation-manager-load/use-compiled-handler))])
(parameterize ([current-command-line-arguments
(list->vector (reverse (doc-command-line-arguments)))])
(build-docs (map (lambda (file)
(define (go)
(let ([mp (if (current-lib-mode)
`(lib ,file)
`(file ,file))])
;; Try `doc' submodule, first:
(if (module-declared? `(submod ,mp ,doc-binding) #t)
(dynamic-require `(submod ,mp ,doc-binding)
doc-binding)
(dynamic-require mp doc-binding))))
(if maker
(parameterize ([current-load/use-compiled maker])
(go))
(go)))
files)
(build-docs (for/list ([file (in-list files)])
(define (go)
(let ([mp (if (current-lib-mode)
`(lib ,file)
`(file ,file))])
;; Try `doc' submodule, first:
(if (module-declared? `(submod ,mp ,doc-binding) #t)
(dynamic-require `(submod ,mp ,doc-binding) doc-binding)
(dynamic-require mp doc-binding))))
(if maker
(parameterize ([current-load/use-compiled maker])
(go))
(go)))
files)))))

(define (build-docs docs files)
(when (and (current-dest-name)
((length files) . > . 1))
(raise-user-error 'scribble "cannot supply a destination name with multiple inputs"))
(render docs
(map (lambda (fn)
(let-values ([(base name dir?) (split-path fn)])
(or (current-dest-name) name)))
files)
(for/list ([fn (in-list files)])
(define-values (base name dir?) (split-path fn))
(or (current-dest-name) name))
#:dest-dir (current-dest-directory)
#:render-mixin (current-render-mixin)
#:image-preferences (reverse (current-image-prefs))
Expand All @@ -212,13 +208,15 @@
#:quiet? (current-quiet)
#:info-in-files (reverse (current-info-input-files))
#:xrefs (for/list ([mod+id (in-list (reverse (current-xref-input-modules)))])
(let* ([get-xref (dynamic-require (car mod+id) (cdr mod+id))]
[xr (get-xref)])
(unless (xref? xr)
(raise-user-error
'scribble "result from `~s' of `~s' is not an xref: ~e"
(cdr mod+id) (car mod+id) xr))
xr))
(define get-xref (dynamic-require (car mod+id) (cdr mod+id)))
(define xr (get-xref))
(unless (xref? xr)
(raise-user-error 'scribble
"result from `~s' of `~s' is not an xref: ~e"
(cdr mod+id)
(car mod+id)
xr))
xr)
#:info-out-file (current-info-output-file)))

(run)
24 changes: 11 additions & 13 deletions scribble-test/tests/scribble/markdown.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,14 +10,14 @@
"scribble-docs-tests"))

(define (build-markdown-doc src-file dest-file)
(let* ([renderer (new (markdown:render-mixin render%) [dest-dir work-dir])]
[docs (list (dynamic-require src-file 'doc))]
[fns (list (build-path work-dir dest-file))]
[fp (send renderer traverse docs fns)]
[info (send renderer collect docs fns fp)]
[r-info (send renderer resolve docs fns info)])
(send renderer render docs fns r-info)
(send renderer get-undefined r-info)))
(define renderer (new (markdown:render-mixin render%) [dest-dir work-dir]))
(define docs (list (dynamic-require src-file 'doc)))
(define fns (list (build-path work-dir dest-file)))
(define fp (send renderer traverse docs fns))
(define info (send renderer collect docs fns fp))
(define r-info (send renderer resolve docs fns info))
(send renderer render docs fns r-info)
(send renderer get-undefined r-info))

(provide markdown-tests)
(module+ main (markdown-tests))
Expand All @@ -40,11 +40,9 @@
(define (contents file)
(regexp-replace #rx"\n+$" (file->string file) ""))
(define undefineds (build-markdown-doc src-file "gen.md"))
(for ([u (in-list undefineds)])
(when (eq? 'tech (car u))
(test #:failure-message
(format "undefined tech: ~e" u)
#f)))
(for ([u (in-list undefineds)]
#:when (eq? 'tech (car u)))
(test #:failure-message (format "undefined tech: ~e" u) #f))
(test #:failure-message
(format
"mismatch for: \"~a\", expected text in: \"~a\", got:\n~a"
Expand Down
16 changes: 8 additions & 8 deletions scribble-test/tests/scribble/reader.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -947,14 +947,14 @@ END-OF-TESTS
(define m
(or (regexp-match #px"^(.*)\n\\s*(-\\S+->)\\s*\n(.*)$" t)
(regexp-match #px"^(.*\\S)\\s+(-\\S+->)\\s+(\\S.*)$" t)))
(if (not (and m (= 4 (length m))))
(error 'bad-test "~a" t)
(let-values ([(x y) ((string->tester (caddr m)) (cadr m) (cadddr m))])
(test #:failure-message (format "bad result in\n ~a\n results:\n ~s != ~s"
(regexp-replace* #rx"\n" t "\n ")
x
y)
(matching? x y)))))))
(unless (and m (= 4 (length m)))
(error 'bad-test "~a" t))
(let-values ([(x y) ((string->tester (caddr m)) (cadr m) (cadddr m))])
(test #:failure-message (format "bad result in\n ~a\n results:\n ~s != ~s"
(regexp-replace* #rx"\n" t "\n ")
x
y)
(matching? x y))))))

;; Check static versus dynamic readtable for command (dynamic when "c" in the
;; name) and datum (dynamic when "d" in the name) parts:
Expand Down
Loading