more thorough treatment of hidden type variables within zproof;
authorwenzelm
Thu, 11 Jan 2024 12:44:27 +0100
changeset 79475 9eb9882f1845
parent 79474 c39aed404ffc
child 79476 64b3cfbce63f
more thorough treatment of hidden type variables within zproof;
src/Pure/zterm.ML
--- a/src/Pure/zterm.ML	Thu Jan 11 12:37:10 2024 +0100
+++ b/src/Pure/zterm.ML	Thu Jan 11 12:44:27 2024 +0100
@@ -470,6 +470,26 @@
   subst_term_same typ (Same.function (ZVars.lookup inst));
 
 
+(* fold types/terms within proof *)
+
+fun fold_proof {hyps} typ term =
+  let
+    fun proof ZDummy = I
+      | proof (ZConstp (_, _, instT, inst)) =
+          ZTVars.fold (typ o #2) instT #> ZVars.fold (term o #2) inst
+      | proof (ZBoundp _) = I
+      | proof (ZHyp h) = hyps ? term h
+      | proof (ZAbst (_, T, p)) = typ T #> proof p
+      | proof (ZAbsp (_, t, p)) = term t #> proof p
+      | proof (ZAppt (p, t)) = proof p #> term t
+      | proof (ZAppp (p, q)) = proof p #> proof q
+      | proof (ZClassp (T, _)) = hyps ? typ T;
+  in proof end;
+
+fun fold_proof_types hyps typ =
+  fold_proof hyps typ (fold_types typ);
+
+
 (* map types/terms within proof *)
 
 exception BAD_INST of ((indexname * ztyp) * zterm) list
@@ -830,7 +850,9 @@
   let
     val {zterm, ...} = zterm_cache thy;
 
-    val present_set = Types.build (Types.add_atyps concl #> fold Types.add_atyps hyps);
+    val present_set =
+      Types.build (Types.add_atyps concl #> fold Types.add_atyps hyps #>
+        (fold_proof_types {hyps = true} o fold_tvars) (Types.add_set o typ_of o ZTVar) prf);
     val ucontext as {constraints, outer_constraints, ...} =
       Logic.unconstrain_context [] present_set;