equal
deleted
inserted
replaced
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 |