src/HOL/Decision_Procs/Reflective_Field.thy
changeset 74570 7625b5d7cfe2
parent 74569 f4613ca298e6
child 78095 bc42c074e58f
equal deleted inserted replaced
74569:f4613ca298e6 74570:7625b5d7cfe2
   638     (term_of_pexpr y, HOLogic.mk_list \<^Type>\<open>pexpr\<close> (map term_of_pexpr zs)));
   638     (term_of_pexpr y, HOLogic.mk_list \<^Type>\<open>pexpr\<close> (map term_of_pexpr zs)));
   639 
   639 
   640 local
   640 local
   641 
   641 
   642 fun fnorm (ctxt, ct, t) =
   642 fun fnorm (ctxt, ct, t) =
   643   \<^let>\<open>x = ct and y = \<open>Thm.cterm_of ctxt t\<close>
   643   \<^instantiate>\<open>x = ct and y = \<open>Thm.cterm_of ctxt t\<close>
   644     in cterm \<open>x \<equiv> y\<close> for x y :: \<open>pexpr \<times> pexpr \<times> pexpr list\<close>\<close>;
   644     in cterm \<open>x \<equiv> y\<close> for x y :: \<open>pexpr \<times> pexpr \<times> pexpr list\<close>\<close>;
   645 
   645 
   646 val (_, raw_fnorm_oracle) = Context.>>> (Context.map_theory_result
   646 val (_, raw_fnorm_oracle) = Context.>>> (Context.map_theory_result
   647   (Thm.add_oracle (\<^binding>\<open>fnorm\<close>, fnorm)));
   647   (Thm.add_oracle (\<^binding>\<open>fnorm\<close>, fnorm)));
   648 
   648 
   879         get_field_simps ctxt (Option.map (Thm.ctyp_of ctxt) optT) R;
   879         get_field_simps ctxt (Option.map (Thm.ctyp_of ctxt) optT) R;
   880       val xs = [] |> Term.add_frees t |> Term.add_frees u |> filter (equal T o snd);
   880       val xs = [] |> Term.add_frees t |> Term.add_frees u |> filter (equal T o snd);
   881       val cxs = Thm.cterm_of ctxt (HOLogic.mk_list T (map Free xs));
   881       val cxs = Thm.cterm_of ctxt (HOLogic.mk_list T (map Free xs));
   882       val ce = Thm.cterm_of ctxt (reif xs t);
   882       val ce = Thm.cterm_of ctxt (reif xs t);
   883       val ce' = Thm.cterm_of ctxt (reif xs u);
   883       val ce' = Thm.cterm_of ctxt (reif xs u);
   884       val fnorm = cv ctxt \<^let>\<open>e = ce and e' = ce' in cterm \<open>fnorm (FSub e e')\<close>\<close>;
   884       val fnorm = cv ctxt \<^instantiate>\<open>e = ce and e' = ce' in cterm \<open>fnorm (FSub e e')\<close>\<close>;
   885       val (_, [n, dc]) = strip_app (Thm.rhs_of fnorm);
   885       val (_, [n, dc]) = strip_app (Thm.rhs_of fnorm);
   886       val (_, [_, c]) = strip_app dc;
   886       val (_, [_, c]) = strip_app dc;
   887       val th =
   887       val th =
   888         Conv.fconv_rule (Conv.concl_conv 1 (Conv.arg_conv
   888         Conv.fconv_rule (Conv.concl_conv 1 (Conv.arg_conv
   889           (binop_conv
   889           (binop_conv