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

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

Automated Resyntax fixes #1426

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
c7a4aeb
Fix 37 occurrences of `single-clause-match-to-match-define`
resyntax-ci[bot] Jan 10, 2025
f14fb48
Fix 3 occurrences of `let-to-define`
resyntax-ci[bot] Jan 10, 2025
1b11c20
Fix 1 occurrence of `if-begin-to-cond`
resyntax-ci[bot] Jan 10, 2025
ad28f67
Fix 1 occurrence of `if-else-false-to-and`
resyntax-ci[bot] Jan 10, 2025
b7540e2
Fix 1 occurrence of `map-to-for`
resyntax-ci[bot] Jan 10, 2025
8fae220
Fix 1 occurrence of `define-lambda-to-define`
resyntax-ci[bot] Jan 10, 2025
09d9e92
Fix 2 occurrences of `always-throwing-if-to-when`
resyntax-ci[bot] Jan 10, 2025
16a98c9
Fix 2 occurrences of `inline-unnecessary-define`
resyntax-ci[bot] Jan 10, 2025
53abe9c
Fix 1 occurrence of `define-let-to-double-define`
resyntax-ci[bot] Jan 10, 2025
833c1f7
Fix 1 occurrence of `if-let-to-cond`
resyntax-ci[bot] Jan 10, 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
37 changes: 19 additions & 18 deletions typed-racket-lib/typed-racket/static-contracts/combinators/case-lambda.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,12 +45,15 @@
(arr-seq-sc-map f (combinator-args v))
(void))
(define (sc->contract v f)
(match v
[(arr-combinator (arr-seq args rest range))
(with-syntax ([(arg-stx ...) (map f args)]
[(rest-stx ...) (if rest #`(#:rest #,(f rest)) #'())]
[range-stx (if range #`(values #,@(map f range)) #'any)])
#'(arg-stx ... rest-stx ... . -> . range-stx))]))
(match-define (arr-combinator (arr-seq args rest range)) v)
(with-syntax ([(arg-stx ...) (map f args)]
[(rest-stx ...) (if rest
#`(#:rest #,(f rest))
#'())]
[range-stx (if range
#`(values #,@(map f range))
#'any)])
#'(arg-stx ... rest-stx ... . -> . range-stx)))
(define (sc->constraints v f)
(merge-restricts* 'chaperone (map f (arr-seq->list (combinator-args v)))))])

Expand All @@ -66,20 +69,18 @@


(define (arr-seq-sc-map f seq)
(match seq
[(arr-seq args rest range)
(arr-seq
(map (λ (a) (f a 'contravariant)) args)
(and rest (f rest 'contravariant))
(and range (map (λ (a) (f a 'covariant)) range)))]))
(match-define (arr-seq args rest range) seq)
(arr-seq (map (λ (a) (f a 'contravariant)) args)
(and rest (f rest 'contravariant))
(and range (map (λ (a) (f a 'covariant)) range))))

(define (arr-seq->list seq)
(match seq
[(arr-seq args rest range)
(append
args
(if rest (list rest) empty)
(or range empty))]))
(match-define (arr-seq args rest range) seq)
(append args
(if rest
(list rest)
empty)
(or range empty)))


(struct arr-seq (args rest range)
Expand Down
31 changes: 12 additions & 19 deletions typed-racket-lib/typed-racket/static-contracts/combinators/control.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,14 +24,12 @@
(pt-seq-map f (combinator-args v))
(void))
(define (sc->contract v f)
(match v
[(prompt-tag-combinator (pt-seq vals call-cc))
(with-syntax ([(vals-stx ...) (map f vals)]
[(call-cc-stx ...)
(if call-cc
#`(#:call/cc (values #,@(map f call-cc)))
empty)])
#'(prompt-tag/c vals-stx ... call-cc-stx ...))]))
(match-define (prompt-tag-combinator (pt-seq vals call-cc)) v)
(with-syntax ([(vals-stx ...) (map f vals)]
[(call-cc-stx ...) (if call-cc
#`(#:call/cc (values #,@(map f call-cc)))
empty)])
#'(prompt-tag/c vals-stx ... call-cc-stx ...)))
(define (sc->constraints v f)
(merge-restricts* 'chaperone (map f (pt-seq->list (combinator-args v)))))])

Expand All @@ -52,16 +50,11 @@


(define (pt-seq-map f seq)
(match seq
[(pt-seq vals call-cc)
(define (f* a) (f a 'invariant))
(pt-seq
(map f* vals)
(and call-cc (map f* call-cc)))]))
(match-define (pt-seq vals call-cc) seq)
(define (f* a)
(f a 'invariant))
(pt-seq (map f* vals) (and call-cc (map f* call-cc))))

(define (pt-seq->list seq)
(match seq
[(pt-seq vals call-cc)
(append
vals
(or call-cc empty))]))
(match-define (pt-seq vals call-cc) seq)
(append vals (or call-cc empty)))
107 changes: 53 additions & 54 deletions typed-racket-lib/typed-racket/static-contracts/combinators/dep-function.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,64 +25,63 @@
#:property prop:combinator-name "dep->/sc"
#:methods gen:sc
[(define (sc->contract v rec)
(match v
[(->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps)
(with-syntax ([(id ...) ids]
[(c ...) (for/list ([d/sc (in-list dom/scs)]
[dep-ids (in-list dom-deps)])
(cond
[(not (null? dep-ids))
(parameterize ([static-contract-may-contain-free-ids? #t])
(rec d/sc))]
[else (rec d/sc)]))]
[(dep ...) dom-deps]
[(r-deps ...) rng-deps]
[(p-deps ...) pre-deps])
#`(->i ([id dep c] ...)
#,@(cond
[(not pre) #'()]
[else #`(#:pre (p-deps ...)
#,(cond
[(not (null? pre-deps))
(parameterize ([static-contract-may-contain-free-ids? #t])
(rec pre))]
[else (rec pre)]))])
#,(cond
[(and typed-side? (andmap any/sc? rng-deps)) #'any]
[(null? rng-deps)
#`[_ () (values #,@(map rec rng/scs))]]
[else
(parameterize ([static-contract-may-contain-free-ids? #t])
#`[_ (r-deps ...) (values #,@(map rec rng/scs))])])))]))
(match-define (->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps) v)
(with-syntax ([(id ...) ids]
[(c ...) (for/list ([d/sc (in-list dom/scs)]
[dep-ids (in-list dom-deps)])
(cond
[(not (null? dep-ids))
(parameterize ([static-contract-may-contain-free-ids? #t])
(rec d/sc))]
[else (rec d/sc)]))]
[(dep ...) dom-deps]
[(r-deps ...) rng-deps]
[(p-deps ...) pre-deps])
#`(->i ([id dep c] ...)
#,@(cond
[(not pre) #'()]
[else
#`(#:pre (p-deps ...)
#,(cond
[(not (null? pre-deps))
(parameterize ([static-contract-may-contain-free-ids? #t])
(rec pre))]
[else (rec pre)]))])
#,(cond
[(and typed-side? (andmap any/sc? rng-deps)) #'any]
[(null? rng-deps) #`[_ () (values #,@(map rec rng/scs))]]
[else
(parameterize ([static-contract-may-contain-free-ids? #t])
#`[_ (r-deps ...) (values #,@(map rec rng/scs))])]))))
(define (sc-map v f)
(match v
[(->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps)
(->i/sc typed-side?
ids
(for/list ([d/sc (in-list dom/scs)])
(f d/sc 'contravariant))
dom-deps
(and pre (f pre 'contravariant))
pre-deps
(for/list ([r/sc (in-list rng/scs)])
(f r/sc 'covariant))
rng-deps)]))
(match-define (->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps) v)
(->i/sc typed-side?
ids
(for/list ([d/sc (in-list dom/scs)])
(f d/sc 'contravariant))
dom-deps
(and pre (f pre 'contravariant))
pre-deps
(for/list ([r/sc (in-list rng/scs)])
(f r/sc 'covariant))
rng-deps))
(define (sc-traverse v f)
(match v
[(->i/sc _ _ dom/scs _ pre _ rng/scs _)
(for ([d/sc (in-list dom/scs)])
(f d/sc 'contravariant))
(when pre (f pre 'contravariant))
(for ([r/sc (in-list rng/scs)])
(f r/sc 'covariant))]))
(match-define (->i/sc _ _ dom/scs _ pre _ rng/scs _) v)
(for ([d/sc (in-list dom/scs)])
(f d/sc 'contravariant))
(when pre
(f pre 'contravariant))
(for ([r/sc (in-list rng/scs)])
(f r/sc 'covariant)))
(define (sc-terminal-kind v) 'impersonator)
(define (sc->constraints v f)
(match v
[(->i/sc _ _ dom/scs _ pre _ rng/scs _)
(merge-restricts* 'impersonator
(append (if pre (list (f pre)) (list))
(map f rng/scs)
(map f dom/scs)))]))])
(match-define (->i/sc _ _ dom/scs _ pre _ rng/scs _) v)
(merge-restricts* 'impersonator
(append (if pre
(list (f pre))
(list))
(map f rng/scs)
(map f dom/scs))))])

(require-for-cond-contract "proposition.rkt")

Expand Down
10 changes: 4 additions & 6 deletions typed-racket-lib/typed-racket/static-contracts/combinators/exist.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,12 +29,10 @@
(define (sc->contract v f)
(match-define (exist-combinator (list names doms rngs)) v)
(parameterize ([static-contract-may-contain-free-ids? #t])
(define a
(with-syntax ([doms-stx (f doms)]
[rngs-stx (f rngs)]
[n (car names)])
#'(->i ([n doms-stx]) (_ (n) rngs-stx))))
a))
(with-syntax ([doms-stx (f doms)]
[rngs-stx (f rngs)]
[n (car names)])
#'(->i ([n doms-stx]) (_ (n) rngs-stx)))))
(define (sc->constraints v f)
(simple-contract-restrict 'flat))])

Expand Down
11 changes: 4 additions & 7 deletions typed-racket-lib/typed-racket/static-contracts/combinators/function.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -146,13 +146,10 @@
(match-define (function-combinator args indices mand-kws opt-kws typed-side?) v)
(define-values (mand-args opt-args mand-kw-args opt-kw-args rest-arg range-args)
(apply split-function-args args indices))
(if (and (not rest-arg)
(null? (append mand-kw-args mand-args opt-kw-args opt-args))
typed-side?)
;; currently we only handle this trivial case
;; we could probably look at the actual kind of `range-args` as well
(if (not range-args) 'flat #f)
#f))
(and (and (not rest-arg) (null? (append mand-kw-args mand-args opt-kw-args opt-args)) typed-side?)
;; currently we only handle this trivial case
;; we could probably look at the actual kind of `range-args` as well
(if (not range-args) 'flat #f)))


(define (function-sc-constraints v f)
Expand Down
Loading
Loading