Skip to content

Automated Resyntax fixes #515

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

Merged
mflatt merged 10 commits into from
Jun 26, 2025
Merged

Automated Resyntax fixes #515

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
9c1a3d9
Fix 4 occurrences of `if-begin-to-cond`
resyntax-ci[bot] Jun 11, 2025
18fa63a
Fix 2 occurrences of `or-hash-ref-set!-to-hash-ref!`
resyntax-ci[bot] Jun 11, 2025
ea142ce
Fix 2 occurrences of `if-let-to-cond`
resyntax-ci[bot] Jun 11, 2025
cd1d8c5
Fix 2 occurrences of `map-to-for`
resyntax-ci[bot] Jun 11, 2025
2ef7a34
Fix 1 occurrence of `ormap-to-for/or`
resyntax-ci[bot] Jun 11, 2025
d2369f3
Fix 1 occurrence of `when-expression-in-for-loop-to-when-keyword`
resyntax-ci[bot] Jun 11, 2025
5f89343
Fix 3 occurrences of `provide/contract-to-contract-out`
resyntax-ci[bot] Jun 11, 2025
d749d91
Fix 2 occurrences of `let-to-define`
resyntax-ci[bot] Jun 11, 2025
03b8466
Fix 2 occurrences of `quasiquote-to-list`
resyntax-ci[bot] Jun 11, 2025
6d48c98
Fix 1 occurrence of `single-clause-match-to-match-define`
resyntax-ci[bot] Jun 11, 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
4 changes: 2 additions & 2 deletions scribble-html-lib/scribble/html/html.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -186,11 +186,11 @@
(define-values [attrs body] (attributes+body args))
(make-element
'script attrs
`("\n" ,(set-prefix 0 (apply cdata #:line-prefix "//" body)) "\n")))
(list "\n" (set-prefix 0 (apply cdata #:line-prefix "//" body)) "\n")))
(provide style/inline)
(define (style/inline . args)
(define-values [attrs body] (attributes+body args))
(make-element 'style attrs `("\n" ,body "\n")))
(make-element 'style attrs (list "\n" body "\n")))

;; ----------------------------------------------------------------------------
;; Entities
Expand Down
91 changes: 47 additions & 44 deletions scribble-html-lib/scribble/html/resource.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,11 +57,10 @@
(set! cached-roots
(cons roots
(and (list? roots) (pair? roots)
(map (lambda (root)
(list* (regexp-match* #rx"[^/]+" (car root))
(regexp-replace #rx"/$" (cadr root) "")
(cddr root)))
roots)))))
(for/list ([root (in-list roots)])
(list* (regexp-match* #rx"[^/]+" (car root))
(regexp-replace #rx"/$" (cadr root) "")
(cddr root)))))))
(cdr cached-roots))

;; a utility for relative paths, taking the above `default-file' and
Expand All @@ -70,22 +69,23 @@
(define file* (if (equal? file default-file) "" file))
(define roots (current-url-roots))
(define (find-root path mode)
(ormap (lambda (root+url+flags)
(let loop ([r (car root+url+flags)] [p path])
(if (pair? r)
(and (pair? p) (equal? (car p) (car r))
(loop (cdr r) (cdr p)))
(case mode
[(get-path) `(,(cadr root+url+flags)
,@p
,(if (and (equal? file* "")
(memq 'index (cddr root+url+flags)))
default-file
file*))]
[(get-abs-or-true)
(if (memq 'abs (cddr root+url+flags)) `("" ,@p) #t)]
[else (error 'relativize "internal error: ~e" mode)]))))
roots))
(for/or ([root+url+flags (in-list roots)])
(let loop ([r (car root+url+flags)]
[p path])
(if (pair? r)
(and (pair? p) (equal? (car p) (car r)) (loop (cdr r) (cdr p)))
(case mode
[(get-path)
`(,(cadr root+url+flags) ,@p
,(if (and (equal? file* "")
(memq 'index (cddr root+url+flags)))
default-file
file*))]
[(get-abs-or-true)
(if (memq 'abs (cddr root+url+flags))
`("" ,@p)
#t)]
[else (error 'relativize "internal error: ~e" mode)])))))
(define result
(let loop ([t tgtdir] [c curdir] [pfx '()])
(cond
Expand Down Expand Up @@ -165,9 +165,11 @@
(define t (make-hash))
(define-syntax-rule (S body) (call-with-semaphore s (lambda () body)))
(values (lambda (path renderer)
(S (if (hash-ref t path #f)
(error 'resource "path used for two resources: ~e" path)
(begin (hash-set! t path #t) (set! l (cons renderer l))))))
(S (cond
[(hash-ref t path #f) (error 'resource "path used for two resources: ~e" path)]
[else
(hash-set! t path #t)
(set! l (cons renderer l))])))
(lambda () (S (begin0 (reverse l) (set! l '())))))))

;; `#:exists' determines what happens when the render destination exists, it
Expand All @@ -180,32 +182,33 @@
(define (resource path0 renderer #:exists [exists 'delete-file])
(define (bad reason) (error 'resource "bad path, ~a: ~e" reason path0))
(unless (string? path0) (bad "must be a string"))
(for ([x (in-list '([#rx"^/" "must be relative"]
[#rx"//" "must not have empty elements"]
[#rx"(?:^|/)[.][.]?(?:/|$)"
"must not contain `.' or `..'"]))])
(when (regexp-match? (car x) path0) (bad (cadr x))))
(for ([x (in-list '([#rx"^/" "must be relative"] [#rx"//" "must not have empty elements"]
[#rx"(?:^|/)[.][.]?(?:/|$)"
"must not contain `.' or `..'"]))]
#:when (regexp-match? (car x) path0))
(bad (cadr x)))
(define path (regexp-replace #rx"(?<=^|/)$" path0 default-file))
(define-values [dirpathlist filename]
(let-values ([(l r) (split-at-right (regexp-split #rx"/" path) 1)])
(values l (car r))))
(define (render)
(let loop ([ps dirpathlist])
(if (pair? ps)
(begin (unless (directory-exists? (car ps))
(if (or (file-exists? (car ps)) (link-exists? (car ps)))
(bad "exists as a file/link")
(make-directory (car ps))))
(parameterize ([current-directory (car ps)])
(loop (cdr ps))))
(begin (cond [(not exists)] ; do nothing
[(or (file-exists? filename) (link-exists? filename))
(delete-file filename)]
[(directory-exists? filename)
(bad "exists as directory")])
(parameterize ([rendered-dirpath dirpathlist])
(printf " ~a\n" path)
(renderer filename))))))
(cond
[(pair? ps)
(unless (directory-exists? (car ps))
(if (or (file-exists? (car ps)) (link-exists? (car ps)))
(bad "exists as a file/link")
(make-directory (car ps))))
(parameterize ([current-directory (car ps)])
(loop (cdr ps)))]
[else
(cond
[(not exists)] ; do nothing
[(or (file-exists? filename) (link-exists? filename)) (delete-file filename)]
[(directory-exists? filename) (bad "exists as directory")])
(parameterize ([rendered-dirpath dirpathlist])
(printf " ~a\n" path)
(renderer filename))])))
(define absolute-url
(lazy (define url (relativize filename dirpathlist '()))
(if (url-roots)
Expand Down
18 changes: 8 additions & 10 deletions scribble-html-lib/scribble/html/xml.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -106,16 +106,14 @@
;; null body means a lone tag, tags that should always have a closer will
;; have a '(#f) as their body (see below)
(list (with-writer #f "<" tag)
(map (lambda (attr)
(define name (car attr))
(define val (cdr attr))
(cond [(not val) #f]
;; #t means just mention the attribute
[(eq? #t val) (with-writer #f (list " " name))]
[else (list (with-writer #f (list " " name "=\""))
val
(with-writer #f "\""))]))
attrs)
(for/list ([attr (in-list attrs)])
(define name (car attr))
(define val (cdr attr))
(cond
[(not val) #f]
;; #t means just mention the attribute
[(eq? #t val) (with-writer #f (list " " name))]
[else (list (with-writer #f (list " " name "=\"")) val (with-writer #f "\""))]))
(if (null? body)
(with-writer #f " />")
(list (with-writer #f ">")
Expand Down
58 changes: 25 additions & 33 deletions scribble-lib/scribble/base.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,23 +29,22 @@
#:rest (listof pre-content?)
part-start?))

(provide/contract
[title (->* ()
(#:tag (or/c #f string? (listof string?))
#:tag-prefix (or/c #f string? module-path? hash?)
#:style (or/c style? string? symbol? (listof symbol?) #f)
#:version (or/c string? #f)
#:date (or/c string? #f)
#:index-extras desc-extras/c)
#:rest (listof pre-content?)
title-decl?)]
[section (title-like-contract)]
[subsection (title-like-contract)]
[subsubsection (title-like-contract)]
[subsubsub*section (->* ()
(#:tag (or/c #f string? (listof string?)))
#:rest (listof pre-content?)
block?)])
(provide (contract-out
[title
(->* ()
(#:tag (or/c #f string? (listof string?))
#:tag-prefix (or/c #f string? module-path? hash?)
#:style (or/c style? string? symbol? (listof symbol?) #f)
#:version (or/c string? #f)
#:date (or/c string? #f)
#:index-extras desc-extras/c)
#:rest (listof pre-content?)
title-decl?)]
[section (title-like-contract)]
[subsection (title-like-contract)]
[subsubsection (title-like-contract)]
[subsubsub*section
(->* () (#:tag (or/c #f string? (listof string?))) #:rest (listof pre-content?) block?)]))
(provide include-section)

(define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style plain]
Expand Down Expand Up @@ -131,9 +130,8 @@

;; ----------------------------------------

(provide/contract
[author (->* (content?) () #:rest (listof content?) block?)]
[author+email (->* (content? string?) (#:obfuscate? any/c) element?)])
(provide (contract-out [author (->* (content?) () #:rest (listof content?) block?)]
[author+email (->* (content? string?) (#:obfuscate? any/c) element?)]))

(define (author . auths)
(make-paragraph
Expand All @@ -142,10 +140,9 @@
(case (length auths)
[(1) auths]
[(2) (list (car auths) nl "and " (cadr auths))]
[else (let ([r (reverse auths)])
(append (add-between (reverse (cdr r))
(make-element #f (list "," nl)))
(list "," nl "and " (car r))))]))))
[else (define r (reverse auths))
(append (add-between (reverse (cdr r)) (make-element #f (list "," nl)))
(list "," nl "and " (car r)))]))))

(define (author+email name email #:obfuscate? [obfuscate? #f])
(make-element #f
Expand Down Expand Up @@ -173,15 +170,10 @@

(provide items/c)

(provide/contract
[itemlist (->* ()
(#:style (or/c style? string? symbol? #f))
#:rest (listof items/c)
itemization?)]
[item (->* ()
()
#:rest (listof pre-flow?)
item?)])
(provide (contract-out
[itemlist
(->* () (#:style (or/c style? string? symbol? #f)) #:rest (listof items/c) itemization?)]
[item (->* () () #:rest (listof pre-flow?) item?)]))
(provide/contract
[item? (any/c . -> . boolean?)])

Expand Down
84 changes: 35 additions & 49 deletions scribble-lib/scribble/tag.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,58 +48,45 @@
(let ([v (if (list? v)
(map intern-taglet v)
(datum-intern-literal v))])
(if (or (string? v)
(bytes? v)
(list? v))
(let ([b (hash-ref interned v #f)])
(if b
(or (weak-box-value b)
;; just in case the value is GCed before we extract it:
(intern-taglet v))
(begin
(hash-set! interned v (make-weak-box v))
v)))
v)))
(cond
[(or (string? v) (bytes? v) (list? v))
(define b (hash-ref interned v #f))
(if b
(or (weak-box-value b)
;; just in case the value is GCed before we extract it:
(intern-taglet v))
(begin
(hash-set! interned v (make-weak-box v))
v))]
[else v])))

(define (do-module-path-index->taglet mod)
;; Derive the name from the module path:
(let ([p (collapse-module-path-index
mod
(lambda () (build-path (current-directory) "dummy")))])
(if (path? p)
;; If we got a path back anyway, then it's best to use the resolved
;; name; if the current directory has changed since we
;; the path-index was resolved, then p might not be right. Also,
;; the resolved path might be a symbol instead of a path.
(let ([rp (resolved-module-path-name
(module-path-index-resolve mod))])
(if (path? rp)
(intern-taglet
(path->collects-relative rp))
rp))
(let ([p (if (and (pair? p)
(eq? (car p) 'planet))
;; Normalize planet verion number based on current
;; linking:
(let-values ([(path pkg)
(get-planet-module-path/pkg p #f #f)])
(list* 'planet
(cadr p)
(list (car (caddr p))
(cadr (caddr p))
(pkg-maj pkg)
(pkg-min pkg))
(cdddr p)))
;; Otherwise the path is fully normalized:
p)])
(intern-taglet p)))))
(define p (collapse-module-path-index mod (lambda () (build-path (current-directory) "dummy"))))
(if (path? p)
;; If we got a path back anyway, then it's best to use the resolved
;; name; if the current directory has changed since we
;; the path-index was resolved, then p might not be right. Also,
;; the resolved path might be a symbol instead of a path.
(let ([rp (resolved-module-path-name (module-path-index-resolve mod))])
(if (path? rp)
(intern-taglet (path->collects-relative rp))
rp))
(let ([p (if (and (pair? p) (eq? (car p) 'planet))
;; Normalize planet verion number based on current
;; linking:
(let-values ([(path pkg) (get-planet-module-path/pkg p #f #f)])
(list* 'planet
(cadr p)
(list (car (caddr p)) (cadr (caddr p)) (pkg-maj pkg) (pkg-min pkg))
(cdddr p)))
;; Otherwise the path is fully normalized:
p)])
(intern-taglet p))))

(define collapsed (make-weak-hasheq))
(define (module-path-index->taglet mod)
(or (hash-ref collapsed mod #f)
(let ([v (do-module-path-index->taglet mod)])
(hash-set! collapsed mod v)
v)))
(hash-ref! collapsed mod (λ () (do-module-path-index->taglet mod))))

(define (module-path-prefix->string p)
(datum-intern-literal
Expand All @@ -123,9 +110,8 @@
(define (definition-tag->class/interface-tag t) (cons 'class/intf (cdr t)))
(define (class/interface-tag->constructor-tag t) (cons 'constructor (cdr t)))
(define (get-class/interface-and-method meth-tag)
(match meth-tag
[`(meth ((,_ ,class/interface) ,method))
(values class/interface method)]))
(match-define `(meth ((,_ ,class/interface) ,method)) meth-tag)
(values class/interface method))
(define (definition-tag? x) (and (tag? x) (equal? (car x) 'def)))
(define (class/interface-tag? x) (and (tag? x) (equal? (car x) 'class/intf)))
(define (method-tag? x) (and (tag? x) (equal? (car x) 'meth)))
Expand Down
16 changes: 7 additions & 9 deletions scribble-text-lib/scribble/text/output.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -112,11 +112,12 @@
(cond
[(pair? nls)
(define nl (car nls))
(if (regexp-match? #rx"^ *$" x start (car nl))
(newline p) ; only spaces before the end of the line
(begin
(output-pfx col pfx lpfx)
(write x p start (cdr nl))))
(cond
[(regexp-match? #rx"^ *$" x start (car nl))
(newline p)] ; only spaces before the end of the line
[else
(output-pfx col pfx lpfx)
(write x p start (cdr nl))])
(loop (cdr nl) (cdr nls) 0 0)]
;; last substring from here (always set lpfx state when done)
[(start . = . len) (set-mcdr! pfxs lpfx)]
Expand Down Expand Up @@ -279,10 +280,7 @@
[(eq? p (car last)) (cdr last)]
[else
(define s
(or (hash-ref t p #f)
(let ([s (mcons 0 0)])
(hash-set! t p s)
s)))
(hash-ref! t p (λ () (mcons 0 0))))
(set! last (cons p s))
s]))))

Expand Down
Loading