src/HOL/Set.thy

remove simp attribute from range_composition

(*  Title:      HOL/Set.thy
    ID:         $Id$
    Author:     Tobias Nipkow, Lawrence C Paulson and Markus Wenzel
*)

header {* Set theory for higher-order logic *}

theory Set
imports Orderings
begin

text {* A set in HOL is simply a predicate. *}


subsection {* Basic syntax *}

global

types 'a set = "'a => bool"

consts
  "{}"          :: "'a set"                             ("{}")
  UNIV          :: "'a set"
  insert        :: "'a => 'a set => 'a set"
  Collect       :: "('a => bool) => 'a set"              -- "comprehension"
  "op Int"      :: "'a set => 'a set => 'a set"          (infixl "Int" 70)
  "op Un"       :: "'a set => 'a set => 'a set"          (infixl "Un" 65)
  UNION         :: "'a set => ('a => 'b set) => 'b set"  -- "general union"
  INTER         :: "'a set => ('a => 'b set) => 'b set"  -- "general intersection"
  Union         :: "'a set set => 'a set"                -- "union of a set"
  Inter         :: "'a set set => 'a set"                -- "intersection of a set"
  Pow           :: "'a set => 'a set set"                -- "powerset"
  Ball          :: "'a set => ('a => bool) => bool"      -- "bounded universal quantifiers"
  Bex           :: "'a set => ('a => bool) => bool"      -- "bounded existential quantifiers"
  Bex1          :: "'a set => ('a => bool) => bool"      -- "bounded unique existential quantifiers"
  image         :: "('a => 'b) => 'a set => 'b set"      (infixr "`" 90)
  "op :"        :: "'a => 'a set => bool"                -- "membership"

notation
  "op :"  ("op :") and
  "op :"  ("(_/ : _)" [50, 51] 50)

local


subsection {* Additional concrete syntax *}

abbreviation
  range :: "('a => 'b) => 'b set" where -- "of function"
  "range f == f ` UNIV"

abbreviation
  "not_mem x A == ~ (x : A)" -- "non-membership"

notation
  not_mem  ("op ~:") and
  not_mem  ("(_/ ~: _)" [50, 51] 50)

notation (xsymbols)
  "op Int"  (infixl "\<inter>" 70) and
  "op Un"  (infixl "\<union>" 65) and
  "op :"  ("op \<in>") and
  "op :"  ("(_/ \<in> _)" [50, 51] 50) and
  not_mem  ("op \<notin>") and
  not_mem  ("(_/ \<notin> _)" [50, 51] 50) and
  Union  ("\<Union>_" [90] 90) and
  Inter  ("\<Inter>_" [90] 90)

notation (HTML output)
  "op Int"  (infixl "\<inter>" 70) and
  "op Un"  (infixl "\<union>" 65) and
  "op :"  ("op \<in>") and
  "op :"  ("(_/ \<in> _)" [50, 51] 50) and
  not_mem  ("op \<notin>") and
  not_mem  ("(_/ \<notin> _)" [50, 51] 50)

syntax
  "@Finset"     :: "args => 'a set"                       ("{(_)}")
  "@Coll"       :: "pttrn => bool => 'a set"              ("(1{_./ _})")
  "@SetCompr"   :: "'a => idts => bool => 'a set"         ("(1{_ |/_./ _})")
  "@Collect"    :: "idt => 'a set => bool => 'a set"      ("(1{_ :/ _./ _})")
  "@INTER1"     :: "pttrns => 'b set => 'b set"           ("(3INT _./ _)" [0, 10] 10)
  "@UNION1"     :: "pttrns => 'b set => 'b set"           ("(3UN _./ _)" [0, 10] 10)
  "@INTER"      :: "pttrn => 'a set => 'b set => 'b set"  ("(3INT _:_./ _)" [0, 10] 10)
  "@UNION"      :: "pttrn => 'a set => 'b set => 'b set"  ("(3UN _:_./ _)" [0, 10] 10)
  "_Ball"       :: "pttrn => 'a set => bool => bool"      ("(3ALL _:_./ _)" [0, 0, 10] 10)
  "_Bex"        :: "pttrn => 'a set => bool => bool"      ("(3EX _:_./ _)" [0, 0, 10] 10)
  "_Bex1"       :: "pttrn => 'a set => bool => bool"      ("(3EX! _:_./ _)" [0, 0, 10] 10)
  "_Bleast"     :: "id => 'a set => bool => 'a"           ("(3LEAST _:_./ _)" [0, 0, 10] 10)

syntax (HOL)
  "_Ball"       :: "pttrn => 'a set => bool => bool"      ("(3! _:_./ _)" [0, 0, 10] 10)
  "_Bex"        :: "pttrn => 'a set => bool => bool"      ("(3? _:_./ _)" [0, 0, 10] 10)
  "_Bex1"       :: "pttrn => 'a set => bool => bool"      ("(3?! _:_./ _)" [0, 0, 10] 10)

translations
  "{x, xs}"     == "insert x {xs}"
  "{x}"         == "insert x {}"
  "{x. P}"      == "Collect (%x. P)"
  "{x:A. P}"    => "{x. x:A & P}"
  "UN x y. B"   == "UN x. UN y. B"
  "UN x. B"     == "UNION UNIV (%x. B)"
  "UN x. B"     == "UN x:UNIV. B"
  "INT x y. B"  == "INT x. INT y. B"
  "INT x. B"    == "INTER UNIV (%x. B)"
  "INT x. B"    == "INT x:UNIV. B"
  "UN x:A. B"   == "UNION A (%x. B)"
  "INT x:A. B"  == "INTER A (%x. B)"
  "ALL x:A. P"  == "Ball A (%x. P)"
  "EX x:A. P"   == "Bex A (%x. P)"
  "EX! x:A. P"  == "Bex1 A (%x. P)"
  "LEAST x:A. P" => "LEAST x. x:A & P"

syntax (xsymbols)
  "_Ball"       :: "pttrn => 'a set => bool => bool"      ("(3\<forall>_\<in>_./ _)" [0, 0, 10] 10)
  "_Bex"        :: "pttrn => 'a set => bool => bool"      ("(3\<exists>_\<in>_./ _)" [0, 0, 10] 10)
  "_Bex1"       :: "pttrn => 'a set => bool => bool"      ("(3\<exists>!_\<in>_./ _)" [0, 0, 10] 10)
  "_Bleast"     :: "id => 'a set => bool => 'a"           ("(3LEAST_\<in>_./ _)" [0, 0, 10] 10)

syntax (HTML output)
  "_Ball"       :: "pttrn => 'a set => bool => bool"      ("(3\<forall>_\<in>_./ _)" [0, 0, 10] 10)
  "_Bex"        :: "pttrn => 'a set => bool => bool"      ("(3\<exists>_\<in>_./ _)" [0, 0, 10] 10)
  "_Bex1"       :: "pttrn => 'a set => bool => bool"      ("(3\<exists>!_\<in>_./ _)" [0, 0, 10] 10)

syntax (xsymbols)
  "@Collect"    :: "idt => 'a set => bool => 'a set"      ("(1{_ \<in>/ _./ _})")
  "@UNION1"     :: "pttrns => 'b set => 'b set"           ("(3\<Union>_./ _)" [0, 10] 10)
  "@INTER1"     :: "pttrns => 'b set => 'b set"           ("(3\<Inter>_./ _)" [0, 10] 10)
  "@UNION"      :: "pttrn => 'a set => 'b set => 'b set"  ("(3\<Union>_\<in>_./ _)" [0, 10] 10)
  "@INTER"      :: "pttrn => 'a set => 'b set => 'b set"  ("(3\<Inter>_\<in>_./ _)" [0, 10] 10)

syntax (latex output)
  "@UNION1"     :: "pttrns => 'b set => 'b set"           ("(3\<Union>(00\<^bsub>_\<^esub>)/ _)" [0, 10] 10)
  "@INTER1"     :: "pttrns => 'b set => 'b set"           ("(3\<Inter>(00\<^bsub>_\<^esub>)/ _)" [0, 10] 10)
  "@UNION"      :: "pttrn => 'a set => 'b set => 'b set"  ("(3\<Union>(00\<^bsub>_\<in>_\<^esub>)/ _)" [0, 10] 10)
  "@INTER"      :: "pttrn => 'a set => 'b set => 'b set"  ("(3\<Inter>(00\<^bsub>_\<in>_\<^esub>)/ _)" [0, 10] 10)

text{*
  Note the difference between ordinary xsymbol syntax of indexed
  unions and intersections (e.g.\ @{text"\<Union>a\<^isub>1\<in>A\<^isub>1. B"})
  and their \LaTeX\ rendition: @{term"\<Union>a\<^isub>1\<in>A\<^isub>1. B"}. The
  former does not make the index expression a subscript of the
  union/intersection symbol because this leads to problems with nested
  subscripts in Proof General. *}

abbreviation
  subset :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool" where
  "subset \<equiv> less"

abbreviation
  subset_eq :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool" where
  "subset_eq \<equiv> less_eq"

notation (output)
  subset  ("op <") and
  subset  ("(_/ < _)" [50, 51] 50) and
  subset_eq  ("op <=") and
  subset_eq  ("(_/ <= _)" [50, 51] 50)

notation (xsymbols)
  subset  ("op \<subset>") and
  subset  ("(_/ \<subset> _)" [50, 51] 50) and
  subset_eq  ("op \<subseteq>") and
  subset_eq  ("(_/ \<subseteq> _)" [50, 51] 50)

notation (HTML output)
  subset  ("op \<subset>") and
  subset  ("(_/ \<subset> _)" [50, 51] 50) and
  subset_eq  ("op \<subseteq>") and
  subset_eq  ("(_/ \<subseteq> _)" [50, 51] 50)

abbreviation (input)
  supset :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool" where
  "supset \<equiv> greater"

abbreviation (input)
  supset_eq :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool" where
  "supset_eq \<equiv> greater_eq"

notation (xsymbols)
  supset  ("op \<supset>") and
  supset  ("(_/ \<supset> _)" [50, 51] 50) and
  supset_eq  ("op \<supseteq>") and
  supset_eq  ("(_/ \<supseteq> _)" [50, 51] 50)


subsubsection "Bounded quantifiers"

syntax (output)
  "_setlessAll" :: "[idt, 'a, bool] => bool"  ("(3ALL _<_./ _)"  [0, 0, 10] 10)
  "_setlessEx"  :: "[idt, 'a, bool] => bool"  ("(3EX _<_./ _)"  [0, 0, 10] 10)
  "_setleAll"   :: "[idt, 'a, bool] => bool"  ("(3ALL _<=_./ _)" [0, 0, 10] 10)
  "_setleEx"    :: "[idt, 'a, bool] => bool"  ("(3EX _<=_./ _)" [0, 0, 10] 10)
  "_setleEx1"   :: "[idt, 'a, bool] => bool"  ("(3EX! _<=_./ _)" [0, 0, 10] 10)

syntax (xsymbols)
  "_setlessAll" :: "[idt, 'a, bool] => bool"   ("(3\<forall>_\<subset>_./ _)"  [0, 0, 10] 10)
  "_setlessEx"  :: "[idt, 'a, bool] => bool"   ("(3\<exists>_\<subset>_./ _)"  [0, 0, 10] 10)
  "_setleAll"   :: "[idt, 'a, bool] => bool"   ("(3\<forall>_\<subseteq>_./ _)" [0, 0, 10] 10)
  "_setleEx"    :: "[idt, 'a, bool] => bool"   ("(3\<exists>_\<subseteq>_./ _)" [0, 0, 10] 10)
  "_setleEx1"   :: "[idt, 'a, bool] => bool"   ("(3\<exists>!_\<subseteq>_./ _)" [0, 0, 10] 10)

syntax (HOL output)
  "_setlessAll" :: "[idt, 'a, bool] => bool"   ("(3! _<_./ _)"  [0, 0, 10] 10)
  "_setlessEx"  :: "[idt, 'a, bool] => bool"   ("(3? _<_./ _)"  [0, 0, 10] 10)
  "_setleAll"   :: "[idt, 'a, bool] => bool"   ("(3! _<=_./ _)" [0, 0, 10] 10)
  "_setleEx"    :: "[idt, 'a, bool] => bool"   ("(3? _<=_./ _)" [0, 0, 10] 10)
  "_setleEx1"   :: "[idt, 'a, bool] => bool"   ("(3?! _<=_./ _)" [0, 0, 10] 10)

syntax (HTML output)
  "_setlessAll" :: "[idt, 'a, bool] => bool"   ("(3\<forall>_\<subset>_./ _)"  [0, 0, 10] 10)
  "_setlessEx"  :: "[idt, 'a, bool] => bool"   ("(3\<exists>_\<subset>_./ _)"  [0, 0, 10] 10)
  "_setleAll"   :: "[idt, 'a, bool] => bool"   ("(3\<forall>_\<subseteq>_./ _)" [0, 0, 10] 10)
  "_setleEx"    :: "[idt, 'a, bool] => bool"   ("(3\<exists>_\<subseteq>_./ _)" [0, 0, 10] 10)
  "_setleEx1"   :: "[idt, 'a, bool] => bool"   ("(3\<exists>!_\<subseteq>_./ _)" [0, 0, 10] 10)

translations
 "\<forall>A\<subset>B. P"   =>  "ALL A. A \<subset> B --> P"
 "\<exists>A\<subset>B. P"   =>  "EX A. A \<subset> B & P"
 "\<forall>A\<subseteq>B. P"   =>  "ALL A. A \<subseteq> B --> P"
 "\<exists>A\<subseteq>B. P"   =>  "EX A. A \<subseteq> B & P"
 "\<exists>!A\<subseteq>B. P"  =>  "EX! A. A \<subseteq> B & P"

print_translation {*
let
  val Type (set_type, _) = @{typ "'a set"};
  val All_binder = Syntax.binder_name @{const_syntax "All"};
  val Ex_binder = Syntax.binder_name @{const_syntax "Ex"};
  val impl = @{const_syntax "op -->"};
  val conj = @{const_syntax "op &"};
  val sbset = @{const_syntax "subset"};
  val sbset_eq = @{const_syntax "subset_eq"};

  val trans =
   [((All_binder, impl, sbset), "_setlessAll"),
    ((All_binder, impl, sbset_eq), "_setleAll"),
    ((Ex_binder, conj, sbset), "_setlessEx"),
    ((Ex_binder, conj, sbset_eq), "_setleEx")];

  fun mk v v' c n P =
    if v = v' andalso not (Term.exists_subterm (fn Free (x, _) => x = v | _ => false) n)
    then Syntax.const c $ Syntax.mark_bound v' $ n $ P else raise Match;

  fun tr' q = (q,
    fn [Const ("_bound", _) $ Free (v, Type (T, _)), Const (c, _) $ (Const (d, _) $ (Const ("_bound", _) $ Free (v', _)) $ n) $ P] =>
         if T = (set_type) then case AList.lookup (op =) trans (q, c, d)
          of NONE => raise Match
           | SOME l => mk v v' l n P
         else raise Match
     | _ => raise Match);
in
  [tr' All_binder, tr' Ex_binder]
end
*}


text {*
  \medskip Translate between @{text "{e | x1...xn. P}"} and @{text
  "{u. EX x1..xn. u = e & P}"}; @{text "{y. EX x1..xn. y = e & P}"} is
  only translated if @{text "[0..n] subset bvs(e)"}.
*}

parse_translation {*
  let
    val ex_tr = snd (mk_binder_tr ("EX ", "Ex"));

    fun nvars (Const ("_idts", _) $ _ $ idts) = nvars idts + 1
      | nvars _ = 1;

    fun setcompr_tr [e, idts, b] =
      let
        val eq = Syntax.const "op =" $ Bound (nvars idts) $ e;
        val P = Syntax.const "op &" $ eq $ b;
        val exP = ex_tr [idts, P];
      in Syntax.const "Collect" $ Term.absdummy (dummyT, exP) end;

  in [("@SetCompr", setcompr_tr)] end;
*}

(* To avoid eta-contraction of body: *)
print_translation {*
let
  fun btr' syn [A,Abs abs] =
    let val (x,t) = atomic_abs_tr' abs
    in Syntax.const syn $ x $ A $ t end
in
[("Ball", btr' "_Ball"),("Bex", btr' "_Bex"),
 ("UNION", btr' "@UNION"),("INTER", btr' "@INTER")]
end
*}

print_translation {*
let
  val ex_tr' = snd (mk_binder_tr' ("Ex", "DUMMY"));

  fun setcompr_tr' [Abs (abs as (_, _, P))] =
    let
      fun check (Const ("Ex", _) $ Abs (_, _, P), n) = check (P, n + 1)
        | check (Const ("op &", _) $ (Const ("op =", _) $ Bound m $ e) $ P, n) =
            n > 0 andalso m = n andalso not (loose_bvar1 (P, n)) andalso
            ((0 upto (n - 1)) subset add_loose_bnos (e, 0, []))
        | check _ = false

        fun tr' (_ $ abs) =
          let val _ $ idts $ (_ $ (_ $ _ $ e) $ Q) = ex_tr' [abs]
          in Syntax.const "@SetCompr" $ e $ idts $ Q end;
    in if check (P, 0) then tr' P
       else let val (x as _ $ Free(xN,_), t) = atomic_abs_tr' abs
                val M = Syntax.const "@Coll" $ x $ t
            in case t of
                 Const("op &",_)
                   $ (Const("op :",_) $ (Const("_bound",_) $ Free(yN,_)) $ A)
                   $ P =>
                   if xN=yN then Syntax.const "@Collect" $ x $ A $ P else M
               | _ => M
            end
    end;
  in [("Collect", setcompr_tr')] end;
*}