section \<open>List Interface\<close>
theory IICF_List
imports
  "../../Sepref"
  "List-Index.List_Index"
begin

lemma param_index[param]:
  "\<lbrakk>single_valued A; single_valued (A\<inverse>)\<rbrakk> \<Longrightarrow> (index,index) \<in> \<langle>A\<rangle>list_rel \<rightarrow> A \<rightarrow> nat_rel"
  unfolding index_def[abs_def] find_index_def
  apply (subgoal_tac "(((=), (=)) \<in> A \<rightarrow> A \<rightarrow> bool_rel)")
  apply parametricity
  by (simp add: pres_eq_iff_svb)

(* TODO: Move? *)
subsection \<open>Swap two elements of a list, by index\<close>

definition "swap l i j \<equiv> l[i := l!j, j:=l!i]"
lemma swap_nth[simp]: "\<lbrakk>i < length l; j<length l; k<length l\<rbrakk> \<Longrightarrow>
  swap l i j!k = (
    if k=i then l!j
    else if k=j then l!i
    else l!k
  )"
  unfolding swap_def
  by auto

lemma swap_set[simp]: "\<lbrakk> i < length l; j<length l \<rbrakk> \<Longrightarrow> set (swap l i j) = set l"
  unfolding swap_def
  by auto

lemma swap_multiset[simp]: "\<lbrakk> i < length l; j<length l \<rbrakk> \<Longrightarrow> mset (swap l i j) = mset l"
  unfolding swap_def
  by (auto simp: mset_swap)

lemma swap_length[simp]: "length (swap l i j) = length l"
  unfolding swap_def
  by auto

lemma swap_same[simp]: "swap l i i = l"
  unfolding swap_def by auto

lemma distinct_swap[simp]:
  "\<lbrakk>i<length l; j<length l\<rbrakk> \<Longrightarrow> distinct (swap l i j) = distinct l"
  unfolding swap_def
  by auto

lemma map_swap: "\<lbrakk>i<length l; j<length l\<rbrakk>
  \<Longrightarrow> map f (swap l i j) = swap (map f l) i j"
  unfolding swap_def
  by (auto simp add: map_update)

lemma swap_param[param]: "\<lbrakk> i<length l; j<length l; (l',l)\<in>\<langle>A\<rangle>list_rel; (i',i)\<in>nat_rel; (j',j)\<in>nat_rel\<rbrakk>
  \<Longrightarrow> (swap l' i' j', swap l i j)\<in>\<langle>A\<rangle>list_rel"
  unfolding swap_def
  by parametricity

lemma swap_param_fref: "(uncurry2 swap,uncurry2 swap) \<in>
  [\<lambda>((l,i),j). i<length l \<and> j<length l]\<^sub>f (\<langle>A\<rangle>list_rel \<times>\<^sub>r nat_rel) \<times>\<^sub>r nat_rel \<rightarrow> \<langle>A\<rangle>list_rel"
  apply rule apply clarsimp
  unfolding swap_def
  apply parametricity
  by simp_all

lemma param_list_null[param]: "(List.null,List.null) \<in> \<langle>A\<rangle>list_rel \<rightarrow> bool_rel"
proof -
  have 1: "List.null = (\<lambda>[] \<Rightarrow> True | _ \<Rightarrow> False)"
    apply (rule ext) subgoal for l by (cases l) (auto simp: List.null_def)
    done
  show ?thesis unfolding 1 by parametricity
qed

subsection \<open>Operations\<close>

context
  fixes t ::  "'c list \<Rightarrow> nat"
begin

  definition "mop_append x xs = SPECT [ (x#xs) \<mapsto> t xs]"

  lemma progress_mop_append[progress_rules]: "t xs > 0 \<Longrightarrow> progress (mop_append x xs)"
    unfolding mop_append_def by (auto intro!: progress_rules simp add:   zero_enat_def)

  lemma mop_append: "tt \<le> lst (SPECT [ (x#xs) \<mapsto> t xs]) Q \<Longrightarrow> tt
           \<le> lst (mop_append x xs) Q" unfolding mop_append_def by simp

  sepref_register "mop_append"
end

context
  fixes n::"unit \<Rightarrow> nat"
begin
  definition "mop_empty_list = SPECT [ [] \<mapsto> enat (n ()) ]"

  sepref_register "mop_empty_list"
end

context
  fixes t::"('a *'a list) \<Rightarrow> nat"
begin
  definition "mop_push_list  x xs = SPECT [ ( xs @ [x] ) \<mapsto> enat (t (x, xs)) ]"

  sepref_register "mop_push_list"
end

context
  fixes t:: "'a list \<times> nat \<Rightarrow> nat"
begin
  definition "mop_lookup_list xs i = SPECT [ xs ! i \<mapsto> enat (t (xs,i)) ]"

  sepref_register "mop_lookup_list"
end

end


theory Network
imports Entity
begin

(*TODO split into view and props
  spoofing
  treepath
  policycompliance
  *)

(*examples and code equations are in Network_ex*)

section{*A network consisting of entities*}
  text{*packet header*}

  (*TODO make generic hdr
  datatype 'v srcdsthdr = SrcDstHdr "'v entity \<times> 'v entity"
  value "SrcDstHdr (Host ''Alice'', Host ''Bob'') :: string srcdsthdr"
  *)
  (*record 'v hdr = src_addr :: "'v entity"
                  dst_addr :: "'v entity"
                  proto :: nat
                   src_port :: nat
                   dst_port ::nat*)
  type_synonym 'v hdr="('v entity \<times> 'v entity)" -- "packet header: (src address, dst address)"

  text{*fwd is an entity's packet forward function:
      A packet arriving at port with a header (src, dst) is outputted to a set of ports.
      Example: flooding switch with 3 ports. If packet arrives at port 1, output at ports {2,3}.*}
  type_synonym 'v fwd_fun="port \<Rightarrow> 'v hdr \<Rightarrow> port set"

  text{* A network consists of
          A set of interfaces (ports at entities where packets are moved between)
          A forwarding behaviour per entity
          Links betweend interfaces (edges in a graph or cables in real world)*}
  record 'v network = interfaces :: "'v interface set"
                      forwarding :: "'v entity \<Rightarrow> 'v fwd_fun"
                      links      :: "(('v interface) \<times> ('v interface)) set"

  text{*here is an abbreviatin for forwarding in network N the packet with hdr at input interface hop:
          get forwarding function for hop, apply input port and hdr to it, get result*}
  abbreviation forward :: "'v network \<Rightarrow> 'v hdr \<Rightarrow> 'v interface \<Rightarrow> port set" where
    "forward N hdr hop \<equiv> ((forwarding N) (entity hop)) (port hop) hdr"

  text{*wellformed network.
        Links must be subset of interfaces, think of it as a graph.
        names_disjunct verifies that no confusion arises if there is a switch ''x'' and a host ''x''.*}
  locale wellformed_network =
    fixes N :: "'v network"
    assumes fst_links: "fst ` links N \<subseteq> interfaces N"
    and     snd_links: "snd ` links N \<subseteq> interfaces N"
    and     finite_interfaces: "finite (interfaces N)"
    and     names_disjunct: "{host. Host host \<in> entity ` interfaces N} \<inter> {box. NetworkBox box \<in> entity ` interfaces N} = {}"
    begin
      lemma finite_links: "finite (links N)"
      proof -
        have "\<And> X. X \<subseteq> fst ` X \<times> snd ` X" by force
        hence "links N \<subseteq> fst ` links N \<times> snd ` links N" by blast
        from this rev_finite_subset[OF finite_interfaces fst_links] rev_finite_subset[OF finite_interfaces snd_links] show ?thesis
          by (metis finite_cartesian_product rev_finite_subset)
      qed

      lemma finite_entity_interfaces: "finite (entity ` interfaces N)" by(simp add: finite_interfaces)
      lemma finite_entity_name_entity_interfaces: "finite (entity_name ` entity ` interfaces N)" by(simp add: finite_entity_interfaces)

      lemma names_disjunct_2: "\<forall>x\<in>interfaces N. \<forall>y\<in>interfaces N. entity_name (entity x) = entity_name (entity y) \<longrightarrow> entity x = entity y"
        apply(clarify)
        apply(case_tac x, rename_tac entity_x port_x, case_tac y, rename_tac entity_y port_y, clarsimp)
        apply(case_tac entity_x, case_tac entity_y)
        apply(simp add: entity_name_def)
        apply(simp add: entity_name_def)
        using names_disjunct apply force
        apply(clarsimp)
        apply(case_tac entity_y)
        apply(simp add: entity_name_def)
        using names_disjunct apply force
        apply(simp add: entity_name_def)
        done
      lemma "card (entity ` interfaces N) = card (entity_name ` entity ` interfaces N)"
        thm Set_Interval.bij_betw_iff_card
        apply(subst Set_Interval.bij_betw_iff_card[OF finite_entity_interfaces finite_entity_name_entity_interfaces, symmetric])
        apply(rule_tac x="entity_name" in exI)
        apply(simp add: bij_betw_def inj_on_def)
        apply(fact names_disjunct_2)
        done
    end

subsection{*Moving packets*}
  text{*The following simple model is used. A packet is moved from input interface to input interface.
        Therefore, two steps are necessary.
        1) the entity forwarding function outputs the packet at output interfaces.
        2) the packet traverses the link and thus arrives at the next input interface. *}

  text{*succ moves packet along links. It is step 2*}
  definition succ :: "'v network \<Rightarrow> 'v interface \<Rightarrow> ('v interface) set" where
    "succ N out_iface \<equiv> {in_iface. (out_iface, in_iface) \<in> links N}"

  lemma succ_subseteq_interfaces: assumes wf_N: "wellformed_network N" shows "succ N x \<subseteq> interfaces N"
    apply(simp add: succ_def)
    using wellformed_network.snd_links[OF wf_N] by force
  lemma succ_subset_networkboxes: "succ N start \<subseteq> networkboxes (succ N start) \<Longrightarrow> succ N start = networkboxes (succ N start)"
    by(simp add: networkboxes_def, blast)
  lemma start_notininterfaces_succ_empty: assumes wf_N: "wellformed_network N" shows "start \<notin> interfaces N \<Longrightarrow> succ N start = {}"
    apply(simp add: succ_def)
    using wellformed_network.fst_links[OF wf_N] by fastforce

  text{*A packet traverses a hop. It performs steps 1 and 2.*}
  (*recall: (forward N hdr hop) return the ports where the packet leaves the entity*)
  definition traverse :: "'v network \<Rightarrow> 'v hdr \<Rightarrow> 'v interface \<Rightarrow> ('v interface) set" where
    "traverse N hdr hop \<equiv> \<Union> p \<in> (forward N hdr hop). succ N \<lparr>entity = entity hop, port = p\<rparr>"

  (*traverse jumps over routers, it is not in the links. the forwarding function moves packets in routeres, there is no corresponding link IN an entity for it. *)
  lemma traverse_subseteq_interfaces: "wellformed_network N \<Longrightarrow> traverse N hdr hop \<subseteq> interfaces N"
    apply(simp add: traverse_def succ_def)
    apply(drule wellformed_network.snd_links)
    by force
  corollary traverse_finite: assumes wf_N: "wellformed_network N"
    shows "finite (traverse N hdr hop)"
    using traverse_subseteq_interfaces[OF wf_N] wellformed_network.finite_interfaces[OF wf_N] by (metis rev_finite_subset)

subsection {*Reachable interfaces*}
  text{* Traverese performs one step to move a packet. The reachable set defines all reachable entities for a given start node of a packet. *}
  (* we can allow spoofing by allowing an arbitrary packet header.*)
  text{*reachable(1): a packet starts at a start node. All directly reachable nodes are reachable.
        reachable(2): if a hop is reachables, then the next hop is also reachable. *}
  inductive_set reachable :: "'v network \<Rightarrow> 'v hdr \<Rightarrow> 'v interface \<Rightarrow> ('v interface) set"
  for N::"'v network" and "pkt_hdr"::"'v hdr" and "start"::"'v interface"
  where
    "first_hop \<in> succ N start \<Longrightarrow> first_hop \<in> reachable N pkt_hdr start" |
    "hop \<in> reachable N pkt_hdr start \<Longrightarrow> next_hop \<in> (traverse N pkt_hdr hop) \<Longrightarrow> next_hop \<in> reachable N pkt_hdr start"

  (*tuned induction rule*)
  lemmas reachable_induct = reachable.induct[case_names Start Step]
  thm reachable_induct

  lemma reachable_subseteq_interfaces:
    assumes wf_N: "wellformed_network N"
    shows "reachable N pkt_hdr start \<subseteq> interfaces N"
    proof
      fix x
      show "x \<in> reachable N pkt_hdr start \<Longrightarrow> x \<in> interfaces N"
        apply(induction x rule: reachable_induct)
        using succ_subseteq_interfaces[OF wf_N] apply blast
        using traverse_subseteq_interfaces[OF wf_N] by fast
    qed

  lemma start_notininterfaces_reachableempty: assumes wf_N: "wellformed_network N" shows "start \<notin> interfaces N \<Longrightarrow> reachable N hdr start = {}"
    apply(drule start_notininterfaces_succ_empty[OF wf_N])
    apply(rule, rule)
    apply(erule reachable_induct)
    by(auto)
  lemma succ_subseteq_reachable: "succ N start \<subseteq> reachable N hdr start"
    by(auto intro: reachable.intros)

section{*Sending packets to hosts*}
  text{*a packet from start is sent to dst. Which hosts gets the packet?*}
  definition send_to :: "'v network \<Rightarrow> 'v interface \<Rightarrow> 'v entity \<Rightarrow> 'v interface set" where
    "send_to N start dst \<equiv> hosts (reachable N (entity start, dst) start)"

section{*Compliance with a Security Policy*}
    (*policy is a graph ... cannot spoof .... *)

end


theory PreferenceLogicTestsApp2                (*Benzmüller & Fuenmayor, 2020*)
   imports PreferenceLogicBasics
begin

(*****Application-specific tests for the value ontology****)
(* EE variant (\<and>)*)
lemma "\<lfloor>A \<^bold>\<preceq>\<^sub>E\<^sub>E (A\<^bold>\<and>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A\<^bold>\<and>B) \<^bold>\<preceq>\<^sub>E\<^sub>E A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>E\<^sub>E B) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>E\<^sub>E (C\<^bold>\<and>B))\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>E\<^sub>E (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>E\<^sub>E B)\<rfloor>" by blast
lemma "\<lfloor>((C\<^bold>\<and>B) \<^bold>\<preceq>\<^sub>E\<^sub>E A) \<^bold>\<rightarrow> (B \<^bold>\<preceq>\<^sub>E\<^sub>E A)\<rfloor>" by blast
lemma "\<lfloor>(B \<^bold>\<preceq>\<^sub>E\<^sub>E A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<^bold>\<preceq>\<^sub>E\<^sub>E A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
(* EE variant (\<or>)*)
lemma "\<lfloor>A \<^bold>\<preceq>\<^sub>E\<^sub>E (A\<^bold>\<or>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A\<^bold>\<or>B) \<^bold>\<preceq>\<^sub>E\<^sub>E A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>E\<^sub>E B) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>E\<^sub>E (C\<^bold>\<or>B))\<rfloor>" by blast
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>E\<^sub>E (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>E\<^sub>E B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>((C\<^bold>\<or>B) \<^bold>\<preceq>\<^sub>E\<^sub>E A) \<^bold>\<rightarrow> (B \<^bold>\<preceq>\<^sub>E\<^sub>E A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(B \<^bold>\<preceq>\<^sub>E\<^sub>E A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<^bold>\<preceq>\<^sub>E\<^sub>E A)\<rfloor>" by blast
(* total EE variant (\<and>)*)
lemma "is_total SBR \<Longrightarrow> \<lfloor>A \<preceq>\<^sub>E\<^sub>E (A\<^bold>\<and>B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A\<^bold>\<and>B) \<preceq>\<^sub>E\<^sub>E A\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>E\<^sub>E B) \<^bold>\<rightarrow> (A \<preceq>\<^sub>E\<^sub>E (C\<^bold>\<and>B))\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>E\<^sub>E (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<preceq>\<^sub>E\<^sub>E B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>((C\<^bold>\<and>B) \<preceq>\<^sub>E\<^sub>E A) \<^bold>\<rightarrow> (B \<preceq>\<^sub>E\<^sub>E A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(B \<preceq>\<^sub>E\<^sub>E A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<preceq>\<^sub>E\<^sub>E A)\<rfloor>" by blast
(* total EE variant (\<or>)*)
lemma "is_total SBR \<Longrightarrow> \<lfloor>A \<preceq>\<^sub>E\<^sub>E (A\<^bold>\<or>B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A\<^bold>\<or>B) \<preceq>\<^sub>E\<^sub>E A\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>E\<^sub>E B) \<^bold>\<rightarrow> (A \<preceq>\<^sub>E\<^sub>E (C\<^bold>\<or>B))\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>E\<^sub>E (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<preceq>\<^sub>E\<^sub>E B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>((C\<^bold>\<or>B) \<preceq>\<^sub>E\<^sub>E A) \<^bold>\<rightarrow> (B \<preceq>\<^sub>E\<^sub>E A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(B \<preceq>\<^sub>E\<^sub>E A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<preceq>\<^sub>E\<^sub>E A)\<rfloor>" by blast

(* AE variant (\<and>)*)
lemma "\<lfloor>A \<^bold>\<preceq>\<^sub>A\<^sub>E (A\<^bold>\<and>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A\<^bold>\<and>B) \<^bold>\<preceq>\<^sub>A\<^sub>E A\<rfloor>" using rBR by blast (*change wrt. strict*)
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>A\<^sub>E B) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>A\<^sub>E (C\<^bold>\<and>B))\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>A\<^sub>E (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>A\<^sub>E B)\<rfloor>" by blast
lemma "\<lfloor>((C\<^bold>\<and>B) \<^bold>\<preceq>\<^sub>A\<^sub>E A) \<^bold>\<rightarrow> (B \<^bold>\<preceq>\<^sub>A\<^sub>E A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(B \<^bold>\<preceq>\<^sub>A\<^sub>E A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<^bold>\<preceq>\<^sub>A\<^sub>E A)\<rfloor>" by blast
(* AE variant (\<or>)*)
lemma "\<lfloor>A \<^bold>\<preceq>\<^sub>A\<^sub>E (A\<^bold>\<or>B)\<rfloor>" using rBR by blast (*change wrt. strict*)
lemma "\<lfloor>(A\<^bold>\<or>B) \<^bold>\<preceq>\<^sub>A\<^sub>E A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>A\<^sub>E B) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>A\<^sub>E (C\<^bold>\<or>B))\<rfloor>" by blast
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>A\<^sub>E (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>A\<^sub>E B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>((C\<^bold>\<or>B) \<^bold>\<preceq>\<^sub>A\<^sub>E A) \<^bold>\<rightarrow> (B \<^bold>\<preceq>\<^sub>A\<^sub>E A)\<rfloor>" by blast
lemma "\<lfloor>(B \<^bold>\<preceq>\<^sub>A\<^sub>E A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<^bold>\<preceq>\<^sub>A\<^sub>E A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
(* total AE variant (\<and>)*)
lemma "is_total SBR \<Longrightarrow> \<lfloor>A \<preceq>\<^sub>A\<^sub>E (A\<^bold>\<and>B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A\<^bold>\<and>B) \<preceq>\<^sub>A\<^sub>E A\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>A\<^sub>E B) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>E (C\<^bold>\<and>B))\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>A\<^sub>E (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>E B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>((C\<^bold>\<and>B) \<preceq>\<^sub>A\<^sub>E A) \<^bold>\<rightarrow> (B \<preceq>\<^sub>A\<^sub>E A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(B \<preceq>\<^sub>A\<^sub>E A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<preceq>\<^sub>A\<^sub>E A)\<rfloor>" by blast
(* total AE variant (\<or>)*)
lemma "is_total SBR \<Longrightarrow> \<lfloor>A \<preceq>\<^sub>A\<^sub>E (A\<^bold>\<or>B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A\<^bold>\<or>B) \<preceq>\<^sub>A\<^sub>E A\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>A\<^sub>E B) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>E (C\<^bold>\<or>B))\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>A\<^sub>E (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>E B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>((C\<^bold>\<or>B) \<preceq>\<^sub>A\<^sub>E A) \<^bold>\<rightarrow> (B \<preceq>\<^sub>A\<^sub>E A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(B \<preceq>\<^sub>A\<^sub>E A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<preceq>\<^sub>A\<^sub>E A)\<rfloor>" by blast

(* AA variant (\<and>)*)
lemma "\<lfloor>A \<^bold>\<preceq>\<^sub>A\<^sub>A (A\<^bold>\<and>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A\<^bold>\<and>B) \<^bold>\<preceq>\<^sub>A\<^sub>A A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>A\<^sub>A B) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>A\<^sub>A (C\<^bold>\<and>B))\<rfloor>" by blast
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>A\<^sub>A (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>A\<^sub>A B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>((C\<^bold>\<and>B) \<^bold>\<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> (B \<^bold>\<preceq>\<^sub>A\<^sub>A A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(B \<^bold>\<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<^bold>\<preceq>\<^sub>A\<^sub>A A)\<rfloor>" by blast
(*--------------------------------------------------*)
lemma "\<lfloor>A \<preceq>\<^sub>A\<^sub>A (A\<^bold>\<and>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A\<^bold>\<and>B) \<preceq>\<^sub>A\<^sub>A A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<preceq>\<^sub>A\<^sub>A B) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>A (C\<^bold>\<and>B))\<rfloor>" by blast
lemma "\<lfloor>(A \<preceq>\<^sub>A\<^sub>A (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>A B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>((C\<^bold>\<and>B) \<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> (B \<preceq>\<^sub>A\<^sub>A A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(B \<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<preceq>\<^sub>A\<^sub>A A)\<rfloor>" by blast
(* AA variant (\<or>)*)
lemma "\<lfloor>A \<^bold>\<preceq>\<^sub>A\<^sub>A (A\<^bold>\<or>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A\<^bold>\<or>B) \<^bold>\<preceq>\<^sub>A\<^sub>A A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>A\<^sub>A B) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>A\<^sub>A (C\<^bold>\<or>B))\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<preceq>\<^sub>A\<^sub>A (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<^bold>\<preceq>\<^sub>A\<^sub>A B)\<rfloor>" by blast
lemma "\<lfloor>((C\<^bold>\<or>B) \<^bold>\<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> (B \<^bold>\<preceq>\<^sub>A\<^sub>A A)\<rfloor>" by blast
lemma "\<lfloor>(B \<^bold>\<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<^bold>\<preceq>\<^sub>A\<^sub>A A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
(*---------------------------------------------------*)
lemma "\<lfloor>A \<preceq>\<^sub>A\<^sub>A (A\<^bold>\<or>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A\<^bold>\<or>B) \<preceq>\<^sub>A\<^sub>A A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<preceq>\<^sub>A\<^sub>A B) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>A (C\<^bold>\<or>B))\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<preceq>\<^sub>A\<^sub>A (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>A B)\<rfloor>" by blast
lemma "\<lfloor>((C\<^bold>\<or>B) \<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> (B \<preceq>\<^sub>A\<^sub>A A)\<rfloor>" by blast
lemma "\<lfloor>(B \<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<preceq>\<^sub>A\<^sub>A A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
(* total AA variant (\<and>)*)
lemma "is_total SBR \<Longrightarrow> \<lfloor>A \<preceq>\<^sub>A\<^sub>A (A\<^bold>\<and>B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A\<^bold>\<and>B) \<preceq>\<^sub>A\<^sub>A A\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>A\<^sub>A B) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>A (C\<^bold>\<and>B))\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>A\<^sub>A (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>A B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>((C\<^bold>\<and>B) \<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> (B \<preceq>\<^sub>A\<^sub>A A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(B \<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<preceq>\<^sub>A\<^sub>A A)\<rfloor>" by blast
(* total AA variant (\<or>)*)
lemma "is_total SBR \<Longrightarrow> \<lfloor>A \<preceq>\<^sub>A\<^sub>A (A\<^bold>\<or>B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A\<^bold>\<or>B) \<preceq>\<^sub>A\<^sub>A A\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>A\<^sub>A B) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>A (C\<^bold>\<or>B))\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<preceq>\<^sub>A\<^sub>A (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<preceq>\<^sub>A\<^sub>A B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>((C\<^bold>\<or>B) \<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> (B \<preceq>\<^sub>A\<^sub>A A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(B \<preceq>\<^sub>A\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<preceq>\<^sub>A\<^sub>A A)\<rfloor>" by blast

(* EA variant (\<and>)*)
lemma "\<lfloor>(A\<^bold>\<and>B) \<^bold>\<succeq>\<^sub>E\<^sub>A A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent - change wrt. strict*)
lemma "\<lfloor>A \<^bold>\<succeq>\<^sub>E\<^sub>A (A\<^bold>\<and>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(B \<^bold>\<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<^bold>\<succeq>\<^sub>E\<^sub>A A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>((C\<^bold>\<and>B) \<^bold>\<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> (B \<^bold>\<succeq>\<^sub>E\<^sub>A A)\<rfloor>" by blast
lemma "\<lfloor>(A \<^bold>\<succeq>\<^sub>E\<^sub>A (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<^bold>\<succeq>\<^sub>E\<^sub>A B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<succeq>\<^sub>E\<^sub>A B) \<^bold>\<rightarrow> (A \<^bold>\<succeq>\<^sub>E\<^sub>A (C\<^bold>\<and>B))\<rfloor>" by blast
(*--------------------------------------------*)
lemma "\<lfloor>(A\<^bold>\<and>B) \<succeq>\<^sub>E\<^sub>A A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>A \<succeq>\<^sub>E\<^sub>A (A\<^bold>\<and>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(B \<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<succeq>\<^sub>E\<^sub>A A)\<rfloor>" by blast
lemma "\<lfloor>((C\<^bold>\<and>B) \<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> (B \<succeq>\<^sub>E\<^sub>A A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<succeq>\<^sub>E\<^sub>A (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<succeq>\<^sub>E\<^sub>A B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<succeq>\<^sub>E\<^sub>A B) \<^bold>\<rightarrow> (A \<succeq>\<^sub>E\<^sub>A (C\<^bold>\<and>B))\<rfloor>" by blast
(* EA variant (\<or>)*)
lemma "\<lfloor>(A\<^bold>\<or>B) \<^bold>\<succeq>\<^sub>E\<^sub>A A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>A \<^bold>\<succeq>\<^sub>E\<^sub>A (A\<^bold>\<or>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent - change wrt. strict*)
lemma "\<lfloor>(B \<^bold>\<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<^bold>\<succeq>\<^sub>E\<^sub>A A)\<rfloor>" by blast
lemma "\<lfloor>((C\<^bold>\<or>B) \<^bold>\<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> (B \<^bold>\<succeq>\<^sub>E\<^sub>A A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(A \<^bold>\<succeq>\<^sub>E\<^sub>A (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<^bold>\<succeq>\<^sub>E\<^sub>A B)\<rfloor>" by blast
lemma "\<lfloor>(A \<^bold>\<succeq>\<^sub>E\<^sub>A B) \<^bold>\<rightarrow> (A \<^bold>\<succeq>\<^sub>E\<^sub>A (C\<^bold>\<or>B))\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
(*------------------------------------------------*)
lemma "\<lfloor>(A\<^bold>\<or>B) \<succeq>\<^sub>E\<^sub>A A\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>A \<succeq>\<^sub>E\<^sub>A (A\<^bold>\<or>B)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>(B \<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<succeq>\<^sub>E\<^sub>A A)\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
lemma "\<lfloor>((C\<^bold>\<or>B) \<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> (B \<succeq>\<^sub>E\<^sub>A A)\<rfloor>" by blast
lemma "\<lfloor>(A \<succeq>\<^sub>E\<^sub>A (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<succeq>\<^sub>E\<^sub>A B)\<rfloor>" by blast
lemma "\<lfloor>(A \<succeq>\<^sub>E\<^sub>A B) \<^bold>\<rightarrow> (A \<succeq>\<^sub>E\<^sub>A (C\<^bold>\<or>B))\<rfloor>" nitpick[satisfy] nitpick oops (*contingent*)
(* total EA variant (\<and>)*)
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A\<^bold>\<and>B) \<succeq>\<^sub>E\<^sub>A A\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>A \<succeq>\<^sub>E\<^sub>A (A\<^bold>\<and>B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(B \<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<and>B) \<succeq>\<^sub>E\<^sub>A A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>((C\<^bold>\<and>B) \<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> (B \<succeq>\<^sub>E\<^sub>A A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<succeq>\<^sub>E\<^sub>A (C\<^bold>\<and>B)) \<^bold>\<rightarrow> (A \<succeq>\<^sub>E\<^sub>A B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<succeq>\<^sub>E\<^sub>A B) \<^bold>\<rightarrow> (A \<succeq>\<^sub>E\<^sub>A (C\<^bold>\<and>B))\<rfloor>" by blast
(* total EA variant (\<or>)*)
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A\<^bold>\<or>B) \<succeq>\<^sub>E\<^sub>A A\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>A \<succeq>\<^sub>E\<^sub>A (A\<^bold>\<or>B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(B \<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> ((C\<^bold>\<or>B) \<succeq>\<^sub>E\<^sub>A A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>((C\<^bold>\<or>B) \<succeq>\<^sub>E\<^sub>A A) \<^bold>\<rightarrow> (B \<succeq>\<^sub>E\<^sub>A A)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<succeq>\<^sub>E\<^sub>A (C\<^bold>\<or>B)) \<^bold>\<rightarrow> (A \<succeq>\<^sub>E\<^sub>A B)\<rfloor>" by blast
lemma "is_total SBR \<Longrightarrow> \<lfloor>(A \<succeq>\<^sub>E\<^sub>A B) \<^bold>\<rightarrow> (A \<succeq>\<^sub>E\<^sub>A (C\<^bold>\<or>B))\<rfloor>" by blast
end


theory Why3_BV
imports
  Why3_Int
  "HOL-Library.Word"
  Next_and_Prev
  Word_32

begin

abbreviation (input) pow2 :: "int \<Rightarrow> int"
where "pow2 i \<equiv> 2 ^ nat i"

why3_open "bv/Pow2int.xml"
  constants
    pow2=pow2

why3_vc Power_0 by simp

why3_vc Power_s using assms by (simp add: Power_s)

why3_vc Power_1 by simp

why3_vc Power_sum using assms by (simp add: Power_sum)

why3_vc pow2pos using assms by simp

why3_vc pow2_0 by simp
why3_vc pow2_1 by simp
why3_vc pow2_2 by simp
why3_vc pow2_3 by simp
why3_vc pow2_4 by simp
why3_vc pow2_5 by simp
why3_vc pow2_6 by simp
why3_vc pow2_7 by simp
why3_vc pow2_8 by simp
why3_vc pow2_9 by simp
why3_vc pow2_10 by simp
why3_vc pow2_11 by simp
why3_vc pow2_12 by simp
why3_vc pow2_13 by simp
why3_vc pow2_14 by simp
why3_vc pow2_15 by simp
why3_vc pow2_16 by simp
why3_vc pow2_17 by simp
why3_vc pow2_18 by simp
why3_vc pow2_19 by simp
why3_vc pow2_20 by simp
why3_vc pow2_21 by simp
why3_vc pow2_22 by simp
why3_vc pow2_23 by simp
why3_vc pow2_24 by simp
why3_vc pow2_25 by simp
why3_vc pow2_26 by simp
why3_vc pow2_27 by simp
why3_vc pow2_28 by simp
why3_vc pow2_29 by simp
why3_vc pow2_30 by simp
why3_vc pow2_31 by simp
why3_vc pow2_32 by simp
why3_vc pow2_33 by simp
why3_vc pow2_34 by simp
why3_vc pow2_35 by simp
why3_vc pow2_36 by simp
why3_vc pow2_37 by simp
why3_vc pow2_38 by simp
why3_vc pow2_39 by simp
why3_vc pow2_40 by simp
why3_vc pow2_41 by simp
why3_vc pow2_42 by simp
why3_vc pow2_43 by simp
why3_vc pow2_44 by simp
why3_vc pow2_45 by simp
why3_vc pow2_46 by simp
why3_vc pow2_47 by simp
why3_vc pow2_48 by simp
why3_vc pow2_49 by simp
why3_vc pow2_50 by simp
why3_vc pow2_51 by simp
why3_vc pow2_52 by simp
why3_vc pow2_53 by simp
why3_vc pow2_54 by simp
why3_vc pow2_55 by simp
why3_vc pow2_56 by simp
why3_vc pow2_57 by simp
why3_vc pow2_58 by simp
why3_vc pow2_59 by simp
why3_vc pow2_60 by simp
why3_vc pow2_61 by simp
why3_vc pow2_62 by simp
why3_vc pow2_63 by simp
why3_vc pow2_64 by simp

why3_end

lemma rotate1_nth:
  assumes "0 < length xs"
  shows "rotate1 xs ! (i mod length xs) = xs ! (Suc i mod length xs)"
proof (cases xs)
  case Nil
  with `0 < length xs` show ?thesis by simp
next
  case (Cons y ys)
  with mod_less_divisor [of "Suc (length ys)" i]
  show ?thesis
    by (auto simp add: nth_append mod_Suc simp del: mod_less_divisor)
qed

lemma rotl_nth:
  "word_rotl j w !! ((i + j) mod len_of TYPE('a)) = (w::'a::len word) !! (i mod len_of TYPE('a))"
proof (induct j arbitrary: w i)
  case 0
  show ?case by simp
next
  case (Suc n)
  from Suc [of "of_bl (rotate1 (to_bl w))" "Suc i"]
    rotate1_nth [of "to_bl w" "len_of TYPE('a) - Suc (Suc i mod len_of TYPE('a))"]
  show ?case
    by (metis (no_types, lifting) bit_word_rotr_iff len_gt_0 mod_add_left_eq
                                  mod_less_divisor test_bit_eq_bit word_rot_gal)
(*  by (simp add: word_rotl_def rotate1_rotate_swap word_bl.Abs_inverse
      rev_nth test_bit_bl word_size Suc_diff_Suc)
      (simp add: mod_Suc) *)
qed

lemma rotater1_rotater_swap: "rotater1 (rotater n xs) = rotater n (rotater1 xs)"
  by (simp add: rotater_def funpow_swap1)

lemma length_rotater1 [simp]: "length (rotater1 xs) = length xs"
  by (simp add: rotater1_def split: list.split)

lemma rotater1_nth:
  assumes "0 < length xs"
  shows "rotater1 xs ! (Suc i mod length xs) = xs ! (i mod length xs)"
proof (cases xs rule: rev_cases)
  case Nil
  with `0 < length xs` show ?thesis by simp
next
  case (snoc ys y)
  with mod_less_divisor [of "Suc (length ys)" i]
  show ?thesis
    by (auto simp add: rotate1_rl' nth_append mod_Suc simp del: mod_less_divisor)
qed

lemma rotr_nth:
  "word_rotr j w !! (i mod len_of TYPE('a)) = (w::'a::len word) !! ((i + j) mod len_of TYPE('a))"
proof (induct j arbitrary: w)
  case 0
  show ?case by simp
next
  case (Suc n)
  from Suc [of "of_bl (rotater1 (to_bl w))"]
    rotater1_nth [of "to_bl w" "len_of TYPE('a) - Suc (Suc (i + n) mod len_of TYPE('a))", symmetric]
  show ?case
    by (simp add: word_rotr_eq rotater1_rotater_swap word_bl.Abs_inverse
      rev_nth test_bit_bl word_size Suc_diff_Suc)
      (simp add: mod_Suc)
qed

lemma uint_pow: "uint ((b::'a::len word) ^ n) = uint b ^ n mod 2 ^ len_of TYPE('a)"
  by (induct n) (simp_all add: uint_word_ariths mod_mult_right_eq)

lemma eq_sub_equiv_aux:
  "(\<forall>j. uint i \<le> j \<and> j < uint i + uint n \<longrightarrow>
      (0 \<le> j \<and> a !! nat j) = (0 \<le> j \<and> b !! nat j)) =
   (b AND (mask (unat n) << unat i) = a AND (mask (unat n) << unat i))" (is "?P = ?Q")
proof
  show "?P \<Longrightarrow> ?Q"
  proof -
    assume ?P
    thus ?thesis sorry
  qed
  show "?Q \<Longrightarrow> ?P"
  proof -
    assume ?Q
    thus ?thesis sorry
  qed
qed

(*
  apply (simp add: word_eq_iff word_ops_nth_size word_size nth_shiftl)
  apply (rule iffI)
  apply (rule allI)
  apply (drule_tac x="int na" in spec)
  apply (auto simp add: uint_nat)[1]
  apply (rule allI)
  apply (drule_tac x="nat j" in spec)
  apply (auto simp add: uint_nat test_bit_bin)
  done
*)

lemma int_minus_mod: "((i::int) - j) mod n = (i + (n - j mod n)) mod n"
proof -
  have "(i + (n - j mod n)) mod n = (i mod n + (n - j mod n) mod n) mod n"
    by (simp only: mod_add_eq)
  also have "(n - j mod n) mod n = (n mod n - j mod n) mod n"
    by simp
  finally show ?thesis by (simp add: pull_mods(1,5) [symmetric])
qed

lemma nat_minus_mod:
  assumes "0 < (n::nat)"
  shows "((n - i mod n) + i) mod n = 0"
proof -
  have "((n - i mod n) + i) mod n = (i + (n - i mod n)) mod n"
    by (simp add: add_ac)
  also have "\<dots> = (i mod n + (n - i mod n)) mod n"
    by (simp add: pull_mods(8) [symmetric])
  also from assms have "\<dots> = (n mod n + (i mod n - i mod n)) mod n"
    by (simp add: add_ac)
  finally show ?thesis by simp
qed

lemma nat_minus_mod':
  assumes "0 < (n::nat)"
  shows "(i + (n - j mod n) + j) mod n = i mod n"
proof -
  have "(i + (n - j mod n) + j) mod n = (i + ((n - j mod n) + j)) mod n"
    by (simp add: add_ac)
  also have "\<dots> = (i mod n + ((n - j mod n) + j) mod n) mod n"
    by (simp add: pull_mods(1) [symmetric])
  also note nat_minus_mod [OF assms]
  finally show ?thesis by simp
qed

definition bv_nth :: "'a::len word \<Rightarrow> int \<Rightarrow> bool"
where "bv_nth bv i \<equiv> 0 \<le> i \<and> bv !! nat i"

abbreviation (input) nth_bv :: "'a::len word \<Rightarrow> 'a word \<Rightarrow> bool"
where "nth_bv bv bv' \<equiv> bv !! unat bv'"

abbreviation (input) lsr :: "'a::len word \<Rightarrow> int \<Rightarrow> 'a word"
where "lsr v i \<equiv> v >> nat i"

abbreviation (input) lsr_bv :: "'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word"
where "lsr_bv v n \<equiv> v >> unat n"

abbreviation (input) asr :: "'a::len word \<Rightarrow> int \<Rightarrow> 'a word"
where "asr v i \<equiv> v >>> nat i"

abbreviation (input) asr_bv :: "'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word"
where "asr_bv v n \<equiv> v >>> unat n"

abbreviation (input) lsl :: "'a::len word \<Rightarrow> int \<Rightarrow> 'a word"
where "lsl v i \<equiv> v << nat i"

abbreviation (input) lsl_bv :: "'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word"
where "lsl_bv v n \<equiv> v << unat n"

abbreviation (input) rotate_left :: "'a::len word \<Rightarrow> int \<Rightarrow> 'a word"
where "rotate_left v n \<equiv> word_rotl (nat n) v"

abbreviation (input) rotate_right :: "'a::len word \<Rightarrow> int \<Rightarrow> 'a word"
where "rotate_right v n \<equiv> word_rotr (nat n) v"

abbreviation (input) rotate_left_bv :: "'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word"
where "rotate_left_bv v n \<equiv> word_rotl (unat n) v"

abbreviation (input) rotate_right_bv :: "'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word"
where "rotate_right_bv v n \<equiv> word_rotr (unat n) v"

definition eq_sub_bv :: "'a::len word \<Rightarrow> 'a word \<Rightarrow> 'a word \<Rightarrow> 'a word \<Rightarrow> bool" where
  eq_sub_bv_defn: "eq_sub_bv a b i n =
    (b AND (mask (unat n) << unat i) = a AND (mask (unat n) << unat i))"

definition size_bv :: "'a::len word" where
  "size_bv = of_nat LENGTH('a)"

definition is_signed_positive :: "'a::len word \<Rightarrow> bool" where
  "is_signed_positive w = (0 \<le> sint w)"

lemma to_int_eq:
  "sint (x::'a::len word) =
   (if is_signed_positive x then uint x else - (2 ^ LENGTH('a) - uint x))"
proof (cases "0 \<le> sint x")
  case True
  note sint_lt [of x]
  also have "(2::int) ^ (LENGTH('a) - 1) < 2 ^ LENGTH('a)"
    by (rule power_strict_increasing) simp_all
  finally have "sint x < 2 ^ LENGTH('a)" .
  with True show ?thesis by (simp add: is_signed_positive_def uint_sint bintrunc_mod2p)
(*  by (simp add: is_signed_positive_def uint_sint bintrunc_mod2p mod_pos_pos_trivial) *)
next
  case False
  from sint_ge [of x]
  have "- sint x \<le> 2 ^ (LENGTH('a) - 1)" by simp
  also have "(2::int) ^ (LENGTH('a) - 1) < 2 ^ LENGTH('a)"
    by (rule power_strict_increasing) simp_all
  finally have "- sint x < 2 ^ LENGTH('a)" .
  then have "- (2 ^ LENGTH('a)) < sint x" by simp
  moreover from False have "0 < - sint x" by simp
  ultimately have "- sint x = - sint x mod 2 ^ LENGTH('a)" by simp
(*  by (simp add: mod_pos_pos_trivial) *)
  also have "sint x mod 2 ^ LENGTH('a) \<noteq> 0"
  proof
    assume "sint x mod 2 ^ LENGTH('a) = 0"
    then obtain y where y: "sint x = y * 2 ^ LENGTH('a)" by auto
    with False have "\<not> 0 \<le> y" by auto
    then have "y \<le> - 1" by simp
    then have "y * 2 ^ LENGTH('a) \<le> - 1 * 2 ^ LENGTH('a)"
      by (rule mult_right_mono) simp
    with y have "sint x \<le> - (2 ^ LENGTH('a))" by simp
    with \<open>- (2 ^ LENGTH('a)) < sint x\<close> show False by simp
  qed
  then have "- sint x mod 2 ^ LENGTH('a) = 2 ^ LENGTH('a) - sint x mod 2 ^ LENGTH('a)"
    by (simp add: zmod_zminus1_eq_if)
  finally show ?thesis using False
    by (simp add: is_signed_positive_def uint_sint bintrunc_mod2p)
qed

type_synonym word8 = "8 word"

why3_open "bv/BV8.xml"
  constants
    zeros=zero_class.zero
    ones=max_word
    bw_and=Bit_Operations.semiring_bit_operations_class.and
    bw_or=Bit_Operations.semiring_bit_operations_class.or
    bw_xor=Bit_Operations.semiring_bit_operations_class.xor
    bw_not=Bit_Operations.ring_bit_operations_class.not
(*
    bw_and=bitAND
    bw_or=bitOR
    bw_xor=bitXOR
    bw_not=bitNOT
*)
    add=plus
    sub=minus
    neg=uminus
    mul=times
    udiv=divide
    urem=modulo
    lsr=lsr
    asr=asr
    lsl=lsl
    lsr_bv=lsr_bv
    asr_bv=asr_bv
    lsl_bv=lsl_bv
    rotate_left=rotate_left
    rotate_right=rotate_right
    rotate_left_bv=rotate_left_bv
    rotate_right_bv=rotate_right_bv
    nth=bv_nth
    nth_bv=nth_bv
    tqtint=uint
    of_int=of_int
    eq_sub_bv=eq_sub_bv
    size_bv=size_bv
    one=one_class.one
    is_signed_positive=is_signed_positive
  types
    t=word8

why3_vc nth_out_of_bound
  using assms
  by (auto simp add: bv_nth_def test_bit_bin)

why3_vc Nth_zeros by (simp add: bv_nth_def)

why3_vc Nth_ones
  using assms
  by (simp add: bv_nth_def)

why3_vc Nth_bw_and
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_or
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_xor
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_not
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Lsr_nth_low
  using assms
  by (simp add: bv_nth_def nth_shiftr nat_add_distrib)

why3_vc Lsr_nth_high
  using assms
  by (simp add: bv_nth_def nth_shiftr)
    (simp add: test_bit_bin nat_add_distrib [symmetric] nat_less_iff)

why3_vc lsr_zeros by simp

why3_vc Asr_nth_low
  using assms
  by (simp add: bv_nth_def nth_sshiftr word_size)
    (simp add: nat_add_distrib [symmetric] le_nat_iff)

why3_vc Asr_nth_high
  using assms
  by (simp add: bv_nth_def nth_sshiftr word_size)
    (simp add: nat_add_distrib [symmetric] le_nat_iff nat_less_iff)

why3_vc asr_zeros by (simp add: sshiftr_eq_funpow_sshiftr1)

why3_vc Lsl_nth_high
  using assms
  by (simp add: bv_nth_def nth_shiftl nat_diff_distrib nat_less_iff nat_le_eq_zle)

why3_vc Lsl_nth_low
  using assms
  by (simp add: bv_nth_def nth_shiftl nat_le_eq_zle)

why3_vc lsl_zeros by simp

why3_vc to_uint_extensionality using assms by simp

why3_vc to_intqtdef by (simp add: to_int_eq)

why3_vc to_int_extensionality using assms by simp

why3_vc positive_is_ge_zeros
  by (simp add: is_signed_positive_def sge_def)

why3_vc to_uint_bounds
  using uint_bounded [of v]
  by simp_all

why3_vc to_uint_of_int
  using assms sorry
(*by (simp add: uint_in_range_def word_of_int uint_word_of_int mod_pos_pos_trivial) *)

why3_vc nth_bv_def
  by (simp add: word_eq_iff word_ops_nth_size word_size nth_shiftr)

why3_vc Nth_bv_is_nth
  by (metis bv_nth_def uint_ge_0 unat_eq_nat_uint)
(*by (simp add: bv_nth_def unat_def)*)

why3_vc Nth_bv_is_nth2
  using assms
  by (metis Nth_bv_is_nth to_uint_of_int)
(*by (simp add: bv_nth_def unat_def to_uint_of_int uint_in_range_def)*)

why3_vc to_uint_size_bv by (simp add: size_bv_def)

why3_vc to_uint_zeros by simp

why3_vc to_uint_one by simp

why3_vc to_uint_ones
  sorry
(*by (simp add: max_word_eq)*)

why3_vc to_uint_add
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_add_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_sub
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_sub_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_neg
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_mul
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_mul_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_udiv
  by (cases "uint v2 = 0")
    (simp_all add: uint_div ediv_def order.strict_iff_order)

why3_vc to_uint_urem
  by (simp add: uint_mod emod_def)

why3_vc Nth_rotate_left
  using assms rotl_nth [of "nat n" v "nat i + (size v - nat n mod size v)"]
  by (simp add: emod_def bv_nth_def word_size nat_minus_mod' int_minus_mod
    nat_mod_distrib nat_add_distrib nat_diff_distrib del: add_diff_assoc)

why3_vc Nth_rotate_right
  using assms rotr_nth [of "nat n" v "nat i"]
  by (simp add: emod_def bv_nth_def nat_mod_distrib nat_add_distrib)

why3_vc rotate_left_bv_is_rotate_left by auto (* by (simp add: unat_def) *)

why3_vc rotate_right_bv_is_rotate_right by auto (*  by (simp add: unat_def) *)

why3_vc lsr_bv_is_lsr by auto (* by (simp add: unat_def) *)

why3_vc to_uint_lsr sorry
(*  by (simp add: ediv_def shiftr_div_2n unat_def) *)

why3_vc asr_bv_is_asr by auto (* by (simp add: unat_def)*)

why3_vc lsl_bv_is_lsl by auto (*by (simp add: unat_def)*)

why3_vc to_uint_lsl sorry
(*  by (simp add: emod_def shiftl_t2n unat_def
    uint_word_ariths mult_ac uint_pow pull_mods [symmetric]) *)

why3_vc Extensionality
  using assms
  by (simp add: eq_sub_def bv_nth_def word_eq_iff all_nat)

why3_vc eq_sub_equiv
  by (simp add: eq_sub_equiv_aux eq_sub_def eq_sub_bv_defn bv_nth_def)

why3_vc eq_sub_bv_def
  by (simp add: eq_sub_bv_defn mask_eq)

why3_end

type_synonym word16 = "16 word"

why3_open "bv/BV16.xml"
  constants
    zeros=zero_class.zero
    ones=max_word
    bw_and=Bit_Operations.semiring_bit_operations_class.and
    bw_or=Bit_Operations.semiring_bit_operations_class.or
    bw_xor=Bit_Operations.semiring_bit_operations_class.xor
    bw_not=Bit_Operations.ring_bit_operations_class.not
(*
    bw_and=bitAND
    bw_or=bitOR
    bw_xor=bitXOR
    bw_not=bitNOT
*)
    add=plus
    sub=minus
    neg=uminus
    mul=times
    udiv=divide
    urem=modulo
    lsr=lsr
    asr=asr
    lsl=lsl
    lsr_bv=lsr_bv
    asr_bv=asr_bv
    lsl_bv=lsl_bv
    rotate_left=rotate_left
    rotate_right=rotate_right
    rotate_left_bv=rotate_left_bv
    rotate_right_bv=rotate_right_bv
    nth=bv_nth
    nth_bv=nth_bv
    tqtint=uint
    of_int=of_int
    eq_sub_bv=eq_sub_bv
    size_bv=size_bv
    one=one_class.one
    is_signed_positive=is_signed_positive
  types
    t=word16

why3_vc nth_out_of_bound
  using assms
  by (auto simp add: bv_nth_def test_bit_bin)

why3_vc Nth_zeros by (simp add: bv_nth_def)

why3_vc Nth_ones
  using assms
  by (simp add: bv_nth_def)

why3_vc Nth_bw_and
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_or
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_xor
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_not
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Lsr_nth_low
  using assms
  by (simp add: bv_nth_def nth_shiftr nat_add_distrib)

why3_vc Lsr_nth_high
  using assms
  by (simp add: bv_nth_def nth_shiftr)
    (simp add: test_bit_bin nat_add_distrib [symmetric] nat_less_iff)

why3_vc lsr_zeros by simp

why3_vc Asr_nth_low
  using assms
  by (simp add: bv_nth_def nth_sshiftr word_size)
    (simp add: nat_add_distrib [symmetric] le_nat_iff)

why3_vc Asr_nth_high
  using assms
  by (simp add: bv_nth_def nth_sshiftr word_size)
    (simp add: nat_add_distrib [symmetric] le_nat_iff nat_less_iff)

why3_vc asr_zeros by (simp add: sshiftr_eq_funpow_sshiftr1)

why3_vc Lsl_nth_high
  using assms
  by (simp add: bv_nth_def nth_shiftl nat_diff_distrib nat_less_iff nat_le_eq_zle)

why3_vc Lsl_nth_low
  using assms
  by (simp add: bv_nth_def nth_shiftl nat_le_eq_zle)

why3_vc lsl_zeros by simp

why3_vc to_uint_extensionality using assms by simp

why3_vc to_intqtdef by (simp add: to_int_eq)

why3_vc to_int_extensionality using assms by simp

why3_vc positive_is_ge_zeros
  by (simp add: is_signed_positive_def sge_def)

why3_vc to_uint_bounds
  using uint_bounded [of v]
  by simp_all

why3_vc to_uint_of_int
  using assms
  sorry
(*  by (simp add: uint_in_range_def word_of_int uint_word_of_int mod_pos_pos_trivial) *)

why3_vc nth_bv_def
  by (simp add: word_eq_iff word_ops_nth_size word_size nth_shiftr)

why3_vc Nth_bv_is_nth
  by (simp add: bv_nth_def)
(*  by (simp add: bv_nth_def unat_def) *)

why3_vc Nth_bv_is_nth2
  using assms
  by (metis BV16.facts.Nth_bv_is_nth BV16.facts.to_uint_of_int)
(*  by (simp add: bv_nth_def unat_def to_uint_of_int uint_in_range_def) *)

why3_vc to_uint_size_bv by (simp add: size_bv_def)

why3_vc to_uint_zeros by simp

why3_vc to_uint_one by simp

why3_vc to_uint_ones sorry (* by (simp add: max_word_eq) *)

why3_vc to_uint_add
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_add_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_sub
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_sub_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_neg
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_mul
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_mul_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_udiv
  by (cases "uint v2 = 0")
    (simp_all add: uint_div ediv_def order.strict_iff_order)

why3_vc to_uint_urem
  by (simp add: uint_mod emod_def)

why3_vc Nth_rotate_left
  using assms rotl_nth [of "nat n" v "nat i + (size v - nat n mod size v)"]
  by (simp add: emod_def bv_nth_def word_size nat_minus_mod' int_minus_mod
    nat_mod_distrib nat_add_distrib nat_diff_distrib del: add_diff_assoc)

why3_vc Nth_rotate_right
  using assms rotr_nth [of "nat n" v "nat i"]
  by (simp add: emod_def bv_nth_def nat_mod_distrib nat_add_distrib)

why3_vc rotate_left_bv_is_rotate_left by auto (* by (simp add: unat_def) *)

why3_vc rotate_right_bv_is_rotate_right by auto (* by (simp add: unat_def) *)

why3_vc lsr_bv_is_lsr by auto (* by (simp add: unat_def)*)

why3_vc to_uint_lsr sorry
(*  by (simp add: ediv_def shiftr_div_2n unat_def) *)

why3_vc asr_bv_is_asr by auto (* by (simp add: unat_def) *)

why3_vc lsl_bv_is_lsl by auto (* by (simp add: unat_def) *)

why3_vc to_uint_lsl
  sorry
(*  by (simp add: emod_def shiftl_t2n unat_def
    uint_word_ariths mult_ac uint_pow pull_mods [symmetric]) *)

why3_vc Extensionality
  using assms
  by (simp add: eq_sub_def bv_nth_def word_eq_iff all_nat)

why3_vc eq_sub_equiv
  by (simp add: eq_sub_equiv_aux eq_sub_def eq_sub_bv_defn bv_nth_def)

why3_vc eq_sub_bv_def
  by (simp add: eq_sub_bv_defn mask_eq)

why3_end

type_synonym word32 = "32 word"

why3_open "bv/BV32.xml"
  constants
    zeros=zero_class.zero
    ones=max_word
    bw_and=Bit_Operations.semiring_bit_operations_class.and
    bw_or=Bit_Operations.semiring_bit_operations_class.or
    bw_xor=Bit_Operations.semiring_bit_operations_class.xor
    bw_not=Bit_Operations.ring_bit_operations_class.not
(*
    bw_and=bitAND
    bw_or=bitOR
    bw_xor=bitXOR
    bw_not=bitNOT
*)
    add=plus
    sub=minus
    neg=uminus
    mul=times
    udiv=divide
    urem=modulo
    lsr=lsr
    asr=asr
    lsl=lsl
    lsr_bv=lsr_bv
    asr_bv=asr_bv
    lsl_bv=lsl_bv
    rotate_left=rotate_left
    rotate_right=rotate_right
    rotate_left_bv=rotate_left_bv
    rotate_right_bv=rotate_right_bv
    nth=bv_nth
    nth_bv=nth_bv
    tqtint=uint
    of_int=of_int
    eq_sub_bv=eq_sub_bv
    size_bv=size_bv
    one=one_class.one
    is_signed_positive=is_signed_positive
  types
    t=word32

why3_vc nth_out_of_bound
  using assms
  by (auto simp add: bv_nth_def test_bit_bin)

why3_vc Nth_zeros by (simp add: bv_nth_def)

why3_vc Nth_ones
  using assms
  by (simp add: bv_nth_def)

why3_vc Nth_bw_and
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_or
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_xor
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_not
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Lsr_nth_low
  using assms
  by (simp add: bv_nth_def nth_shiftr nat_add_distrib)

why3_vc Lsr_nth_high
  using assms
  by (simp add: bv_nth_def nth_shiftr)
    (simp add: test_bit_bin nat_add_distrib [symmetric] nat_less_iff)

why3_vc lsr_zeros by simp

why3_vc Asr_nth_low
  using assms
  by (simp add: bv_nth_def nth_sshiftr word_size)
    (simp add: nat_add_distrib [symmetric] le_nat_iff)

why3_vc Asr_nth_high
  using assms
  by (simp add: bv_nth_def nth_sshiftr word_size)
    (simp add: nat_add_distrib [symmetric] le_nat_iff nat_less_iff)

why3_vc asr_zeros by (simp add: sshiftr_eq_funpow_sshiftr1)

why3_vc Lsl_nth_high
  using assms
  by (simp add: bv_nth_def nth_shiftl nat_diff_distrib nat_less_iff nat_le_eq_zle)

why3_vc Lsl_nth_low
  using assms
  by (simp add: bv_nth_def nth_shiftl nat_le_eq_zle)

why3_vc lsl_zeros by simp

why3_vc to_uint_extensionality using assms by simp

why3_vc to_intqtdef by (simp add: to_int_eq)

why3_vc to_int_extensionality using assms by simp

why3_vc positive_is_ge_zeros
  by (simp add: is_signed_positive_def sge_def)

why3_vc to_uint_bounds
  using uint_bounded [of v]
  by simp_all

why3_vc to_uint_of_int
  using assms
  by (simp add: take_bit_int_eq_self)
(*  by (simp add: uint_in_range_def word_of_int uint_word_of_int mod_pos_pos_trivial)*)

why3_vc nth_bv_def
  by (simp add: word_eq_iff word_ops_nth_size word_size nth_shiftr)

why3_vc Nth_bv_is_nth
  by (simp add: bv_nth_def)
(*  by (simp add: bv_nth_def unat_def) *)

why3_vc Nth_bv_is_nth2
  using assms
  by (metis BV32.facts.Nth_bv_is_nth BV32.facts.to_uint_of_int)
(*  by (simp add: bv_nth_def unat_def to_uint_of_int uint_in_range_def) *)

why3_vc to_uint_size_bv by (simp add: size_bv_def)

why3_vc to_uint_zeros by simp

why3_vc to_uint_one by simp

why3_vc to_uint_ones sorry (* by (simp add: max_word_eq) *)

why3_vc to_uint_add
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_add_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_sub
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_sub_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_neg
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_mul
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_mul_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_udiv
  by (cases "uint v2 = 0")
    (simp_all add: uint_div ediv_def order.strict_iff_order)

why3_vc to_uint_urem
  by (simp add: uint_mod emod_def)

why3_vc Nth_rotate_left
  using assms rotl_nth [of "nat n" v "nat i + (size v - nat n mod size v)"]
  by (simp add: emod_def bv_nth_def word_size nat_minus_mod' int_minus_mod
    nat_mod_distrib nat_add_distrib nat_diff_distrib del: add_diff_assoc)

why3_vc Nth_rotate_right
  using assms rotr_nth [of "nat n" v "nat i"]
  by (simp add: emod_def bv_nth_def nat_mod_distrib nat_add_distrib)

why3_vc rotate_left_bv_is_rotate_left by auto (* by (simp add: unat_def) *)

why3_vc rotate_right_bv_is_rotate_right by auto (*  by (simp add: unat_def) *)

why3_vc lsr_bv_is_lsr by auto (* by (simp add: unat_def) *)

why3_vc to_uint_lsr sorry
(*  by (simp add: ediv_def shiftr_div_2n unat_def) *)

why3_vc asr_bv_is_asr by auto (* by (simp add: unat_def) *)

why3_vc lsl_bv_is_lsl by auto (* by (simp add: unat_def) *)

why3_vc to_uint_lsl sorry
(*  by (simp add: emod_def shiftl_t2n unat_def
    uint_word_ariths mult_ac uint_pow pull_mods [symmetric]) *)

why3_vc Extensionality
  using assms
  by (simp add: eq_sub_def bv_nth_def word_eq_iff all_nat)

why3_vc eq_sub_equiv
  by (simp add: eq_sub_equiv_aux eq_sub_def eq_sub_bv_defn bv_nth_def)

why3_vc eq_sub_bv_def
  by (simp add: eq_sub_bv_defn mask_eq)

why3_end

type_synonym word64 = "64 word"

why3_open "bv/BV64.xml"
  constants
    zeros=zero_class.zero
    ones=max_word
    bw_and=Bit_Operations.semiring_bit_operations_class.and
    bw_or=Bit_Operations.semiring_bit_operations_class.or
    bw_xor=Bit_Operations.semiring_bit_operations_class.xor
    bw_not=Bit_Operations.ring_bit_operations_class.not
(*
    bw_and=bitAND
    bw_or=bitOR
    bw_xor=bitXOR
    bw_not=bitNOT
*)
    add=plus
    sub=minus
    neg=uminus
    mul=times
    udiv=divide
    urem=modulo
    lsr=lsr
    asr=asr
    lsl=lsl
    lsr_bv=lsr_bv
    asr_bv=asr_bv
    lsl_bv=lsl_bv
    rotate_left=rotate_left
    rotate_right=rotate_right
    rotate_left_bv=rotate_left_bv
    rotate_right_bv=rotate_right_bv
    nth=bv_nth
    nth_bv=nth_bv
    tqtint=uint
    of_int=of_int
    eq_sub_bv=eq_sub_bv
    size_bv=size_bv
    one=one_class.one
    is_signed_positive=is_signed_positive
  types
    t=word64

why3_vc nth_out_of_bound
  using assms
  by (auto simp add: bv_nth_def test_bit_bin)

why3_vc Nth_zeros by (simp add: bv_nth_def)

why3_vc Nth_ones
  using assms
  by (simp add: bv_nth_def)

why3_vc Nth_bw_and
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_or
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_xor
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Nth_bw_not
  using assms
  by (simp add: bv_nth_def word_ops_nth_size word_size)

why3_vc Lsr_nth_low
  using assms
  by (simp add: bv_nth_def nth_shiftr nat_add_distrib)

why3_vc Lsr_nth_high
  using assms
  by (simp add: bv_nth_def nth_shiftr)
    (simp add: test_bit_bin nat_add_distrib [symmetric] nat_less_iff)

why3_vc lsr_zeros by simp

why3_vc Asr_nth_low
  using assms
  by (simp add: bv_nth_def nth_sshiftr word_size)
    (simp add: nat_add_distrib [symmetric] le_nat_iff)

why3_vc Asr_nth_high
  using assms
  by (simp add: bv_nth_def nth_sshiftr word_size)
    (simp add: nat_add_distrib [symmetric] le_nat_iff nat_less_iff)

why3_vc asr_zeros by (simp add: sshiftr_eq_funpow_sshiftr1)

why3_vc Lsl_nth_high
  using assms
  by (simp add: bv_nth_def nth_shiftl nat_diff_distrib nat_less_iff nat_le_eq_zle)

why3_vc Lsl_nth_low
  using assms
  by (simp add: bv_nth_def nth_shiftl nat_le_eq_zle)

why3_vc lsl_zeros by simp

why3_vc to_uint_extensionality using assms by simp

why3_vc to_intqtdef by (simp add: to_int_eq)

why3_vc to_int_extensionality using assms by simp

why3_vc positive_is_ge_zeros
  by (simp add: is_signed_positive_def sge_def)

why3_vc to_uint_bounds
  using uint_bounded [of v]
  by simp_all

why3_vc to_uint_of_int
  using assms sorry
(*  by (simp add: uint_in_range_def word_of_int uint_word_of_int mod_pos_pos_trivial) *)

why3_vc nth_bv_def
  by (simp add: word_eq_iff word_ops_nth_size word_size nth_shiftr)

why3_vc Nth_bv_is_nth
  by (simp add: bv_nth_def)
(*  by (simp add: bv_nth_def unat_def) *)

why3_vc Nth_bv_is_nth2
  using assms BV64.facts.to_uint_of_int bv_nth_def by auto
(*  by (simp add: bv_nth_def unat_def to_uint_of_int uint_in_range_def) *)

why3_vc to_uint_size_bv by (simp add: size_bv_def)

why3_vc to_uint_zeros by simp

why3_vc to_uint_one by simp

why3_vc to_uint_ones sorry (* by (simp add: max_word_eq) *)

why3_vc to_uint_add
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_add_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_sub
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_sub_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_neg
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_mul
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p emod_def)

why3_vc to_uint_mul_bounded
  using assms
  by (simp add: uint_word_arith_bintrs bintrunc_mod2p)

why3_vc to_uint_udiv
  by (cases "uint v2 = 0")
    (simp_all add: uint_div ediv_def order.strict_iff_order)

why3_vc to_uint_urem
  by (simp add: uint_mod emod_def)

why3_vc Nth_rotate_left
  using assms rotl_nth [of "nat n" v "nat i + (size v - nat n mod size v)"]
  by (simp add: emod_def bv_nth_def word_size nat_minus_mod' int_minus_mod
    nat_mod_distrib nat_add_distrib nat_diff_distrib del: add_diff_assoc)

why3_vc Nth_rotate_right
  using assms rotr_nth [of "nat n" v "nat i"]
  by (simp add: emod_def bv_nth_def nat_mod_distrib nat_add_distrib)

why3_vc rotate_left_bv_is_rotate_left by simp  (* by (simp add: unat_def) *)

why3_vc rotate_right_bv_is_rotate_right by simp (* by (simp add: unat_def) *)

why3_vc lsr_bv_is_lsr by simp (* by (simp add: unat_def) *)

why3_vc to_uint_lsr sorry
(*  by (simp add: ediv_def shiftr_div_2n unat_def) *)

why3_vc asr_bv_is_asr by simp (*by (simp add: unat_def) *)

why3_vc lsl_bv_is_lsl by simp (* by (simp add: unat_def) *)

why3_vc to_uint_lsl sorry
(*  by (simp add: emod_def shiftl_t2n unat_def
    uint_word_ariths mult_ac uint_pow pull_mods [symmetric]) *)

why3_vc Extensionality
  using assms
  by (simp add: eq_sub_def bv_nth_def word_eq_iff all_nat)

why3_vc eq_sub_equiv
  by (simp add: eq_sub_equiv_aux eq_sub_def eq_sub_bv_defn bv_nth_def)

why3_vc eq_sub_bv_def
  by (simp add: eq_sub_bv_defn mask_eq)

why3_end

why3_open "bv/BVConverter_32_64.xml"
  constants
    toBig = ucast
    toSmall = ucast

why3_vc toSmall_to_uint
  using assms
  sorry
(*  by (simp add: BV64.ule_def ucast_def uint_word_of_int mod_pos_pos_trivial) *)

why3_vc toBig_to_uint
  by (simp add: uint_up_ucast is_up)

why3_end

why3_open "bv/BVConverter_16_64.xml"
  constants
    toBig = ucast
    toSmall = ucast

why3_vc toSmall_to_uint
  using assms sorry
(*  by (simp add: BV64.ule_def ucast_def uint_word_of_int mod_pos_pos_trivial) *)

why3_vc toBig_to_uint
  by (simp add: uint_up_ucast is_up)

why3_end

why3_open "bv/BVConverter_8_64.xml"
  constants
    toBig = ucast
    toSmall = ucast

why3_vc toSmall_to_uint
  using assms sorry
(*  by (simp add: BV64.ule_def ucast_def uint_word_of_int mod_pos_pos_trivial) *)

why3_vc toBig_to_uint
  by (simp add: uint_up_ucast is_up)

why3_end

why3_open "bv/BVConverter_16_32.xml"
  constants
    toBig = ucast
    toSmall = ucast

why3_vc toSmall_to_uint
  using assms sorry
(*  by (simp add: BV32.ule_def ucast_def uint_word_of_int mod_pos_pos_trivial) *)

why3_vc toBig_to_uint
  by (simp add: uint_up_ucast is_up)

why3_end

why3_open "bv/BVConverter_8_32.xml"
  constants
    toBig = ucast
    toSmall = ucast

why3_vc toSmall_to_uint
  using assms sorry
(*  by (simp add: BV32.ule_def ucast_def uint_word_of_int mod_pos_pos_trivial) *)

why3_vc toBig_to_uint
  by (simp add: uint_up_ucast is_up)

why3_end

why3_open "bv/BVConverter_8_16.xml"
  constants
    toBig = ucast
    toSmall = ucast

why3_vc toSmall_to_uint
  using assms sorry
(*  by (simp add: BV16.ule_def ucast_def uint_word_of_int mod_pos_pos_trivial) *)

why3_vc toBig_to_uint
  by (simp add: uint_up_ucast is_up)

why3_end

end