Skip to content

Automated Resyntax fixes #1416

New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

Open
wants to merge 16 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
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
41 changes: 22 additions & 19 deletions typed-racket-lib/typed-racket/core.rkt
Original file line number Diff line number Diff line change
@@ -1,25 +1,26 @@
#lang racket/base

(require (rename-in "utils/utils.rkt")
(for-syntax racket/base)
(for-template racket/base)
"private/with-types.rkt"
"private/type-contract.rkt"
(except-in syntax/parse id)
racket/match racket/syntax
(require (for-syntax racket/base)
(for-template racket/base
"base-env/top-interaction.rkt")
racket/match
racket/syntax
syntax/flatten-begin
"types/utils.rkt"
"types/abbrev.rkt"
"types/generalize.rkt"
(rename-in "utils/utils.rkt")
(except-in syntax/parse id)
"private/type-contract.rkt"
"private/with-types.rkt"
"rep/type-rep.rkt"
"standard-inits.rkt"
"tc-setup.rkt"
"typecheck/provide-handling.rkt"
"typecheck/tc-app-helper.rkt"
"rep/type-rep.rkt"
(for-template "base-env/top-interaction.rkt")
"utils/utils.rkt"
"utils/tc-utils.rkt"
"types/abbrev.rkt"
"types/generalize.rkt"
"types/utils.rkt"
"utils/arm.rkt"
"standard-inits.rkt"
"tc-setup.rkt")
"utils/tc-utils.rkt"
"utils/utils.rkt")

(provide mb-core ti-core wt-core wt-core-shallow wt-core-optional)

Expand Down Expand Up @@ -48,10 +49,12 @@
(and (attribute opt?) (syntax-e (attribute opt?))))]
[with-refinements? (and (or (attribute refinement-reasoning?)
(with-refinements?))
(when (not (eq? te-mode deep))
(unless (eq? te-mode deep)
(raise-arguments-error
(string->symbol (format "typed/racket/~a" (keyword->string (syntax-e te-attr))))
"#:with-refinements unsupported")))])
(string->symbol (format "typed/racket/~a"
(keyword->string
(syntax-e te-attr))))
"#:with-refinements unsupported")))])
(tc-module/full te-mode stx pmb-form
(λ (new-mod pre-before-code pre-after-code)
(define ctc-cache (make-hash))
Expand Down
91 changes: 41 additions & 50 deletions typed-racket-lib/typed-racket/logic/ineq.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -99,9 +99,8 @@

;; Leq to the internal leq rep
(define (Leq->leq l)
(match l
[(LeqProp: (LExp: c1 ts1) (LExp: c2 ts2))
(leq (lexp c1 ts1) (lexp c2 ts2))]))
(match-define (LeqProp: (LExp: c1 ts1) (LExp: c2 ts2)) l)
(leq (lexp c1 ts1) (lexp c2 ts2)))


;; *****************************************************************************
Expand Down Expand Up @@ -215,10 +214,8 @@
[(eqv? a 0) (lexp 0 (make-terms))]
[(= a 1) exp]
[else
(match exp
[(lexp: c h)
(lexp (* c a)
(terms-scale h a))])]))
(match-define (lexp: c h) exp)
(lexp (* c a) (terms-scale h a))]))

(module+ test
(check-equal? (lexp-set (lexp* 17 '(42 x)) 'x 0)
Expand Down Expand Up @@ -332,13 +329,15 @@
(-> lexp? (-> any/c any/c) string?)
(define vars (terms-vars (lexp-vars e)))
(define const (lexp-const e))
(define term->string
(λ (x) (string-append (if (= 1 (lexp-coeff e x))
""
(number->string (lexp-coeff e x)))
"(" (if pp
(pp x)
(~a x)) ")")))
(define (term->string x)
(string-append (if (= 1 (lexp-coeff e x))
""
(number->string (lexp-coeff e x)))
"("
(if pp
(pp x)
(~a x))
")"))
(cond
[(terms-empty? vars) (number->string const)]
[(zero? const)
Expand Down Expand Up @@ -487,21 +486,18 @@
;; leq2: ... + cx + .... <= ... + dx + ...
(let-values ([(l1 r1) (leq-lexps leq1)]
[(l2 r2) (leq-lexps leq2)])
(let ([a (lexp-coeff l1 x)] [b (lexp-coeff r1 x)]
[c (lexp-coeff l2 x)] [d (lexp-coeff r2 x)])
(cond
;; leq1: ax <= lexp1
;; leq2: lexp2 <= dx
[(and (eqv? 0 b) (eqv? 0 c))
(leq (lexp-scale l2 a)
(lexp-scale r1 d))]
;; leq1: lexp1 <= bx
;; leq2: cx <= lexp2
[(and (eqv? 0 a) (eqv? 0 d))
(leq (lexp-scale l1 c)
(lexp-scale r2 b))]
[else
(error 'leq-join "cannot join ~a and ~a by ~a" leq1 leq2 x)]))))
(define a (lexp-coeff l1 x))
(define b (lexp-coeff r1 x))
(define c (lexp-coeff l2 x))
(define d (lexp-coeff r2 x))
(cond
;; leq1: ax <= lexp1
;; leq2: lexp2 <= dx
[(and (eqv? 0 b) (eqv? 0 c)) (leq (lexp-scale l2 a) (lexp-scale r1 d))]
;; leq1: lexp1 <= bx
;; leq2: cx <= lexp2
[(and (eqv? 0 a) (eqv? 0 d)) (leq (lexp-scale l1 c) (lexp-scale r2 b))]
[else (error 'leq-join "cannot join ~a and ~a by ~a" leq1 leq2 x)])))

(module+ test
(check-equal? (leq-join (leq (lexp* '(2 x))
Expand Down Expand Up @@ -600,36 +596,31 @@
(values xlhs xrhs (cons ineq nox))]))))

(module+ test
(check-equal? (let-values ([(lt gt no)
(sli-partition (list (leq (lexp* '(2 x) '(4 y) 1)
(lexp* '(2 y))))
'x)])
(list lt gt no))
(check-equal? (call-with-values
(λ () (sli-partition (list (leq (lexp* '(2 x) '(4 y) 1) (lexp* '(2 y)))) 'x))
list)
(list (list (leq (lexp* '(2 x))
(lexp* '(-2 y) -1)))
(list)
(list)))
(check-equal? (let-values ([(lt gt no)
(sli-partition (list (leq (lexp* '(2 x) '(4 y) 1)
(lexp* '(2 y)))
(leq (lexp* '(2 x) '(4 y))
(lexp* '(2 y) '(42 x))))
'x)])
(list lt gt no))
(check-equal? (call-with-values (λ ()
(sli-partition (list (leq (lexp* '(2 x) '(4 y) 1) (lexp* '(2 y)))
(leq (lexp* '(2 x) '(4 y))
(lexp* '(2 y) '(42 x))))
'x))
list)
(list (list (leq (lexp* '(2 x))
(lexp* '(-2 y) -1)))
(list (leq (lexp* '(2 y))
(lexp* '(40 x))))
(list)))
(check-equal? (let-values ([(lt gt no)
(sli-partition (list (leq (lexp* '(2 x) '(4 y) -1)
(lexp* '(2 y)))
(leq (lexp* '(2 x) '(4 y))
(lexp* '(2 y) '(42 x)))
(leq (lexp* '(2 z) '(4 y))
(lexp* '(2 y) '(42 q))))
'x)])
(list lt gt no))
(check-equal? (call-with-values
(λ ()
(sli-partition (list (leq (lexp* '(2 x) '(4 y) -1) (lexp* '(2 y)))
(leq (lexp* '(2 x) '(4 y)) (lexp* '(2 y) '(42 x)))
(leq (lexp* '(2 z) '(4 y)) (lexp* '(2 y) '(42 q))))
'x))
list)
(list (list (leq (lexp* '(2 x))
(lexp* '(-2 y) 1)))
(list (leq (lexp* '(2 y))
Expand Down
12 changes: 6 additions & 6 deletions typed-racket-lib/typed-racket/rep/base-type-rep.rkt
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
#lang racket/base

(require "rep-utils.rkt"
"core-rep.rkt"
"type-mask.rkt"
racket/match
(for-syntax racket/base
(require (for-syntax racket/base
racket/syntax
syntax/parse))
syntax/parse)
racket/match
"core-rep.rkt"
"rep-utils.rkt"
"type-mask.rkt")

(provide define-base-types
Base-bits:
Expand Down
12 changes: 5 additions & 7 deletions typed-racket-lib/typed-racket/rep/base-union.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -59,10 +59,8 @@
(app BaseUnion-bases bases)))])))

(define (BaseUnion-bases t)
(match t
[(BaseUnion: bbits nbits)
(cond
[(eqv? bbits 0) (nbits->base-types nbits)]
[(eqv? nbits 0) (bbits->base-types bbits)]
[else (append (bbits->base-types bbits)
(nbits->base-types nbits))])]))
(match-define (BaseUnion: bbits nbits) t)
(cond
[(eqv? bbits 0) (nbits->base-types nbits)]
[(eqv? nbits 0) (bbits->base-types bbits)]
[else (append (bbits->base-types bbits) (nbits->base-types nbits))]))
2 changes: 1 addition & 1 deletion typed-racket-lib/typed-racket/rep/core-rep.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -247,7 +247,7 @@
(-> Result? Result?)
(match-define (Result: type propset optobject n-existentials) result)
(cond
[(> n-existentials 0)
[(positive? n-existentials)
(define syms (hash-ref type-var-name-table result (build-list n-existentials (lambda _ (gensym)))))
(define vars (map make-F syms))
(make-Result (instantiate-type type vars) (instantiate-propset propset vars) optobject n-existentials)]
Expand Down
8 changes: 3 additions & 5 deletions typed-racket-lib/typed-racket/rep/free-ids.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -69,11 +69,9 @@
(cond
[(member x seen free-identifier=?) (cons x seen)]
[else
(begin0
(let ([seen+x (cons x seen)])
(for/or ([neighbor (in-list (cdr (assoc x deps free-identifier=?)))])
(and (not (member neighbor visited free-identifier=?))
(visit neighbor seen+x))))
(define seen+x (cons x seen))
(begin0 (for/or ([neighbor (in-list (cdr (assoc x deps free-identifier=?)))])
(and (not (member neighbor visited free-identifier=?)) (visit neighbor seen+x)))
(set! visited (cons x visited)))]))
(match (for/or ([entry (in-list deps)])
(visit (car entry) '()))
Expand Down
24 changes: 10 additions & 14 deletions typed-racket-lib/typed-racket/rep/free-variance.rkt
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
#lang racket/base
(require racket/match
racket/set
(require racket/lazy-require
racket/list
"../rep/type-constr.rkt"
"../utils/utils.rkt"
racket/lazy-require
racket/match
racket/set
"../env/type-constr-env.rkt"
"../private/user-defined-type-constr.rkt"
"../env/type-constr-env.rkt")
"../rep/type-constr.rkt"
"../utils/utils.rkt")

(provide
;; Variances
Expand Down Expand Up @@ -123,18 +123,14 @@
(for/fold ([hash (hasheq)]
[computed null])
([frees (in-list freess)])
(match frees
[(combined-frees new-hash new-computed)
(values (combine-hashes (list hash new-hash))
(append new-computed computed))])))
(match-define (combined-frees new-hash new-computed) frees)
(values (combine-hashes (list hash new-hash)) (append new-computed computed))))
(combined-frees hash computed))


(define (free-vars-remove frees name)
(match frees
[(combined-frees hash computed)
(combined-frees (hash-remove hash name)
(map (λ (v) (remove-frees v name)) computed))]))
(match-define (combined-frees hash computed) frees)
(combined-frees (hash-remove hash name) (map (λ (v) (remove-frees v name)) computed)))

;;
(define (free-vars-names vars)
Expand Down
17 changes: 7 additions & 10 deletions typed-racket-lib/typed-racket/rep/object-rep.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -268,10 +268,10 @@
[(list (? exact-integer? coeff) (? Path? p))
(values c (terms-set ts p (+ coeff (terms-ref ts p))))]
[(list (? exact-integer? coeff) (? name-ref/c nm))
(let ([p (-id-path nm)])
(if (Empty? nm)
(values c ts)
(values c (terms-set ts p (+ coeff (terms-ref ts p))))))]
(define p (-id-path nm))
(if (Empty? nm)
(values c ts)
(values c (terms-set ts p (+ coeff (terms-ref ts p)))))]
[(? exact-integer? new-const)
(values (+ new-const c) ts)]
[(LExp: c* ts*)
Expand Down Expand Up @@ -313,9 +313,7 @@
(-> OptObject? (or/c #f exact-integer?))
(match l
[(LExp: c terms)
(if (hash-empty? terms)
c
#f)]
(and (hash-empty? terms) c)]
[_ #f]))

(define/cond-contract (in-LExp? obj l)
Expand Down Expand Up @@ -388,6 +386,5 @@
(make-LExp* (+ c1 c2) (terms-add terms1 terms2))]))

(define (add-path-to-lexp p l)
(match l
[(LExp: const terms)
(make-LExp* const (terms-set terms p (add1 (terms-ref terms p))))]))
(match-define (LExp: const terms) l)
(make-LExp* const (terms-set terms p (add1 (terms-ref terms p)))))
3 changes: 1 addition & 2 deletions typed-racket-lib/typed-racket/rep/prop-rep.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -143,8 +143,7 @@
[#:for-each (f) (for-each f ps)]
[#:custom-constructor/contract
(-> (listof (or/c TypeProp? NotTypeProp? LeqProp?)) OrProp?)
(let ([ps (sort ps (λ (p q) (unsafe-fx<= (eq-hash-code p)
(eq-hash-code q))))])
(let ([ps (sort ps unsafe-fx<= #:key eq-hash-code)])
(intern-single-ref!
orprop-intern-table
ps
Expand Down
12 changes: 6 additions & 6 deletions typed-racket-lib/typed-racket/rep/rep-switch.rkt
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
#lang racket/base

(require "rep-utils.rkt"
(require (for-syntax racket/base
racket/list
racket/syntax
syntax/parse)
racket/match
racket/unsafe/ops
(for-syntax racket/base
syntax/parse
racket/list
racket/syntax))
"rep-utils.rkt")

(provide define-rep-switch)

Expand Down Expand Up @@ -35,7 +35,7 @@
(~var clause (switch-clause #'(pre-args ...) #'arg #'(post-args ...))) ...
[(~datum else:) . default])
(define name-symbols (map syntax->datum (syntax->list #'(clause.name ...))))
(unless (not (null? name-symbols))
(when (null? name-symbols)
(raise-syntax-error 'define-switch "switch cannot be null" stx))
(define sorted-name-symbols (sort name-symbols symbol<?))
(unless (eq? (first name-symbols) (first sorted-name-symbols))
Expand Down
Loading