section "Dequeue Proofs"

theory RealTimeDeque_Dequeue_Proof
imports Deque RealTimeDeque_Aux States_Proof
begin

lemma list_deqL' [simp]: "\<lbrakk>invar deque; listL deque \<noteq> []; deqL' deque = (x, deque')\<rbrakk>
   \<Longrightarrow> x # listL deque' = listL deque"
proof(induction deque arbitrary: x rule: deqL'.induct)
  case (4 left right length_right)

  then obtain left' where pop_left[simp]: "Idle.pop left = (x, left')"
    by(auto simp: Let_def split: if_splits stack.splits prod.splits idle.splits)

  then obtain stack_left' length_left'
    where left'[simp]: "left' = idle.Idle stack_left' length_left'"
    using idle.exhaust by blast

  from 4 have invar_left': "invar left'"
    using Idle_Proof.invar_pop[of left]
    by auto

  then have size_left' [simp]: "size stack_left' = length_left'"
    by auto

  have size_left'_size_left [simp]: "size stack_left' = (size left) - 1"
    using Idle_Proof.size_pop_sub[of left x left']
    by auto

  show ?case
  proof(cases "3 * length_left' \<ge> length_right")
    case True
    with 4 pop_left show ?thesis
      using Idle_Proof.pop_list[of left x left']
      by auto
  next
    case False
    note Start_Transformation = False

    then show ?thesis
    proof(cases "length_left' \<ge> 1")
      case True
      let ?big = "Reverse (Current [] 0 right (size right - Suc length_left'))
                           right [] (size right - Suc length_left')"
      let ?small = "Reverse1 (Current [] 0 stack_left' (Suc (2 * length_left'))) stack_left' []"
      let ?states = "States Left ?big ?small"

      from 4 Start_Transformation True invar_left' have invar: "invar ?states"
        by(auto simp: Let_def rev_take rev_drop)

      with 4 Start_Transformation True invar_left'
      have "States_Aux.listL ?states = tl (Idle_Aux.list left) @ rev (Stack_Aux.list right)"
        using pop_list_tl'[of left x left']
        by (auto simp del: take_rev_def)

      with invar
      have "States_Aux.listL ((step^^6) ?states) =
            tl (Idle_Aux.list left) @ rev (Stack_Aux.list right)"
        using step_n_listL[of ?states 6]
        by presburger

      with 4 Start_Transformation True show ?thesis
        by(auto simp: Let_def)
    next
      case False
      from False Start_Transformation 4 have [simp]:"size left = 1"
        using size_left' size_left'_size_left by auto

      with False Start_Transformation 4 have [simp]: "Idle_Aux.list left = [x]"
        by(induction left)(auto simp: length_one_hd split: stack.splits)

      obtain right1 right2 where "right = Stack right1 right2"
        using Stack_Aux.list.cases by blast

      with False Start_Transformation 4 show ?thesis
        by(induction right1 right2 rule: small_deque.induct) auto
    qed
  qed
next
  case (5 big small)

  then have start_invar: "invar (States Left big small)"
    by auto

  from 5 have small_invar: "invar small"
    by auto

  from 5 have small_size: "0 < size small"
    by auto

  with 5(3) obtain small' where pop: "Small.pop small = (x, small')"
    by(cases small)
      (auto simp: Let_def split: states.splits direction.splits state_splits prod.splits)

  let ?states_new = "States Left big small'"
  let ?states_stepped = "(step^^4) ?states_new"

  have invar: "invar ?states_new"
    using pop start_invar small_size invar_pop_small[of Left big small x small']
    by auto

  have "x # Small_Aux.list_current small' = Small_Aux.list_current small"
    using small_invar small_size pop Small_Proof.pop_list_current[of small x small'] by auto

  then have listL:
      "x # States_Aux.listL ?states_new =
       Small_Aux.list_current small @ rev (Big_Aux.list_current big)"
    using invar small_size Small_Proof.pop_list_current[of small x small'] 5(1)
    by auto

  from invar have "invar ?states_stepped"
    using invar_step_n by blast

  then have states_listL_list_current [simp]: "x # States_Aux.listL ?states_stepped =
                Small_Aux.list_current small @ rev (Big_Aux.list_current big)"
    using States_Proof.step_n_listL invar listL by metis

  then have "listL (deqL (Transforming (States Left big small))) = States_Aux.listL ?states_stepped"
    by(auto simp: Let_def pop split: prod.splits direction.splits states.splits state_splits)

  then have states_listL_list_current:
      "x # listL (deqL (Transforming (States Left big small))) =
       Small_Aux.list_current small @ rev (Big_Aux.list_current big)"
    by auto

  with 5(1) have "listL (Transforming (States Left big small)) =
                  Small_Aux.list_current small @ rev (Big_Aux.list_current big)"
    by auto

  with states_listL_list_current
  have "x # listL (deqL (Transforming (States Left big small))) =
        listL (Transforming (States Left big small))"
    by auto

  with 5 show ?case by auto
next
  case (6 big small)
  then have start_invar: "invar (States Right big small)"
    by auto

  from 6 have big_invar: "invar big"
    by auto

  from 6 have big_size: "0 < size big"
    by auto

  with 6(3) obtain big' where pop: "Big.pop big = (x, big')"
    by(cases big)
      (auto simp: Let_def split: prod.splits direction.splits states.splits state_splits)

  let ?states_new = "States Right big' small"
  let ?states_stepped = "(step^^4) ?states_new"

  have invar: "invar ?states_new"
    using pop start_invar big_size invar_pop_big[of Right big small]
    by auto

  have big_list_current: "x # Big_Aux.list_current big' = Big_Aux.list_current big"
    using big_invar big_size pop by auto

  then have listL:
    "x # States_Aux.listL ?states_new =
     Big_Aux.list_current big @ rev (Small_Aux.list_current small)"
    proof(cases "States_Aux.lists ?states_new")
      case (Pair bigs smalls)
      with invar big_list_current show ?thesis
        using app_rev[of smalls bigs]
        by(auto split: prod.splits)
    qed

  from invar have four_steps: "invar ?states_stepped"
    using invar_step_n by blast

  then have [simp]:
      "x # States_Aux.listL ?states_stepped =
       Big_Aux.list_current big @ rev (Small_Aux.list_current small)"
    using States_Proof.step_n_listL[of ?states_new 4] invar listL
    by auto

  then have "listL (deqL (Transforming (States Right big small))) =
              States_Aux.listL ?states_stepped"
    by(auto simp: Let_def pop split: prod.splits direction.splits states.splits state_splits)

  then have listL_list_current:
      "x # listL (deqL (Transforming (States Right big small))) =
       Big_Aux.list_current big @ rev (Small_Aux.list_current small)"
    by auto

  with 6(1) have "listL (Transforming (States Right big small)) =
                  Big_Aux.list_current big @ rev (Small_Aux.list_current small)"
    using invar_list_big_first[of "States Right big small"] by fastforce

  with listL_list_current have
    "x # listL (deqL (Transforming (States Right big small))) =
     listL (Transforming (States Right big small))"
    by auto

  with 6 show ?case by auto
qed auto

lemma list_deqL [simp]:
    "\<lbrakk>invar deque; listL deque \<noteq> []\<rbrakk> \<Longrightarrow> listL (deqL deque) = tl (listL deque)"
  using cons_tl[of "fst (deqL' deque)" "listL (deqL deque)" "listL deque"]
  by(auto split: prod.splits)

lemma list_firstL [simp]:
    "\<lbrakk>invar deque; listL deque \<noteq> []\<rbrakk> \<Longrightarrow> firstL deque = hd (listL deque)"
  using cons_hd[of "fst (deqL' deque)" "listL (deqL deque)" "listL deque"]
  by(auto split: prod.splits)

lemma invar_deqL:
    "\<lbrakk>invar deque; \<not> is_empty deque\<rbrakk> \<Longrightarrow> invar (deqL deque)"
proof(induction deque rule: deqL'.induct)
  case (4 left right length_right)
  then obtain x left' where pop_left[simp]: "Idle.pop left = (x, left')"
    by fastforce

  then obtain stack_left' length_left'
    where left'[simp]: "left' = idle.Idle stack_left' length_left'"
    using idle.exhaust by blast

  from 4 have invar_left': "invar left'" "invar left"
    using Idle_Proof.invar_pop by fastforce+

  have [simp]: "size stack_left' = size left - 1"
    by (metis Idle_Proof.size_pop_sub left' pop_left size_idle.simps)

  have [simp]: "length_left' = size left - 1"
    using invar_left' by auto

  from 4 have list: "x # Idle_Aux.list left' = Idle_Aux.list left"
    using Idle_Proof.pop_list[of left x left']
    by auto

  show ?case
  proof(cases "length_right \<le> 3 * size left'")
    case True
    with 4 invar_left' show ?thesis
      by(auto simp: Stack_Proof.size_empty[symmetric])
  next
    case False
    note Start_Transformation = False
    then show ?thesis
    proof(cases "1 \<le> size left'")
      case True
      let ?big =
        "Reverse
            (Current [] 0 right (size right - Suc length_left'))
            right [] (size right - Suc length_left')"
      let ?small = "Reverse1 (Current [] 0 stack_left' (Suc (2 * length_left'))) stack_left' []"
      let ?states = "States Left ?big ?small"

      from 4 Start_Transformation True invar_left'
      have invar: "invar ?states"
        by(auto simp: Let_def rev_take rev_drop)

      then have invar_stepped: "invar ((step^^6) ?states)"
        using invar_step_n by blast

      from 4 Start_Transformation True
      have remaining_steps: "6 < remaining_steps ?states"
        by auto

      then have remaining_steps_end: "0 < remaining_steps ((step^^6) ?states)"
        by(simp only: remaining_steps_n_steps_sub[of ?states 6] invar)

      from 4 Start_Transformation True
      have size_ok': "size_ok' ?states (remaining_steps ?states - 6)"
        by auto

      then have size_ok: "size_ok ((step^^6) ?states)"
        using invar remaining_steps size_ok_steps by blast

      from True Start_Transformation 4 show ?thesis
        using remaining_steps_end size_ok invar_stepped
        by(auto simp: Let_def)
    next
      case False
      from False Start_Transformation 4 have [simp]: "size left = 1"
        by auto

      with False Start_Transformation 4 have [simp]: "Idle_Aux.list left = [x]"
        using list[symmetric]
        by(auto simp: list Stack_Proof.list_empty_size)

      obtain right1 right2 where "right = Stack right1 right2"
        using Stack_Aux.list.cases by blast

      with False Start_Transformation 4 show ?thesis
        by(induction right1 right2 rule: small_deque.induct) auto
    qed
  qed
next
  case (5 big small)

  obtain x small' where small' [simp]: "Small.pop small = (x, small')"
    by fastforce

  let ?states = "States Left big small'"
  let ?states_stepped = "(step^^4) ?states"

  obtain big_stepped small_stepped where stepped [simp]:
       "?states_stepped = States Left big_stepped small_stepped"
     by (metis remaining_steps_states.cases step_n_same)

  from 5 have invar: "invar ?states"
    using invar_pop_small[of Left big small x small']
    by auto

  then have invar_stepped: "invar ?states_stepped"
    using invar_step_n by blast

  show ?case
  proof(cases "4 < remaining_steps ?states")
    case True

    then have remaining_steps: "0 < remaining_steps ?states_stepped"
      using invar remaining_steps_n_steps_sub[of ?states 4]
      by simp

    from True have size_ok: "size_ok ?states_stepped"
      using step_4_pop_small_size_ok[of Left big small x small'] 5(1)
      by auto

    from remaining_steps size_ok invar_stepped show ?thesis
      by(cases big_stepped; cases small_stepped) (auto simp: Let_def split!: Common.state.split)
  next
    case False
    then have remaining_steps_stepped: "remaining_steps ?states_stepped = 0"
      using invar by(auto simp del: stepped)

    then obtain small_current small_idle big_current big_idle where idle [simp]: "
      States Left big_stepped small_stepped =
      States Left
          (Big.state.Common (state.Idle big_current big_idle))
          (Small.state.Common (state.Idle small_current small_idle))
      "
      using remaining_steps_idle' invar_stepped remaining_steps_stepped
      by fastforce

    have size_new_small : "1 < size_new small"
      using 5 by auto

    have [simp]: "size_new small = Suc (size_new small')"
      using 5 by auto

    have [simp]: "size_new small' = size_new small_stepped"
      using invar step_n_size_new_small stepped
      by metis

    have [simp]: "size_new small_stepped = size small_idle"
      using idle invar_stepped
      by(cases small_stepped) auto

    have [simp]: "\<not>is_empty small_idle"
      using size_new_small
      by (simp add: Idle_Proof.size_not_empty)

    have [simp]: "size_new big = size_new big_stepped"
      by (metis invar step_n_size_new_big stepped)

    have [simp]: "size_new big_stepped = size big_idle"
      using idle invar_stepped
      by(cases big_stepped) auto

    have "0 < size big_idle"
      using 5 by auto

    then have [simp]: "\<not>is_empty big_idle"
      by (auto simp: Idle_Proof.size_not_empty)

    have [simp]: "size small_idle \<le> 3 * size big_idle"
      using 5 by auto

    have [simp]: "size big_idle \<le> 3 * size small_idle"
      using 5 by auto

    show ?thesis
      using invar_stepped by auto
  qed
next
  case (6 big small)

  obtain x big' where big' [simp]: "Big.pop big = (x, big')"
    by fastforce

  let ?states = "States Right big' small"
  let ?states_stepped = "(step^^4) ?states"

  obtain big_stepped small_stepped where stepped [simp]:
       "?states_stepped = States Right big_stepped small_stepped"
     by (metis remaining_steps_states.cases step_n_same)

  from 6 have invar: "invar ?states"
    using invar_pop_big[of Right big small x big']
    by auto

  then have invar_stepped: "invar ?states_stepped"
    using invar_step_n by blast

  show ?case
  proof(cases "4 < remaining_steps ?states")
    case True

    then have remaining_steps: "0 < remaining_steps ?states_stepped"
      using invar remaining_steps_n_steps_sub[of ?states 4]
      by simp

    from True have size_ok: "size_ok ?states_stepped"
      using step_4_pop_big_size_ok[of Right big small x big'] 6(1)
      by auto

    from remaining_steps size_ok invar_stepped show ?thesis
      by(cases big_stepped; cases small_stepped) (auto simp: Let_def split!: Common.state.split)
  next
    case False
    then have remaining_steps_stepped: "remaining_steps ?states_stepped = 0"
      using invar by(auto simp del: stepped)

    then obtain small_current small_idle big_current big_idle where idle [simp]: "
      States Right big_stepped small_stepped =
      States Right
          (Big.state.Common (state.Idle big_current big_idle))
          (Small.state.Common (state.Idle small_current small_idle))
      "
      using remaining_steps_idle' invar_stepped remaining_steps_stepped
      by fastforce

    have size_new_big : "1 < size_new big"
      using 6 by auto

    have [simp]: "size_new big = Suc (size_new big')"
      using 6 by auto

    have [simp]: "size_new big' = size_new big_stepped"
      using invar step_n_size_new_big stepped
      by metis

    have [simp]: "size_new big_stepped = size big_idle"
      using idle invar_stepped
      by(cases big_stepped) auto

    have [simp]: "\<not>is_empty big_idle"
      using size_new_big
      by (simp add: Idle_Proof.size_not_empty)

    have [simp]: "size_new small = size_new small_stepped"
      by (metis invar step_n_size_new_small stepped)

    have [simp]: "size_new small_stepped = size small_idle"
      using idle invar_stepped
      by(cases small_stepped) auto

    have "0 < size small_idle"
      using 6 by auto

    then have [simp]: "\<not>is_empty small_idle"
      by (auto simp: Idle_Proof.size_not_empty)

    have [simp]: "size big_idle \<le> 3 * size small_idle"
      using 6 by auto

    have [simp]: "size small_idle \<le> 3 * size big_idle"
      using 6 by auto

    show ?thesis
      using invar_stepped by auto
  qed
qed auto

end


theory Chapter21_3_Evaluation
imports Chapter21_2_Typechecking
begin

primrec is_val :: "expr => bool"
where "is_val (Var v) = False"
    | "is_val Zero = True"
    | "is_val (Suc e) = is_val e"
    | "is_val (Iter et e0 es) = False"
    | "is_val (Lam t e) = True"
    | "is_val (Appl e1 e2) = False"
    | "is_val (TyLam e) = True"
    | "is_val (TyAppl t e) = False"
    | "is_val Triv = True"
    | "is_val (Pair e1 e2) = (is_val e1 & is_val e2)"
    | "is_val (ProjL e) = False"
    | "is_val (ProjR e) = False"
    | "is_val (Abort t e) = False"
    | "is_val (Case et el er) = False"
    | "is_val (InL t1 t2 e) = is_val e"
    | "is_val (InR t1 t2 e) = is_val e"

inductive eval :: "expr => expr => bool"
where eval_suc [simp]: "eval e e' ==> eval (Suc e) (Suc e')"
    | eval_rec_1 [simp]: "eval et et' ==> eval (Iter et e0 es) (Iter et' e0 es)"
    | eval_rec_2 [simp]: "eval (Iter Zero e0 es) e0"
    | eval_rec_3 [simp]: "is_val et ==> eval (Iter (Suc et) e0 es) (subst (Iter et e0 es) first es)"
    | eval_appl_1 [simp]: "eval e1 e1' ==> eval (Appl e1 e2) (Appl e1' e2)"
    | eval_appl_2 [simp]: "is_val e1 ==> eval e2 e2' ==> eval (Appl e1 e2) (Appl e1 e2')"
    | eval_appl_3 [simp]: "is_val e2 ==> eval (Appl (Lam t2 e1) e2) (subst e2 first e1)"
    | eval_tyappl_1 [simp]: "eval e e' ==> eval (TyAppl t e) (TyAppl t e')"
    | eval_tyappl_2 [simp]: "eval (TyAppl t (TyLam e)) (expr_subst_type t first e)"
    | eval_pair_1 [simp]: "eval e1 e1' ==> eval (Pair e1 e2) (Pair e1' e2)"
    | eval_pair_2 [simp]: "is_val e1 ==> eval e2 e2' ==> eval (Pair e1 e2) (Pair e1 e2')"
    | eval_projl_1 [simp]: "eval e e' ==> eval (ProjL e) (ProjL e')"
    | eval_projl_2 [simp]: "eval (ProjL (Pair e1 e2)) e1"
    | eval_projr_1 [simp]: "eval e e' ==> eval (ProjR e) (ProjR e')"
    | eval_projr_2 [simp]: "eval (ProjR (Pair e1 e2)) e2"
    | eval_abort [simp]: "eval e e' ==> eval (Abort t e) (Abort t e')"
    | eval_case_1 [simp]: "eval et et' ==> eval (Case et el er) (Case et' el er)"
    | eval_case_2 [simp]: "is_val e ==> eval (Case (InL t1 t2 e) el er) (subst e first el)"
    | eval_case_3 [simp]: "is_val e ==> eval (Case (InR t1 t2 e) el er) (subst e first er)"
    | eval_inl [simp]: "eval e e' ==> eval (InL t1 t2 e) (InL t1 t2 e')"
    | eval_inr [simp]: "eval e e' ==> eval (InR t1 t2 e) (InR t1 t2 e')"

lemma canonical_nat: "is_val e ==> typecheck del gam e Nat ==>
          e = Zero | (EX e'. e = Suc e' & typecheck del gam e' Nat)"
by (induction e, auto)

lemma canonical_nat_no_vars: "is_val e ==> typecheck del gam e Nat ==> typecheck del gam' e Nat"
by (induction e, auto)

lemma canonical_arrow: "is_val e ==> typecheck del gam e (Arrow t1 t2) ==>
              EX e'. e = Lam t1 e' & typecheck del (extend gam t1) e' t2"
by (induction e, auto)

lemma canonical_all: "is_val e ==> typecheck del gam e (All t) ==>
              EX e'. e = TyLam e' &
                  typecheck (extend del Star) (env_map (type_insert first) gam) e' t"
by (induction e, auto)

lemma canonical_unit: "is_val e ==> typecheck del gam e Unit ==> e = Triv"
by (induction e, auto)

lemma canonical_prod: "is_val e ==> typecheck del gam e (Prod t1 t2) ==>
              EX e1 e2. e = Pair e1 e2 & typecheck del gam e1 t1 & typecheck del gam e2 t2"
by (induction e, auto)

lemma canonical_void: "is_val e ==> typecheck del gam e Void ==> False"
by (induction e, auto)

lemma canonical_sum: "is_val e ==> typecheck del gam e (Sum t1 t2) ==>
          (EX e'. e = InL t1 t2 e' & typecheck del gam e' t1) |
          (EX e'. e = InR t1 t2 e' & typecheck del gam e' t2)"
by (induction e, auto)

theorem preservation: "eval e e' ==> gam = empty_env ==>
          typecheck del gam e t ==> typecheck del gam e' t"
proof (induction e e' arbitrary: t rule: eval.induct)
case eval_suc
  thus ?case by fastforce
next case eval_rec_1
  thus ?case by fastforce
next case eval_rec_2
  thus ?case by fastforce
next case eval_rec_3
  thus ?case by fastforce
next case eval_appl_1
  thus ?case by fastforce
next case eval_appl_2
  thus ?case by fastforce
next case eval_appl_3
  thus ?case by fastforce
next case eval_tyappl_1
  thus ?case by fastforce
next case (eval_tyappl_2 tt e)
  then obtain t2 where T2: "is_type del tt & typecheck (extend del Star) gam e t2 &
                                t = type_subst tt first t2" by fastforce
  with eval_tyappl_2 have "typecheck (extend_at first del Star) gam e t2" by simp
  with T2 have "typecheck del (env_map (type_subst tt first) gam)
                          (expr_subst_type tt first e) (type_subst tt first t2)" by simp
  with T2 eval_tyappl_2 show ?case by simp
next case eval_pair_1
  thus ?case by fastforce
next case eval_pair_2
  thus ?case by fastforce
next case eval_projl_1
  thus ?case by fastforce
next case eval_projl_2
  thus ?case by fastforce
next case eval_projr_1
  thus ?case by fastforce
next case eval_projr_2
  thus ?case by fastforce
next case eval_abort
  thus ?case by fastforce
next case eval_case_1
  thus ?case by fastforce
next case eval_case_2
  thus ?case by fastforce
next case eval_case_3
  thus ?case by fastforce
next case eval_inl
  thus ?case by fastforce
next case eval_inr
  thus ?case by fastforce
qed

theorem progress: "typecheck del gam e t ==> gam = empty_env ==>
          is_val e | (EX e'. eval e e')"
proof (induction gam e t rule: typecheck.induct)
case tc_var
  thus ?case by simp
next case tc_zero
  thus ?case by simp
next case tc_suc
  thus ?case by (metis eval_suc is_val.simps(3))
next case tc_rec
  thus ?case by (metis eval_rec_1 eval_rec_2 eval_rec_3 is_val.simps(3) canonical_nat)
next case tc_lam
  thus ?case by simp
next case tc_appl
  thus ?case by (metis eval_appl_1 eval_appl_2 eval_appl_3 canonical_arrow)
next case tc_tylam
  thus ?case by simp
next case tc_tyappl
  thus ?case by (metis eval_tyappl_1 eval_tyappl_2 canonical_all)
next case tc_triv
  thus ?case by simp
next case tc_pair
  thus ?case by (metis eval_pair_1 eval_pair_2 is_val.simps(10))
next case tc_projl
  thus ?case by (metis eval_projl_1 eval_projl_2 canonical_prod)
next case tc_projr
  thus ?case by (metis eval_projr_1 eval_projr_2 canonical_prod)
next case tc_abort
  thus ?case by (metis eval_abort canonical_void)
next case tc_case
  thus ?case
  by (metis canonical_sum eval_case_1 eval_case_2 eval_case_3 is_val.simps(15) is_val.simps(16))
next case tc_inl
  thus ?case by (metis eval_inl is_val.simps(15))
next case tc_inr
  thus ?case by (metis eval_inr is_val.simps(16))
qed

end


theory Hoare_Direct imports Hoare
begin

(* Implementation of a direct-style (as opposed to CPS) Hoare logic.
 * This ends up being useful for reasoning about single-steps for languages
 * that do not affect control flow.
 *)

definition HT ::
  "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool"
  ("{{_}} _ {{_}}" [0,0,0] 61) where
"HT pre x post =
  (\<forall> a b . pre a \<longrightarrow> x a b \<longrightarrow> post b)"

lemma HTI :
  assumes H1 :
    "\<And> a b . pre a \<Longrightarrow> x a b \<Longrightarrow> post b"
  shows "HT pre x post" using assms
  unfolding HT_def by auto

lemma HTE :
  assumes H : "HT pre x post"
  assumes Ha : "pre a"
  assumes Hb : "x a b"
  shows "post b" using assms
  unfolding HT_def by auto

(* Hoare triple for an executable semantics *)
definition HTS ::
  "('x \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow>
   ('a \<Rightarrow> bool) \<Rightarrow> 'x \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool"
  ("_ % {{_}} _ {{_}}" [250,252,254,256])
  where
"HTS sem pre x post =
  HT pre (\<lambda> a b . sem x a = b) post"

lemma HTSI :
  assumes H1 :
    "\<And> a . pre a \<Longrightarrow> post (sem x a)"
  shows "HTS sem pre x post" using assms
  unfolding HTS_def HT_def by auto

lemma HTSE :
  assumes H : "HTS sem pre x post"
  assumes Ha : "pre a"
  shows "post (sem x a)"
  using assms unfolding HTS_def HT_def by auto

lemma HTS_Conseq :
  assumes H1 : "sem % {{P}} c {{Q}}"
  assumes HP : "\<And> x . P' x \<Longrightarrow> P x"
  assumes HQ : "\<And> x . Q x \<Longrightarrow> Q' x"
  shows "sem % {{P'}} c {{Q'}}"
proof(rule HTSI)
  fix a
  assume P' : "P' a"
  hence P : "P a" using HP by blast
  have Q: "Q (sem c a)"
    using HTSE[OF H1 P] by simp
  show "Q' (sem c a)"
    using HQ[OF Q] by simp
qed

end