File simpdata.ML (Isabelle2005: October 2005)

# File simpdata.ML

    (*  Title:      ZF/simpdata
        ID:         $Id: simpdata.ML,v 1.48 2005/09/12 16:21:02 haftmann Exp $
        Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
        Copyright   1991  University of Cambridge

    Rewriting for ZF set theory: specialized extraction of rewrites from theorems
    *)

    (*** New version of mk_rew_rules ***)

    (*Should False yield False<->True, or should it solve goals some other way?*)

    (*Analyse a theorem to atomic rewrite rules*)
    fun atomize (conn_pairs, mem_pairs) th =
      let fun tryrules pairs t =
              case head_of t of
                  Const(a,_) =>
                    (case AList.lookup (op =) pairs a of
                         SOME rls => List.concat (map (atomize (conn_pairs, mem_pairs))
                                           ([th] RL rls))
                       | NONE     => [th])
                | _ => [th]
      in case concl_of th of
             Const("Trueprop",_) $ P =>
                (case P of
                     Const("op :",_) $ a $ b => tryrules mem_pairs b
                   | Const("True",_)         => []
                   | Const("False",_)        => []
                   | A => tryrules conn_pairs A)
           | _                       => [th]
      end;

    (*Analyse a rigid formula*)
    val ZF_conn_pairs =
      [("Ball",     [bspec]),
       ("All",      [spec]),
       ("op -->",   [mp]),
       ("op &",     [conjunct1,conjunct2])];

    (*Analyse a:b, where b is rigid*)
    val ZF_mem_pairs =
      [("Collect",  [CollectD1,CollectD2]),
       ("op -",     [DiffD1,DiffD2]),
       ("op Int",   [IntD1,IntD2])];

    val ZF_atomize = atomize (ZF_conn_pairs, ZF_mem_pairs);

    val type_solver =
      mk_solver "types" (fn prems => TCSET' (fn tcset => type_solver_tac tcset prems));

    simpset_ref() :=
      simpset() setmksimps (map mk_eq o ZF_atomize o gen_all)
      addcongs [if_weak_cong]
      setSolver type_solver;

    local

    fun prove_bex_tac ss = unfold_tac ss [Bex_def] THEN Quantifier1.prove_one_point_ex_tac;
    val rearrange_bex = Quantifier1.rearrange_bex prove_bex_tac;

    fun prove_ball_tac ss = unfold_tac ss [Ball_def] THEN Quantifier1.prove_one_point_all_tac;
    val rearrange_ball = Quantifier1.rearrange_ball prove_ball_tac;

    in

    val defBEX_regroup = Simplifier.simproc (the_context ())
      "defined BEX" ["EX x:A. P(x) & Q(x)"] rearrange_bex;

    val defBALL_regroup = Simplifier.simproc (the_context ())
      "defined BALL" ["ALL x:A. P(x) --> Q(x)"] rearrange_ball;

    end;

    Addsimprocs [defBALL_regroup, defBEX_regroup];

    val ZF_ss = simpset();