minor performance tuning: more compact, more sharing;
authorwenzelm
Mon, 01 May 2023 13:09:53 +0200
changeset 77945 99df2576107f
parent 77944 fd5f4455e033
child 77946 00c38dd0f30f
minor performance tuning: more compact, more sharing;
src/Pure/General/long_name.ML
--- a/src/Pure/General/long_name.ML	Mon May 01 12:18:10 2023 +0200
+++ b/src/Pure/General/long_name.ML	Mon May 01 13:09:53 2023 +0200
@@ -25,6 +25,7 @@
   val count_chunks: chunks -> int
   val size_chunks: chunks -> int
   val empty_chunks: chunks
+  val is_empty_chunks: chunks -> bool
   val base_chunks: string -> chunks
   val suppress_chunks: int -> bool list -> string -> chunks
   val make_chunks: string -> chunks
@@ -107,18 +108,26 @@
 fun range_length r = r mod range_limit;
 fun range_string s r = String.substring (s, range_index r, range_length r);
 
+val range_empty = 0;
+val ranges_empty: int vector = Vector.fromList [];
+
 in
 
-abstype chunks = Chunks of {ranges: int vector (*reverse*), string: string}
+abstype chunks = Chunks of {range0: int, ranges: int vector (*reverse*), string: string}
 with
 
-fun count_chunks (Chunks {ranges, ...}) = Vector.length ranges;
+val empty_chunks = Chunks {range0 = range_empty, ranges = ranges_empty, string = ""};
+
+fun is_empty_chunks (Chunks {range0, ranges, ...}) =
+  range0 = range_empty andalso Vector.length ranges = 0;
 
-fun size_chunks (Chunks {ranges, ...}) =
-  if Vector.length ranges = 0 then 0
-  else Vector.fold (fn r => fn n => n + range_length r + 1) ranges ~1;
+fun count_chunks (chunks as Chunks {ranges, ...}) =
+  if is_empty_chunks chunks then 0
+  else Vector.length ranges + 1;
 
-val empty_chunks = Chunks {ranges = Vector.fromList [], string = ""};
+fun size_chunks (chunks as Chunks {range0, ranges, ...}) =
+  if is_empty_chunks chunks then 0
+  else Vector.fold (fn r => fn n => n + range_length r + 1) ranges (range_length range0);
 
 fun base_chunks name =
   let
@@ -126,7 +135,7 @@
     val j = i + 1;
   in
     if i < 0 then empty_chunks
-    else Chunks {ranges = Vector.fromList [range name j (size name - j)], string = name}
+    else Chunks {range0 = range name j (size name - j), ranges = ranges_empty, string = name}
   end;
 
 fun suppress_chunks suppress1 suppress2 string =
@@ -158,25 +167,30 @@
         if not string_end then suppr_chunks suppr1' suppr2' i' j' rs'
         else if not (suppr1' = 0 andalso null suppr2') then
           failure string ("cannot suppress chunks beyond " ^ string_of_int (length rs'))
-        else if null rs' then empty_chunks
-        else Chunks {ranges = Vector.fromList rs', string = string}
+        else
+          (case rs' of
+            [] => empty_chunks
+          | r0 :: rest => Chunks {range0 = r0, ranges = Vector.fromList rest, string = string})
       end;
   in suppr_chunks suppress1 suppress2 0 0 [] end;
 
 val make_chunks = suppress_chunks 0 [];
 
-fun explode_chunks (Chunks {ranges, string}) =
-  Vector.fold (cons o range_string string) ranges [];
+fun explode_chunks (chunks as Chunks {range0, ranges, string}) =
+  if is_empty_chunks chunks then []
+  else Vector.fold (cons o range_string string) ranges [range_string string range0];
 
-fun implode_chunks (chunks as Chunks {ranges, string}) =
+fun implode_chunks (chunks as Chunks {range0, ranges, string}) =
   if size_chunks chunks = size string then string
-  else if Vector.length ranges = 1 then range_string string (Vector.nth ranges 0)
+  else if Vector.length ranges = 0 then range_string string range0
   else implode (explode_chunks chunks);
 
 val compare_chunks = pointer_eq_ord (fn (chunks1, chunks2) =>
   let
-    val Chunks {ranges = ranges1, string = string1} = chunks1;
-    val Chunks {ranges = ranges2, string = string2} = chunks2;
+    val Chunks {range0 = range01, ranges = ranges1, string = string1} = chunks1;
+    val Chunks {range0 = range02, ranges = ranges2, string = string2} = chunks2;
+    val count1 = count_chunks chunks1;
+    val count2 = count_chunks chunks2;
 
     val range_length_ord = int_ord o apply2 range_length;
     fun range_substring_ord arg =
@@ -192,9 +206,20 @@
           else EQUAL;
       in (case int_ord (m, n) of EQUAL => substring_ord 0 | ord => ord) end;
   in
-    (case vector_ord range_length_ord (ranges1, ranges2) of
-      EQUAL => Vector.collate range_substring_ord (ranges1, ranges2)
-    | ord => ord)
+    if count1 = 0 andalso count2 = 0 then EQUAL
+    else
+      (case int_ord (count1, count2) of
+        EQUAL =>
+          (case range_length_ord (range01, range02) of
+            EQUAL =>
+              (case Vector.collate range_length_ord (ranges1, ranges2) of
+                EQUAL =>
+                  (case range_substring_ord (range01, range02) of
+                    EQUAL => Vector.collate range_substring_ord (ranges1, ranges2)
+                  | ord => ord)
+              | ord => ord)
+          | ord => ord)
+      | ord => ord)
   end);
 
 val eq_chunks = is_equal o compare_chunks;