theory Base_Tools

  imports  "../ProgLang/ProgLang" "../Interpret/Interpret" "../BridgeLibisabelle/BridgeLibisabelle"

                                                          (*  ^^^ for KEStore_Elems.add_thes *)

begin

subsection \<open>theorems for Base_Tools\<close>

axiomatization where (*for evaluating the assumptions of conditional rules*)

(*last_thmI:	        "lastI (x#xs) = (if xs =!= [] then x else lastI xs)" and*)

  real_unari_minus:   "- a = (-1) * a" and

  radd_left_cancel_le:"((k::real) + m <= k + n) = (m <= n)" and

  (* should be in Rational.thy, but: 

   needed for asms in e.g. d2_pqformula1 in PolyEq.ML, RootEq.ML...*)

  rat_leq1:	      "[| b ~= 0; d ~= 0 |] ==>

		       ((a / b) <= (c / d)) = ((a*d) <= (b*c))"(*Isa?*) and

  rat_leq2:	      "d ~= 0 ==>

		       ( a      <= (c / d)) = ((a*d) <=    c )"(*Isa?*) and

  rat_leq3:	      "b ~= 0 ==>

		       ((a / b) <=  c     ) = ( a    <= (b*c))"(*Isa?*)

subsection \<open>setup for ML-functions\<close>

text \<open>required by "eval_binop" below\<close>

setup \<open>KEStore_Elems.add_calcs

  [ ("occurs_in", ("Atools.occurs'_in", eval_occurs_in "#occurs_in_")),

    ("some_occur_in", ("Atools.some'_occur'_in", eval_some_occur_in "#some_occur_in_")),

    ("is_atom", ("Atools.is'_atom", eval_is_atom "#is_atom_")),

    ("is_even", ("Atools.is'_even", eval_is_even "#is_even_")),

    ("is_const", ("Atools.is'_const", eval_const "#is_const_")),

    ("le", ("Orderings.ord_class.less", eval_equ "#less_")),

    ("leq", ("Orderings.ord_class.less_eq", eval_equ "#less_equal_")),

    ("ident", ("Atools.ident", eval_ident "#ident_")),

    ("equal", ("HOL.eq", eval_equal "#equal_")),

    ("PLUS", ("Groups.plus_class.plus", eval_binop "#add_")),

    ("MINUS", ("Groups.minus_class.minus", eval_binop "#sub_")),

    ("TIMES", ("Groups.times_class.times", eval_binop "#mult_")),

    ("DIVIDE", ("Rings.divide_class.divide", eval_cancel "#divide_e")),

    ("POWER",("Atools.pow", eval_binop "#power_")),

    ("boollist2sum", ("Atools.boollist2sum", eval_boollist2sum ""))]\<close>

subsection \<open>rewrite-order for rule-sets\<close>

ML \<open>

\<close> ML \<open>

local

  open Term;

in

  fun termlessI (_: Rule.subst) uv = LibraryC.termless uv;

  fun term_ordI (_: Rule.subst) uv = Term_Ord.term_ord uv;

end;

\<close> ML \<open>

(*TODO.WN0509 reduce ids: tless_true = e_rew_ord' = Rule.e_rew_ord = Rule.dummy_ord*)

val tless_true = Rule.dummy_ord;

Rule.rew_ord' := overwritel (! Rule.rew_ord', (*<<<---- use KEStore.xxx here, too*)

			[("tless_true", tless_true),

			 ("e_rew_ord'", tless_true),

			 ("dummy_ord", Rule.dummy_ord)]);

\<close>

subsection \<open>rule-sets\<close>

ML \<open>

\<close> ML \<open>

val Atools_erls = Rule.append_rls "Atools_erls" Rule.e_rls

  [ Rule.Calc ("HOL.eq", eval_equal "#equal_"),

    Rule.Thm ("not_true", TermC.num_str @{thm not_true}),

		(*"(~ True) = False"*)

		Rule.Thm ("not_false", TermC.num_str @{thm not_false}),

		(*"(~ False) = True"*)

		Rule.Thm ("and_true", TermC.num_str @{thm and_true}),

		(*"(?a & True) = ?a"*)

		Rule.Thm ("and_false", TermC.num_str @{thm and_false}),

		(*"(?a & False) = False"*)

		Rule.Thm ("or_true", TermC.num_str @{thm or_true}),

		(*"(?a | True) = True"*)

		Rule.Thm ("or_false", TermC.num_str @{thm or_false}),

		(*"(?a | False) = ?a"*)

		Rule.Thm ("rat_leq1", TermC.num_str @{thm rat_leq1}),

		Rule.Thm ("rat_leq2", TermC.num_str @{thm rat_leq2}),

		Rule.Thm ("rat_leq3", TermC.num_str @{thm rat_leq3}),

      Rule.Thm ("refl", TermC.num_str @{thm refl}),

		Rule.Thm ("order_refl", TermC.num_str @{thm order_refl}),

		Rule.Thm ("radd_left_cancel_le", TermC.num_str @{thm radd_left_cancel_le}),

		Rule.Calc ("Orderings.ord_class.less", eval_equ "#less_"),

		Rule.Calc ("Orderings.ord_class.less_eq", eval_equ "#less_equal_"),

		Rule.Calc ("Atools.ident", eval_ident "#ident_"),    

		Rule.Calc ("Atools.is'_const", eval_const "#is_const_"),

		Rule.Calc ("Atools.occurs'_in", eval_occurs_in ""),    

		Rule.Calc ("Tools.matches", Tools.eval_matches "")];

\<close>

ML \<open>

val Atools_crls = Rule.append_rls "Atools_crls" Rule.e_rls

  [ Rule.Calc ("HOL.eq", eval_equal "#equal_"),

    Rule.Thm ("not_true", TermC.num_str @{thm not_true}),

		Rule.Thm ("not_false", TermC.num_str @{thm not_false}),

		Rule.Thm ("and_true", TermC.num_str @{thm and_true}),

		Rule.Thm ("and_false", TermC.num_str @{thm and_false}),

		Rule.Thm ("or_true", TermC.num_str @{thm or_true}),

		Rule.Thm ("or_false", TermC.num_str @{thm or_false}),

		Rule.Thm ("rat_leq1", TermC.num_str @{thm rat_leq1}),

		Rule.Thm ("rat_leq2", TermC.num_str @{thm rat_leq2}),

		Rule.Thm ("rat_leq3", TermC.num_str @{thm rat_leq3}),

		Rule.Thm ("refl", TermC.num_str @{thm refl}),

		Rule.Thm ("order_refl", TermC.num_str @{thm order_refl}),

		Rule.Thm ("radd_left_cancel_le", TermC.num_str @{thm radd_left_cancel_le}),

		Rule.Calc ("Orderings.ord_class.less", eval_equ "#less_"),

		Rule.Calc ("Orderings.ord_class.less_eq", eval_equ "#less_equal_"),

		Rule.Calc ("Atools.ident", eval_ident "#ident_"),    

		Rule.Calc ("Atools.is'_const", eval_const "#is_const_"),

		Rule.Calc ("Atools.occurs'_in", eval_occurs_in ""),    

		Rule.Calc ("Tools.matches", Tools.eval_matches "")];

\<close>

subsection \<open>ONCE AGAIN extend rule-set for evaluating pre-conditions and program-expressions\<close>

text \<open>requires "eval_binop" from above\<close>

ML \<open>

val list_rls = Rule.append_rls "list_rls" list_rls

	[ Rule.Calc ("Groups.times_class.times",eval_binop "#mult_"),

		Rule.Calc ("Groups.plus_class.plus", eval_binop "#add_"), 

		Rule.Calc ("Orderings.ord_class.less",eval_equ "#less_"),

		Rule.Calc ("Orderings.ord_class.less_eq",eval_equ "#less_equal_"),

		Rule.Calc ("Atools.ident",eval_ident "#ident_"),

		Rule.Calc ("HOL.eq",eval_equal "#equal_"),(*atom <> atom -> False*)

		Rule.Calc ("Tools.Vars",Tools.eval_var "#Vars_"),

		Rule.Thm ("if_True",TermC.num_str @{thm if_True}),

		Rule.Thm ("if_False",TermC.num_str @{thm if_False})];

val list_rls = LTool.prep_rls @{theory} (Rule.merge_rls "list_erls"

	(Rule.Rls {id = "replaced", preconds = [], rew_ord = ("termlessI", termlessI),

    erls = Rule.Rls {id = "list_elrs", preconds = [], rew_ord = ("termlessI", termlessI), 

    erls = Rule.e_rls, srls = Rule.Erls, calc = [], errpatts = [],

    rules = [Rule.Calc ("Groups.plus_class.plus", eval_binop "#add_"),

      Rule.Calc ("Orderings.ord_class.less", eval_equ "#less_")

      (*    ~~~~~~ for nth_Cons_*)],

    scr = Rule.EmptyScr},

    srls = Rule.Erls, calc = [], errpatts = [],

    rules = [], scr = Rule.EmptyScr})

  list_rls);

\<close>

subsection \<open>setup for extended rule-set\<close>

setup \<open>KEStore_Elems.add_rlss

  [("list_rls", (Context.theory_name @{theory}, LTool.prep_rls @{theory} list_rls))]\<close>

end