1(* -------------------------------------------------------------------------
2   Patricia trees
3   ------------------------------------------------------------------------- *)
4
5structure Ptree :> Ptree =
6struct
7
8datatype 'a ptree =
9     Empty
10   | Leaf of IntInf.int * 'a
11   | Branch of IntInf.int * word * 'a ptree * 'a ptree
12
13fun bit (b, n) = IntInf.~>> (n, b) mod 2 = 1
14fun mod_2exp (x, n) = IntInf.andb (n, IntInf.<< (1, x) - 1)
15fun mod_2exp_eq (x, a, b) = mod_2exp (x, IntInf.xorb (a, b)) = 0
16
17fun peek (Empty, _) = NONE
18  | peek (Leaf (j, d), k) = if k = j then SOME d else NONE
19  | peek (Branch (_, m, l, r), k) = peek (if bit (m, k) then l else r, k)
20
21local
22   fun leastSetBit a = Word.fromInt (IntInf.log2 (IntInf.andb (a, ~a)))
23   fun branching_bit (p0, p1) =
24      if p0 = p1 then 0w0 else leastSetBit (IntInf.xorb (p0, p1))
25   fun join (p0, t0, p1, t1) =
26      let
27         val m = branching_bit (p0, p1)
28         val p = mod_2exp (m, p0)
29      in
30         if bit (m, p0) then Branch (p, m, t0, t1) else Branch (p, m, t1, t0)
31      end
32in
33   fun add (Empty, x) = Leaf x
34     | add (Leaf (j, d), x as (k, _)) =
35         if j = k then Leaf x else join (k, Leaf x, j, Leaf (j, d))
36     | add (Branch (p, m, l, r), x as (k, _)) =
37         if mod_2exp_eq (m, k, p)
38            then if bit (m, k)
39                    then Branch (p, m, add (l, x), r)
40                 else Branch (p, m, l, add (r, x))
41         else join (k, Leaf x, p, Branch (p, m, l, r))
42end
43
44fun transform f Empty = Empty
45  | transform f (Leaf (j, d)) = Leaf (j, f d)
46  | transform f (Branch (p, m, l, r)) =
47      Branch (p, m, transform f l, transform f r)
48
49(*
50fun add_list t = List.foldl (fn (x, t) => add (t, x)) t
51fun ptree_of_list l = add_list Empty l
52
53local
54   fun branch (_, _, Empty, t) = t
55     | branch (_, _, t, Empty) = t
56     | branch (p, m, t0, t1) = Branch (p, m, t0, t1)
57in
58   fun remove (Empty, _) = Empty
59     | remove (t as Leaf (j, _), k) = if j = k then Empty else t
60     | remove (t as Branch (p, m, l, r), k) =
61         if mod_2exp_eq (m, k, p)
62            then if bit (m, k)
63                    then branch (p, m, remove (l, k), r)
64                 else branch (p, m, l, remove (r, k))
65         else t
66end
67
68local
69   fun traverse (Empty, a) = a
70     | traverse (Leaf x, a) = x :: a
71     | traverse (Branch (p, m, l, r), a) = traverse (l, traverse (r, a))
72in
73   fun list_of_ptree t = traverse (t, [])
74   fun keys t = List.map fst (list_of_ptree t)
75end
76
77fun size Empty = 0
78  | size (Leaf _) = 1
79  | size (Branch (_, _, l, r)) = size l + size r
80*)
81
82end (* structure Ptree *)
83