chapter {* Generated by Lem from basic_classes.lem. *}

theory "Lem_basic_classes"

imports
 	 Main
	 "Lem_bool"

begin

(******************************************************************************)
(* Basic Type Classes                                                         *)
(******************************************************************************)

(*open import Bool*)

(*open import {coq} `Coq.Strings.Ascii`*)

(* ========================================================================== *)
(* Equality                                                                   *)
(* ========================================================================== *)

(* Lem`s default equality (=) is defined by the following type-class Eq.
   This typeclass should define equality on an abstract datatype 'a. It should
   always coincide with the default equality of Coq, HOL and Isabelle.
   For OCaml, it might be different, since abstract datatypes like sets
   might have fancy equalities. *)

(*class ( Eq 'a )
  val = [isEqual] : 'a -> 'a -> bool
  val <> [isInequal] : 'a -> 'a -> bool
end*)

(* (=) should for all instances be an equivalence relation
   The isEquivalence predicate of relations could be used here.
   However, this would lead to a cyclic dependency. *)

(* TODO: add later, once lemmata can be assigned to classes
lemma eq_equiv: ((forall x. (x = x)) &&
                 (forall x y. (x = y) <-> (y = x)) &&
                 (forall x y z. ((x = y) && (y = z)) --> (x = z)))
*)

(* Structural equality *)

(* Sometimes, it is also handy to be able to use structural equality.
   This equality is mapped to the build-in equality of backends. This equality
   differs significantly for each backend. For example, OCaml can`t check equality
   of function types, whereas HOL can.  When using structural equality, one should
   know what one is doing. The only guarentee is that is behaves like
   the native backend equality.

   A lengthy name for structural equality is used to discourage its direct use.
   It also ensures that users realise it is unsafe (e.g. OCaml can`t check two functions
   for equality *)
(*val unsafe_structural_equality : forall 'a. 'a -> 'a -> bool*)

(*val unsafe_structural_inequality : forall 'a. 'a -> 'a -> bool*)
(*let unsafe_structural_inequality x y=  not (unsafe_structural_equality x y)*)

(* ========================================================================== *)
(* Orderings                                                                  *)
(* ========================================================================== *)

(* The type-class Ord represents total orders (also called linear orders) *)
datatype ordering = LT | EQ | GT

fun orderingIsLess  :: " ordering \<Rightarrow> bool "        where
     " orderingIsLess LT       = ( True )"
|" orderingIsLess _       = ( False )"
declare orderingIsLess.simps [simp del]

fun orderingIsGreater  :: " ordering \<Rightarrow> bool "     where
     " orderingIsGreater GT    = ( True )"
|" orderingIsGreater _    = ( False )"
declare orderingIsGreater.simps [simp del]

fun orderingIsEqual  :: " ordering \<Rightarrow> bool "       where
     " orderingIsEqual EQ      = ( True )"
|" orderingIsEqual _      = ( False )"
declare orderingIsEqual.simps [simp del]

definition ordering_cases  :: " ordering \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a "  where
     " ordering_cases r lt eq gt = (
  if orderingIsLess r then lt else
  if orderingIsEqual r then eq else gt )"

(*val orderingEqual : ordering -> ordering -> bool*)

record 'a Ord_class=

  compare_method                 ::" 'a \<Rightarrow> 'a \<Rightarrow> ordering "

  isLess_method         ::" 'a \<Rightarrow> 'a \<Rightarrow> bool "

  isLessEqual_method    ::" 'a \<Rightarrow> 'a \<Rightarrow> bool "

  isGreater_method      ::" 'a \<Rightarrow> 'a \<Rightarrow> bool "

  isGreaterEqual_method ::" 'a \<Rightarrow> 'a \<Rightarrow> bool "

(* Ocaml provides default, polymorphic compare functions. Let's use them
   as the default. However, because used perhaps in a typeclass they must be
   defined for all targets. So, explicitly declare them as undefined for
   all other targets. If explictly declare undefined, the type-checker won't complain and
   an error will only be raised when trying to actually output the function for a certain
   target. *)
(*val defaultCompare   : forall 'a. 'a -> 'a -> ordering*)
(*val defaultLess      : forall 'a. 'a -> 'a -> bool*)
(*val defaultLessEq    : forall 'a. 'a -> 'a -> bool*)
(*val defaultGreater   : forall 'a. 'a -> 'a -> bool*)
(*val defaultGreaterEq : forall 'a. 'a -> 'a -> bool*)

definition genericCompare  :: "('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow>('a \<Rightarrow> 'a \<Rightarrow> bool)\<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ordering "  where
     " genericCompare (less1:: 'a \<Rightarrow> 'a \<Rightarrow> bool) (equal:: 'a \<Rightarrow> 'a \<Rightarrow> bool) (x :: 'a) (y :: 'a) = (
  if less1 x y then
    LT
  else if equal x y then
    EQ
  else
    GT )"

(*
(* compare should really be a total order *)
lemma ord_OK_1: (
  (forall x y. (compare x y = EQ) <-> (compare y x = EQ)) &&
  (forall x y. (compare x y = LT) <-> (compare y x = GT)))

lemma ord_OK_2: (
  (forall x y z. (x <= y) && (y <= z) --> (x <= z)) &&
  (forall x y. (x <= y) || (y <= x))
)
*)

(* let's derive a compare function from the Ord type-class *)
(*val ordCompare : forall 'a. Eq 'a, Ord 'a => 'a -> 'a -> ordering*)
definition ordCompare  :: " 'a Ord_class \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ordering "  where
     " ordCompare dict_Basic_classes_Ord_a x y = (
  if ((isLess_method   dict_Basic_classes_Ord_a) x y) then LT else
  if (x = y) then EQ else GT )"

record 'a OrdMaxMin_class=

  max_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a "

  min_method ::" 'a \<Rightarrow> 'a \<Rightarrow> 'a "

(*val minByLessEqual : forall 'a. ('a -> 'a -> bool) -> 'a -> 'a -> 'a*)

(*val maxByLessEqual : forall 'a. ('a -> 'a -> bool) -> 'a -> 'a -> 'a*)

(*val defaultMax : forall 'a. Ord 'a => 'a -> 'a -> 'a*)

(*val defaultMin : forall 'a. Ord 'a => 'a -> 'a -> 'a*)

definition instance_Basic_classes_OrdMaxMin_var_dict  :: " 'a Ord_class \<Rightarrow> 'a OrdMaxMin_class "  where
     " instance_Basic_classes_OrdMaxMin_var_dict dict_Basic_classes_Ord_a = ((|

  max_method = ((\<lambda> x y. if (
  (isLessEqual_method   dict_Basic_classes_Ord_a) y x) then x else y)),

  min_method = ((\<lambda> x y. if (
  (isLessEqual_method   dict_Basic_classes_Ord_a) x y) then x else y))|) )"

(* ========================================================================== *)
(* SetTypes                                                                   *)
(* ========================================================================== *)

(* Set implementations use often an order on the elements. This allows the OCaml implementation
   to use trees for implementing them. At least, one needs to be able to check equality on sets.
   One could use the Ord type-class for sets. However, defining a special typeclass is cleaner
   and allows more flexibility. One can make e.g. sure, that this type-class is ignored for
   backends like HOL or Isabelle, which don't need it. Moreover, one is not forced to also instantiate
   the functions <, <= ... *)

(*class ( SetType 'a )
  val {ocaml;coq} setElemCompare : 'a -> 'a -> ordering
end*)

fun boolCompare  :: " bool \<Rightarrow> bool \<Rightarrow> ordering "  where
     " boolCompare True True = ( EQ )"
|" boolCompare True False = ( GT )"
|" boolCompare False True = ( LT )"
|" boolCompare False False = ( EQ )"
declare boolCompare.simps [simp del]

(* strings *)

(*val charEqual : char -> char -> bool*)

(*val stringEquality : string -> string -> bool*)

(* pairs *)

(*val pairEqual : forall 'a 'b. Eq 'a, Eq 'b => ('a * 'b) -> ('a * 'b) -> bool*)
(*let pairEqual (a1, b1) (a2, b2)=  (a1 = a2) && (b1 = b2)*)

(*val pairEqualBy : forall 'a 'b. ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a * 'b) -> ('a * 'b) -> bool*)

(*val pairCompare : forall 'a 'b. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('a * 'b) -> ('a * 'b) -> ordering*)
fun pairCompare  :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow> 'a*'b \<Rightarrow> 'a*'b \<Rightarrow> ordering "  where
     " pairCompare cmpa cmpb (a1, b1) (a2, b2) = (
  (case  cmpa a1 a2 of
      LT => LT
    | GT => GT
    | EQ => cmpb b1 b2
  ))"
declare pairCompare.simps [simp del]

fun pairLess  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'b*'a \<Rightarrow> 'b*'a \<Rightarrow> bool "  where
     " pairLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b (x1, x2) (y1, y2) = ( (
  (isLess_method   dict_Basic_classes_Ord_b) x1 y1) \<or> (((isLessEqual_method   dict_Basic_classes_Ord_b) x1 y1) \<and> ((isLess_method   dict_Basic_classes_Ord_a) x2 y2)))"
declare pairLess.simps [simp del]

fun pairLessEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'b*'a \<Rightarrow> 'b*'a \<Rightarrow> bool "  where
     " pairLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b (x1, x2) (y1, y2) = ( (
  (isLess_method   dict_Basic_classes_Ord_b) x1 y1) \<or> (((isLessEqual_method   dict_Basic_classes_Ord_b) x1 y1) \<and> ((isLessEqual_method   dict_Basic_classes_Ord_a) x2 y2)))"
declare pairLessEq.simps [simp del]

definition pairGreater  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'a*'b \<Rightarrow> 'a*'b \<Rightarrow> bool "  where
     " pairGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b x12 y12 = ( pairLess
  dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y12 x12 )"

definition pairGreaterEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'a*'b \<Rightarrow> 'a*'b \<Rightarrow> bool "  where
     " pairGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b x12 y12 = ( pairLessEq
  dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y12 x12 )"

definition instance_Basic_classes_Ord_tup2_dict  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow>('a*'b)Ord_class "  where
     " instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b = ((|

  compare_method = (pairCompare
  (compare_method   dict_Basic_classes_Ord_a) (compare_method   dict_Basic_classes_Ord_b)),

  isLess_method =
  (pairLess dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a),

  isLessEqual_method =
  (pairLessEq dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a),

  isGreater_method =
  (pairGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b),

  isGreaterEqual_method =
  (pairGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b) |) )"

(* triples *)

(*val tripleEqual : forall 'a 'b 'c. Eq 'a, Eq 'b, Eq 'c => ('a * 'b * 'c) -> ('a * 'b * 'c) -> bool*)
(*let tripleEqual (x1, x2, x3) (y1, y2, y3)=  ((Instance_Basic_classes_Eq_tup2.=) (x1, (x2, x3)) (y1, (y2, y3)))*)

(*val tripleCompare : forall 'a 'b 'c. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('c -> 'c -> ordering) -> ('a * 'b * 'c) -> ('a * 'b * 'c) -> ordering*)
fun tripleCompare  :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow>('c \<Rightarrow> 'c \<Rightarrow> ordering)\<Rightarrow> 'a*'b*'c \<Rightarrow> 'a*'b*'c \<Rightarrow> ordering "  where
     " tripleCompare cmpa cmpb cmpc (a1, b1, c1) (a2, b2, c2) = (
  pairCompare cmpa (pairCompare cmpb cmpc) (a1, (b1, c1)) (a2, (b2, c2)))"
declare tripleCompare.simps [simp del]

fun tripleLess  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'a*'b*'c \<Rightarrow> 'a*'b*'c \<Rightarrow> bool "  where
     " tripleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c (x1, x2, x3) (y1, y2, y3) = ( pairLess
  (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c) dict_Basic_classes_Ord_a (x1, (x2, x3)) (y1, (y2, y3)))"
declare tripleLess.simps [simp del]

fun tripleLessEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'a*'b*'c \<Rightarrow> 'a*'b*'c \<Rightarrow> bool "  where
     " tripleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c (x1, x2, x3) (y1, y2, y3) = ( pairLessEq
  (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c) dict_Basic_classes_Ord_a (x1, (x2, x3)) (y1, (y2, y3)))"
declare tripleLessEq.simps [simp del]

definition tripleGreater  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'c*'b*'a \<Rightarrow> 'c*'b*'a \<Rightarrow> bool "  where
     " tripleGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c x123 y123 = ( tripleLess
  dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y123 x123 )"

definition tripleGreaterEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'c*'b*'a \<Rightarrow> 'c*'b*'a \<Rightarrow> bool "  where
     " tripleGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c x123 y123 = ( tripleLessEq
  dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y123 x123 )"

definition instance_Basic_classes_Ord_tup3_dict  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow>('a*'b*'c)Ord_class "  where
     " instance_Basic_classes_Ord_tup3_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c = ((|

  compare_method = (tripleCompare
  (compare_method   dict_Basic_classes_Ord_a) (compare_method   dict_Basic_classes_Ord_b) (compare_method   dict_Basic_classes_Ord_c)),

  isLess_method =
  (tripleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c),

  isLessEqual_method =
  (tripleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c),

  isGreater_method =
  (tripleGreater dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_a),

  isGreaterEqual_method =
  (tripleGreaterEq dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_a) |) )"

(* quadruples *)

(*val quadrupleEqual : forall 'a 'b 'c 'd. Eq 'a, Eq 'b, Eq 'c, Eq 'd => ('a * 'b * 'c * 'd) -> ('a * 'b * 'c * 'd) -> bool*)
(*let quadrupleEqual (x1, x2, x3, x4) (y1, y2, y3, y4)=  ((Instance_Basic_classes_Eq_tup2.=) (x1, (x2, (x3, x4))) (y1, (y2, (y3, y4))))*)

(*val quadrupleCompare : forall 'a 'b 'c 'd. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('c -> 'c -> ordering) ->
                                              ('d -> 'd -> ordering) -> ('a * 'b * 'c * 'd) -> ('a * 'b * 'c * 'd) -> ordering*)
fun quadrupleCompare  :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow>('c \<Rightarrow> 'c \<Rightarrow> ordering)\<Rightarrow>('d \<Rightarrow> 'd \<Rightarrow> ordering)\<Rightarrow> 'a*'b*'c*'d \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> ordering "  where
     " quadrupleCompare cmpa cmpb cmpc cmpd (a1, b1, c1, d1) (a2, b2, c2, d2) = (
  pairCompare cmpa (pairCompare cmpb (pairCompare cmpc cmpd)) (a1, (b1, (c1, d1))) (a2, (b2, (c2, d2))))"
declare quadrupleCompare.simps [simp del]

fun quadrupleLess  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> bool "  where
     " quadrupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d (x1, x2, x3, x4) (y1, y2, y3, y4) = ( pairLess
  (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b
     (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c
        dict_Basic_classes_Ord_d)) dict_Basic_classes_Ord_a (x1, (x2, (x3, x4))) (y1, (y2, (y3, y4))))"
declare quadrupleLess.simps [simp del]

fun quadrupleLessEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> 'a*'b*'c*'d \<Rightarrow> bool "  where
     " quadrupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d (x1, x2, x3, x4) (y1, y2, y3, y4) = ( pairLessEq
  (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b
     (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c
        dict_Basic_classes_Ord_d)) dict_Basic_classes_Ord_a (x1, (x2, (x3, x4))) (y1, (y2, (y3, y4))))"
declare quadrupleLessEq.simps [simp del]

definition quadrupleGreater  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'd*'c*'b*'a \<Rightarrow> 'd*'c*'b*'a \<Rightarrow> bool "  where
     " quadrupleGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d x1234 y1234 = ( quadrupleLess
  dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y1234 x1234 )"

definition quadrupleGreaterEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'd*'c*'b*'a \<Rightarrow> 'd*'c*'b*'a \<Rightarrow> bool "  where
     " quadrupleGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d x1234 y1234 = ( quadrupleLessEq
  dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y1234 x1234 )"

definition instance_Basic_classes_Ord_tup4_dict  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow>('a*'b*'c*'d)Ord_class "  where
     " instance_Basic_classes_Ord_tup4_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d = ((|

  compare_method = (quadrupleCompare
  (compare_method   dict_Basic_classes_Ord_a) (compare_method   dict_Basic_classes_Ord_b) (compare_method   dict_Basic_classes_Ord_c) (compare_method   dict_Basic_classes_Ord_d)),

  isLess_method =
  (quadrupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d),

  isLessEqual_method =
  (quadrupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d),

  isGreater_method =
  (quadrupleGreater dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c
     dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a),

  isGreaterEqual_method =
  (quadrupleGreaterEq dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c
     dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a) |) )"

(* quintuples *)

(*val quintupleEqual : forall 'a 'b 'c 'd 'e. Eq 'a, Eq 'b, Eq 'c, Eq 'd, Eq 'e => ('a * 'b * 'c * 'd * 'e) -> ('a * 'b * 'c * 'd * 'e) -> bool*)
(*let quintupleEqual (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5)=  ((Instance_Basic_classes_Eq_tup2.=) (x1, (x2, (x3, (x4, x5)))) (y1, (y2, (y3, (y4, y5)))))*)

(*val quintupleCompare : forall 'a 'b 'c 'd 'e. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('c -> 'c -> ordering) ->
                                              ('d -> 'd -> ordering) -> ('e -> 'e -> ordering) -> ('a * 'b * 'c * 'd * 'e) -> ('a * 'b * 'c * 'd * 'e) -> ordering*)
fun quintupleCompare  :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow>('c \<Rightarrow> 'c \<Rightarrow> ordering)\<Rightarrow>('d \<Rightarrow> 'd \<Rightarrow> ordering)\<Rightarrow>('e \<Rightarrow> 'e \<Rightarrow> ordering)\<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> ordering "  where
     " quintupleCompare cmpa cmpb cmpc cmpd cmpe (a1, b1, c1, d1, e1) (a2, b2, c2, d2, e2) = (
  pairCompare cmpa (pairCompare cmpb (pairCompare cmpc (pairCompare cmpd cmpe))) (a1, (b1, (c1, (d1, e1)))) (a2, (b2, (c2, (d2, e2)))))"
declare quintupleCompare.simps [simp del]

fun quintupleLess  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> bool "  where
     " quintupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5) = ( pairLess
  (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b
     (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c
        (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_d
           dict_Basic_classes_Ord_e))) dict_Basic_classes_Ord_a (x1, (x2, (x3, (x4, x5)))) (y1, (y2, (y3, (y4, y5)))))"
declare quintupleLess.simps [simp del]

fun quintupleLessEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> 'a*'b*'c*'d*'e \<Rightarrow> bool "  where
     " quintupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5) = ( pairLessEq
  (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b
     (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c
        (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_d
           dict_Basic_classes_Ord_e))) dict_Basic_classes_Ord_a (x1, (x2, (x3, (x4, x5)))) (y1, (y2, (y3, (y4, y5)))))"
declare quintupleLessEq.simps [simp del]

definition quintupleGreater  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'e*'d*'c*'b*'a \<Rightarrow> 'e*'d*'c*'b*'a \<Rightarrow> bool "  where
     " quintupleGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e x12345 y12345 = ( quintupleLess
  dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y12345 x12345 )"

definition quintupleGreaterEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'e*'d*'c*'b*'a \<Rightarrow> 'e*'d*'c*'b*'a \<Rightarrow> bool "  where
     " quintupleGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e x12345 y12345 = ( quintupleLessEq
  dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y12345 x12345 )"

definition instance_Basic_classes_Ord_tup5_dict  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow>('a*'b*'c*'d*'e)Ord_class "  where
     " instance_Basic_classes_Ord_tup5_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e = ((|

  compare_method = (quintupleCompare
  (compare_method   dict_Basic_classes_Ord_a) (compare_method   dict_Basic_classes_Ord_b) (compare_method   dict_Basic_classes_Ord_c) (compare_method   dict_Basic_classes_Ord_d) (compare_method   dict_Basic_classes_Ord_e)),

  isLess_method =
  (quintupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d
     dict_Basic_classes_Ord_e),

  isLessEqual_method =
  (quintupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d
     dict_Basic_classes_Ord_e),

  isGreater_method =
  (quintupleGreater dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d
     dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_a),

  isGreaterEqual_method =
  (quintupleGreaterEq dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d
     dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_a) |) )"

(* sextuples *)

(*val sextupleEqual : forall 'a 'b 'c 'd 'e 'f. Eq 'a, Eq 'b, Eq 'c, Eq 'd, Eq 'e, Eq 'f => ('a * 'b * 'c * 'd * 'e * 'f) -> ('a * 'b * 'c * 'd * 'e * 'f) -> bool*)
(*let sextupleEqual (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6)=  ((Instance_Basic_classes_Eq_tup2.=) (x1, (x2, (x3, (x4, (x5, x6))))) (y1, (y2, (y3, (y4, (y5, y6))))))*)

(*val sextupleCompare : forall 'a 'b 'c 'd 'e 'f. ('a -> 'a -> ordering) -> ('b -> 'b -> ordering) -> ('c -> 'c -> ordering) ->
                                              ('d -> 'd -> ordering) -> ('e -> 'e -> ordering) -> ('f -> 'f -> ordering) ->
                                              ('a * 'b * 'c * 'd * 'e * 'f) -> ('a * 'b * 'c * 'd * 'e * 'f) -> ordering*)
fun sextupleCompare  :: "('a \<Rightarrow> 'a \<Rightarrow> ordering)\<Rightarrow>('b \<Rightarrow> 'b \<Rightarrow> ordering)\<Rightarrow>('c \<Rightarrow> 'c \<Rightarrow> ordering)\<Rightarrow>('d \<Rightarrow> 'd \<Rightarrow> ordering)\<Rightarrow>('e \<Rightarrow> 'e \<Rightarrow> ordering)\<Rightarrow>('f \<Rightarrow> 'f \<Rightarrow> ordering)\<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> ordering "  where
     " sextupleCompare cmpa cmpb cmpc cmpd cmpe cmpf (a1, b1, c1, d1, e1, f1) (a2, b2, c2, d2, e2, f2) = (
  pairCompare cmpa (pairCompare cmpb (pairCompare cmpc (pairCompare cmpd (pairCompare cmpe cmpf)))) (a1, (b1, (c1, (d1, (e1, f1))))) (a2, (b2, (c2, (d2, (e2, f2))))))"
declare sextupleCompare.simps [simp del]

fun sextupleLess  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> bool "  where
     " sextupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6) = ( pairLess
  (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b
     (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c
        (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_d
           (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_e
              dict_Basic_classes_Ord_f)))) dict_Basic_classes_Ord_a (x1, (x2, (x3, (x4, (x5, x6))))) (y1, (y2, (y3, (y4, (y5, y6))))))"
declare sextupleLess.simps [simp del]

fun sextupleLessEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> 'a*'b*'c*'d*'e*'f \<Rightarrow> bool "  where
     " sextupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6) = ( pairLessEq
  (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_b
     (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_c
        (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_d
           (instance_Basic_classes_Ord_tup2_dict dict_Basic_classes_Ord_e
              dict_Basic_classes_Ord_f)))) dict_Basic_classes_Ord_a (x1, (x2, (x3, (x4, (x5, x6))))) (y1, (y2, (y3, (y4, (y5, y6))))))"
declare sextupleLessEq.simps [simp del]

definition sextupleGreater  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow> 'f*'e*'d*'c*'b*'a \<Rightarrow> 'f*'e*'d*'c*'b*'a \<Rightarrow> bool "  where
     " sextupleGreater dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f x123456 y123456 = ( sextupleLess
  dict_Basic_classes_Ord_f dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y123456 x123456 )"

definition sextupleGreaterEq  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow> 'f*'e*'d*'c*'b*'a \<Rightarrow> 'f*'e*'d*'c*'b*'a \<Rightarrow> bool "  where
     " sextupleGreaterEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f x123456 y123456 = ( sextupleLessEq
  dict_Basic_classes_Ord_f dict_Basic_classes_Ord_e dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a y123456 x123456 )"

definition instance_Basic_classes_Ord_tup6_dict  :: " 'a Ord_class \<Rightarrow> 'b Ord_class \<Rightarrow> 'c Ord_class \<Rightarrow> 'd Ord_class \<Rightarrow> 'e Ord_class \<Rightarrow> 'f Ord_class \<Rightarrow>('a*'b*'c*'d*'e*'f)Ord_class "  where
     " instance_Basic_classes_Ord_tup6_dict dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f = ((|

  compare_method = (sextupleCompare
  (compare_method   dict_Basic_classes_Ord_a) (compare_method   dict_Basic_classes_Ord_b) (compare_method   dict_Basic_classes_Ord_c) (compare_method   dict_Basic_classes_Ord_d) (compare_method   dict_Basic_classes_Ord_e) (compare_method   dict_Basic_classes_Ord_f)),

  isLess_method =
  (sextupleLess dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d
     dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f),

  isLessEqual_method =
  (sextupleLessEq dict_Basic_classes_Ord_a dict_Basic_classes_Ord_b
     dict_Basic_classes_Ord_c dict_Basic_classes_Ord_d
     dict_Basic_classes_Ord_e dict_Basic_classes_Ord_f),

  isGreater_method =
  (sextupleGreater dict_Basic_classes_Ord_f dict_Basic_classes_Ord_e
     dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c
     dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a),

  isGreaterEqual_method =
  (sextupleGreaterEq dict_Basic_classes_Ord_f dict_Basic_classes_Ord_e
     dict_Basic_classes_Ord_d dict_Basic_classes_Ord_c
     dict_Basic_classes_Ord_b dict_Basic_classes_Ord_a) |) )"

end


section \<open>Finite types as explicit enumerations\<close>

theory Enum_mod
  imports Main
begin

subsection \<open>Small finite types as arithmetic modulo its cardinal\<close>

text \<open>Similar types are defined as @{term finite_1} up to @{term finite_5} in Enum.thy
  in the Isabelle distribution, but they define the binary minus
  (see Enum.thy in the HOL folder of the Isabelle distribution)
  not modulo the cardinal of the Universe set, but as in a lattice.
  They are neither proven to be instances of linear order, but lattices.\<close>

datatype (plugins only: code "quickcheck" extraction) finite_mod_1 =
  a\<^sub>0

notation (output) a\<^sub>0  ("a\<^sub>0")

lemma UNIV_finite_mod_1:
  "UNIV = {a\<^sub>0}"
  by (auto intro: finite_mod_1.exhaust)

instantiation finite_mod_1 :: enum
begin

definition enum_finite_mod_1 :: "finite_mod_1 list"
  where "enum_finite_mod_1 = [a\<^sub>0]"

definition enum_all_finite_mod_1 :: "(finite_mod_1 \<Rightarrow> bool) \<Rightarrow> bool"
  where "enum_all_finite_mod_1 P = P a\<^sub>0"

definition enum_ex_finite_mod_1 :: "(finite_mod_1 \<Rightarrow> bool) \<Rightarrow> bool"
  where "enum_ex_finite_mod_1 P = P a\<^sub>0"

instance proof (intro_classes)
qed (simp_all only: enum_finite_mod_1_def enum_all_finite_mod_1_def enum_ex_finite_mod_1_def UNIV_finite_mod_1, simp_all)

end

instantiation finite_mod_1 :: linorder
begin

definition less_finite_mod_1 :: "finite_mod_1 \<Rightarrow> finite_mod_1 \<Rightarrow> bool"
where
  "x < (y :: finite_mod_1) \<longleftrightarrow> False"

definition less_eq_finite_mod_1 :: "finite_mod_1 \<Rightarrow> finite_mod_1 \<Rightarrow> bool"
where
  "x \<le> (y :: finite_mod_1) \<longleftrightarrow> True"

instance
apply (intro_classes)
apply (auto simp add: less_finite_mod_1_def less_eq_finite_mod_1_def)
apply (metis (full_types) finite_mod_1.exhaust)
done

end

instance finite_mod_1 :: "{dense_linorder, wellorder}"
by intro_classes (simp_all add: less_finite_mod_1_def)

instantiation finite_mod_1 :: complete_lattice
begin

definition [simp]: "Inf = (\<lambda>_. a\<^sub>0)"
definition [simp]: "Sup = (\<lambda>_. a\<^sub>0)"
definition [simp]: "bot = a\<^sub>0"
definition [simp]: "top = a\<^sub>0"
definition [simp]: "inf = (\<lambda>_ _. a\<^sub>0)"
definition [simp]: "sup = (\<lambda>_ _. a\<^sub>0)"

instance by intro_classes(simp_all add: less_eq_finite_mod_1_def)
end

instance finite_mod_1 :: complete_distrib_lattice
  by standard simp_all

instance finite_mod_1 :: complete_linorder ..

lemma finite_mod_1_eq: "x = a\<^sub>0"
by(cases x) simp

simproc_setup finite_mod_1_eq ("x::finite_mod_1") = \<open>
  fn _ => fn _ => fn ct =>
    (case Thm.term_of ct of
      Const (\<^const_name>\<open>a\<^sub>0\<close>, _) => NONE
    | _ => SOME (mk_meta_eq @{thm finite_mod_1_eq}))
\<close>

instantiation finite_mod_1 :: complete_boolean_algebra
begin
definition [simp]: "(-) = (\<lambda>_ _. a\<^sub>0)"
definition [simp]: "uminus = (\<lambda>_. a\<^sub>0)"
instance by intro_classes simp_all
end

instantiation finite_mod_1 ::
  "{linordered_ring_strict, linordered_comm_semiring_strict, ordered_comm_ring,
    ordered_cancel_comm_monoid_diff, comm_monoid_mult, ordered_ring_abs,
    one, modulo, sgn, inverse}"
begin
definition [simp]: "Groups.zero = a\<^sub>0"
definition [simp]: "Groups.one = a\<^sub>0"
definition [simp]: "(+) = (\<lambda>_ _. a\<^sub>0)"
definition [simp]: "(*) = (\<lambda>_ _. a\<^sub>0)"
definition [simp]: "(mod) = (\<lambda>_ _. a\<^sub>0)"
definition [simp]: "abs = (\<lambda>_. a\<^sub>0)"
definition [simp]: "sgn = (\<lambda>_. a\<^sub>0)"
definition [simp]: "inverse = (\<lambda>_. a\<^sub>0)"
definition [simp]: "divide = (\<lambda>_ _. a\<^sub>0)"

instance by intro_classes (simp_all add: less_finite_1_def)
end

declare [[simproc del: finite_mod_1_eq]]
hide_const (open) a\<^sub>0

datatype (plugins only: code "quickcheck" extraction) finite_mod_2 =
  a\<^sub>0 | a\<^sub>1

notation (output) a\<^sub>0  ("a\<^sub>0")
notation (output) a\<^sub>1  ("a\<^sub>1")

lemma UNIV_finite_mod_2:
  "UNIV = {a\<^sub>0, a\<^sub>1}"
  by (auto intro: finite_mod_2.exhaust)

instantiation finite_mod_2 :: enum
begin

definition
  "enum_finite_mod_2 = [a\<^sub>0, a\<^sub>1]"

definition
  "enum_all_finite_mod_2 P \<longleftrightarrow> P a\<^sub>0 \<and> P a\<^sub>1"

definition
  "enum_ex_finite_mod_2 P \<longleftrightarrow> P a\<^sub>0 \<or> P a\<^sub>1"

instance proof
qed (simp_all only: enum_finite_mod_2_def enum_all_finite_mod_2_def enum_ex_finite_mod_2_def UNIV_finite_mod_2, simp_all)

end

instantiation finite_mod_2 :: linorder
begin

definition less_finite_mod_2 :: "finite_mod_2 \<Rightarrow> finite_mod_2 \<Rightarrow> bool"
where
  "x < y \<longleftrightarrow> x = a\<^sub>0 \<and> y = a\<^sub>1"

definition less_eq_finite_mod_2 :: "finite_mod_2 \<Rightarrow> finite_mod_2 \<Rightarrow> bool"
where
  "x \<le> y \<longleftrightarrow> x = y \<or> x < (y :: finite_mod_2)"

instance
apply (intro_classes)
apply (auto simp add: less_finite_mod_2_def less_eq_finite_mod_2_def)
apply (metis finite_mod_2.nchotomy)+
done

end

instance finite_mod_2 :: wellorder
by(rule wf_wellorderI)(simp add: less_finite_mod_2_def, intro_classes)

instantiation finite_mod_2 :: complete_lattice
begin

definition "Inf_finite_mod_2 A = (if a\<^sub>0 \<in> A then a\<^sub>0 else a\<^sub>1)"
definition "Sup_finite_mod_2 A = (if a\<^sub>1 \<in> A then a\<^sub>1 else a\<^sub>0)"
definition [simp]: "bot = a\<^sub>0"
definition [simp]: "top = a\<^sub>1"
definition "sup_finite_mod_2 x y = (if x = a\<^sub>1 \<or> y = a\<^sub>1 then a\<^sub>1 else a\<^sub>0)"
definition "inf_finite_mod_2 x y = (if x = a\<^sub>0 \<or> y = a\<^sub>0 then a\<^sub>0 else a\<^sub>1)"

lemma neq_finite_mod_2_a\<^sub>1_iff [simp]: "x \<noteq> a\<^sub>0 \<longleftrightarrow> x = a\<^sub>1"
by(cases x) simp_all

lemma neq_finite_mod_2_a\<^sub>1_iff' [simp]: "a\<^sub>0 \<noteq> x \<longleftrightarrow> x = a\<^sub>1"
by(cases x) simp_all

lemma neq_finite_mod_2_a\<^sub>2_iff [simp]: "x \<noteq> a\<^sub>1 \<longleftrightarrow> x = a\<^sub>0"
by(cases x) simp_all

lemma neq_finite_mod_2_a\<^sub>2_iff' [simp]: "a\<^sub>1 \<noteq> x \<longleftrightarrow> x = a\<^sub>0"
by(cases x) simp_all

instance
  apply (intro_classes)
  apply (auto simp add: less_eq_finite_mod_2_def less_finite_mod_2_def
      inf_finite_mod_2_def sup_finite_mod_2_def Inf_finite_mod_2_def Sup_finite_mod_2_def finite_mod_2.exhaust)+
  by (metis finite_mod_2.exhaust)+
end

instance finite_mod_2 :: complete_linorder ..

instance finite_mod_2 :: complete_distrib_lattice ..

instantiation finite_mod_2 :: "{field, idom_abs_sgn, idom_modulo}" begin
definition [simp]: "0 = a\<^sub>0"
definition [simp]: "1 = a\<^sub>1"
definition "x + y = (case (x, y) of (a\<^sub>0, a\<^sub>0) \<Rightarrow> a\<^sub>0 | (a\<^sub>1, a\<^sub>1) \<Rightarrow> a\<^sub>0 | _ \<Rightarrow> a\<^sub>1)"
definition "uminus = (\<lambda>x :: finite_mod_2. x)"
definition "(-) = ((+) :: finite_mod_2 \<Rightarrow> _)"
definition "x * y = (case (x, y) of (a\<^sub>1, a\<^sub>1) \<Rightarrow> a\<^sub>1 | _ \<Rightarrow> a\<^sub>0)"
definition "inverse = (\<lambda>x :: finite_mod_2. x)"
definition "divide = ((*) :: finite_mod_2 \<Rightarrow> _)"
definition "x mod y = (case (x, y) of (a\<^sub>1, a\<^sub>0) \<Rightarrow> a\<^sub>1 | _ \<Rightarrow> a\<^sub>0)"
definition "abs = (\<lambda>x :: finite_mod_2. x)"
definition "sgn = (\<lambda>x :: finite_mod_2. x)"
instance
  by standard
    (subproofs
      \<open>simp_all add: plus_finite_mod_2_def uminus_finite_mod_2_def minus_finite_mod_2_def
        times_finite_mod_2_def
        inverse_finite_mod_2_def divide_finite_mod_2_def modulo_finite_mod_2_def
        abs_finite_mod_2_def sgn_finite_mod_2_def
        split: finite_mod_2.splits\<close>)
end

hide_const (open) a\<^sub>0 a\<^sub>1

datatype (plugins only: code "quickcheck" extraction) finite_mod_3 =
  a\<^sub>0 | a\<^sub>1 | a\<^sub>2

notation (output) a\<^sub>0  ("a\<^sub>0")
notation (output) a\<^sub>1  ("a\<^sub>1")
notation (output) a\<^sub>2  ("a\<^sub>2")

lemma UNIV_finite_mod_3:
  "UNIV = {a\<^sub>0, a\<^sub>1, a\<^sub>2}"
  by (auto intro: finite_mod_3.exhaust)

instantiation finite_mod_3 :: enum
begin

definition
  "enum_finite_mod_3 = [a\<^sub>0, a\<^sub>1, a\<^sub>2]"

definition
  "enum_all_finite_mod_3 P \<longleftrightarrow> P a\<^sub>0 \<and> P a\<^sub>1 \<and> P a\<^sub>2"

definition
  "enum_ex_finite_mod_3 P \<longleftrightarrow> P a\<^sub>0 \<or> P a\<^sub>1 \<or> P a\<^sub>2"

instance proof
qed (simp_all only: enum_finite_mod_3_def enum_all_finite_mod_3_def enum_ex_finite_mod_3_def UNIV_finite_mod_3, simp_all)

end

lemma finite_mod_3_not_eq_unfold:
  "x \<noteq> a\<^sub>0 \<longleftrightarrow> x \<in> {a\<^sub>1, a\<^sub>2}"
  "x \<noteq> a\<^sub>1 \<longleftrightarrow> x \<in> {a\<^sub>0, a\<^sub>2}"
  "x \<noteq> a\<^sub>2 \<longleftrightarrow> x \<in> {a\<^sub>0, a\<^sub>1}"
  by (cases x; simp)+

instantiation finite_mod_3 :: linorder
begin

definition less_finite_mod_3 :: "finite_mod_3 \<Rightarrow> finite_mod_3 \<Rightarrow> bool"
where
  "x < y = (case x of a\<^sub>0 \<Rightarrow> y \<noteq> a\<^sub>0 | a\<^sub>1 \<Rightarrow> y = a\<^sub>2 | a\<^sub>2 \<Rightarrow> False)"

definition less_eq_finite_mod_3 :: "finite_mod_3 \<Rightarrow> finite_mod_3 \<Rightarrow> bool"
where
  "x \<le> y \<longleftrightarrow> x = y \<or> x < (y :: finite_mod_3)"

instance proof (intro_classes)
qed (auto simp add: less_finite_mod_3_def less_eq_finite_mod_3_def split: finite_mod_3.split_asm)

end

instance finite_mod_3 :: wellorder
proof(rule wf_wellorderI)
  have "inv_image less_than (case_finite_mod_3 0 1 2) = {(x, y). x < y}"
    by(auto simp add: less_finite_mod_3_def split: finite_mod_3.splits)
  from this[symmetric] show "wf \<dots>" by simp
qed intro_classes

instantiation finite_mod_3 :: "{field, idom_abs_sgn, idom_modulo}" begin
definition [simp]: "0 = a\<^sub>0"
definition [simp]: "1 = a\<^sub>1"
definition
  "x + y = (case (x, y) of
     (a\<^sub>0, a\<^sub>0) \<Rightarrow> a\<^sub>0 | (a\<^sub>1, a\<^sub>2) \<Rightarrow> a\<^sub>0 | (a\<^sub>2, a\<^sub>1) \<Rightarrow> a\<^sub>0
   | (a\<^sub>0, a\<^sub>1) \<Rightarrow> a\<^sub>1 | (a\<^sub>1, a\<^sub>0) \<Rightarrow> a\<^sub>1 | (a\<^sub>2, a\<^sub>2) \<Rightarrow> a\<^sub>1
   | _ \<Rightarrow> a\<^sub>2)"
definition "- x = (case x of a\<^sub>0 \<Rightarrow> a\<^sub>0 | a\<^sub>1 \<Rightarrow> a\<^sub>2 | a\<^sub>2 \<Rightarrow> a\<^sub>1)"
definition "x - y = x + (- y :: finite_mod_3)"
definition "x * y = (case (x, y) of (a\<^sub>1, a\<^sub>1) \<Rightarrow> a\<^sub>1 | (a\<^sub>2, a\<^sub>2) \<Rightarrow> a\<^sub>1 | (a\<^sub>1, a\<^sub>2) \<Rightarrow> a\<^sub>2 | (a\<^sub>2, a\<^sub>1) \<Rightarrow> a\<^sub>2 | _ \<Rightarrow> a\<^sub>0)"
definition "inverse = (\<lambda>x :: finite_mod_3. x)"
definition "x div y = x * inverse (y :: finite_mod_3)"
definition "x mod y = (case y of a\<^sub>0 \<Rightarrow> x | _ \<Rightarrow> a\<^sub>0)"
definition "abs = (\<lambda>x. case x of a\<^sub>2 \<Rightarrow> a\<^sub>1 | _ \<Rightarrow> x)"
definition "sgn = (\<lambda>x :: finite_mod_3. x)"
instance
  by standard
    (subproofs
      \<open>simp_all add: plus_finite_mod_3_def uminus_finite_mod_3_def minus_finite_mod_3_def
        times_finite_mod_3_def
        inverse_finite_mod_3_def divide_finite_mod_3_def modulo_finite_mod_3_def
        abs_finite_mod_3_def sgn_finite_mod_3_def
        less_finite_mod_3_def
        split: finite_mod_3.splits\<close>)
end

hide_const (open) a\<^sub>0 a\<^sub>1 a\<^sub>2

datatype (plugins only: code "quickcheck" extraction) finite_mod_4 =
  a\<^sub>0 | a\<^sub>1 | a\<^sub>2 | a\<^sub>3

notation (output) a\<^sub>0  ("a\<^sub>0")
notation (output) a\<^sub>1  ("a\<^sub>1")
notation (output) a\<^sub>2  ("a\<^sub>2")
notation (output) a\<^sub>3  ("a\<^sub>3")

lemma UNIV_finite_mod_4:
  "UNIV = {a\<^sub>0, a\<^sub>1, a\<^sub>2, a\<^sub>3}"
  by (auto intro: finite_mod_4.exhaust)

instantiation finite_mod_4 :: enum
begin

definition
  "enum_finite_mod_4 = [a\<^sub>0, a\<^sub>1, a\<^sub>2, a\<^sub>3]"

definition
  "enum_all_finite_mod_4 P \<longleftrightarrow> P a\<^sub>0 \<and> P a\<^sub>1 \<and> P a\<^sub>2 \<and> P a\<^sub>3"

definition
  "enum_ex_finite_mod_4 P \<longleftrightarrow> P a\<^sub>0 \<or> P a\<^sub>1 \<or> P a\<^sub>2 \<or> P a\<^sub>3"

instance proof
qed (simp_all only: enum_finite_mod_4_def enum_all_finite_mod_4_def enum_ex_finite_mod_4_def UNIV_finite_mod_4, simp_all)

end

instantiation finite_mod_4 :: linorder
begin

definition
  "x < y \<longleftrightarrow> (case (x, y) of
     (a\<^sub>0, a\<^sub>0) \<Rightarrow> False | (a\<^sub>0, _) \<Rightarrow> True
   |  (a\<^sub>1, a\<^sub>2) \<Rightarrow> True |  (a\<^sub>1, a\<^sub>3) \<Rightarrow> True
   |  (a\<^sub>2, a\<^sub>3) \<Rightarrow> True  | _ \<Rightarrow> False)"

definition
  "x \<le> y \<longleftrightarrow> (case (x, y) of
     (a\<^sub>0, _) \<Rightarrow> True
   | (a\<^sub>1, a\<^sub>1) \<Rightarrow> True | (a\<^sub>1, a\<^sub>2) \<Rightarrow> True | (a\<^sub>1, a\<^sub>3) \<Rightarrow> True
   | (a\<^sub>2, a\<^sub>2) \<Rightarrow> True | (a\<^sub>2, a\<^sub>3) \<Rightarrow> True
   | (a\<^sub>3, a\<^sub>3) \<Rightarrow> True | _ \<Rightarrow> False)"

instance proof (intro_classes)
  fix x::finite_mod_4
  show refl: "x \<le> x" unfolding less_eq_finite_mod_4_def
    by (metis (no_types, lifting) case_prodI finite_mod_4.case(1) finite_mod_4.exhaust finite_mod_4.simps(14) finite_mod_4.simps(15) finite_mod_4.simps(16))
  fix y::finite_mod_4
  show "x \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> x = y"
    unfolding less_eq_finite_mod_4_def
    by (smt (z3) case_prodD finite_mod_4.case(1) finite_mod_4.exhaust finite_mod_4.simps(14) finite_mod_4.simps(15) finite_mod_4.simps(16))
  show "x \<le> y \<or> y \<le> x"
    unfolding less_eq_finite_mod_4_def
    apply (cases "x", cases "y")
    apply simp_all
      by (metis finite_mod_4.exhaust finite_mod_4.simps(13) finite_mod_4.simps(14) finite_mod_4.simps(15) finite_mod_4.simps(16))+
  fix z::finite_mod_4
  show "x \<le> y \<Longrightarrow> y \<le> z \<Longrightarrow> x \<le> z"
    unfolding less_eq_finite_mod_4_def
    apply (cases "x", cases "y", cases "z")
    apply simp_all
    by (metis finite_mod_4.exhaust finite_mod_4.simps(13) finite_mod_4.simps(14) finite_mod_4.simps(15) finite_mod_4.simps(16))+
  show "(x < y) = (x \<le> y \<and> \<not> y \<le> x)"
    unfolding less_eq_finite_mod_4_def less_finite_mod_4_def
    apply (cases "x", cases "y") apply simp_all
    by (metis (full_types) finite_mod_4.exhaust finite_mod_4.simps(13) finite_mod_4.simps(14) finite_mod_4.simps(15) finite_mod_4.simps(16))+
qed

end

hide_const (open) a\<^sub>0 a\<^sub>1 a\<^sub>2 a\<^sub>3

datatype (plugins only: code "quickcheck" extraction) finite_mod_5 =
  a\<^sub>0 | a\<^sub>1 | a\<^sub>2 | a\<^sub>3 | a\<^sub>4

notation (output) a\<^sub>0  ("a\<^sub>0")
notation (output) a\<^sub>1  ("a\<^sub>1")
notation (output) a\<^sub>2  ("a\<^sub>2")
notation (output) a\<^sub>3  ("a\<^sub>3")
notation (output) a\<^sub>4  ("a\<^sub>4")

lemma UNIV_finite_mod_5:
  "UNIV = {a\<^sub>0, a\<^sub>1, a\<^sub>2, a\<^sub>3, a\<^sub>4}"
  by (auto intro: finite_mod_5.exhaust)

instantiation finite_mod_5 :: enum
begin

definition
  "enum_finite_mod_5 = [a\<^sub>0, a\<^sub>1, a\<^sub>2, a\<^sub>3, a\<^sub>4]"

definition
  "enum_all_finite_mod_5 P \<longleftrightarrow> P a\<^sub>0 \<and> P a\<^sub>1 \<and> P a\<^sub>2 \<and> P a\<^sub>3 \<and> P a\<^sub>4"

definition
  "enum_ex_finite_mod_5 P \<longleftrightarrow> P a\<^sub>0 \<or> P a\<^sub>1 \<or> P a\<^sub>2 \<or> P a\<^sub>3 \<or> P a\<^sub>4"

instance proof
qed (simp_all only: enum_finite_mod_5_def enum_all_finite_mod_5_def enum_ex_finite_mod_5_def UNIV_finite_mod_5, simp_all)

end

instantiation finite_mod_5 :: linorder
begin

definition
  "x < y \<longleftrightarrow> (case (x, y) of
      (a\<^sub>0, a\<^sub>1) \<Rightarrow> True | (a\<^sub>0, a\<^sub>2) \<Rightarrow> True | (a\<^sub>0, a\<^sub>3) \<Rightarrow> True | (a\<^sub>0, a\<^sub>4) \<Rightarrow> True
   |  (a\<^sub>1, a\<^sub>2) \<Rightarrow> True | (a\<^sub>1, a\<^sub>3) \<Rightarrow> True | (a\<^sub>1, a\<^sub>4) \<Rightarrow> True
   |  (a\<^sub>2, a\<^sub>3) \<Rightarrow> True | (a\<^sub>2, a\<^sub>4) \<Rightarrow> True
   |  (a\<^sub>3, a\<^sub>4) \<Rightarrow> True
   | _ \<Rightarrow> False)"

definition
  "x \<le> y \<longleftrightarrow> (case (x, y) of
     (a\<^sub>0, _) \<Rightarrow> True
   | (a\<^sub>1, a\<^sub>1) \<Rightarrow> True | (a\<^sub>1, a\<^sub>2) \<Rightarrow> True | (a\<^sub>1, a\<^sub>3) \<Rightarrow> True | (a\<^sub>1, a\<^sub>4) \<Rightarrow> True
   | (a\<^sub>2, a\<^sub>2) \<Rightarrow> True | (a\<^sub>2, a\<^sub>3) \<Rightarrow> True | (a\<^sub>2, a\<^sub>4) \<Rightarrow> True
   | (a\<^sub>3, a\<^sub>3) \<Rightarrow> True | (a\<^sub>3, a\<^sub>4) \<Rightarrow> True
   | (a\<^sub>4, a\<^sub>4) \<Rightarrow> True
   | _ \<Rightarrow> False)"

instance proof (intro_classes)
  fix x::finite_mod_5
  show refl: "x \<le> x" unfolding less_eq_finite_mod_5_def
    by (smt (z3) curry_case_prod curry_conv finite_mod_5.case(1) finite_mod_5.case(2) finite_mod_5.case(3) finite_mod_5.case(4) finite_mod_5.case(5) finite_mod_5.exhaust)
  fix y::finite_mod_5
  show "x \<le> y \<Longrightarrow> y \<le> x \<Longrightarrow> x = y"
    unfolding less_eq_finite_mod_4_def
    by (smt (z3) curry_case_prod curry_conv finite_mod_5.case(1) finite_mod_5.case(2) finite_mod_5.case(3) finite_mod_5.case(4) finite_mod_5.case(5) finite_mod_5.exhaust less_eq_finite_mod_5_def)
  show "x \<le> y \<or> y \<le> x"
    unfolding less_eq_finite_mod_5_def
    apply (cases "x", cases "y")
    apply simp_all
    by (metis finite_mod_5.exhaust finite_mod_5.simps(21) finite_mod_5.simps(22) finite_mod_5.simps(23) finite_mod_5.simps(24) finite_mod_5.simps(25))+
  fix z::finite_mod_5
  show "x \<le> y \<Longrightarrow> y \<le> z \<Longrightarrow> x \<le> z"
    unfolding less_eq_finite_mod_5_def
    apply (cases "x", cases "y", cases "z")
    apply simp_all
    by (metis finite_mod_5.exhaust finite_mod_5.simps(21) finite_mod_5.simps(22) finite_mod_5.simps(23) finite_mod_5.simps(24) finite_mod_5.simps(25))+
  show "(x < y) = (x \<le> y \<and> \<not> y \<le> x)"
    unfolding less_eq_finite_mod_5_def less_finite_mod_5_def
    apply (cases "x", cases "y") apply simp_all
    by (smt (z3) finite_mod_5.exhaust finite_mod_5.simps(21) finite_mod_5.simps(22) finite_mod_5.simps(23) finite_mod_5.simps(24) finite_mod_5.simps(25))+
  qed

end

hide_const (open) a\<^sub>0 a\<^sub>1 a\<^sub>2 a\<^sub>3 a\<^sub>4

end


(*  Title:      HOL/Nitpick_Examples/Refute_Nits.thy
    Author:     Jasmin Blanchette, TU Muenchen
    Copyright   2009-2011

Refute examples adapted to Nitpick.
*)

section {* Refute Examples Adapted to Nitpick *}

theory Refute_Nits
imports Main
begin

nitpick_params [verbose, card = 1-6, max_potential = 0,
                sat_solver = MiniSat_JNI, max_threads = 1, timeout = 240]

lemma "P \<and> Q"
apply (rule conjI)
nitpick [expect = genuine] 1
nitpick [expect = genuine] 2
nitpick [expect = genuine]
nitpick [card = 5, expect = genuine]
nitpick [sat_solver = SAT4J, expect = genuine] 2
oops

subsection {* Examples and Test Cases *}

subsubsection {* Propositional logic *}

lemma "True"
nitpick [expect = none]
apply auto
done

lemma "False"
nitpick [expect = genuine]
oops

lemma "P"
nitpick [expect = genuine]
oops

lemma "\<not> P"
nitpick [expect = genuine]
oops

lemma "P \<and> Q"
nitpick [expect = genuine]
oops

lemma "P \<or> Q"
nitpick [expect = genuine]
oops

lemma "P \<longrightarrow> Q"
nitpick [expect = genuine]
oops

lemma "(P\<Colon>bool) = Q"
nitpick [expect = genuine]
oops

lemma "(P \<or> Q) \<longrightarrow> (P \<and> Q)"
nitpick [expect = genuine]
oops

subsubsection {* Predicate logic *}

lemma "P x y z"
nitpick [expect = genuine]
oops

lemma "P x y \<longrightarrow> P y x"
nitpick [expect = genuine]
oops

lemma "P (f (f x)) \<longrightarrow> P x \<longrightarrow> P (f x)"
nitpick [expect = genuine]
oops

subsubsection {* Equality *}

lemma "P = True"
nitpick [expect = genuine]
oops

lemma "P = False"
nitpick [expect = genuine]
oops

lemma "x = y"
nitpick [expect = genuine]
oops

lemma "f x = g x"
nitpick [expect = genuine]
oops

lemma "(f\<Colon>'a\<Rightarrow>'b) = g"
nitpick [expect = genuine]
oops

lemma "(f\<Colon>('d\<Rightarrow>'d)\<Rightarrow>('c\<Rightarrow>'d)) = g"
nitpick [expect = genuine]
oops

lemma "distinct [a, b]"
nitpick [expect = genuine]
apply simp
nitpick [expect = genuine]
oops

subsubsection {* First-Order Logic *}

lemma "\<exists>x. P x"
nitpick [expect = genuine]
oops

lemma "\<forall>x. P x"
nitpick [expect = genuine]
oops

lemma "\<exists>!x. P x"
nitpick [expect = genuine]
oops

lemma "Ex P"
nitpick [expect = genuine]
oops

lemma "All P"
nitpick [expect = genuine]
oops

lemma "Ex1 P"
nitpick [expect = genuine]
oops

lemma "(\<exists>x. P x) \<longrightarrow> (\<forall>x. P x)"
nitpick [expect = genuine]
oops

lemma "(\<forall>x. \<exists>y. P x y) \<longrightarrow> (\<exists>y. \<forall>x. P x y)"
nitpick [expect = genuine]
oops

lemma "(\<exists>x. P x) \<longrightarrow> (\<exists>!x. P x)"
nitpick [expect = genuine]
oops

text {* A true statement (also testing names of free and bound variables being identical) *}

lemma "(\<forall>x y. P x y \<longrightarrow> P y x) \<longrightarrow> (\<forall>x. P x y) \<longrightarrow> P y x"
nitpick [expect = none]
apply fast
done

text {* "A type has at most 4 elements." *}

lemma "\<not> distinct [a, b, c, d, e]"
nitpick [expect = genuine]
apply simp
nitpick [expect = genuine]
oops

lemma "distinct [a, b, c, d]"
nitpick [expect = genuine]
apply simp
nitpick [expect = genuine]
oops

text {* "Every reflexive and symmetric relation is transitive." *}

lemma "\<lbrakk>\<forall>x. P x x; \<forall>x y. P x y \<longrightarrow> P y x\<rbrakk> \<Longrightarrow> P x y \<longrightarrow> P y z \<longrightarrow> P x z"
nitpick [expect = genuine]
oops

text {* The ``Drinker's theorem'' *}

lemma "\<exists>x. f x = g x \<longrightarrow> f = g"
nitpick [expect = none]
apply (auto simp add: ext)
done

text {* And an incorrect version of it *}

lemma "(\<exists>x. f x = g x) \<longrightarrow> f = g"
nitpick [expect = genuine]
oops

text {* "Every function has a fixed point." *}

lemma "\<exists>x. f x = x"
nitpick [expect = genuine]
oops

text {* "Function composition is commutative." *}

lemma "f (g x) = g (f x)"
nitpick [expect = genuine]
oops

text {* "Two functions that are equivalent wrt.\ the same predicate 'P' are equal." *}

lemma "((P\<Colon>('a\<Rightarrow>'b)\<Rightarrow>bool) f = P g) \<longrightarrow> (f x = g x)"
nitpick [expect = genuine]
oops

subsubsection {* Higher-Order Logic *}

lemma "\<exists>P. P"
nitpick [expect = none]
apply auto
done

lemma "\<forall>P. P"
nitpick [expect = genuine]
oops

lemma "\<exists>!P. P"
nitpick [expect = none]
apply auto
done

lemma "\<exists>!P. P x"
nitpick [expect = genuine]
oops

lemma "P Q \<or> Q x"
nitpick [expect = genuine]
oops

lemma "x \<noteq> All"
nitpick [expect = genuine]
oops

lemma "x \<noteq> Ex"
nitpick [expect = genuine]
oops

lemma "x \<noteq> Ex1"
nitpick [expect = genuine]
oops

text {* ``The transitive closure of an arbitrary relation is non-empty.'' *}

definition "trans" :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool" where
"trans P \<equiv> (ALL x y z. P x y \<longrightarrow> P y z \<longrightarrow> P x z)"

definition
"subset" :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool" where
"subset P Q \<equiv> (ALL x y. P x y \<longrightarrow> Q x y)"

definition
"trans_closure" :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> bool" where
"trans_closure P Q \<equiv> (subset Q P) \<and> (trans P) \<and> (ALL R. subset Q R \<longrightarrow> trans R \<longrightarrow> subset P R)"

lemma "trans_closure T P \<longrightarrow> (\<exists>x y. T x y)"
nitpick [expect = genuine]
oops

text {* ``The union of transitive closures is equal to the transitive closure of unions.'' *}

lemma "(\<forall>x y. (P x y \<or> R x y) \<longrightarrow> T x y) \<longrightarrow> trans T \<longrightarrow> (\<forall>Q. (\<forall>x y. (P x y \<or> R x y) \<longrightarrow> Q x y) \<longrightarrow> trans Q \<longrightarrow> subset T Q)
 \<longrightarrow> trans_closure TP P
 \<longrightarrow> trans_closure TR R
 \<longrightarrow> (T x y = (TP x y \<or> TR x y))"
nitpick [expect = genuine]
oops

text {* ``Every surjective function is invertible.'' *}

lemma "(\<forall>y. \<exists>x. y = f x) \<longrightarrow> (\<exists>g. \<forall>x. g (f x) = x)"
nitpick [expect = genuine]
oops

text {* ``Every invertible function is surjective.'' *}

lemma "(\<exists>g. \<forall>x. g (f x) = x) \<longrightarrow> (\<forall>y. \<exists>x. y = f x)"
nitpick [expect = genuine]
oops

text {* ``Every point is a fixed point of some function.'' *}

lemma "\<exists>f. f x = x"
nitpick [card = 1-7, expect = none]
apply (rule_tac x = "\<lambda>x. x" in exI)
apply simp
done

text {* Axiom of Choice: first an incorrect version *}

lemma "(\<forall>x. \<exists>y. P x y) \<longrightarrow> (\<exists>!f. \<forall>x. P x (f x))"
nitpick [expect = genuine]
oops

text {* And now two correct ones *}

lemma "(\<forall>x. \<exists>y. P x y) \<longrightarrow> (\<exists>f. \<forall>x. P x (f x))"
nitpick [card = 1-4, expect = none]
apply (simp add: choice)
done

lemma "(\<forall>x. \<exists>!y. P x y) \<longrightarrow> (\<exists>!f. \<forall>x. P x (f x))"
nitpick [card = 1-3, expect = none]
apply auto
 apply (simp add: ex1_implies_ex choice)
apply (fast intro: ext)
done

subsubsection {* Metalogic *}

lemma "\<And>x. P x"
nitpick [expect = genuine]
oops

lemma "f x \<equiv> g x"
nitpick [expect = genuine]
oops

lemma "P \<Longrightarrow> Q"
nitpick [expect = genuine]
oops

lemma "\<lbrakk>P; Q; R\<rbrakk> \<Longrightarrow> S"
nitpick [expect = genuine]
oops

lemma "(x \<equiv> Pure.all) \<Longrightarrow> False"
nitpick [expect = genuine]
oops

lemma "(x \<equiv> (op \<equiv>)) \<Longrightarrow> False"
nitpick [expect = genuine]
oops

lemma "(x \<equiv> (op \<Longrightarrow>)) \<Longrightarrow> False"
nitpick [expect = genuine]
oops

subsubsection {* Schematic Variables *}

schematic_lemma "?P"
nitpick [expect = none]
apply auto
done

schematic_lemma "x = ?y"
nitpick [expect = none]
apply auto
done

subsubsection {* Abstractions *}

lemma "(\<lambda>x. x) = (\<lambda>x. y)"
nitpick [expect = genuine]
oops

lemma "(\<lambda>f. f x) = (\<lambda>f. True)"
nitpick [expect = genuine]
oops

lemma "(\<lambda>x. x) = (\<lambda>y. y)"
nitpick [expect = none]
apply simp
done

subsubsection {* Sets *}

lemma "P (A\<Colon>'a set)"
nitpick [expect = genuine]
oops

lemma "P (A\<Colon>'a set set)"
nitpick [expect = genuine]
oops

lemma "{x. P x} = {y. P y}"
nitpick [expect = none]
apply simp
done

lemma "x \<in> {x. P x}"
nitpick [expect = genuine]
oops

lemma "P (op \<in>)"
nitpick [expect = genuine]
oops

lemma "P (op \<in> x)"
nitpick [expect = genuine]
oops

lemma "P Collect"
nitpick [expect = genuine]
oops

lemma "A Un B = A Int B"
nitpick [expect = genuine]
oops

lemma "(A Int B) Un C = (A Un C) Int B"
nitpick [expect = genuine]
oops

lemma "Ball A P \<longrightarrow> Bex A P"
nitpick [expect = genuine]
oops

subsubsection {* @{const undefined} *}

lemma "undefined"
nitpick [expect = genuine]
oops

lemma "P undefined"
nitpick [expect = genuine]
oops

lemma "undefined x"
nitpick [expect = genuine]
oops

lemma "undefined undefined"
nitpick [expect = genuine]
oops

subsubsection {* @{const The} *}

lemma "The P"
nitpick [expect = genuine]
oops

lemma "P The"
nitpick [expect = genuine]
oops

lemma "P (The P)"
nitpick [expect = genuine]
oops

lemma "(THE x. x=y) = z"
nitpick [expect = genuine]
oops

lemma "Ex P \<longrightarrow> P (The P)"
nitpick [expect = genuine]
oops

subsubsection {* @{const Eps} *}

lemma "Eps P"
nitpick [expect = genuine]
oops

lemma "P Eps"
nitpick [expect = genuine]
oops

lemma "P (Eps P)"
nitpick [expect = genuine]
oops

lemma "(SOME x. x=y) = z"
nitpick [expect = genuine]
oops

lemma "Ex P \<longrightarrow> P (Eps P)"
nitpick [expect = none]
apply (auto simp add: someI)
done

subsubsection {* Operations on Natural Numbers *}

lemma "(x\<Colon>nat) + y = 0"
nitpick [expect = genuine]
oops

lemma "(x\<Colon>nat) = x + x"
nitpick [expect = genuine]
oops

lemma "(x\<Colon>nat) - y + y = x"
nitpick [expect = genuine]
oops

lemma "(x\<Colon>nat) = x * x"
nitpick [expect = genuine]
oops

lemma "(x\<Colon>nat) < x + y"
nitpick [card = 1, expect = genuine]
oops

text {* \<times> *}

lemma "P (x\<Colon>'a\<times>'b)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>'a\<times>'b. P x"
nitpick [expect = genuine]
oops

lemma "P (x, y)"
nitpick [expect = genuine]
oops

lemma "P (fst x)"
nitpick [expect = genuine]
oops

lemma "P (snd x)"
nitpick [expect = genuine]
oops

lemma "P Pair"
nitpick [expect = genuine]
oops

lemma "P (case x of Pair a b \<Rightarrow> f a b)"
nitpick [expect = genuine]
oops

subsubsection {* Subtypes (typedef), typedecl *}

text {* A completely unspecified non-empty subset of @{typ "'a"}: *}

definition "myTdef = insert (undefined::'a) (undefined::'a set)"

typedef 'a myTdef = "myTdef :: 'a set"
unfolding myTdef_def by auto

lemma "(x\<Colon>'a myTdef) = y"
nitpick [expect = genuine]
oops

typedecl myTdecl

definition "T_bij = {(f::'a\<Rightarrow>'a). \<forall>y. \<exists>!x. f x = y}"

typedef 'a T_bij = "T_bij :: ('a \<Rightarrow> 'a) set"
unfolding T_bij_def by auto

lemma "P (f\<Colon>(myTdecl myTdef) T_bij)"
nitpick [expect = genuine]
oops

subsubsection {* Inductive Datatypes *}

text {* unit *}

lemma "P (x\<Colon>unit)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>unit. P x"
nitpick [expect = genuine]
oops

lemma "P ()"
nitpick [expect = genuine]
oops

lemma "P (case x of () \<Rightarrow> u)"
nitpick [expect = genuine]
oops

text {* option *}

lemma "P (x\<Colon>'a option)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>'a option. P x"
nitpick [expect = genuine]
oops

lemma "P None"
nitpick [expect = genuine]
oops

lemma "P (Some x)"
nitpick [expect = genuine]
oops

lemma "P (case x of None \<Rightarrow> n | Some u \<Rightarrow> s u)"
nitpick [expect = genuine]
oops

text {* + *}

lemma "P (x\<Colon>'a+'b)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>'a+'b. P x"
nitpick [expect = genuine]
oops

lemma "P (Inl x)"
nitpick [expect = genuine]
oops

lemma "P (Inr x)"
nitpick [expect = genuine]
oops

lemma "P Inl"
nitpick [expect = genuine]
oops

lemma "P (case x of Inl a \<Rightarrow> l a | Inr b \<Rightarrow> r b)"
nitpick [expect = genuine]
oops

text {* Non-recursive datatypes *}

datatype T1 = A | B

lemma "P (x\<Colon>T1)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>T1. P x"
nitpick [expect = genuine]
oops

lemma "P A"
nitpick [expect = genuine]
oops

lemma "P B"
nitpick [expect = genuine]
oops

lemma "rec_T1 a b A = a"
nitpick [expect = none]
apply simp
done

lemma "rec_T1 a b B = b"
nitpick [expect = none]
apply simp
done

lemma "P (rec_T1 a b x)"
nitpick [expect = genuine]
oops

lemma "P (case x of A \<Rightarrow> a | B \<Rightarrow> b)"
nitpick [expect = genuine]
oops

datatype 'a T2 = C T1 | D 'a

lemma "P (x\<Colon>'a T2)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>'a T2. P x"
nitpick [expect = genuine]
oops

lemma "P D"
nitpick [expect = genuine]
oops

lemma "rec_T2 c d (C x) = c x"
nitpick [expect = none]
apply simp
done

lemma "rec_T2 c d (D x) = d x"
nitpick [expect = none]
apply simp
done

lemma "P (rec_T2 c d x)"
nitpick [expect = genuine]
oops

lemma "P (case x of C u \<Rightarrow> c u | D v \<Rightarrow> d v)"
nitpick [expect = genuine]
oops

datatype ('a, 'b) T3 = E "'a \<Rightarrow> 'b"

lemma "P (x\<Colon>('a, 'b) T3)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>('a, 'b) T3. P x"
nitpick [expect = genuine]
oops

lemma "P E"
nitpick [expect = genuine]
oops

lemma "rec_T3 e (E x) = e x"
nitpick [card = 1-4, expect = none]
apply simp
done

lemma "P (rec_T3 e x)"
nitpick [expect = genuine]
oops

lemma "P (case x of E f \<Rightarrow> e f)"
nitpick [expect = genuine]
oops

text {* Recursive datatypes *}

text {* nat *}

lemma "P (x\<Colon>nat)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>nat. P x"
nitpick [expect = genuine]
oops

lemma "P (Suc 0)"
nitpick [expect = genuine]
oops

lemma "P Suc"
nitpick [card = 1-7, expect = none]
oops

lemma "rec_nat zero suc 0 = zero"
nitpick [expect = none]
apply simp
done

lemma "rec_nat zero suc (Suc x) = suc x (rec_nat zero suc x)"
nitpick [expect = none]
apply simp
done

lemma "P (rec_nat zero suc x)"
nitpick [expect = genuine]
oops

lemma "P (case x of 0 \<Rightarrow> zero | Suc n \<Rightarrow> suc n)"
nitpick [expect = genuine]
oops

text {* 'a list *}

lemma "P (xs\<Colon>'a list)"
nitpick [expect = genuine]
oops

lemma "\<forall>xs\<Colon>'a list. P xs"
nitpick [expect = genuine]
oops

lemma "P [x, y]"
nitpick [expect = genuine]
oops

lemma "rec_list nil cons [] = nil"
nitpick [card = 1-5, expect = none]
apply simp
done

lemma "rec_list nil cons (x#xs) = cons x xs (rec_list nil cons xs)"
nitpick [card = 1-5, expect = none]
apply simp
done

lemma "P (rec_list nil cons xs)"
nitpick [expect = genuine]
oops

lemma "P (case x of Nil \<Rightarrow> nil | Cons a b \<Rightarrow> cons a b)"
nitpick [expect = genuine]
oops

lemma "(xs\<Colon>'a list) = ys"
nitpick [expect = genuine]
oops

lemma "a # xs = b # xs"
nitpick [expect = genuine]
oops

datatype BitList = BitListNil | Bit0 BitList | Bit1 BitList

lemma "P (x\<Colon>BitList)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>BitList. P x"
nitpick [expect = genuine]
oops

lemma "P (Bit0 (Bit1 BitListNil))"
nitpick [expect = genuine]
oops

lemma "rec_BitList nil bit0 bit1 BitListNil = nil"
nitpick [expect = none]
apply simp
done

lemma "rec_BitList nil bit0 bit1 (Bit0 xs) = bit0 xs (rec_BitList nil bit0 bit1 xs)"
nitpick [expect = none]
apply simp
done

lemma "rec_BitList nil bit0 bit1 (Bit1 xs) = bit1 xs (rec_BitList nil bit0 bit1 xs)"
nitpick [expect = none]
apply simp
done

lemma "P (rec_BitList nil bit0 bit1 x)"
nitpick [expect = genuine]
oops

datatype 'a BinTree = Leaf 'a | Node "'a BinTree" "'a BinTree"

lemma "P (x\<Colon>'a BinTree)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>'a BinTree. P x"
nitpick [expect = genuine]
oops

lemma "P (Node (Leaf x) (Leaf y))"
nitpick [expect = genuine]
oops

lemma "rec_BinTree l n (Leaf x) = l x"
nitpick [expect = none]
apply simp
done

lemma "rec_BinTree l n (Node x y) = n x y (rec_BinTree l n x) (rec_BinTree l n y)"
nitpick [card = 1-5, expect = none]
apply simp
done

lemma "P (rec_BinTree l n x)"
nitpick [expect = genuine]
oops

lemma "P (case x of Leaf a \<Rightarrow> l a | Node a b \<Rightarrow> n a b)"
nitpick [expect = genuine]
oops

text {* Mutually recursive datatypes *}

datatype 'a aexp = Number 'a | ITE "'a bexp" "'a aexp" "'a aexp"
 and 'a bexp = Equal "'a aexp" "'a aexp"

lemma "P (x\<Colon>'a aexp)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>'a aexp. P x"
nitpick [expect = genuine]
oops

lemma "P (ITE (Equal (Number x) (Number y)) (Number x) (Number y))"
nitpick [expect = genuine]
oops

lemma "P (x\<Colon>'a bexp)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>'a bexp. P x"
nitpick [expect = genuine]
oops

lemma "rec_aexp number ite equal (Number x) = number x"
nitpick [card = 1-3, expect = none]
apply simp
done

lemma "rec_aexp number ite equal (ITE x y z) = ite x y z (rec_bexp number ite equal x) (rec_aexp number ite equal y) (rec_aexp number ite equal z)"
nitpick [card = 1-3, expect = none]
apply simp
done

lemma "P (rec_aexp number ite equal x)"
nitpick [expect = genuine]
oops

lemma "P (case x of Number a \<Rightarrow> number a | ITE b a1 a2 \<Rightarrow> ite b a1 a2)"
nitpick [expect = genuine]
oops

lemma "rec_bexp number ite equal (Equal x y) = equal x y (rec_aexp number ite equal x) (rec_aexp number ite equal y)"
nitpick [card = 1-3, expect = none]
apply simp
done

lemma "P (rec_bexp number ite equal x)"
nitpick [expect = genuine]
oops

lemma "P (case x of Equal a1 a2 \<Rightarrow> equal a1 a2)"
nitpick [expect = genuine]
oops

datatype X = A | B X | C Y and Y = D X | E Y | F

lemma "P (x\<Colon>X)"
nitpick [expect = genuine]
oops

lemma "P (y\<Colon>Y)"
nitpick [expect = genuine]
oops

lemma "P (B (B A))"
nitpick [expect = genuine]
oops

lemma "P (B (C F))"
nitpick [expect = genuine]
oops

lemma "P (C (D A))"
nitpick [expect = genuine]
oops

lemma "P (C (E F))"
nitpick [expect = genuine]
oops

lemma "P (D (B A))"
nitpick [expect = genuine]
oops

lemma "P (D (C F))"
nitpick [expect = genuine]
oops

lemma "P (E (D A))"
nitpick [expect = genuine]
oops

lemma "P (E (E F))"
nitpick [expect = genuine]
oops

lemma "P (C (D (C F)))"
nitpick [expect = genuine]
oops

lemma "rec_X a b c d e f A = a"
nitpick [card = 1-5, expect = none]
apply simp
done

lemma "rec_X a b c d e f (B x) = b x (rec_X a b c d e f x)"
nitpick [card = 1-5, expect = none]
apply simp
done

lemma "rec_X a b c d e f (C y) = c y (rec_Y a b c d e f y)"
nitpick [card = 1-5, expect = none]
apply simp
done

lemma "rec_Y a b c d e f (D x) = d x (rec_X a b c d e f x)"
nitpick [card = 1-5, expect = none]
apply simp
done

lemma "rec_Y a b c d e f (E y) = e y (rec_Y a b c d e f y)"
nitpick [card = 1-5, expect = none]
apply simp
done

lemma "rec_Y a b c d e f F = f"
nitpick [card = 1-5, expect = none]
apply simp
done

lemma "P (rec_X a b c d e f x)"
nitpick [expect = genuine]
oops

lemma "P (rec_Y a b c d e f y)"
nitpick [expect = genuine]
oops

text {* Other datatype examples *}

text {* Indirect recursion is implemented via mutual recursion. *}

datatype XOpt = CX "XOpt option" | DX "bool \<Rightarrow> XOpt option"

lemma "P (x\<Colon>XOpt)"
nitpick [expect = genuine]
oops

lemma "P (CX None)"
nitpick [expect = genuine]
oops

lemma "P (CX (Some (CX None)))"
nitpick [expect = genuine]
oops

lemma "P (rec_X cx dx n1 s1 n2 s2 x)"
nitpick [expect = genuine]
oops

datatype 'a YOpt = CY "('a \<Rightarrow> 'a YOpt) option"

lemma "P (x\<Colon>'a YOpt)"
nitpick [expect = genuine]
oops

lemma "P (CY None)"
nitpick [expect = genuine]
oops

lemma "P (CY (Some (\<lambda>a. CY None)))"
nitpick [expect = genuine]
oops

datatype Trie = TR "Trie list"

lemma "P (x\<Colon>Trie)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>Trie. P x"
nitpick [expect = genuine]
oops

lemma "P (TR [TR []])"
nitpick [expect = genuine]
oops

datatype InfTree = Leaf | Node "nat \<Rightarrow> InfTree"

lemma "P (x\<Colon>InfTree)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>InfTree. P x"
nitpick [expect = genuine]
oops

lemma "P (Node (\<lambda>n. Leaf))"
nitpick [expect = genuine]
oops

lemma "rec_InfTree leaf node Leaf = leaf"
nitpick [card = 1-3, expect = none]
apply simp
done

lemma "rec_InfTree leaf node (Node g) = node ((\<lambda>InfTree. (InfTree, rec_InfTree leaf node InfTree)) \<circ> g)"
nitpick [card = 1-3, expect = none]
apply simp
done

lemma "P (rec_InfTree leaf node x)"
nitpick [expect = genuine]
oops

datatype 'a lambda = Var 'a | App "'a lambda" "'a lambda" | Lam "'a \<Rightarrow> 'a lambda"

lemma "P (x\<Colon>'a lambda)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>'a lambda. P x"
nitpick [expect = genuine]
oops

lemma "P (Lam (\<lambda>a. Var a))"
nitpick [card = 1-5, expect = none]
nitpick [card 'a = 4, card "'a lambda" = 5, expect = genuine]
oops

lemma "rec_lambda var app lam (Var x) = var x"
nitpick [card = 1-3, expect = none]
apply simp
done

lemma "rec_lambda var app lam (App x y) = app x y (rec_lambda var app lam x) (rec_lambda var app lam y)"
nitpick [card = 1-3, expect = none]
apply simp
done

lemma "rec_lambda var app lam (Lam x) = lam ((\<lambda>lambda. (lambda, rec_lambda var app lam lambda)) \<circ> x)"
nitpick [card = 1-3, expect = none]
apply simp
done

lemma "P (rec_lambda v a l x)"
nitpick [expect = genuine]
oops

text {* Taken from "Inductive datatypes in HOL", p. 8: *}

datatype (dead 'a, 'b) T = C "'a \<Rightarrow> bool" | D "'b list"
datatype 'c U = E "('c, 'c U) T"

lemma "P (x\<Colon>'c U)"
nitpick [expect = genuine]
oops

lemma "\<forall>x\<Colon>'c U. P x"
nitpick [expect = genuine]
oops

lemma "P (E (C (\<lambda>a. True)))"
nitpick [expect = genuine]
oops

subsubsection {* Records *}

record ('a, 'b) point =
  xpos :: 'a
  ypos :: 'b

lemma "(x\<Colon>('a, 'b) point) = y"
nitpick [expect = genuine]
oops

record ('a, 'b, 'c) extpoint = "('a, 'b) point" +
  ext :: 'c

lemma "(x\<Colon>('a, 'b, 'c) extpoint) = y"
nitpick [expect = genuine]
oops

subsubsection {* Inductively Defined Sets *}

inductive_set undefinedSet :: "'a set" where
"undefined \<in> undefinedSet"

lemma "x \<in> undefinedSet"
nitpick [expect = genuine]
oops

inductive_set evenCard :: "'a set set"
where
"{} \<in> evenCard" |
"\<lbrakk>S \<in> evenCard; x \<notin> S; y \<notin> S; x \<noteq> y\<rbrakk> \<Longrightarrow> S \<union> {x, y} \<in> evenCard"

lemma "S \<in> evenCard"
nitpick [expect = genuine]
oops

inductive_set
even :: "nat set"
and odd :: "nat set"
where
"0 \<in> even" |
"n \<in> even \<Longrightarrow> Suc n \<in> odd" |
"n \<in> odd \<Longrightarrow> Suc n \<in> even"

lemma "n \<in> odd"
nitpick [expect = genuine]
oops

consts f :: "'a \<Rightarrow> 'a"

inductive_set a_even :: "'a set" and a_odd :: "'a set" where
"undefined \<in> a_even" |
"x \<in> a_even \<Longrightarrow> f x \<in> a_odd" |
"x \<in> a_odd \<Longrightarrow> f x \<in> a_even"

lemma "x \<in> a_odd"
nitpick [expect = genuine]
oops

subsubsection {* Examples Involving Special Functions *}

lemma "card x = 0"
nitpick [expect = genuine]
oops

lemma "finite x"
nitpick [expect = none]
oops

lemma "xs @ [] = ys @ []"
nitpick [expect = genuine]
oops

lemma "xs @ ys = ys @ xs"
nitpick [expect = genuine]
oops

lemma "f (lfp f) = lfp f"
nitpick [card = 2, expect = genuine]
oops

lemma "f (gfp f) = gfp f"
nitpick [card = 2, expect = genuine]
oops

lemma "lfp f = gfp f"
nitpick [card = 2, expect = genuine]
oops

subsubsection {* Axiomatic Type Classes and Overloading *}

text {* A type class without axioms: *}

class classA

lemma "P (x\<Colon>'a\<Colon>classA)"
nitpick [expect = genuine]
oops

text {* An axiom with a type variable (denoting types which have at least two elements): *}

class classC =
  assumes classC_ax: "\<exists>x y. x \<noteq> y"

lemma "P (x\<Colon>'a\<Colon>classC)"
nitpick [expect = genuine]
oops

lemma "\<exists>x y. (x\<Colon>'a\<Colon>classC) \<noteq> y"
nitpick [expect = none]
sorry

text {* A type class for which a constant is defined: *}

class classD =
  fixes classD_const :: "'a \<Rightarrow> 'a"
  assumes classD_ax: "classD_const (classD_const x) = classD_const x"

lemma "P (x\<Colon>'a\<Colon>classD)"
nitpick [expect = genuine]
oops

text {* A type class with multiple superclasses: *}

class classE = classC + classD

lemma "P (x\<Colon>'a\<Colon>classE)"
nitpick [expect = genuine]
oops

text {* OFCLASS: *}

lemma "OFCLASS('a\<Colon>type, type_class)"
nitpick [expect = none]
apply intro_classes
done

lemma "OFCLASS('a\<Colon>classC, type_class)"
nitpick [expect = none]
apply intro_classes
done

lemma "OFCLASS('a\<Colon>type, classC_class)"
nitpick [expect = genuine]
oops

text {* Overloading: *}

consts inverse :: "'a \<Rightarrow> 'a"

defs (overloaded)
inverse_bool: "inverse (b\<Colon>bool) \<equiv> \<not> b"
inverse_set: "inverse (S\<Colon>'a set) \<equiv> -S"
inverse_pair: "inverse p \<equiv> (inverse (fst p), inverse (snd p))"

lemma "inverse b"
nitpick [expect = genuine]
oops

lemma "P (inverse (S\<Colon>'a set))"
nitpick [expect = genuine]
oops

lemma "P (inverse (p\<Colon>'a\<times>'b))"
nitpick [expect = genuine]
oops

end