Skip to content

Automated Resyntax fixes #490

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 9 commits into
base: master
Choose a base branch
from
+243 −296
Open

Automated Resyntax fixes #490

Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
e2d8ba9
Fix 7 occurrences of `provide/contract-to-contract-out`
resyntax-ci[bot] Mar 12, 2025
b4aa4c2
Fix 3 occurrences of `let-to-define`
resyntax-ci[bot] Mar 12, 2025
3925ec3
Fix 1 occurrence of `arrow-contract-with-rest-to-arrow-contract-with-…
resyntax-ci[bot] Mar 12, 2025
2e1f2cd
Fix 2 occurrences of `map-to-for`
resyntax-ci[bot] Mar 12, 2025
8886c90
Fix 2 occurrences of `if-let-to-cond`
resyntax-ci[bot] Mar 12, 2025
778979b
Fix 2 occurrences of `if-begin-to-cond`
resyntax-ci[bot] Mar 12, 2025
f4ff763
Fix 1 occurrence of `define-syntax-syntax-rules-to-define-syntax-rule`
resyntax-ci[bot] Mar 12, 2025
3bcc174
Fix 1 occurrence of `cond-let-to-cond-define`
resyntax-ci[bot] Mar 12, 2025
6e76891
Fix 1 occurrence of `or-hash-ref-set!-to-hash-ref!`
resyntax-ci[bot] Mar 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
181 changes: 83 additions & 98 deletions scribble-lib/scribble/base.rkt
View file
Original file line number Diff line number Diff line change
@@ -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]
@@ -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
@@ -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
@@ -173,17 +170,11 @@

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

(define (itemlist #:style [style plain] . items)
(let ([flows (let loop ([items items])
@@ -218,33 +209,27 @@
;; ----------------------------------------

(define elem-like-contract
(->* () () #:rest (listof pre-content?) element?))

(provide/contract
[linebreak (-> element?)]
[nonbreaking elem-like-contract]
[hspace (-> exact-nonnegative-integer? element?)]
[elem (->* ()
(#:style element-style?)
#:rest (listof pre-content?)
element?)]
[italic elem-like-contract]
[bold elem-like-contract]
[smaller elem-like-contract]
[larger elem-like-contract]
[emph elem-like-contract]
[tt elem-like-contract]
[subscript elem-like-contract]
[superscript elem-like-contract]

[literal (->* (string?) () #:rest (listof string?) element?)]

[image (->* ((or/c path-string? (cons/c 'collects (listof bytes?))))
(#:scale real?
#:suffixes (listof (and/c string? #rx"^[.]"))
#:style element-style?)
#:rest (listof content?)
image-element?)])
(-> pre-content? ... element?))

(provide (contract-out
[linebreak (-> element?)]
[nonbreaking elem-like-contract]
[hspace (-> exact-nonnegative-integer? element?)]
[elem (->* () (#:style element-style?) #:rest (listof pre-content?) element?)]
[italic elem-like-contract]
[bold elem-like-contract]
[smaller elem-like-contract]
[larger elem-like-contract]
[emph elem-like-contract]
[tt elem-like-contract]
[subscript elem-like-contract]
[superscript elem-like-contract]
[literal (->* (string?) () #:rest (listof string?) element?)]
[image
(->* ((or/c path-string? (cons/c 'collects (listof bytes?))))
(#:scale real? #:suffixes (listof (and/c string? #rx"^[.]")) #:style element-style?)
#:rest (listof content?)
image-element?)]))

(define hspace-cache (make-vector 100 #f))

@@ -292,11 +277,10 @@
l))])
(if (andmap string? l)
(make-element 'tt l)
(make-element #f (map (lambda (s)
(if (or (string? s) (symbol? s))
(make-element 'tt (list s))
s))
l)))))
(make-element #f (for/list ([s (in-list l)])
(if (or (string? s) (symbol? s))
(make-element 'tt (list s))
s))))))

(define (span-class classname . str)
(make-element classname (decode-content str)))
@@ -331,27 +315,28 @@
(cons/c rc rc))))
rc)

(provide/contract
[para (->* ()
(#:style (or/c style? string? symbol? #f ))
#:rest (listof pre-content?)
paragraph?)]
[nested (->* ()
(#:style (or/c style? string? symbol? #f ))
#:rest (listof pre-flow?)
nested-flow?)]
[compound (->* ()
(#:style (or/c style? string? symbol? #f ))
(provide (contract-out
[para
(->* ()
(#:style (or/c style? string? symbol? #f))
#:rest (listof pre-content?)
paragraph?)]
[nested
(->* () (#:style (or/c style? string? symbol? #f)) #:rest (listof pre-flow?) nested-flow?)]
[compound
(->* ()
(#:style (or/c style? string? symbol? #f))
#:rest (listof pre-flow?)
compound-paragraph?)]
[tabular (->* ((listof (listof (or/c 'cont block? content?))))
(#:style (or/c style? string? symbol? #f)
#:sep (or/c content? block? #f)
#:column-properties (listof any/c)
#:row-properties (listof any/c)
#:cell-properties (listof (listof any/c))
#:sep-properties (or/c list? #f))
table?)])
[tabular
(->* ((listof (listof (or/c 'cont block? content?))))
(#:style (or/c style? string? symbol? #f)
#:sep (or/c content? block? #f)
#:column-properties (listof any/c)
#:row-properties (listof any/c)
#:cell-properties (listof (listof any/c))
#:sep-properties (or/c list? #f))
table?)]))

(define (convert-block-style style)
(cond
@@ -385,18 +370,18 @@
[(3) "rd"]
[else "th"]))
(unless (null? cells)
(let ([n (length (car cells))])
(for ([row (in-list (cdr cells))]
[pos (in-naturals 2)])
(unless (= n (length row))
(raise-mismatch-error
'tabular
(format "bad length (~a does not match first row's length ~a) for ~a~a row: "
(length row)
n
pos
(nth-str pos))
row)))))
(define n (length (car cells)))
(for ([row (in-list (cdr cells))]
[pos (in-naturals 2)])
(unless (= n (length row))
(raise-mismatch-error
'tabular
(format "bad length (~a does not match first row's length ~a) for ~a~a row: "
(length row)
n
pos
(nth-str pos))
row))))
(for ([row (in-list cells)]
[pos (in-naturals 1)])
(when (and (pair? row) (eq? (car row) 'cont))
51 changes: 13 additions & 38 deletions scribble-lib/scribble/sigplan.rkt
View file
Original file line number Diff line number Diff line change
@@ -8,44 +8,19 @@
scribble/latex-properties
(for-syntax racket/base))

(provide/contract
[abstract
(->* () () #:rest (listof pre-content?)
block?)]
[subtitle
(->* () () #:rest (listof pre-content?)
content?)]
[authorinfo
(-> pre-content? pre-content? pre-content?
block?)]
[conferenceinfo
(-> pre-content? pre-content?
block?)]
[copyrightyear
(->* () () #:rest (listof pre-content?)
block?)]
[copyrightdata
(->* () () #:rest (listof pre-content?)
block?)]
[exclusive-license
(->* () ()
block?)]
[doi
(->* () () #:rest (listof pre-content?)
block?)]
[to-appear
(->* () () #:rest pre-content?
block?)]
[category
(->* (pre-content? pre-content? pre-content?)
((or/c #f pre-content?))
content?)]
[terms
(->* () () #:rest (listof pre-content?)
content?)]
[keywords
(->* () () #:rest (listof pre-content?)
content?)])
(provide (contract-out
[abstract (->* () () #:rest (listof pre-content?) block?)]
[subtitle (->* () () #:rest (listof pre-content?) content?)]
[authorinfo (-> pre-content? pre-content? pre-content? block?)]
[conferenceinfo (-> pre-content? pre-content? block?)]
[copyrightyear (->* () () #:rest (listof pre-content?) block?)]
[copyrightdata (->* () () #:rest (listof pre-content?) block?)]
[exclusive-license (->* () () block?)]
[doi (->* () () #:rest (listof pre-content?) block?)]
[to-appear (->* () () #:rest pre-content? block?)]
[category (->* (pre-content? pre-content? pre-content?) ((or/c #f pre-content?)) content?)]
[terms (->* () () #:rest (listof pre-content?) content?)]
[keywords (->* () () #:rest (listof pre-content?) content?)]))

(provide preprint 10pt nocopyright onecolumn noqcourier notimes
include-abstract)
39 changes: 14 additions & 25 deletions scribble-lib/scriblib/footnote.rkt
View file
Original file line number Diff line number Diff line change
@@ -44,27 +44,19 @@
(define (footnote-part . text) (do-footnote-part footnotes id))))

(define (do-footnote footnotes id text)
(let ([tag (generated-tag)]
[content (decode-content text)])
(make-traverse-element
(lambda (get set)
(set id (cons (cons
(make-element footnote-target-style
(make-element
'superscript
(counter-target footnotes tag #f)))
(define tag (generated-tag))
(define content (decode-content text))
(make-traverse-element
(lambda (get set)
(set id
(cons (cons (make-element footnote-target-style
(make-element 'superscript (counter-target footnotes tag #f)))
content)
(get id null)))
(make-element footnote-style
(list
(make-element
footnote-ref-style
(make-element
'superscript
(counter-ref footnotes tag #f)))
(make-element
footnote-content-style
content)))))))
(get id null)))
(make-element footnote-style
(list (make-element footnote-ref-style
(make-element 'superscript (counter-ref footnotes tag #f)))
(make-element footnote-content-style content))))))

(define (do-footnote-part footnotes id)
(make-part
@@ -78,9 +70,6 @@
(lambda (get set)
(make-compound-paragraph
footnote-block-style
(map (lambda (content)
(make-paragraph
footnote-block-content-style
content))
(reverse (get id null)))))))
(for/list ([content (in-list (reverse (get id null)))])
(make-paragraph footnote-block-content-style content))))))
null))
221 changes: 110 additions & 111 deletions scribble-lib/scriblib/gui-eval.rkt
View file
Original file line number Diff line number Diff line change
@@ -12,28 +12,26 @@
racket/sandbox
(for-syntax racket/base))

(define-syntax define-mr
(syntax-rules ()
[(_ mr orig)
(begin
(provide mr)
(define-syntax (mr stx)
(syntax-case stx ()
[(_ #:eval+opts the-eval get-predicate? get-render get-get-width get-get-height x (... ...))
#'(let ([the-eval-x the-eval])
(parameterize ([scribble-eval-handler (gui-eval-handler the-eval-x
get-predicate?
get-render
get-get-width
get-get-height)])
(orig #:eval the-eval-x x (... ...))))]
[(_ x (... ...))
#'(parameterize ([scribble-eval-handler (gui-eval-handler gui-eval
(λ () (gui-eval 'pict?))
(λ () (gui-eval 'draw-pict))
(λ () (gui-eval 'pict-width))
(λ () (gui-eval 'pict-height)))])
(orig #:eval gui-eval x (... ...)))])))]))
(define-syntax-rule (define-mr mr orig)
(begin
(provide mr)
(define-syntax (mr stx)
(syntax-case stx ()
[(_ #:eval+opts the-eval get-predicate? get-render get-get-width get-get-height x (... ...))
#'(let ([the-eval-x the-eval])
(parameterize ([scribble-eval-handler (gui-eval-handler the-eval-x
get-predicate?
get-render
get-get-width
get-get-height)])
(orig #:eval the-eval-x x (... ...))))]
[(_ x (... ...))
#'(parameterize ([scribble-eval-handler (gui-eval-handler gui-eval
(λ () (gui-eval 'pict?))
(λ () (gui-eval 'draw-pict))
(λ () (gui-eval 'pict-width))
(λ () (gui-eval 'pict-height)))])
(orig #:eval gui-eval x (... ...)))]))))

(define gui-eval (make-base-eval #:pretty-print? #f))

@@ -68,61 +66,63 @@
"exprs.dat"))

(define gui-eval-handler
(if mred?
(let ([eh (scribble-eval-handler)]
[log-file (open-output-file exprs-dat-file #:exists 'truncate/replace)])
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
(lambda (ev catching-exns? expr)
(write (serialize (if (syntax? expr) (syntax->datum expr) expr)) log-file)
(newline log-file)
(flush-output log-file)
(let ([result
(with-handlers ([exn:fail?
(lambda (exn)
(make-gui-exn (exn-message exn)))])
;; put the call to fixup-picts in the handlers
;; so that errors in the user-supplied predicates &
;; conversion functions show up in the rendered output
(fixup-picts (get-predicate?) (get-render) (get-get-width) (get-get-height)
(eh ev catching-exns? expr)))])
(write (serialize result) log-file)
(newline log-file)
(flush-output log-file)
(if (gui-exn? result)
(raise (make-exn:fail
(gui-exn-message result)
(current-continuation-marks)))
result)))))
(let ([log-file (with-handlers ([exn:fail:filesystem?
(lambda (exn)
(open-input-string ""))])
(open-input-file exprs-dat-file))])
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
(lambda (ev catching-exns? expr)
(with-handlers ([exn:fail? (lambda (exn)
(if catching-exns?
(raise exn)
(void)))])
(let ([v (read log-file)])
(if (eof-object? v)
(error "expression not in log file")
(let ([v (deserialize v)])
(if (equal? v (if (syntax? expr)
(syntax->datum expr)
expr))
(let ([v (read log-file)])
(if (eof-object? v)
(error "expression result missing in log file")
(let ([v (deserialize v)])
(if (gui-exn? v)
(raise (make-exn:fail
(gui-exn-message v)
(current-continuation-marks)))
v))))
(error 'mreval
"expression does not match log file: ~e versus: ~e"
expr
v)))))))))))
(cond
[mred?
(define eh (scribble-eval-handler))
(define log-file (open-output-file exprs-dat-file #:exists 'truncate/replace))
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
(lambda (ev catching-exns? expr)
(write (serialize (if (syntax? expr)
(syntax->datum expr)
expr))
log-file)
(newline log-file)
(flush-output log-file)
(let ([result (with-handlers ([exn:fail? (lambda (exn) (make-gui-exn (exn-message exn)))])
;; put the call to fixup-picts in the handlers
;; so that errors in the user-supplied predicates &
;; conversion functions show up in the rendered output
(fixup-picts (get-predicate?)
(get-render)
(get-get-width)
(get-get-height)
(eh ev catching-exns? expr)))])
(write (serialize result) log-file)
(newline log-file)
(flush-output log-file)
(if (gui-exn? result)
(raise (make-exn:fail (gui-exn-message result) (current-continuation-marks)))
result))))]
[else
(define log-file
(with-handlers ([exn:fail:filesystem? (lambda (exn) (open-input-string ""))])
(open-input-file exprs-dat-file)))
(λ (gui-eval get-predicate? get-render get-get-width get-get-height)
(lambda (ev catching-exns? expr)
(with-handlers ([exn:fail? (lambda (exn)
(if catching-exns?
(raise exn)
(void)))])
(let ([v (read log-file)])
(if (eof-object? v)
(error "expression not in log file")
(let ([v (deserialize v)])
(if (equal? v
(if (syntax? expr)
(syntax->datum expr)
expr))
(let ([v (read log-file)])
(if (eof-object? v)
(error "expression result missing in log file")
(let ([v (deserialize v)])
(if (gui-exn? v)
(raise (make-exn:fail (gui-exn-message v)
(current-continuation-marks)))
v))))
(error 'mreval
"expression does not match log file: ~e versus: ~e"
expr
v))))))))]))

(define image-counter 0)

@@ -133,41 +133,40 @@
(let loop ([v v])
(cond
[(predicate? v)
(let ([fn (build-string-path img-dir
(format "img~a.png" image-counter))])
(set! image-counter (add1 image-counter))
(let ([dc (let ([pss (make-object (gui-eval 'ps-setup%))])
(send pss set-mode 'file)
(send pss set-file (path-replace-suffix fn #".pdf"))
(parameterize ([(gui-eval 'current-ps-setup) pss])
(let ([xb (box 0)]
[yb (box 0)])
(send pss get-scaling xb yb)
(new (gui-eval 'pdf-dc%)
[interactive #f]
[width (* (unbox xb) (get-width v))]
[height (* (unbox yb) (get-height v))]))))])
(send dc start-doc "Image")
(send dc start-page)
(render v dc 0 0)
(send dc end-page)
(send dc end-doc))
(let* ([bm (make-object (gui-eval 'bitmap%)
(define fn (build-string-path img-dir (format "img~a.png" image-counter)))
(set! image-counter (add1 image-counter))
(let ([dc (let ([pss (make-object (gui-eval 'ps-setup%))])
(send pss set-mode 'file)
(send pss set-file (path-replace-suffix fn #".pdf"))
(parameterize ([(gui-eval 'current-ps-setup) pss])
(let ([xb (box 0)]
[yb (box 0)])
(send pss get-scaling xb yb)
(new (gui-eval 'pdf-dc%)
[interactive #f]
[width (* (unbox xb) (get-width v))]
[height (* (unbox yb) (get-height v))]))))])
(send dc start-doc "Image")
(send dc start-page)
(render v dc 0 0)
(send dc end-page)
(send dc end-doc))
(define bm
(make-object (gui-eval 'bitmap%)
(inexact->exact (ceiling (get-width v)))
(inexact->exact (ceiling (get-height v))))]
[dc (make-object (gui-eval 'bitmap-dc%) bm)])
(send dc set-smoothing 'aligned)
(send dc clear)
(render v dc 0 0)
(send bm save-file fn 'png)
(make-image-element
#f
(list "[image]")
;; Be sure to use a string rather than a path, because
;; it gets recorded in "exprs.dat".
(path->string (path-replace-suffix fn #""))
'(".pdf" ".png")
1.0)))]
(inexact->exact (ceiling (get-height v)))))
(define dc (make-object (gui-eval 'bitmap-dc%) bm))
(send dc set-smoothing 'aligned)
(send dc clear)
(render v dc 0 0)
(send bm save-file fn 'png)
(make-image-element #f
(list "[image]")
;; Be sure to use a string rather than a path, because
;; it gets recorded in "exprs.dat".
(path->string (path-replace-suffix fn #""))
'(".pdf" ".png")
1.0)]
[(pair? v) (cons (loop (car v))
(loop (cdr v)))]
[(serializable? v) v]
16 changes: 7 additions & 9 deletions scribble-text-lib/scribble/text/output.rkt
View file
Original file line number Diff line number Diff line change
@@ -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)]
@@ -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]))))

31 changes: 16 additions & 15 deletions scribble-text-lib/scribble/text/syntax-utils.rkt
View file
Original file line number Diff line number Diff line change
@@ -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?]