src/ZF/Resid/Redex.ML
author wenzelm
Mon, 29 Nov 1999 15:52:49 +0100
changeset 8039 a901bafe4578
parent 6141 a6922171b396
child 11319 8b84ee2cc79c
permissions -rw-r--r--
Goal: tuned pris;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1048
diff changeset
     1
(*  Title:      Redex.ML
1048
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
     2
    ID:         $Id$
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1048
diff changeset
     3
    Author:     Ole Rasmussen
1048
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
     4
    Copyright   1995  University of Cambridge
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
     5
    Logic Image: ZF
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
     6
*)
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
     7
6046
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
     8
Addsimps redexes.intrs;
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
     9
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    10
fun rotate n i = EVERY(replicate n (etac revcut_rl i));    
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    11
(* ------------------------------------------------------------------------- *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    12
(*    Specialisation of comp-rules                                           *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    13
(* ------------------------------------------------------------------------- *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    14
6141
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    15
val compD1 = Scomp.dom_subset RS subsetD RS SigmaD1;
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    16
val compD2 = Scomp.dom_subset RS subsetD RS SigmaD2;
6046
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    17
6141
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    18
val regD = Sreg.dom_subset RS subsetD;
1048
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    19
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    20
(* ------------------------------------------------------------------------- *)
6046
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    21
(*    Equality rules for union                                               *)
1048
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    22
(* ------------------------------------------------------------------------- *)
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    23
6046
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    24
Goal "n:nat==>Var(n) un Var(n)=Var(n)";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    25
by (asm_simp_tac (simpset() addsimps [union_def]) 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    26
qed "union_Var";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    27
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    28
Goal "[|u:redexes; v:redexes|]==>Fun(u) un Fun(v)=Fun(u un v)";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    29
by (asm_simp_tac (simpset() addsimps [union_def]) 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    30
qed "union_Fun";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    31
 
6141
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    32
Goal "[|b1:bool; b2:bool; u1:redexes; v1:redexes; u2:redexes; v2:redexes|]==> \
6046
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    33
\     App(b1,u1,v1) un App(b2,u2,v2)=App(b1 or b2,u1 un u2,v1 un v2)";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    34
by (asm_simp_tac (simpset() addsimps [union_def]) 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    35
qed "union_App";
1048
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    36
6046
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    37
Addsimps (Ssub.intrs@bool_typechecks@
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    38
	  Sreg.intrs@Scomp.intrs@
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    39
	  [or_1 RSN (3,or_commute RS trans),
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    40
	   or_0 RSN (3,or_commute RS trans),
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    41
	   union_App,union_Fun,union_Var,compD2,compD1,regD]);
1048
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    42
6046
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    43
AddIs Scomp.intrs;
6141
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    44
AddSEs [Sreg.mk_cases "regular(App(b,f,a))",
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    45
	Sreg.mk_cases "regular(Fun(b))",
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    46
	Sreg.mk_cases "regular(Var(b))",
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    47
	Scomp.mk_cases "Fun(u) ~ Fun(t)",
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    48
	Scomp.mk_cases "u ~ Fun(t)",
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    49
	Scomp.mk_cases "u ~ Var(n)",
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    50
	Scomp.mk_cases "u ~ App(b,t,a)",
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    51
	Scomp.mk_cases "Fun(t) ~ v",
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    52
	Scomp.mk_cases "App(b,f,a) ~ v",
a6922171b396 removal of the (thm list) argument of mk_cases
paulson
parents: 6046
diff changeset
    53
	Scomp.mk_cases "Var(n) ~ u"];
1048
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    54
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    55
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    56
6046
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    57
(* ------------------------------------------------------------------------- *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    58
(*    comp proofs                                                            *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    59
(* ------------------------------------------------------------------------- *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    60
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    61
Goal "u:redexes ==> u ~ u";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    62
by (etac redexes.induct 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    63
by (ALLGOALS Fast_tac);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    64
qed "comp_refl";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    65
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    66
Goal "u ~ v ==> v ~ u";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    67
by (etac Scomp.induct 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    68
by (ALLGOALS Fast_tac);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    69
qed "comp_sym";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    70
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    71
Goal "u ~ v <-> v ~ u";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    72
by (fast_tac (claset() addIs [comp_sym]) 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    73
qed "comp_sym_iff";
1048
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    74
5ba0314f8214 New example by Ole Rasmussen
lcp
parents:
diff changeset
    75
6046
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    76
Goal "u ~ v ==> ALL w. v ~ w-->u ~ w";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    77
by (etac Scomp.induct 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    78
by (ALLGOALS Fast_tac);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    79
qed_spec_mp "comp_trans";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    80
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    81
(* ------------------------------------------------------------------------- *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    82
(*   union proofs                                                            *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    83
(* ------------------------------------------------------------------------- *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    84
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    85
Goal "u ~ v ==> u <== (u un v)";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    86
by (etac Scomp.induct 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    87
by (etac boolE 3);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    88
by (ALLGOALS Asm_simp_tac);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    89
qed "union_l";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    90
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    91
Goal "u ~ v ==> v <== (u un v)";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    92
by (etac Scomp.induct 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    93
by (eres_inst_tac [("c","b2")] boolE 3);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    94
by (ALLGOALS Asm_simp_tac);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    95
qed "union_r";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    96
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    97
Goal "u ~ v ==> u un v = v un u";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    98
by (etac Scomp.induct 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
    99
by (ALLGOALS(asm_simp_tac (simpset() addsimps [or_commute])));
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   100
qed "union_sym";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   101
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   102
(* ------------------------------------------------------------------------- *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   103
(*      regular proofs                                                       *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   104
(* ------------------------------------------------------------------------- *)
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   105
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   106
Goal "u ~ v ==> regular(u)-->regular(v)-->regular(u un v)";
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   107
by (etac Scomp.induct 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   108
by Auto_tac;
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   109
by (dres_inst_tac [("psi", "regular(Fun(?u) un ?v)")] asm_rl 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   110
by (Asm_full_simp_tac 1);
2c8a8be36c94 converted to use new primrec section
paulson
parents: 5068
diff changeset
   111
qed_spec_mp "union_preserve_regular";