minor performance tuning: avoid somewhat indirect filter / add_consts;
authorwenzelm
Tue, 28 Jan 2025 13:33:07 +0100
changeset 82004 aaa7e388265a
parent 82003 abb40413c1e7
child 82005 b2d8d50b9efb
minor performance tuning: avoid somewhat indirect filter / add_consts;
src/Pure/Tools/adhoc_overloading.ML
--- a/src/Pure/Tools/adhoc_overloading.ML	Tue Jan 28 11:29:42 2025 +0100
+++ b/src/Pure/Tools/adhoc_overloading.ML	Tue Jan 28 13:33:07 2025 +0100
@@ -80,6 +80,7 @@
     let val (variants', oconsts') = f (variants, oconsts)
     in {variants = variants', oconsts = oconsts'} end);
 
+val no_overloaded = Symtab.is_empty o #variants o Data.get;
 val is_overloaded = Symtab.defined o #variants o Data.get;
 val get_variants = Symtab.lookup o #variants o Data.get;
 val get_overloaded = Termtab.lookup o #oconsts o Data.get;
@@ -185,10 +186,20 @@
     Pattern.rewrite_term_yoyo thy [] [proc]
   end;
 
+fun add_consts_overloaded ctxt =
+  let
+    val context = Context.Proof ctxt;
+    val overloaded = is_overloaded context;
+  in
+    if no_overloaded context then K I
+    else fold_aterms (fn Const (c, T) => if overloaded c then insert (op =) (c, T) else I | _ => I)
+  end;
+
 in
 
 fun check ctxt =
-  map (fn t => Term.map_aterms (insert_variants ctxt t) t);
+  if no_overloaded (Context.Proof ctxt) then I
+  else map (fn t => Term.map_aterms (insert_variants ctxt t) t);
 
 fun uncheck ctxt ts =
   if Config.get ctxt show_variants orelse exists (is_none o try Term.type_of) ts then ts
@@ -197,9 +208,9 @@
 fun reject_unresolved ctxt =
   let
     fun check_unresolved t =
-      (case filter (is_overloaded (Context.Proof ctxt) o fst) (Term.add_consts t []) of
+      (case add_consts_overloaded ctxt t [] of
         [] => t
-      | (cT :: _) => err_unresolved_overloading ctxt cT t (the_candidates ctxt cT));
+      | const :: _ => err_unresolved_overloading ctxt const t (the_candidates ctxt const));
   in map check_unresolved end;
 
 end;