fun trans_type _ \<^Type>\<open>real\<close> tcx = SOME (Argo_Expr.Real, tcx)
| trans_type _ _ _ = NONE
fun trans_term f \<^Const_>\<open>uminus \<^Type>\<open>real\<close> for t\<close> tcx =
tcx |> f t |>> Argo_Expr.mk_neg |> SOME
| trans_term f \<^Const_>\<open>plus \<^Type>\<open>real\<close> for t1 t2\<close> tcx =
tcx |> f t1 ||>> f t2 |>> uncurry Argo_Expr.mk_add2 |> SOME
| trans_term f \<^Const_>\<open>minus \<^Type>\<open>real\<close> for t1 t2\<close> tcx =
tcx |> f t1 ||>> f t2 |>> uncurry Argo_Expr.mk_sub |> SOME
| trans_term f \<^Const_>\<open>times \<^Type>\<open>real\<close> for t1 t2\<close> tcx =
tcx |> f t1 ||>> f t2 |>> uncurry Argo_Expr.mk_mul |> SOME
| trans_term f \<^Const_>\<open>divide \<^Type>\<open>real\<close> for t1 t2\<close> tcx =
tcx |> f t1 ||>> f t2 |>> uncurry Argo_Expr.mk_div |> SOME
| trans_term f \<^Const_>\<open>min \<^Type>\<open>real\<close> for t1 t2\<close> tcx =
tcx |> f t1 ||>> f t2 |>> uncurry Argo_Expr.mk_min |> SOME
| trans_term f \<^Const_>\<open>max \<^Type>\<open>real\<close> for t1 t2\<close> tcx =
tcx |> f t1 ||>> f t2 |>> uncurry Argo_Expr.mk_max |> SOME
| trans_term f \<^Const_>\<open>abs \<^Type>\<open>real\<close> for t\<close> tcx =
tcx |> f t |>> Argo_Expr.mk_abs |> SOME
| trans_term f \<^Const_>\<open>less \<^Type>\<open>real\<close> for t1 t2\<close> tcx =
tcx |> f t1 ||>> f t2 |>> uncurry Argo_Expr.mk_lt |> SOME
| trans_term f \<^Const_>\<open>less_eq \<^Type>\<open>real\<close> for t1 t2\<close> tcx =
tcx |> f t1 ||>> f t2 |>> uncurry Argo_Expr.mk_le |> SOME
| trans_term _ t tcx =
(casetry HOLogic.dest_number t of
SOME (\<^Type>\<open>real\<close>, n) => SOME (Argo_Expr.mk_num (Rat.of_int n), tcx)
| _ => NONE)
(* reverse translation *)
fun mk_plus t1 t2 = \<^Const>\<open>plus \<^Type>\<open>real\<close> for t1 t2\<close> fun mk_sum ts = uncurry (fold_rev mk_plus) (split_last ts) fun mk_times t1 t2 = \<^Const>\<open>times \<^Type>\<open>real\<close> for t1 t2\<close> fun mk_divide t1 t2 = \<^Const>\<open>divide \<^Type>\<open>real\<close> for t1 t2\<close> fun mk_le t1 t2 = \<^Const>\<open>less_eq \<^Type>\<open>real\<close> for t1 t2\<close> fun mk_lt t1 t2 = \<^Const>\<open>less \<^Type>\<open>real\<close> for t1 t2\<close>
fun mk_real_num i = HOLogic.mk_number \<^Type>\<open>real\<close> i
fun mk_number n = letval (p, q) = Rat.dest n inif q = 1 then mk_real_num p else mk_divide (mk_real_num p) (mk_real_num q) end
fun term_of _ (Argo_Expr.E (Argo_Expr.Num n, _)) = SOME (mk_number n)
| term_of f (Argo_Expr.E (Argo_Expr.Neg, [e])) = SOME \<^Const>\<open>uminus \<^Type>\<open>real\<close> for \<open>f e\<close>\<close>
| term_of f (Argo_Expr.E (Argo_Expr.Add, es)) = SOME (mk_sum (map f es))
| term_of f (Argo_Expr.E (Argo_Expr.Sub, [e1, e2])) =
SOME \<^Const>\<open>minus \<^Type>\<open>real\<close> for \<open>f e1\<close> \<open>f e2\<close>\<close>
| term_of f (Argo_Expr.E (Argo_Expr.Mul, [e1, e2])) = SOME (mk_times (f e1) (f e2))
| term_of f (Argo_Expr.E (Argo_Expr.Div, [e1, e2])) = SOME (mk_divide (f e1) (f e2))
| term_of f (Argo_Expr.E (Argo_Expr.Min, [e1, e2])) =
SOME \<^Const>\<open>min \<^Type>\<open>real\<close> for \<open>f e1\<close> \<open>f e2\<close>\<close>
| term_of f (Argo_Expr.E (Argo_Expr.Max, [e1, e2])) =
SOME \<^Const>\<open>max \<^Type>\<open>real\<close> for \<open>f e1\<close> \<open>f e2\<close>\<close>
| term_of f (Argo_Expr.E (Argo_Expr.Abs, [e])) = SOME \<^Const>\<open>abs \<^Type>\<open>real\<close> for \<open>f e\<close>\<close>
| term_of f (Argo_Expr.E (Argo_Expr.Le, [e1, e2])) = SOME (mk_le (f e1) (f e2))
| term_of f (Argo_Expr.E (Argo_Expr.Lt, [e1, e2])) = SOME (mk_lt (f e1) (f e2))
| term_of _ _ = NONE
(* proof replay for rewrite steps *)
fun mk_rewr thm = thm RS @{thm eq_reflection}
fun by_simp ctxt t = letfun prove {context, ...} = HEADGOAL (Simplifier.simp_tac context) in Goal.prove ctxt [] [] (HOLogic.mk_Trueprop t) prove end
fun prove_num_pred ctxt n =
by_simp ctxt (uncurry mk_lt (apply2 mk_number (if @0 < n then (@0, n) else (n, @0))))
fun simp_conv ctxt t = Conv.rewr_conv (mk_rewr (by_simp ctxt t))
fun nums_conv mk f ctxt n m =
simp_conv ctxt (HOLogic.mk_eq (mk (mk_number n) (mk_number m), mk_number (f (n, m))))
val add_nums_conv = nums_conv mk_plus (op +) val mul_nums_conv = nums_conv mk_times (op *) val div_nums_conv = nums_conv mk_divide (op /) fun inv_num_conv ctxt = nums_conv mk_divide (fn (_, n) => Rat.inv n) ctxt @1
fun cmp_nums_conv ctxt b ct = letval t = if b then \<^Const>\<open>True\<close> else \<^Const>\<open>False\<close> in simp_conv ctxt (HOLogic.mk_eq (Thm.term_of ct, t)) ct end
local
fun is_add2 \<^Const_>\<open>plus \<^Type>\<open>real\<close> for _ _\<close> = true
| is_add2 _ = false
fun is_add3 \<^Const_>\<open>plus \<^Type>\<open>real\<close> for _ t\<close> = is_add2 t
| is_add3 _ = false
val flatten_thm = mk_rewr @{lemma "(a::real) + b + c = a + (b + c)" by simp}
fun flatten_conv ct = if is_add2 (Thm.term_of ct) then Argo_Tactic.flatten_conv flatten_conv flatten_thm ct else Conv.all_conv ct
val swap_conv = Conv.rewrs_conv (map mk_rewr @{lemma "(a::real) + (b + c) = b + (a + c)" "(a::real) + b = b + a"
by simp_all})
val assoc_conv = Conv.rewr_conv (mk_rewr @{lemma "(a::real) + (b + c) = (a + b) + c" by simp})
val norm_monom_thm = mk_rewr @{lemma "1 * (a::real) = a" by simp} fun norm_monom_conv n = if n = @1 then Conv.rewr_conv norm_monom_thm else Conv.all_conv
val add2_thms = map mk_rewr @{lemma "n * (a::real) + m * a = (n + m) * a" "n * (a::real) + a = (n + 1) * a" "(a::real) + m * a = (1 + m) * a" "(a::real) + a = (1 + 1) * a"
by algebra+}
val add3_thms = map mk_rewr @{lemma "n * (a::real) + (m * a + b) = (n + m) * a + b" "n * (a::real) + (a + b) = (n + 1) * a + b" "(a::real) + (m * a + b) = (1 + m) * a + b" "(a::real) + (a + b) = (1 + 1) * a + b"
by algebra+}
fun choose_conv cv2 cv3 ct = if is_add3 (Thm.term_of ct) then cv3 ct else cv2 ct
fun join_num_conv ctxt n m = letval conv = add_nums_conv ctxt n m in choose_conv conv (assoc_conv then_conv Conv.arg1_conv conv) end
fun join_monom_conv ctxt n m = let val conv = Conv.arg1_conv (add_nums_conv ctxt n m) then_conv norm_monom_conv (n + m) fun seq_conv thms cv = Conv.rewrs_conv thms then_conv cv in choose_conv (seq_conv add2_thms conv) (seq_conv add3_thms (Conv.arg1_conv conv)) end
fun bubble_down_conv _ _ [] ct = Conv.no_conv ct
| bubble_down_conv _ _ [_] ct = Conv.all_conv ct
| bubble_down_conv ctxt i ((m1 as (n1, i1)) :: (m2 as (n2, i2)) :: ms) ct = if i1 = i then if i2 = i then
(join_conv i ctxt n1 n2 then_conv bubble_down_conv ctxt i ((n1 + n2, i) :: ms)) ct else (swap_conv then_conv Conv.arg_conv (bubble_down_conv ctxt i (m1 :: ms))) ct else Conv.arg_conv (bubble_down_conv ctxt i (m2 :: ms)) ct
fun drop_var i ms = filter_out (fn (_, i') => i' = i) ms
fun permute_conv _ [] [] ct = Conv.all_conv ct
| permute_conv ctxt (ms as ((_, i) :: _)) [] ct =
(bubble_down_conv ctxt i ms then_conv permute_conv ctxt (drop_var i ms) []) ct
| permute_conv ctxt ms1 ms2 ct = letval (ms2', (_, i)) = split_last ms2 in (bubble_down_conv ctxt i ms1 then_conv permute_conv ctxt (drop_var i ms1) ms2') ct end
val no_monom_conv = Conv.rewr_conv (mk_rewr @{lemma "0 * (a::real) = 0" by simp})
val norm_sum_conv = Conv.rewrs_conv (map mk_rewr @{lemma "0 * (a::real) + b = b" "(a::real) + 0 * b = a" "0 + (a::real) = a" "(a::real) + 0 = a"
by simp_all})
fun drop0_conv ct = if is_add2 (Thm.term_of ct) then
((norm_sum_conv then_conv drop0_conv) else_conv Conv.arg_conv drop0_conv) ct else Conv.try_conv no_monom_conv ct
fun full_add_conv ctxt ms1 ms2 = if eq_list (op =) (ms1, ms2) then flatten_conv else flatten_conv then_conv permute_conv ctxt ms1 ms2 then_conv drop0_conv
in
fun add_conv ctxt (ms1, ms2 as [(n, NONE)]) = if n = @0 then full_add_conv ctxt ms1 [] else full_add_conv ctxt ms1 ms2
| add_conv ctxt (ms1, ms2) = full_add_conv ctxt ms1 ms2
end
val mul_suml_thm = mk_rewr @{lemma "((x::real) + y) * z = x * z + y * z" by (rule ring_distribs)} val mul_sumr_thm = mk_rewr @{lemma "(x::real) * (y + z) = x * y + x * z" by (rule ring_distribs)} fun mul_sum_conv thm ct =
Conv.try_conv (Conv.rewr_conv thm then_conv Conv.binop_conv (mul_sum_conv thm)) ct
val div_sum_thm = mk_rewr @{lemma "((x::real) + y) / z = x / z + y / z"
by (rule add_divide_distrib)} fun div_sum_conv ct =
Conv.try_conv (Conv.rewr_conv div_sum_thm then_conv Conv.binop_conv div_sum_conv) ct
fun var_of_add_cmp (_ $ _ $ (_ $ _ $ (_ $ _ $ Var v))) = v
| var_of_add_cmp t = raise TERM ("var_of_add_cmp", [t])
fun add_cmp_conv ctxt n thm = letval v = var_of_add_cmp (Thm.prop_of thm) in
Conv.rewr_conv
(Thm.instantiate (TVars.empty, Vars.make1 (v, Thm.cterm_of ctxt (mk_number n))) thm) end
fun mul_cmp_conv ctxt n pos_thm neg_thm = letval thm = if @0 < n then pos_thm else neg_thm in Conv.rewr_conv (prove_num_pred ctxt n RS thm) end
val neg_thm = mk_rewr @{lemma "-(x::real) = -1 * x" by simp} val sub_thm = mk_rewr @{lemma "(x::real) - y = x + -1 * y" by simp} val mul_zero_thm = mk_rewr @{lemma "0 * (x::real) = 0" by (rule mult_zero_left)} val mul_one_thm = mk_rewr @{lemma "1 * (x::real) = x" by (rule mult_1)} val mul_comm_thm = mk_rewr @{lemma "(x::real) * y = y * x" by simp} val mul_assocl_thm = mk_rewr @{lemma "((x::real) * y) * z = x * (y * z)" by simp} val mul_assocr_thm = mk_rewr @{lemma "(x::real) * (y * z) = (x * y) * z" by simp} val mul_divl_thm = mk_rewr @{lemma "((x::real) / y) * z = (x * z) / y" by simp} val mul_divr_thm = mk_rewr @{lemma "(x::real) * (y / z) = (x * y) / z" by simp} val div_zero_thm = mk_rewr @{lemma "0 / (x::real) = 0" by (rule div_0)} val div_one_thm = mk_rewr @{lemma "(x::real) / 1 = x" by (rule div_by_1)} val div_numl_thm = mk_rewr @{lemma "(x::real) / y = x * (1 / y)" by simp} val div_numr_thm = mk_rewr @{lemma "(x::real) / y = (1 / y) * x" by simp} val div_mull_thm = mk_rewr @{lemma "((x::real) * y) / z = x * (y / z)" by simp} val div_mulr_thm = mk_rewr @{lemma "(x::real) / (y * z) = (1 / y) * (x / z)" by simp} val div_divl_thm = mk_rewr @{lemma "((x::real) / y) / z = x / (y * z)" by simp} val div_divr_thm = mk_rewr @{lemma "(x::real) / (y / z) = (x * z) / y" by simp} val min_eq_thm = mk_rewr @{lemma "min (x::real) x = x" by (simp add: min_def)} val min_lt_thm = mk_rewr @{lemma "min (x::real) y = (if x <= y then x else y)" by (rule min_def)} val min_gt_thm = mk_rewr @{lemma "min (x::real) y = (if y <= x then y else x)"
by (simp add: min_def)} val max_eq_thm = mk_rewr @{lemma "max (x::real) x = x" by (simp add: max_def)} val max_lt_thm = mk_rewr @{lemma "max (x::real) y = (if x <= y then y else x)" by (rule max_def)} val max_gt_thm = mk_rewr @{lemma "max (x::real) y = (if y <= x then x else y)"
by (simp add: max_def)} val abs_thm = mk_rewr @{lemma "abs (x::real) = (if 0 <= x then x else -x)" by simp} val sub_eq_thm = mk_rewr @{lemma "((x::real) = y) = (x - y = 0)" by simp} val eq_le_thm = mk_rewr @{lemma "((x::real) = y) = ((x \ y) \ (y \ x))" by (rule order_eq_iff)} val add_le_thm = mk_rewr @{lemma "((x::real) \ y) = (x + n \ y + n)" by simp} val add_lt_thm = mk_rewr @{lemma "((x::real) < y) = (x + n < y + n)" by simp} val sub_le_thm = mk_rewr @{lemma "((x::real) <= y) = (x - y <= 0)" by simp} val sub_lt_thm = mk_rewr @{lemma "((x::real) < y) = (x - y < 0)" by simp} val pos_mul_le_thm = mk_rewr @{lemma "0 < n ==> ((x::real) <= y) = (n * x <= n * y)" by simp} val neg_mul_le_thm = mk_rewr @{lemma "n < 0 ==> ((x::real) <= y) = (n * y <= n * x)" by simp} val pos_mul_lt_thm = mk_rewr @{lemma "0 < n ==> ((x::real) < y) = (n * x < n * y)" by simp} val neg_mul_lt_thm = mk_rewr @{lemma "n < 0 ==> ((x::real) < y) = (n * y < n * x)" by simp} val not_le_thm = mk_rewr @{lemma "(\((x::real) \ y)) = (y < x)" by auto} val not_lt_thm = mk_rewr @{lemma "(\((x::real) < y)) = (y \ x)" by auto}
val combine_thms = @{lemma "(a::real) < b ==> c < d ==> a + c < b + d" "(a::real) < b ==> c <= d ==> a + c < b + d" "(a::real) <= b ==> c < d ==> a + c < b + d" "(a::real) <= b ==> c <= d ==> a + c <= b + d"
by auto}
fun combine thm1 thm2 = hd (Argo_Tactic.discharges thm2 (Argo_Tactic.discharges thm1 combine_thms))
¤ Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.0.16Bemerkung:
(vorverarbeitet)
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.