Skip to content

Automated Resyntax fixes #482

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 #482

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
2d72383
Fix 2 occurrences of `quasiquote-to-list`
resyntax-ci[bot] Feb 12, 2025
1596665
Fix 1 occurrence of `if-else-false-to-and`
resyntax-ci[bot] Feb 12, 2025
d003d7a
Fix 1 occurrence of `define-let-to-double-define`
resyntax-ci[bot] Feb 12, 2025
ac4cc8c
Fix 3 occurrences of `map-to-for`
resyntax-ci[bot] Feb 12, 2025
d6abb1d
Fix 4 occurrences of `if-begin-to-cond`
resyntax-ci[bot] Feb 12, 2025
b8baf82
Fix 1 occurrence of `or-hash-ref-set!-to-hash-ref!`
resyntax-ci[bot] Feb 12, 2025
dbaa60f
Fix 1 occurrence of `inline-unnecessary-begin`
resyntax-ci[bot] Feb 12, 2025
a5f1c2e
Fix 1 occurrence of `if-let-to-cond`
resyntax-ci[bot] Feb 12, 2025
5bf4221
Fix 1 occurrence of `quasiquote-to-append`
resyntax-ci[bot] Feb 12, 2025
58e5112
Fix 1 occurrence of `always-throwing-if-to-when`
resyntax-ci[bot] Feb 12, 2025
842d707
Fix 1 occurrence of `ormap-to-for/or`
resyntax-ci[bot] Feb 12, 2025
f29078e
Fix 2 occurrences of `when-expression-in-for-loop-to-when-keyword`
resyntax-ci[bot] Feb 12, 2025
daf317e
Fix 1 occurrence of `let-to-define`
resyntax-ci[bot] Feb 12, 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
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
45 changes: 22 additions & 23 deletions scribble-lib/scribble/racket.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -793,9 +793,8 @@
(out ". " (if (positive? quote-depth) value-color paren-color))
(set! src-col (+ src-col 3)))
(hash-set! next-col-map src-col dest-col)
((loop init-line! quote-depth first-expr? #f) l (if (and expr? (zero? quote-depth))
srcless-step
#f))]))
((loop init-line! quote-depth first-expr? #f) l (and (and expr? (zero? quote-depth))
srcless-step))]))
(out (case sh
[(#\[) "]"]
[(#\{) "}"]
Expand Down Expand Up @@ -853,22 +852,24 @@
[col (if (= line (syntax-line (cdr p)))
col
col0)])
(define e
(syntax-ize (car p)
(max 0
(- (syntax-column (cdr p)) width sep))
(syntax-line (cdr p))
#:expr? (and expr? (zero? quote-depth))))
(define key
(let ([e (syntax-ize (car p)
(max 0 (- (syntax-column (cdr p))
width
sep))
(syntax-line (cdr p))
#:expr? (and expr? (zero? quote-depth)))])
(if ((syntax-column e) . <= . col)
e
(datum->syntax #f
(syntax-e e)
(vector (syntax-source e)
(syntax-line e)
col
(syntax-position e)
(+ (syntax-span e) (- (syntax-column e) col)))))))
(if ((syntax-column e) . <= . col)
e
(datum->syntax #f
(syntax-e e)
(vector (syntax-source e)
(syntax-line e)
col
(syntax-position e)
(+ (syntax-span e)
(- (syntax-column e)
col))))))
(define elem
(datum->syntax
#f
Expand All @@ -885,11 +886,9 @@
;; constructed:
[(and expr? (zero? quote-depth))
(define l (apply append
(map (lambda (p)
(let ([p (syntax-e p)])
(list (forced-pair-car p)
(forced-pair-cdr p))))
(reverse l2))))
(for/list ([p (in-list (reverse l2))])
(let ([p (syntax-e p)])
(list (forced-pair-car p) (forced-pair-cdr p))))))
(datum->syntax
#f
(cons (datum->syntax #f
Expand Down
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
2 changes: 1 addition & 1 deletion scribble-test/tests/scribble/text-lang.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -67,4 +67,4 @@
(call-with-trusted-sandbox-configuration
(lambda ()
(for ([t (in-list (doc:tests))])
(begin (apply text-test t))))))
(apply text-test t)))))
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
31 changes: 16 additions & 15 deletions scribble-text-lib/scribble/text/syntax-utils.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -145,23 +145,24 @@
(loop (append (syntax->list #'(x ...)) (cdr exprs)) ds es)]
[(define-syntaxes (id ...) rhs)
(andmap identifier? (syntax->list #'(id ...)))
(if (null? es)
(let ([ids (syntax->list #'(id ...))])
(syntax-local-bind-syntaxes ids
(local-transformer-expand #'rhs 'expression '())
(car ctx))
(loop (cdr exprs) (cons (rebuild-bindings) ds) es))
;; return the unexpanded expr, to be re-expanded later, in the
;; right contexts
(values (reverse ds) (reverse es) exprs))]
(cond
[(null? es)
(define ids (syntax->list #'(id ...)))
(syntax-local-bind-syntaxes ids
(local-transformer-expand #'rhs 'expression '())
(car ctx))
(loop (cdr exprs) (cons (rebuild-bindings) ds) es)]
;; return the unexpanded expr, to be re-expanded later, in the
;; right contexts
[else (values (reverse ds) (reverse es) exprs)])]
[(define-values (id ...) rhs)
(andmap identifier? (syntax->list #'(id ...)))
(if (null? es)
(begin
(syntax-local-bind-syntaxes (syntax->list #'(id ...)) #f (car ctx))
(loop (cdr exprs) (cons (rebuild-bindings) ds) es))
;; same note here
(values (reverse ds) (reverse es) exprs))]
(cond
[(null? es)
(syntax-local-bind-syntaxes (syntax->list #'(id ...)) #f (car ctx))
(loop (cdr exprs) (cons (rebuild-bindings) ds) es)]
;; same note here
[else (values (reverse ds) (reverse es) exprs)])]
[_ (loop (cdr exprs) ds (cons expr* es))])])))
(define-syntax (begin/collect* stx) ; helper, has a boolean flag first
(define-values [exprs always-list?]
Expand Down