diff -r 6088fea1c8b1 -r 8a1c8dc72b5c IntEx2.thy --- a/IntEx2.thy Mon Dec 07 14:00:36 2009 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,436 +0,0 @@ -theory IntEx2 -imports QuotMain -uses - ("Tools/numeral.ML") - ("Tools/numeral_syntax.ML") - ("Tools/int_arith.ML") -begin - - -fun - intrel :: "(nat \ nat) \ (nat \ nat) \ bool" (infix "\" 50) -where - "intrel (x, y) (u, v) = (x + v = u + y)" - -quotient int = "nat \ nat" / intrel - apply(unfold equivp_def) - apply(auto simp add: mem_def expand_fun_eq) - done - -instantiation int :: "{zero, one, plus, minus, uminus, times, ord, abs, sgn}" -begin - -quotient_def - zero_qnt::"int" -where - "zero_qnt \ (0::nat, 0::nat)" - -definition Zero_int_def[code del]: - "0 = zero_qnt" - -quotient_def - one_qnt::"int" -where - "one_qnt \ (1::nat, 0::nat)" - -definition One_int_def[code del]: - "1 = one_qnt" - -fun - plus_raw :: "(nat \ nat) \ (nat \ nat) \ (nat \ nat)" -where - "plus_raw (x, y) (u, v) = (x + u, y + v)" - -quotient_def - plus_qnt::"int \ int \ int" -where - "plus_qnt \ plus_raw" - -definition add_int_def[code del]: - "z + w = plus_qnt z w" - -fun - minus_raw :: "(nat \ nat) \ (nat \ nat)" -where - "minus_raw (x, y) = (y, x)" - -quotient_def - minus_qnt::"int \ int" -where - "minus_qnt \ minus_raw" - -definition minus_int_def [code del]: - "- z = minus_qnt z" - -definition - diff_int_def [code del]: "z - w = z + (-w::int)" - -fun - mult_raw :: "(nat \ nat) \ (nat \ nat) \ (nat \ nat)" -where - "mult_raw (x, y) (u, v) = (x*u + y*v, x*v + y*u)" - -quotient_def - mult_qnt::"int \ int \ int" -where - "mult_qnt \ mult_raw" - -definition - mult_int_def [code del]: "z * w = mult_qnt z w" - -fun - le_raw :: "(nat \ nat) \ (nat \ nat) \ bool" -where - "le_raw (x, y) (u, v) = (x+v \ u+y)" - -quotient_def - le_qnt :: "int \ int \ bool" -where - "le_qnt \ le_raw" - -definition - le_int_def [code del]: - "z \ w = le_qnt z w" - -definition - less_int_def [code del]: "(z\int) < w = (z \ w \ z \ w)" - -definition - zabs_def: "\i\int\ = (if i < 0 then - i else i)" - -definition - zsgn_def: "sgn (i\int) = (if i=0 then 0 else if 0 ===> op \ ===> op \) plus_raw plus_raw" -by auto - -lemma minus_raw_rsp[quotient_rsp]: - shows "(op \ ===> op \) minus_raw minus_raw" - by auto - -lemma mult_raw_rsp[quotient_rsp]: - shows "(op \ ===> op \ ===> op \) mult_raw mult_raw" -apply(auto) -apply(simp add: mult algebra_simps) -sorry - -lemma le_raw_rsp[quotient_rsp]: - shows "(op \ ===> op \ ===> op =) le_raw le_raw" -by auto - -lemma plus_assoc_raw: - shows "plus_raw (plus_raw i j) k \ plus_raw i (plus_raw j k)" -by (cases i, cases j, cases k) (simp) - -lemma plus_sym_raw: - shows "plus_raw i j \ plus_raw j i" -by (cases i, cases j) (simp) - -lemma plus_zero_raw: - shows "plus_raw (0, 0) i \ i" -by (cases i) (simp) - -lemma plus_minus_zero_raw: - shows "plus_raw (minus_raw i) i \ (0, 0)" -by (cases i) (simp) - -lemma mult_assoc_raw: - shows "mult_raw (mult_raw i j) k \ mult_raw i (mult_raw j k)" -by (cases i, cases j, cases k) - (simp add: mult algebra_simps) - -lemma mult_sym_raw: - shows "mult_raw i j \ mult_raw j i" -by (cases i, cases j) (simp) - -lemma mult_one_raw: - shows "mult_raw (1, 0) i \ i" -by (cases i) (simp) - -lemma mult_plus_comm_raw: - shows "mult_raw (plus_raw i j) k \ plus_raw (mult_raw i k) (mult_raw j k)" -by (cases i, cases j, cases k) - (simp add: mult algebra_simps) - -lemma one_zero_distinct: - shows "\ (0, 0) \ ((1::nat), (0::nat))" - by simp - -text{*The integers form a @{text comm_ring_1}*} - - -ML {* val qty = @{typ "int"} *} -ML {* val (rty, rel, rel_refl, rel_eqv) = lookup_quot_data @{context} qty *} -ML {* val (trans2, reps_same, absrep, quot) = lookup_quot_thms @{context} "int" *} - -instance int :: comm_ring_1 -proof - fix i j k :: int - show "(i + j) + k = i + (j + k)" - unfolding add_int_def - apply(tactic {* lift_tac @{context} @{thm plus_assoc_raw} 1 *}) - done - show "i + j = j + i" - unfolding add_int_def - apply(tactic {* lift_tac @{context} @{thm plus_sym_raw} 1 *}) - done - show "0 + i = (i::int)" - unfolding add_int_def Zero_int_def - apply(tactic {* lift_tac @{context} @{thm plus_zero_raw} 1 *}) - done - show "- i + i = 0" - unfolding add_int_def minus_int_def Zero_int_def - apply(tactic {* lift_tac @{context} @{thm plus_minus_zero_raw} 1 *}) - done - show "i - j = i + - j" - by (simp add: diff_int_def) - show "(i * j) * k = i * (j * k)" - unfolding mult_int_def - apply(tactic {* lift_tac @{context} @{thm mult_assoc_raw} 1 *}) - done - show "i * j = j * i" - unfolding mult_int_def - apply(tactic {* lift_tac @{context} @{thm mult_sym_raw} 1 *}) - done - show "1 * i = i" - unfolding mult_int_def One_int_def - apply(tactic {* lift_tac @{context} @{thm mult_one_raw} 1 *}) - done - show "(i + j) * k = i * k + j * k" - unfolding mult_int_def add_int_def - apply(tactic {* lift_tac @{context} @{thm mult_plus_comm_raw} 1 *}) - done - show "0 \ (1::int)" - unfolding Zero_int_def One_int_def - apply(tactic {* lift_tac @{context} @{thm one_zero_distinct} 1 *}) - done -qed - -term of_nat -thm of_nat_def - -lemma int_def: "of_nat m = ABS_int (m, 0)" -apply(induct m) -apply(simp add: Zero_int_def zero_qnt_def) -apply(simp) -apply(simp add: add_int_def One_int_def) -apply(simp add: plus_qnt_def one_qnt_def) -oops - -lemma le_antisym_raw: - shows "le_raw i j \ le_raw j i \ i \ j" -by (cases i, cases j) (simp) - -lemma le_refl_raw: - shows "le_raw i i" -by (cases i) (simp) - -lemma le_trans_raw: - shows "le_raw i j \ le_raw j k \ le_raw i k" -by (cases i, cases j, cases k) (simp) - -lemma le_cases_raw: - shows "le_raw i j \ le_raw j i" -by (cases i, cases j) - (simp add: linorder_linear) - -instance int :: linorder -proof - fix i j k :: int - show antisym: "i \ j \ j \ i \ i = j" - unfolding le_int_def - apply(tactic {* lift_tac @{context} @{thm le_antisym_raw} 1 *}) - done - show "(i < j) = (i \ j \ \ j \ i)" - by (auto simp add: less_int_def dest: antisym) - show "i \ i" - unfolding le_int_def - apply(tactic {* lift_tac @{context} @{thm le_refl_raw} 1 *}) - done - show "i \ j \ j \ k \ i \ k" - unfolding le_int_def - apply(tactic {* lift_tac @{context} @{thm le_trans_raw} 1 *}) - done - show "i \ j \ j \ i" - unfolding le_int_def - apply(tactic {* lift_tac @{context} @{thm le_cases_raw} 1 *}) - done -qed - -instantiation int :: distrib_lattice -begin - -definition - "(inf \ int \ int \ int) = min" - -definition - "(sup \ int \ int \ int) = max" - -instance - by intro_classes - (auto simp add: inf_int_def sup_int_def min_max.sup_inf_distrib1) - -end - -lemma le_plus_raw: - shows "le_raw i j \ le_raw (plus_raw k i) (plus_raw k j)" -by (cases i, cases j, cases k) (simp) - - -instance int :: pordered_cancel_ab_semigroup_add -proof - fix i j k :: int - show "i \ j \ k + i \ k + j" - unfolding le_int_def add_int_def - apply(tactic {* lift_tac @{context} @{thm le_plus_raw} 1 *}) - done -qed - -lemma test: - "\le_raw i j \ \i \ j; le_raw (0, 0) k \ \(0, 0) \ k\ - \ le_raw (mult_raw k i) (mult_raw k j) \ \mult_raw k i \ mult_raw k j" -apply(cases i, cases j, cases k) -apply(auto simp add: mult algebra_simps) -sorry - - -text{*The integers form an ordered integral domain*} -instance int :: ordered_idom -proof - fix i j k :: int - show "i < j \ 0 < k \ k * i < k * j" - unfolding mult_int_def le_int_def less_int_def Zero_int_def - apply(tactic {* lift_tac @{context} @{thm test} 1 *}) - done - show "\i\ = (if i < 0 then -i else i)" - by (simp only: zabs_def) - show "sgn (i\int) = (if i=0 then 0 else if 0 'a" -where - "of_int -*) - - -subsection {* Binary representation *} - -text {* - This formalization defines binary arithmetic in terms of the integers - rather than using a datatype. This avoids multiple representations (leading - zeroes, etc.) See @{text "ZF/Tools/twos-compl.ML"}, function @{text - int_of_binary}, for the numerical interpretation. - - The representation expects that @{text "(m mod 2)"} is 0 or 1, - even if m is negative; - For instance, @{text "-5 div 2 = -3"} and @{text "-5 mod 2 = 1"}; thus - @{text "-5 = (-3)*2 + 1"}. - - This two's complement binary representation derives from the paper - "An Efficient Representation of Arithmetic for Term Rewriting" by - Dave Cohen and Phil Watson, Rewriting Techniques and Applications, - Springer LNCS 488 (240-251), 1991. -*} - -subsubsection {* The constructors @{term Bit0}, @{term Bit1}, @{term Pls} and @{term Min} *} - -definition - Pls :: int where - [code del]: "Pls = 0" - -definition - Min :: int where - [code del]: "Min = - 1" - -definition - Bit0 :: "int \ int" where - [code del]: "Bit0 k = k + k" - -definition - Bit1 :: "int \ int" where - [code del]: "Bit1 k = 1 + k + k" - -class number = -- {* for numeric types: nat, int, real, \dots *} - fixes number_of :: "int \ 'a" - -use "~~/src/HOL/Tools/numeral.ML" - -syntax - "_Numeral" :: "num_const \ 'a" ("_") - -use "~~/src/HOL/Tools/numeral_syntax.ML" -(* -setup NumeralSyntax.setup - -abbreviation - "Numeral0 \ number_of Pls" - -abbreviation - "Numeral1 \ number_of (Bit1 Pls)" - -lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)" - -- {* Unfold all @{text let}s involving constants *} - unfolding Let_def .. - -definition - succ :: "int \ int" where - [code del]: "succ k = k + 1" - -definition - pred :: "int \ int" where - [code del]: "pred k = k - 1" - -lemmas - max_number_of [simp] = max_def - [of "number_of u" "number_of v", standard, simp] -and - min_number_of [simp] = min_def - [of "number_of u" "number_of v", standard, simp] - -- {* unfolding @{text minx} and @{text max} on numerals *} - -lemmas numeral_simps = - succ_def pred_def Pls_def Min_def Bit0_def Bit1_def - -text {* Removal of leading zeroes *} - -lemma Bit0_Pls [simp, code_post]: - "Bit0 Pls = Pls" - unfolding numeral_simps by simp - -lemma Bit1_Min [simp, code_post]: - "Bit1 Min = Min" - unfolding numeral_simps by simp - -lemmas normalize_bin_simps = - Bit0_Pls Bit1_Min -*) \ No newline at end of file