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

Null does not overlap with structs.

Browse Source 
svn: r18508
This commit is contained in:
Sam Tobin-Hochstadt 2010-03-10 23:43:47 +00:00
parent 826fbdf16f
commit b3be4f32f7
2 changed files with 21 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/typed-scheme/succeed/even-odd.ss Normal file
View File

@ -0,0 +1,18 @@
#lang typed/scheme
(define-struct: (A) Z ([b : A]))
(define-struct: (A) O ([b : A]))
(define-type Bitstring (Rec B (U '() (Z B) (O B))))
(define-type EvenParity (Rec Even (U '() (Z Even) (O (Rec Odd (U (Z Odd) (O Even)))))))
(define-type OddParity (Rec Odd (U (Z Odd) (O (Rec Even (U '() (Z Even) (O Odd)))))))
(: append-one (case-lambda (EvenParity -> OddParity)
(OddParity -> EvenParity)
(Bitstring -> Bitstring)))
(define (append-one l)
(if (null? l)
(make-O '())
(if (Z? l)
(make-Z (append-one (Z-b l)))
(make-O (append-one (O-b l))))))

3
collects/typed-scheme/types/remove-intersect.ss
View File

@ -50,6 +50,9 @@
[(or (list (Pair: _ _) _) [(or (list (Pair: _ _) _)
(list _ (Pair: _ _))) (list _ (Pair: _ _)))
#f] #f]
[(or (list (Value: '()) (Struct: n _ flds _ _ _ _ _))
(list (Struct: n _ flds _ _ _ _ _) (Value: '())))
#f]
[(list (Struct: n _ flds _ _ _ _ _) [(list (Struct: n _ flds _ _ _ _ _)
(Struct: n _ flds* _ _ _ _ _)) (Struct: n _ flds* _ _ _ _ _))
(for/and ([f flds] [f* flds*]) (overlap f f*))] (for/and ([f flds] [f* flds*]) (overlap f f*))]