--- 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));