From bc2abb42c83c2f77cc1f35562e4956af63cfa068 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sat, 1 Sep 2012 18:44:50 -0700 Subject: [PATCH] Replace uses of Type? in contracts with Type/c. original commit: 8a8dc66a191342ec5de1a4dc6bec3f61d3f0f54f --- collects/typed-racket/env/global-env.rkt | 2 +- collects/typed-racket/env/init-envs.rkt | 11 +++------- collects/typed-racket/env/type-name-env.rkt | 2 +- collects/typed-racket/infer/infer-unit.rkt | 20 +++++++++---------- collects/typed-racket/infer/signatures.rkt | 4 ++-- collects/typed-racket/rep/filter-rep.rkt | 4 ++-- collects/typed-racket/rep/object-rep.rkt | 2 +- collects/typed-racket/rep/rep-utils.rkt | 20 ++++++++++++++++--- .../typed-racket/typecheck/check-below.rkt | 4 ++-- collects/typed-racket/types/printer.rkt | 16 +++++---------- collects/typed-racket/types/resolve.rkt | 2 +- collects/typed-racket/types/substitute.rkt | 8 ++++---- collects/typed-racket/types/tc-result.rkt | 2 +- 13 files changed, 50 insertions(+), 47 deletions(-) diff --git a/collects/typed-racket/env/global-env.rkt b/collects/typed-racket/env/global-env.rkt index c66cd9b1..314af04d 100644 --- a/collects/typed-racket/env/global-env.rkt +++ b/collects/typed-racket/env/global-env.rkt @@ -4,7 +4,7 @@ ;; maps identifiers to their types, updated by mutation (require "../types/tc-error.rkt" - syntax/id-table + syntax/id-table unstable/lazy-require) (provide register-type register-type-if-undefined finish-register-type diff --git a/collects/typed-racket/env/init-envs.rkt b/collects/typed-racket/env/init-envs.rkt index 507f4211..ced30315 100644 --- a/collects/typed-racket/env/init-envs.rkt +++ b/collects/typed-racket/env/init-envs.rkt @@ -55,14 +55,9 @@ `(make-Path ,(sub p) ,(if (identifier? i) `(quote-syntax ,i) i))] - [(? (lambda (e) (or (Filter? e) - (Object? e) - (PathElem? e))) - (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx vals))) - `(,(gen-constructor tag) ,@(map sub vals))] - [(? Type? - (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx key vals))) - `(,(gen-constructor tag) ,@(map sub vals))] + [(? Rep? rep) + `(,(gen-constructor (car (vector->list (struct->vector rep)))) + ,@(map sub (Rep-values rep)))] [_ (basic v)])) (define (bound-in-this-module id) diff --git a/collects/typed-racket/env/type-name-env.rkt b/collects/typed-racket/env/type-name-env.rkt index 5a846695..61ed1ec5 100644 --- a/collects/typed-racket/env/type-name-env.rkt +++ b/collects/typed-racket/env/type-name-env.rkt @@ -1,7 +1,7 @@ #lang racket/base (require "../utils/utils.rkt") -(require syntax/boundmap +(require syntax/boundmap racket/dict (env type-alias-env) (utils tc-utils) diff --git a/collects/typed-racket/infer/infer-unit.rkt b/collects/typed-racket/infer/infer-unit.rkt index 9ea58c3d..11c73213 100644 --- a/collects/typed-racket/infer/infer-unit.rkt +++ b/collects/typed-racket/infer/infer-unit.rkt @@ -27,11 +27,11 @@ (define (seen-before s t) (cons (Type-seq s) (Type-seq t))) (define/cond-contract (remember s t A) - (Type? Type? (listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?)) . -> . - (listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?))) + (Type/c Type/c (listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?)) . -> . + (listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?))) (cons (seen-before s t) A)) (define/cond-contract (seen? s t) - (Type? Type? . -> . any/c) + (Type/c Type/c . -> . any/c) (member (seen-before s t) (current-seen))) @@ -167,7 +167,7 @@ [(_ _) (fail! s t)])) (define/cond-contract (cgen/arr V X Y s-arr t-arr) - ((listof symbol?) (listof symbol?) (listof symbol?) Type? Type? . -> . cset?) + ((listof symbol?) (listof symbol?) (listof symbol?) Type/c Type/c . -> . cset?) (define (cg S T) (cgen V X Y S T)) (match* (s-arr t-arr) ;; the simplest case - no rests, drests, keywords @@ -310,10 +310,10 @@ ;; implements the V |-_X S <: T => C judgment from Pierce+Turner, extended with ;; the index variables from the TOPLAS paper (define/cond-contract (cgen V X Y S T) - ((listof symbol?) (listof symbol?) (listof symbol?) Type? Type? . -> . cset?) + ((listof symbol?) (listof symbol?) (listof symbol?) Type/c Type/c . -> . cset?) ;; useful quick loop (define/cond-contract (cg S T) - (Type? Type? . -> . cset?) + (Type/c Type/c . -> . cset?) (cgen V X Y S T)) ;; this places no constraints on any variables in X (define empty (empty-cset X Y)) @@ -578,9 +578,9 @@ ;; C : cset? - set of constraints found by the inference engine ;; Y : (listof symbol?) - index variables that must have entries -;; R : Type? - result type into which we will be substituting +;; R : Type/c - result type into which we will be substituting (define/cond-contract (subst-gen C Y R) - (cset? (listof symbol?) Type? . -> . (or/c #f substitution/c)) + (cset? (listof symbol?) Type/c . -> . (or/c #f substitution/c)) (define var-hash (free-vars-hash (free-vars* R))) (define idx-hash (free-vars-hash (free-idxs* R))) ;; v : Symbol - variable for which to check variance @@ -687,7 +687,7 @@ ;; produces a cset which determines a substitution that makes the Ss subtypes of the Ts (define/cond-contract (cgen/list V X Y S T #:expected-cset [expected-cset (empty-cset '() '())]) - (((listof symbol?) (listof symbol?) (listof symbol?) (listof Type?) (listof Type?)) + (((listof symbol?) (listof symbol?) (listof symbol?) (listof Type/c) (listof Type/c)) (#:expected-cset cset?) . ->* . cset?) (unless (= (length S) (length T)) (fail! S T)) @@ -712,7 +712,7 @@ (define infer (let () (define/cond-contract (infer X Y S T R [expected #f]) - (((listof symbol?) (listof symbol?) (listof Type/c) (listof Type/c) Type?) ((or/c #f Type?)) . ->* . (or/c boolean? substitution/c)) + (((listof symbol?) (listof symbol?) (listof Type/c) (listof Type/c) Type/c) ((or/c #f Type/c)) . ->* . (or/c boolean? substitution/c)) (with-handlers ([exn:infer? (lambda _ #f)]) (let* ([expected-cset (if expected (cgen null X Y R expected) diff --git a/collects/typed-racket/infer/signatures.rkt b/collects/typed-racket/infer/signatures.rkt index 64ad524d..14f02ee7 100644 --- a/collects/typed-racket/infer/signatures.rkt +++ b/collects/typed-racket/infer/signatures.rkt @@ -59,5 +59,5 @@ ((or/c #f Values? ValuesDots? Result? Type/c)) . ->* . any)] [cond-contracted infer/dots (((listof symbol?) symbol? - (listof Type/c) (listof Type/c) Type/c Type? (listof symbol?)) - (#:expected (or/c #f Type?)) . ->* . any)])) + (listof Type/c) (listof Type/c) Type/c Type/c (listof symbol?)) + (#:expected (or/c #f Type/c)) . ->* . any)])) diff --git a/collects/typed-racket/rep/filter-rep.rkt b/collects/typed-racket/rep/filter-rep.rkt index 4c0a5168..8bb54aa3 100644 --- a/collects/typed-racket/rep/filter-rep.rkt +++ b/collects/typed-racket/rep/filter-rep.rkt @@ -19,12 +19,12 @@ (def-filter Bot () [#:fold-rhs #:base]) (def-filter Top () [#:fold-rhs #:base]) -(def-filter TypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c]) +(def-filter TypeFilter ([t Type/c] [p (listof PathElem?)] [v name-ref/c]) [#:intern (list (Rep-seq t) (map Rep-seq p) (hash-name v))] [#:frees (λ (f) (combine-frees (map f (cons t p))))] [#:fold-rhs (*TypeFilter (type-rec-id t) (map pathelem-rec-id p) v)]) -(def-filter NotTypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c]) +(def-filter NotTypeFilter ([t Type/c] [p (listof PathElem?)] [v name-ref/c]) [#:intern (list (Rep-seq t) (map Rep-seq p) (hash-name v))] [#:frees (λ (f) (combine-frees (map f (cons t p))))] [#:fold-rhs (*NotTypeFilter (type-rec-id t) (map pathelem-rec-id p) v)]) diff --git a/collects/typed-racket/rep/object-rep.rkt b/collects/typed-racket/rep/object-rep.rkt index 69ccc76d..9f5877a3 100644 --- a/collects/typed-racket/rep/object-rep.rkt +++ b/collects/typed-racket/rep/object-rep.rkt @@ -7,7 +7,7 @@ (def-pathelem CdrPE () [#:fold-rhs #:base]) (def-pathelem SyntaxPE () [#:fold-rhs #:base]) ;; t is always a Name (can't put that into the contract b/c of circularity) -(def-pathelem StructPE ([t Type?] [idx natural-number/c]) +(def-pathelem StructPE ([t Type/c] [idx natural-number/c]) [#:frees (λ (f) (f t))] [#:fold-rhs (*StructPE (type-rec-id t) idx)]) diff --git a/collects/typed-racket/rep/rep-utils.rkt b/collects/typed-racket/rep/rep-utils.rkt index 04759ac6..604511df 100644 --- a/collects/typed-racket/rep/rep-utils.rkt +++ b/collects/typed-racket/rep/rep-utils.rkt @@ -353,9 +353,23 @@ [Object def-object #:Object object-case print-object object-name-ht object-rec-id] [PathElem def-pathelem #:PathElem pathelem-case print-pathelem pathelem-name-ht pathelem-rec-id]) -(provide PathElem? (rename-out [Rep-seq Type-seq] - [Rep-free-vars free-vars*] - [Rep-free-idxs free-idxs*])) +(define (Rep-values rep) + (match rep + [(? (lambda (e) (or (Filter? e) + (Object? e) + (PathElem? e))) + (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx vals))) + vals] + [(? Type? + (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx key vals))) + vals])) + + +(provide + Rep-values + (rename-out [Rep-seq Type-seq] + [Rep-free-vars free-vars*] + [Rep-free-idxs free-idxs*])) (provide/cond-contract (struct Rep ([seq exact-nonnegative-integer?] [free-vars (hash/c symbol? variance?)] diff --git a/collects/typed-racket/typecheck/check-below.rkt b/collects/typed-racket/typecheck/check-below.rkt index 3b153941..fc9e989e 100644 --- a/collects/typed-racket/typecheck/check-below.rkt +++ b/collects/typed-racket/typecheck/check-below.rkt @@ -12,8 +12,8 @@ (only-in srfi/1 split-at)) (provide/cond-contract - [check-below (-->d ([s (-or/c Type/c tc-results?)] [t (-or/c Type/c tc-results?)]) () [_ (if (Type? s) Type/c tc-results?)])] - [cond-check-below (-->d ([s (-or/c Type/c tc-results?)] [t (-or/c #f Type/c tc-results?)]) () [_ (if (Type? s) Type/c tc-results?)])]) + [check-below (-->d ([s (-or/c Type/c tc-results?)] [t (-or/c Type/c tc-results?)]) () [_ (if (Type/c s) Type/c tc-results?)])] + [cond-check-below (-->d ([s (-or/c Type/c tc-results?)] [t (-or/c #f Type/c tc-results?)]) () [_ (if (Type/c s) Type/c tc-results?)])]) (define (print-object o) (match o diff --git a/collects/typed-racket/types/printer.rkt b/collects/typed-racket/types/printer.rkt index ac1068db..fdcc44d4 100644 --- a/collects/typed-racket/types/printer.rkt +++ b/collects/typed-racket/types/printer.rkt @@ -328,22 +328,16 @@ #'(begin (require racket/pretty) (require mzlib/pconvert) - + (define (converter v basic sub) (define (gen-constructor sym) (string->symbol (string-append "make-" (substring (symbol->string sym) 7)))) (match v - [(? (lambda (e) (or (Filter? e) - (Object? e) - (PathElem? e))) - (app (lambda (v) (vector->list (struct->vector v))) - (list-rest tag seq fv fi stx vals))) - `(,(gen-constructor tag) ,@(map sub vals))] - [(? Type? - (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx key vals))) - `(,(gen-constructor tag) ,@(map sub vals))] + [(? Rep? rep) + `(,(gen-constructor (car (vector->list (struct->vector rep)))) + ,@(map sub (Rep-values rep)))] [_ (basic v)])) - + (define (debug-printer v port write?) ((if write? pretty-write pretty-print) (parameterize ((current-print-convert-hook converter)) diff --git a/collects/typed-racket/types/resolve.rkt b/collects/typed-racket/types/resolve.rkt index c54cc3f4..ba16448f 100644 --- a/collects/typed-racket/types/resolve.rkt +++ b/collects/typed-racket/types/resolve.rkt @@ -17,7 +17,7 @@ (define (resolve-name t) (match t [(Name: n) (let ([t (lookup-type-name n)]) - (if (Type? t) t #f))] + (if (Type/c t) t #f))] [_ (int-err "resolve-name: not a name ~a" t)])) (define already-resolving? (make-parameter #f)) diff --git a/collects/typed-racket/types/substitute.rkt b/collects/typed-racket/types/substitute.rkt index 0f642e71..516ff918 100644 --- a/collects/typed-racket/types/substitute.rkt +++ b/collects/typed-racket/types/substitute.rkt @@ -37,7 +37,7 @@ ;; substitute-many : Hash[Name,Type] Type -> Type (define/cond-contract (substitute-many subst target #:Un [Un (lambda (args) (apply Un args))]) - ((simple-substitution/c Type?) (#:Un procedure?) . ->* . Type?) + ((simple-substitution/c Type/c) (#:Un procedure?) . ->* . Type/c) (define (sb t) (substitute-many subst t #:Un Un)) (define names (hash-keys subst)) (define fvs (free-vars* target)) @@ -74,13 +74,13 @@ ;; substitute : Type Name Type -> Type (define/cond-contract (substitute image name target #:Un [Un (lambda (args) (apply Un args))]) - ((Type/c symbol? Type?) (#:Un procedure?) . ->* . Type?) + ((Type/c symbol? Type/c) (#:Un procedure?) . ->* . Type/c) (substitute-many (hash name image) target #:Un Un)) ;; implements angle bracket substitution from the formalism ;; substitute-dots : Listof[Type] Option[type] Name Type -> Type (define/cond-contract (substitute-dots images rimage name target) - ((listof Type/c) (or/c #f Type/c) symbol? Type? . -> . Type?) + ((listof Type/c) (or/c #f Type/c) symbol? Type/c . -> . Type/c) (define (sb t) (substitute-dots images rimage name t)) (if (or (set-member? (free-vars-names (free-idxs* target)) name) (set-member? (free-vars-names (free-vars* target)) name)) @@ -157,7 +157,7 @@ ;; substitution = Listof[U List[Name,Type] List[Name,Listof[Type]]] ;; subst-all : substitution Type -> Type (define/cond-contract (subst-all s ty) - (substitution/c Type? . -> . Type?) + (substitution/c Type/c . -> . Type/c) (define t-substs (for/fold ([acc (hash)]) ([(v r) (in-hash s)]) diff --git a/collects/typed-racket/types/tc-result.rkt b/collects/typed-racket/types/tc-result.rkt index b5896e2e..cbe4f5c1 100644 --- a/collects/typed-racket/types/tc-result.rkt +++ b/collects/typed-racket/types/tc-result.rkt @@ -113,4 +113,4 @@ [tc-result? (any/c . -> . boolean?)] [tc-result-t (tc-result? . -> . Type/c)] [tc-result-equal? (tc-result? tc-result? . -> . boolean?)] - [tc-results? (any/c . -> . boolean?)]) \ No newline at end of file + [tc-results? (any/c . -> . boolean?)])