clarified modules;
authorwenzelm
Mon, 11 Dec 2023 12:45:16 +0100
changeset 79241 a49bdb686545
parent 79240 9cb8053d720e
child 79242 b0774e7d1949
clarified modules;
src/Pure/proofterm.ML
src/Pure/thm.ML
--- a/src/Pure/proofterm.ML	Mon Dec 11 12:27:42 2023 +0100
+++ b/src/Pure/proofterm.ML	Mon Dec 11 12:45:16 2023 +0100
@@ -131,7 +131,7 @@
   val lift_proof: term -> int -> term list -> proof -> proof
   val incr_indexes: int -> proof -> proof
   val assumption_proof: term list -> term -> int -> proof -> proof
-  val bicompose_proof: Envir.env -> bool -> term list -> term list -> term option ->
+  val bicompose_proof: Envir.env -> int -> bool -> term list -> term list -> term option ->
     term list -> int -> int -> proof -> proof -> proof
   val reflexive_axm: proof
   val symmetric_axm: proof
@@ -1079,18 +1079,25 @@
   | flatten_params_proof i j n (_, k) = proof_combP (proof_combt (PBound (k+i),
       map Bound (j-1 downto 0)), map PBound (remove (op =) (i-n) (i-1 downto 0)));
 
-fun bicompose_proof env flatten Bs As A oldAs n m rprf sprf =
+fun bicompose_proof env smax flatten Bs As A oldAs n m rprf sprf =
   let
     val normt = Envir.norm_term env;
+    val normp = norm_proof_remove_types env;
 
     val lb = length Bs;
     val la = length As;
+
+    fun proof p =
+      mk_AbsP (map normt (Bs @ As)) (proof_combP (sprf,
+        map PBound (lb + la - 1 downto la)) %%
+          proof_combP (p, (if n>0 then [mk_asm_prf (the A) n m] else []) @
+            map (if flatten then flatten_params_proof 0 0 n else PBound o snd)
+              (oldAs ~~ (la - 1 downto 0))));
   in
-    mk_AbsP (map normt (Bs @ As)) (proof_combP (sprf,
-      map PBound (lb + la - 1 downto la)) %%
-        proof_combP (rprf, (if n>0 then [mk_asm_prf (the A) n m] else []) @
-          map (if flatten then flatten_params_proof 0 0 n else PBound o snd)
-            (oldAs ~~ (la - 1 downto 0))))
+    if Envir.is_empty env then proof rprf
+    else if Envir.above env smax
+    then proof (normp rprf)
+    else normp (proof rprf)
   end;
 
 
--- a/src/Pure/thm.ML	Mon Dec 11 12:27:42 2023 +0100
+++ b/src/Pure/thm.ML	Mon Dec 11 12:45:16 2023 +0100
@@ -2347,13 +2347,8 @@
           union_constraints constraints1 constraints2
           |> insert_constraints_env thy' env;
         fun zproof p q = ZTerm.todo_proof p;
-        fun bicompose_proof p q =
-          Proofterm.bicompose_proof env flatten Bs As A oldAs n (nlift+1) p q;
-        val proof =
-          if Envir.is_empty env then bicompose_proof
-          else if Envir.above env smax
-          then bicompose_proof o Proofterm.norm_proof_remove_types env
-          else Proofterm.norm_proof_remove_types env oo bicompose_proof;
+        fun proof p q =
+          Proofterm.bicompose_proof env smax flatten Bs As A oldAs n (nlift + 1) p q;
         val th =
           Thm (deriv_rule2 zproof proof rder' sder,
            {tags = [],