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

Allow depth subtyping with #:implements

Browse Source 
original commit: bd5ec395c264971fe9c8f0ed2fbe5130cc406c56
This commit is contained in:
Asumu Takikawa 2013-10-03 12:02:16 -04:00
parent 72dd536f96
commit 24d2f84103
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,7 +4,8 @@
(require "../utils/utils.rkt"
(except-in (rep type-rep object-rep filter-rep) make-arr)
(rename-in (types abbrev union utils filter-ops resolve classes)
(rename-in (types abbrev union utils filter-ops resolve
classes subtype)
[make-arr* make-arr])
(utils tc-utils stxclass-util literal-syntax-class)
syntax/stx (prefix-in c: (contract-req))
@ -570,12 +571,16 @@
(cond [maybe-dup
(define type (car (dict-ref types maybe-dup)))
(define super-type (car (dict-ref super-types maybe-dup)))
(cond [;; if there is a duplicate, but the type is the same,
(cond [;; if there is a duplicate, but the type is a subtype,
;; then let it through and check for any other duplicates
(type-equal? type super-type)
(unless (subtype type super-type)
;; FIXME: this error message may need rewording
(tc-error (~a "Type for member " maybe-dup
" in class type is not a subtype of the type"
" in the parent class type")))
(check-duplicate-clause
(remove maybe-dup names) super-names
(dict-remove types maybe-dup) super-types
names (remove maybe-dup super-names)
types (dict-remove super-types maybe-dup)
err-msg)]
[else
(tc-error/stx stx err-msg maybe-dup)])]