src/Pure/General/table.ML
changeset 77802 25c114e2528e
parent 77800 9a30b76a6f60
child 77805 66779a752f10
equal deleted inserted replaced
77801:e7cf427f8b2a 77802:25c114e2528e
   119 
   119 
   120 
   120 
   121 (* size *)
   121 (* size *)
   122 
   122 
   123 (*literal copy from set.ML*)
   123 (*literal copy from set.ML*)
   124 fun make_size m arg = if m > 12 then Size (m, arg) else arg;
       
   125 
       
   126 local
   124 local
   127   (*literal copy from set.ML*)
       
   128   fun count Empty n = n
   125   fun count Empty n = n
   129     | count (Leaf1 _) n = n + 1
   126     | count (Leaf1 _) n = n + 1
   130     | count (Leaf2 _) n = n + 2
   127     | count (Leaf2 _) n = n + 2
   131     | count (Leaf3 _) n = n + 3
   128     | count (Leaf3 _) n = n + 3
   132     | count (Branch2 (left, _, right)) n = count right (count left (n + 1))
   129     | count (Branch2 (left, _, right)) n = count right (count left (n + 1))
   133     | count (Branch3 (left, _, mid, _, right)) n = count right (count mid (count left (n + 2)))
   130     | count (Branch3 (left, _, mid, _, right)) n = count right (count mid (count left (n + 2)))
   134     | count (Size (m, _)) n = m + n;
   131     | count (Size (m, _)) n = m + n;
       
   132 
       
   133   fun box (Branch2 _) = 1
       
   134     | box (Branch3 _) = 1
       
   135     | box _ = 0;
       
   136 
       
   137   fun bound arg b =
       
   138     if b > 0 then
       
   139       (case arg of
       
   140         Branch2 (left, _, right) =>
       
   141           bound right (bound left (b - box left - box right))
       
   142       | Branch3 (left, _, mid, _, right) =>
       
   143           bound right (bound mid (bound left (b - box left - box mid - box right)))
       
   144       | _ => b)
       
   145     else b;
   135 in
   146 in
   136   fun size tab = Integer.build (count tab);
   147   fun size arg = count arg 0;
       
   148   fun make_size m arg = if bound arg 3 <= 0 then Size (m, arg) else arg;
   137 end;
   149 end;
   138 
   150 
   139 
   151 
   140 (* empty *)
   152 (* empty *)
   141 
   153