Refine solution for red-black trees

tests/poly/red-black.cd

@@ -13,6 +13,7 @@ type Wrongtree('a) =    <red elem='a>( [ Rtree('a) Btree('a) ]
 type Unbalanced('a) = <black elem='a>( [ Wrongtree('a) RBtree('a) ]
                                    | [ RBtree('a) Wrongtree('a) ])
 
+(* does not type *)
 let balance ( Unbalanced('a) -> Rtree('a) ; 'b\Unbalanced('a) -> 'b\Unbalanced('a) )
   | <black (z)>[ <red (y)>[ <red (x)>[ a b ] c ] d ]
   | <black (z)>[ <red (x)>[ a <red (y)>[ b c ] ] d ]
@@ -20,6 +21,32 @@ let balance ( Unbalanced('a) -> Rtree('a) ; 'b\Unbalanced('a) -> 'b\Unbalanced('
   | <black (x)>[ a <red (y)>[ b <red (z)>[ c d ] ] ] ->
         <red (y)>[ <black (x)>[ a b ] <black (z)>[ c d ] ]
   | x -> x
+;;
+
+let balance ( Unbalanced('a) -> Rtree('a) ; 'b & RBtree('a) -> 'b & RBtree('a) )
+  | <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 balance ( Unbalanced('a) -> Rtree('a) ; 'b\Unbalanced(Any) -> 'b\Unbalanced(Any) )
+  | (<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 ] ] ]) & Unbalanced(Any) ->
+        <red (y)>[ <black (x)>[ a b ] <black (z)>[ c d ] ]
+  | x -> x
+;;
+
+type  UTree = <black (Any)>[ <red (Any)>[ <red (Any)>[ Any Any ] Any ] Any ] 
+             | <black (Any)>[ <red (Any)>[ Any <red (Any)>[ Any Any ] ] Any ] 
+             | <black (Any)>[ Any <red (Any)>[ <red (Any)>[ Any Any ] Any ] ] 
+             | <black (Any)>[ Any <red (Any)>[ Any <red (Any)>[ Any Any ] ] ]
+;;
+
 
 let insert (x : 'a) (t : Btree('a)) : Btree('a) =
   let ins_aux ( [] -> Rtree('a);
@@ -32,4 +59,4 @@ let insert (x : 'a) (t : Btree('a)) : Btree('a) =
 	   else z
     in match ins_aux t with
        | <_ (y)>[ a b ] -> <black (y)>[ a b ]
- 
\ No newline at end of file
+