# HG changeset patch
# User wenzelm
# Date 1312922253 -7200
# Node ID 60edd70b72bd35763880e54499554eb152df57ca
# Parent  0e018cbcc0de519b9422076e01c907ebe46b1f70# Parent  202d2f56560c71e38eb117424ec1010238f3c7a8
merged

diff -r 0e018cbcc0de -r 60edd70b72bd src/Pure/proofterm.ML
--- a/src/Pure/proofterm.ML	Tue Aug 09 20:24:48 2011 +0200
+++ b/src/Pure/proofterm.ML	Tue Aug 09 22:37:33 2011 +0200
@@ -567,13 +567,16 @@
 
 (**** Freezing and thawing of variables in proof terms ****)
 
+local
+
 fun frzT names =
-  map_type_tvar (fn (ixn, xs) => TFree ((the o AList.lookup (op =) names) ixn, xs));
+  map_type_tvar (fn (ixn, S) => TFree (the (AList.lookup (op =) names ixn), S));
 
 fun thawT names =
-  map_type_tfree (fn (s, xs) => case AList.lookup (op =) names s of
-      NONE => TFree (s, xs)
-    | SOME ixn => TVar (ixn, xs));
+  map_type_tfree (fn (a, S) =>
+    (case AList.lookup (op =) names a of
+      NONE => TFree (a, S)
+    | SOME ixn => TVar (ixn, S)));
 
 fun freeze names names' (t $ u) =
       freeze names names' t $ freeze names names' u
@@ -582,7 +585,7 @@
   | freeze names names' (Const (s, T)) = Const (s, frzT names' T)
   | freeze names names' (Free (s, T)) = Free (s, frzT names' T)
   | freeze names names' (Var (ixn, T)) =
-      Free ((the o AList.lookup (op =) names) ixn, frzT names' T)
+      Free (the (AList.lookup (op =) names ixn), frzT names' T)
   | freeze names names' t = t;
 
 fun thaw names names' (t $ u) =
@@ -591,14 +594,16 @@
       Abs (s, thawT names' T, thaw names names' t)
   | thaw names names' (Const (s, T)) = Const (s, thawT names' T)
   | thaw names names' (Free (s, T)) =
-      let val T' = thawT names' T
-      in case AList.lookup (op =) names s of
+      let val T' = thawT names' T in
+        (case AList.lookup (op =) names s of
           NONE => Free (s, T')
-        | SOME ixn => Var (ixn, T')
+        | SOME ixn => Var (ixn, T'))
       end
   | thaw names names' (Var (ixn, T)) = Var (ixn, thawT names' T)
   | thaw names names' t = t;
 
+in
+
 fun freeze_thaw_prf prf =
   let
     val (fs, Tfs, vs, Tvs) = fold_proof_terms
@@ -618,6 +623,8 @@
      map_proof_terms (thaw rnames rnames') (thawT rnames'))
   end;
 
+end;
+
 
 (***** implication introduction *****)
 
@@ -881,23 +888,25 @@
   let
     val f = Envir.beta_norm f;
     val g = Envir.beta_norm g;
-    val prf =  if check_comb prf1 then
+    val prf =
+      if check_comb prf1 then
         combination_axm % NONE % NONE
-      else (case prf1 of
+      else
+        (case prf1 of
           PAxm ("Pure.reflexive", _, _) % _ =>
             combination_axm %> remove_types f % NONE
         | _ => combination_axm %> remove_types f %> remove_types g)
   in
     (case T of
-       Type ("fun", _) => prf %
-         (case head_of f of
-            Abs _ => SOME (remove_types t)
-          | Var _ => SOME (remove_types t)
-          | _ => NONE) %
-         (case head_of g of
-            Abs _ => SOME (remove_types u)
-          | Var _ => SOME (remove_types u)
-          | _ => NONE) %% prf1 %% prf2
+      Type ("fun", _) => prf %
+        (case head_of f of
+          Abs _ => SOME (remove_types t)
+        | Var _ => SOME (remove_types t)
+        | _ => NONE) %
+        (case head_of g of
+           Abs _ => SOME (remove_types u)
+        | Var _ => SOME (remove_types u)
+        | _ => NONE) %% prf1 %% prf2
      | _ => prf % NONE % NONE %% prf1 %% prf2)
   end;