src/HOL/Library/reflection.ML
changeset 32960 69916a850301
parent 32149 ef59550a55d3
child 32978 a473ba9a221d
--- a/src/HOL/Library/reflection.ML	Sat Oct 17 01:05:59 2009 +0200
+++ b/src/HOL/Library/reflection.ML	Sat Oct 17 14:43:18 2009 +0200
@@ -48,22 +48,22 @@
    val tys = map fastype_of fterms
    val vs = map Free (xs ~~ tys)
    val env = fterms ~~ vs
-		    (* FIXME!!!!*)
+                    (* FIXME!!!!*)
    fun replace_fterms (t as t1 $ t2) =
        (case AList.lookup (op aconv) env t of
-	    SOME v => v
-	  | NONE => replace_fterms t1 $ replace_fterms t2)
+            SOME v => v
+          | NONE => replace_fterms t1 $ replace_fterms t2)
      | replace_fterms t = (case AList.lookup (op aconv) env t of
-			       SOME v => v
-			     | NONE => t)
+                               SOME v => v
+                             | NONE => t)
 
    fun mk_def (Abs(x,xT,t),v) = HOLogic.mk_Trueprop ((HOLogic.all_const xT)$ Abs(x,xT,HOLogic.mk_eq(v$(Bound 0), t)))
      | mk_def (t, v) = HOLogic.mk_Trueprop (HOLogic.mk_eq (v, t))
    fun tryext x = (x RS ext2 handle THM _ =>  x)
    val cong = (Goal.prove ctxt'' [] (map mk_def env)
-			  (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, replace_fterms rhs)))
-			  (fn x => LocalDefs.unfold_tac (#context x) (map tryext (#prems x))
-							THEN rtac th' 1)) RS sym
+                          (HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, replace_fterms rhs)))
+                          (fn x => LocalDefs.unfold_tac (#context x) (map tryext (#prems x))
+                                                        THEN rtac th' 1)) RS sym
 
    val (cong' :: vars') =
        Variable.export ctxt'' ctxt (cong :: map (Drule.mk_term o cert) vs)
@@ -134,15 +134,15 @@
                  val (xn,ta) = variant_abs (xn,xT,ta)
                  val x = Free(xn,xT)
                  val bds = (case AList.lookup Type.could_unify bds (HOLogic.listT xT)
-		          of NONE => error "tryabsdecomp: Type not found in the Environement"
+                          of NONE => error "tryabsdecomp: Type not found in the Environement"
                            | SOME (bsT,atsT) =>
                              (AList.update Type.could_unify (HOLogic.listT xT, ((x::bsT), atsT)) bds))
                in (([(ta, ctxt')],
                     fn ([th], bds) =>
                       (hd (Variable.export ctxt' ctxt [(forall_intr (cert x) th) COMP allI]),
                        let val (bsT,asT) = the(AList.lookup Type.could_unify bds (HOLogic.listT xT))
-		       in AList.update Type.could_unify (HOLogic.listT xT,(tl bsT,asT)) bds
-		       end)),
+                       in AList.update Type.could_unify (HOLogic.listT xT,(tl bsT,asT)) bds
+                       end)),
                    bds)
                end)
            | _ => da (s,ctxt) bds)
@@ -157,9 +157,9 @@
                 (Vartab.empty, Vartab.empty)
             val (fnvs,invs) = List.partition (fn ((vn,_),_) => vn mem vns) (Vartab.dest tmenv)
             val (fts,its) =
-	      (map (snd o snd) fnvs,
+              (map (snd o snd) fnvs,
                map (fn ((vn,vi),(tT,t)) => (cert(Var ((vn,vi),tT)), cert t)) invs)
-	    val ctyenv = map (fn ((vn,vi),(s,ty)) => (certy (TVar((vn,vi),s)), certy ty)) (Vartab.dest tyenv)
+            val ctyenv = map (fn ((vn,vi),(s,ty)) => (certy (TVar((vn,vi),s)), certy ty)) (Vartab.dest tyenv)
           in ((fts ~~ (replicate (length fts) ctxt),
                Library.apfst (FWD (instantiate (ctyenv, its) cong))), bds)
           end)
@@ -174,9 +174,9 @@
           let
             val rhs = eq |> prop_of |> HOLogic.dest_Trueprop |> HOLogic.dest_eq |> snd
           in exists_Const
-	    (fn (n,ty) => n = @{const_name "List.nth"}
+            (fn (n,ty) => n = @{const_name "List.nth"}
                           andalso
-			  AList.defined Type.could_unify bds (domain_type ty)) rhs
+                          AList.defined Type.could_unify bds (domain_type ty)) rhs
             andalso Type.could_unify (fastype_of rhs, tT)
           end
 
@@ -266,7 +266,7 @@
 
         val bds = AList.make (fn _ => ([],[])) tys
         val eqs = map (fn eq => eq |> prop_of |> HOLogic.dest_Trueprop
-  	                           |> HOLogic.dest_eq |> fst |> strip_comb |> snd |> tl
+                                   |> HOLogic.dest_eq |> fst |> strip_comb |> snd |> tl
                                    |> (insteq eq)) raw_eqs
         val (ps,congs) = split_list (map (mk_congeq ctxt' fs) eqs)
       in (ps ~~ (Variable.export ctxt' ctxt congs), bds)
@@ -278,14 +278,14 @@
     fun is_listVar (Var (_,t)) = can dest_listT t
          | is_listVar _ = false
     val vars = th |> prop_of |> HOLogic.dest_Trueprop |> HOLogic.dest_eq |> snd
-	          |> strip_comb |> snd |> filter is_listVar
+                  |> strip_comb |> snd |> filter is_listVar
     val cert = cterm_of (ProofContext.theory_of ctxt)
     val cvs = map (fn (v as Var(n,t)) => (cert v,
                   the (AList.lookup Type.could_unify bds t) |> snd |> HOLogic.mk_list (dest_listT t) |> cert)) vars
     val th' = instantiate ([], cvs) th
     val t' = (fst o HOLogic.dest_eq o HOLogic.dest_Trueprop o prop_of) th'
     val th'' = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop (HOLogic.mk_eq (t, t')))
-	       (fn _ => simp_tac (simpset_of ctxt) 1)
+               (fn _ => simp_tac (simpset_of ctxt) 1)
   in FWD trans [th'',th']
   end