Null does not overlap with structs.
svn: r18508 original commit: b3be4f32f7dceb402dbfc2bce35a8db466c16219
This commit is contained in:
commit
db56dfd7d6
18
collects/tests/typed-scheme/succeed/even-odd.ss
Normal file
18
collects/tests/typed-scheme/succeed/even-odd.ss
Normal 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))))))
|
|
@ -50,6 +50,9 @@
|
|||
[(or (list (Pair: _ _) _)
|
||||
(list _ (Pair: _ _)))
|
||||
#f]
|
||||
[(or (list (Value: '()) (Struct: n _ flds _ _ _ _ _))
|
||||
(list (Struct: n _ flds _ _ _ _ _) (Value: '())))
|
||||
#f]
|
||||
[(list (Struct: n _ flds _ _ _ _ _)
|
||||
(Struct: n _ flds* _ _ _ _ _))
|
||||
(for/and ([f flds] [f* flds*]) (overlap f f*))]
|
||||
|
|
Loading…
Reference in New Issue
Block a user