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