(*
   Author: Mike Stannett
   Date: 22 October 2012
   m.stannett@sheffield.ac.uk
   Updated 28 April 2016 to run under Isabelle2016.
*)
theory SpecRel
imports Axioms
begin

class SpecRel = WorldView + AxPh + AxEv + AxSelf + AxSym
(*
  The following proof  assumes that the quantity field is Euclidean. It
  may be possible to produce a proof without this constraint.
*)

  + AxEuclidean

(*
  We also assume for now that lines, planes and lightcones are
  preserved by the worldview transformation.
*)

  + AxLines + AxPlanes + AxCones

begin

(* *******************************************************************
*                                                                    *
*     THEOREM:                                                       *
*     No inertial observer can move faster than light.               *
*                                                                    *
** **************************************************************** *)

  lemma lemZEG:
    shows "z - e = g - e + (z - g)"
  proof -
    have  "g - e + (z - g) = (g - e + z) - g" by (rule add_diff_eq)
    also have "(g - e + z) - g = (-e + z)"
      by (metis local.diff_add_cancel
                local.ring_normalization_rules(2)
                local.semiring_normalization_rules(24)
                local.semiring_normalization_rules(25))
    thus ?thesis
      by (simp add: calculation)
  qed

lemma noFTLObserver:
  assumes iobm:  "IOb m"
  and     iobk:  "IOb k"
  and     mke:   "m sees k at e"
  and     mkf:   "m sees k at f"
  and     enotf: "e \<noteq> f"
shows     "space2 e f \<le> (c m * c m) * time2 e f"
proof -  (* by reductio *)

(* Step 1: Suppose k is going FTL from m's viewpoint. *)
{
  assume converse: "space2 e f > (c m * c m) * time2 e f"

(* Step 2: Consider the m-lightcone at e *)
  define eCone where "eCone = mkCone e (c m)"
  have e_on_econe: "onCone e eCone" by (simp add: eCone_def)

(* Step 3: There is a tangent plane for eCone containing both e and f,
   defined using some point g on the tangent line  *)

  have e_is_vertex: "e = vertex eCone" by (simp add: eCone_def)
  have cm_is_slope: "c m = slope eCone" by (simp add: eCone_def)
  hence outside: "outsideCone f eCone"
    by (metis (lifting) e_is_vertex cm_is_slope converse outsideCone.simps)

  have "outsideCone f eCone
    \<longrightarrow> (\<exists>x.(onCone x eCone \<and> x \<noteq> vertex eCone \<and> inPlane f (tangentPlane x eCone)))"
    by (rule AxParallelConesE)

  hence tplane_exists: "\<exists>x.(onCone x eCone \<and> x \<noteq> vertex eCone \<and> inPlane f (tangentPlane x eCone))"
    by (metis outside)
  then obtain g where g_props: "(onCone g eCone \<and> g \<noteq> vertex eCone \<and> inPlane f (tangentPlane g eCone))"
    by auto
  have g_on_eCone: "onCone g eCone" by (metis g_props)
  have g_not_vertex: "g \<noteq> vertex eCone" by (metis g_props)

  define tplane where "tplane = tangentPlane g eCone"
  have e_in_tplane: "inPlane e tplane" by (metis AxTangentVertex e_is_vertex tplane_def)
  have f_in_tplane: "inPlane f tplane" by (metis g_props tplane_def)
  have g_in_tplane: "inPlane g tplane" by (metis lemPlaneContainsBasePoint tplane_def AxTangentBase)

  (* We'll need to show that e-f-g aren't collinear *)
  have "(onCone g eCone) \<longrightarrow>
                  ((inPlane f (tangentPlane g eCone) \<and> onCone f eCone)
                                                           \<longleftrightarrow> collinear (vertex eCone) g f)"
    by (metis AxConeTangent)
  hence axconetangent: "collinear e g f \<longrightarrow> onCone f eCone"
    by (metis g_on_eCone e_is_vertex)
  have "\<not>(onCone f eCone)" by (metis outside lemOutsideNotOnCone)
  hence g_not_collinear: "\<not> (collinear e g f)"
    by (metis axconetangent)

(* Step 4: k considers wvte and wvtf to be distinct points on the t-axis, and wvtg is off
           k's t-axis. *)

  define wvte where "wvte = wvt k m e"
  define wvtf where "wvtf = wvt k m f"
  define wvtg where "wvtg = wvt k m g"

  have "W k k wvte" by (metis wvte_def AxWVT mke iobm iobk)
  hence wvte_onAxis: "onAxisT wvte" by (metis AxSelf iobk)

  have "W k k wvtf" by (metis wvtf_def AxWVT mkf iobm iobk)
  hence wvtf_onAxis: "onAxisT wvtf" by (metis AxSelf iobk)

  have wvte_inv: "e = wvt m k wvte" by (metis AxWVTSym iobk iobm wvte_def)
  have wvtf_inv: "f = wvt m k wvtf" by (metis AxWVTSym iobk iobm wvtf_def)
  have wvtg_inv: "g = wvt m k wvtg" by (metis AxWVTSym iobk iobm wvtg_def)

  have e_not_g: "e \<noteq> g" by (metis e_is_vertex g_not_vertex)
  have f_not_g: "f \<noteq> g" by (metis outside lemOutsideNotOnCone g_on_eCone)

  have wvt_e_not_f: "wvte \<noteq> wvtf" by (metis wvte_inv wvtf_inv enotf)
  have wvt_f_not_g: "wvtf \<noteq> wvtg" by (metis wvtf_inv wvtg_inv f_not_g)
  have wvt_g_not_e: "wvtg \<noteq> wvte" by (metis wvtg_inv wvte_inv e_not_g)

  have if_g_onAxis:  "onAxisT wvtg \<longrightarrow> collinear wvte wvtg wvtf"
    by (metis lemAxisIsLine wvte_onAxis wvtf_onAxis wvt_e_not_f wvt_f_not_g wvt_g_not_e)

  have "collinear wvte wvtg wvtf \<longrightarrow> collinear e g f"
    by (metis AxLines iobm iobk wvte_inv wvtf_inv wvtg_inv)
  hence "onAxisT wvtg \<longrightarrow> collinear e g f" by (metis if_g_onAxis)

  hence wvtg_offAxis: "\<not> (onAxisT wvtg)" by (metis g_not_collinear)

(* Step 5: There is a point z with various contradictory properties. *)

  have "\<forall>s.(\<exists>p.( collinear wvte wvtg p \<and> (space2 p wvtf = (s*s)*time2 p wvtf)))"
    by (metis AxSlopedLineInVerticalPlane wvte_onAxis wvtf_onAxis wvtg_offAxis wvt_e_not_f)
  hence exists_wvtz: "\<exists>p.( collinear wvte wvtg p \<and> (space2 p wvtf = (c k * c k)*time2 p wvtf))"
    by metis
  then obtain wvtz where
    wvtz_props: "collinear wvte wvtg wvtz \<and> (space2 wvtz wvtf = (c k * c k)*time2 wvtz wvtf)" by auto
  hence wvtf_speed: "space2 wvtz wvtf = (c k * c k)*time2 wvtz wvtf" by metis

  define z where "z = wvt m k wvtz"
  define wvtzCone where "wvtzCone = lightcone k wvtz"

  have wvtz_is_vertex: "wvtz = vertex wvtzCone" by (simp add: wvtzCone_def)
  have ck_is_slope: "c k = slope wvtzCone" by (simp add: wvtzCone_def)
  hence "space2 (vertex wvtzCone) wvtf = ((slope wvtzCone) *(slope wvtzCone))*time2 (vertex wvtzCone) wvtf"
    by (metis wvtf_speed wvtz_is_vertex ck_is_slope)
  hence "onCone wvtf wvtzCone" by (metis onCone.simps)

  hence wvtf_on_wvtzCone: "onCone (wvt m k wvtf) (lightcone m z)"
    by (metis iobm iobk AxCones wvtzCone_def z_def)

  (* f is on the lightcone at z *)
  define zCone where "zCone = lightcone m z"
  have z_is_vertex: "z = vertex zCone" by (simp add: zCone_def)
  have cm_is_zSlope: "c m = slope zCone" by (simp add: zCone_def)

  have f_on_zCone: "onCone f zCone" by (metis wvtf_inv wvtf_on_wvtzCone zCone_def)

  (* whence z is on the lightcone at f *)
  hence "space2 (vertex zCone) f = (slope zCone * slope zCone)*time2 (vertex zCone) f"
    by (simp add: zCone_def)
  hence "space2 z f = (c m * c m)*time2 z f" by (metis z_is_vertex cm_is_zSlope)
  hence fz_speed: "space2 f z = (c m * c m)*time2 f z" by (metis lemSpace2Sym lemTime2Sym)

  define fCone where "fCone = lightcone m f"

  have f_is_fVertex: "f = vertex fCone" by (simp add: fCone_def)
  have cm_is_fSlope: "c m = slope fCone" by (simp add: fCone_def)
  hence "space2 (vertex fCone) z = ((slope fCone) *(slope fCone))*time2 (vertex fCone) z"
    by (metis fz_speed f_is_fVertex cm_is_fSlope)
  hence z_on_fCone: "onCone z fCone" by (metis onCone.simps)

  (* z is also on the lightcone at e, as well as in the tangent plane at g *)
  have "collinear wvte wvtg wvtz" by (metis wvtz_props)
  hence egz_collinear: "collinear e g z" by (metis wvte_inv wvtg_inv z_def AxLines iobm iobk)
  hence z_geometry: "(inPlane z (tangentPlane g eCone) \<and> onCone z eCone)"
    by (metis AxConeTangent e_is_vertex g_on_eCone)

  have z_on_eCone: "onCone z eCone" by (metis z_geometry)
  have z_in_tplane: "inPlane z tplane" by (metis z_geometry tplane_def)

  hence z_not_f: "z \<noteq> f" by (metis z_on_eCone outside lemOutsideNotOnCone)
  hence z_not_fVertex: "z \<noteq> vertex fCone" by (simp add: fCone_def z_not_f)

  {
    assume assm: "z = e"
    have "space2 f e = (c m * c m)*time2 f e \<and> space2 f e = space2 e f \<and> time2 f e = time2 e f"
     by (metis lemSpace2Sym lemTime2Sym fz_speed assm)
    hence "space2 e f = (c m * c m)*time2 e f" by metis
    hence "False" by (metis less_irrefl converse)
  }
  from this have z_not_e: "z \<noteq> e" by blast

  (* but the lines e-z and f-z must be parallel *)

  define lineA where "lineA = lineJoining e z"
  define lineB where "lineB = lineJoining f z"

  {
    assume assm: "direction lineA = vecZero"
    have lemnullline: "(direction lineA = vecZero \<and> inLine z lineA) \<longrightarrow> z = basepoint lineA"
      by (metis lemNullLine)
    have "inLine z lineA" by (metis lineA_def lemLineContainsEndpoint)
    hence z_is_bp: "z = basepoint lineA" by (metis lemnullline assm)
    have "basepoint lineA = e" by (simp add: lineA_def)
    hence "False" by (metis z_is_bp z_not_e)
  }
  from this have ez_not_null: "direction lineA \<noteq> vecZero" by blast

  {
    assume assm: "direction lineB = vecZero"
    have lemnullline: "(direction lineB = vecZero \<and> inLine z lineB) \<longrightarrow> z = basepoint lineB"
      by (metis lemNullLine)
    have "inLine z lineB" by (metis lineB_def lemLineContainsEndpoint)
    hence z_is_bp: "z = basepoint lineB" by (metis lemnullline assm)
    have "basepoint lineB = f" by (simp add: lineB_def)
    hence "False" by (metis z_is_bp z_not_f)
  }
  from this have fz_not_null: "direction lineB \<noteq> vecZero" by blast

  {
    have "samePlane tplane (tangentPlane z fCone)
           \<and> ((lineJoining e g) \<parallel> (lineJoining f z))"
    by (metis AxParallelCones tplane_def
              g_on_eCone g_not_vertex z_on_fCone z_not_fVertex z_in_tplane
              e_is_vertex f_is_fVertex)

    hence eg_par_fz: "(lineJoining e g) \<parallel> (lineJoining f z)" by metis
    {
      assume case1: "direction (lineJoining e g) = vecZero"
      have "direction (lineJoining e g) = from e to g" by simp
      hence "from e to g = vecZero" by (metis case1)
      hence "e = g" by (simp)
      hence "False" by (metis e_not_g)
    }
    from this have eg_not_null: "\<not>(direction (lineJoining e g) = vecZero)" by blast
    then obtain a where a_props: "a \<noteq> 0 \<and> direction (lineJoining f z) = a**direction (lineJoining e g)"
      by (metis fz_not_null eg_not_null eg_par_fz parallel.simps lineB_def)
    hence f_to_z: "from f to z = a**(from e to g)" by simp
    have a_nonzero: "a \<noteq> 0" by (metis a_props)

    have eg_dir: "from e to g = direction (lineJoining e g)" by simp
    have gz_dir: "from g to z = direction (lineJoining g z)" by simp
    have egz: "z = g \<leadsto> (from g to z)" by (metis lemLineEndpoint)
    hence "collinear e g (g \<leadsto> (from g to z))" by (metis egz_collinear)
    then obtain b where e_to_g: "from e to g = (-b)**(from g to z)"
      by (metis lemDirectionCollinear)

    {
      assume assm: "-b = 0"
      have "from e to g = (-b)**(from g to z)" by (metis e_to_g)
      hence "from e to g = vecZero" by (simp add: assm)
      hence "direction (lineJoining e g) = vecZero" by (simp)
      hence "False" by (metis eg_not_null lineA_def)
    }
    from this have b_nonzero: "-b \<noteq> 0" by blast

    define binv where "binv = inverse (-b)"
    define factor where "factor = 1+binv"
    have binv_nonzero: "binv \<noteq> 0" by (metis b_nonzero add.comm_neutral binv_def nonzero_imp_inverse_nonzero right_minus)

    have "from e to g = (-b)**(from g to z)" by (metis e_to_g)
    hence g_to_z: "(from g to z) = binv**(from e to g)"
      by (metis b_nonzero lemScaleInverse binv_def)

    have "from e to z = from e to g \<oplus> from g to z"
      by (simp add: lemZEG)

    hence "from e to z = (from e to g) \<oplus> binv**(from e to g)" by (metis g_to_z)
    hence e_to_z: "from e to z = factor**(from e to g)" by (metis lemAddOverScale lemScale1 factor_def)
    have ez_dir: "direction (lineJoining e z) = from e to z" by simp
    have eg_dir: "direction (lineJoining e g) = from e to g" by simp

    {
      assume assm: "factor = 0"
      have "from e to z = factor**(from e to g)" by (metis e_to_z)
      hence "from e to z = vecZero" by (simp add: assm)
      hence "direction (lineJoining e z) = vecZero" by (simp)
      hence "False" by (metis ez_not_null lineA_def)
    }
    from this have factor_nonzero: "factor \<noteq> 0" by blast

    have "direction (lineJoining e z) = factor**(direction (lineJoining e g))"
      by (metis e_to_z ez_dir eg_dir)
    hence "(lineJoining e g) \<parallel> (lineJoining e z)" by (metis parallel.simps factor_nonzero)
    hence "(lineJoining e z) \<parallel> (lineJoining e g)" by (metis lemParallelSym)

    hence "(lineJoining e z) \<parallel> (lineJoining f z)" by (metis lemParallelTrans eg_par_fz eg_not_null)
  }
  from this have A_par_B: "lineA \<parallel> lineB" by (metis lineA_def lineB_def)

  (* which is impossible because this means they are distinct parallel lines that meet *)

  have e_in_lineA: "inLine e lineA" by (metis lineA_def lemLineContainsBasepoint)

  {
    have basic: "\<forall>a b.(((-a)*b)*((-a)*b) = (a*a)*(b*b))"
      by (metis equation_minus_iff minus_mult_commute minus_mult_right
                semiring_normalization_rules(17) semiring_normalization_rules(19))

    assume assm: "inLine e lineB"
    hence coll: "collinear e f (f \<leadsto> direction lineB)" by (simp add: lineB_def)
    then obtain \<beta> where props: "from e to f = (-\<beta>)**(direction lineB)"
      by (metis lemDirectionCollinear)

    hence "tval f - tval e = (-\<beta>)*(tval z - tval f) \<and> xval f - xval e = (-\<beta>)*(xval z - xval f)
        \<and> yval f - yval e = (-\<beta>)*(yval z - yval f) \<and> zval f - zval e = (-\<beta>)*(zval z - zval f)"
      by (simp add: lineB_def)
    hence speeds: "time2 f e = (\<beta>*\<beta>)*time2 z f \<and> space2 f e = (\<beta>*\<beta>)*space2 z f"
      apply (simp add: basic) apply auto
      apply (metis semiring_normalization_rules(18) semiring_normalization_rules(19))
      by (metis semiring_normalization_rules(18) semiring_normalization_rules(19)
                semiring_normalization_rules(34))

    have "space2 f z = (c m * c m)*time2 f z" by (metis fz_speed)
    hence "space2 z f = (c m * c m)*time2 z f" by (metis lemSpace2Sym lemTime2Sym)
    hence "space2 f e = ((\<beta>*\<beta>)*(c m * c m))*time2 z f" by (metis speeds mult.assoc)
    hence "space2 f e = (c m * c m)*(\<beta>*\<beta>)*time2 z f" by (metis mult.assoc mult.commute)
    hence "space2 f e = (c m * c m)*time2 f e" by (metis mult.assoc speeds)
    hence "space2 e f = (c m * c m)*time2 e f" by (metis lemSpace2Sym lemTime2Sym)
    hence "False" by (metis less_irrefl converse)
  }
  from this have e_not_in_lineB: "\<not>(inLine e lineB)" by blast

  have "inLine z lineA \<and> inLine z lineB" by (metis lemLineContainsEndpoint lineA_def lineB_def)
  hence A_meets_B: "meets lineA lineB" by auto

  hence "False" by (metis A_par_B ez_not_null fz_not_null e_in_lineA e_not_in_lineB lemParallelNotMeet)
  }
  from this have "\<not> (space2 e f > (c m * c m) * time2 e f)" by blast

  thus ?thesis by simp
qed

end

end


theory T154
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(x, join(y, z)) = join(undr(x, y), undr(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(x, meet(y, z)) = join(over(x, y), over(x, z)))
"
nitpick[card nat=8,timeout=86400]
oops
end


theory Basics_Vectors3D_E1
imports "$HETS_LIB/Isabelle/MainHCPairs"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"binary_inverse\", \"antisym\", \"refl\", \"trans\",
     \"subtype_def\", \"subtype_pred_def\", \"ga_assoc___Xx__\",
     \"ga_right_unit___Xx__\", \"ga_left_unit___Xx__\", \"inv_Group\",
     \"rinv_Group\", \"ga_comm___Xx__\", \"ga_assoc___Xx___1\",
     \"ga_right_unit___Xx___1\", \"ga_left_unit___Xx___1\",
     \"distr1_Ring\", \"distr2_Ring\", \"left_zero\", \"right_zero\",
     \"ga_comm___Xx___1\", \"noZeroDiv\", \"zeroNeqOne\", \"Ax1\",
     \"ga_assoc___Xx___2\", \"ga_right_unit___Xx___2\",
     \"ga_left_unit___Xx___2\", \"inv_Group_1\", \"rinv_Group_1\",
     \"binary_inverse_1\", \"Ax1_1\", \"refl_1\", \"trans_1\",
     \"antisym_1\", \"dichotomy_TotalOrder\", \"FWO_plus_left\",
     \"FWO_times_left\", \"FWO_plus_right\", \"FWO_times_right\",
     \"FWO_plus\", \"inf_def\", \"Real_completeness\",
     \"geq_def_ExtPartialOrder\", \"less_def_ExtPartialOrder\",
     \"greater_def_ExtPartialOrder\", \"ga_comm_inf\", \"ga_comm_sup\",
     \"inf_def_ExtPartialOrder\", \"sup_def_ExtPartialOrder\",
     \"ga_comm_min\", \"ga_comm_max\", \"ga_assoc_min\",
     \"ga_assoc_max\", \"ga_left_comm_min\", \"ga_left_comm_max\",
     \"min_def_ExtTotalOrder\", \"max_def_ExtTotalOrder\",
     \"min_inf_relation\", \"max_sup_relation\",
     \"RealNonNeg_pred_def\", \"RealPos_pred_def\", \"Ax3\", \"Ax4\",
     \"RealNonNeg_subtype\", \"RealPos_subtype\", \"abs_def\",
     \"times_cancel_right_nonneg_leq\", \"times_leq_nonneg_cond\",
     \"sqr_def\", \"sqrt_def\", \"Pos_def\", \"X2_def_Real\",
     \"X3_def_Real\", \"X4_def_Real\", \"X5_def_Real\", \"X6_def_Real\",
     \"X7_def_Real\", \"X8_def_Real\", \"X9_def_Real\",
     \"ZeroToNine_type\", \"decimal_def\", \"ga_select_C1\",
     \"ga_select_C2\", \"ga_select_C3\", \"Zero_Vector\",
     \"VectorStar_pred_def\", \"Ax7\", \"VectorStar_subtype\",
     \"def_of_vector_addition\", \"def_of_minus_vector\",
     \"binary_inverse_2\", \"scalar_multiplication\",
     \"scalar_product\", \"vector_product\", \"ONB1\", \"ONB2\",
     \"ONB3\", \"cross_left_homogenity\",
     \"cross_product_antisymmetric\"]"

typedecl NonZero
typedecl Real
typedecl RealNonNeg
typedecl RealPos
typedecl VectorStar
typedecl ZeroToNine

datatype Vector = X_V "Real" "Real" "Real" ("V/'(_,/ _,/ _')" [3,3,3] 999)

consts
X0X1 :: "Real" ("0''")
X0X2 :: "Vector" ("0''''")
X1X1 :: "NonZero" ("1''")
X1X2 :: "Real" ("1''''")
X2 :: "Real" ("2''")
X3 :: "Real" ("3''")
X4 :: "Real" ("4''")
X5 :: "Real" ("5''")
X6 :: "Real" ("6''")
X7 :: "Real" ("7''")
X8 :: "Real" ("8''")
X9 :: "Real" ("9''")
XMinus__XX1 :: "Real => Real" ("(-''/ _)" [56] 56)
XMinus__XX2 :: "Vector => Vector" ("(-''''/ _)" [56] 56)
X_C1 :: "Vector => Real" ("C1/'(_')" [3] 999)
X_C2 :: "Vector => Real" ("C2/'(_')" [3] 999)
X_C3 :: "Vector => Real" ("C3/'(_')" [3] 999)
X_Pos :: "Real => bool" ("Pos/'(_')" [3] 999)
X_RealNonNeg_inj :: "RealNonNeg => Real" ("RealNonNeg'_inj/'(_')" [3] 999)
X_RealNonNeg_pred :: "Real => bool" ("RealNonNeg'_pred/'(_')" [3] 999)
X_RealNonNeg_proj :: "Real => RealNonNeg" ("RealNonNeg'_proj/'(_')" [3] 999)
X_RealPos_inj :: "RealPos => Real" ("RealPos'_inj/'(_')" [3] 999)
X_RealPos_pred :: "Real => bool" ("RealPos'_pred/'(_')" [3] 999)
X_RealPos_proj :: "Real => RealPos" ("RealPos'_proj/'(_')" [3] 999)
X_VectorStar_inj :: "VectorStar => Vector" ("VectorStar'_inj/'(_')" [3] 999)
X_VectorStar_pred :: "Vector => bool" ("VectorStar'_pred/'(_')" [3] 999)
X_VectorStar_proj :: "Vector => VectorStar" ("VectorStar'_proj/'(_')" [3] 999)
X__XAtXAt__X :: "ZeroToNine => Real => Real" ("(_/ @@/ _)" [54,54] 52)
X__XGtXEq__X :: "Real => Real => bool" ("(_/ >=''/ _)" [44,44] 42)
X__XGt__X :: "Real => Real => bool" ("(_/ >''/ _)" [44,44] 42)
X__XHash__X :: "Vector => Vector => Vector" ("(_/ #''/ _)" [54,54] 52)
X__XLtXEq__X :: "Real => Real => bool" ("(_/ <=''/ _)" [44,44] 42)
X__XLt__X :: "Real => Real => bool" ("(_/ <''/ _)" [44,44] 42)
X__XMinus__XX1 :: "Real => Real => Real" ("(_/ -''/ _)" [54,54] 52)
X__XMinus__XX2 :: "Vector => Vector => Vector" ("(_/ -''''/ _)" [54,54] 52)
X__XPlus__XX1 :: "Real => Real => Real" ("(_/ +''/ _)" [54,54] 52)
X__XPlus__XX2 :: "Vector => Vector => Vector" ("(_/ +''''/ _)" [54,54] 52)
X__XSlash__X :: "Real => NonZero => Real" ("(_/ '/''/ _)" [54,54] 52)
X__Xx__XX1 :: "NonZero => NonZero => NonZero" ("(_/ *''/ _)" [54,54] 52)
X__Xx__XX2 :: "Real => Real => Real" ("(_/ *''''/ _)" [54,54] 52)
X__Xx__XX3 :: "Real => Vector => Vector" ("(_/ *'_3/ _)" [54,54] 52)
X__Xx__XX4 :: "Vector => Vector => Real" ("(_/ *'_4/ _)" [54,54] 52)
X_abs :: "Real => RealNonNeg" ("abs''/'(_')" [3] 999)
X_gn_inj :: "'a => 'b" ("gn'_inj/'(_')" [3] 999)
X_gn_proj :: "'a => 'b partial" ("gn'_proj/'(_')" [3] 999)
X_inv :: "NonZero => NonZero" ("inv''/'(_')" [3] 999)
X_isSubtype :: "('s => 't) => ('t => 's) => bool" ("isSubtype/'(_,/ _')" [3,3] 999)
X_isSubtypeWithPred :: "('t => bool) => ('s => 't) => ('t => 's) => bool" ("isSubtypeWithPred/'(_,/ _,/ _')" [3,3,3] 999)
X_max :: "Real => Real => Real" ("max''/'(_,/ _')" [3,3] 999)
X_min :: "Real => Real => Real" ("min''/'(_,/ _')" [3,3] 999)
X_sqr :: "Real => RealNonNeg" ("sqr/'(_')" [3] 999)
X_sqrt :: "RealNonNeg => RealNonNeg" ("sqrt/'(_')" [3] 999)
X_sup :: "Real => Real => Real partial" ("sup/'(_,/ _')" [3,3] 999)
e1 :: "Vector"
e2 :: "Vector"
e3 :: "Vector"
infX1 :: "Real => Real => Real partial" ("inf''/'(_,/ _')" [3,3] 999)
infX2 :: "(Real => bool) => Real partial" ("inf''''/'(_')" [3] 999)

axioms
binary_inverse [rule_format] :
"ALL x. ALL y. x /' y = x *'' inv'(y)"

antisym [rule_format] :
"ALL x. ALL y. __~__ x y & __~__ y x --> x = y"

refl [rule_format] : "ALL x. __~__ x x"

trans [rule_format] :
"ALL x. ALL y. ALL z. __~__ x y & __~__ y z --> __~__ x z"

subtype_def [rule_format] :
"ALL injection.
 ALL projection.
 isSubtype(injection, projection) =
 (ALL x. x = projection (injection x))"

subtype_pred_def [rule_format] :
"ALL P.
 ALL injection.
 ALL projection.
 isSubtypeWithPred(P, injection, projection) =
 ((isSubtype(injection, projection) &
   (ALL x. P x --> x = injection (projection x))) &
  (ALL x. P (injection x)))"

ga_assoc___Xx__ [rule_format] :
"ALL x. ALL y. ALL z. (x +' y) +' z = x +' (y +' z)"

ga_right_unit___Xx__ [rule_format] : "ALL x. x +' 0' = x"

ga_left_unit___Xx__ [rule_format] : "ALL x. 0' +' x = x"

inv_Group [rule_format] : "ALL x. -' x +' x = 0'"

rinv_Group [rule_format] : "ALL x. x +' -' x = 0'"

ga_comm___Xx__ [rule_format] : "ALL x. ALL y. x +' y = y +' x"

ga_assoc___Xx___1 [rule_format] :
"ALL x. ALL y. ALL z. (x *'' y) *'' z = x *'' (y *'' z)"

ga_right_unit___Xx___1 [rule_format] : "ALL x. x *'' 1'' = x"

ga_left_unit___Xx___1 [rule_format] : "ALL x. 1'' *'' x = x"

distr1_Ring [rule_format] :
"ALL x. ALL y. ALL z. (x +' y) *'' z = (x *'' z) +' (y *'' z)"

distr2_Ring [rule_format] :
"ALL x. ALL y. ALL z. z *'' (x +' y) = (z *'' x) +' (z *'' y)"

left_zero [rule_format] : "ALL x. 0' *'' x = 0'"

right_zero [rule_format] : "ALL x. x *'' 0' = 0'"

ga_comm___Xx___1 [rule_format] : "ALL x. ALL y. x *'' y = y *'' x"

noZeroDiv [rule_format] :
"ALL x. ALL y. x *'' y = 0' --> x = 0' | y = 0'"

zeroNeqOne [rule_format] : "~ 1'' = 0'"

Ax1 [rule_format] : "ALL x. defOp (gn_proj(x)) = (~ x = 0')"

ga_assoc___Xx___2 [rule_format] :
"ALL x. ALL y. ALL z. (x *' y) *' z = x *' (y *' z)"

ga_right_unit___Xx___2 [rule_format] : "ALL x. x *' 1' = x"

ga_left_unit___Xx___2 [rule_format] : "ALL x. 1' *' x = x"

inv_Group_1 [rule_format] : "ALL x. inv'(x) *' x = 1'"

rinv_Group_1 [rule_format] : "ALL x. x *' inv'(x) = 1'"

binary_inverse_1 [rule_format] : "ALL x. ALL y. x -' y = x +' -' y"

Ax1_1 [rule_format] :
"ALL x. ALL y. x /' y = x *'' gn_inj(inv'(y))"

refl_1 [rule_format] : "ALL x. x <=' x"

trans_1 [rule_format] :
"ALL x. ALL y. ALL z. x <=' y & y <=' z --> x <=' z"

antisym_1 [rule_format] :
"ALL x. ALL y. x <=' y & y <=' x --> x = y"

dichotomy_TotalOrder [rule_format] :
"ALL x. ALL y. x <=' y | y <=' x"

FWO_plus_left [rule_format] :
"ALL a. ALL b. ALL c. a <=' b --> a +' c <=' b +' c"

FWO_times_left [rule_format] :
"ALL a. ALL b. ALL c. a <=' b & 0' <=' c --> a *'' c <=' b *'' c"

FWO_plus_right [rule_format] :
"ALL a. ALL b. ALL c. b <=' c --> a +' b <=' a +' c"

FWO_times_right [rule_format] :
"ALL a. ALL b. ALL c. b <=' c & 0' <=' a --> a *'' b <=' a *'' c"

FWO_plus [rule_format] :
"ALL a.
 ALL b. ALL c. ALL d. a <=' c & b <=' d --> a +' b <=' c +' d"

inf_def [rule_format] :
"ALL S.
 ALL m.
 inf''(S) = makePartial m =
 (ALL m2. (ALL x. S x --> x <=' m2) --> m <=' m2)"

Real_completeness [rule_format] :
"ALL S.
 (EX x. S x) & (EX B. ALL x. S x --> x <=' B) -->
 (EX m. makePartial m = inf''(S))"

geq_def_ExtPartialOrder [rule_format] :
"ALL x. ALL y. (x >=' y) = (y <=' x)"

less_def_ExtPartialOrder [rule_format] :
"ALL x. ALL y. (x <' y) = (x <=' y & ~ x = y)"

greater_def_ExtPartialOrder [rule_format] :
"ALL x. ALL y. (x >' y) = (y <' x)"

ga_comm_inf [rule_format] : "ALL x. ALL y. inf'(x, y) = inf'(y, x)"

ga_comm_sup [rule_format] : "ALL x. ALL y. sup(x, y) = sup(y, x)"

inf_def_ExtPartialOrder [rule_format] :
"ALL x.
 ALL y.
 ALL z.
 inf'(x, y) = makePartial z =
 (z <=' x & z <=' y & (ALL t. t <=' x & t <=' y --> t <=' z))"

sup_def_ExtPartialOrder [rule_format] :
"ALL x.
 ALL y.
 ALL z.
 sup(x, y) = makePartial z =
 (x <=' z & y <=' z & (ALL t. x <=' t & y <=' t --> z <=' t))"

ga_comm_min [rule_format] : "ALL x. ALL y. min'(x, y) = min'(y, x)"

ga_comm_max [rule_format] : "ALL x. ALL y. max'(x, y) = max'(y, x)"

ga_assoc_min [rule_format] :
"ALL x. ALL y. ALL z. min'(min'(x, y), z) = min'(x, min'(y, z))"

ga_assoc_max [rule_format] :
"ALL x. ALL y. ALL z. max'(max'(x, y), z) = max'(x, max'(y, z))"

ga_left_comm_min [rule_format] :
"ALL x. ALL y. ALL z. min'(x, min'(y, z)) = min'(y, min'(x, z))"

ga_left_comm_max [rule_format] :
"ALL x. ALL y. ALL z. max'(x, max'(y, z)) = max'(y, max'(x, z))"

min_def_ExtTotalOrder [rule_format] :
"ALL x. ALL y. min'(x, y) = (if x <=' y then x else y)"

max_def_ExtTotalOrder [rule_format] :
"ALL x. ALL y. max'(x, y) = (if x <=' y then y else x)"

min_inf_relation [rule_format] :
"ALL x. ALL y. makePartial (min'(x, y)) = inf'(x, y)"

max_sup_relation [rule_format] :
"ALL x. ALL y. makePartial (max'(x, y)) = sup(x, y)"

RealNonNeg_pred_def [rule_format] :
"ALL x. RealNonNeg_pred(x) = (x >=' 0')"

RealPos_pred_def [rule_format] :
"ALL x. RealPos_pred(x) = (x >' 0')"

Ax3 [rule_format] :
"ALL x. defOp (gn_proj(x)) = RealNonNeg_pred(x)"

Ax4 [rule_format] : "ALL x. defOp (gn_proj(x)) = RealPos_pred(x)"

RealNonNeg_subtype [rule_format] :
"isSubtypeWithPred(X_RealNonNeg_pred, X_RealNonNeg_inj,
 X_RealNonNeg_proj)"

RealPos_subtype [rule_format] :
"isSubtypeWithPred(X_RealPos_pred, X_RealPos_inj, X_RealPos_proj)"

abs_def [rule_format] :
"ALL x.
 makePartial (abs'(x)) =
 (if 0' <=' x then gn_proj(x) else gn_proj(-' x))"

times_cancel_right_nonneg_leq [rule_format] :
"ALL a. ALL b. ALL c. a *'' b <=' c *'' b & b >=' 0' --> a <=' c"

times_leq_nonneg_cond [rule_format] :
"ALL a. ALL b. 0' <=' a *'' b & b >=' 0' --> 0' <=' a"

sqr_def [rule_format] :
"ALL r. gn_inj(sqr(r)) = makePartial (r *'' r)"

sqrt_def [rule_format] : "ALL q. sqr(gn_inj(sqrt(q))) = q"

Pos_def [rule_format] : "ALL x. Pos(x) = (0' <=' x)"

X2_def_Real [rule_format] : "2' = gn_inj(1') +' gn_inj(1')"

X3_def_Real [rule_format] : "3' = 2' +' gn_inj(1')"

X4_def_Real [rule_format] : "4' = 3' +' gn_inj(1')"

X5_def_Real [rule_format] : "5' = 4' +' gn_inj(1')"

X6_def_Real [rule_format] : "6' = 5' +' gn_inj(1')"

X7_def_Real [rule_format] : "7' = 6' +' gn_inj(1')"

X8_def_Real [rule_format] : "8' = 7' +' gn_inj(1')"

X9_def_Real [rule_format] : "9' = 8' +' gn_inj(1')"

ZeroToNine_type [rule_format] :
"ALL x.
 defOp (gn_proj(x)) =
 (((((((((x = 0' | makePartial x = gn_inj(1')) | x = 2') | x = 3') |
       x = 4') |
      x = 5') |
     x = 6') |
    x = 7') |
   x = 8') |
  x = 9')"

decimal_def [rule_format] :
"ALL m.
 ALL X_n. m @@ X_n = (gn_inj(m) *'' (9' +' gn_inj(1'))) +' X_n"

ga_select_C1 [rule_format] :
"ALL x_1. ALL x_2. ALL x_3. C1(V(x_1, x_2, x_3)) = x_1"

ga_select_C2 [rule_format] :
"ALL x_1. ALL x_2. ALL x_3. C2(V(x_1, x_2, x_3)) = x_2"

ga_select_C3 [rule_format] :
"ALL x_1. ALL x_2. ALL x_3. C3(V(x_1, x_2, x_3)) = x_3"

Zero_Vector [rule_format] : "0'' = V(0', 0', 0')"

VectorStar_pred_def [rule_format] :
"ALL x. VectorStar_pred(x) = (~ x = 0'')"

Ax7 [rule_format] :
"ALL x. defOp (gn_proj(x)) = VectorStar_pred(x)"

VectorStar_subtype [rule_format] :
"isSubtypeWithPred(X_VectorStar_pred, X_VectorStar_inj,
 X_VectorStar_proj)"

def_of_vector_addition [rule_format] :
"ALL x.
 ALL y. x +'' y = V(C1(x) +' C1(y), C2(x) +' C2(y), C3(x) +' C3(y))"

def_of_minus_vector [rule_format] :
"ALL x. -'' x = V(-' C1(x), -' C2(x), -' C3(x))"

binary_inverse_2 [rule_format] :
"ALL x. ALL y. x -'' y = x +'' -'' y"

scalar_multiplication [rule_format] :
"ALL x. ALL y. x *_3 y = V(x *'' C1(y), x *'' C2(y), x *'' C3(y))"

scalar_product [rule_format] :
"ALL x.
 ALL y.
 x *_4 y =
 ((C1(x) *'' C1(y)) +' (C2(x) *'' C2(y))) +' (C3(x) *'' C3(y))"

vector_product [rule_format] :
"ALL x.
 ALL y.
 x #' y =
 V((C2(x) *'' C3(y)) -' (C2(y) *'' C3(x)),
 (C3(x) *'' C1(y)) -' (C3(y) *'' C1(x)),
 (C1(x) *'' C2(y)) -' (C1(y) *'' C2(x)))"

ONB1 [rule_format] : "e1 = V(gn_inj(1'), 0', 0')"

ONB2 [rule_format] : "e2 = V(0', gn_inj(1'), 0')"

ONB3 [rule_format] : "e3 = V(0', 0', gn_inj(1'))"

declare refl [simp]
declare ga_assoc___Xx__ [simp]
declare ga_right_unit___Xx__ [simp]
declare ga_left_unit___Xx__ [simp]
declare inv_Group [simp]
declare rinv_Group [simp]
declare ga_comm___Xx__ [simp]
declare ga_assoc___Xx___1 [simp]
declare ga_right_unit___Xx___1 [simp]
declare ga_left_unit___Xx___1 [simp]
declare left_zero [simp]
declare right_zero [simp]
declare ga_comm___Xx___1 [simp]
declare ga_assoc___Xx___2 [simp]
declare ga_right_unit___Xx___2 [simp]
declare ga_left_unit___Xx___2 [simp]
declare inv_Group_1 [simp]
declare rinv_Group_1 [simp]
declare refl_1 [simp]
declare FWO_plus_left [simp]
declare FWO_plus_right [simp]
declare ga_comm_inf [simp]
declare ga_comm_sup [simp]
declare ga_comm_min [simp]
declare ga_comm_max [simp]
declare ga_assoc_min [simp]
declare ga_assoc_max [simp]
declare ga_left_comm_min [simp]
declare ga_left_comm_max [simp]
declare min_inf_relation [simp]
declare max_sup_relation [simp]
declare Ax3 [simp]
declare Ax4 [simp]
declare RealNonNeg_subtype [simp]
declare RealPos_subtype [simp]
declare sqrt_def [simp]
declare ga_select_C1 [simp]
declare ga_select_C2 [simp]
declare ga_select_C3 [simp]
declare Ax7 [simp]
declare VectorStar_subtype [simp]

theorem cross_left_homogenity :
"ALL r. ALL x. ALL y. r *_3 (x #' y) = (r *_3 x) #' y"
using subtype_def subtype_pred_def Ax1_1 inf_def
      RealNonNeg_pred_def RealPos_pred_def abs_def sqr_def sqrt_def
      Pos_def X2_def_Real X3_def_Real X4_def_Real X5_def_Real X6_def_Real
      X7_def_Real X8_def_Real X9_def_Real decimal_def Zero_Vector
      VectorStar_pred_def scalar_multiplication scalar_product
      vector_product ONB1 ONB2 ONB3
by (auto)

ML "Header.record \"cross_left_homogenity\""

theorem cross_product_antisymmetric :
"ALL x. ALL y. x #' y = -'' (y #' x)"
using subtype_def subtype_pred_def Ax1_1 inf_def
      RealNonNeg_pred_def RealPos_pred_def abs_def sqr_def sqrt_def
      Pos_def X2_def_Real X3_def_Real X4_def_Real X5_def_Real X6_def_Real
      X7_def_Real X8_def_Real X9_def_Real decimal_def Zero_Vector
      VectorStar_pred_def scalar_multiplication scalar_product
      vector_product ONB1 ONB2 ONB3
by (auto)

ML "Header.record \"cross_product_antisymmetric\""

end


theory Collecting
imports Complete_Lattice Big_Step ACom
  "~~/src/Tools/Permanent_Interpretation"
begin

subsection "The generic Step function"

notation
  sup (infixl "\<squnion>" 65) and
  inf (infixl "\<sqinter>" 70) and
  bot ("\<bottom>") and
  top ("\<top>")

context
  fixes f :: "vname \<Rightarrow> aexp \<Rightarrow> 'a \<Rightarrow> 'a::sup"
  fixes g :: "bexp \<Rightarrow> 'a \<Rightarrow> 'a"
begin
fun Step :: "'a \<Rightarrow> 'a acom \<Rightarrow> 'a acom" where
"Step S (SKIP {Q}) = (SKIP {S})" |
"Step S (x ::= e {Q}) =
  x ::= e {f x e S}" |
"Step S (C1;; C2) = Step S C1;; Step (post C1) C2" |
"Step S (IF b THEN {P1} C1 ELSE {P2} C2 {Q}) =
  IF b THEN {g b S} Step P1 C1 ELSE {g (Not b) S} Step P2 C2
  {post C1 \<squnion> post C2}" |
"Step S ({I} WHILE b DO {P} C {Q}) =
  {S \<squnion> post C} WHILE b DO {g b I} Step P C {g (Not b) I}"
end

lemma strip_Step[simp]: "strip(Step f g S C) = strip C"
by(induct C arbitrary: S) auto

subsection "Collecting Semantics of Commands"

subsubsection "Annotated commands as a complete lattice"

instantiation acom :: (order) order
begin

definition less_eq_acom :: "('a::order)acom \<Rightarrow> 'a acom \<Rightarrow> bool" where
"C1 \<le> C2 \<longleftrightarrow> strip C1 = strip C2 \<and> (\<forall>p<size(annos C1). anno C1 p \<le> anno C2 p)"

definition less_acom :: "'a acom \<Rightarrow> 'a acom \<Rightarrow> bool" where
"less_acom x y = (x \<le> y \<and> \<not> y \<le> x)"

instance
proof
  case goal1 show ?case by(simp add: less_acom_def)
next
  case goal2 thus ?case by(auto simp: less_eq_acom_def)
next
  case goal3 thus ?case by(fastforce simp: less_eq_acom_def size_annos)
next
  case goal4 thus ?case
    by(fastforce simp: le_antisym less_eq_acom_def size_annos
         eq_acom_iff_strip_anno)
qed

end

lemma less_eq_acom_annos:
  "C1 \<le> C2 \<longleftrightarrow> strip C1 = strip C2 \<and> list_all2 (op \<le>) (annos C1) (annos C2)"
by(auto simp add: less_eq_acom_def anno_def list_all2_conv_all_nth size_annos_same2)

lemma SKIP_le[simp]: "SKIP {S} \<le> c \<longleftrightarrow> (\<exists>S'. c = SKIP {S'} \<and> S \<le> S')"
by (cases c) (auto simp:less_eq_acom_def anno_def)

lemma Assign_le[simp]: "x ::= e {S} \<le> c \<longleftrightarrow> (\<exists>S'. c = x ::= e {S'} \<and> S \<le> S')"
by (cases c) (auto simp:less_eq_acom_def anno_def)

lemma Seq_le[simp]: "C1;;C2 \<le> C \<longleftrightarrow> (\<exists>C1' C2'. C = C1';;C2' \<and> C1 \<le> C1' \<and> C2 \<le> C2')"
apply (cases C)
apply(auto simp: less_eq_acom_annos list_all2_append size_annos_same2)
done

lemma If_le[simp]: "IF b THEN {p1} C1 ELSE {p2} C2 {S} \<le> C \<longleftrightarrow>
  (\<exists>p1' p2' C1' C2' S'. C = IF b THEN {p1'} C1' ELSE {p2'} C2' {S'} \<and>
     p1 \<le> p1' \<and> p2 \<le> p2' \<and> C1 \<le> C1' \<and> C2 \<le> C2' \<and> S \<le> S')"
apply (cases C)
apply(auto simp: less_eq_acom_annos list_all2_append size_annos_same2)
done

lemma While_le[simp]: "{I} WHILE b DO {p} C {P} \<le> W \<longleftrightarrow>
  (\<exists>I' p' C' P'. W = {I'} WHILE b DO {p'} C' {P'} \<and> C \<le> C' \<and> p \<le> p' \<and> I \<le> I' \<and> P \<le> P')"
apply (cases W)
apply(auto simp: less_eq_acom_annos list_all2_append size_annos_same2)
done

lemma mono_post: "C \<le> C' \<Longrightarrow> post C \<le> post C'"
using annos_ne[of C']
by(auto simp: post_def less_eq_acom_def last_conv_nth[OF annos_ne] anno_def
     dest: size_annos_same)

definition Inf_acom :: "com \<Rightarrow> 'a::complete_lattice acom set \<Rightarrow> 'a acom" where
"Inf_acom c M = annotate (\<lambda>p. INF C:M. anno C p) c"

permanent_interpretation
  Complete_Lattice "{C. strip C = c}" "Inf_acom c" for c
proof
  case goal1 thus ?case
    by(auto simp: Inf_acom_def less_eq_acom_def size_annos intro:INF_lower)
next
  case goal2 thus ?case
    by(auto simp: Inf_acom_def less_eq_acom_def size_annos intro:INF_greatest)
next
  case goal3 thus ?case by(auto simp: Inf_acom_def)
qed

subsubsection "Collecting semantics"

definition "step = Step (\<lambda>x e S. {s(x := aval e s) |s. s : S}) (\<lambda>b S. {s:S. bval b s})"

definition CS :: "com \<Rightarrow> state set acom" where
"CS c = lfp c (step UNIV)"

lemma mono2_Step: fixes C1 C2 :: "'a::semilattice_sup acom"
  assumes "!!x e S1 S2. S1 \<le> S2 \<Longrightarrow> f x e S1 \<le> f x e S2"
          "!!b S1 S2. S1 \<le> S2 \<Longrightarrow> g b S1 \<le> g b S2"
  shows "C1 \<le> C2 \<Longrightarrow> S1 \<le> S2 \<Longrightarrow> Step f g S1 C1 \<le> Step f g S2 C2"
proof(induction S1 C1 arbitrary: C2 S2 rule: Step.induct)
  case 1 thus ?case by(auto)
next
  case 2 thus ?case by (auto simp: assms(1))
next
  case 3 thus ?case by(auto simp: mono_post)
next
  case 4 thus ?case
    by(auto simp: subset_iff assms(2))
      (metis mono_post le_supI1 le_supI2)+
next
  case 5 thus ?case
    by(auto simp: subset_iff assms(2))
      (metis mono_post le_supI1 le_supI2)+
qed

lemma mono2_step: "C1 \<le> C2 \<Longrightarrow> S1 \<subseteq> S2 \<Longrightarrow> step S1 C1 \<le> step S2 C2"
unfolding step_def by(rule mono2_Step) auto

lemma mono_step: "mono (step S)"
by(blast intro: monoI mono2_step)

lemma strip_step: "strip(step S C) = strip C"
by (induction C arbitrary: S) (auto simp: step_def)

lemma lfp_cs_unfold: "lfp c (step S) = step S (lfp c (step S))"
apply(rule lfp_unfold[OF _  mono_step])
apply(simp add: strip_step)
done

lemma CS_unfold: "CS c = step UNIV (CS c)"
by (metis CS_def lfp_cs_unfold)

lemma strip_CS[simp]: "strip(CS c) = c"
by(simp add: CS_def index_lfp[simplified])

subsubsection "Relation to big-step semantics"

lemma asize_nz: "asize(c::com) \<noteq> 0"
by (metis length_0_conv length_annos_annotate annos_ne)

lemma post_Inf_acom:
  "\<forall>C\<in>M. strip C = c \<Longrightarrow> post (Inf_acom c M) = \<Inter>(post ` M)"
apply(subgoal_tac "\<forall>C\<in>M. size(annos C) = asize c")
 apply(simp add: post_anno_asize Inf_acom_def asize_nz neq0_conv[symmetric])
apply(simp add: size_annos)
done

lemma post_lfp: "post(lfp c f) = (\<Inter>{post C|C. strip C = c \<and> f C \<le> C})"
by(auto simp add: lfp_def post_Inf_acom)

lemma big_step_post_step:
  "\<lbrakk> (c, s) \<Rightarrow> t;  strip C = c;  s \<in> S;  step S C \<le> C \<rbrakk> \<Longrightarrow> t \<in> post C"
proof(induction arbitrary: C S rule: big_step_induct)
  case Skip thus ?case by(auto simp: strip_eq_SKIP step_def post_def)
next
  case Assign thus ?case
    by(fastforce simp: strip_eq_Assign step_def post_def)
next
  case Seq thus ?case
    by(fastforce simp: strip_eq_Seq step_def post_def last_append annos_ne)
next
  case IfTrue thus ?case apply(auto simp: strip_eq_If step_def post_def)
    by (metis (lifting,full_types) mem_Collect_eq set_mp)
next
  case IfFalse thus ?case apply(auto simp: strip_eq_If step_def post_def)
    by (metis (lifting,full_types) mem_Collect_eq set_mp)
next
  case (WhileTrue b s1 c' s2 s3)
  from WhileTrue.prems(1) obtain I P C' Q where "C = {I} WHILE b DO {P} C' {Q}" "strip C' = c'"
    by(auto simp: strip_eq_While)
  from WhileTrue.prems(3) `C = _`
  have "step P C' \<le> C'"  "{s \<in> I. bval b s} \<le> P"  "S \<le> I"  "step (post C') C \<le> C"
    by (auto simp: step_def post_def)
  have "step {s \<in> I. bval b s} C' \<le> C'"
    by (rule order_trans[OF mono2_step[OF order_refl `{s \<in> I. bval b s} \<le> P`] `step P C' \<le> C'`])
  have "s1: {s:I. bval b s}" using `s1 \<in> S` `S \<subseteq> I` `bval b s1` by auto
  note s2_in_post_C' = WhileTrue.IH(1)[OF `strip C' = c'` this `step {s \<in> I. bval b s} C' \<le> C'`]
  from WhileTrue.IH(2)[OF WhileTrue.prems(1) s2_in_post_C' `step (post C') C \<le> C`]
  show ?case .
next
  case (WhileFalse b s1 c') thus ?case
    by (force simp: strip_eq_While step_def post_def)
qed

lemma big_step_lfp: "\<lbrakk> (c,s) \<Rightarrow> t;  s \<in> S \<rbrakk> \<Longrightarrow> t \<in> post(lfp c (step S))"
by(auto simp add: post_lfp intro: big_step_post_step)

lemma big_step_CS: "(c,s) \<Rightarrow> t \<Longrightarrow> t : post(CS c)"
by(simp add: CS_def big_step_lfp)

end


(* Author: Alexander Maletzky *)

section \<open>Preliminaries\<close>

theory Dube_Prelims
  imports Groebner_Bases.General
begin

subsection \<open>Sets\<close>

lemma card_geq_ex_subset:
  assumes "card A \<ge> n"
  obtains B where "card B = n" and "B \<subseteq> A"
  using assms
proof (induct n arbitrary: thesis)
  case base: 0
  show ?case
  proof (rule base(1))
    show "card {} = 0" by simp
  next
    show "{} \<subseteq> A" ..
  qed
next
  case ind: (Suc n)
  from ind(3) have "n < card A" by simp
  obtain B where card: "card B = n" and "B \<subseteq> A"
  proof (rule ind(1))
    from \<open>n < card A\<close> show "n \<le> card A" by simp
  qed
  from \<open>n < card A\<close> have "card A \<noteq> 0" by simp
  with card_infinite[of A] have "finite A" by blast
  let ?C = "A - B"
  have "?C \<noteq> {}"
  proof
    assume "A - B = {}"
    hence "A \<subseteq> B" by simp
    from this \<open>B \<subseteq> A\<close> have "A = B" ..
    from \<open>n < card A\<close> show False unfolding \<open>A = B\<close> card by simp
  qed
  then obtain c where "c \<in> ?C" by auto
  hence "c \<notin> B" by simp
  hence "B - {c} = B" by simp
  show ?case
  proof (rule ind(2))
    thm card_insert
    have "card (B \<union> {c}) = card (insert c B)" by simp
    also have "... = Suc (card (B - {c}))"
      by (rule card_insert, rule finite_subset, fact \<open>B \<subseteq> A\<close>, fact)
    finally show "card (B \<union> {c}) = Suc n" unfolding \<open>B - {c} = B\<close> card .
  next
    show "B \<union> {c} \<subseteq> A" unfolding Un_subset_iff
    proof (intro conjI, fact)
      from \<open>c \<in> ?C\<close> show "{c} \<subseteq> A" by auto
    qed
  qed
qed

lemma card_2_E_1:
  assumes "card A = 2" and "x \<in> A"
  obtains y where "x \<noteq> y" and "A = {x, y}"
proof -
  have "A - {x} \<noteq> {}"
  proof
    assume "A - {x} = {}"
    with assms(2) have "A = {x}" by auto
    hence "card A = 1" by simp
    with assms show False by simp
  qed
  then obtain y where "y \<in> A - {x}" by auto
  hence "y \<in> A" and "x \<noteq> y" by auto
  show ?thesis
  proof
    show "A = {x, y}"
    proof (rule sym, rule card_seteq)
      from assms(1) show "finite A" using card_infinite by fastforce
    next
      from \<open>x \<in> A\<close> \<open>y \<in> A\<close> show "{x, y} \<subseteq> A" by simp
    next
      from \<open>x \<noteq> y\<close> show "card A \<le> card {x, y}" by (simp add: assms(1))
    qed
  qed fact
qed

lemma card_2_E:
  assumes "card A = 2"
  obtains x y where "x \<noteq> y" and "A = {x, y}"
proof -
  from assms have "A \<noteq> {}" by auto
  then obtain x where "x \<in> A" by blast
  with assms obtain y where "x \<noteq> y" and "A = {x, y}" by (rule card_2_E_1)
  thus ?thesis ..
qed

subsection \<open>Sums\<close>

lemma sum_tail_nat: "0 < b \<Longrightarrow> a \<le> (b::nat) \<Longrightarrow> sum f {a..b} = f b + sum f {a..b - 1}"
  by (metis One_nat_def Suc_pred add.commute not_le sum.cl_ivl_Suc)

lemma sum_atLeast_Suc_shift: "0 < b \<Longrightarrow> a \<le> b \<Longrightarrow> sum f {Suc a..b} = (\<Sum>i=a..b - 1. f (Suc i))"
  by (metis Suc_pred' sum.shift_bounds_cl_Suc_ivl)

lemma sum_split_nat_ivl:
  "a \<le> Suc j \<Longrightarrow> j \<le> b \<Longrightarrow> sum f {a..j} + sum f {Suc j..b} = sum f {a..b}"
  by (metis Suc_eq_plus1 le_Suc_ex sum.ub_add_nat)

subsection \<open>@{const count_list}\<close>

lemma count_list_eq_0_iff: "count_list xs x = 0 \<longleftrightarrow> x \<notin> set xs"
  by (induct xs) simp_all

lemma count_list_append: "count_list (xs @ ys) x = count_list xs x + count_list ys x"
  by (induct xs) simp_all

lemma count_list_map_ge: "count_list xs x \<le> count_list (map f xs) (f x)"
  by (induct xs) simp_all

lemma count_list_gr_1_E:
  assumes "1 < count_list xs x"
  obtains i j where "i < j" and "j < length xs" and "xs ! i = x" and "xs ! j = x"
proof -
  from assms have "count_list xs x \<noteq> 0" by simp
  hence "x \<in> set xs" by (simp only: count_list_eq_0_iff not_not)
  then obtain ys zs where xs: "xs = ys @ x # zs" and "x \<notin> set ys" by (meson split_list_first)
  hence "count_list xs x = Suc (count_list zs x)" by (simp add: count_list_append)
  with assms have "count_list zs x \<noteq> 0" by simp
  hence "x \<in> set zs" by (simp only: count_list_eq_0_iff not_not)
  then obtain j where "j < length zs" and "x = zs ! j" by (metis in_set_conv_nth)
  show ?thesis
  proof
    show "length ys < length ys + Suc j" by simp
  next
    from \<open>j < length zs\<close> show "length ys + Suc j < length xs" by (simp add: xs)
  next
    show "xs ! length ys = x" by (simp add: xs)
  next
    show "xs ! (length ys + Suc j) = x"
      by (simp only: xs \<open>x = zs ! j\<close> nth_append_length_plus nth_Cons_Suc)
  qed
qed

subsection \<open>@{const listset}\<close>

lemma listset_Cons: "listset (x # xs) = (\<Union>y\<in>x. (#) y ` listset xs)"
  by (auto simp: set_Cons_def)

lemma listset_ConsI: "y \<in> x \<Longrightarrow> ys' \<in> listset xs \<Longrightarrow> ys = y # ys' \<Longrightarrow> ys \<in> listset (x # xs)"
  by (simp add: set_Cons_def)

lemma listset_ConsE:
  assumes "ys \<in> listset (x# xs)"
  obtains y ys' where "y \<in> x" and "ys' \<in> listset xs" and "ys = y # ys'"
  using assms by (auto simp: set_Cons_def)

lemma listsetI:
  "length ys = length xs \<Longrightarrow> (\<And>i. i < length xs \<Longrightarrow> ys ! i \<in> xs ! i) \<Longrightarrow> ys \<in> listset xs"
  by (induct ys xs rule: list_induct2)
     (simp_all, smt Suc_mono list.sel(3) mem_Collect_eq nth_Cons_0 nth_tl set_Cons_def zero_less_Suc)

lemma listsetD:
  assumes "ys \<in> listset xs"
  shows "length ys = length xs" and "\<And>i. i < length xs \<Longrightarrow> ys ! i \<in> xs ! i"
proof -
  from assms have "length ys = length xs \<and> (\<forall>i<length xs. ys ! i \<in> xs ! i)"
  proof (induct xs arbitrary: ys)
    case Nil
    thus ?case by simp
  next
    case (Cons x xs)
    from Cons.prems obtain y ys' where "y \<in> x" and "ys' \<in> listset xs" and ys: "ys = y # ys'"
      by (rule listset_ConsE)
    from this(2) have "length ys' = length xs \<and> (\<forall>i<length xs. ys' ! i \<in> xs ! i)" by (rule Cons.hyps)
    hence 1: "length ys' = length xs" and 2: "\<And>i. i < length xs \<Longrightarrow> ys' ! i \<in> xs ! i" by simp_all
    show ?case
    proof (intro conjI allI impI)
      fix i
      assume "i < length (x # xs)"
      show "ys ! i \<in> (x # xs) ! i"
      proof (cases i)
        case 0
        with \<open>y \<in> x\<close> show ?thesis by (simp add: ys)
      next
        case (Suc j)
        with \<open>i < length (x # xs)\<close> have "j < length xs" by simp
        hence "ys' ! j \<in> xs ! j" by (rule 2)
        thus ?thesis by (simp add: ys \<open>i = Suc j\<close>)
      qed
    qed (simp add: ys 1)
  qed
  thus "length ys = length xs" and "\<And>i. i < length xs \<Longrightarrow> ys ! i \<in> xs ! i" by simp_all
qed

lemma listset_singletonI: "a \<in> A \<Longrightarrow> ys = [a] \<Longrightarrow> ys \<in> listset [A]"
  by simp

lemma listset_singletonE:
  assumes "ys \<in> listset [A]"
  obtains a where "a \<in> A" and "ys = [a]"
  using assms by auto

lemma listset_doubletonI: "a \<in> A \<Longrightarrow> b \<in> B \<Longrightarrow> ys = [a, b] \<Longrightarrow> ys \<in> listset [A, B]"
  by (simp add: set_Cons_def)

lemma listset_doubletonE:
  assumes "ys \<in> listset [A, B]"
  obtains a b where "a \<in> A" and "b \<in> B" and "ys = [a, b]"
  using assms by (auto simp: set_Cons_def)

lemma listset_appendI:
  "ys1 \<in> listset xs1 \<Longrightarrow> ys2 \<in> listset xs2 \<Longrightarrow> ys = ys1 @ ys2 \<Longrightarrow> ys \<in> listset (xs1 @ xs2)"
  by (induct xs1 arbitrary: ys ys1 ys2)
      (simp, auto simp del: listset.simps elim!: listset_ConsE intro!: listset_ConsI)

lemma listset_appendE:
  assumes "ys \<in> listset (xs1 @ xs2)"
  obtains ys1 ys2 where "ys1 \<in> listset xs1" and "ys2 \<in> listset xs2" and "ys = ys1 @ ys2"
  using assms
proof (induct xs1 arbitrary: thesis ys)
  case Nil
  have "[] \<in> listset []" by simp
  moreover from Nil(2) have "ys \<in> listset xs2" by simp
  ultimately show ?case by (rule Nil) simp
next
  case (Cons x xs1)
  from Cons.prems(2) have "ys \<in> listset (x # (xs1 @ xs2))" by simp
  then obtain y ys' where "y \<in> x" and "ys' \<in> listset (xs1 @ xs2)" and ys: "ys = y # ys'"
    by (rule listset_ConsE)
  from _ this(2) obtain ys1 ys2 where ys1: "ys1 \<in> listset xs1" and "ys2 \<in> listset xs2"
    and ys': "ys' = ys1 @ ys2" by (rule Cons.hyps)
  show ?case
  proof (rule Cons.prems)
    from \<open>y \<in> x\<close> ys1 refl show "y # ys1 \<in> listset (x # xs1)" by (rule listset_ConsI)
  next
    show "ys = (y # ys1) @ ys2" by (simp add: ys ys')
  qed fact
qed

lemma listset_map_imageI: "ys' \<in> listset xs \<Longrightarrow> ys = map f ys' \<Longrightarrow> ys \<in> listset (map ((`) f) xs)"
  by (induct xs arbitrary: ys ys')
    (simp, auto simp del: listset.simps elim!: listset_ConsE intro!: listset_ConsI)

lemma listset_map_imageE:
  assumes "ys \<in> listset (map ((`) f) xs)"
  obtains ys' where "ys' \<in> listset xs" and "ys = map f ys'"
  using assms
proof (induct xs arbitrary: thesis ys)
  case Nil
  from Nil(2) have "ys = map f []" by simp
  with _ show ?case by (rule Nil) simp
next
  case (Cons x xs)
  from Cons.prems(2) have "ys \<in> listset (f ` x # map ((`) f) xs)" by simp
  then obtain y ys' where "y \<in> f ` x" and "ys' \<in> listset (map ((`) f) xs)" and ys: "ys = y # ys'"
    by (rule listset_ConsE)
  from _ this(2) obtain ys1 where ys1: "ys1 \<in> listset xs" and ys': "ys' = map f ys1" by (rule Cons.hyps)
  from \<open>y \<in> f ` x\<close> obtain y1 where "y1 \<in> x" and y: "y = f y1" ..
  show ?case
  proof (rule Cons.prems)
    from \<open>y1 \<in> x\<close> ys1 refl show "y1 # ys1 \<in> listset (x # xs)" by (rule listset_ConsI)
  qed (simp add: ys ys' y)
qed

lemma listset_permE:
  assumes "ys \<in> listset xs" and "bij_betw f {..<length xs} {..<length xs'}"
    and "\<And>i. i < length xs \<Longrightarrow> xs' ! i = xs ! f i"
  obtains ys' where "ys' \<in> listset xs'" and "length ys' = length ys"
    and "\<And>i. i < length ys \<Longrightarrow> ys' ! i = ys ! f i"
proof -
  from assms(1) have len_ys: "length ys = length xs" by (rule listsetD)
  from assms(2) have "card {..<length xs} = card {..<length xs'}" by (rule bij_betw_same_card)
  hence len_xs: "length xs = length xs'" by simp
  define ys' where "ys' = map (\<lambda>i. ys ! (f i)) [0..<length ys]"
  have 1: "ys' ! i = ys ! f i" if "i < length ys" for i using that by (simp add: ys'_def)
  show ?thesis
  proof
    show "ys' \<in> listset xs'"
    proof (rule listsetI)
      show "length ys' = length xs'" by (simp add: ys'_def len_ys len_xs)

      fix i
      assume "i < length xs'"
      hence "i < length xs" by (simp only: len_xs)
      hence "i < length ys" by (simp only: len_ys)
      hence "ys' ! i = ys ! (f i)" by (rule 1)
      also from assms(1) have "\<dots> \<in> xs ! (f i)"
      proof (rule listsetD)
        from \<open>i < length xs\<close> have "i \<in> {..<length xs}" by simp
        hence "f i \<in> f ` {..<length xs}" by (rule imageI)
        also from assms(2) have "\<dots> = {..<length xs'}" by (simp add: bij_betw_def)
        finally show "f i < length xs" by (simp add: len_xs)
      qed
      also have "\<dots> = xs' ! i" by (rule sym) (rule assms(3), fact)
      finally show "ys' ! i \<in> xs' ! i" .
    qed
  next
    show "length ys' = length ys" by (simp add: ys'_def)
  qed (rule 1)
qed

lemma listset_closed_map:
  assumes "ys \<in> listset xs" and "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> x \<Longrightarrow> f y \<in> x"
  shows "map f ys \<in> listset xs"
  using assms
proof (induct xs arbitrary: ys)
  case Nil
  from Nil(1) show ?case by simp
next
  case (Cons x xs)
  from Cons.prems(1) obtain y ys' where "y \<in> x" and "ys' \<in> listset xs" and ys: "ys = y # ys'"
    by (rule listset_ConsE)
  show ?case
  proof (rule listset_ConsI)
    from _ \<open>y \<in> x\<close> show "f y \<in> x" by (rule Cons.prems) simp
  next
    show "map f ys' \<in> listset xs"
    proof (rule Cons.hyps)
      fix x0 y0
      assume "x0 \<in> set xs"
      hence "x0 \<in> set (x # xs)" by simp
      moreover assume "y0 \<in> x0"
      ultimately show "f y0 \<in> x0" by (rule Cons.prems)
    qed fact
  qed (simp add: ys)
qed

lemma listset_closed_map2:
  assumes "ys1 \<in> listset xs" and "ys2 \<in> listset xs"
    and "\<And>x y1 y2. x \<in> set xs \<Longrightarrow> y1 \<in> x \<Longrightarrow> y2 \<in> x \<Longrightarrow> f y1 y2 \<in> x"
  shows "map2 f ys1 ys2 \<in> listset xs"
  using assms
proof (induct xs arbitrary: ys1 ys2)
  case Nil
  from Nil(1) show ?case by simp
next
  case (Cons x xs)
  from Cons.prems(1) obtain y1 ys1' where "y1 \<in> x" and "ys1' \<in> listset xs" and ys1: "ys1 = y1 # ys1'"
    by (rule listset_ConsE)
  from Cons.prems(2) obtain y2 ys2' where "y2 \<in> x" and "ys2' \<in> listset xs" and ys2: "ys2 = y2 # ys2'"
    by (rule listset_ConsE)
  show ?case
  proof (rule listset_ConsI)
    from _ \<open>y1 \<in> x\<close> \<open>y2 \<in> x\<close> show "f y1 y2 \<in> x" by (rule Cons.prems) simp
  next
    show "map2 f ys1' ys2' \<in> listset xs"
    proof (rule Cons.hyps)
      fix x' y1' y2'
      assume "x' \<in> set xs"
      hence "x' \<in> set (x # xs)" by simp
      moreover assume "y1' \<in> x'" and "y2' \<in> x'"
      ultimately show "f y1' y2' \<in> x'" by (rule Cons.prems)
    qed fact+
  qed (simp add: ys1 ys2)
qed

lemma listset_empty_iff: "listset xs = {} \<longleftrightarrow> {} \<in> set xs"
  by (induct xs) (auto simp: listset_Cons simp del: listset.simps(2))

lemma listset_mono:
  assumes "length xs = length ys" and "\<And>i. i < length ys \<Longrightarrow> xs ! i \<subseteq> ys ! i"
  shows "listset xs \<subseteq> listset ys"
  using assms
proof (induct xs ys rule: list_induct2)
  case Nil
  show ?case by simp
next
  case (Cons x xs y ys)
  show ?case
  proof
    fix zs'
    assume "zs' \<in> listset (x # xs)"
    then obtain z zs where "z \<in> x" and zs: "zs \<in> listset xs" and zs': "zs' = z # zs"
      by (rule listset_ConsE)
    have "0 < length (y # ys)" by simp
    hence "(x # xs) ! 0 \<subseteq> (y # ys) ! 0" by (rule Cons.prems)
    hence "x \<subseteq> y" by simp
    with \<open>z \<in> x\<close> have "z \<in> y" ..
    moreover from zs have "zs \<in> listset ys"
    proof
      show "listset xs \<subseteq> listset ys"
      proof (rule Cons.hyps)
        fix i
        assume "i < length ys"
        hence "Suc i < length (y # ys)" by simp
        hence "(x # xs) ! Suc i \<subseteq> (y # ys) ! Suc i" by (rule Cons.prems)
        thus "xs ! i \<subseteq> ys ! i" by simp
      qed
    qed
    ultimately show "zs' \<in> listset (y # ys)" using zs' by (rule listset_ConsI)
  qed
qed

end (* theory *)


theory Prelude_Nat
imports "$HETS_LIB/Isabelle/MainHC"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"SubDomNat\", \"DivideDomNat\", \"DivDomNat\", \"ModDomNat\",
     \"Distr1Nat\", \"Distr2Nat\", \"NotFalse\", \"NotTrue\",
     \"AndDef1\", \"AndDef2\", \"AndDef3\", \"AndDef4\", \"OrDef\",
     \"OtherwiseDef\", \"NotTrue1\", \"NotFalse2\", \"TB1\",
     \"EqualTDef\", \"SymT\", \"SymF\", \"ReflexT\", \"TransT\",
     \"DiffTDef\", \"DiffFDef\", \"DiffDef2\", \"TE1\", \"TE2\",
     \"TE3\", \"TE4\", \"IBE1\", \"IBE2\", \"IBE3\", \"IBE4\", \"IBE5\",
     \"IBE6\", \"IBE7\", \"IBE8\", \"IUE1\", \"IUE2\",
     \"ALeIrreflexivity\", \"ALeAsymmetry\", \"ALeTransitive\",
     \"ALeTotal\", \"IOE01\", \"IOE02\", \"IOE03\", \"IOE04\",
     \"IOE05\", \"IOE06\", \"IOE07\", \"IOE08\", \"IOE09\", \"LeDef\",
     \"LeIrreflexivity\", \"LeTAsymmetry\", \"LeTTransitive\",
     \"LeTTotal\", \"LeqTTransitive\", \"LeqTTotal\",
     \"GeIrreflexivity\", \"GeTAsymmetry\", \"GeTTransitive\",
     \"GeTTotal\", \"GeqTTransitive\", \"GeqTTotal\", \"EqTSOrdRel\",
     \"EqFSOrdRel\", \"EqTOrdRel\", \"EqFOrdRel\", \"LeTGeTRel\",
     \"LeqTGetTRel\", \"GeTLeTRel\", \"GeqTLeqTRel\", \"LeTGeFEqFRel\",
     \"LeqTGeFRel\", \"GeTLeFEqFRel\", \"GeqTLeFRel\",
     \"LeqTLeTEqTRel\", \"GeqTGeTEqTRel\", \"LeFGeFRel\",
     \"LeqFGetFRel\", \"GeFLeFRel\", \"GeqFLeqFRel\", \"LeFGeTEqTRel\",
     \"LeqFGeTRel\", \"GeFLeTEqTRel\", \"GeqFLeTRel\",
     \"LeqFLeFEqFRel\", \"GeqFGeFEqFRel\", \"LeTGeqFRel\",
     \"GeTLeqFRel\", \"LeLtDef\", \"LeEqDef\", \"LeGtDef\", \"LqLtDef\",
     \"LqEqDef\", \"LqGtDef\", \"GeLtDef\", \"GeEqDef\", \"GeGtDef\",
     \"GqLtDef\", \"GqEqDef\", \"GqGtDef\", \"MaxYDef\", \"MaxXDef\",
     \"MinXDef\", \"MinYDef\", \"TO1\", \"TO2\", \"TO3\", \"TO4\",
     \"TO5\", \"TO6\", \"TO7\", \"IOO1\", \"IOO2\", \"IOO3\", \"IOO13\",
     \"IOO14\", \"IOO15\", \"IOO16\", \"IOO17\", \"IOO18\", \"IOO19\",
     \"IOO20\", \"IOO21\", \"IOO22\", \"IOO23\", \"IOO24\", \"IOO25\",
     \"IOO26\", \"IOO27\", \"IOO28\", \"IOO29\", \"IOO30\", \"IOO31\",
     \"IOO32\", \"IOO33\", \"IBO1\", \"IBO4\", \"IBO5\", \"IBO6\",
     \"IBO7\", \"IBO8\", \"IBO9\", \"IBO10\", \"IBO11\", \"IBO12\",
     \"IUO01\", \"IUO02\", \"IUO03\", \"IUO04\", \"IUO05\", \"IUO06\",
     \"IUO07\", \"ga_select_pre\", \"X1DefNat\", \"X2DefNat\",
     \"X3DefNat\", \"X4DefNat\", \"X5DefNat\", \"X6DefNat\",
     \"X7DefNat\", \"X8DefNat\", \"X9DefNat\", \"DecimalDef\",
     \"LeqDef1Nat\", \"LeqDef2Nat\", \"LeqDef3Nat\", \"GeqDefNat\",
     \"LessDefNat\", \"GreaterDefNat\", \"Even0Nat\", \"EvenSucNat\",
     \"OddDefNat\", \"Factorial0\", \"FactorialSuc\", \"Add0Nat\",
     \"AddSucNat\", \"Mult0Nat\", \"MultSucNat\", \"Power0Nat\",
     \"PowerSucNat\", \"SubTotalDef1Nat\", \"SubTotalDef2Nat\",
     \"SubDefNat\", \"Divide0Nat1\", \"Divide0Nat\", \"DividePosNat\",
     \"DivNat\", \"ModNat\"]"

typedecl Unit

datatype Bool = X_False ("False''") | X_True ("True''")
datatype Ordering = EQ | GT | LT
datatype Nat = X0 ("0''") | X_suc "Nat" ("suc/'(_')" [3] 999)

consts
Not__X :: "Bool => Bool" ("(Not''/ _)" [56] 56)
X1 :: "Nat" ("1''")
X2 :: "Nat" ("2")
X3 :: "Nat" ("3")
X4 :: "Nat" ("4")
X5 :: "Nat" ("5")
X6 :: "Nat" ("6")
X7 :: "Nat" ("7")
X8 :: "Nat" ("8")
X9 :: "Nat" ("9")
X__XAmpXAmp__X :: "Bool => Bool => Bool" ("(_/ &&/ _)" [54,54] 52)
X__XAtXAt__X :: "Nat => Nat => Nat" ("(_/ @@/ _)" [54,54] 52)
X__XCaret__X :: "Nat => Nat => Nat" ("(_/ ^''/ _)" [54,54] 52)
X__XEqXEq__X :: "'a => 'a => Bool" ("(_/ ==''/ _)" [54,54] 52)
X__XExclam :: "Nat => Nat" ("(_/ !'')" [58] 58)
X__XGtXEq__X :: "'a => 'a => Bool" ("(_/ >=''/ _)" [54,54] 52)
X__XGt__X :: "'a => 'a => Bool" ("(_/ >''/ _)" [54,54] 52)
X__XLtXEq__X :: "'a => 'a => Bool" ("(_/ <=''/ _)" [54,54] 52)
X__XLt__X :: "'a => 'a => Bool" ("(_/ <''/ _)" [54,54] 52)
X__XMinusXExclam__X :: "Nat => Nat => Nat" ("(_/ -!/ _)" [54,54] 52)
X__XMinusXQuest__X :: "Nat => Nat => Nat option" ("(_/ -?/ _)" [54,54] 52)
X__XPlus__X :: "Nat => Nat => Nat" ("(_/ +''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a => 'a => Bool" ("(_/ '/=/ _)" [54,54] 52)
X__XSlashXQuest__X :: "Nat => Nat => Nat option" ("(_/ '/?/ _)" [54,54] 52)
X__XVBarXVBar__X :: "Bool => Bool => Bool" ("(_/ ||/ _)" [54,54] 52)
X__Xx__X :: "Nat => Nat => Nat" ("(_/ *''/ _)" [54,54] 52)
X__div__X :: "Nat => Nat => Nat option" ("(_/ div''/ _)" [54,54] 52)
X__le__X :: "'a => 'a => bool" ("(_/ le/ _)" [44,44] 42)
X__mod__X :: "Nat => Nat => Nat option" ("(_/ mod''/ _)" [54,54] 52)
X_even :: "Nat => Bool" ("even''/'(_')" [3] 999)
X_maxX1 :: "Nat => Nat => Nat" ("max''/'(_,/ _')" [3,3] 999)
X_maxX2 :: "'a => 'a => 'a"
X_minX1 :: "Nat => Nat => Nat" ("min''/'(_,/ _')" [3,3] 999)
X_minX2 :: "'a => 'a => 'a"
X_odd :: "Nat => Bool" ("odd''/'(_')" [3] 999)
X_pre :: "Nat => Nat option" ("pre/'(_')" [3] 999)
compare :: "'a => 'a => Ordering"
otherwiseH :: "Bool"

instance Bool:: type ..
instance Nat:: type ..
instance Ordering:: type ..
instance Unit:: type ..

axioms
NotFalse [rule_format] : "Not' False' = True'"

NotTrue [rule_format] : "Not' True' = False'"

AndDef1 [rule_format] : "False' && False' = False'"

AndDef2 [rule_format] : "False' && True' = False'"

AndDef3 [rule_format] : "True' && False' = False'"

AndDef4 [rule_format] : "True' && True' = True'"

OrDef [rule_format] :
"ALL x. ALL y. x || y = Not' (Not' x && Not' y)"

OtherwiseDef [rule_format] : "otherwiseH = True'"

NotTrue1 [rule_format] : "ALL x. Not' x = True' = (x = False')"

NotFalse2 [rule_format] : "ALL x. Not' x = False' = (x = True')"

TB1 [rule_format] : "~ True' = False'"

EqualTDef [rule_format] : "ALL x. ALL y. x = y --> x ==' y = True'"

SymT [rule_format] :
"ALL x. ALL y. x ==' y = True' = (y ==' x = True')"

SymF [rule_format] :
"ALL x. ALL y. x ==' y = False' = (y ==' x = False')"

ReflexT [rule_format] : "ALL x. x ==' x = True'"

TransT [rule_format] :
"ALL x.
 ALL y.
 ALL z. x ==' y = True' & y ==' z = True' --> x ==' z = True'"

DiffTDef [rule_format] :
"ALL x. ALL y. x /= y = True' = (Not' (x ==' y) = True')"

DiffFDef [rule_format] :
"ALL x. ALL y. x /= y = False' = (x ==' y = True')"

DiffDef2 [rule_format] : "ALL x. ALL y. x /= y = Not' (x ==' y)"

TE1 [rule_format] : "ALL x. ALL y. x ==' y = False' --> ~ x = y"

TE2 [rule_format] :
"ALL x. ALL y. Not' (x ==' y) = True' = (x ==' y = False')"

TE3 [rule_format] :
"ALL x. ALL y. Not' (x ==' y) = False' = (x ==' y = True')"

TE4 [rule_format] :
"ALL x. ALL y. (~ x ==' y = True') = (x ==' y = False')"

IBE1 [rule_format] : "True' ==' True' = True'"

IBE2 [rule_format] : "False' ==' False' = True'"

IBE3 [rule_format] : "True' ==' False' = False'"

IBE4 [rule_format] : "False' ==' True' = False'"

IBE5 [rule_format] : "True' /= False' = True'"

IBE6 [rule_format] : "False' /= True' = True'"

IBE7 [rule_format] : "Not' (True' ==' False') = True'"

IBE8 [rule_format] : "Not' Not' (True' ==' False') = False'"

IUE1 [rule_format] : "() ==' () = True'"

IUE2 [rule_format] : "() /= () = False'"

ALeIrreflexivity [rule_format] : "ALL x. ~ x le x"

ALeAsymmetry [rule_format] : "ALL x. ALL y. x le y --> ~ y le x"

ALeTransitive [rule_format] :
"ALL x. ALL y. ALL z. x le y & y le z --> x le z"

ALeTotal [rule_format] : "ALL x. ALL y. (x le y | y le x) | x = y"

IOE01 [rule_format] : "LT ==' LT = True'"

IOE02 [rule_format] : "EQ ==' EQ = True'"

IOE03 [rule_format] : "GT ==' GT = True'"

IOE04 [rule_format] : "LT ==' EQ = False'"

IOE05 [rule_format] : "LT ==' GT = False'"

IOE06 [rule_format] : "EQ ==' GT = False'"

IOE07 [rule_format] : "LT /= EQ = True'"

IOE08 [rule_format] : "LT /= GT = True'"

IOE09 [rule_format] : "EQ /= GT = True'"

LeDef [rule_format] : "ALL x. ALL y. x <' y = True' = (x le y)"

LeIrreflexivity [rule_format] : "ALL x. x <' x = False'"

LeTAsymmetry [rule_format] :
"ALL x. ALL y. x <' y = True' --> y <' x = False'"

LeTTransitive [rule_format] :
"ALL x.
 ALL y. ALL z. x <' y = True' & y <' z = True' --> x <' z = True'"

LeTTotal [rule_format] :
"ALL x. ALL y. (x <' y = True' | y <' x = True') | x ==' y = True'"

LeqTTransitive [rule_format] :
"ALL x.
 ALL y.
 ALL z. x <=' y = True' & y <=' z = True' --> x <=' z = True'"

LeqTTotal [rule_format] :
"ALL x.
 ALL y. x <=' y = True' & y <=' x = True' --> x ==' y = True'"

GeIrreflexivity [rule_format] : "ALL x. x >' x = False'"

GeTAsymmetry [rule_format] :
"ALL x. ALL y. x >' y = True' --> y >' x = False'"

GeTTransitive [rule_format] :
"ALL x.
 ALL y. ALL z. x >' y = True' & y >' z = True' --> x >' z = True'"

GeTTotal [rule_format] :
"ALL x. ALL y. (x >' y = True' | y >' x = True') | x ==' y = True'"

GeqTTransitive [rule_format] :
"ALL x.
 ALL y.
 ALL z. x >=' y = True' & y >=' z = True' --> x >=' z = True'"

GeqTTotal [rule_format] :
"ALL x.
 ALL y. (x >=' y = True' & y >=' x = True') = (x ==' y = True')"

EqTSOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = True' = (x <' y = False' & x >' y = False')"

EqFSOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = False' = (x <' y = True' | x >' y = True')"

EqTOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = True' = (x <=' y = True' & x >=' y = True')"

EqFOrdRel [rule_format] :
"ALL x.
 ALL y. x ==' y = False' = (x <=' y = True' | x >=' y = True')"

LeTGeTRel [rule_format] :
"ALL x. ALL y. x <' y = True' = (y >' x = True')"

LeqTGetTRel [rule_format] :
"ALL x. ALL y. x <=' y = True' = (y >=' x = True')"

GeTLeTRel [rule_format] :
"ALL x. ALL y. x >' y = True' = (y <' x = True')"

GeqTLeqTRel [rule_format] :
"ALL x. ALL y. x >=' y = True' = (y <=' x = True')"

LeTGeFEqFRel [rule_format] :
"ALL x.
 ALL y. x <' y = True' = (x >' y = False' & x ==' y = False')"

LeqTGeFRel [rule_format] :
"ALL x. ALL y. x <=' y = True' = (x >' y = False')"

GeTLeFEqFRel [rule_format] :
"ALL x.
 ALL y. x >' y = True' = (x <' y = False' & x ==' y = False')"

GeqTLeFRel [rule_format] :
"ALL x. ALL y. x >=' y = True' = (x <' y = False')"

LeqTLeTEqTRel [rule_format] :
"ALL x.
 ALL y. x <=' y = True' = (x <' y = True' | x ==' y = True')"

GeqTGeTEqTRel [rule_format] :
"ALL x.
 ALL y. x >=' y = True' = (x >' y = True' | x ==' y = True')"

LeFGeFRel [rule_format] :
"ALL x. ALL y. x <' y = False' = (y >' x = False')"

LeqFGetFRel [rule_format] :
"ALL x. ALL y. x <=' y = False' = (y >=' x = False')"

GeFLeFRel [rule_format] :
"ALL x. ALL y. x >' y = False' = (y <' x = False')"

GeqFLeqFRel [rule_format] :
"ALL x. ALL y. x >=' y = False' = (y <=' x = False')"

LeFGeTEqTRel [rule_format] :
"ALL x.
 ALL y. x <' y = False' = (x >' y = True' | x ==' y = True')"

LeqFGeTRel [rule_format] :
"ALL x. ALL y. x <=' y = False' = (x >' y = True')"

GeFLeTEqTRel [rule_format] :
"ALL x.
 ALL y. x >' y = False' = (x <' y = True' | x ==' y = True')"

GeqFLeTRel [rule_format] :
"ALL x. ALL y. x >=' y = False' = (x <' y = True')"

LeqFLeFEqFRel [rule_format] :
"ALL x.
 ALL y. x <=' y = False' = (x <' y = False' & x ==' y = False')"

GeqFGeFEqFRel [rule_format] :
"ALL x.
 ALL y. x >=' y = False' = (x >' y = False' & x ==' y = False')"

LeTGeqFRel [rule_format] :
"ALL x. ALL y. x <' y = True' = (x >=' y = False')"

GeTLeqFRel [rule_format] :
"ALL x. ALL y. x >' y = True' = (x <=' y = False')"

LeLtDef [rule_format] :
"ALL x.
 ALL y. compare x y = LT = (x <' y = True' & x ==' y = False')"

LeEqDef [rule_format] :
"ALL x.
 ALL y. compare x y = EQ = (x <' y = False' & y <' x = False')"

LeGtDef [rule_format] :
"ALL x.
 ALL y. compare x y = GT = (x >' y = True' & x ==' y = False')"

LqLtDef [rule_format] :
"ALL x.
 ALL y. (compare x y = LT | compare x y = EQ) = (x <=' y = True')"

LqEqDef [rule_format] :
"ALL x.
 ALL y. compare x y = EQ = (x <=' y = True' & y <=' x = True')"

LqGtDef [rule_format] :
"ALL x. ALL y. compare x y = GT = (x <=' y = False')"

GeLtDef [rule_format] :
"ALL x.
 ALL y. compare x y = LT = (x >' y = False' & x ==' y = False')"

GeEqDef [rule_format] :
"ALL x.
 ALL y. compare x y = EQ = (x >' y = False' & y >' x = False')"

GeGtDef [rule_format] :
"ALL x.
 ALL y. compare x y = GT = (x >' y = True' & x ==' y = False')"

GqLtDef [rule_format] :
"ALL x. ALL y. compare x y = LT = (x >=' y = False')"

GqEqDef [rule_format] :
"ALL x.
 ALL y. compare x y = EQ = (x >=' y = True' & y >=' x = True')"

GqGtDef [rule_format] :
"ALL x.
 ALL y. (compare x y = GT | compare x y = EQ) = (x >=' y = True')"

MaxYDef [rule_format] :
"ALL x. ALL y. X_maxX2 x y = y = (x <=' y = True')"

MaxXDef [rule_format] :
"ALL x. ALL y. X_maxX2 x y = x = (x >' y = True')"

MinXDef [rule_format] :
"ALL x. ALL y. X_minX2 x y = x = (x <=' y = True')"

MinYDef [rule_format] :
"ALL x. ALL y. X_minX2 x y = y = (x >' y = True')"

TO1 [rule_format] :
"ALL x.
 ALL y. (x ==' y = True' | x <' y = True') = (x <=' y = True')"

TO2 [rule_format] :
"ALL x. ALL y. x ==' y = True' --> x <' y = False'"

TO3 [rule_format] :
"ALL x. ALL y. Not' Not' (x <' y) = True' | Not' (x <' y) = True'"

TO4 [rule_format] :
"ALL x. ALL y. x <' y = True' --> Not' (x ==' y) = True'"

TO5 [rule_format] :
"ALL w.
 ALL x.
 ALL y.
 ALL z.
 (x <' y = True' & y <' z = True') & z <' w = True' -->
 x <' w = True'"

TO6 [rule_format] :
"ALL x. ALL z. z <' x = True' --> Not' (x <' z) = True'"

TO7 [rule_format] :
"ALL x. ALL y. x <' y = True' = (y >' x = True')"

IOO1 [rule_format] : "LT le EQ"

IOO2 [rule_format] : "EQ le GT"

IOO3 [rule_format] : "LT le GT"

IOO13 [rule_format] : "LT <' EQ = True'"

IOO14 [rule_format] : "EQ <' GT = True'"

IOO15 [rule_format] : "LT <' GT = True'"

IOO16 [rule_format] : "LT <=' EQ = True'"

IOO17 [rule_format] : "EQ <=' GT = True'"

IOO18 [rule_format] : "LT <=' GT = True'"

IOO19 [rule_format] : "EQ >=' LT = True'"

IOO20 [rule_format] : "GT >=' EQ = True'"

IOO21 [rule_format] : "GT >=' LT = True'"

IOO22 [rule_format] : "EQ >' LT = True'"

IOO23 [rule_format] : "GT >' EQ = True'"

IOO24 [rule_format] : "GT >' LT = True'"

IOO25 [rule_format] : "X_maxX2 LT EQ = EQ"

IOO26 [rule_format] : "X_maxX2 EQ GT = GT"

IOO27 [rule_format] : "X_maxX2 LT GT = GT"

IOO28 [rule_format] : "X_minX2 LT EQ = LT"

IOO29 [rule_format] : "X_minX2 EQ GT = EQ"

IOO30 [rule_format] : "X_minX2 LT GT = LT"

IOO31 [rule_format] : "compare LT LT = EQ"

IOO32 [rule_format] : "compare EQ EQ = EQ"

IOO33 [rule_format] : "compare GT GT = EQ"

IBO1 [rule_format] : "False' le True'"

IBO4 [rule_format] : "~ True' le False'"

IBO5 [rule_format] : "False' <' True' = True'"

IBO6 [rule_format] : "False' >=' True' = False'"

IBO7 [rule_format] : "True' >=' False' = True'"

IBO8 [rule_format] : "True' <' False' = False'"

IBO9 [rule_format] : "X_maxX2 False' True' = True'"

IBO10 [rule_format] : "X_minX2 False' True' = False'"

IBO11 [rule_format] : "compare True' True' = EQ"

IBO12 [rule_format] : "compare False' False' = EQ"

IUO01 [rule_format] : "() <=' () = True'"

IUO02 [rule_format] : "() <' () = False'"

IUO03 [rule_format] : "() >=' () = True'"

IUO04 [rule_format] : "() >' () = False'"

IUO05 [rule_format] : "() = ()"

IUO06 [rule_format] : "() = ()"

IUO07 [rule_format] : "compare () () = EQ"

ga_select_pre [rule_format] :
"ALL x_1_1. pre(suc(x_1_1)) = Some x_1_1"

X1DefNat [rule_format] : "1' = suc(0')"

X2DefNat [rule_format] : "2 = suc(1')"

X3DefNat [rule_format] : "3 = suc(2)"

X4DefNat [rule_format] : "4 = suc(3)"

X5DefNat [rule_format] : "5 = suc(4)"

X6DefNat [rule_format] : "6 = suc(5)"

X7DefNat [rule_format] : "7 = suc(6)"

X8DefNat [rule_format] : "8 = suc(7)"

X9DefNat [rule_format] : "9 = suc(8)"

DecimalDef [rule_format] :
"ALL m. ALL X_n. m @@ X_n = (m *' suc(9)) +' X_n"

LeqDef1Nat [rule_format] : "ALL X_n. 0' <=' X_n = True'"

LeqDef2Nat [rule_format] : "ALL X_n. suc(X_n) <=' 0' = False'"

LeqDef3Nat [rule_format] :
"ALL m. ALL X_n. suc(m) <=' suc(X_n) = True' = (m <=' X_n = True')"

GeqDefNat [rule_format] :
"ALL m. ALL X_n. m >=' X_n = True' = (X_n <=' m = True')"

LessDefNat [rule_format] :
"ALL m.
 ALL X_n.
 m <' X_n = True' = (m <=' X_n = True' & m ==' X_n = False')"

GreaterDefNat [rule_format] :
"ALL m. ALL X_n. m >' X_n = True' = (X_n <' m = True')"

Even0Nat [rule_format] : "even'(0') = True'"

EvenSucNat [rule_format] :
"ALL m. even'(suc(m)) = True' = (odd'(m) = True')"

OddDefNat [rule_format] :
"ALL m. odd'(m) = True' = (even'(m) = False')"

Factorial0 [rule_format] : "0' !' = 1'"

FactorialSuc [rule_format] :
"ALL X_n. suc(X_n) !' = suc(X_n) *' X_n !'"

Add0Nat [rule_format] : "ALL m. 0' +' m = m"

AddSucNat [rule_format] :
"ALL m. ALL X_n. suc(X_n) +' m = suc(X_n +' m)"

Mult0Nat [rule_format] : "ALL m. 0' *' m = 0'"

MultSucNat [rule_format] :
"ALL m. ALL X_n. suc(X_n) *' m = (X_n *' m) +' m"

Power0Nat [rule_format] : "ALL m. m ^' 0' = 1'"

PowerSucNat [rule_format] :
"ALL m. ALL X_n. m ^' suc(X_n) = m *' (m ^' X_n)"

SubTotalDef1Nat [rule_format] :
"ALL m. ALL X_n. m >' X_n = True' --> X_n -! m = 0'"

SubTotalDef2Nat [rule_format] :
"ALL m. ALL X_n. m <=' X_n = True' --> Some (X_n -! m) = X_n -? m"

SubDefNat [rule_format] :
"ALL m. ALL X_n. ALL r. m -? X_n = Some r = (m = r +' X_n)"

Divide0Nat1 [rule_format] :
"ALL m. ALL X_n. X_n ==' 0' = True' --> ~ defOp (m /? X_n)"

Divide0Nat [rule_format] : "ALL m. ~ defOp (m /? 0')"

DividePosNat [rule_format] :
"ALL m.
 ALL X_n.
 ALL r. X_n >' 0' = True' --> m /? X_n = Some r = (m = r *' X_n)"

DivNat [rule_format] :
"ALL m.
 ALL X_n.
 ALL r.
 m div' X_n = Some r =
 (EX s. m = (X_n *' r) +' s & s <' X_n = True')"

ModNat [rule_format] :
"ALL m.
 ALL X_n.
 ALL s.
 m mod' X_n = Some s =
 (EX r. m = (X_n *' r) +' s & s <' X_n = True')"

declare NotFalse [simp]
declare NotTrue [simp]
declare AndDef1 [simp]
declare AndDef2 [simp]
declare AndDef3 [simp]
declare AndDef4 [simp]
declare ReflexT [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare ALeIrreflexivity [simp]
declare ALeAsymmetry [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare TO2 [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IOO1 [simp]
declare IOO2 [simp]
declare IOO3 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO1 [simp]
declare IBO4 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare ga_select_pre [simp]
declare LeqDef1Nat [simp]
declare LeqDef2Nat [simp]
declare Even0Nat [simp]
declare Factorial0 [simp]
declare Add0Nat [simp]
declare Mult0Nat [simp]
declare Power0Nat [simp]
declare SubTotalDef1Nat [simp]
declare SubTotalDef2Nat [simp]
declare Divide0Nat1 [simp]
declare Divide0Nat [simp]

theorem SubDomNat :
"ALL m. ALL X_n. defOp (m -? X_n) = (m >=' X_n = True')"
apply(auto)
apply(rename_tac x y)
apply(case_tac "x -? y")
apply(auto)
apply(simp add: SubDefNat)
apply(case_tac "a +' y")
apply(auto)
apply(simp add: GeqTLeqTRel)

apply(simp add: LeqTDef)
apply(auto)

using X1DefNat X2DefNat X3DefNat X4DefNat X5DefNat X6DefNat X7DefNat X8DefNat X9DefNat DecimalDef by auto

ML "Header.record \"SubDomNat\""

theorem DivideDomNat :
"ALL m.
 ALL X_n.
 defOp (m /? X_n) = (X_n ==' 0' = False' & m mod' X_n = Some 0')"
using X1DefNat X2DefNat X3DefNat X4DefNat X5DefNat X6DefNat X7DefNat X8DefNat X9DefNat DecimalDef by auto

ML "Header.record \"DivideDomNat\""

theorem DivDomNat :
"ALL m. ALL X_n. defOp (m div' X_n) = (~ X_n = 0')"
using X1DefNat X2DefNat X3DefNat X4DefNat X5DefNat X6DefNat X7DefNat X8DefNat X9DefNat DecimalDef by auto

ML "Header.record \"DivDomNat\""

theorem ModDomNat :
"ALL m. ALL X_n. defOp (m mod' X_n) = (~ X_n = 0')"
using X1DefNat X2DefNat X3DefNat X4DefNat X5DefNat X6DefNat X7DefNat X8DefNat X9DefNat DecimalDef by auto

ML "Header.record \"ModDomNat\""

theorem Distr1Nat :
"ALL r. ALL s. ALL t. (r +' s) *' t = (r *' t) +' (s *' t)"
using X1DefNat X2DefNat X3DefNat X4DefNat X5DefNat X6DefNat X7DefNat X8DefNat X9DefNat DecimalDef by auto

ML "Header.record \"Distr1Nat\""

theorem Distr2Nat :
"ALL r. ALL s. ALL t. t *' (r +' s) = (t *' r) +' (t *' s)"
using X1DefNat X2DefNat X3DefNat X4DefNat X5DefNat X6DefNat X7DefNat X8DefNat X9DefNat DecimalDef by auto

ML "Header.record \"Distr2Nat\""

end


section "Current Proofs"

theory Current_Proof
imports Current Stack_Proof
begin

lemma push_list [simp]: "list (push x current) = x # list current"
  by(induction x current rule: push.induct) auto

lemma pop_list: "\<lbrakk>\<not> is_empty current; pop current = (x, current')\<rbrakk>
  \<Longrightarrow> x # list current' = list current"
  by(induction current arbitrary: x rule: pop.induct)(auto simp: list_not_empty)

lemma pop_list_size: "\<lbrakk>invar current; 0 < size current; pop current = (x, current')\<rbrakk>
  \<Longrightarrow> x # list current' = list current"
  by(induction current arbitrary: x rule: pop.induct)(auto simp: size_not_empty list_not_empty)

lemma drop_first_list [simp]:
    "\<not> is_empty current \<Longrightarrow> list (drop_first current) = tl (list current)"
  by(induction current rule: pop.induct)(auto simp: drop_Suc)

lemma pop_list_2 [simp]:
    "\<lbrakk>0 < size current; invar current\<rbrakk> \<Longrightarrow> fst (pop current) # tl (list current) = list current"
  by(induction current rule: pop.induct)(auto simp: size_not_empty list_not_empty)

lemma drop_first_list_size [simp]: "\<lbrakk>invar current; 0 < size current\<rbrakk>
  \<Longrightarrow> list (drop_first current) = tl (list current)"
  by(induction current rule: pop.induct)(auto simp: drop_Suc)

lemma invar_push: "invar current \<Longrightarrow> invar (push x current)"
  by(induction x current rule: push.induct) auto

lemma invar_pop: "\<lbrakk>\<not> is_empty current; invar current; pop current = (x, current')\<rbrakk>
   \<Longrightarrow> invar current'"
  by(induction current arbitrary: x rule: pop.induct) auto

lemma invar_size_pop: "\<lbrakk>0 < size current; invar current; pop current = (x, current')\<rbrakk>
   \<Longrightarrow> invar current'"
  by(induction current arbitrary: x rule: pop.induct) auto

lemma invar_size_drop_first: "\<lbrakk>0 < size current; invar current\<rbrakk> \<Longrightarrow> invar (drop_first current)"
  using invar_size_pop
  by (metis eq_snd_iff)

lemma invar_drop_first: "\<lbrakk>\<not> is_empty current; invar current\<rbrakk> \<Longrightarrow> invar (drop_first current)"
  by(induction current rule: pop.induct) auto

lemma push_not_empty [simp]: "\<lbrakk>\<not> is_empty current; is_empty (push x current)\<rbrakk> \<Longrightarrow> False"
  by(induction x current rule: push.induct) auto

(* TODO: not optimal with only one direction (Is it really needed?) *)
lemma size_empty: "invar (current :: 'a current) \<Longrightarrow> size current = 0 \<Longrightarrow> is_empty current"
  by(induction current)(auto simp: size_empty)

lemma size_new_empty: "invar (current :: 'a current) \<Longrightarrow> size_new current = 0 \<Longrightarrow> is_empty current"
  by(induction current)(auto simp: size_empty)

lemma list_not_empty [simp]: "\<lbrakk>list current = []; \<not>is_empty current\<rbrakk> \<Longrightarrow> False"
  by(induction current)(auto simp: list_empty)

lemma list_size [simp]: "\<lbrakk>invar current; list current = []; 0 < size current\<rbrakk> \<Longrightarrow> False"
  by(induction current)(auto simp: size_not_empty list_empty)

lemma size_new_push [simp]: "invar current \<Longrightarrow> size_new (push x current) = Suc (size_new current)"
  by(induction x current rule: push.induct) auto

lemma size_push [simp]: "size (push x current) = Suc (size current)"
  by(induction x current rule: push.induct) auto

lemma size_new_pop [simp]: "\<lbrakk>0 < size_new current; invar current \<rbrakk>
  \<Longrightarrow> Suc (size_new (drop_first current)) = size_new current"
  by(induction current rule: pop.induct) auto

lemma size_pop [simp]: "\<lbrakk>0 < size current; invar current \<rbrakk>
   \<Longrightarrow> Suc (size (drop_first current)) = size current"
  by(induction current rule: pop.induct) auto

lemma size_pop_suc [simp]: "\<lbrakk>0 < size current; invar current; pop current = (x, current') \<rbrakk>
   \<Longrightarrow> Suc (size current') = size current"
  by(induction current rule: pop.induct) auto

lemma size_pop_sub: "\<lbrakk>0 < size current; invar current; pop current = (x, current') \<rbrakk>
   \<Longrightarrow> size current' = size current - 1"
  by(induction current rule: pop.induct) auto

lemma size_drop_first_sub: "\<lbrakk>0 < size current; invar current \<rbrakk>
   \<Longrightarrow> size (drop_first current) = size current - 1"
  by(induction current rule: pop.induct) auto

end


theory Dutch_National_Flag_Monad
imports
  "Dutch_National_Flag_Monad_Definitions_Lemmas"
  "HOL-Library.LaTeXsugar"
begin

section\<open>Proof of DNFP\<close>
text\<open>A version using a state-monad for storing the array and the intermediate variable.
This function takes a parameter that defines the size of the unsorted array (the difference between the variables @{text high} and @{text i} due to the invariant on the ranges).
This makes the recursion well-defined and will ensure termination since @{text loop_update_action} decreases the difference for every single call\<close>
fun dnfp_mon:: "nat \<Rightarrow> (env, unit) state" where
  case0:"dnfp_mon 0  = skip"|
  caseN:"dnfp_mon (Suc n) = do {
                        (h, j) \<leftarrow> get (\<lambda>e. (high e, i e));
                        (if h > j then do{
                          loop_update_action;
                          dnfp_mon n
                         }
                       else skip
                      )}"

subsection\<open>DNFP - Invariants proof\<close>
text\<open>These proofs show that @{text dnfp_mon} preserves the invariants.
   They use the already established lemmas about how the definitions/functions that @{text dnfp_mon} consists of all preserve the invariants of the ranges (red, white and blue).\<close>
lemma dnfp_invariantRed: "spec (dnfp_inv1) (dnfp_mon n) (GG dnfp_inv1)"
  unfolding dnfp_inv1_def GG_def
  apply(induction n rule: dnfp_mon.induct)
  apply(simp add: spec_def skip_def)
  apply(simp only: caseN)
  apply(intro get_rule; intro allI; clarify)
  apply(intro cond_rule; simp)
  apply(simp add: loop_update_action_def)
  apply(intro get_rule; intro allI; clarify)
  apply(intro seq_rule[of _ _ "(\<lambda>x e. dnfp_variables_invariants e \<and> low_invariant_is_0_Env e)"])
  apply(intro cond_rule)
  apply (smt GG_def Pair_inject dnfp_inv1_def inc_lowbound_inv1_def inc_lowbound_invariantRed less_numeral_extra(1) loop_update_action_inv1_def loop_update_action_pre_def spec_def split_beta')
  apply (smt GG_def Pair_inject dec_highbound_inv1_def dec_highbound_invariantRed dnfp_inv1_def loop_update_action_inv1_def loop_update_action_pre_def spec_def split_beta')
  apply (smt GG_def Pair_inject dnfp_inv1_def inc_index_inv1_def inc_index_invariantRed less_one loop_update_action_inv1_def loop_update_action_pre_def spec_def split_beta')
  apply blast
  by(simp add: spec_def skip_def)

lemma dnfp_invariantWhite: "spec dnfp_inv2 (dnfp_mon n) (GG dnfp_inv2)"
  unfolding dnfp_inv2_def  GG_def
  apply(induction n rule: dnfp_mon.induct)
  apply(simp add: spec_def skip_def)
  apply(simp only: caseN)
  apply(intro get_rule; intro allI; clarify)
  apply(intro cond_rule; simp)
  apply(simp add: loop_update_action_def)
  apply(intro get_rule; intro allI; clarify)
  apply(intro seq_rule[of _ _ "(\<lambda>x e. dnfp_variables_invariants e \<and> invariant_low_to_j_is_1_Env e)"])
  apply(intro cond_rule; simp)
  apply (smt GG_def dnfp_inv2_def inc_lowbound_inv2_def inc_lowbound_invariantWhite less_numeral_extra(1) loop_update_action_inv2_def loop_update_action_pre_def spec_def split_beta')
  apply (smt GG_def One_nat_def dec_highbound_inv2_def dec_highbound_invariantWhite dnfp_inv2_def loop_update_action_inv2_def loop_update_action_pre_def spec_def split_beta')
  apply (smt GG_def One_nat_def dnfp_inv2_def inc_index_inv2_def inc_index_invariantWhite loop_update_action_inv2_def loop_update_action_pre_def not_less_eq spec_def split_beta')
  apply blast
  by(simp add: spec_def skip_def)

lemma dnfp_invariantBlue: "spec dnfp_inv3 (dnfp_mon n) (GG dnfp_inv3)"
  unfolding dnfp_inv3_def GG_def
  apply(induction n rule: dnfp_mon.induct)
  apply(simp add: spec_def skip_def)
  apply(simp only: caseN)
  apply(intro get_rule; intro allI; clarify)
  apply(intro cond_rule; simp)
  apply(simp add: loop_update_action_def)
  apply(intro get_rule; intro allI; clarify)
  apply(intro seq_rule[of _ _ "(\<lambda>x e. dnfp_variables_invariants e \<and> high_invariant_is_2_Env e)"])
  apply (intro cond_rule; simp)
  apply (smt GG_def dnfp_inv3_def inc_lowbound_inv3_def inc_lowbound_invariantBlue less_numeral_extra(1) loop_update_action_inv3_def loop_update_action_pre_def spec_def split_beta')
  apply (smt GG_def One_nat_def dec_highbound_inv3_def dec_highbound_invariantBlue dnfp_inv3_def loop_update_action_inv3_def loop_update_action_pre_def spec_def split_beta')
  apply (smt GG_def One_nat_def dnfp_inv3_def inc_index_inv3_def inc_index_invariantBlue loop_update_action_inv3_def loop_update_action_pre_def not_less_eq spec_def split_beta')
  apply blast
  by(simp add: spec_def skip_def)

text\<open>All invariants are preserved by the dnfp-function\<close>
lemma dnfp_mon_invariants: "spec (dnfp_inv) (dnfp_mon n) (GG dnfp_inv)"
  by (smt GG_def dnfp_invariantBlue dnfp_invariantRed dnfp_invariantWhite dnfp_inv_def spec_def split_def)

subsection\<open>Aux. proofs of the DNFP\<close>
text\<open>@{text Dnfp_mon} preserves the invariants on the ranges and the bounds of the variables. This proof is actually not necessary to proof that the method sorts the array\<close>
lemma dnfp_env_inv: "spec (dnfp_mon_spec) (dnfp_mon n) (GG dnfp_mon_spec)"
  unfolding GG_def dnfp_mon_spec_def
  apply(induction n rule: dnfp_mon.induct)
  apply(simp add: spec_def skip_def)
  apply(simp only: caseN)
  apply(intro get_rule; intro allI; clarify)
  apply(intro cond_rule)
  apply(simp add: loop_update_action_def)
  apply(intro get_rule; intro allI; clarify)
  apply(intro seq_rule[of _ _ "(\<lambda>x e. dnfp_variables_invariants e \<and> dnfp_inv e)"])
  apply(intro cond_rule)
  apply (smt GG_def Pair_inject dnfp_inv1_def dnfp_inv_def inc_lowbound_inv1_def inc_lowbound_inv2_def inc_lowbound_inv3_def inc_lowbound_invariantBlue inc_lowbound_invariantRed inc_lowbound_invariantWhite less_numeral_extra(1) loop_update_action_inv1_def loop_update_action_inv2_def loop_update_action_inv3_def loop_update_action_pre_def spec_def split_beta')
  apply (smt GG_def Pair_inject dec_highbound_inv1_def dec_highbound_inv2_def dec_highbound_inv3_def dec_highbound_invariantBlue dec_highbound_invariantRed dec_highbound_invariantWhite dnfp_inv1_def dnfp_inv_def loop_update_action_inv1_def loop_update_action_inv2_def loop_update_action_inv3_def loop_update_action_pre_def spec_def split_beta')
  apply (smt GG_def Pair_inject dnfp_inv1_def dnfp_inv_def inc_index_inv1_def inc_index_inv2_def inc_index_inv3_def inc_index_invariantBlue inc_index_invariantRed inc_index_invariantWhite less_one loop_update_action_inv1_def loop_update_action_inv2_def loop_update_action_inv3_def loop_update_action_pre_def spec_def split_beta')
  apply blast
  by(simp add: spec_def skip_def)

text\<open>This lemma is used to establish that variables @{text high} and @{text i} will be equal if the variables are initiated with the right value (defined by the invariant on the environment @{text dnfp_variables_invariants})\<close>
lemma aux1: "(spec (\<lambda>e. dnfp_variables_invariants e \<and> n = high e - i e) (dnfp_mon n)
                (\<lambda>x e. high e = i e)) \<Longrightarrow>
           spec
            (\<lambda>xa. ((dnfp_variables_invariants xa \<and> Suc n = high xa - i xa) \<and>
                   (high x, i x) = (high xa, i xa)) \<and>
                  i x < high x)
            (loop_update_action \<bind> (\<lambda>_. dnfp_mon n)) (\<lambda>x e. high e = i e)"
  apply(intro seq_rule[of _ _ "(\<lambda>x e. dnfp_variables_invariants e
                                \<and> n = high e - i e)"])
  apply(simp add: loop_update_action_def)
  apply(intro get_rule; intro allI; clarify)
  apply(intro cond_rule)
  apply(simp add: inc_lowbound_def)
  apply(intro get_rule; intro allI; simp)
  apply(intro seq_rule[of _ _ "(\<lambda>x e. Suc n = high e - i e \<and> high e > i e \<and> dnfp_variables_invariants e)"])
  apply(simp add: spec_def swap_def xs_Env_def put_def get_state_def put_state_def dnfp_variables_invariants_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(intro seq_rule[of _ _ "(\<lambda>x e. n = high e - i e \<and> dnfp_variables_invariants e \<and> i e > low e)"])
  apply(simp add: spec_def i_Env_def put_def get_state_def put_state_def dnfp_variables_invariants_def)
  apply linarith
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply(simp add: spec_def low_Env_def put_def get_state_def put_state_def dnfp_variables_invariants_def)
  apply(simp add: dec_highbound_def)
  apply(intro get_rule; intro allI; simp)
  apply(intro seq_rule[of _ _ "(\<lambda>x e. n = high e - i e \<and> dnfp_variables_invariants e)"])
  apply(simp add: spec_def high_Env_def put_def get_state_def put_state_def dnfp_variables_invariants_def)
  apply linarith
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply(simp add: spec_def swap_def xs_Env_def put_def get_state_def put_state_def dnfp_variables_invariants_def)
  apply(simp add: inc_index_def)
  apply(intro get_rule; intro allI; simp)
  apply(simp add: spec_def i_Env_def put_def get_state_def put_state_def dnfp_variables_invariants_def)
  apply linarith
  by blast

subsection\<open>Main proofs\<close>
text\<open>If @{text dnfp_mon} is called with a proper environment and the parameter of the function @{text n} is the difference between the variables @{text high} and @{text i}.
When @{text high} and @{text i} will be equal after the termination of the function.
This lemma can be used the termination. And this proof can together with the dnfp-mon main-proof be used to prove that @{text dnfp_mon} will sort the array \<close>
lemma dnfp_mon_termination: "spec (dnfp_mon_pre n) (dnfp_mon n) (GG (i_high_equal n))"
  unfolding GG_def dnfp_mon_pre_def dnfp_mon_spec_def i_high_equal_def
  apply(induction n rule: dnfp_mon.induct)
  apply(simp add: spec_def skip_def dnfp_variables_invariants_def)
  apply(simp only: caseN)
  apply(intro get_rule; intro allI; clarify)
  apply(intro cond_rule)
  using aux1 apply blast
  by(simp add: spec_def skip_def dnfp_variables_invariants_def)

text\<open>The invariants and the fact @{text i} = @{text high} means that the the entire array will be sorted.
    This lemma makes it possible to show that @{text dnfp_mon} will sort the array\<close>
lemma dnfp_mon_isSorted: "dnfp_post_final_spec e \<Longrightarrow> (array_sorted e)"
  unfolding dnfp_post_final_spec_def dnfp_inv_def array_sorted_def
  by (smt Suc_1 Suc_leD dnfp_inv1_def dnfp_inv2_def dnfp_inv3_def high_invariant_is_2_Env_def invariant_low_to_j_is_1_Env_def less_numeral_extra(1) less_or_eq_imp_le less_trans low_invariant_is_0_Env_def not_less sorted_iff_nth_mono_less)

text\<open>The array is sorted after the termination of the dnfp function.
  This proof depends mainly on two proofs.
\begin{enumerate}
  \item The variables @{text i} and @{text high} are equal by the termination of @{text dnfp_mon}
  \item @{text Dnfp_mon} preserves the invariant of the ranges.
\end{enumerate}
These two facts are by the proof of lemma @{text dnfp_mon_isSorted} enough to show that the array is sorted in the final state.\<close>
theorem dnfp_mon_main_list_sorted: "spec (dnfp_mon_spec_aux n) (dnfp_mon n) (GG array_sorted)"
  unfolding GG_def dnfp_mon_spec_aux_def
  apply(induction n rule: dnfp_mon.induct)
   apply (simp add: spec_def skip_def  dnfp_mon_spec_def  dnfp_variables_invariants_def)
  using array_sorted_def dnfp_mon_isSorted dnfp_post_final_spec_def le_antisym apply blast
  by (smt GG_def case_prod_beta' dnfp_mon_invariants dnfp_mon_isSorted dnfp_mon_pre_def dnfp_mon_spec_def dnfp_mon_termination dnfp_post_final_spec_def i_high_equal_def spec_def)

section\<open>Examples of DNFP\<close>
text\<open>The definiton of how to set up the state-monad/environment with the right values based on an array.\<close>
definition init_env:: "nat array \<Rightarrow> env" where
  "init_env l \<equiv> \<lparr>high = (length l),            low = 0,
                 i = 0,                         xs = l\<rparr>"

text\<open>An alternative way to initialize a record\<close>
definition init_env2:: "nat array \<Rightarrow> env" where
  "init_env2 l \<equiv> env.make (length l) 0 0 l"

lemma "init_env l = init_env2 l"
  by(simp add: init_env_def init_env2_def env.defs)

text\<open>A proof to show that the init-env will satisfy the invariant of the environment\<close>
lemma "e = (init_env x) \<and> set(x) \<subseteq> {0,1,2} \<Longrightarrow> dnfp_variables_invariants e"
  unfolding init_env_def dnfp_variables_invariants_def
  by simp

text\<open>This is just some examples of how to run the algorithm and some concrete assertions\<close>
value \<open>snd(run_state (dnfp_mon 5) (init_env [0,2,2,1,2]))\<close>
value \<open>snd(run_state (dnfp_mon 9) (init_env [0,2,2,0,1,0,2,1,2]))\<close>
value \<open>snd(run_state (dnfp_mon 3)(init_env [2,1,0]))\<close>

value \<open>assert(sorted(xs(snd(run_state (dnfp_mon 5) (init_env[0,2,2,1,2])))))\<close>
value \<open>assert(sorted(xs(snd(run_state (dnfp_mon 9) (init_env[0,2,2,0,1,0,2,1,2])))))\<close>
value \<open>assert(sorted(xs(snd(run_state (dnfp_mon 3) (init_env[2,1,0])))))\<close>

section\<open>Experiences\<close>
text\<open>A general rule of thumb when carrying out a single proof is to divide the methods as much as possible and limit the number of parameters. By following these rules, it simplifies the proof substantial since it is a lot easier to proof five small methods compared to one big. It is also far easier to reason about small methods.
It is also vital to establish a hierarchy of pre- and post-conditions that can be used in the proof. This hierarchy enables the reuse of lemmas of the simple methods inside the compound methods.\<close>
text\<open>Not all programs work with the current syntax. An example of this is two get-statements in a row inside a method. This syntax is currently not supported by the HOL proof-rules. Instead, the two get-statements should be captured into one get-statement that returns multiple values.
     I also have experienced how methods higher-order functions like @{text nths} from the list library should be avoided, since they have bad proof-support. Instead, quantifiers should be used when working with lists.\<close>

text\<open>I have also learned that if a proof can't be proved by first rewriting and afterward Sledgehammer. It means that either it is unprovable or Isabelle needs some more information to prove it. This information can be given by adding some more lemmas. An example of this is the lemmas that can be seen the section Aux. lemmas about values inside the array.\<close>
end


theory GenEnv
  imports Main
begin

type_synonym 'a gen_env = "string \<Rightarrow> 'a option"

definition empty_env where
  "empty_env x = None"

definition add_env where
  "add_env env x t = (\<lambda> x'. if x = x' then Some t else env x')"

definition rem_env where
  "rem_env env x = (\<lambda> x'. if x = x' then None else env x')"

definition fresh_var where
  "fresh_var s y = (s y = None)"

    (* #### basic add/rem lemmas #### *)

lemma almost_comm_add_env: "\<lbrakk> x \<noteq> y \<rbrakk> \<Longrightarrow> add_env (add_env env y t) x t' = add_env (add_env env x t') y t"
  apply (simp add: add_env_def)
  apply (auto)
  done

lemma double_add_env: "add_env (add_env env x t) x t' = add_env env x t'"
  apply (simp add: add_env_def)
  apply (auto)
  done

lemma ignore_rem_env: "\<lbrakk> env x = None \<rbrakk> \<Longrightarrow> env = rem_env env x"
  apply (case_tac "\<forall> x'. env x' = rem_env env x x'")
   apply (auto)
  apply (simp add: rem_env_def)
  apply (case_tac "x = x'")
   apply (auto)
  done

lemma cancel_rem_add_env: "\<lbrakk> env x = None \<rbrakk> \<Longrightarrow> env = rem_env (add_env env x t) x"
  apply (case_tac "\<forall> x'. env x' = rem_env (add_env env x t) x x'")
   apply (auto)
  apply (simp add: add_env_def)
  apply (simp add: rem_env_def)
  apply (case_tac "x = x'")
   apply (auto)
  done

lemma partial_add_rem_env: "add_env (rem_env env x) x t = add_env env x t"
  apply (case_tac "\<forall> x'. add_env (rem_env env x) x t x' = add_env env x t x'")
   apply (auto)
  apply (simp add: add_env_def)
  apply (case_tac "x = x'")
   apply (auto)
  apply (simp add: rem_env_def)
  done

lemma cancel_add_rem_env: "\<lbrakk> env x = Some y \<rbrakk> \<Longrightarrow> env = add_env (rem_env env x) x y"
  apply (case_tac "\<forall> x'. env x' = add_env (rem_env env x) x y x'")
   apply (auto)
  apply (simp add: add_env_def)
  apply (case_tac "x = x'")
   apply (auto)
  apply (simp add: rem_env_def)
  done

lemma partial_rem_add_env: "rem_env (add_env env x y) x = rem_env env x"
  apply (case_tac "\<forall> x'. rem_env (add_env env x y) x x' = rem_env env x x'")
   apply (auto)
  apply (simp add: rem_env_def)
  apply (case_tac "x = x'")
   apply (auto)
  apply (simp add: add_env_def)
  done

lemma almost_comm_add_rem_env: "\<lbrakk> x \<noteq> y \<rbrakk> \<Longrightarrow> add_env (rem_env env x) y t = rem_env (add_env env y t) x"
  apply (case_tac "\<forall> x'. add_env (rem_env env x) y t x' = rem_env (add_env env y t) x x'")
   apply (auto)
  apply (simp add: add_env_def)
  apply (simp add: rem_env_def)
  apply (case_tac "y = x'")
   apply (auto)
  apply (simp add: rem_env_def)
  apply (case_tac "x = x'")
   apply (auto)
  done

lemma double_rem_env: "rem_env (rem_env env x) x = rem_env env x"
  apply (case_tac "\<forall> y. rem_env (rem_env env x) x y = rem_env env x y")
   apply (auto)
  apply (simp add: rem_env_def)
  apply (auto)
  done

lemma almost_comm_rem_env: "\<lbrakk> x \<noteq> y \<rbrakk> \<Longrightarrow> rem_env (rem_env env x) y = rem_env (rem_env env y) x"
  apply (case_tac "\<forall> z. rem_env (rem_env env x) y z = rem_env (rem_env env y) x z")
   apply (auto)
  apply (simp add: rem_env_def)
  apply (auto)
  done

end