226
|
1 |
(*notation ( output) "prop" ("#_" [1000] 1000) *)
|
|
2 |
notation ( output) "Trueprop" ("#_" [1000] 1000)
|
101
|
3 |
|
806
43336511993f
Readded 'regularize_to_injection' which I believe will be needed.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
4 |
lemma regularize_to_injection:
|
43336511993f
Readded 'regularize_to_injection' which I believe will be needed.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
5 |
shows "(QUOT_TRUE l \<Longrightarrow> y) \<Longrightarrow> (l = r) \<longrightarrow> y"
|
43336511993f
Readded 'regularize_to_injection' which I believe will be needed.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
6 |
by(auto simp add: QUOT_TRUE_def)
|
43336511993f
Readded 'regularize_to_injection' which I believe will be needed.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
7 |
|
43336511993f
Readded 'regularize_to_injection' which I believe will be needed.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
8 |
|
43336511993f
Readded 'regularize_to_injection' which I believe will be needed.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
9 |
|
870
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
10 |
(* Atomize infrastructure *)
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
11 |
(* FIXME/TODO: is this really needed? *)
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
12 |
(*
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
13 |
lemma atomize_eqv:
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
14 |
shows "(Trueprop A \<equiv> Trueprop B) \<equiv> (A \<equiv> B)"
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
15 |
proof
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
16 |
assume "A \<equiv> B"
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
17 |
then show "Trueprop A \<equiv> Trueprop B" by unfold
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
18 |
next
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
19 |
assume *: "Trueprop A \<equiv> Trueprop B"
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
20 |
have "A = B"
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
21 |
proof (cases A)
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
22 |
case True
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
23 |
have "A" by fact
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
24 |
then show "A = B" using * by simp
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
25 |
next
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
26 |
case False
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
27 |
have "\<not>A" by fact
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
28 |
then show "A = B" using * by auto
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
29 |
qed
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
30 |
then show "A \<equiv> B" by (rule eq_reflection)
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
31 |
qed
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
32 |
*)
|
2a19e0a37131
Remove SOLVED from quotient_tac. Move atomize_eqv to 'Unused'.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
33 |
|
806
43336511993f
Readded 'regularize_to_injection' which I believe will be needed.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
34 |
|
101
|
35 |
ML {*
|
|
36 |
fun dest_cbinop t =
|
|
37 |
let
|
|
38 |
val (t2, rhs) = Thm.dest_comb t;
|
|
39 |
val (bop, lhs) = Thm.dest_comb t2;
|
|
40 |
in
|
|
41 |
(bop, (lhs, rhs))
|
|
42 |
end
|
|
43 |
*}
|
|
44 |
|
|
45 |
ML {*
|
|
46 |
fun dest_ceq t =
|
|
47 |
let
|
|
48 |
val (bop, pair) = dest_cbinop t;
|
|
49 |
val (bop_s, _) = Term.dest_Const (Thm.term_of bop);
|
|
50 |
in
|
|
51 |
if bop_s = "op =" then pair else (raise CTERM ("Not an equality", [t]))
|
|
52 |
end
|
|
53 |
*}
|
|
54 |
|
|
55 |
ML {*
|
|
56 |
fun split_binop_conv t =
|
|
57 |
let
|
|
58 |
val (lhs, rhs) = dest_ceq t;
|
|
59 |
val (bop, _) = dest_cbinop lhs;
|
|
60 |
val [clT, cr2] = bop |> Thm.ctyp_of_term |> Thm.dest_ctyp;
|
|
61 |
val [cmT, crT] = Thm.dest_ctyp cr2;
|
|
62 |
in
|
|
63 |
Drule.instantiate' [SOME clT, SOME cmT, SOME crT] [NONE, NONE, NONE, NONE, SOME bop] @{thm arg_cong2}
|
|
64 |
end
|
|
65 |
*}
|
|
66 |
|
|
67 |
|
|
68 |
ML {*
|
|
69 |
fun split_arg_conv t =
|
|
70 |
let
|
|
71 |
val (lhs, rhs) = dest_ceq t;
|
|
72 |
val (lop, larg) = Thm.dest_comb lhs;
|
|
73 |
val [caT, crT] = lop |> Thm.ctyp_of_term |> Thm.dest_ctyp;
|
|
74 |
in
|
|
75 |
Drule.instantiate' [SOME caT, SOME crT] [NONE, NONE, SOME lop] @{thm arg_cong}
|
|
76 |
end
|
|
77 |
*}
|
|
78 |
|
|
79 |
ML {*
|
|
80 |
fun split_binop_tac n thm =
|
|
81 |
let
|
|
82 |
val concl = Thm.cprem_of thm n;
|
|
83 |
val (_, cconcl) = Thm.dest_comb concl;
|
|
84 |
val rewr = split_binop_conv cconcl;
|
|
85 |
in
|
|
86 |
rtac rewr n thm
|
|
87 |
end
|
|
88 |
handle CTERM _ => Seq.empty
|
|
89 |
*}
|
|
90 |
|
|
91 |
|
|
92 |
ML {*
|
|
93 |
fun split_arg_tac n thm =
|
|
94 |
let
|
|
95 |
val concl = Thm.cprem_of thm n;
|
|
96 |
val (_, cconcl) = Thm.dest_comb concl;
|
|
97 |
val rewr = split_arg_conv cconcl;
|
|
98 |
in
|
|
99 |
rtac rewr n thm
|
|
100 |
end
|
|
101 |
handle CTERM _ => Seq.empty
|
|
102 |
*}
|
|
103 |
|
|
104 |
|
|
105 |
lemma trueprop_cong:
|
303
|
106 |
shows "(a \<equiv> b) \<Longrightarrow> (Trueprop a \<equiv> Trueprop b)"
|
101
|
107 |
by auto
|
226
|
108 |
|
|
109 |
lemma list_induct_hol4:
|
303
|
110 |
fixes P :: "'a list \<Rightarrow> bool"
|
|
111 |
assumes a: "((P []) \<and> (\<forall>t. (P t) \<longrightarrow> (\<forall>h. (P (h # t)))))"
|
|
112 |
shows "\<forall>l. (P l)"
|
226
|
113 |
using a
|
|
114 |
apply (rule_tac allI)
|
|
115 |
apply (induct_tac "l")
|
|
116 |
apply (simp)
|
|
117 |
apply (metis)
|
|
118 |
done
|
|
119 |
|
301
|
120 |
ML {*
|
|
121 |
val no_vars = Thm.rule_attribute (fn context => fn th =>
|
|
122 |
let
|
|
123 |
val ctxt = Variable.set_body false (Context.proof_of context);
|
|
124 |
val ((_, [th']), _) = Variable.import true [th] ctxt;
|
|
125 |
in th' end);
|
|
126 |
*}
|
303
|
127 |
|
|
128 |
(*lemma equality_twice:
|
|
129 |
"a = c \<Longrightarrow> b = d \<Longrightarrow> (a = b \<longrightarrow> c = d)"
|
|
130 |
by auto*)
|
685
|
131 |
|
|
132 |
|
|
133 |
(*interpretation code *)
|
|
134 |
(*val bindd = ((Binding.make ("", Position.none)), ([]: Attrib.src list))
|
|
135 |
val ((_, [eqn1pre]), lthy5) = Variable.import true [ABS_def] lthy4;
|
|
136 |
val eqn1i = Thm.prop_of (symmetric eqn1pre)
|
|
137 |
val ((_, [eqn2pre]), lthy6) = Variable.import true [REP_def] lthy5;
|
|
138 |
val eqn2i = Thm.prop_of (symmetric eqn2pre)
|
|
139 |
|
|
140 |
val exp_morphism = ProofContext.export_morphism lthy6 (ProofContext.init (ProofContext.theory_of lthy6));
|
|
141 |
val exp_term = Morphism.term exp_morphism;
|
|
142 |
val exp = Morphism.thm exp_morphism;
|
|
143 |
|
|
144 |
val mthd = Method.SIMPLE_METHOD ((rtac quot_thm 1) THEN
|
|
145 |
ALLGOALS (simp_tac (HOL_basic_ss addsimps [(symmetric (exp ABS_def)), (symmetric (exp REP_def))])))
|
|
146 |
val mthdt = Method.Basic (fn _ => mthd)
|
|
147 |
val bymt = Proof.global_terminal_proof (mthdt, NONE)
|
|
148 |
val exp_i = [(@{const_name QUOT_TYPE}, ((("QUOT_TYPE_I_" ^ (Binding.name_of qty_name)), true),
|
|
149 |
Expression.Named [("R", rel), ("Abs", abs), ("Rep", rep) ]))]*)
|
|
150 |
|
|
151 |
(*||> Local_Theory.theory (fn thy =>
|
|
152 |
let
|
|
153 |
val global_eqns = map exp_term [eqn2i, eqn1i];
|
|
154 |
(* Not sure if the following context should not be used *)
|
|
155 |
val (global_eqns2, lthy7) = Variable.import_terms true global_eqns lthy6;
|
|
156 |
val global_eqns3 = map (fn t => (bindd, t)) global_eqns2;
|
806
43336511993f
Readded 'regularize_to_injection' which I believe will be needed.
Cezary Kaliszyk <kaliszyk@in.tum.de>
diff
changeset
|
157 |
in ProofContext.theory_of (bymt (Expression.interpretation (exp_i, []) global_eqns3 thy)) end)*)
|