clarified signature;
authorwenzelm
Sat, 30 Dec 2023 22:05:55 +0100
changeset 79397 0596c28860f9
parent 79396 d08460213400
child 79398 a9fb2bc71435
clarified signature;
src/Pure/logic.ML
src/Pure/thm.ML
--- a/src/Pure/logic.ML	Sat Dec 30 21:54:08 2023 +0100
+++ b/src/Pure/logic.ML	Sat Dec 30 22:05:55 2023 +0100
@@ -58,6 +58,8 @@
   val mk_arities: arity -> term list
   val mk_arity: string * sort list * class -> term
   val dest_arity: term -> string * sort list * class
+  val present_sorts: sort Ord_List.T -> Types.set ->
+    {present: (typ * sort) list, extra: sort Ord_List.T}
   val dummy_tfree: sort -> typ
   type unconstrain_context =
    {unconstrain_typ: {strip_sorts: bool} -> typ Same.operation,
@@ -352,6 +354,12 @@
 
 fun dummy_tfree S = TFree ("'dummy", S);
 
+fun present_sorts shyps present_set =
+  let
+    val present = map (fn T => (T, Type.sort_of_atyp T)) (Types.list_set present_set);
+    val extra = fold (Sorts.remove_sort o #2) present shyps;
+  in {present = present, extra = extra} end;
+
 type unconstrain_context =
  {unconstrain_typ: {strip_sorts: bool} -> typ Same.operation,
   constraints: ((typ * class) * term) list,
@@ -360,8 +368,7 @@
 fun unconstrainT shyps prop =
   let
     val present_set = Types.build (prop |> (fold_types o fold_atyps) Types.add_set);
-    val present = map (fn T => (T, Type.sort_of_atyp T)) (Types.list_set present_set);
-    val extra = fold (Sorts.remove_sort o #2) present shyps;
+    val {present, extra} = present_sorts shyps present_set;
 
     val n = Types.size present_set;
     val (names1, names2) = Name.invent Name.context Name.aT (n + length extra) |> chop n;
--- a/src/Pure/thm.ML	Sat Dec 30 21:54:08 2023 +0100
+++ b/src/Pure/thm.ML	Sat Dec 30 22:05:55 2023 +0100
@@ -1065,9 +1065,8 @@
 
         val present_set =
           Types.build (thm |> (fold_terms {hyps = true} o fold_types o fold_atyps) Types.add_set);
-        val present = map (fn T => (T, Type.sort_of_atyp T)) (Types.list_set present_set);
-
-        val extra = fold (Sorts.remove_sort o #2) present shyps;
+        val {present, extra} = Logic.present_sorts shyps present_set;
+
         val (witnessed, non_witnessed) =
           Sign.witness_sorts thy present extra ||> map (`(Sorts.minimize_sort algebra));