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

Make unfold use typecase instead of subst.

Browse Source 
original commit: 42acb08399729acc20f6900b330bab9396f796d8
This commit is contained in:
Eric Dobson 2014-05-21 09:10:43 -07:00
parent 951d8ed2d7
commit 5470604b70
2 changed files with 12 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/substitute.rkt
View File

@ -38,15 +38,15 @@
;; TODO: Figure out if free var checking/short circuiting is actually a performance improvement.
;; 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?)
(define (sb t) (substitute-many subst t #:Un Un))
(define/cond-contract (substitute-many subst target)
(simple-substitution/c Type? . -> . Type?)
(define (sb t) (substitute-many subst t))
(define names (hash-keys subst))
(define fvs (free-vars* target))
(if (ormap (lambda (name) (free-vars-has-key? fvs name)) names)
(type-case (#:Type sb #:Filter (sub-f sb) #:Object (sub-o sb))
target
[#:Union tys (Un (map sb tys))]
[#:Union tys (apply Un (map sb tys))]
[#:F name (hash-ref subst name target)]
[#:arr dom rng rest drest kws
(cond
@ -81,9 +81,9 @@
;; 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?)
(substitute-many (hash name image) target #:Un Un))
(define/cond-contract (substitute image name target)
(Type/c symbol? Type? . -> . Type?)
(substitute-many (hash name image) target))
;; implements angle bracket substitution from the formalism
;; substitute-dots : Listof[Type] Option[type] Name Type -> Type

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/utils.rkt
View File

@ -19,9 +19,11 @@
(define (unfold t)
(match t
[(Mu: name b)
(substitute t name b #:Un (lambda (tys)
(make-Union (sort tys < #:key Type-seq))))]
[_ (int-err "unfold: requires Mu type, got ~a" t)]))
(define (sb target)
(type-case (#:Type sb #:Filter (sub-f sb) #:Object (sub-o sb))
target
[#:F name* (if (eq? name name*) t target)]))
(sb b)]))
(define (instantiate-poly t types)
(match t