misc tuning;
authorwenzelm
Tue, 28 Jan 2025 11:20:53 +0100
changeset 82002 150bbde003ef
parent 82001 ae454f0c4f4c
child 82003 abb40413c1e7
misc tuning;
src/Pure/Tools/adhoc_overloading.ML
--- a/src/Pure/Tools/adhoc_overloading.ML	Tue Jan 28 11:17:07 2025 +0100
+++ b/src/Pure/Tools/adhoc_overloading.ML	Tue Jan 28 11:20:53 2025 +0100
@@ -66,12 +66,12 @@
     ({variants = vtab1, oconsts = otab1},
      {variants = vtab2, oconsts = otab2}) : T =
     let
-      fun merge_oconsts _ (oconst1, oconst2) =
+      fun join (oconst1, oconst2) =
         if oconst1 = oconst2 then oconst1
         else err_duplicate_variant oconst1;
     in
       {variants = Symtab.merge_list variants_eq (vtab1, vtab2),
-       oconsts = Termtab.join merge_oconsts (otab1, otab2)}
+       oconsts = Termtab.join (K join) (otab1, otab2)}
     end;
 );
 
@@ -141,8 +141,11 @@
 
 (* check / uncheck *)
 
-fun unifiable_with thy T1 T2 =
+local
+
+fun unifiable_types ctxt (T1, T2) =
   let
+    val thy = Proof_Context.theory_of ctxt;
     val maxidx1 = Term.maxidx_of_typ T1;
     val T2' = Logic.incr_tvar (maxidx1 + 1) T2;
     val maxidx2 = Term.maxidx_typ T2' maxidx1;
@@ -151,11 +154,13 @@
 fun get_candidates ctxt (c, T) =
   get_variants (Context.Proof ctxt) c
   |> Option.map (map_filter (fn (t, T') =>
-    if unifiable_with (Proof_Context.theory_of ctxt) T T'
+    if unifiable_types ctxt (T, T')
     (*keep the type constraint for the type-inference check phase*)
     then SOME (Type.constraint T t)
     else NONE));
 
+val the_candidates = the oo get_candidates;
+
 fun insert_variants ctxt t (oconst as Const (c, T)) =
       (case get_candidates ctxt (c, T) of
         SOME [] => err_unresolved_overloading ctxt (c, T) t []
@@ -165,14 +170,17 @@
 
 fun insert_overloaded ctxt =
   let
+    val thy = Proof_Context.theory_of ctxt;
     fun proc t =
       Term.map_types (K dummyT) t
       |> get_overloaded (Context.Proof ctxt)
       |> Option.map (Const o rpair (Term.type_of t));
   in
-    Pattern.rewrite_term_yoyo (Proof_Context.theory_of ctxt) [] [proc]
+    Pattern.rewrite_term_yoyo thy [] [proc]
   end;
 
+in
+
 fun check ctxt =
   map (fn t => Term.map_aterms (insert_variants ctxt t) t);
 
@@ -182,13 +190,14 @@
 
 fun reject_unresolved ctxt =
   let
-    val the_candidates = the o get_candidates ctxt;
     fun check_unresolved t =
       (case filter (is_overloaded (Context.Proof ctxt) o fst) (Term.add_consts t []) of
         [] => t
-      | (cT :: _) => err_unresolved_overloading ctxt cT t (the_candidates cT));
+      | (cT :: _) => err_unresolved_overloading ctxt cT t (the_candidates ctxt cT));
   in map check_unresolved end;
 
+end;
+
 
 (* setup *)