Commit 792df7c1 authored by Kim Nguyễn's avatar Kim Nguyễn

Add a test case, extracted from the red-black tree code, that exhibits a bad performance behaviour.

parent e2b4e79c
type RBtree('a) = Btree('a) | Rtree('a)
(* Black rooted RB tree: *)
type Btree('a) = [] | <black elem='a>[ RBtree('a) RBtree('a) ]
(* Red rooted RB tree: *)
type Rtree('a) = <red elem='a>[ Btree('a) Btree('a) ]
type Wrongtree('a) = <red elem='a>( [ Rtree('a) Btree('a) ]
| [ Btree('a) Rtree('a) ])
type Unbalanced('a) = <black elem='a>( [ Wrongtree('a) RBtree('a) ]
| [ RBtree('a) Wrongtree('a) ])
;;
(* *)
(* Version 1: restrict the domain of balance to trees (ie, RBtree | Unbalanced) *)
(* *)
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 x : Unbalanced('a) | RBtree('a) = raise ""
let y = balance x
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