(*
 * Copyright 2016, NTU
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * Author: Zhe Hou.
 *)

theory VHDL_Power_Properties
imports Main VHDL_Hoare VHDL_Power VHDL_Power_Comp
begin

definition f:: "nat \<Rightarrow> nat" where "f x = x + 1"

definition val_op_power:: "val option \<Rightarrow> val option \<Rightarrow> val option" where
"val_op_power vop1 vop2 \<equiv>
  case (vop1,vop2) of (Some (val_i v1), Some (val_i v2)) \<Rightarrow> Some (val_i (v1 ^ (nat v2)))
  | _ \<Rightarrow> None
"

definition input_state_p:: "int \<Rightarrow> int \<Rightarrow> vhdl_state" where
"input_state_p i j \<equiv> init_state\<lparr>state_sp :=
(state_sp init_state)((sp_p p_arg1_p) := (Some (val_i i)),
                      (sp_p p_arg2_p) := (Some (val_i j)))\<rparr>"

definition input_state_pc:: "int \<Rightarrow> int \<Rightarrow> vhdl_arch_state" where
"input_state_pc i j \<equiv> arch_state (''POWER'',init_state\<lparr>state_sp :=
(state_sp init_state)((sp_p p_arg1_pc) := (Some (val_i i)),
                      (sp_p p_arg2_pc) := (Some (val_i j)))\<rparr>,
  [(mult_unit_comp_map,init_arch_state_mult)])"

definition final_state where "final_state \<equiv>
simulation 15 (trans_vhdl_desc_complex vhdl_power) (input_state_p 4 2)"

definition final_state_n where "final_state_n n x y \<equiv>
simulation n (trans_vhdl_desc_complex vhdl_power) (input_state_p x y)"

definition vhdl_power_core:: "vhdl_desc" where
"vhdl_power_core \<equiv> trans_vhdl_desc_complex vhdl_power"

definition mult_proc:: "conc_stmt" where
"mult_proc \<equiv> cst_ps ''MULTIPLIER'' [sp_p p_clk]
  [(sst_if '''' (bexpr (exp_sig s_req_p) [=] (exp_con (vhdl_bit, (val_c (CHR ''1'')))))
    [(sst_sa '''' (clhs_sp (lhs_s (sp_s s_result_p)))
      (rhs_e (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p))))
    ] []),
   (sst_sa '''' (clhs_sp (lhs_s (sp_s s_ack_p))) (rhs_e (exp_sig s_req_p)))
  ]
"

definition ctrl_proc:: "conc_stmt" where
"ctrl_proc \<equiv> cst_ps ''CONTROLLER'' [sp_p p_clk]
  [(sst_if '''' (bexpr (exp_sig s_state_p) [=] (exp_con (vhdl_natural, (val_i 0))))
    [(sst_if '''' (bexpr (exp_prt p_start_p) [=] (exp_con (vhdl_bit, (val_c (CHR ''1'')))))
      [(sst_sa '''' (clhs_sp (lhs_s (sp_s s_reg1_p))) (rhs_e (exp_prt p_arg1_p))),
       (sst_sa '''' (clhs_sp (lhs_s (sp_s s_reg2_p))) (rhs_e (exp_con (vhdl_natural, (val_i 1))))),
       (sst_sa '''' (clhs_sp (lhs_s (sp_s s_count_p))) (rhs_e (exp_prt p_arg2_p))),
       (sst_sa '''' (clhs_sp (lhs_s (sp_s s_state_p))) (rhs_e (exp_con (vhdl_natural, (val_i 1)))))
      ] [])
    ] [
     (sst_if '''' (bexpr (exp_sig s_state_p) [=] (exp_con (vhdl_natural, (val_i 1))))
      [(sst_if '''' (bexpr (exp_sig s_count_p) [=] (exp_con (vhdl_natural, (val_i 0))))
        [(sst_sa '''' (clhs_sp (lhs_s (sp_p p_res_p))) (rhs_e (exp_sig s_reg2_p))),
         (sst_sa '''' (clhs_sp (lhs_s (sp_p p_done_p))) (rhs_e (exp_con (vhdl_bit, (val_c (CHR ''1'')))))),
         (sst_sa '''' (clhs_sp (lhs_s (sp_s s_state_p))) (rhs_e (exp_con (vhdl_natural, (val_i 4)))))
        ] [
         (sst_sa '''' (clhs_sp (lhs_s (sp_s s_req_p))) (rhs_e (exp_con (vhdl_bit, (val_c (CHR ''1'')))))),
         (sst_sa '''' (clhs_sp (lhs_s (sp_s s_state_p))) (rhs_e (exp_con (vhdl_natural, (val_i 2)))))
        ])
      ] [
       (sst_if '''' (bexpr (exp_sig s_state_p) [=] (exp_con (vhdl_natural, (val_i 2))))
        [(sst_if '''' (bexpr (exp_sig s_ack_p) [=] (exp_con (vhdl_bit, (val_c (CHR ''1'')))))
          [(sst_sa '''' (clhs_sp (lhs_s (sp_s s_reg2_p))) (rhs_e (exp_sig s_result_p))),
           (sst_sa '''' (clhs_sp (lhs_s (sp_s s_req_p))) (rhs_e (exp_con (vhdl_bit, (val_c (CHR ''0'')))))),
           (sst_sa '''' (clhs_sp (lhs_s (sp_s s_state_p))) (rhs_e (exp_con (vhdl_natural, (val_i 3)))))
          ] [])
        ] [
         (sst_if '''' (bexpr (exp_sig s_state_p) [=] (exp_con (vhdl_natural, (val_i 3))))
          [(sst_sa '''' (clhs_sp (lhs_s (sp_s s_count_p))) (rhs_e (bexpa (exp_sig s_count_p) [-] (exp_con (vhdl_natural, (val_i 1)))))),
           (sst_sa '''' (clhs_sp (lhs_s (sp_s s_state_p))) (rhs_e (exp_con (vhdl_natural, (val_i 1)))))
          ] [
           (sst_if '''' (bexpr (exp_sig s_state_p) [=] (exp_con (vhdl_natural, (val_i 4))))
            [(sst_if '''' (bexpr (exp_prt p_start_p) [=] (exp_con (vhdl_bit, (val_c (CHR ''0'')))))
              [(sst_sa '''' (clhs_sp (lhs_s (sp_p p_done_p))) (rhs_e (exp_con (vhdl_bit, (val_c (CHR ''0'')))))),
               (sst_sa '''' (clhs_sp (lhs_s (sp_s s_state_p))) (rhs_e (exp_con (vhdl_natural, (val_i 1)))))
              ] [])
            ] [])
          ])
        ])
      ])
    ])
  ]
"

text {* Functional correctness of the MULTIPLIER process. *}

lemma fun_cor_mult_sub3: "valid_hoare_tuple (multi_proc, [],
((\<lambda>y. (\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
   (y\<lparr>state_dr_val := (state_dr_val y)
   ((sp_s s_result_p) := ((state_dr_val y) (sp_s s_result_p))
   (multi_proc := state_val_exp_t
   (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p)) y))\<rparr>))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))),
[(sst_sa '''' (clhs_sp (lhs_s (sp_s s_result_p)))
      (rhs_e (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p))))],
((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))
)
"
using VHDL_Hoare.sig_asmt by meson

lemma "\<forall>w. (\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. (state_val_exp_t (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p)) x = Some (val_i r) \<and>
     r = v1 * v2)))) w \<longrightarrow>
(\<lambda>y. (\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
   (y\<lparr>state_dr_val := (state_dr_val y)
   ((sp_s s_result_p) := ((state_dr_val y) (sp_s s_result_p))
   (multi_proc := state_val_exp_t
   (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p)) y))\<rparr>)) w"
by auto

lemma "\<forall>w. (\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) w \<longrightarrow>
     (\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. (state_val_exp_t (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p)) x = Some (val_i r) \<and>
     r = v1 * v2)))) w"
apply clarsimp
apply (simp add: state_val_exp_t_def s_reg1_p_def s_reg2_p_def)
apply (simp add: val_arith_def)
by (simp add: vhdl_natural_def vhdl_positive_def vhdl_real_def)

lemma fun_cor_mult_sub3_1: "valid_hoare_tuple (multi_proc, [],
((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))
  \<sqinter> (\<lambda>x. (state_val_exp_t (bexpr (exp_sig s_req_p) [=]
    (exp_con (vhdl_bit, (val_c (CHR ''1''))))) x = Some (val_b True)))),
[(sst_sa '''' (clhs_sp (lhs_s (sp_s s_result_p)))
      (rhs_e (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p))))],
((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))
)
"
proof -
def "P" \<equiv> "((\<lambda>y. (\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
   (y\<lparr>state_dr_val := (state_dr_val y)
   ((sp_s s_result_p) := ((state_dr_val y) (sp_s s_result_p))
   (multi_proc := state_val_exp_t
   (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p)) y))\<rparr>))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))"
def "C" \<equiv> "[(sst_sa '''' (clhs_sp (lhs_s (sp_s s_result_p)))
      (rhs_e (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p))))]"
def "Q" \<equiv> "((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))"
def "P'" \<equiv> "(\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. (state_val_exp_t (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p)) x = Some (val_i r) \<and>
     r = v1 * v2)))) \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))"
def "P''" \<equiv> "(\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2))
     \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))"
def "P'''" \<equiv> "((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))
  \<sqinter> (\<lambda>x. (state_val_exp_t (bexpr (exp_sig s_req_p) [=]
    (exp_con (vhdl_bit, (val_c (CHR ''1''))))) x = Some (val_b True))))"
  have f0: "valid_hoare_tuple (multi_proc, [], P, C, Q)"
    using fun_cor_mult_sub3 unfolding P_def C_def Q_def by auto
  have f1: "\<forall>w. P' w \<longrightarrow> P w" unfolding P'_def P_def asst_and_def
    by auto
  have f2: "\<forall>w. P'' w \<longrightarrow> P' w" unfolding P''_def P'_def asst_and_def
    apply clarsimp
    apply (simp add: state_val_exp_t_def s_reg1_p_def s_reg2_p_def)
    apply (simp add: val_arith_def)
    by (simp add: vhdl_natural_def vhdl_positive_def vhdl_real_def)
  have f3: "\<forall>w. P''' w \<longrightarrow> P'' w" unfolding P'''_def P''_def asst_and_def
    by auto
  from f1 f2 f3 have f4: "\<forall>w. P''' w \<longrightarrow> P w" by auto
  have f5: "\<forall>w. Q w \<longrightarrow> Q w" by auto
  from f0 f4 f5 have "valid_hoare_tuple (multi_proc, [], P''', C, Q)"
    using consequence by auto
  then show ?thesis using P'''_def C_def Q_def by auto
qed

lemma fun_cor_mult_sub4: "valid_hoare_tuple (multi_proc, [],
((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))
  \<sqinter> (\<lambda>x. (state_val_exp_t (bexpr (exp_sig s_req_p) [=]
    (exp_con (vhdl_bit, (val_c (CHR ''1''))))) x \<noteq> Some (val_b True)))),
[],
((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))
)
"
proof -
def "Q" \<equiv> "((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))"
def "P" \<equiv> "((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))
  \<sqinter> (\<lambda>x. (state_val_exp_t (bexpr (exp_sig s_req_p) [=]
    (exp_con (vhdl_bit, (val_c (CHR ''1''))))) x \<noteq> Some (val_b True))))"
  have f1: "valid_hoare_tuple (multi_proc, [], Q, [], Q)" using skip by auto
  have f2: "\<forall>w. P w \<longrightarrow> Q w" unfolding P_def Q_def asst_and_def
    apply auto
    apply (simp add: state_val_exp_t_def s_req_p_def)
    apply (simp add: val_rel_def)
    by (simp add: vhdl_bit_def vhdl_boolean_def)
  then have "valid_hoare_tuple (multi_proc, [], P, [], Q)" using f1 consequence
    by auto
  then show ?thesis unfolding P_def Q_def
    by auto
qed

lemma fun_cor_mult_sub2: "valid_hoare_tuple (multi_proc, [],
(\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))),
[(sst_if '''' (bexpr (exp_sig s_req_p) [=] (exp_con (vhdl_bit, (val_c (CHR ''1'')))))
    [(sst_sa '''' (clhs_sp (lhs_s (sp_s s_result_p)))
      (rhs_e (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p))))
    ] [])],
((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     ((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     ((state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))
)
"
using fun_cor_mult_sub3_1 fun_cor_mult_sub4 if_stmt
by auto

lemma fun_cor_mult_sub1: "valid_hoare_tuple (multi_proc, [],
((\<lambda>y. (\<lambda>x. (state_dr_val x) (sp_s s_ack_p) multi_proc = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
   (y\<lparr>state_dr_val := (state_dr_val y)
   ((sp_s s_ack_p) := ((state_dr_val y) (sp_s s_ack_p))
   (multi_proc := state_val_exp_t (exp_sig s_req_p) y))\<rparr>))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))),
[(sst_sa '''' (clhs_sp (lhs_s (sp_s s_ack_p))) (rhs_e (exp_sig s_req_p)))],
((\<lambda>x. (state_dr_val x) (sp_s s_ack_p) multi_proc = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))
)
"
using VHDL_Hoare.sig_asmt by meson

lemma fun_cor_mult_sub1_1: "valid_hoare_tuple (multi_proc, [],
((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))),
[(sst_sa '''' (clhs_sp (lhs_s (sp_s s_ack_p))) (rhs_e (exp_sig s_req_p)))],
((\<lambda>x. (state_dr_val x) (sp_s s_ack_p) multi_proc = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))
)
"
proof -
def "P" \<equiv> "((\<lambda>y. (\<lambda>x. (state_dr_val x) (sp_s s_ack_p) multi_proc = Some (val_c (CHR ''1'')) \<and>
     ((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     ((state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
   (y\<lparr>state_dr_val := (state_dr_val y)
   ((sp_s s_ack_p) := ((state_dr_val y) (sp_s s_ack_p))
   (multi_proc := state_val_exp_t (exp_sig s_req_p) y))\<rparr>))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))"
def "C" \<equiv> "[(sst_sa '''' (clhs_sp (lhs_s (sp_s s_ack_p))) (rhs_e (exp_sig s_req_p)))]"
def "Q" \<equiv> "((\<lambda>x. (state_dr_val x) (sp_s s_ack_p) multi_proc = Some (val_c (CHR ''1'')) \<and>
     ((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     ((state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))"
def "P'" \<equiv> "((\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     ((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     ((state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))"
  have f1: "valid_hoare_tuple (multi_proc, [], P, C, Q)"
    unfolding P_def C_def Q_def using fun_cor_mult_sub1 by auto
  have f2: "\<forall>x. P' x \<longrightarrow> P x" unfolding P'_def P_def
    unfolding asst_and_def
    apply auto
      unfolding state_val_exp_t_def
      apply (cases "exp_type (exp_sig s_req_p) = None")
       apply auto
    unfolding s_result_p_def s_ack_p_def
    by auto
  have f3: "\<forall>x. Q x \<longrightarrow> Q x" by auto
  then have "valid_hoare_tuple (multi_proc, [], P', C, Q)"
    using consequence f1 f2 f3 by auto
  then show ?thesis unfolding P'_def C_def Q_def
    by auto
qed

lemma fun_cor_mult: "valid_hoare_tuple (multi_proc, [],
(\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))),
[(sst_if '''' (bexpr (exp_sig s_req_p) [=] (exp_con (vhdl_bit, (val_c (CHR ''1'')))))
    [(sst_sa '''' (clhs_sp (lhs_s (sp_s s_result_p)))
      (rhs_e (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p))))
    ] []),
   (sst_sa '''' (clhs_sp (lhs_s (sp_s s_ack_p))) (rhs_e (exp_sig s_req_p)))
],
((\<lambda>x. (state_dr_val x) (sp_s s_ack_p) multi_proc = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))
  \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x))))
)"
proof -
def "P" \<equiv> "(\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     (state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2))::asst"
def "C1" \<equiv> "[(sst_if '''' (bexpr (exp_sig s_req_p) [=] (exp_con (vhdl_bit, (val_c (CHR ''1'')))))
    [(sst_sa '''' (clhs_sp (lhs_s (sp_s s_result_p)))
      (rhs_e (bexpa (exp_sig s_reg1_p) [*] (exp_sig s_reg2_p))))
    ] [])]"
def "Q" \<equiv> "(\<lambda>x. (state_sp x) (sp_s s_req_p) = Some (val_c (CHR ''1'')) \<and>
     ((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     ((state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))::asst"
def "C2" \<equiv> "[(sst_sa '''' (clhs_sp (lhs_s (sp_s s_ack_p))) (rhs_e (exp_sig s_req_p)))]"
def "R" \<equiv> "(\<lambda>x. (state_dr_val x) (sp_s s_ack_p) multi_proc = Some (val_c (CHR ''1'')) \<and>
     (((state_sp x) (sp_s s_reg1_p) = Some (val_i v1) \<and>
     (state_sp x) (sp_s s_reg2_p) = Some (val_i v2)) \<longrightarrow>
     (\<exists>r. ((state_dr_val x) (sp_s s_result_p) multi_proc = Some (val_i r) \<and>
     r = v1 * v2))))::asst"
  from fun_cor_mult_sub2 have f1: "valid_hoare_tuple (multi_proc, [],
    (P \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))), C1,
    (Q \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))))"
    unfolding P_def C1_def Q_def by auto
  from fun_cor_mult_sub1_1 have f2: "valid_hoare_tuple (multi_proc, [],
    (Q \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))), C2,
    (R \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))))"
    unfolding Q_def C2_def R_def by auto
  from f1 f2 if_stmt_seq have "valid_hoare_tuple (multi_proc, [],
    (P \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))), C1@C2,
    (R \<sqinter> (\<lambda>x. \<not> (snd (next_flag x))) \<sqinter> (\<lambda>x. \<not>(snd (exit_flag x)))))"
    unfolding C1_def by auto
  then show ?thesis unfolding P_def R_def C1_def C2_def by auto
qed

theorem power_correct: "\<exists>(m::nat). (\<forall>(n::nat).
(((n \<ge> m)) \<longrightarrow>
(((state_sp (simulation n (trans_vhdl_desc_complex vhdl_power) init_state)) (sp_p p_res_p)) =
val_op_power ((state_sp init_state) (sp_p p_arg1_p)) ((state_sp init_state) (sp_p p_arg2_p)))))"

sorry

theorem power_comp_correct: "\<exists>(m::nat). (\<forall>(n::nat).
(((n \<ge> m)) \<longrightarrow>
(((state_sp (state_of_arch (sim_arch n vhdl_power_comp init_arch_state_power))) (sp_p p_res_pc)) =
val_op_power ((state_sp (state_of_arch init_arch_state_power)) (sp_p p_arg1_pc))
  ((state_sp (state_of_arch init_arch_state_power)) (sp_p p_arg2_pc)))))"
sorry

theorem power_eq: "\<exists>(m::nat). (\<forall>(n::nat).
(((((state_sp init_state) (sp_p p_arg1_p)) =
((state_sp (state_of_arch init_arch_state_power)) (sp_p p_arg1_pc)) \<and>
((state_sp init_state) (sp_p p_arg2_p)) =
((state_sp (state_of_arch init_arch_state_power)) (sp_p p_arg2_pc))) \<and>
(n \<ge> m)) \<longrightarrow>
(((state_sp (simulation n (trans_vhdl_desc_complex vhdl_power) init_state)) (sp_p p_res_p)) =
((state_sp (state_of_arch (sim_arch n vhdl_power_comp init_arch_state_power))) (sp_p p_res_pc)))))"
by (metis add_leE power_comp_correct power_correct)

end


(*  Title:       Safe OCL
    Author:      Denis Nikiforov, April 2019
    Maintainer:  Denis Nikiforov <denis.nikif at gmail.com>
    License:     LGPL
*)
chapter \<open>Type Helpers\<close>
theory OCL_Type_Helpers
  imports OCL_Types
begin

(*** Definition *************************************************************)

section \<open>Definition\<close>

subsection \<open>All Types\<close>

abbreviation between ("_/ = _\<midarrow>_"  [51, 51, 51] 50) where
  "x = y\<midarrow>z \<equiv> y \<le> x \<and> x \<le> z"
(*
inductive any_type\<^sub>N where
  "any_type\<^sub>N (Required \<tau>) \<tau> False"
| "any_type\<^sub>N (Optional \<tau>) \<tau> True"

inductive any_type where
  "any_type\<^sub>N \<tau> \<sigma> n \<Longrightarrow>
   any_type (ErrorFree \<tau>) \<sigma> n False"
| "any_type\<^sub>N \<tau> \<sigma> n \<Longrightarrow>
   any_type (Errorable \<tau>) \<sigma> n True"

inductive any_type_template where
  "any_type\<^sub>N \<tau> \<sigma> n \<Longrightarrow>
   any_type_template (ErrorFree \<tau>) \<sigma> n"
| "any_type\<^sub>N \<tau> \<sigma> n \<Longrightarrow>
   any_type_template (Errorable \<tau>) \<sigma> n"

inductive any_type_template' where
  "any_type_template \<tau> \<sigma> _ \<Longrightarrow>
   any_type_template' \<tau> \<sigma>"
*)

inductive any_type where
  "any_type \<tau>[1] \<tau>[1] False False"
| "any_type \<tau>[?] \<tau>[?] True False"
| "any_type \<tau>[1!] \<tau>[1!] False True"
| "any_type \<tau>[?!] \<tau>[?!] True True"

inductive any_type_template where
  "any_type \<tau> \<sigma> n _ \<Longrightarrow>
   any_type_template \<tau> \<sigma> n"

inductive any_type_template' where
  "any_type \<tau> \<sigma> _ _ \<Longrightarrow>
   any_type_template' \<tau> \<sigma>"

notation error_free_type ("_ \<hookrightarrow> OclAny[.]" [900] 900)
notation errorable_type ("_ \<hookrightarrow> OclAny[.!]" [900] 900)

text \<open>Set, ordered set, map and tuple types with finite element types are finite.
  However they are too big, so we consider them as infinite types.\<close>

fun finite_type\<^sub>T
and finite_type\<^sub>N where
  "finite_type\<^sub>T OclAny = False"
| "finite_type\<^sub>T OclVoid = True"

| "finite_type\<^sub>T Boolean = True"
| "finite_type\<^sub>T Real = False"
| "finite_type\<^sub>T Integer = False"
| "finite_type\<^sub>T UnlimitedNatural = False"
| "finite_type\<^sub>T String = False"

| "finite_type\<^sub>T (Enum \<E>) = True"
| "finite_type\<^sub>T (ObjectType \<C>) = True"
| "finite_type\<^sub>T (Tuple \<pi>) = False"

| "finite_type\<^sub>T (Collection \<tau>) = False"
| "finite_type\<^sub>T (Set \<tau>) = False"
| "finite_type\<^sub>T (OrderedSet \<tau>) = False"
| "finite_type\<^sub>T (Bag \<tau>) = False"
| "finite_type\<^sub>T (Sequence \<tau>) = False"

| "finite_type\<^sub>T (Map \<tau> \<sigma>) = False"

| "finite_type\<^sub>N (Required \<tau>) = finite_type\<^sub>T \<tau>"
| "finite_type\<^sub>N (Optional \<tau>) = finite_type\<^sub>T \<tau>"

fun finite_type where
  "finite_type (ErrorFree \<tau>) = finite_type\<^sub>N \<tau>"
| "finite_type (Errorable \<tau>) = finite_type\<^sub>N \<tau>"

subsection \<open>Object Types\<close>

inductive object_type\<^sub>T where
  "object_type\<^sub>T (ObjectType \<C>) \<C>"

inductive object_type\<^sub>N where
  "object_type\<^sub>T \<tau> \<C> \<Longrightarrow>
   object_type\<^sub>N (Required \<tau>) \<C> False"
| "object_type\<^sub>T \<tau> \<C> \<Longrightarrow>
   object_type\<^sub>N (Optional \<tau>) \<C> True"

inductive object_type where
  "object_type\<^sub>N \<tau> \<C> n \<Longrightarrow>
   object_type (ErrorFree \<tau>) \<C> n"
| "object_type\<^sub>N \<tau> \<C> n \<Longrightarrow>
   object_type (Errorable \<tau>) \<C> n"

abbreviation "required_object_type \<tau> \<C> \<equiv> object_type \<tau> \<C> False"
abbreviation "optional_object_type \<tau> \<C> \<equiv> object_type \<tau> \<C> True"

subsection \<open>Tuple Types\<close>

inductive tuple_type\<^sub>T where
  "tuple_type\<^sub>T (Tuple \<pi>) \<pi>"

inductive tuple_type\<^sub>N where
  "tuple_type\<^sub>T \<tau> \<pi> \<Longrightarrow>
   tuple_type\<^sub>N (Required \<tau>) \<pi> False"
| "tuple_type\<^sub>T \<tau> \<pi> \<Longrightarrow>
   tuple_type\<^sub>N (Optional \<tau>) \<pi> True"

inductive tuple_type where
  "tuple_type\<^sub>N \<tau> \<pi> n \<Longrightarrow>
   tuple_type (ErrorFree \<tau>) (fmmap ErrorFree \<pi>) n"
| "tuple_type\<^sub>N \<tau> \<pi> n \<Longrightarrow>
   tuple_type (Errorable \<tau>) (fmmap Errorable \<pi>) n"

inductive tuple_type' where
  "tuple_type\<^sub>N \<tau> (fmmap unwrap_errorable_type \<pi>) n \<Longrightarrow>
   \<not> fBex (fmran \<pi>) errorable_type \<Longrightarrow>
   tuple_type' (ErrorFree \<tau>) \<pi> n"
| "tuple_type\<^sub>N \<tau> (fmmap unwrap_errorable_type \<pi>) n \<Longrightarrow>
   fBex (fmran \<pi>) errorable_type \<Longrightarrow>
   tuple_type' (Errorable \<tau>) \<pi> n"

abbreviation "required_tuple_type \<tau> \<pi> \<equiv> tuple_type \<tau> \<pi> False"
abbreviation "optional_tuple_type \<tau> \<pi> \<equiv> tuple_type \<tau> \<pi> True"
abbreviation "required_tuple_type' \<tau> \<pi> \<equiv> tuple_type' \<tau> \<pi> False"
abbreviation "optional_tuple_type' \<tau> \<pi> \<equiv> tuple_type' \<tau> \<pi> True"

subsection \<open>Collection Types\<close>

inductive collection_type\<^sub>T where
  "collection_type\<^sub>T (Collection \<tau>) CollectionKind \<tau>"
| "collection_type\<^sub>T (Set \<tau>) SetKind \<tau>"
| "collection_type\<^sub>T (OrderedSet \<tau>) OrderedSetKind \<tau>"
| "collection_type\<^sub>T (Bag \<tau>) BagKind \<tau>"
| "collection_type\<^sub>T (Sequence \<tau>) SequenceKind \<tau>"

inductive collection_type\<^sub>N where
  "collection_type\<^sub>T \<tau> k \<sigma> \<Longrightarrow>
   collection_type\<^sub>N (Required \<tau>) k \<sigma> False"
| "collection_type\<^sub>T \<tau> k \<sigma> \<Longrightarrow>
   collection_type\<^sub>N (Optional \<tau>) k \<sigma> True"

inductive collection_type where
  "collection_type\<^sub>N \<tau> k \<sigma> n \<Longrightarrow>
   collection_type (ErrorFree \<tau>) k (ErrorFree \<sigma>) n False"
| "collection_type\<^sub>N \<tau> k \<sigma> n \<Longrightarrow>
   collection_type (Errorable \<tau>) k (ErrorFree \<sigma>) n True"

abbreviation collection_type_r ("_ \<hookrightarrow> Collection\<^bsub>_\<^esub>'(_')([1])" [900] 900) where
  "collection_type_r \<tau> k \<sigma> \<equiv> collection_type \<tau> k \<sigma> False False"
abbreviation collection_type_o ("_ \<hookrightarrow> Collection\<^bsub>_\<^esub>'(_')([?])" [900] 900) where
  "collection_type_o \<tau> k \<sigma> \<equiv> collection_type \<tau> k \<sigma> True False"
abbreviation collection_type_re ("_ \<hookrightarrow> Collection\<^bsub>_\<^esub>'(_')([1!])" [900] 900) where
  "collection_type_re \<tau> k \<sigma> \<equiv> collection_type \<tau> k \<sigma> False True"
abbreviation collection_type_oe ("_ \<hookrightarrow> Collection\<^bsub>_\<^esub>'(_')([?!])" [900] 900) where
  "collection_type_oe \<tau> k \<sigma> \<equiv> collection_type \<tau> k \<sigma> True True"

inductive collection_type_template where
  "collection_type \<tau> k \<sigma> n _ \<Longrightarrow>
   collection_type_template \<tau> k \<sigma> n"

abbreviation collection_type_template_r ("_ \<hookrightarrow> Collection\<^bsub>_\<^esub>'(_')([1.])" [900] 900) where
  "collection_type_template_r \<tau> k \<sigma> \<equiv> collection_type_template \<tau> k \<sigma> False"
abbreviation collection_type_template_o ("_ \<hookrightarrow> Collection\<^bsub>_\<^esub>'(_')([?.])" [900] 900) where
  "collection_type_template_o \<tau> k \<sigma> \<equiv> collection_type_template \<tau> k \<sigma> True"

inductive any_collection_type where
  "collection_type \<tau> _ \<sigma> n e \<Longrightarrow>
   any_collection_type \<tau> \<sigma> n e"

abbreviation any_collection_type_r ("_ \<hookrightarrow> Collection'(_')([1])") where
  "any_collection_type_r \<tau> \<sigma> \<equiv> any_collection_type \<tau> \<sigma> False False"
abbreviation any_collection_type_o ("_ \<hookrightarrow> Collection'(_')([?])") where
  "any_collection_type_o \<tau> \<sigma> \<equiv> any_collection_type \<tau> \<sigma> True False"
abbreviation any_collection_type_re ("_ \<hookrightarrow> Collection'(_')([1!])") where
  "any_collection_type_re \<tau> \<sigma> \<equiv> any_collection_type \<tau> \<sigma> False True"
abbreviation any_collection_type_oe ("_ \<hookrightarrow> Collection'(_')([?!])") where
  "any_collection_type_oe \<tau> \<sigma> \<equiv> any_collection_type \<tau> \<sigma> True True"

inductive any_collection_type_template where
  "collection_type \<tau> _ \<sigma> n _ \<Longrightarrow>
   any_collection_type_template \<tau> \<sigma> n"

abbreviation any_collection_type_template_r ("_ \<hookrightarrow> Collection'(_')([1.])") where
  "any_collection_type_template_r \<tau> \<sigma> \<equiv> any_collection_type_template \<tau> \<sigma> False"
abbreviation any_collection_type_template_o ("_ \<hookrightarrow> Collection'(_')([?.])") where
  "any_collection_type_template_o \<tau> \<sigma> \<equiv> any_collection_type_template \<tau> \<sigma> True"

inductive collection_type_template' ("_ \<hookrightarrow> Collection'(_')" 900) where
  "collection_type \<tau> _ \<sigma> _ _ \<Longrightarrow>
   collection_type_template' \<tau> \<sigma>"

inductive collection_type' where
  "collection_type\<^sub>N \<tau> k \<sigma> n \<Longrightarrow>
   collection_type' (ErrorFree \<tau>) k (ErrorFree \<sigma>) n False"
| "collection_type\<^sub>N \<tau> k \<sigma> n \<Longrightarrow>
   collection_type' (Errorable \<tau>) k (ErrorFree \<sigma>) n True"
| "collection_type\<^sub>N \<tau> k \<sigma> n \<Longrightarrow>
   collection_type' (Errorable \<tau>) k (Errorable \<sigma>) n False"
| "collection_type\<^sub>N \<tau> k \<sigma> n \<Longrightarrow>
   collection_type' (Errorable \<tau>) k (Errorable \<sigma>) n True"

abbreviation collection_type_r' ("_ \<hookleftarrow> Collection\<^bsub>_\<^esub>'(_')([1])") where
  "collection_type_r' \<tau> k \<sigma> \<equiv> collection_type' \<tau> k \<sigma> False False"
abbreviation collection_type_o' ("_ \<hookleftarrow> Collection\<^bsub>_\<^esub>'(_')([?])") where
  "collection_type_o' \<tau> k \<sigma> \<equiv> collection_type' \<tau> k \<sigma> True False"
abbreviation collection_type_re' ("_ \<hookleftarrow> Collection\<^bsub>_\<^esub>'(_')([1!])") where
  "collection_type_re' \<tau> k \<sigma> \<equiv> collection_type' \<tau> k \<sigma> False True"
abbreviation collection_type_oe' ("_ \<hookleftarrow> Collection\<^bsub>_\<^esub>'(_')([?!])") where
  "collection_type_oe' \<tau> k \<sigma> \<equiv> collection_type' \<tau> k \<sigma> True True"

abbreviation set_type_r ("_ \<hookrightarrow> Set'(_')([1])") where
  "set_type_r \<tau> \<sigma> \<equiv> collection_type \<tau> SetKind \<sigma> False False"
abbreviation set_type_o ("_ \<hookrightarrow> Set'(_')([?])") where
  "set_type_o \<tau> \<sigma> \<equiv> collection_type \<tau> SetKind \<sigma> True False"
abbreviation set_type_re ("_ \<hookrightarrow> Set'(_')([1!])") where
  "set_type_re \<tau> \<sigma> \<equiv> collection_type \<tau> SetKind \<sigma> False True"
abbreviation set_type_oe ("_ \<hookrightarrow> Set'(_')([?!])") where
  "set_type_oe \<tau> \<sigma> \<equiv> collection_type \<tau> SetKind \<sigma> True True"

abbreviation set_type_r' ("_ \<hookleftarrow> Set'(_')([1])") where
  "set_type_r' \<tau> \<sigma> \<equiv> collection_type' \<tau> SetKind \<sigma> False False"
abbreviation set_type_o' ("_ \<hookleftarrow> Set'(_')([?])") where
  "set_type_o' \<tau> \<sigma> \<equiv> collection_type' \<tau> SetKind \<sigma> True False"
abbreviation set_type_re' ("_ \<hookleftarrow> Set'(_')([1!])") where
  "set_type_re' \<tau> \<sigma> \<equiv> collection_type' \<tau> SetKind \<sigma> False True"
abbreviation set_type_oe' ("_ \<hookleftarrow> Set'(_')([?!])") where
  "set_type_oe' \<tau> \<sigma> \<equiv> collection_type' \<tau> SetKind \<sigma> True True"

abbreviation ordered_set_type_r ("_ \<hookrightarrow> OrderedSet'(_')([1])") where
  "ordered_set_type_r \<tau> \<sigma> \<equiv> collection_type \<tau> OrderedSetKind \<sigma> False False"
abbreviation ordered_set_type_o ("_ \<hookrightarrow> OrderedSet'(_')([?])") where
  "ordered_set_type_o \<tau> \<sigma> \<equiv> collection_type \<tau> OrderedSetKind \<sigma> True False"
abbreviation ordered_set_type_re ("_ \<hookrightarrow> OrderedSet'(_')([1!])") where
  "ordered_set_type_re \<tau> \<sigma> \<equiv> collection_type \<tau> OrderedSetKind \<sigma> False True"
abbreviation ordered_set_type_oe ("_ \<hookrightarrow> OrderedSet'(_')([?!])") where
  "ordered_set_type_oe \<tau> \<sigma> \<equiv> collection_type \<tau> OrderedSetKind \<sigma> True True"

abbreviation ordered_set_type_r' ("_ \<hookleftarrow> OrderedSet'(_')([1])") where
  "ordered_set_type_r' \<tau> \<sigma> \<equiv> collection_type' \<tau> OrderedSetKind \<sigma> False False"
abbreviation ordered_set_type_o' ("_ \<hookleftarrow> OrderedSet'(_')([?])") where
  "ordered_set_type_o' \<tau> \<sigma> \<equiv> collection_type' \<tau> OrderedSetKind \<sigma> True False"
abbreviation ordered_set_type_re' ("_ \<hookleftarrow> OrderedSet'(_')([1!])") where
  "ordered_set_type_re' \<tau> \<sigma> \<equiv> collection_type' \<tau> OrderedSetKind \<sigma> False True"
abbreviation ordered_set_type_oe' ("_ \<hookleftarrow> OrderedSet'(_')([?!])") where
  "ordered_set_type_oe' \<tau> \<sigma> \<equiv> collection_type' \<tau> OrderedSetKind \<sigma> True True"

abbreviation bag_type_r ("_ \<hookrightarrow> Bag'(_')([1])") where
  "bag_type_r \<tau> \<sigma> \<equiv> collection_type \<tau> BagKind \<sigma> False False"
abbreviation bag_type_o ("_ \<hookrightarrow> Bag'(_')([?])") where
  "bag_type_o \<tau> \<sigma> \<equiv> collection_type \<tau> BagKind \<sigma> True False"
abbreviation bag_type_re ("_ \<hookrightarrow> Bag'(_')([1!])") where
  "bag_type_re \<tau> \<sigma> \<equiv> collection_type \<tau> BagKind \<sigma> False True"
abbreviation bag_type_oe ("_ \<hookrightarrow> Bag'(_')([?!])") where
  "bag_type_oe \<tau> \<sigma> \<equiv> collection_type \<tau> BagKind \<sigma> True True"

abbreviation bag_type_r' ("_ \<hookleftarrow> Bag'(_')([1])") where
  "bag_type_r' \<tau> \<sigma> \<equiv> collection_type' \<tau> BagKind \<sigma> False False"
abbreviation bag_type_o' ("_ \<hookleftarrow> Bag'(_')([?])") where
  "bag_type_o' \<tau> \<sigma> \<equiv> collection_type' \<tau> BagKind \<sigma> True False"
abbreviation bag_type_re' ("_ \<hookleftarrow> Bag'(_')([1!])") where
  "bag_type_re' \<tau> \<sigma> \<equiv> collection_type' \<tau> BagKind \<sigma> False True"
abbreviation bag_type_oe' ("_ \<hookleftarrow> Bag'(_')([?!])") where
  "bag_type_oe' \<tau> \<sigma> \<equiv> collection_type' \<tau> BagKind \<sigma> True True"

abbreviation sequence_type_r ("_ \<hookrightarrow> Sequence'(_')([1])") where
  "sequence_type_r \<tau> \<sigma> \<equiv> collection_type \<tau> SequenceKind \<sigma> False False"
abbreviation sequence_type_o ("_ \<hookrightarrow> Sequence'(_')([?])") where
  "sequence_type_o \<tau> \<sigma> \<equiv> collection_type \<tau> SequenceKind \<sigma> True False"
abbreviation sequence_type_re ("_ \<hookrightarrow> Sequence'(_')([1!])") where
  "sequence_type_re \<tau> \<sigma> \<equiv> collection_type \<tau> SequenceKind \<sigma> False True"
abbreviation sequence_type_oe ("_ \<hookrightarrow> Sequence'(_')([?!])") where
  "sequence_type_oe \<tau> \<sigma> \<equiv> collection_type \<tau> SequenceKind \<sigma> True True"

abbreviation sequence_type_r' ("_ \<hookleftarrow> Sequence'(_')([1])") where
  "sequence_type_r' \<tau> \<sigma> \<equiv> collection_type' \<tau> SequenceKind \<sigma> False False"
abbreviation sequence_type_o' ("_ \<hookleftarrow> Sequence'(_')([?])") where
  "sequence_type_o' \<tau> \<sigma> \<equiv> collection_type' \<tau> SequenceKind \<sigma> True False"
abbreviation sequence_type_re' ("_ \<hookleftarrow> Sequence'(_')([1!])") where
  "sequence_type_re' \<tau> \<sigma> \<equiv> collection_type' \<tau> SequenceKind \<sigma> False True"
abbreviation sequence_type_oe' ("_ \<hookleftarrow> Sequence'(_')([?!])") where
  "sequence_type_oe' \<tau> \<sigma> \<equiv> collection_type' \<tau> SequenceKind \<sigma> True True"

inductive unique_collection_type' where
  "collection_type' \<tau> SetKind \<sigma> n e \<Longrightarrow>
   unique_collection_type' \<tau> SetKind \<sigma> n e"
| "collection_type' \<tau> OrderedSetKind \<sigma> n e \<Longrightarrow>
   unique_collection_type' \<tau> OrderedSetKind \<sigma> n e"
| "collection_type' \<tau> SetKind \<sigma> n e \<Longrightarrow>
   unique_collection_type' \<tau> BagKind \<sigma> n e"
| "collection_type' \<tau> OrderedSetKind \<sigma> n e \<Longrightarrow>
   unique_collection_type' \<tau> SequenceKind \<sigma> n e"

abbreviation unique_collection_type_r' ("_ \<hookleftarrow> UniqueCollection\<^bsub>_\<^esub>'(_')([1])") where
  "unique_collection_type_r' \<tau> k \<sigma> \<equiv> unique_collection_type' \<tau> k \<sigma> False False"
abbreviation unique_collection_type_o' ("_ \<hookleftarrow> UniqueCollection\<^bsub>_\<^esub>'(_')([?])") where
  "unique_collection_type_o' \<tau> k \<sigma> \<equiv> unique_collection_type' \<tau> k \<sigma> True False"
abbreviation unique_collection_type_re' ("_ \<hookleftarrow> UniqueCollection\<^bsub>_\<^esub>'(_')([1!])") where
  "unique_collection_type_re' \<tau> k \<sigma> \<equiv> unique_collection_type' \<tau> k \<sigma> False True"
abbreviation unique_collection_type_oe' ("_ \<hookleftarrow> UniqueCollection\<^bsub>_\<^esub>'(_')([?!])") where
  "unique_collection_type_oe' \<tau> k \<sigma> \<equiv> unique_collection_type' \<tau> k \<sigma> True True"

inductive non_unique_collection_type' where
  "collection_type' \<tau> BagKind \<sigma> n e \<Longrightarrow>
   non_unique_collection_type' \<tau> SetKind \<sigma> n e"
| "collection_type' \<tau> SequenceKind \<sigma> n e \<Longrightarrow>
   non_unique_collection_type' \<tau> OrderedSetKind \<sigma> n e"
| "collection_type' \<tau> BagKind \<sigma> n e \<Longrightarrow>
   non_unique_collection_type' \<tau> BagKind \<sigma> n e"
| "collection_type' \<tau> SequenceKind \<sigma> n e \<Longrightarrow>
   non_unique_collection_type' \<tau> SequenceKind \<sigma> n e"

abbreviation non_unique_collection_type_r' ("_ \<hookleftarrow> NonUniqueCollection\<^bsub>_\<^esub>'(_')([1])") where
  "non_unique_collection_type_r' \<tau> k \<sigma> \<equiv> non_unique_collection_type' \<tau> k \<sigma> False False"
abbreviation non_unique_collection_type_o' ("_ \<hookleftarrow> NonUniqueCollection\<^bsub>_\<^esub>'(_')([?])") where
  "non_unique_collection_type_o' \<tau> k \<sigma> \<equiv> non_unique_collection_type' \<tau> k \<sigma> True False"
abbreviation non_unique_collection_type_re' ("_ \<hookleftarrow> NonUniqueCollection\<^bsub>_\<^esub>'(_')([1!])") where
  "non_unique_collection_type_re' \<tau> k \<sigma> \<equiv> non_unique_collection_type' \<tau> k \<sigma> False True"
abbreviation non_unique_collection_type_oe' ("_ \<hookleftarrow> NonUniqueCollection\<^bsub>_\<^esub>'(_')([?!])") where
  "non_unique_collection_type_oe' \<tau> k \<sigma> \<equiv> non_unique_collection_type' \<tau> k \<sigma> True True"

inductive any_ordered_collection_type where
  "collection_type \<tau> OrderedSetKind \<sigma> n e \<Longrightarrow>
   any_ordered_collection_type \<tau> \<sigma> n e"
| "collection_type \<tau> SequenceKind \<sigma> n e \<Longrightarrow>
   any_ordered_collection_type \<tau> \<sigma> n e"

abbreviation any_ordered_collection_type_r ("_ \<hookrightarrow> OrderedCollection'(_')([1])") where
  "any_ordered_collection_type_r \<tau> \<sigma> \<equiv> any_ordered_collection_type \<tau> \<sigma> False False"
abbreviation any_ordered_collection_type_o ("_ \<hookrightarrow> OrderedCollection'(_')([?])") where
  "any_ordered_collection_type_o \<tau> \<sigma> \<equiv> any_ordered_collection_type \<tau> \<sigma> True False"
abbreviation any_ordered_collection_type_re ("_ \<hookrightarrow> OrderedCollection'(_')([1!])") where
  "any_ordered_collection_type_re \<tau> \<sigma> \<equiv> any_ordered_collection_type \<tau> \<sigma> False True"
abbreviation any_ordered_collection_type_oe ("_ \<hookrightarrow> OrderedCollection'(_')([?!])") where
  "any_ordered_collection_type_oe \<tau> \<sigma> \<equiv> any_ordered_collection_type \<tau> \<sigma> True True"

inductive any_ordered_collection_type_template where
  "collection_type \<tau> _ \<sigma> n _ \<Longrightarrow>
   any_ordered_collection_type_template \<tau> \<sigma> n"

abbreviation any_ordered_collection_type_template_r ("_ \<hookrightarrow> OrderedCollection'(_')([1.])") where
  "any_ordered_collection_type_template_r \<tau> \<sigma> \<equiv> any_ordered_collection_type_template \<tau> \<sigma> False"
abbreviation any_ordered_collection_type_template_o ("_ \<hookrightarrow> OrderedCollection'(_')([?.])") where
  "any_ordered_collection_type_template_o \<tau> \<sigma> \<equiv> any_ordered_collection_type_template \<tau> \<sigma> True"

inductive ordered_collection_type' where
  "collection_type' \<tau> OrderedSetKind \<sigma> n e \<Longrightarrow>
   ordered_collection_type' \<tau> SetKind \<sigma> n e"
| "collection_type' \<tau> OrderedSetKind \<sigma> n e \<Longrightarrow>
   ordered_collection_type' \<tau> OrderedSetKind \<sigma> n e"
| "collection_type' \<tau> SequenceKind \<sigma> n e \<Longrightarrow>
   ordered_collection_type' \<tau> BagKind \<sigma> n e"
| "collection_type' \<tau> SequenceKind \<sigma> n e \<Longrightarrow>
   ordered_collection_type' \<tau> SequenceKind \<sigma> n e"

abbreviation ordered_collection_type_r' ("_ \<hookleftarrow> OrderedCollection\<^bsub>_\<^esub>'(_')([1])") where
  "ordered_collection_type_r' \<tau> k \<sigma> \<equiv> ordered_collection_type' \<tau> k \<sigma> False False"
abbreviation ordered_collection_type_o' ("_ \<hookleftarrow> OrderedCollection\<^bsub>_\<^esub>'(_')([?])") where
  "ordered_collection_type_o' \<tau> k \<sigma> \<equiv> ordered_collection_type' \<tau> k \<sigma> True False"
abbreviation ordered_collection_type_re' ("_ \<hookleftarrow> OrderedCollection\<^bsub>_\<^esub>'(_')([1!])") where
  "ordered_collection_type_re' \<tau> k \<sigma> \<equiv> ordered_collection_type' \<tau> k \<sigma> False True"
abbreviation ordered_collection_type_oe' ("_ \<hookleftarrow> OrderedCollection\<^bsub>_\<^esub>'(_')([?!])") where
  "ordered_collection_type_oe' \<tau> k \<sigma> \<equiv> ordered_collection_type' \<tau> k \<sigma> True True"

inductive is_collection_type where
  "collection_type \<tau> _ _ _ _ \<Longrightarrow>
   is_collection_type \<tau>"

abbreviation
  "non_collection_type \<tau> \<sigma> n e \<equiv> (\<not> is_collection_type \<tau> \<and> any_type \<tau> \<sigma> n e)"

abbreviation non_collection_type_r ("_ \<hookrightarrow> NonCollection'(_')([1])") where
  "non_collection_type_r \<tau> \<sigma> \<equiv> (\<not> is_collection_type \<tau> \<and> any_type \<tau> \<sigma> False False)"
abbreviation non_collection_type_o ("_ \<hookrightarrow> NonCollection'(_')([?])") where
  "non_collection_type_o \<tau> \<sigma> \<equiv> (\<not> is_collection_type \<tau> \<and> any_type \<tau> \<sigma> True False)"
abbreviation non_collection_type_re ("_ \<hookrightarrow> NonCollection'(_')([1!])") where
  "non_collection_type_re \<tau> \<sigma> \<equiv> (\<not> is_collection_type \<tau> \<and> any_type \<tau> \<sigma> False True)"
abbreviation non_collection_type_oe ("_ \<hookrightarrow> NonCollection'(_')([?!])") where
  "non_collection_type_oe \<tau> \<sigma> \<equiv> (\<not> is_collection_type \<tau> \<and> any_type \<tau> \<sigma> True True)"

abbreviation non_collection_type_template_r ("_ \<hookrightarrow> NonCollection'(_')([1.])") where
  "non_collection_type_template_r \<tau> \<sigma> \<equiv> (\<not> is_collection_type \<tau> \<and> any_type_template \<tau> \<sigma> False)"
abbreviation non_collection_type_template_o ("_ \<hookrightarrow> NonCollection'(_')([?.])") where
  "non_collection_type_template_o \<tau> \<sigma> \<equiv> (\<not> is_collection_type \<tau> \<and> any_type_template \<tau> \<sigma> True)"

abbreviation non_collection_type_template' ("_ \<hookrightarrow> NonCollection'(_')" 900) where
  "non_collection_type_template' \<tau> \<sigma> \<equiv> (\<not> is_collection_type \<tau> \<and> any_type_template' \<tau> \<sigma>)"

inductive to_single_type where
  "\<not> is_collection_type \<tau> \<Longrightarrow>
   to_single_type \<tau> \<tau>"
| "collection_type \<tau> _ \<sigma> _ _ \<Longrightarrow>
   to_single_type \<sigma> \<rho> \<Longrightarrow>
   to_single_type \<tau> \<rho>"

subsection \<open>Map Types\<close>

inductive map_type\<^sub>T where
  "map_type\<^sub>T (Map \<sigma> \<rho>) \<sigma> \<rho>"

inductive map_type\<^sub>N where
  "map_type\<^sub>T \<tau> \<sigma> \<rho> \<Longrightarrow>
   map_type\<^sub>N (Required \<tau>) \<sigma> \<rho> False"
| "map_type\<^sub>T \<tau> \<sigma> \<rho> \<Longrightarrow>
   map_type\<^sub>N (Optional \<tau>) \<sigma> \<rho> True"

inductive map_type where
  "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type (ErrorFree \<tau>) (ErrorFree \<sigma>) (ErrorFree \<rho>) n False"
| "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type (Errorable \<tau>) (ErrorFree \<sigma>) (ErrorFree \<rho>) n True"

abbreviation map_type_r ("_ \<hookrightarrow> Map'(_, _')([1])") where
  "map_type_r \<tau> \<sigma> \<rho> \<equiv> map_type \<tau> \<sigma> \<rho> False False"
abbreviation map_type_o ("_ \<hookrightarrow> Map'(_, _')([?])") where
  "map_type_o \<tau> \<sigma> \<rho> \<equiv> map_type \<tau> \<sigma> \<rho> True False"
abbreviation map_type_re ("_ \<hookrightarrow> Map'(_, _')([1!])") where
  "map_type_re \<tau> \<sigma> \<rho> \<equiv> map_type \<tau> \<sigma> \<rho> False True"
abbreviation map_type_oe ("_ \<hookrightarrow> Map'(_, _')([?!])") where
  "map_type_oe \<tau> \<sigma> \<rho> \<equiv> map_type \<tau> \<sigma> \<rho> True True"

inductive map_type_template where
  "map_type \<tau> \<sigma> \<rho> n _ \<Longrightarrow>
   map_type_template \<tau> \<sigma> \<rho> n"

abbreviation map_type_template_r ("_ \<hookrightarrow> Map'(_, _')([1.])") where
  "map_type_template_r \<tau> \<sigma> \<rho> \<equiv> map_type_template \<tau> \<sigma> \<rho> False"
abbreviation map_type_template_o ("_ \<hookrightarrow> Map'(_, _')([?.])") where
  "map_type_template_o \<tau> \<sigma> \<rho> \<equiv> map_type_template \<tau> \<sigma> \<rho> True"

inductive map_type_template' ("_ \<hookrightarrow> Map'(_, _')" 900) where
  "map_type \<tau> \<sigma> \<rho> _ _ \<Longrightarrow>
   map_type_template' \<tau> \<sigma> \<rho>"

inductive map_type' where
  "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type' (ErrorFree \<tau>) (ErrorFree \<sigma>) (ErrorFree \<rho>) n False"
| "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type' (Errorable \<tau>) (ErrorFree \<sigma>) (Errorable \<rho>) n False"
| "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type' (Errorable \<tau>) (Errorable \<sigma>) (ErrorFree \<rho>) n False"
| "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type' (Errorable \<tau>) (Errorable \<sigma>) (Errorable \<rho>) n False"
| "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type' (Errorable \<tau>) (ErrorFree \<sigma>) (ErrorFree \<rho>) n True"
| "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type' (Errorable \<tau>) (ErrorFree \<sigma>) (Errorable \<rho>) n True"
| "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type' (Errorable \<tau>) (Errorable \<sigma>) (ErrorFree \<rho>) n True"
| "map_type\<^sub>N \<tau> \<sigma> \<rho> n \<Longrightarrow>
   map_type' (Errorable \<tau>) (Errorable \<sigma>) (Errorable \<rho>) n True"

abbreviation map_type_r' ("_ \<hookleftarrow> Map'(_, _')([1])") where
  "map_type_r' \<tau> \<sigma> \<rho> \<equiv> map_type' \<tau> \<sigma> \<rho> False False"
abbreviation map_type_o' ("_ \<hookleftarrow> Map'(_, _')([?])") where
  "map_type_o' \<tau> \<sigma> \<rho> \<equiv> map_type' \<tau> \<sigma> \<rho> True False"
abbreviation map_type_re' ("_ \<hookleftarrow> Map'(_, _')([1!])") where
  "map_type_re' \<tau> \<sigma> \<rho> \<equiv> map_type' \<tau> \<sigma> \<rho> False True"
abbreviation map_type_oe' ("_ \<hookleftarrow> Map'(_, _')([?!])") where
  "map_type_oe' \<tau> \<sigma> \<rho> \<equiv> map_type' \<tau> \<sigma> \<rho> True True"

subsection \<open>Iterable Types\<close>

inductive iterable_type where
  "collection_type \<tau> _ \<sigma> n e \<Longrightarrow>
   iterable_type \<tau> \<sigma> n e"
| "map_type \<tau> \<sigma> _ n e \<Longrightarrow>
   iterable_type \<tau> \<sigma> n e"

abbreviation iterable_type_r ("_ \<hookrightarrow> Iterable'(_')([1])") where
  "iterable_type_r \<tau> \<sigma> \<equiv> iterable_type \<tau> \<sigma> False False"
abbreviation iterable_type_o ("_ \<hookrightarrow> Iterable'(_')([?])") where
  "iterable_type_o \<tau> \<sigma> \<equiv> iterable_type \<tau> \<sigma> True False"
abbreviation iterable_type_re ("_ \<hookrightarrow> Iterable'(_')([1!])") where
  "iterable_type_re \<tau> \<sigma> \<equiv> iterable_type \<tau> \<sigma> False True"
abbreviation iterable_type_oe ("_ \<hookrightarrow> Iterable'(_')([?!])") where
  "iterable_type_oe \<tau> \<sigma> \<equiv> iterable_type \<tau> \<sigma> True True"

inductive iterable_type_template where
  "iterable_type \<tau> \<sigma> n _ \<Longrightarrow>
   iterable_type_template \<tau> \<sigma> n"

abbreviation iterable_type_template_r ("_ \<hookrightarrow> Iterable'(_')([1.])") where
  "iterable_type_template_r \<tau> \<sigma> \<equiv> iterable_type_template \<tau> \<sigma> False"
abbreviation iterable_type_template_o ("_ \<hookrightarrow> Iterable'(_')([?.])") where
  "iterable_type_template_o \<tau> \<sigma> \<equiv> iterable_type_template \<tau> \<sigma> True"

inductive iterable_type_template' ("_ \<hookrightarrow> Iterable'(_')" 900) where
  "iterable_type \<tau> \<sigma> _ _ \<Longrightarrow>
   iterable_type_template' \<tau> \<sigma>"

inductive is_iterable_type where
  "iterable_type \<tau> _ _ _ \<Longrightarrow> is_iterable_type \<tau>"
(*
abbreviation non_iterable_type_r ("_ \<hookrightarrow> NonIterable'(_')([1])") where
  "non_iterable_type_r \<tau> \<sigma> \<equiv> (\<not> is_iterable_type \<tau> \<and> any_type \<tau> \<sigma> False False)"
abbreviation non_iterable_type_o ("_ \<hookrightarrow> NonIterable'(_')([?])") where
  "non_iterable_type_o \<tau> \<sigma> \<equiv> (\<not> is_iterable_type \<tau> \<and> any_type \<tau> \<sigma> True False)"
abbreviation non_iterable_type_re ("_ \<hookrightarrow> NonIterable'(_')([1!])") where
  "non_iterable_type_re \<tau> \<sigma> \<equiv> (\<not> is_iterable_type \<tau> \<and> any_type \<tau> \<sigma> False True)"
abbreviation non_iterable_type_oe ("_ \<hookrightarrow> NonIterable'(_')([?!])") where
  "non_iterable_type_oe \<tau> \<sigma> \<equiv> (\<not> is_iterable_type \<tau> \<and> any_type \<tau> \<sigma> True True)"

abbreviation non_iterable_type_template_r ("_ \<hookrightarrow> NonIterable'(_')([1.])") where
  "non_iterable_type_template_r \<tau> \<sigma> \<equiv> (\<not> is_iterable_type \<tau> \<and> any_type_template \<tau> \<sigma> False)"
abbreviation non_iterable_type_template_o ("_ \<hookrightarrow> NonIterable'(_')([?.])") where
  "non_iterable_type_template_o \<tau> \<sigma> \<equiv> (\<not> is_iterable_type \<tau> \<and> any_type_template \<tau> \<sigma> True)"
*)
abbreviation non_iterable_type_template' ("_ \<hookrightarrow> NonIterable'(_')" 900) where
  "non_iterable_type_template' \<tau> \<sigma> \<equiv> (\<not> is_iterable_type \<tau> \<and> any_type_template' \<tau> \<sigma>)"

(*** Simplification Rules ***************************************************)

section \<open>Simplification Rules\<close>
(*
lemma any_type_template'_simps:
  "any_type_template' (ErrorFree \<tau>) \<sigma> = (\<exists>n. any_type\<^sub>N \<tau> \<sigma> n)"
  "any_type_template' (Errorable \<tau>) \<sigma> = (\<exists>n. any_type\<^sub>N \<tau> \<sigma> n)"
  by (auto simp add: any_type_template'.simps any_type_template.simps)

lemma ex_any_type_template'_simps:
  "Ex (any_type_template' (ErrorFree \<tau>)) = (\<exists>\<sigma> n. any_type\<^sub>N \<tau> \<sigma> n)"
  "Ex (any_type_template' (Errorable \<tau>)) = (\<exists>\<sigma> n. any_type\<^sub>N \<tau> \<sigma> n)"
  using any_type_template'_simps(1) apply blast
  using any_type_template'_simps(2) by blast
*)

lemma collection_type_simps:
  "collection_type (ErrorFree \<tau>) k \<sigma> n e =
   (\<exists>\<rho>. \<sigma> = ErrorFree \<rho> \<and> e = False \<and> collection_type\<^sub>N \<tau> k \<rho> n)"
  "collection_type (Errorable \<tau>) k \<sigma> n e =
   (\<exists>\<rho>. \<sigma> = ErrorFree \<rho> \<and> e = True \<and> collection_type\<^sub>N \<tau> k \<rho> n)"
  by (simp_all add: collection_type.simps)

lemma ex_collection_type_simps:
  "Ex (collection_type (ErrorFree \<tau>) k \<sigma> n) =
   (\<exists>\<rho>. \<sigma> = ErrorFree \<rho> \<and> collection_type\<^sub>N \<tau> k \<rho> n)"
  "Ex (collection_type (Errorable \<tau>) k \<sigma> n) =
   (\<exists>\<rho>. \<sigma> = ErrorFree \<rho> \<and> collection_type\<^sub>N \<tau> k \<rho> n)"
  using collection_type_simps(1) apply blast
  using collection_type_simps(2) by blast

lemma collection_type'_simps:
  "collection_type' \<tau> k (ErrorFree \<sigma>) n False =
   (\<exists>\<rho>. \<tau> = ErrorFree \<rho> \<and> collection_type\<^sub>N \<rho> k \<sigma> n)"
  "collection_type' \<tau> k (Errorable \<sigma>) n False =
   (\<exists>\<rho>. \<tau> = Errorable \<rho> \<and> collection_type\<^sub>N \<rho> k \<sigma> n)"
  "collection_type' \<tau> k (ErrorFree \<sigma>) n True =
   (\<exists>\<rho>. \<tau> = Errorable \<rho> \<and> collection_type\<^sub>N \<rho> k \<sigma> n)"
  "collection_type' \<tau> k (Errorable \<sigma>) n True =
   (\<exists>\<rho>. \<tau> = Errorable \<rho> \<and> collection_type\<^sub>N \<rho> k \<sigma> n)"
  by (simp_all add: collection_type'.simps)

text \<open>
  The first argument gets simpler, so the following simplification rules
  does not get stuck.\<close>

lemma to_single_type_simps:
  "to_single_type (ErrorFree \<tau>) \<sigma> =
   ((\<not> is_collection_type (ErrorFree \<tau>) \<and> (ErrorFree \<tau>) = \<sigma>) \<or>
    (\<exists>k \<upsilon> n e. collection_type (ErrorFree \<tau>) k \<upsilon> n e \<and> to_single_type \<upsilon> \<sigma>))"
  "to_single_type (Errorable \<tau>) \<sigma> =
   ((\<not> is_collection_type (Errorable \<tau>) \<and> (Errorable \<tau>) = \<sigma>) \<or>
    (\<exists>k \<upsilon> n e. collection_type (Errorable \<tau>) k \<upsilon> n e \<and> to_single_type \<upsilon> \<sigma>))"
  by (subst to_single_type.simps; auto)+

lemmas ocl_type_helper_simps =
  (*any_type\<^sub>N.simps*)
  any_type.simps
  any_type_template.simps
  any_type_template'.simps
  (*any_type_template'_simps
  ex_any_type_template'_simps*)

  tuple_type.simps
  tuple_type'.simps

  collection_type\<^sub>T.simps
  collection_type\<^sub>N.simps
  collection_type_simps
  ex_collection_type_simps
  collection_type'_simps
  any_collection_type.simps
  any_collection_type_template.simps
  collection_type_template.simps
  collection_type_template'.simps
  unique_collection_type'.simps
  non_unique_collection_type'.simps
  any_ordered_collection_type.simps
  any_ordered_collection_type_template.simps
  ordered_collection_type'.simps
  is_collection_type.simps
  to_single_type_simps

  map_type\<^sub>T.simps
  map_type\<^sub>N.simps
  map_type.simps
  map_type'.simps
  map_type_template.simps
  map_type_template'.simps

  iterable_type.simps
  iterable_type_template.simps
  iterable_type_template'.simps
  is_iterable_type.simps

(*** Misc Properties ********************************************************)

section \<open>Misc Properties\<close>

lemma tuple_type_implies_tuple_type':
  "tuple_type \<tau> \<pi> n \<Longrightarrow> \<pi> \<noteq> fmempty \<Longrightarrow> tuple_type' \<tau> \<pi> n"
  apply (erule tuple_type.cases;
         simp add: tuple_type'.simps fmap.map_comp fmap.map_id0)
  using not_fmempty_eq_fmran_not_fempty by fastforce

lemma tuple_type'_implies_ex_tuple_type:
  "tuple_type' \<tau> \<pi> n \<Longrightarrow> \<exists>\<xi>. tuple_type \<tau> \<xi> n"
  by (erule tuple_type'.cases; auto simp add: tuple_type.simps)

lemma tuple_type\<^sub>T_sup:
  "tuple_type\<^sub>T \<tau> \<pi> \<Longrightarrow>
   tuple_type\<^sub>T \<sigma> \<xi> \<Longrightarrow>
   tuple_type\<^sub>T (\<tau> \<squnion> \<sigma>) (fmmerge (\<squnion>) \<pi> \<xi>)"
  for \<tau> \<sigma> :: "('a :: semilattice_sup) type"
  by (simp add: tuple_type\<^sub>T.simps)

lemma tuple_type\<^sub>N_sup:
  "tuple_type\<^sub>N \<tau> \<pi> n \<Longrightarrow>
   tuple_type\<^sub>N \<sigma> \<xi> n \<Longrightarrow>
   tuple_type\<^sub>N (\<tau> \<squnion> \<sigma>) (fmmerge (\<squnion>) \<pi> \<xi>) n"
  for \<tau> \<sigma> :: "('a :: semilattice_sup) type\<^sub>N"
  by (auto simp add: tuple_type\<^sub>N.simps tuple_type\<^sub>T.simps)

(* TODO: Show a concrete value of \<pi> *)
lemma tuple_type_sup:
  "tuple_type \<tau> \<pi> n \<Longrightarrow>
   tuple_type \<sigma> \<xi> n \<Longrightarrow>
   \<exists>\<pi>. tuple_type (\<tau> \<squnion> \<sigma>) \<pi> n"
  for \<tau> \<sigma> :: "('a :: semilattice_sup) type\<^sub>N\<^sub>E"
  by (cases \<tau>; cases \<sigma>; auto simp add: tuple_type.simps
      tuple_type\<^sub>N.simps tuple_type\<^sub>T.simps)

lemma collection_type_sup:
  "collection_type \<tau> k \<rho> n e \<Longrightarrow>
   collection_type \<sigma> k \<upsilon> n e \<Longrightarrow>
   collection_type (\<tau> \<squnion> \<sigma>) k (\<rho> \<squnion> \<upsilon>) n e"
  by (auto simp add: collection_type.simps
      collection_type\<^sub>N.simps collection_type\<^sub>T.simps)

lemma collection_type_and_non_collection_type_distinct:
  "collection_type_template \<tau> k \<sigma> n \<Longrightarrow> non_collection_type_template' \<tau> \<rho> \<Longrightarrow> False"
  "collection_type_template' \<tau> \<sigma> \<Longrightarrow> non_collection_type_template' \<tau> \<rho> \<Longrightarrow> False"
  "any_collection_type \<tau> \<sigma> n\<^sub>1 e\<^sub>1 \<Longrightarrow> non_collection_type \<tau> \<rho> n\<^sub>2 e\<^sub>2 \<Longrightarrow> False"
  "any_collection_type_template \<tau> \<sigma> n \<Longrightarrow> non_collection_type_template' \<tau> \<rho> \<Longrightarrow> False"
  by (auto simp add: collection_type_template.simps collection_type_template'.simps
      any_collection_type_template.simps any_collection_type.simps is_collection_type.simps)

lemma collection_type_and_map_type_distinct:
  "collection_type \<tau> k \<sigma> n\<^sub>1 e\<^sub>1 \<Longrightarrow> map_type \<tau> \<rho> \<upsilon> n\<^sub>2 e\<^sub>2 \<Longrightarrow> False"
  by (auto simp: collection_type.simps collection_type\<^sub>N.simps
      collection_type\<^sub>T.simps map_type.simps map_type\<^sub>N.simps map_type\<^sub>T.simps)

lemma map_type_implies_map_type':
  "map_type \<tau> \<sigma> \<rho> n e \<Longrightarrow> map_type' \<tau> \<sigma> \<rho> n e"
  by (erule map_type.cases; simp add: map_type'.simps)
(*
lemma map_type'_implies_ex_map_type:
  "map_type' \<tau> \<sigma> \<rho> n e \<Longrightarrow> \<exists>\<upsilon> \<phi>. map_type \<tau> \<upsilon> \<phi> n e"
  by (erule map_type'.cases; auto simp add: map_type.simps)
*)
lemma map_type_sup:
  "map_type \<tau> \<rho> \<phi> n e \<Longrightarrow>
   map_type \<sigma> \<upsilon> \<psi> n e \<Longrightarrow>
   map_type (\<tau> \<squnion> \<sigma>) (\<rho> \<squnion> \<upsilon>) (\<phi> \<squnion> \<psi>) n e"
  for \<tau> \<sigma> \<rho> \<upsilon> :: "('a :: semilattice_sup) type\<^sub>N\<^sub>E"
  apply (cases \<rho>; cases \<phi>)
  by (auto simp add: map_type.simps map_type\<^sub>N.simps map_type\<^sub>T.simps)

lemma map_type'_sup:
  "map_type' \<tau> \<rho> \<phi> n e \<Longrightarrow>
   map_type \<sigma> \<upsilon> \<psi> n e \<Longrightarrow>
   map_type' (\<tau> \<squnion> \<sigma>) (\<rho> \<squnion> \<upsilon>) (\<phi> \<squnion> \<psi>) n e"
  for \<tau> \<sigma> \<rho> \<upsilon> :: "('a :: semilattice_sup) type\<^sub>N\<^sub>E"
  apply (cases \<rho>; cases \<phi>)
  by (auto simp add: map_type'.simps map_type.simps
      map_type\<^sub>N.simps map_type\<^sub>T.simps)

lemma any_collection_type_and_map_type_distinct:
  "any_collection_type \<tau> \<sigma> n\<^sub>1 e\<^sub>1 \<Longrightarrow> map_type \<tau> \<rho> \<upsilon> n\<^sub>2 e\<^sub>2 \<Longrightarrow> False"
  by (auto simp: any_collection_type.simps collection_type.simps
      collection_type\<^sub>N.simps collection_type\<^sub>T.simps
      map_type.simps map_type\<^sub>N.simps map_type\<^sub>T.simps)

lemma any_ordered_collection_type_and_map_type_distinct:
  "any_ordered_collection_type \<tau> \<sigma> n\<^sub>1 e\<^sub>1 \<Longrightarrow> map_type \<tau> \<rho> \<upsilon> n\<^sub>2 e\<^sub>2 \<Longrightarrow> False"
  by (auto simp: any_ordered_collection_type.simps collection_type.simps
      collection_type\<^sub>N.simps collection_type\<^sub>T.simps
      map_type.simps map_type\<^sub>N.simps map_type\<^sub>T.simps)

(*** Determinism ************************************************************)

section \<open>Determinism\<close>

lemma tuple_type\<^sub>T_det:
  "tuple_type\<^sub>T \<tau> \<pi>\<^sub>1 \<Longrightarrow>
   tuple_type\<^sub>T \<tau> \<pi>\<^sub>2 \<Longrightarrow> \<pi>\<^sub>1 = \<pi>\<^sub>2"
  "tuple_type\<^sub>T \<tau>\<^sub>1 \<pi> \<Longrightarrow>
   tuple_type\<^sub>T \<tau>\<^sub>2 \<pi> \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (auto simp add: tuple_type\<^sub>T.simps)

lemma tuple_type\<^sub>N_det:
  "tuple_type\<^sub>N \<tau> \<pi>\<^sub>1 n\<^sub>1 \<Longrightarrow>
   tuple_type\<^sub>N \<tau> \<pi>\<^sub>2 n\<^sub>2 \<Longrightarrow> \<pi>\<^sub>1 = \<pi>\<^sub>2 \<and>  n\<^sub>1 =  n\<^sub>2"
  "tuple_type\<^sub>N \<tau>\<^sub>1 \<pi> n \<Longrightarrow>
   tuple_type\<^sub>N \<tau>\<^sub>2 \<pi> n \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (auto simp add: tuple_type\<^sub>N.simps tuple_type\<^sub>T_det)

lemma tuple_type_det:
  "tuple_type \<tau> \<pi>\<^sub>1 n\<^sub>1 \<Longrightarrow>
   tuple_type \<tau> \<pi>\<^sub>2 n\<^sub>2 \<Longrightarrow> \<pi>\<^sub>1 = \<pi>\<^sub>2 \<and>  n\<^sub>1 =  n\<^sub>2"
  "tuple_type' \<tau>\<^sub>1 \<pi> n \<Longrightarrow>
   tuple_type' \<tau>\<^sub>2 \<pi> n \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  apply (elim tuple_type.cases)
  using tuple_type\<^sub>N_det(1) apply blast+
  apply (elim tuple_type'.cases)
  using tuple_type\<^sub>N_det(2) by blast+

lemma collection_type\<^sub>T_det:
  "collection_type\<^sub>T \<tau> k\<^sub>1 \<sigma>\<^sub>N \<Longrightarrow>
   collection_type\<^sub>T \<tau> k\<^sub>2 \<rho>\<^sub>N \<Longrightarrow> k\<^sub>1 = k\<^sub>2 \<and> \<sigma>\<^sub>N = \<rho>\<^sub>N"
  "collection_type\<^sub>T \<tau>\<^sub>1 k \<sigma>\<^sub>N \<Longrightarrow>
   collection_type\<^sub>T \<tau>\<^sub>2 k \<sigma>\<^sub>N \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (auto simp add: collection_type\<^sub>T.simps)

lemma collection_type\<^sub>N_det:
  "collection_type\<^sub>N \<tau>\<^sub>N k\<^sub>1 \<sigma>\<^sub>N n\<^sub>1 \<Longrightarrow>
   collection_type\<^sub>N \<tau>\<^sub>N k\<^sub>2 \<rho>\<^sub>N n\<^sub>2 \<Longrightarrow> k\<^sub>1 = k\<^sub>2 \<and> \<sigma>\<^sub>N = \<rho>\<^sub>N \<and> n\<^sub>1 = n\<^sub>2"
  "collection_type\<^sub>N \<tau>\<^sub>N\<^sub>1 k \<sigma>\<^sub>N n \<Longrightarrow>
   collection_type\<^sub>N \<tau>\<^sub>N\<^sub>2 k \<sigma>\<^sub>N n \<Longrightarrow> \<tau>\<^sub>N\<^sub>1 = \<tau>\<^sub>N\<^sub>2"
  by (auto simp add: collection_type\<^sub>N.simps collection_type\<^sub>T_det)

lemma collection_type_det:
  "collection_type \<tau> k\<^sub>1 \<sigma>\<^sub>1 n\<^sub>1 e\<^sub>1 \<Longrightarrow>
   collection_type \<tau> k\<^sub>2 \<sigma>\<^sub>2 n\<^sub>2 e\<^sub>2 \<Longrightarrow> k\<^sub>1 = k\<^sub>2 \<and> \<sigma>\<^sub>1 = \<sigma>\<^sub>2 \<and> n\<^sub>1 = n\<^sub>2 \<and> e\<^sub>1 = e\<^sub>2"
  by (elim collection_type.cases; simp add: collection_type\<^sub>N_det(1))

lemma collection_type'_det:
  "collection_type' \<tau>\<^sub>1 k \<sigma> n e \<Longrightarrow>
   collection_type' \<tau>\<^sub>2 k \<sigma> n e \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (elim collection_type'.cases; simp add: collection_type\<^sub>N_det(2))

lemma any_collection_type_det:
  "any_collection_type \<tau> \<sigma>\<^sub>1 n\<^sub>1 e\<^sub>1 \<Longrightarrow>
   any_collection_type \<tau> \<sigma>\<^sub>2 n\<^sub>2 e\<^sub>2 \<Longrightarrow> \<sigma>\<^sub>1 = \<sigma>\<^sub>2 \<and> n\<^sub>1 = n\<^sub>2 \<and> e\<^sub>1 = e\<^sub>2"
  by (elim any_collection_type.cases; simp add: collection_type_det)

lemma any_collection_type_template_det:
  "any_collection_type_template \<tau> \<sigma>\<^sub>1 n\<^sub>1 \<Longrightarrow>
   any_collection_type_template \<tau> \<sigma>\<^sub>2 n\<^sub>2 \<Longrightarrow> \<sigma>\<^sub>1 = \<sigma>\<^sub>2 \<and> n\<^sub>1 = n\<^sub>2"
  by (elim any_collection_type_template.cases; simp add: collection_type_det)

lemma unique_collection_type'_det:
  "unique_collection_type' \<tau>\<^sub>1 k \<sigma> n e \<Longrightarrow>
   unique_collection_type' \<tau>\<^sub>2 k \<sigma> n e \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (elim unique_collection_type'.cases; simp add: collection_type'_det)

lemma non_unique_collection_type'_det:
  "non_unique_collection_type' \<tau>\<^sub>1 k \<sigma> n e \<Longrightarrow>
   non_unique_collection_type' \<tau>\<^sub>2 k \<sigma> n e \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (elim non_unique_collection_type'.cases; simp add: collection_type'_det)

lemma any_ordered_collection_type_det:
  "any_ordered_collection_type \<tau> \<sigma>\<^sub>1 n\<^sub>1 e\<^sub>1 \<Longrightarrow>
   any_ordered_collection_type \<tau> \<sigma>\<^sub>2 n\<^sub>2 e\<^sub>2 \<Longrightarrow> \<sigma>\<^sub>1 = \<sigma>\<^sub>2 \<and> n\<^sub>1 = n\<^sub>2 \<and> e\<^sub>1 = e\<^sub>2"
  by (elim any_ordered_collection_type.cases; simp add: collection_type_det)

lemma ordered_collection_type'_det:
  "ordered_collection_type' \<tau>\<^sub>1 k \<sigma> n e \<Longrightarrow>
   ordered_collection_type' \<tau>\<^sub>2 k \<sigma> n e \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (elim ordered_collection_type'.cases; simp add: collection_type'_det)

lemma to_single_type_det:
  "to_single_type \<tau> \<sigma> \<Longrightarrow>
   to_single_type \<tau> \<rho> \<Longrightarrow> \<sigma> = \<rho>"
  apply (induct rule: to_single_type.induct)
  apply (erule to_single_type.cases; simp add: is_collection_type.intros)
  apply (erule to_single_type.cases)
  sorry
(*  using collection_type_det is_collection_type.intros to_single_type.simps by blast*)
(*  by (smt collection_type_det is_collection_type.intros to_single_type.simps)*)

lemma map_type\<^sub>T_det:
  "map_type\<^sub>T \<tau> \<sigma>\<^sub>N\<^sub>1 \<rho>\<^sub>N\<^sub>1 \<Longrightarrow>
   map_type\<^sub>T \<tau> \<sigma>\<^sub>N\<^sub>2 \<rho>\<^sub>N\<^sub>2 \<Longrightarrow> \<sigma>\<^sub>N\<^sub>1 = \<sigma>\<^sub>N\<^sub>2 \<and> \<rho>\<^sub>N\<^sub>1 = \<rho>\<^sub>N\<^sub>2"
  "map_type\<^sub>T \<tau>\<^sub>1 \<sigma>\<^sub>N \<rho>\<^sub>N \<Longrightarrow>
   map_type\<^sub>T \<tau>\<^sub>2 \<sigma>\<^sub>N \<rho>\<^sub>N \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (auto simp add: map_type\<^sub>T.simps)

lemma map_type\<^sub>N_det:
  "map_type\<^sub>N \<tau> \<sigma>\<^sub>N\<^sub>1 \<rho>\<^sub>N\<^sub>1 n\<^sub>1 \<Longrightarrow>
   map_type\<^sub>N \<tau> \<sigma>\<^sub>N\<^sub>2 \<rho>\<^sub>N\<^sub>2 n\<^sub>2 \<Longrightarrow> \<sigma>\<^sub>N\<^sub>1 = \<sigma>\<^sub>N\<^sub>2 \<and> \<rho>\<^sub>N\<^sub>1 = \<rho>\<^sub>N\<^sub>2 \<and> n\<^sub>1 = n\<^sub>2"
  "map_type\<^sub>N \<tau>\<^sub>1 \<sigma>\<^sub>N \<rho>\<^sub>N n \<Longrightarrow>
   map_type\<^sub>N \<tau>\<^sub>2 \<sigma>\<^sub>N \<rho>\<^sub>N n \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (auto simp add: map_type\<^sub>N.simps map_type\<^sub>T_det)

lemma map_type_det:
  "map_type \<tau> \<sigma>\<^sub>N\<^sub>1 \<rho>\<^sub>N\<^sub>1 n\<^sub>1 e\<^sub>1 \<Longrightarrow>
   map_type \<tau> \<sigma>\<^sub>N\<^sub>2 \<rho>\<^sub>N\<^sub>2 n\<^sub>2 e\<^sub>2 \<Longrightarrow> \<sigma>\<^sub>N\<^sub>1 = \<sigma>\<^sub>N\<^sub>2 \<and> \<rho>\<^sub>N\<^sub>1 = \<rho>\<^sub>N\<^sub>2 \<and> n\<^sub>1 = n\<^sub>2 \<and> e\<^sub>1 = e\<^sub>2"
  by (elim map_type.cases; simp add: map_type\<^sub>N_det(1))

lemma map_type_template_det:
  "map_type_template \<tau> \<sigma>\<^sub>N\<^sub>1 \<rho>\<^sub>N\<^sub>1 n\<^sub>1 \<Longrightarrow>
   map_type_template \<tau> \<sigma>\<^sub>N\<^sub>2 \<rho>\<^sub>N\<^sub>2 n\<^sub>2 \<Longrightarrow> \<sigma>\<^sub>N\<^sub>1 = \<sigma>\<^sub>N\<^sub>2 \<and> \<rho>\<^sub>N\<^sub>1 = \<rho>\<^sub>N\<^sub>2 \<and> n\<^sub>1 = n\<^sub>2"
  by (elim map_type_template.cases; simp add: map_type_det)

lemma map_type'_det:
  "map_type' \<tau>\<^sub>1 \<sigma>\<^sub>N \<rho>\<^sub>N n e \<Longrightarrow>
   map_type' \<tau>\<^sub>2 \<sigma>\<^sub>N \<rho>\<^sub>N n e \<Longrightarrow> \<tau>\<^sub>1 = \<tau>\<^sub>2"
  by (elim map_type'.cases; simp add: map_type\<^sub>N_det(2))

lemma iterable_type_det:
  "iterable_type \<tau> \<sigma> n\<^sub>1 e\<^sub>1 \<Longrightarrow>
   iterable_type \<tau> \<rho> n\<^sub>2 e\<^sub>2 \<Longrightarrow> \<sigma> = \<rho> \<and> n\<^sub>1 = n\<^sub>2 \<and> e\<^sub>1 = e\<^sub>2"
  apply (auto simp add: iterable_type.simps collection_type_det map_type_det(1))
  using collection_type_det collection_type_and_map_type_distinct apply blast+
  using map_type_det(1) by blast+

(*** Notation ***************************************************************)

subsection \<open>Notation\<close>

notation object_type ("_ \<hookrightarrow> ObjectType'(_')([_])")
notation required_object_type ("_ \<hookrightarrow> ObjectType'(_')([1])")
notation optional_object_type ("_ \<hookrightarrow> ObjectType'(_')([?])")

notation tuple_type ("_ \<hookrightarrow> Tuple'(_')([_])")
notation tuple_type' ("_ \<hookleftarrow> Tuple'(_')([_])")
notation required_tuple_type ("_ \<hookrightarrow> Tuple'(_')([1])")
notation required_tuple_type' ("_ \<hookleftarrow> Tuple'(_')([1])")
notation optional_tuple_type ("_ \<hookrightarrow> Tuple'(_')([?])")
notation optional_tuple_type' ("_ \<hookleftarrow> Tuple'(_')([?])")

notation to_optional_type_nested ("_[??]" [1000] 1000)

(*** Code Setup *************************************************************)

section \<open>Code Setup\<close>

code_pred any_type .
code_pred object_type .
code_pred tuple_type .
code_pred tuple_type' .
code_pred collection_type .
code_pred any_collection_type .
code_pred unique_collection_type' .
code_pred non_unique_collection_type' .
(*code_pred ordered_collection_type .*)
code_pred ordered_collection_type' .
code_pred is_collection_type .
code_pred to_single_type .
code_pred map_type .
code_pred map_type' .
code_pred iterable_type .
(*code_pred any_iterable_type .*)
code_pred is_iterable_type .

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               December 2004               |
            |                 August 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |                October 2005  (modified)   |
            |                  April 2006  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2013         |
            |                   June 2013  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2017         |
            |                  April 2018  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory Domain_F
imports CSP_T.Domain_T Set_F
begin

(*****************************************************************

         1.
         2.
         3.
         4.

 *****************************************************************)

(*  The following simplification rules are deleted in this theory file *)
(*  because they unexpectly rewrite UnionT and InterT.                 *)
(*                  Union (B ` A) = (UN x:A. B x)                      *)
(*                  Inter (B ` A) = (INT x:A. B x)                     *)
(*
declare Union_image_eq [simp del]
declare Inter_image_eq [simp del]
*)
(* no simp rules in Isabelle 2017
declare Sup_image_eq [simp del]
declare Inf_image_eq [simp del]
*)

(***********************************************************
                 type def (Stable Failure)
 ***********************************************************)

(* types 'a domTsetF = "'a domT * 'a setF"       (* synonym *)  2011 *)
type_synonym 'a domTsetF = "'a domT * 'a setF"

definition
  HC_T2    :: "'a domTsetF => bool"
  where
  HC_T2_def :
    "HC_T2 TF == ALL s X. (s, X) :f (snd TF)
                --> s :t (fst TF)"

definition
  HC_T3    :: "'a domTsetF => bool"
  where
  HC_T3_def :
    "HC_T3 TF == ALL s. s ^^^ <Tick> :t (fst TF) & noTick s
                --> (ALL X. (s ^^^ <Tick>, X) :f (snd TF))"

definition
  HC_F3    :: "'a domTsetF => bool"
  where
  HC_F3_def :
    "HC_F3 TF == ALL s X Y. (s, X) :f (snd TF) & noTick s &
                          (ALL a. a : Y --> s ^^^ <a> ~:t fst TF)
                --> (s, X Un Y) :f (snd TF)"

definition
  HC_F4    :: "'a domTsetF => bool"
  where
  HC_F4_def :
    "HC_F4 TF == ALL s. s ^^^ <Tick> :t (fst TF) & noTick s
                --> (s, Evset) :f (snd TF)"

definition
  HC_T3_F4 :: "'a domTsetF => bool"
  where
  HC_T3_F4_def :
    "HC_T3_F4 TF == ALL s. s ^^^ <Tick> :t (fst TF) & noTick s
                    --> ((s, Evset) :f (snd TF) &
                         (ALL X. (s ^^^ <Tick>, X) :f (snd TF)))"

lemma HC_T3_F4_iff : "HC_T3_F4 TF = (HC_T3 TF & HC_F4 TF)"
apply (simp add: HC_T3_F4_def HC_T3_def HC_F4_def)
by (auto)

(*** BOT in domF ***)

lemma BOT_T2_T3_F3_F4: "HC_T2({<>}t , {}f) & HC_F3({<>}t , {}f) &
                        HC_T3_F4({<>}t , {}f)"
by (auto simp add: HC_T2_def HC_F3_def HC_T3_F4_def)

(**************************************************
           Type domF (Stable-Failures model)
 **************************************************)

definition "domF  = {SF::('a domTsetF). HC_T2(SF) & HC_T3(SF) & HC_F3(SF) & HC_F4(SF)}"
typedef 'a domF = "domF :: 'a domTsetF set"
apply (rule_tac x ="({<>}t , {}f)" in exI)
apply (simp add: domF_def)
by (simp add: BOT_T2_T3_F3_F4 HC_T3_F4_iff[THEN sym])

declare Rep_domF         [simp]

lemma domF_iff: "domF = {SF. HC_T2 SF & HC_F3 SF & HC_T3_F4 SF}"
by (auto simp add: domF_def HC_T3_F4_iff)

(*********************************************************
          The relation (<=) is defined over domF
 *********************************************************)

instantiation domF :: (type) ord
begin
definition
  subdomF_def:
    "SF <= SE  ==  (Rep_domF SF) <= (Rep_domF SE)"
definition
  psubdomF_def:
    "SF <  SE  ==  (Rep_domF SF) <  (Rep_domF SE)"

instance
by (intro_classes)
end

(*********************************************************
          The relation (<=) is a partial order
 *********************************************************)

instance domF :: (type) order
apply (intro_classes)
apply (unfold subdomF_def psubdomF_def)
apply (auto)
apply (simp add: Rep_domF_inject)
done

(***********************************************************
                          lemmas
 ***********************************************************)

(*******************************
              basic
 *******************************)

(*** T2 ***)

lemma domTsetF_T2:
    "[| TF : domF ; (s, X) :f snd TF |] ==> s :t fst TF"
by (auto simp add: domF_def HC_T2_def)

lemma domF_T2:
    "[| (T,F) : domF ; (s, X) :f F |] ==> s :t T"
by (auto simp add: domF_def HC_T2_def)

(*** T3 ***)

lemma domTsetF_T3:
  "[| TF : domF ; s ^^^ <Tick> :t fst TF ; noTick s |]
   ==> (s ^^^ <Tick>, X) :f snd TF"
by (simp add: domF_def HC_T3_def)

lemma domF_T3:
  "[| (T,F) : domF ; s ^^^ <Tick> :t T ; noTick s |]
   ==> (s ^^^ <Tick>, X) :f F"
by (simp add: domF_def HC_T3_def)

(*** F3 ***)

lemma domTsetF_F3:
  "[| TF : domF ; (s, X) :f snd TF ; noTick s ;
      (ALL a. a : Y --> s ^^^ <a> ~:t fst TF) |]
   ==> (s, X Un Y) :f snd TF"
by (simp add: domF_def HC_F3_def)

lemma domF_F3:
  "[| (T,F) : domF ; (s, X) :f F ; noTick s ;
      (ALL a. a : Y --> s ^^^ <a> ~:t T) |]
   ==> (s, X Un Y) :f F"
by (simp add: domF_def HC_F3_def)

(*** F4 ***)

lemma domTsetF_F4:
  "[| TF : domF ; s ^^^ <Tick> :t fst TF ; noTick s |]
   ==> (s, Evset) :f snd TF"
by (simp add: domF_def HC_F4_def)

lemma domF_F4:
  "[| (T,F) : domF ; s ^^^ <Tick> :t T ; noTick s |]
   ==> (s, Evset) :f F"
by (simp add: domF_def HC_F4_def)

(*** T3_F4 ***)

lemma domTsetF_T3_F4:
  "[| TF : domF ; s ^^^ <Tick> :t fst TF ; noTick s |]
   ==> (s, Evset) :f snd TF & (ALL X. (s ^^^ <Tick>, X) :f snd TF)"
by (simp add: domF_iff HC_T3_F4_def)

lemma domF_T3_F4:
  "[| (T,F) : domF ; s ^^^ <Tick> :t T ; noTick s |]
   ==> (s, Evset) :f F & (ALL X. (s ^^^ <Tick>, X) :f F)"
by (simp add: domF_iff HC_T3_F4_def)

(*** F2_F4 ***)

lemma domTsetF_F2_F4:
  "[| TF : domF ; s ^^^ <Tick> :t fst TF ; noTick s ; X <= Evset |]
   ==> (s, X) :f snd TF"
apply (simp add: domF_def HC_F4_def)
by (auto intro: memF_F2)

lemma domF_F2_F4:
  "[| (T,F) : domF ; s ^^^ <Tick> :t T ; noTick s ; X <= Evset |]
   ==> (s, X) :f F"
apply (insert domTsetF_F2_F4[of "(T,F)" s X])
by (simp)

(*******************************
         check in domF
 *******************************)

(*** ({<>}t, {}f) ***)

lemma BOT_in_domF[simp]: "({<>}t, {}f) : domF"
by (simp add: domF_iff BOT_T2_T3_F3_F4)

(*******************************
       BOT is the bottom
 *******************************)

lemma BOT_is_bottom_domF[simp]: "({<>}t , {}f) <= SF"
by (simp add: order_pair_def)

(***********************************************************
                   operators on domF
 ***********************************************************)

definition
  pairF :: "'a domT => 'a setF => 'a domF"  ("(0_ ,,/ _)" [51,52] 0)
  where
  pairF_def : "(T ,, F) == Abs_domF (T, F)"

definition
  fstF  :: "'a domF => 'a domT"
  where
  fstF_def  : "fstF     == fst o Rep_domF"

definition
  sndF  :: "'a domF => 'a setF"
  where
  sndF_def  : "sndF     == snd o Rep_domF"

(***********************************************************
                     pairSF lemmas
 ***********************************************************)

lemma fold_fstF: "fst (Rep_domF SF) = fstF SF"
by (simp add: fstF_def comp_def)

lemma fold_sndF: "snd (Rep_domF SF) = sndF SF"
by (simp add: sndF_def comp_def)

lemma pairF_fstF: "(S,F) : domF ==> fstF (S,,F) = S"
apply (simp add: pairF_def fstF_def)
by (simp add: Abs_domF_inverse)

lemma pairF_sndF: "(S,F) : domF ==> sndF (S,,F) = F"
apply (simp add: pairF_def sndF_def)
by (simp add: Abs_domF_inverse)

lemma eqF_decompo:
  "(SF = SE) = (fstF SF = fstF SE & sndF SF = sndF SE)"
apply (simp add: Rep_domF_inject[THEN sym])
apply (simp add: pair_eq_decompo)
apply (simp add: fstF_def sndF_def)
done

lemmas pairF = pairF_fstF pairF_sndF eqF_decompo

lemma mono_fstF: "mono fstF"
apply (simp add: mono_def)
apply (simp add: fstF_def)
apply (simp add: subdomF_def)
apply (simp add: order_pair_def)
done

lemma mono_sndF: "mono sndF"
apply (simp add: mono_def)
apply (simp add: sndF_def)
apply (simp add: subdomF_def)
apply (simp add: order_pair_def)
done

(*********************************************************
           Healthiness conditions for pairF
 *********************************************************)

lemma pairF_domF_T2:
    "(s, X) :f sndF SF ==> s :t fstF SF"
apply (simp add: sndF_def fstF_def)
apply (rule domF_T2[of _ "snd (Rep_domF SF)"])
by (simp_all)

lemma pairF_domF_T3:
  "[| s ^^^ <Tick> :t fstF SF ; noTick s |]
   ==> (s ^^^ <Tick>, X) :f sndF SF"
apply (simp add: sndF_def fstF_def)
apply (rule domF_T3[of "fst (Rep_domF SF)" "snd (Rep_domF SF)"])
by (simp_all)

lemma pairF_domF_T3_Tick:
  "<Tick> :t fstF SF ==> (<Tick>, X) :f sndF SF"
apply (insert pairF_domF_T3[of "<>" SF X])
by (simp)

lemma pairF_domF_F4:
  "[| s ^^^ <Tick> :t fstF SF ; noTick s |]
   ==> (s, Evset) :f sndF SF"
apply (simp add: sndF_def fstF_def)
apply (rule domF_F4[of "fst (Rep_domF SF)" "snd (Rep_domF SF)"])
by (simp_all)

lemma pairF_domF_F3:
  "[| (s, X) :f sndF SF ; noTick s ;
      (ALL a. a : Y --> s ^^^ <a> ~:t fstF SF) |]
   ==> (s, X Un Y) :f sndF SF"
apply (simp add: sndF_def fstF_def)
apply (rule domF_F3[of "fst (Rep_domF SF)" "snd (Rep_domF SF)"])
by (simp_all)

lemma pairF_domF_F3I:
  "[| (s, X) :f sndF SF ; noTick s ;
      (ALL a. a : Y --> s ^^^ <a> ~:t fstF SF) ;
      Z = X Un Y |]
   ==> (s, Z) :f sndF SF"
by (simp add: pairF_domF_F3)

(*** F2_F4 ***)

lemma pairF_domF_F2_F4:
  "[| s ^^^ <Tick> :t fstF SF ; noTick s ; X <= Evset|]
   ==> (s, X) :f sndF SF"
apply (rule memF_F2[of _ "Evset"])
apply (rule pairF_domF_F4)
by (simp_all)

(*** T2_T3 ***)

lemma pairF_domF_T2_T3:
  "[| (s ^^^ <Tick>, X) :f sndF SF ; noTick s |]
  ==> (s ^^^ <Tick>, Y) :f sndF SF"
apply (rule pairF_domF_T3)
apply (rule pairF_domF_T2)
by (simp_all)

(*********************************************************
                     fstF and sndF
 *********************************************************)

lemma fstF_sndF_in_domF[simp]: "(fstF SF , sndF SF) : domF"
apply (simp add: domF_iff)
apply (simp add: HC_T2_def HC_F3_def HC_T3_F4_def)
apply (intro conjI)
apply (intro allI impI)
apply (elim exE)
apply (simp add: pairF_domF_T2)
apply (intro allI impI)
apply (elim conjE)
apply (simp add: pairF_domF_F3)
apply (intro allI impI)
apply (elim conjE)
apply (simp add: pairF_domF_T3 pairF_domF_F4)
done

lemma fstF_sndF_domF[simp]: "(fstF SF ,, sndF SF) = SF"
by (simp add: pairF)

(*********************************************************
                      subdomF
 *********************************************************)

lemma subdomF_decompo:
  "(SF <= SE) = (fstF SF <= fstF SE & sndF SF <= sndF SE)"
apply (simp add: subdomF_def)
apply (simp add: order_pair_def)
apply (simp add: fstF_def sndF_def)
done

(*********************************************************
                define max F from T
 *********************************************************)

definition
 maxFof :: "'a domT => 'a setF"
 where
 maxFof_def: "maxFof T == {f. EX s. (EX X. f = (s, X)) & s :t T}f"

(* in setF *)

lemma maxFof_setF: "{f. EX s. (EX X. f = (s, X)) & s :t T} : setF"
by (simp add: setF_def HC_F2_def)

(* in maxFof *)

lemma in_maxFof:
  "(f :f maxFof T) = (EX s. (EX X. f = (s, X)) & s :t T)"
apply (simp add: maxFof_def)
apply (simp add: memF_def)
apply (simp add: maxFof_setF Abs_setF_inverse)
done

(* in domF *)

lemma maxFof_domF: "(T, maxFof T) : domF"
apply (simp (no_asm) add: domF_iff)
apply (simp add: HC_T2_def HC_F3_def HC_T3_F4_def in_maxFof)
apply (intro allI impI)
apply (elim conjE)
apply (rule memT_prefix_closed)
apply (simp)
apply (simp)
done

(* max *)

lemma maxFof_max: "s :t T ==> (s,X) :f maxFof T"
by (simp add: in_maxFof)

(****************** to add them again ******************)
(*
declare Union_image_eq [simp]
declare Inter_image_eq [simp]
*)
(*
declare Sup_image_eq [simp]
declare Inf_image_eq [simp]
*)
end


theory Std
  imports List_util Global Op Env Env_list Dynamic
    "VeriComp.Language"
begin

datatype ('dyn, 'var, 'fun, 'label, 'op) instr =
  IPush 'dyn |
  IPop |
  IGet nat |
  ISet nat |
  ILoad 'var |
  IStore 'var |
  IOp 'op |
  ICJump 'label 'label |
  ICall 'fun |
  is_return: IReturn

locale std =
  Fenv: env F_empty F_get F_add F_to_list +
  Henv: env heap_empty heap_get heap_add heap_to_list +
  dynval uninitialized is_true is_false +
  nary_operations \<OO>\<pp> \<AA>\<rr>\<ii>\<tt>\<yy>
  for
    \<comment> \<open>Functions environment\<close>
    F_empty and
    F_get :: "'fenv \<Rightarrow> 'fun \<Rightarrow> ('label, ('dyn, 'var, 'fun, 'label, 'op) instr) fundef option" and
    F_add and F_to_list and

    \<comment> \<open>Memory heap\<close>
    heap_empty and
    heap_get :: "'henv \<Rightarrow> 'var \<times> 'dyn \<Rightarrow> 'dyn option" and
    heap_add and heap_to_list and

    \<comment> \<open>Dynamic values\<close>
    uninitialized :: 'dyn and is_true and is_false and

    \<comment> \<open>n-ary operations\<close>
    \<OO>\<pp> :: "'op \<Rightarrow> 'dyn list \<Rightarrow> 'dyn" and \<AA>\<rr>\<ii>\<tt>\<yy>
begin

inductive step (infix "\<rightarrow>" 55) where
  step_push:
    "next_instr (F_get F) f l pc = Some (IPush d) \<Longrightarrow>
    State F H (Frame f l pc R \<Sigma> # st) \<rightarrow> State F H (Frame f l (Suc pc) R (d # \<Sigma>) # st)" |

  step_pop:
    "next_instr (F_get F) f l pc = Some IPop \<Longrightarrow>
    State F H (Frame f l pc R (d # \<Sigma>) # st) \<rightarrow> State F H (Frame f l (Suc pc) R \<Sigma> # st)" |

  step_get:
    "next_instr (F_get F) f l pc = Some (IGet n) \<Longrightarrow>
    n < length R \<Longrightarrow> d = R ! n \<Longrightarrow>
    State F H (Frame f l pc R \<Sigma> # st) \<rightarrow> State F H (Frame f l (Suc pc) R (d # \<Sigma>) # st)" |

  step_set:
    "next_instr (F_get F) f l pc = Some (ISet n) \<Longrightarrow>
    n < length R \<Longrightarrow>  R' = R[n := d] \<Longrightarrow>
    State F H (Frame f l pc R (d # \<Sigma>) # st) \<rightarrow> State F H (Frame f l (Suc pc) R' \<Sigma> # st)" |

  step_load:
    "next_instr (F_get F) f l pc = Some (ILoad x) \<Longrightarrow>
    heap_get H (x, y) = Some d \<Longrightarrow>
    State F H (Frame f l pc R (y # \<Sigma>) # st) \<rightarrow> State F H (Frame f l (Suc pc) R (d # \<Sigma>) # st)" |

  step_store:
    "next_instr (F_get F) f l pc = Some (IStore x) \<Longrightarrow>
    heap_add H (x, y) d = H' \<Longrightarrow>
    State F H (Frame f l pc R (y # d # \<Sigma>) # st) \<rightarrow> State F H' (Frame f l (Suc pc) R \<Sigma> # st)" |

  step_op:
    "next_instr (F_get F) f l pc = Some (IOp op) \<Longrightarrow>
    \<AA>\<rr>\<ii>\<tt>\<yy> op = ar \<Longrightarrow> ar \<le> length \<Sigma> \<Longrightarrow> \<OO>\<pp> op (take ar \<Sigma>) = x \<Longrightarrow>
    State F H (Frame f l pc R \<Sigma> # st) \<rightarrow> State F H (Frame f l (Suc pc) R (x # drop ar \<Sigma>) # st)" |

  step_cjump:
    "next_instr (F_get F) f l pc = Some (ICJump l\<^sub>t l\<^sub>f) \<Longrightarrow>
    is_true d \<and> l' = l\<^sub>t \<or> is_false d \<and> l' = l\<^sub>f \<Longrightarrow>
    State F H (Frame f l pc R (d # \<Sigma>) # st) \<rightarrow> State F H (Frame f l' 0 R \<Sigma> # st)" |

  step_call:
    "next_instr (F_get F) f l pc = Some (ICall g) \<Longrightarrow>
    F_get F g = Some gd \<Longrightarrow> arity gd \<le> length \<Sigma> \<Longrightarrow>
    frame\<^sub>g = allocate_frame g gd (take (arity gd) \<Sigma>) uninitialized \<Longrightarrow>
    State F H (Frame f l pc R \<Sigma> # st) \<rightarrow> State F H (frame\<^sub>g # Frame f l pc R \<Sigma> # st)" |

  step_return:
    "next_instr (F_get F) g l\<^sub>g pc\<^sub>g = Some IReturn \<Longrightarrow>
    F_get F g = Some gd \<Longrightarrow> arity gd \<le> length \<Sigma>\<^sub>f \<Longrightarrow>
    length \<Sigma>\<^sub>g = return gd \<Longrightarrow>
    frame\<^sub>f' = Frame f l\<^sub>f (Suc pc\<^sub>f) R\<^sub>f (\<Sigma>\<^sub>g @ drop (arity gd) \<Sigma>\<^sub>f) \<Longrightarrow>
    State F H (Frame g l\<^sub>g pc\<^sub>g R\<^sub>g \<Sigma>\<^sub>g # Frame f l\<^sub>f pc\<^sub>f R\<^sub>f \<Sigma>\<^sub>f # st) \<rightarrow> State F H (frame\<^sub>f' # st)"

lemma step_deterministic:
  assumes "s1 \<rightarrow> s2" and "s1 \<rightarrow> s3"
  shows "s2 = s3"
  using assms
  apply (cases s1 s2 rule: step.cases)
  apply (auto elim: step.cases dest: is_true_and_is_false_implies_False) [3]
  apply (auto elim: step.cases dest: is_true_and_is_false_implies_False) [3]
  apply (auto elim: step.cases dest: is_true_and_is_false_implies_False) [3]
  apply (auto elim: step.cases dest: is_true_and_is_false_implies_False) [1]
  done

lemma step_right_unique: "right_unique step"
  using step_deterministic
  by (rule right_uniqueI)

lemma final_finished:
  assumes "final F_get IReturn s"
  shows "finished step s"
  unfolding finished_def
proof (rule notI)
  assume "\<exists>x. step s x"
  then obtain s' where "step s s'" by auto
  thus False
    using \<open>final F_get IReturn s\<close>
    by (auto
        simp: state_ok_def
          wf_fundefs_imp_wf_fundef[THEN wf_fundef_last_basic_block, THEN next_instr_length_instrs[rotated]]
        elim!: step.cases final.cases)
qed

sublocale semantics step "final F_get IReturn"
  using final_finished step_deterministic
  by unfold_locales

definition load where
  "load \<equiv> Global.load F_get uninitialized"

sublocale language step "final F_get IReturn" load
  by unfold_locales

end

end


(*  Title:       Isabelle Collections Library
    Author:      Peter Lammich <peter dot lammich at uni-muenster.de>
    Maintainer:  Peter Lammich <peter dot lammich at uni-muenster.de>
*)
(*
  Changelist since submission on 2009-11-26:

  2009-12-09: Ordered iterators, to_list produces sorted list

*)
section \<open>\isaheader{Map Implementation by Red-Black-Trees}\<close>
theory RBTMapImpl
imports
  "../spec/MapSpec"
  "../../Lib/RBT_add"
  "HOL-Library.RBT"
  "../gen_algo/MapGA"
begin
text_raw \<open>\label{thy:RBTMapImpl}\<close>

hide_const (open) RBT.map RBT.fold RBT.foldi RBT.empty RBT.insert

(*@impl Map
  @type ('k::linorder,'v) rm
  @abbrv rm,r
  Maps over linearly ordered keys implemented by red-black trees.
*)

type_synonym ('k,'v) rm = "('k,'v) RBT.rbt"

definition rm_basic_ops :: "('k::linorder,'v,('k,'v) rm) omap_basic_ops"
  where [icf_rec_def]: "rm_basic_ops \<equiv> \<lparr>
  bmap_op_\<alpha> = RBT.lookup,
  bmap_op_invar = \<lambda>_. True,
  bmap_op_empty = (\<lambda>_::unit. RBT.empty),
  bmap_op_lookup = (\<lambda>k m. RBT.lookup m k),
  bmap_op_update = RBT.insert,
  bmap_op_update_dj = RBT.insert,
  bmap_op_delete = RBT.delete,
  bmap_op_list_it = (\<lambda>r. RBT_add.rm_iterateoi (RBT.impl_of r)),
  bmap_op_ordered_list_it = (\<lambda>r. RBT_add.rm_iterateoi (RBT.impl_of r)),
  bmap_op_rev_list_it = (\<lambda>r. RBT_add.rm_reverse_iterateoi (RBT.impl_of r))
\<rparr>"

setup Locale_Code.open_block
interpretation rm_basic: StdBasicOMap rm_basic_ops
  apply unfold_locales
  apply (simp_all add: rm_basic_ops_def map_upd_eq_restrict)
  apply (rule map_iterator_linord_is_it)
  apply dup_subgoals
  unfolding RBT.lookup_def
  apply simp_all
  apply (rule rm_iterateoi_correct)
  apply simp
  apply (rule rm_reverse_iterateoi_correct)
  apply simp
  done
setup Locale_Code.close_block

definition [icf_rec_def]: "rm_ops \<equiv> rm_basic.dflt_oops\<lparr>map_op_add := RBT.union\<rparr>"
setup Locale_Code.open_block
interpretation rm: StdOMap rm_ops
proof -
  interpret aux1: StdOMap rm_basic.dflt_oops
    unfolding rm_ops_def
    by (rule rm_basic.dflt_oops_impl)
  interpret aux2: map_add RBT.lookup "\<lambda>_. True" RBT.union
    apply unfold_locales
    apply (rule lookup_union)
    .

  show "StdOMap rm_ops"
    apply (rule StdOMap_intro)
    apply icf_locales
    done
qed

interpretation rm: StdMap_no_invar rm_ops
  by unfold_locales (simp add: icf_rec_unf)
setup Locale_Code.close_block

setup \<open>ICF_Tools.revert_abbrevs "rm"\<close>

lemma pi_rm[proper_it]:
  "proper_it' RBT_add.rm_iterateoi RBT_add.rm_iterateoi"
  apply (rule proper_it'I)
  by (induct_tac s) (simp_all add: rm_iterateoi_alt_def icf_proper_iteratorI)
lemma pi_rm_rev[proper_it]:
  "proper_it' RBT_add.rm_reverse_iterateoi RBT_add.rm_reverse_iterateoi"
  apply (rule proper_it'I)
  by (induct_tac s) (simp_all add: rm_reverse_iterateoi_alt_def
    icf_proper_iteratorI)

interpretation pi_rm: proper_it_loc RBT_add.rm_iterateoi RBT_add.rm_iterateoi
  apply unfold_locales by (rule pi_rm)
interpretation pi_rm_rev: proper_it_loc RBT_add.rm_reverse_iterateoi
  RBT_add.rm_reverse_iterateoi
  apply unfold_locales by (rule pi_rm_rev)

text \<open>Code generator test\<close>
definition "test_codegen \<equiv> (rm.add ,
  rm.add_dj ,
  rm.ball ,
  rm.bex ,
  rm.delete ,
  rm.empty ,
  rm.isEmpty ,
  rm.isSng ,
  rm.iterate ,
  rm.iteratei ,
  rm.iterateo ,
  rm.iterateoi ,
  rm.list_it ,
  rm.lookup ,
  rm.max ,
  rm.min ,
  rm.restrict ,
  rm.rev_iterateo ,
  rm.rev_iterateoi ,
  rm.rev_list_it ,
  rm.reverse_iterateo ,
  rm.reverse_iterateoi ,
  rm.sel ,
  rm.size ,
  rm.size_abort ,
  rm.sng ,
  rm.to_list ,
  rm.to_map ,
  rm.to_rev_list ,
  rm.to_sorted_list ,
  rm.update ,
  rm.update_dj)"

export_code test_codegen checking SML

end


theory Total_Fun
  imports Partial_Fun
begin

subsection \<open> Total function type and operations \<close>

text \<open> It may seem a little strange to create this, given we already have @{type fun}, but it's
  necessary to implement Z's type hierarchy. \<close>

typedef ('a, 'b) tfun = "{f :: 'a \<Zpfun> 'b. pdom(f) = UNIV}"
  morphisms pfun_of_tfun Abs_tfun
  by (rule_tac x="pfun_entries UNIV undefined" in exI, simp)

type_notation tfun (infixr "\<Rightarrow>\<^sub>t" 0)

setup_lifting type_definition_tfun

lift_definition mk_tfun :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow>\<^sub>t 'b)" is
"\<lambda> f. fun_pfun f" by simp

lemma pfun_of_tfun_mk_tfun [simp]: "pfun_of_tfun (mk_tfun f) = fun_pfun f"
  by (transfer, simp)

end