# HG changeset patch # User wenzelm # Date 1682939393 -7200 # Node ID 99df2576107f4f7594e5bcc5360dc6f566382f36 # Parent fd5f4455e0336212f2f05d944693609246ad3b3e minor performance tuning: more compact, more sharing; diff -r fd5f4455e033 -r 99df2576107f 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;