src/FOLP/simp.ML
changeset 74301 ffe269e74bdd
parent 70478 94ed5be08e7f
child 74408 4cdc5e946c99
equal deleted inserted replaced
74300:33f13d2d211c 74301:ffe269e74bdd
   156 fun add_hidden_vars ccs =
   156 fun add_hidden_vars ccs =
   157   let fun add_hvars tm hvars = case tm of
   157   let fun add_hvars tm hvars = case tm of
   158               Abs(_,_,body) => Misc_Legacy.add_term_vars(body,hvars)
   158               Abs(_,_,body) => Misc_Legacy.add_term_vars(body,hvars)
   159             | _$_ => let val (f,args) = strip_comb tm
   159             | _$_ => let val (f,args) = strip_comb tm
   160                      in case f of
   160                      in case f of
   161                             Const(c,T) =>
   161                             Const(c,_) =>
   162                                 if member (op =) ccs c
   162                                 if member (op =) ccs c
   163                                 then fold_rev add_hvars args hvars
   163                                 then fold_rev add_hvars args hvars
   164                                 else Misc_Legacy.add_term_vars (tm, hvars)
   164                                 else Misc_Legacy.add_term_vars (tm, hvars)
   165                           | _ => Misc_Legacy.add_term_vars (tm, hvars)
   165                           | _ => Misc_Legacy.add_term_vars (tm, hvars)
   166                      end
   166                      end
   176                    else vars
   176                    else vars
   177                 end
   177                 end
   178         fun add_vars (tm,vars) = case tm of
   178         fun add_vars (tm,vars) = case tm of
   179                   Abs (_,_,body) => add_vars(body,vars)
   179                   Abs (_,_,body) => add_vars(body,vars)
   180                 | r$s => (case head_of tm of
   180                 | r$s => (case head_of tm of
   181                           Const(c,T) => (case AList.lookup (op =) new_asms c of
   181                           Const(c,_) => (case AList.lookup (op =) new_asms c of
   182                                   NONE => add_vars(r,add_vars(s,vars))
   182                                   NONE => add_vars(r,add_vars(s,vars))
   183                                 | SOME(al) => add_list(tm,al,vars))
   183                                 | SOME(al) => add_list(tm,al,vars))
   184                         | _ => add_vars(r,add_vars(s,vars)))
   184                         | _ => add_vars(r,add_vars(s,vars)))
   185                 | _ => vars
   185                 | _ => vars
   186     in add_vars end;
   186     in add_vars end;
   397           else ();
   397           else ();
   398           writeln"" )
   398           writeln"" )
   399     else ();
   399     else ();
   400 
   400 
   401 (* Skip the first n hyps of a goal, and return the rest in generalized form *)
   401 (* Skip the first n hyps of a goal, and return the rest in generalized form *)
   402 fun strip_varify(Const(\<^const_name>\<open>Pure.imp\<close>, _) $ H $ B, n, vs) =
   402 fun strip_varify(\<^Const_>\<open>Pure.imp for H B\<close>, n, vs) =
   403         if n=0 then subst_bounds(vs,H)::strip_varify(B,0,vs)
   403         if n=0 then subst_bounds(vs,H)::strip_varify(B,0,vs)
   404         else strip_varify(B,n-1,vs)
   404         else strip_varify(B,n-1,vs)
   405   | strip_varify(Const(\<^const_name>\<open>Pure.all\<close>,_)$Abs(_,T,t), n, vs) =
   405   | strip_varify(\<^Const_>\<open>Pure.all _ for \<open>Abs(_,T,t)\<close>\<close>, n, vs) =
   406         strip_varify(t,n,Var(("?",length vs),T)::vs)
   406         strip_varify(t,n,Var(("?",length vs),T)::vs)
   407   | strip_varify  _  = [];
   407   | strip_varify  _  = [];
   408 
   408 
   409 fun execute ctxt (ss,if_fl,auto_tac,cong_tac,net,i,thm) =
   409 fun execute ctxt (ss,if_fl,auto_tac,cong_tac,net,i,thm) =
   410 let
   410 let
   513 
   513 
   514 
   514 
   515 fun exp_app(0,t) = t
   515 fun exp_app(0,t) = t
   516   | exp_app(i,t) = exp_app(i-1,t $ Bound (i-1));
   516   | exp_app(i,t) = exp_app(i-1,t $ Bound (i-1));
   517 
   517 
   518 fun exp_abs(Type("fun",[T1,T2]),t,i) =
   518 fun exp_abs(\<^Type>\<open>fun T1 T2\<close>,t,i) =
   519         Abs("x"^string_of_int i,T1,exp_abs(T2,t,i+1))
   519         Abs("x"^string_of_int i,T1,exp_abs(T2,t,i+1))
   520   | exp_abs(T,t,i) = exp_app(i,t);
   520   | exp_abs(T,t,i) = exp_app(i,t);
   521 
   521 
   522 fun eta_Var(ixn,T) = exp_abs(T,Var(ixn,T),0);
   522 fun eta_Var(ixn,T) = exp_abs(T,Var(ixn,T),0);
   523 
   523