src/HOL/Quot/PER0.ML
author paulson
Thu Sep 23 13:06:31 1999 +0200 (1999-09-23)
changeset 7584 5be4bb8e4e3f
parent 5858 beddc19c107a
permissions -rw-r--r--
tidied; added lemma restrict_to_left
     1 (*  Title:      HOL/Quot/PER0.ML
     2     ID:         $Id$
     3     Author:     Oscar Slotosch
     4     Copyright   1997 Technische Universitaet Muenchen
     5 
     6 *)
     7 open PER0;
     8 
     9 (* derive the characteristic axioms *)
    10 Goalw [per_def] "x === y ==> y === x";
    11 by (etac ax_per_sym 1);
    12 qed "per_sym";
    13 
    14 Goalw [per_def] "[| x === y; y === z |] ==> x === z";
    15 by (etac ax_per_trans 1);
    16 by (assume_tac 1);
    17 qed "per_trans";
    18 
    19 Goalw [per_def] "(x::'a::er) === x";
    20 by (rtac ax_er_refl 1);
    21 qed "er_refl";
    22 
    23 (* now everything works without axclasses *)
    24 
    25 Goal "x===y=y===x";
    26 by (rtac iffI 1);
    27 by (etac per_sym 1);
    28 by (etac per_sym 1);
    29 qed "per_sym2";
    30 
    31 Goal "x===y ==> x===x";
    32 by (rtac per_trans 1);by (assume_tac 1);
    33 by (etac per_sym 1);
    34 qed "sym2refl1";
    35 
    36 Goal "x===y ==> y===y";
    37 by (rtac per_trans 1);by (assume_tac 2);
    38 by (etac per_sym 1);
    39 qed "sym2refl2";
    40 
    41 Goalw [Dom] "x:D ==> x === x";
    42 by (Blast_tac 1);
    43 qed "DomainD";
    44 
    45 Goalw [Dom] "x === x ==> x:D";
    46 by (Blast_tac 1);
    47 qed "DomainI";
    48 
    49 Goal "x:D = x===x";
    50 by (rtac iffI 1);
    51 by (etac DomainD 1);
    52 by (etac DomainI 1);
    53 qed "DomainEq";
    54 
    55 Goal "(~ x === y) = (~ y === x)";
    56 by (rtac (per_sym2 RS arg_cong) 1);
    57 qed "per_not_sym";
    58 
    59 (* show that PER work only on D *)
    60 Goal "x===y ==> x:D";
    61 by (etac (sym2refl1 RS DomainI) 1);
    62 qed "DomainI_left"; 
    63 
    64 Goal "x===y ==> y:D";
    65 by (etac (sym2refl2 RS DomainI) 1);
    66 qed "DomainI_right"; 
    67 
    68 Goalw [Dom] "x~:D ==> ~x===y";
    69 by (res_inst_tac [("Q","x===y")] (excluded_middle RS disjE) 1);
    70 by (assume_tac 1);
    71 by (dtac sym2refl1 1);
    72 by (Blast_tac 1);
    73 qed "notDomainE1"; 
    74 
    75 Goalw [Dom] "x~:D ==> ~y===x";
    76 by (res_inst_tac [("Q","y===x")] (excluded_middle RS disjE) 1);
    77 by (assume_tac 1);
    78 by (dtac sym2refl2 1);
    79 by (Blast_tac 1);
    80 qed "notDomainE2"; 
    81 
    82 (* theorems for equivalence relations *)
    83 Goal "(x::'a::er) : D";
    84 by (rtac DomainI 1);
    85 by (rtac er_refl 1);
    86 qed "er_Domain";
    87 
    88 (* witnesses for "=>" ::(per,per)per  *)
    89 Goalw [fun_per_def]"eqv (x::'a::per => 'b::per) y ==> eqv y x";
    90 by (auto_tac (claset(), simpset() addsimps [per_sym2]));
    91 qed "per_sym_fun";
    92 
    93 Goalw [fun_per_def] "[| eqv (f::'a::per=>'b::per) g;eqv g h|] ==> eqv f h";
    94 by Safe_tac;
    95 by (REPEAT (dtac spec 1));
    96 by (res_inst_tac [("y","g y")] per_trans 1);
    97 by (rtac mp 1);by (assume_tac 1);
    98 by (Asm_simp_tac 1);
    99 by (rtac mp 1);by (assume_tac 1);
   100 by (asm_simp_tac (simpset() addsimps [sym2refl2]) 1);
   101 qed "per_trans_fun";
   102 
   103