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

Refine handling of types for struct-types

Browse Source 
- Added a top type for struct-types
  - Print struct-type types consistently
  - Add support for parsing struct-types
  - Allow polymorphism within a Struct-Type
This commit is contained in:
Asumu Takikawa 2013-12-28 20:38:38 -05:00
parent 878b67a4a6
commit ae80c216c3
7 changed files with 23 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types-extra.rkt
View File

@ -17,7 +17,7 @@
(define-other-types
-> case-> U Rec All Opaque Vector
Parameterof List List* Class Values Instance Refinement
pred Struct)
pred Struct Struct-Type)
(provide (rename-out [All ∀]
[U Un]

1
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types.rkt
View File

@ -113,6 +113,7 @@
[Thread-CellTop -Thread-CellTop]
[Prompt-TagTop -Prompt-TagTop]
[Continuation-Mark-KeyTop -Continuation-Mark-KeyTop]
[Struct-TypeTop (make-StructTypeTop)]
[Keyword -Keyword]
[Thread -Thread]
[Resolved-Module-Path -Resolved-Module-Path]

5
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt
View File

@ -583,6 +583,11 @@
[((Struct: nm (? Type? parent) _ _ _ _) other)
(cg parent other)]
;; Invariant here because struct types aren't subtypes just because the
;; structs are (since you can make a constructor from the type).
[((StructType: s) (StructType: t))
(cset-meet (cg s t) (cg t s))]
;; vectors are invariant - generate constraints *both* ways
[((Vector: e) (Vector: e*))
(cset-meet (cg e e*) (cg e* e))]

9
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt
View File

@ -180,7 +180,7 @@
(syntax-parse
stx
#:literals (t:Class t:Refinement t:Instance t:List t:List* cons t:pred t:-> : case-lambda t:case->
t:Rec t:U t:All t:Opaque t:Parameter t:Vector quote t:Struct)
t:Rec t:U t:All t:Opaque t:Parameter t:Vector quote t:Struct t:Struct-Type)
[t
#:declare t (3d Type/c?)
(attribute t.datum)]
@ -214,6 +214,13 @@
[(and s (? Struct?)) (make-StructTop s)]
[_ (tc-error/delayed "Argument to Struct must be a structure type, got ~a" v)
(Un)]))]
[((~and kw t:Struct-Type) t)
(add-disappeared-use #'kw)
(define v (parse-type #'t))
(match (resolve v)
[(? Struct? s) (make-StructType s)]
[_ (tc-error/delayed "Argument to Struct-Type must be a structure type, got ~a" v)
(Un)])]
[((~and kw t:Instance) t)
(add-disappeared-use #'kw)
(let ([v (parse-type #'t)])

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt
View File

@ -360,8 +360,8 @@
[#:key '(struct procedure)])
;; A structure type descriptor
;; s : struct
(def-type StructType ([s Struct?]) [#:key 'struct-type])
(def-type StructTypeTop () [#:fold-rhs #:base] [#:key 'struct-type])
(def-type StructType ([s (or/c F? B? Struct?)]) [#:key 'struct-type])
;; the supertype of all of these values
(def-type BoxTop () [#:fold-rhs #:base] [#:key 'box])

5
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt
View File

@ -273,7 +273,10 @@
(set-box! (current-print-unexpanded)
(cons (car names) (unbox (current-print-unexpanded)))))
(fp "~a" (car names))])]
[(StructType: (Struct: nm _ _ _ _ _)) (fp "(StructType ~a)" (syntax-e nm))]
[(StructType: (Struct: nm _ _ _ _ _)) (fp "(Struct-Type ~a)" (syntax-e nm))]
;; this case occurs if the contained type is a type variable
[(StructType: ty) (fp "(Struct-Type ~a)" ty)]
[(StructTypeTop:) (fp "Struct-TypeTop")]
[(StructTop: (Struct: nm _ _ _ _ _)) (fp "(Struct ~a)" (syntax-e nm))]
[(BoxTop:) (fp "BoxTop")]
[(ChannelTop:) (fp "ChannelTop")]

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt
View File

@ -460,6 +460,8 @@
[((Struct: nm _ _ _ _ _) (StructTop: (Struct: nm* _ _ _ _ _)))
#:when (free-identifier=? nm nm*)
A0]
;; All struct-type types are subtypes of the struct type top type
[((StructType: _) (StructTypeTop:)) A0]
;; Promises are covariant
[((Promise: s) (Promise: t))
(subtype* A0 s t)]