Commit 340acaa1 authored by Giuseppe Castagna's avatar Giuseppe Castagna
Browse files

Added some tests

parent f666e8bd
type X('a,'b) = ('a, X) | ('a,'b) ;;
let append ( ([], 'b) -> 'b ; ([ 'a+ ] ,'b) -> X('a,'b))
| ([], y) -> y
| ((h,t),y) -> (h, append ( t, y))
;;
let append ( ( [] , ['b*] ) -> [ 'b* ] ; ([ 'a+ ] ,[ 'b* ]) -> [ 'a+ 'b*] )
| ([], y) -> y
| ((h,t),y) -> (h, append ( t, y))
;;
type RBtree = Btree | Rtree
(* Black rooted RB tree: *)
type Btree = [] | <black elem=Int>[ RBtree RBtree ]
(* Red rooted RB tree: *)
type Rtree = <red elem=Int>[ Btree Btree ]
type Wrongtree = <red elem=Int>( [ Rtree Btree ]
| [ Btree Rtree ])
type Unbalanced = <black elem=Int>( [ Wrongtree RBtree ]
| [ RBtree Wrongtree ])
;;
let balance ( Unbalanced -> Rtree ; 'b\Unbalanced -> 'b\Unbalanced )
| <black (z)>[ <red (y)>[ <red (x)>[ a b ] c ] d ]
| <black (z)>[ <red (x)>[ a <red (y)>[ b c ] ] d ]
| <black (x)>[ a <red (z)>[ <red (y)>[ b c ] d ] ]
| <black (x)>[ a <red (y)>[ b <red (z)>[ c d ] ] ] ->
<red (y)>[ <black (x)>[ a b ] <black (z)>[ c d ] ]
| x -> x
;;
let v : Unbalanced | Btree \[] = <black elem=3>[ <red elem=5>[ [ ] <red elem=2>[ [ ] [ ] ] ] [ ] ];;
let b : RBtree \ [] = balance v;;
let insert (x : Int) (t : Btree) : Btree =
let ins_aux ( [] -> Rtree;
Btree\[] -> RBtree\[];
Rtree -> Rtree|Wrongtree )
| [] -> <red elem=x>[ [] [] ]
| (<black elem=y>[ a b ]) & z ->
let color = `black in
let ib : RBtree = b in
let ia : Btree \[] | Rtree | Wrongtree = ins_aux a in
let tree : Unbalanced | Btree \[] (* <black elem=Int>[ (Rtree | Wrongtree | <black elem=Int>[ RBtree RBtree ]) RBtree ]
| <black elem=Int>[ [ ] RBtree ] | <black elem=Int>[ RBtree Wrongtree ] *) = <black elem=3>[ ia ib ] in
let b : RBtree\[] = balance tree in
if x << y then b
else if x >> y then balance <(color) elem=y>[ a (ins_aux b) ]
else z
| (<red elem=y>[ a b ]) & z ->
let color = `red in
if x << y then balance <(color) elem=y>[ (ins_aux a) b ]
else if x >> y then balance <(color) elem=y>[ a (ins_aux b) ]
else z
in match ins_aux t with
| <_ (y)>[ a b ] -> <black (y)>[ a b ]
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment