suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use more descriptive variable names.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-05-18 14:16:06 -04:00
parent c02071b262
commit 027947eef2
4 changed files with 268 additions and 267 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/typed-scheme/rep/filter-rep.rkt
View File

@ -17,35 +17,35 @@
(define name-ref/c (or/c identifier? integer?))
(define (hash-name v) (if (identifier? v) (hash-id v) (list v)))
(df Bot () [#:fold-rhs #:base])
(df Top () [#:fold-rhs #:base])
(def-filter Bot () [#:fold-rhs #:base])
(def-filter Top () [#:fold-rhs #:base])
(df TypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c])
(def-filter TypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c])
[#:intern (list t p (hash-name v))]
[#:frees (combine-frees (map free-vars* (cons t p)))
(combine-frees (map free-idxs* (cons t p)))]
[#:fold-rhs (*TypeFilter (type-rec-id t) (map pathelem-rec-id p) v)])
(df NotTypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c])
(def-filter NotTypeFilter ([t Type?] [p (listof PathElem?)] [v name-ref/c])
[#:intern (list t p (hash-name v))]
[#:frees (combine-frees (map free-vars* (cons t p)))
(combine-frees (map free-idxs* (cons t p)))]
[#:fold-rhs (*NotTypeFilter (type-rec-id t) (map pathelem-rec-id p) v)])
;; implication
(df ImpFilter ([a Filter/c] [c Filter/c]))
(def-filter ImpFilter ([a Filter/c] [c Filter/c]))
(df AndFilter ([fs (non-empty-listof Filter/c)])
(def-filter AndFilter ([fs (non-empty-listof Filter/c)])
[#:fold-rhs (*AndFilter (map filter-rec-id fs))]
[#:frees (combine-frees (map free-vars* fs))
(combine-frees (map free-idxs* fs))])
(df OrFilter ([fs (non-empty-listof Filter/c)])
(def-filter OrFilter ([fs (non-empty-listof Filter/c)])
[#:fold-rhs (*OrFilter (map filter-rec-id fs))]
[#:frees (combine-frees (map free-vars* fs))
(combine-frees (map free-idxs* fs))])
(df FilterSet (thn els)
(def-filter FilterSet (thn els)
[#:contract (->i ([t any/c]
[e any/c])
(#:syntax [stx #f])
@ -61,7 +61,7 @@
;; represents no info about the filters of this expression
;; should only be used for parsing type annotations and expected types
(df NoFilter () [#:fold-rhs #:base])
(def-filter NoFilter () [#:fold-rhs #:base])
(define (filter-equal? a b) (= (Rep-seq a) (Rep-seq b)))
(provide filter-equal?)

14
collects/typed-scheme/rep/object-rep.rkt
View File

@ -3,24 +3,24 @@
(require racket/match scheme/contract "rep-utils.rkt" "free-variance.rkt" "filter-rep.rkt")
(provide object-equal?)
(dpe CarPE () [#:fold-rhs #:base])
(dpe CdrPE () [#:fold-rhs #:base])
(dpe SyntaxPE () [#:fold-rhs #:base])
(def-pathelem CarPE () [#:fold-rhs #:base])
(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)
(dpe StructPE ([t Type?] [idx natural-number/c])
(def-pathelem StructPE ([t Type?] [idx natural-number/c])
[#:frees (free-vars* t) (free-idxs* t)]
[#:fold-rhs (*StructPE (type-rec-id t) idx)])
(do Empty () [#:fold-rhs #:base])
(def-object Empty () [#:fold-rhs #:base])
(do Path ([p (listof PathElem?)] [v name-ref/c])
(def-object Path ([p (listof PathElem?)] [v name-ref/c])
[#:intern (list p (hash-name v))]
[#:frees (combine-frees (map free-vars* p)) (combine-frees (map free-idxs* p))]
[#:fold-rhs (*Path (map pathelem-rec-id p) v)])
;; represents no info about the object of this expression
;; should only be used for parsing type annotations and expected types
(do NoObject () [#:fold-rhs #:base])
(def-object NoObject () [#:fold-rhs #:base])
(define (object-equal? o1 o2) (= (Rep-seq o1) (Rep-seq o2)))

8
collects/typed-scheme/rep/rep-utils.rkt
View File

@ -226,10 +226,10 @@
'(i.kw ...)))
(list i.ht ...))))))]))
(make-prim-type [Type dt #:Type type-case print-type* type-name-ht type-rec-id #:key]
[Filter df #:Filter filter-case print-filter* filter-name-ht filter-rec-id]
[Object do #:Object object-case print-object* object-name-ht object-rec-id]
[PathElem dpe #:PathElem pathelem-case print-pathelem* pathelem-name-ht pathelem-rec-id])
(make-prim-type [Type def-type #:Type type-case print-type* type-name-ht type-rec-id #:key]
[Filter def-filter #:Filter filter-case print-filter* filter-name-ht filter-rec-id]
[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*]

95
collects/typed-scheme/rep/type-rep.rkt
View File

@ -26,7 +26,7 @@
;; Type is defined in rep-utils.rkt
;; t must be a Type
(dt Scope ([t (or/c Type/c Scope?)]) [#:key (Type-key t)])
(def-type Scope ([t (or/c Type/c Scope?)]) [#:key (Type-key t)])
(define (scope-depth k)
(flat-named-contract
@ -39,24 +39,24 @@
(f k sc))))
;; this is ONLY used when a type error ocurrs
(dt Error () [#:frees #f] [#:fold-rhs #:base])
(def-type Error () [#:frees #f] [#:fold-rhs #:base])
;; de Bruijn indexes - should never appear outside of this file
;; bound type variables
;; i is an nat
(dt B ([i natural-number/c]) [#:frees #f] [#:fold-rhs #:base])
(def-type B ([i natural-number/c]) [#:frees #f] [#:fold-rhs #:base])
;; free type variables
;; n is a Name
(dt F ([n symbol?]) [#:frees (make-immutable-hasheq (list (cons n Covariant))) #hasheq()] [#:fold-rhs #:base])
(def-type F ([n symbol?]) [#:frees (make-immutable-hasheq (list (cons n Covariant))) #hasheq()] [#:fold-rhs #:base])
;; id is an Identifier
(dt Name ([id identifier?]) [#:intern (hash-id id)] [#:frees #f] [#:fold-rhs #:base])
(def-type Name ([id identifier?]) [#:intern (hash-id id)] [#:frees #f] [#:fold-rhs #:base])
;; rator is a type
;; rands is a list of types
;; stx is the syntax of the pair of parens
(dt App ([rator Type/c] [rands (listof Type/c)] [stx (or/c #f syntax?)])
(def-type App ([rator Type/c] [rands (listof Type/c)] [stx (or/c #f syntax?)])
[#:intern (list rator rands)]
[#:frees (λ (f) (combine-frees (map f (cons rator rands))))]
[#:fold-rhs (*App (type-rec-id rator)
@ -90,10 +90,10 @@
[(Contravariant) (flip-variances tbl)]))
;; left and right are Types
(dt Pair ([left Type/c] [right Type/c]) [#:key 'pair])
(def-type Pair ([left Type/c] [right Type/c]) [#:key 'pair])
;; dotted list -- after expansion, becomes normal Pair-based list type
(dt ListDots ([dty Type/c] [dbound (or/c symbol? natural-number/c)])
(def-type ListDots ([dty Type/c] [dbound (or/c symbol? natural-number/c)])
[#:frees (if (symbol? dbound)
(hash-remove (free-vars* dty) dbound)
(free-vars* dty))
@ -104,39 +104,40 @@
;; *mutable* pairs - distinct from regular pairs
;; left and right are Types
(dt MPair ([left Type/c] [right Type/c])
(def-type MPair ([left Type/c] [right Type/c])
[#:frees (λ (f) (make-invariant (combine-frees (list (f left) (f right)))))]
[#:key 'mpair])
;; elem is a Type
(dt Vector ([elem Type/c])
(def-type Vector ([elem Type/c])
[#:frees (λ (f) (make-invariant (f elem)))]
[#:key 'vector])
;; elems are all Types
(dt HeterogenousVector ([elems (listof Type/c)])
(def-type HeterogenousVector ([elems (listof Type/c)])
[#:frees (λ (f) (make-invariant (combine-frees (map f elems))))]
[#:key 'vector]
[#:fold-rhs (*HeterogenousVector (map type-rec-id elems))])
;; elem is a Type
(dt Box ([elem Type/c])
(def-type Box ([elem Type/c])
[#:frees (λ (f) (make-invariant (f elem)))]
[#:key 'box])
;; elem is a Type
(dt Channel ([elem Type/c])
(def-type Channel ([elem Type/c])
[#:frees (λ (f) (make-invariant (f elem)))]
[#:key 'channel])
;; elem is a Type
(dt Ephemeron ([elem Type/c])
(def-type Ephemeron ([elem Type/c])
[#:key 'ephemeron])
;; elem is a Type
(dt Set ([elem Type/c]) [#:key 'set])
(def-type Set ([elem Type/c])
[#:key 'set])
;; name is a Symbol (not a Name)
@ -147,7 +148,7 @@
;; marshaled has to be a syntax object that refers to the base type
;; being created. this allows us to avoid reconstructing the base type
;; when using it from its marshaled representation
(dt Base ([name symbol?] [contract syntax?] [predicate procedure?] [marshaled syntax?])
(def-type Base ([name symbol?] [contract syntax?] [predicate procedure?] [marshaled syntax?])
[#:frees #f] [#:fold-rhs #:base] [#:intern name]
[#:key (case name
[(Number Integer) 'number]
@ -158,13 +159,13 @@
[else #f])])
;; body is a Scope
(dt Mu ([body (scope-depth 1)]) #:no-provide [#:frees (λ (f) (f body))]
(def-type Mu ([body (scope-depth 1)]) #:no-provide [#:frees (λ (f) (f body))]
[#:fold-rhs (*Mu (*Scope (type-rec-id (Scope-t body))))]
[#:key (Type-key body)])
;; n is how many variables are bound here
;; body is a Scope
(dt Poly (n body) #:no-provide
(def-type Poly (n body) #:no-provide
[#:contract (->i ([n natural-number/c]
[body (n) (scope-depth n)])
(#:syntax [stx (or/c #f syntax?)])
@ -177,7 +178,7 @@
;; n is how many variables are bound here
;; there are n-1 'normal' vars and 1 ... var
;; body is a Scope
(dt PolyDots (n body) #:no-provide
(def-type PolyDots (n body) #:no-provide
[#:contract (->i ([n natural-number/c]
[body (n) (scope-depth n)])
(#:syntax [stx (or/c #f syntax?)])
@ -189,25 +190,25 @@
;; pred : identifier
;; cert : syntax certifier
(dt Opaque ([pred identifier?] [cert procedure?])
(def-type Opaque ([pred identifier?] [cert procedure?])
[#:intern (hash-id pred)] [#:frees #f] [#:fold-rhs #:base] [#:key pred])
;; kw : keyword?
;; ty : Type
;; required? : Boolean
(dt Keyword ([kw keyword?] [ty Type/c] [required? boolean?])
(def-type Keyword ([kw keyword?] [ty Type/c] [required? boolean?])
[#:frees (λ (f) (f ty))]
[#:fold-rhs (*Keyword kw (type-rec-id ty) required?)])
(dt Result ([t Type/c] [f FilterSet?] [o Object?])
(def-type Result ([t Type/c] [f FilterSet?] [o Object?])
[#:frees (λ (frees) (combine-frees (map frees (list t f o))))]
[#:fold-rhs (*Result (type-rec-id t) (filter-rec-id f) (object-rec-id o))])
(dt Values ([rs (listof Result?)])
(def-type Values ([rs (listof Result?)])
[#:frees (λ (f) (combine-frees (map f rs)))]
[#:fold-rhs (*Values (map type-rec-id rs))])
(dt ValuesDots ([rs (listof Result?)] [dty Type/c] [dbound (or/c symbol? natural-number/c)])
(def-type ValuesDots ([rs (listof Result?)] [dty Type/c] [dbound (or/c symbol? natural-number/c)])
[#:frees (if (symbol? dbound)
(hash-remove (combine-frees (map free-vars* (cons dty rs))) dbound)
(combine-frees (map free-vars* (cons dty rs))))
@ -218,7 +219,7 @@
[#:fold-rhs (*ValuesDots (map type-rec-id rs) (type-rec-id dty) dbound)])
;; arr is NOT a Type
(dt arr ([dom (listof Type/c)]
(def-type arr ([dom (listof Type/c)]
[rng (or/c Values? ValuesDots?)]
[rest (or/c #f Type/c)]
[drest (or/c #f (cons/c Type/c (or/c natural-number/c symbol?)))]
@ -256,18 +257,18 @@
(map type-rec-id kws))])
;; top-arr is the supertype of all function types
(dt top-arr () [#:fold-rhs #:base])
(def-type top-arr () [#:fold-rhs #:base])
(define arr/c (or/c top-arr? arr?))
;; arities : Listof[arr]
(dt Function ([arities (listof arr/c)])
(def-type Function ([arities (listof arr/c)])
[#:key 'procedure]
[#:frees (λ (f) (combine-frees (map f arities)))]
[#:fold-rhs (*Function (map type-rec-id arities))])
(dt fld ([t Type/c] [acc identifier?] [mutable? boolean?])
(def-type fld ([t Type/c] [acc identifier?] [mutable? boolean?])
[#:frees (λ (f) (if mutable? (make-invariant (f t)) (f t)))]
[#:fold-rhs (*fld (type-rec-id t) acc mutable?)]
[#:intern (list t (hash-id acc) mutable?)])
@ -281,7 +282,7 @@
;; cert : syntax certifier for pred-id
;; acc-ids : names of the accessors
;; maker-id : name of the constructor
(dt Struct ([name symbol?]
(def-type Struct ([name symbol?]
[parent (or/c #f Struct? Name?)]
[flds (listof fld?)]
[proc (or/c #f Function?)]
@ -305,24 +306,24 @@
;; A structure type descriptor
;; s : struct
(dt StructType ([s Struct?]) [#:key 'struct-type])
(def-type StructType ([s Struct?]) [#:key 'struct-type])
;; the supertype of all of these values
(dt BoxTop () [#:fold-rhs #:base] [#:key 'box])
(dt ChannelTop () [#:fold-rhs #:base] [#:key 'channel])
(dt VectorTop () [#:fold-rhs #:base] [#:key 'vector])
(dt HashtableTop () [#:fold-rhs #:base] [#:key 'hash])
(dt MPairTop () [#:fold-rhs #:base] [#:key 'mpair])
(dt StructTop ([name Struct?]) [#:key 'struct])
(def-type BoxTop () [#:fold-rhs #:base] [#:key 'box])
(def-type ChannelTop () [#:fold-rhs #:base] [#:key 'channel])
(def-type VectorTop () [#:fold-rhs #:base] [#:key 'vector])
(def-type HashtableTop () [#:fold-rhs #:base] [#:key 'hash])
(def-type MPairTop () [#:fold-rhs #:base] [#:key 'mpair])
(def-type StructTop ([name Struct?]) [#:key 'struct])
;; v : Scheme Value
(dt Value (v) [#:frees #f] [#:fold-rhs #:base] [#:key (cond [(number? v) 'number]
(def-type Value (v) [#:frees #f] [#:fold-rhs #:base] [#:key (cond [(number? v) 'number]
[(boolean? v) 'boolean]
[(null? v) 'null]
[else #f])])
;; elems : Listof[Type]
(dt Union ([elems (and/c (listof Type/c)
(def-type Union ([elems (and/c (listof Type/c)
(lambda (es)
(or (null? es)
(let-values ([(sorted? k)
@ -342,23 +343,23 @@
[k (loop (cons k res) (cdr ts))]
[else #f]))))])
(dt Univ () [#:frees #f] [#:fold-rhs #:base])
(def-type Univ () [#:frees #f] [#:fold-rhs #:base])
;; in : Type
;; out : Type
(dt Param ([in Type/c] [out Type/c])
(def-type Param ([in Type/c] [out Type/c])
[#:key 'parameter]
[#:frees (λ (f) (combine-frees (list (f out) (flip-variances (f in)))))])
;; key : Type
;; value : Type
(dt Hashtable ([key Type/c] [value Type/c]) [#:key 'hash]
(def-type Hashtable ([key Type/c] [value Type/c]) [#:key 'hash]
[#:frees (λ (f) (combine-frees (list (make-invariant (f key)) (make-invariant (f value)))))])
;; parent : Type
;; pred : Identifier
;; cert : Certifier
(dt Refinement (parent pred cert)
(def-type Refinement (parent pred cert)
[#:key (Type-key parent)]
[#:intern (list parent (hash-id pred))]
[#:fold-rhs (*Refinement (type-rec-id parent) pred cert)]
@ -366,12 +367,12 @@
;; t : Type
(dt Syntax ([t Type/c]) [#:key 'syntax])
(def-type Syntax ([t Type/c]) [#:key 'syntax])
;; pos-flds : (Listof Type)
;; name-flds : (Listof (Tuple Symbol Type Boolean))
;; methods : (Listof (Tuple Symbol Function))
(dt Class ([pos-flds (listof Type/c)]
(def-type Class ([pos-flds (listof Type/c)]
[name-flds (listof (list/c symbol? Type/c boolean?))]
[methods (listof (list/c symbol? Function?))])
[#:frees (λ (f) (combine-frees
@ -393,16 +394,16 @@
(map list mname (map type-rec-id mty)))])])
;; cls : Class
(dt Instance ([cls Type/c]) [#:key 'instance])
(def-type Instance ([cls Type/c]) [#:key 'instance])
;; sequences
;; includes lists, vectors, etc
;; tys : sequence produces this set of values at each step
(dt Sequence ([tys (listof Type/c)])
(def-type Sequence ([tys (listof Type/c)])
[#:frees (λ (f) (combine-frees (map f tys)))]
[#:key #f] [#:fold-rhs (*Sequence (map type-rec-id tys))])
(dt Future ([t Type/c]) [#:key 'future])
(def-type Future ([t Type/c]) [#:key 'future])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;