equal
deleted
inserted
replaced
14 an abstract type of red-black tree obeying the invariant. |
14 an abstract type of red-black tree obeying the invariant. |
15 *} |
15 *} |
16 |
16 |
17 subsection {* Datatype of RB trees *} |
17 subsection {* Datatype of RB trees *} |
18 |
18 |
19 datatype color = R | B |
19 datatype_new color = R | B |
20 datatype ('a, 'b) rbt = Empty | Branch color "('a, 'b) rbt" 'a 'b "('a, 'b) rbt" |
20 datatype_new ('a, 'b) rbt = Empty | Branch color "('a, 'b) rbt" 'a 'b "('a, 'b) rbt" |
21 |
21 |
22 lemma rbt_cases: |
22 lemma rbt_cases: |
23 obtains (Empty) "t = Empty" |
23 obtains (Empty) "t = Empty" |
24 | (Red) l k v r where "t = Branch R l k v r" |
24 | (Red) l k v r where "t = Branch R l k v r" |
25 | (Black) l k v r where "t = Branch B l k v r" |
25 | (Black) l k v r where "t = Branch B l k v r" |
1726 |
1726 |
1727 definition skip_black :: "('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt" |
1727 definition skip_black :: "('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt" |
1728 where |
1728 where |
1729 "skip_black t = (let t' = skip_red t in case t' of Branch color.B l k v r \<Rightarrow> l | _ \<Rightarrow> t')" |
1729 "skip_black t = (let t' = skip_red t in case t' of Branch color.B l k v r \<Rightarrow> l | _ \<Rightarrow> t')" |
1730 |
1730 |
1731 datatype compare = LT | GT | EQ |
1731 datatype_new compare = LT | GT | EQ |
1732 |
1732 |
1733 partial_function (tailrec) compare_height :: "('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt \<Rightarrow> compare" |
1733 partial_function (tailrec) compare_height :: "('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a, 'b) rbt \<Rightarrow> compare" |
1734 where |
1734 where |
1735 "compare_height sx s t tx = |
1735 "compare_height sx s t tx = |
1736 (case (skip_red sx, skip_red s, skip_red t, skip_red tx) of |
1736 (case (skip_red sx, skip_red s, skip_red t, skip_red tx) of |