Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
7a7520a0
Commit
7a7520a0
authored
Dec 18, 2014
by
Giuseppe Castagna
Browse files
Added comments
parent
11ecd5f6
Changes
1
Show whitespace changes
Inline
Side-by-side
tests/poly/red-black.cd
View file @
7a7520a0
...
...
@@ -28,6 +28,9 @@ let balance ( Unbalanced('a) -> Rtree('a) ; 'b\Unbalanced('a) -> 'b\Unbalanced('
;;
************)
(* *)
(* 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 ]
...
...
@@ -39,6 +42,12 @@ let balance ( Unbalanced('a) -> Rtree('a) ; 'b & RBtree('a) -> 'b & RBtree('a) )
;;
(* *)
(* Version 2: restrict the first branch to Unbalanced trees whatever *)
(* type it contains *)
(* *)
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 ]
...
...
@@ -48,14 +57,19 @@ let balance ( Unbalanced('a) -> Rtree('a) ; 'b\Unbalanced(Any) -> 'b\Unbalanced(
| x -> x
;;
(*
(* *)
(* Version 3: Use the accepted type of the first branch (i.e. UTree) *)
(* to specify the behavious when the second branch is taken *)
(* *)
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 balance ( Unbalanced('a) -> Rtree('a) ; 'b\UTree -> 'b\UTree )
| <black (z)>[ <red (y)>[ <red (x)>[ a b ] c ] d ]
| <black (z)>[ <red (x)>[ a <red (y)>[ b c ] ] d ]
...
...
@@ -64,7 +78,7 @@ let balance ( Unbalanced('a) -> Rtree('a) ; 'b\UTree -> 'b\UTree )
<red (y)>[ <black (x)>[ a b ] <black (z)>[ c d ] ]
| x -> x
;;
*)
(* Here we start the definition of *)
...
...
@@ -83,10 +97,13 @@ let insert (x : 'a) (t : Btree('a)) : Btree('a) =
| <_ (y)>[ a b ] -> <black (y)>[ a b ]
let is_empty ( RBtree('a) -> Bool ) | [] -> `true | _ -> `false
let is_empty (RBtree('a) -> Bool) (*better type (Any\[] -> `false ; [] ->`true ) *)
| [] -> `true
| _ -> `false
let member (x : 'a) (t : RBtree('a)) : Bool =
(* better type: 'a -> ([] -> `false & RBtree('a) -> Bool) *)
match t with
| [] -> `false
| <_ elem=y>[ left right ] ->
...
...
@@ -96,6 +113,6 @@ let member (x : 'a) (t : RBtree('a)) : Bool =
let singleton (x : 'a): Btree('a) = <black elem=x>[ [] [] ]
let cardinal ( RBtree('a) -> Int )
let cardinal ( RBtree('a) -> Int )
(* better type: [] -> 0, Any\[] -> [1--*] *)
| [] -> 0
| <_ ..>[ l r ] -> cardinal l + cardinal r + 1
\ No newline at end of file
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment