From mathcomp Require Import all_ssreflect.
From mathcomp Require Import ssralg poly polydiv polyorder ssrnum zmodp.
From mathcomp Require Import polyrcf qe_rcf_th complex.
Require Import poly_normal pol.

(*
This file consists of several sections:
- nonnegative lists, polynomials with nonnegative coefs,
  proof of Proposition 2.39 of [bpr], monic_roots_changes_eq0
- complements for scaleX_poly
- complements for transformations in R and roots
- complements for transformations and equality
- complements for transformations in C and roots
- proof of 3 circles i)
- proof of 3 circles ii)
*)

Set Implicit Arguments.
Unset Strict Implicit.

Import Order.Theory GRing.Theory Num.Theory Num.Def.
Import Pdiv.Idomain.

Local Open Scope ring_scope.

Section about_nonneg.

Variable R : rcfType.

Local Notation C := (complex R).

Definition nonneg (s : seq R) := all (fun x => 0 <= x) s.

Lemma nonnegP (s : seq R) :
  reflect (forall k, (k < size s)%N -> 0 <= s`_k) (nonneg s).
Proof. exact/all_nthP. Qed.

Lemma nonneg_poly_deg1 (a : R) : nonneg ('X - a%:P) = (a <= 0).
Proof.
by rewrite polyseqXsubC /= ler01 oppr_ge0 !andbT.
Qed.

Import complex.

Lemma nonneg_poly_deg2 (z : C) :
  nonneg ('X^2 + (1 *- 2 * Re z) *: 'X + (Re z ^+ 2 + Im z ^+ 2)%:P) =
  ((Re z) <= 0).
Proof.
rewrite -(mul1r 'X^2) mul_polyC polyseq_deg2 /= ?oner_neq0 // ler01 !andbT.
by rewrite nmulr_rge0 ?oppr_lt0 ?ltr0n // addr_ge0 // sqr_ge0.
Qed.

Lemma nonneg_mulr (p q : {poly R}) : nonneg p -> nonneg q -> nonneg (p * q).
Proof.
have [->|Hpsize] := eqVneq p 0; first by rewrite mul0r.
have [->|Hqsize Hp Hq] := eqVneq q 0; first by rewrite mulr0.
apply/nonnegP => k lpq.
rewrite coef_mul_poly /= sumr_ge0 // => i _.
apply: mulr_ge0.
  have [Hi2|Hi2] := ltnP i (size p); first exact/nonnegP.
  by rewrite -(coefK p) coef_poly ltnNge Hi2.
have [Hi2|Hi2] := ltnP (k - i) (size q); first exact/nonnegP.
by rewrite -(coefK q) coef_poly ltnNge Hi2.
Qed.

Local Notation toC := (fun (p : {poly R}) =>
   @map_poly R _ (real_complex R) p).

Lemma nonneg_root_nonpos (p : {poly R}) : p \is monic ->
   (forall z : C, root (toC p) z -> (Re z <= 0)) -> nonneg p.
Proof.
move=> Hpmonic.
move: {2}(size p) (leqnn (size p)) => n.
elim: n p Hpmonic=> [p Hpmonic Hpsize Hproot | n IH p Hpmonic Hpsize Hproots].
(* size p <= 0 *)
  rewrite size_poly_leq0 in Hpsize.
  by rewrite (eqP Hpsize) monicE lead_coef0 eq_sym oner_eq0 in Hpmonic.
(* size p <= n.+1 *)
case: (altP (size (toC p) =P 1%N)) => Hpsize2.
(* size p = 1 *)
  rewrite size_map_poly_id0 in Hpsize2;
    last by rewrite eq_sym negbT // lt_eqF // ltcR (eqP Hpmonic) ltr01.
  have Hp := (size1_polyC (eq_leq Hpsize2)).
  rewrite Hp in Hpsize2.
  rewrite Hp monicE lead_coefE Hpsize2 -pred_Sn polyseqC in Hpmonic.
  rewrite size_polyC in Hpsize2.
  rewrite Hpsize2 /= in Hpmonic.
  by rewrite Hp /= (eqP Hpmonic) polyseqC oner_neq0 /= ler01.
(* size p != 1 *)
move/closed_rootP : Hpsize2.
case=> x Hrootx.
have [Himx|Himx] := altP (Im x =P 0).
(* real root *)
  have H := monicXsubC (Re x).
  have Hp := real_root_div_poly_deg1 Himx Hrootx.
  rewrite Pdiv.IdomainMonic.dvdp_eq // in Hp.
  rewrite (eqP Hp) nonneg_mulr //.
    apply: IH=> [ | | z Hz].
    + by rewrite monicE -(@lead_coef_Mmonic _ (p %/ ('X - (Re x)%:P))
          ('X - (Re x)%:P)) // -(eqP Hp) -monicE.
    - rewrite size_divp; last by apply: monic_neq0.
      by rewrite size_XsubC leq_subLR addnC addn1.
    + rewrite Hproots // (eqP Hp) rmorphM rootM.
      apply/orP; by left.
  by rewrite nonneg_poly_deg1 (Hproots x Hrootx).
(* pair of complex roots *)
have H : 'X^2 + (1 *- 2 * Re x) *: 'X + (Re x ^+ 2 + Im x ^+ 2)%:P \is monic.
  by rewrite -(mul1r 'X^2) mul_polyC monicE lead_coefE polyseq_deg2 // oner_neq0.
have H2 : size ('X^2 + (1 *- 2 * Re x) *: 'X + (Re x ^+ 2 + Im x ^+ 2)%:P) = 3%N.
  by rewrite -(mul1r 'X^2) mul_polyC polyseq_deg2 // oner_neq0.
have Hp := complex_root_div_poly_deg2 Himx Hrootx.
rewrite Pdiv.IdomainMonic.dvdp_eq // in Hp.
rewrite (eqP Hp) nonneg_mulr //.
  apply: IH=> [ | | z Hz].
 + by rewrite monicE -(@lead_coef_Mmonic _ _ ('X^2 + (1 *- 2 * Re x) *: 'X +
    (Re x ^+ 2 + Im x ^+ 2)%:P)) // -(eqP Hp) -monicE.
  - rewrite size_divp; last by apply: monic_neq0.
    by rewrite H2 leq_subLR addnC addn2 (@leq_trans n.+1).
  + by rewrite Hproots // (eqP Hp) rmorphM rootM Hz.
by rewrite nonneg_poly_deg2 (Hproots _ Hrootx).
Qed.

Lemma nonneg_changes0 (s : seq R) : nonneg s -> changes s = 0%N.
Proof.
elim: s => [ |a ] //.
case=> [_ _ |b l IHbl /andP [] Ha Hblnonneg].
  by rewrite /= mulr0 addn0 ltxx.
have /andP[Hb Hlnonneg] := Hblnonneg.
apply/eqP; rewrite addn_eq0 eqb0 -leNgt mulr_ge0 //=.
apply/eqP; by apply: IHbl.
Qed.

(* Proposition 2.39 *)
Lemma monic_roots_changes_eq0 (p : {poly R}) : p \is monic ->
   (forall (z : C), (root (toC p) z) -> (Re z <= 0)) ->
   changes p = 0%N.
Proof.
move=> Hpmonic H.
by rewrite nonneg_changes0 // nonneg_root_nonpos.
Qed.

End about_nonneg.

Section about_scaleX_poly. (* move this section to pol.v*)

Variable (R : comRingType).

Lemma scaleX_poly_is_linear (c : R) : linear (scaleX_poly c).
Proof. by move=> a u v; rewrite /scaleX_poly comp_polyD comp_polyZ. Qed.

Lemma scaleX_poly_multiplicative (c : R) : multiplicative (scaleX_poly c).
Proof.
split. move=> x y; exact: comp_polyM. by rewrite /scaleX_poly comp_polyC.
Qed.

Canonical scaleX_poly_additive (c : R) := Additive (scaleX_poly_is_linear c).
Canonical scaleX_poly_linear c := Linear (scaleX_poly_is_linear c).
Canonical scaleX_poly_rmorphism c := AddRMorphism (scaleX_poly_multiplicative c).

Lemma scaleX_polyC (c a : R) : a%:P \scale c = a%:P.
Proof. by rewrite /scaleX_poly comp_polyC. Qed.

End about_scaleX_poly.

Section about_transformations.
Variable R : fieldType.
(*
Lemma root_shift_1 (p : {poly R}) (a x : R) :
   (root p x) = root (p \shift a) (x-a).
Proof. by rewrite !rootE -horner_shift_poly1. Qed.
*)
Lemma root_shift_2 (p : {poly R}) (a x : R) :
  root p (x + a) = root (p \shift a) x.
Proof. by rewrite !rootE -{2}(@addrK _ a x) -horner_shift_poly1. Qed.
(*
Lemma root_scale_1 (p : {poly R}) (a x : R) : (a != 0) ->
   root p x = root (p \scale a) (x / a).
Proof.
move=> Ha.
by rewrite !rootE horner_scaleX_poly mulrC (@mulrVK _ a _ x) // unitfE.
Qed.
*)
Lemma root_scale_2 (p : {poly R}) (a x : R) :
  root p (a * x) = root (p \scale a) x.
Proof. by rewrite !rootE horner_scaleX_poly. Qed.
(*
Lemma root_reciprocal_1 (p : {poly R}) (x : R) : (x != 0) ->
   root p x = root (reciprocal_pol p) (x^-1).
Proof.
move=> Hx.
rewrite !rootE horner_reciprocal1; last by rewrite unitfE.
rewrite GRing.mulrI_eq0 //; apply: GRing.lregX.
by apply/lregP.
Qed.
*)
Lemma root_reciprocal_2 (p : {poly R}) (x : R) : x != 0 ->
  root p (x^-1) = root (reciprocal_pol p) x.
Proof.
move=> Hx.
rewrite !rootE horner_reciprocal ?unitfE//.
by rewrite mulrI_eq0 //; apply/lregX/lregP.
Qed.
(*
Lemma root_Mobius_1 (p : {poly R}) (x : R) (l r : R) :
   (l != r) -> (x != l) -> (x != r) ->
   root p x = root (Mobius p l r) ((r - x) / (x - l)).
Proof.
move=> Hlr Hxl Hxr.
rewrite /Mobius.
rewrite -root_shift_2 -(@mulrK _ (x - l) _ 1); last by rewrite unitfE subr_eq0.
rewrite mul1r -mulrDl addrA -(@addrA _ _ (-x) x) (@addrC _ (-x) x) addrA addrK.
rewrite -root_reciprocal_2.
  rewrite invrM; last by rewrite unitfE invr_eq0 subr_eq0.
    rewrite invrK -root_scale_2 mulrC divrK;
      last by rewrite unitfE subr_eq0 eq_sym.
    by rewrite -root_shift_2 -addrA (@addrC _ _ l) addrA addrK.
  by rewrite unitfE subr_eq0 eq_sym.
apply: GRing.mulf_neq0.
  by rewrite subr_eq0 eq_sym.
by rewrite invr_eq0 subr_eq0.
Qed.
*)

(* TODO(rei): define as an instance of Mobius in pol.v? *)
Definition Mobius' (R : ringType) (p : {poly R}) (a b : R) : {poly R} :=
(*  Mobius (size p).-1 a b p.? *)
  reciprocal_pol ((p \shift a) \scale (b - a)) \shift 1.

Lemma root_Mobius'_2 (p : {poly R}) (x : R) (l r : R) :
  x + 1 != 0 ->
  root p ((r + l * x) / (x + 1)) = root (Mobius' p l r) x.
Proof.
move=> Hx.
rewrite /Mobius -root_shift_2 -root_reciprocal_2 //.
rewrite -root_scale_2 -root_shift_2 -{3}(@mulrK _ (x + 1) _ l).
  by rewrite -mulrDl {2}(@addrC _ x 1) mulrDr mulr1 addrA
       -(addrA r (- l) l) (addrC (-l) l) addrA addrK.
by rewrite unitfE.
Qed.

Lemma Mobius'M (p q : {poly R}) (l r : R) :
   Mobius' (p * q) l r = Mobius' p l r * Mobius' q l r.
Proof.
by rewrite /Mobius' !rmorphM /= reciprocalM rmorphM.
Qed.

Lemma Mobius'_Xsubc (c l r : R) : (l != r) ->
  Mobius' ('X - c%:P) l r = (l - c) *: 'X + (r - c)%:P.
Proof.
move=> Hlr.
rewrite /Mobius' rmorphB /= shift_polyC rmorphB /= scaleX_polyC
   /shift_poly comp_polyX rmorphD /= scaleX_polyC /scaleX_poly
   comp_polyX -addrA -(rmorphB _ l c) /= reciprocal_monom.
  by rewrite rmorphD rmorphM /= comp_polyX !comp_polyC
    mulrDl polyC1 mul1r mulrC mul_polyC -addrA (addrC (l - c)%:P _)
    -rmorphD /= addrA addrNK.
by rewrite subr_eq0 eq_sym.
Qed.

Lemma Mobius'_Xsubc_monic (c l r : R) : l != r -> l != c ->
  (lead_coef (Mobius' ('X - c%:P) l r))^-1 *: (Mobius' ('X - c%:P) l r) =
  'X + ((r - c) / (l - c))%:P.
Proof.
move=> Hlr Hlc.
rewrite Mobius'_Xsubc //  lead_coefE.
have Hlc2 : (l - c) != 0 by rewrite subr_eq0.
have HlcP : ((l - c)%:P == 0) = false.
  apply/eqP/eqP.
  by rewrite polyC_eq0 subr_eq0.
have Hsize : size ((l - c) *: 'X + (r - c)%:P) = 2%N.
  by rewrite -(mul_polyC (l - c) 'X) size_MXaddC HlcP /= size_polyC Hlc2.
have Hcoef1 : ((l - c) *: 'X + (r - c)%:P)`_1 = l - c.
  by rewrite coefD coefC addr0 -mul_polyC coefMX coefC /=.
by rewrite Hsize -mul_polyC Hcoef1 mulrDr mul_polyC -rmorphM
   mulrC -!mul_polyC mulrA (mulrC _ 'X) -rmorphM (mulrC _ (l - c))
   mulfV //= polyC1 mulr1.
Qed.

End about_transformations.

Section about_transformations_and_equality.

Variable (R : idomainType).

Lemma shift_poly_eq (p q : {poly R}) (a : R) :
  (p == q) = (p \shift a == q \shift a).
Proof.
by rewrite /shift_poly -(subr_eq0 p q) -(@comp_poly2_eq0 _ (p-q) ('X + a%:P))
  ?size_XaddC // rmorphB subr_eq add0r.
Qed.

Lemma scale_poly_eq (p q : {poly R}) (a : R) : (a != 0) ->
  (p == q) = (p \scale a == q \scale a).
Proof.
move=> Ha.
by rewrite /scaleX_poly -(subr_eq0 p q) -(@comp_poly2_eq0 _ (p - q) ('X * a%:P))
  ?size_XmulC // rmorphB subr_eq add0r.
Qed.

Lemma pdivmu0_0th_neq0 (p : {poly R}) : p != 0 -> (p %/ 'X^(\mu_0 p))`_0 != 0.
Proof.
move=> Hp.
have H0noroot : ~~(root (p %/ 'X^(\mu_0 p)) 0).
  rewrite -mu_gt0.
    rewrite -eqn0Ngt -(addr0 'X) -(@oppr0 (poly_zmodType R)) -polyC0 mu_div
      ?subn_eq0; by rewrite leqnn.
  rewrite Pdiv.CommonIdomain.divp_eq0 negb_or Hp /= negb_or.
  rewrite -size_poly_gt0 {1}size_polyXn /= -leqNgt dvdp_leq //.
  by rewrite -(addr0 'X) -oppr0 -polyC0 root_mu.
rewrite -horner_coef0. apply: negbT.
by move/rootPf : H0noroot.
Qed.

Lemma Mobius'0 (p : {poly R}) (a b : R) : a != b ->
  (p == 0) = ((Mobius' p a b) == 0).
Proof.
move=> ab; apply/idP/idP => /eqP Hp.
  by rewrite /Mobius' Hp /shift_poly /scaleX_poly !comp_polyC
     reciprocalC comp_polyC.
rewrite /Mobius' in Hp.
rewrite (shift_poly_eq p 0 a) shift_polyC (@scale_poly_eq _ _  (b - a)).
  by rewrite /scaleX_poly comp_polyC -reciprocal0 (shift_poly_eq _ _ 1)
     shift_polyC Hp.
by rewrite subr_eq0 eq_sym.
Qed.

End about_transformations_and_equality.

From mathcomp Require Import complex.

Section transformations_in_C.
Local Open Scope complex_scope.

Variable (R : rcfType).
Local Notation C:= (complex R).

Local Notation toC := (fun (p : {poly R}) => @map_poly R _ (real_complex R) p).

Lemma shift_toC (p : {poly R}) (a : R) : toC (p \shift a) = (toC p) \shift a%:C.
Proof.
by rewrite /shift_poly (map_comp_poly _ p ('X + a%:P)) rmorphD /=
   map_polyX map_polyC.
Qed.

Lemma scale_toC (p : {poly R}) (a : R) : toC (p \scale a) = (toC p) \scale a%:C.
Proof.
by rewrite /scaleX_poly (map_comp_poly _ p ('X * a%:P)) rmorphM /=
   map_polyX map_polyC.
Qed.

Lemma reciprocal_toC (p : {poly R}) :
  toC (@reciprocal_pol _ p) = reciprocal_pol (toC p).
Proof.
rewrite /reciprocal_pol poly_def rmorph_sum /= poly_def size_map_inj_poly.
- apply: eq_bigr => i _.
  rewrite -mul_polyC rmorphM /= map_polyXn /=.
  by rewrite !coef_map /= map_polyC /= mul_polyC.
- exact: complexI.
- by rewrite -complexr0.
Qed.

Lemma Mobius'_toC (p : {poly R}) (l r : R) :
  toC (Mobius' p l r) = Mobius' (toC p) l%:C r%:C.
Proof.
by rewrite {2}/Mobius' -shift_toC /= -rmorphB -scale_toC
   -reciprocal_toC -shift_toC /Mobius.
Qed.

(*
Lemma root_Mobius_C_1 :  forall (p : {poly R}) (z : C) (l r : R),
   (l != r) -> (z != l%:C) -> (z != r%:C) ->
      root (toC p) z =
      root (toC (Mobius p l r)) ((r%:C - z) / (z - l%:C)).
Proof.
move=> p z l r Hlr Hzl Hzr.
have HlrC : (l%:C != r%:C).
  by rewrite -!complexr0 eq_complex /= negb_and eq_refl orbF.
rewrite !rootE Mobius_toC /Mobius -!rootE -@root_shift_2
   -(@mulrK _ (z - l%:C) _ 1).
  rewrite mul1r -mulrDl addrA -(@addrA _ _ (-z) z) (@addrC _ (-z) z) addrA
     addrK -root_reciprocal_2.
    rewrite invrM.
        rewrite invrK -root_scale_2 mulrC divrK.
          by rewrite -root_shift_2 -addrA (@addrC _ _ l%:C) addrA addrK.
        by rewrite unitfE subr_eq0 eq_sym.
      by rewrite unitfE subr_eq0 eq_sym.
    by rewrite unitfE invr_eq0 subr_eq0.
  apply: GRing.mulf_neq0.
    by rewrite subr_eq0 eq_sym.
  by rewrite invr_eq0 subr_eq0.
by rewrite unitfE subr_eq0.
Qed.
*)

Lemma root_Mobius'_C_2 (p : {poly R}) (z : C) (l r : R) :
  z + 1 != 0 ->
  root (toC p) ((r%:C + l%:C * z) / (z + 1)) = root (toC (Mobius' p l r)) z.
Proof.
move=> Hz.
rewrite !rootE Mobius'_toC /Mobius -!rootE -root_shift_2 -root_reciprocal_2 //.
rewrite -root_scale_2 -root_shift_2 -{3}(@mulrK _ (z + 1) _ l%:C).
  by rewrite -mulrDl {2}(@addrC _ z 1) mulrDr mulr1 addrA
   -(addrA r%:C (- l%:C) l%:C) (addrC (-l%:C) l%:C) addrA addrK.
by rewrite unitfE.
Qed.

End transformations_in_C.

Lemma mul_polyC_seqmul (R : rcfType) (p : {poly R}) (a : R) :
  a != 0 ->
  polyseq (a *: p) = seqmul (nseq (size p) a) p.
Proof.
move=> Ha; elim/poly_ind : p => [ | p c IHp].
  by rewrite size_poly0 /= seqmul0 -mul_polyC mulr0 -polyC0 polyseq0.
rewrite -{2}(cons_poly_def) -mul_polyC mulrDr mulrA mul_polyC -polyCM.
rewrite -!cons_poly_def !polyseq_cons.
case Hp : (nilp p); last first.
  rewrite ifT; last first.
    rewrite nil_poly in Hp.
    by rewrite nil_poly -mul_polyC mulf_neq0 // ?Hp // polyC_eq0.
  by rewrite seqmul_cons IHp.
rewrite ifF; last first.
  rewrite nil_poly in Hp.
  by rewrite nil_poly -mul_polyC mulf_eq0 Hp orbT.
rewrite /= size_polyC.
have [->|Hc] := eqVneq c 0; first by rewrite mulr0 seqmul0 polyseqC eq_refl.
by rewrite !polyseqC mulf_neq0//= Hc seqmul_cons.
Qed.

Lemma changes_mulC  (R : rcfType) (p : {poly R}) (a : R) : a != 0 ->
   changes p = changes (a *: p).
Proof.
move=> Ha.
rewrite mul_polyC_seqmul //=.
case: p.
elim => [Hs//|b/=].
case => [_ _ |c l IHcl Hs] //=.
  by rewrite !addn0 !mulr0.
rewrite /= in IHcl.
rewrite IHcl //= /seqmul.
apply/eqP.
rewrite eqn_add2r !mulrA (mulrC a) -(mulrA b) -expr2 (mulrC _ (a^+2)) -mulrA
   eq_sym.
by rewrite (@pmulr_rlt0 _ (a ^+2) (b * c)) // exprn_even_gt0.
Qed.

Section thm_3_cercles_partie1.
Local Open Scope complex_scope.

Variables (R : rcfType) (l r : R) (Hlr_le : l < r).

Local Notation C := (complex R).

Local Notation toC := (fun (p : {poly R}) => @map_poly R _ (real_complex R) p).

Lemma HlrC : l%:C != r%:C.
Proof. by rewrite -!complexr0 eq_complex /= negb_and lt_eqF. Qed.

Definition notinC (z : C) :=
  0 <= (Re z) ^+2 - (l + r) * (Re z) + (Im z) ^+2 + r * l.

Lemma notinC_Re_lt0_1 : forall (z : C), z != l%:C ->
  notinC z = (Re ((r%:C - z) / (z - l%:C)) <= 0).
Proof.
case => a b Hab.
rewrite /notinC /=.
simpc.
rewrite !mulrA -(mulNr (b * b) _) -mulrDl
  -expr2 (mulrDl r (-a) _) (mulrC r (a - l)) (mulrC (-a) _) (mulrDl _ _ r)
  (mulrDl _ _ (-a)) mulrNN mulrN -expr2 !addrA (addrC (a * r) _)
  -(addrA _ (a * r) _ ) (addrC (a * r) _ ) (mulrC a r) addrA
  (addrC (- l * r) _ ) -(addrA _ (r * a) (l * a)) -(mulrDl _ _ a)
  -(addrA (- a ^+2) _ _) (addrC (- l * r)) -!addrA (addrC _ (- b^+2))
  !addrA mulNr (mulrC l r) (addrC r l) -oppr_ge0 -[X in (_ = (0 <= X))]mulNr
  !opprD !opprK pmulr_lge0 //.
rewrite invr_gt0 lt_neqAle addr_ge0 ?sqr_ge0 // andbT eq_sym paddr_eq0 ?sqr_ge0 //
   negb_and !sqrf_eq0 subr_eq0.
by rewrite -complexr0 eq_complex negb_and /= in Hab.
Qed.

Lemma notinC_Re_lt0_2 (z : C) : z + 1 != 0 ->
   (notinC ((r%:C + l%:C * z) / (z + 1))) = (Re z <= 0).
Proof.
move=> Hz.
rewrite (@notinC_Re_lt0_1 ((r%:C + l%:C * z) / (z + 1))) /=.
  rewrite -{1}(@mulrK _ (z+1) _ r%:C); last by rewrite unitfE.
  rewrite -(mulNr (r%:C + l%:C * z) _ ) -(mulrDl _ _ (z+1)^-1) mulrDr mulr1
     opprD !addrA addrK -{3}(@mulrK _ (z+1) _ l%:C); last by rewrite unitfE.
  rewrite -(mulNr (l%:C * (z+1)) _ ) -(mulrDl _ _ (z+1)^-1) mulrDr mulr1
     opprD !addrA addrK invrM.
      rewrite invrK !mulrA -(mulrA _ _ (z+1)) (mulrC _ (z+1)) !mulrA mulrK;
          last by rewrite unitfE.
      rewrite -mulNr -mulrDl (mulrC _ z) mulrK //.
      by rewrite unitfE subr_eq0 eq_sym HlrC.
    by rewrite unitfE subr_eq0 eq_sym HlrC.
  by rewrite -unitrV invrK unitfE.
rewrite -subr_eq0 -{2}(@mulrK _ (z + 1) _ l%:C); last by rewrite unitfE.
rewrite -mulNr -mulrDl mulrDr mulr1 opprD addrA addrK mulf_neq0 //.
  by rewrite subr_eq add0r eq_sym HlrC.
by rewrite invr_eq0.
Qed.

(* Theorem 10.47 i. *)
Theorem three_circles_1 (p : {poly R}) :
   (forall (z : C), root (toC p) z -> (notinC z)) ->
   changes (Mobius' p l r) = 0%N.
Proof.
move=> H.
have [/eqP|Hp0] := eqVneq p 0.
  rewrite (@Mobius'0 _ p l r) ?lt_eqF// => /eqP ->.
  by rewrite polyseq0.
rewrite (@changes_mulC R (Mobius' p l r) (lead_coef (Mobius' p l r))^-1).
  apply: monic_roots_changes_eq0 => [ | z Hz].
    by rewrite monicE lead_coefZ mulrC -unitrE unitfE lead_coef_eq0
       -Mobius'0 ?lt_eqF// Hp0.
  case/altP : (z+1 =P 0) => [/eqP Hz2 | Hz2].
    rewrite addr_eq0 eq_complex in Hz2.
    move/andP : Hz2; case => /eqP Hrez _.
    by rewrite Hrez raddfN lerN10.
  rewrite map_polyZ rootZ /= -?root_Mobius'_C_2 // in Hz.
    rewrite -notinC_Re_lt0_2 //.
    apply: H => //.
  rewrite -complexr0 eq_complex /= negb_and eq_refl orbF.
  by rewrite invr_eq0 lead_coef_eq0 -Mobius'0 ?lt_eqF// negbT.
by rewrite invr_eq0 lead_coef_eq0 -Mobius'0 ?lt_eqF// negbT.
Qed.

End thm_3_cercles_partie1.

Section thm_3_cercles_partie2.
Variable R : rcfType.

Local Notation C := (complex R).

Definition inC1 := fun (l r : R) (z : C) =>
  (Re z) ^+2 - (l + r) * (Re z) + (Im z) ^+2 -
  (r - l) * (Im z) / (Num.sqrt 3%:R) + l * r < 0.

Definition inC2 := fun (l r : R) (z : C) =>
  (Re z) ^+2 - (l + r) * (Re z) + (Im z) ^+2 +
  (r - l) * (Im z) / (Num.sqrt 3%:R) + l * r < 0.

Definition inC12 := fun (l r : R) (z : C) =>
  ((Re z) ^+2 - (l + r) * (Re z) + (Im z) ^+2 -
  (r - l) * (Im z) / (Num.sqrt 3%:R) + l * r < 0) ||
  ((Re z) ^+2 - (l + r) * (Re z) + (Im z) ^+2 +
  (r - l) * (Im z) / (Num.sqrt 3%:R) + l * r < 0).

Lemma inC1_or_inC2 (l r : R) (z : C) :
  (inC1 l r z) || (inC2 l r z) = (inC12 l r z).
Proof. by []. Qed.

Definition inB1 (z : C) :=
  (Re z - 1 <= 0) && ((Im z)^+2 <= 3%:R * (Re z - 1) ^+2).

Lemma inB_inB1 : forall (z : C), inB z = inB1 (z + 1).
Proof.
case => a b.
by rewrite /inB1 /= addrK addr0 /inB.
Qed.

Lemma inB1_help : forall (z : C), (inB1 z) =
   (((Num.sqrt 3%:R) * (Re z - 1) - Im z <= 0) &&
     (0 <= - (Num.sqrt 3%:R * (Re z - 1)) - Im z)).
Proof.
case=> a b.
rewrite /inB1 /=.
case/altP : (a - 1 =P 0) => Ha.
  rewrite Ha /= mulr0 oppr0 add0r lexx/= (expr2 0) !mulr0.
  by rewrite -eq_le oppr_eq0 -sqrf_eq0 eq_le sqr_ge0 andbT.
rewrite -{1}(sqr_sqrtr (a:=3%:R)); last by apply: ler0n.
rewrite -exprMn -(ler_sqrt (b^+2)).
  rewrite !sqrtr_sqr normrM (ger0_norm (x := Num.sqrt 3%:R));
    last by apply: sqrtr_ge0.
  apply/idP/idP => /andP [] => H1 H2.
    rewrite -(normrN (a - 1)) (gtr0_norm (x:= - (a - 1))) in H2.
      by rewrite ler_norml mulrN opprK -subr_le0
         -[X in (_ && X)]subr_ge0 in H2.
    by rewrite oppr_gt0 lt_def H1 eq_sym Ha.
  have Hb : `|b| <= Num.sqrt 3%:R * -(a - 1).
    by rewrite ler_norml mulrN opprK -subr_le0 -[X in (_ && X)]subr_ge0 H1 H2.
  have Ha2 : (0 <= - (a - 1)).
    rewrite -(pmulr_lge0 (x:=Num.sqrt 3%:R)); last by rewrite sqrtr_gt0 ltr0n.
    by rewrite mulrC (@le_trans _ _ `| b |).
  by rewrite -oppr_ge0 Ha2 /= -(normrN (a-1)) (ger0_norm (x:= -(a-1))).
rewrite exprMn mulr_gt0 // lt_def sqr_ge0.
  by rewrite sqrf_eq0 sqrtr_eq0 -ltNge ltr0n.
by rewrite sqrf_eq0 Ha.
Qed.

Lemma Re_invc (z : C) : Re z^-1 = Re z / ((Re z) ^+ 2 + (Im z) ^+2).
Proof. by case: z. Qed.

Lemma Im_invc : forall (z : C), Im z^-1 = (- Im z) / ((Re z) ^+ 2 + (Im z) ^+2).
Proof. by case => a b; rewrite mulNr. Qed.

Lemma inB1_notinC1201 : forall (z : C), z != 0 -> inB1 z = ~~ inC12 0 1 (z ^-1).
Proof.
case=> a b Hz.
rewrite -inC1_or_inC2 negb_or inB1_help /=.
have H : a ^+ 2 + b ^+ 2 \is a GRing.unit.
  rewrite eq_complex /= negb_and in Hz.
  case/orP: Hz=> H;
    by rewrite unitfE paddr_eq0 ?sqr_ge0 // negb_and !sqrf_eq0 H ?orbT.
have H3 : (Num.ExtraDef.sqrtr (GRing.natmul (V:=R) (GRing.one R) (3)))
          \is a GRing.unit.
  by rewrite unitfE sqrtr_eq0 -ltNge ltr0n.
rewrite /inC1 /= -leNgt add0r oppr0 mul0r !addr0 !mul1r.
rewrite [x in (0 <= ((x + _) + _))]addrC -[x in (0 <= (x + _))]addrA
   exprMn -(mulNr b) exprMn sqrrN -mulrDl
   (expr2 ((a^+2 + b^+2)^-1)) -{2}(mulr1 (a^+2 + b^+2)) -invrM //
   -mulf_div [x in (0 <= _ + x + _)]mulrC !mulrA (mulrK (x:=(a^+2 + b^+2))) //.
rewrite -[in x in _ = x](mulNr a) -mulrDl.
rewrite -{5}(opprK 1) -(opprD a (- 1)) -mulrA -invrM //.
rewrite -[in x in _ = x]mulNr -(mul1r ( - (a - 1) / (a ^+ 2 + b ^+ 2)))
   -{5}(@mulrK _ (Num.sqrt 3%:R) _ 1) //.
rewrite mul1r mulf_div -mulrDl mulrN -[in x in (_ = x)]opprD.
rewrite /inC2 /= -leNgt add0r oppr0 mul0r !addr0 !mul1r.
rewrite [x in (0 <= ((x + _) + _))]addrC -[x in (0 <= (x + _))]addrA
   exprMn -(mulNr b) exprMn sqrrN -mulrDl
   (expr2 ((a^+2 + b^+2)^-1)) -{3}(mulr1 (a^+2 + b^+2)) -invrM //
   -mulf_div [x in (0 <= _ + x + _)]mulrC !mulrA (mulrK (x:=(a^+2 + b^+2))) //
   -[in x in (_ = _ && x)]mulNr -mulrDl -{8}(opprK 1) -(opprD a (- 1)) -mulrA
   -invrM //.
rewrite -(mul1r ( - (a - 1) / (a ^+ 2 + b ^+ 2)))
    -{8}(@mulrK _ (Num.sqrt 3%:R) _ 1) //.
rewrite mul1r mulf_div -mulrDl mulNr oppr_ge0 pmulr_lge0.
  rewrite pmulr_lle0 ?mulrN //.
  by rewrite invr_gt0 lt_def -unitfE unitrM H H3 /= mulr_ge0 // ?sqrtr_ge0 //
     addr_ge0 // sqr_ge0.
by rewrite invr_gt0 lt_def -unitfE unitrM H H3 /= mulr_ge0 // ?sqrtr_ge0 //
     addr_ge0 // sqr_ge0.
Qed.

Local Open Scope complex_scope.

Lemma notinC1201_lr_scale (l r : R) : forall (z : C), l != r ->
   ~~ inC12 0 1 z = ~~ inC12 0 (r - l) ((r - l)%:C * z).
Proof.
case=> a b Hlr.
rewrite !/inC12. simpc. rewrite /=.
rewrite !exprMn !(mulrA (r - l) _ a) !(mulrA (r - l) _ b)
   -expr2 -(mulrN _ a) -mulrA -(mulrN _ (b / Num.sqrt 3%:R))
    -!(mulrDr ((r - l)^+2)) !negb_or -!leNgt.
by rewrite !pmulr_rge0 // lt_def sqr_ge0 sqrf_eq0 subr_eq0 eq_sym Hlr.
Qed.

Lemma notinC12lr_shift (l r : R) : forall (z : C), l != r ->
  ~~ inC12 0 (r - l) z = ~~ inC12 l r (z + l%:C).
Proof.
case=> a b Hlr.
rewrite !/inC12. simpc. rewrite /= !negb_or -!leNgt.
by rewrite (expr2 (a+l)) (mulrDl a l) !mulrDr (mulrDl l r)
   (mulrDl l  r) -!expr2 !opprD
   [l * a + _]addrC !addrA addrK -(addrA _ (- (r * a)) _)
   (addrC (- (r * a)) _) !addrA addrK -(addrA _ (a * l) _)
   (addrC (a * l)) (mulrC a l) -{5 9}(opprK l) mulNr -opprD
   -mulrDl [X in (_ = (0 <= X) && _)]addrC [X in (_ = _ && (0 <= X))]addrC
   !addrA (addrC (l * r)) -(addrA _ (l * r) _)
   (addrC (l * r)) (mulrC l r) !addrA addrK.
Qed.

Lemma inB_notinC12 (l r : R) (z : C) : l != r -> z + 1 != 0 ->
  inB z = ~~ inC12 l r ((r%:C + l%:C * z) / (z + 1)).
Proof.
move=> Hlr Hz.
have H : (r%:C + l%:C * z) / (z + 1) = ((r - l)%:C / (z + 1) + l%:C).
  rewrite -{2}[l%:C](@mulrK _ (z + 1)); last by rewrite unitfE.
  by rewrite -mulrDl {2}[z+1]addrC mulrDr mulr1 rmorphB /= !addrA addrNK.
by rewrite H -notinC12lr_shift // -notinC1201_lr_scale //
   -inB1_notinC1201 // -inB_inB1.
Qed.

Lemma changes_nseq : forall (s : seq R) (a : R), a != 0 ->
  changes (seqmul (nseq (size s) a) s) = changes s.
Proof.
elim => [ | c l IHl a Ha] //.
case : l IHl => [IH |b l IHbl ] //.
  by rewrite /= !mulr0 addn0.
have -> : (changes [::c, b & l]) = ((c * b < 0)%R + changes [:: b & l])%N.
  by [].
rewrite -(IHbl a) //.
suff : ((a * c) * (a * b) < 0) = (c * b < 0) by move=> <-.
rewrite (mulrC a b) -mulrA (mulrC a) -!mulrA -expr2 mulrA.
by rewrite pmulr_llt0 // exprn_even_gt0.
Qed.

Lemma seqn0_nseq : forall (s : seq R) (a : R), a != 0 ->
  seqmul (nseq (size (seqn0 s)) a) (seqn0 s) =
  seqn0 (seqmul (nseq (size s) a) s).
Proof.
elim => [ | c l IHl a Ha] //.
case Hc : (c != 0).
  have Hac : a * c != 0 by apply: mulf_neq0.
  by rewrite seqmul_cons /= Hac /= Hc /= seqmul_cons /= -IHl.
have Hac : (a * c != 0) = false by rewrite mulf_eq0 negb_or Ha Hc.
by rewrite seqmul_cons /= Hc /= Hac /= IHl.
Qed.

Lemma inBneg1 : @inB R (-1).
Proof.
by rewrite /inB !raddfN lerN10 /= oppr0 sqrrN !expr2 mulr0 !mulr1 ler0n.
Qed.

Local Notation toC := (fun (p : {poly R}) => @map_poly R _ (real_complex R) p).

(* (~~ root p r) because of (~~ root (Mobius p l r) 0) *)
Theorem three_circles_2 (l r : R) (p : {poly R}) (a : R) :
  ~~ root p r -> l < a < r -> ~~ root p a ->
  (forall z : C, root (toC p) z -> ~~ inC12 l r z) ->
  changes (seqn0 (Mobius' (p * ('X - a%:P)) l r)) = 1%N.
Proof.
move=> Hpnorootr /andP [] Hal Har Hpnoroota H.
have Hlr : l != r by rewrite lt_eqF// (lt_trans Hal).
have Hal2 : l != a by rewrite negbT // lt_eqF.
have [Hp|Hp] := eqVneq p 0.
  have : false => //.
    by rewrite -(andbN (root p a)) Hpnoroota Hp root0.
have Hlc1 : (lead_coef (Mobius' (R:=R) (p * ('X - a%:P)) l r))^-1 != 0.
  rewrite invr_neq0 // Mobius'M lead_coefM mulf_neq0 //;
  rewrite lead_coef_eq0 -Mobius'0 // negbT //.
  exact: polyXsubC_eq0.
have Hl2 : lead_coef (Mobius' p l r) != 0 by rewrite lead_coef_eq0 -Mobius'0.
rewrite -(@changes_nseq _
   (lead_coef (Mobius' (p * ('X - a%:P)) l r)) ^-1) //
    seqn0_nseq // -mul_polyC_seqmul //.
rewrite Mobius'M lead_coefM -mul_polyC invrM ?unitfE; [ | by [] |]; last first.
  by rewrite lead_coef_eq0 -Mobius'0 // negbT // polyXsubC_eq0.
rewrite rmorphM /= mulrA mulrC !mulrA
     (mulrC (Mobius' ('X - a%:P) _ _) _)
     mul_polyC -mulrA mul_polyC mulrC
     [in X in (changes (R:=R) (seqn0 (polyseq (_ * X))))]
     (@Mobius'_Xsubc_monic R a l r Hlr Hal2)
     -(opprK ((r - a) / (l - a))%:P) -polyCN.
  apply: normal_changes.
    by rewrite oppr_gt0 pmulr_rlt0 ?invr_lt0 ?subr_lt0 // subr_gt0.
  apply: normal_root_inB => [ | z Hz].
    rewrite monicE lead_coef_lreg.
      by rewrite mulrC -unitrE unitfE.
    exact/lregP/invr_neq0.
  have [/eqP Hz2|Hz2] := eqVneq (z + 1) 0.
    rewrite addr_eq0 in Hz2.
    by rewrite (eqP Hz2) inBneg1.
  rewrite (inB_notinC12 Hlr) //.
  rewrite -mul_polyC rmorphM /= map_polyC mul_polyC rootZ in Hz.
  apply: H.
    by rewrite root_Mobius'_C_2.
  by rewrite /= eq_complex negb_and/= invr_neq0.
rewrite rootZ.
  rewrite -root_Mobius'_2; last by rewrite add0r oner_neq0.
  by rewrite mulr0 addr0 add0r invr1 mulr1.
exact: invr_neq0.
Qed.

End thm_3_cercles_partie2.


(* Author: Masaki Hara, 2014 *)
(* Linear Logic Toy for Coq *)
Require Import LType.

(*************************************************)
(*                    Examples                   *)
(*************************************************)

Example LTensorPlusDistr{E:LEnv} (A B C:LType) :
  ILL |- A * (B + C) o-o A * B + A * C.
Proof.
  splitll.
  - introsll x.
    destructll x as [x y].
    destructll y as [y | y].
    + leftll.
      splitll carrying x into 1.
      * applyll x.
      * applyll y.
    + rightll.
      splitll carrying y into 2.
      * applyll x.
      * applyll y.
  - introsll x.
    destructll x as [x | x].
    + destructll x as [x y].
      splitll carrying x into 1.
      * applyll x.
      * leftll; applyll y.
    + destructll x as [x y].
      splitll carrying x into 1; [applyll x|].
      rightll; applyll y.
Defined.

Example LOfcExponentialLaw{E:LEnv} (A B:LType) :
  ILL |- !(A && B) o-o !A * !B.
Proof.
  splitll.
  - introsll x.
    clonell x into y.
    splitll carrying x into 1.
    + splitll.
      destructll x as [x].
      destructll x as [x _].
      applyll x.
    + splitll.
      destructll y as [y].
      destructll y as [_ y].
      applyll y.
  - introsll x.
    destructll x as [x y].
    splitll.
    splitll.
    + clearll y.
      destructll x as [x].
      applyll x.
    + clearll x.
      destructll y as [y].
      applyll y.
Defined.


(** * Induction: Proof by Induction *)

(** The next line imports all of our definitions from the
    previous chapter. *)

Require Export Basics.

(** For it to work, you need to use [coqc] to compile [Basics.v]
    into [Basics.vo].  This is like making a .class file from a .java
    file, or a .o file from a .c file.

    Here are two ways to compile your code:

     - In CoqIDE:

         Open [Basics.v].
         In the "Compile" menu, click on "Compile Buffer".

     - From the command line:

         Run [coqc Basics.v]

    *)

(* ###################################################################### *)
(** * Proof by Induction *)

(** We proved in the last chapter that [0] is a neutral element
    for [+] on the left using an easy argument based on
    simplification.  The fact that it is also a neutral element on the
    _right_... *)

Theorem plus_n_O_firsttry : forall n:nat,
  n = n + 0.

(** ... cannot be proved in the same simple way.  Just applying
  [reflexivity] doesn't work, since the [n] in [n + 0] is an arbitrary
  unknown number, so the [match] in the definition of [+] can't be
  simplified.  *)

Proof.
  intros n.
  simpl. (* Does nothing! *)
Abort.

(** And reasoning by cases using [destruct n] doesn't get us much
   further: the branch of the case analysis where we assume [n = 0]
   goes through fine, but in the branch where [n = S n'] for some [n'] we
   get stuck in exactly the same way.  We could use [destruct n'] to
   get one step further, but, since [n] can be arbitrarily large, if we
   try to keep on like this we'll never be done. *)

Theorem plus_n_O_secondtry : forall n:nat,
  n = n + 0.
Proof.
  intros n. destruct n as [| n'].
  - (* n = 0 *)
    reflexivity. (* so far so good... *)
  - (* n = S n' *)
    simpl.       (* ...but here we are stuck again *)
Abort.

(** To prove interesting facts about numbers, lists, and other
    inductively defined sets, we usually need a more powerful
    reasoning principle: _induction_.

    Recall (from high school, a discrete math course, etc.) the
    principle of induction over natural numbers: If [P(n)] is some
    proposition involving a natural number [n] and we want to show
    that [P] holds for _all_ numbers [n], we can reason like this:
         - show that [P(O)] holds;
         - show that, for any [n'], if [P(n')] holds, then so does
           [P(S n')];
         - conclude that [P(n)] holds for all [n].

    In Coq, the steps are the same but the order is backwards: we
    begin with the goal of proving [P(n)] for all [n] and break it
    down (by applying the [induction] tactic) into two separate
    subgoals: first showing [P(O)] and then showing [P(n') -> P(S
    n')].  Here's how this works for the theorem at hand: *)

Theorem plus_n_O : forall n:nat, n = n + 0.
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)    reflexivity.
  - (* n = S n' *) simpl. rewrite <- IHn'. reflexivity.  Qed.

(** Like [destruct], the [induction] tactic takes an [as...]
    clause that specifies the names of the variables to be introduced
    in the subgoals.  In the first branch, [n] is replaced by [0] and
    the goal becomes [0 + 0 = 0], which follows by simplification.  In
    the second, [n] is replaced by [S n'] and the assumption [n' + 0 =
    n'] is added to the context (with the name [IHn'], i.e., the
    Induction Hypothesis for [n'] -- notice that this name is
    explicitly chosen in the [as...] clause of the call to [induction]
    rather than letting Coq choose one arbitrarily). The goal in this
    case becomes [(S n') + 0 = S n'], which simplifies to [S (n' + 0)
    = S n'], which in turn follows from [IHn']. *)

Theorem minus_diag : forall n,
  minus n n = 0.
Proof.
  (* WORKED IN CLASS *)
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

(** **** Exercise: 2 stars, recommended (basic_induction)  *)
(** Prove the following using induction. You might need previously
    proven results. *)

Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_n_Sm : forall n m : nat,
  S (n + m) = n + (S m).
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars (double_plus)  *)
(** Consider the following function, which doubles its argument: *)

Fixpoint double (n:nat) :=
  match n with
  | O => O
  | S n' => S (S (double n'))
  end.

(** Use induction to prove this simple fact about [double]: *)

Lemma double_plus : forall n, double n = n + n .
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (evenb_S)  *)
(** One inconveninent aspect of our definition of [evenb n] is that it
    may need to perform a recursive call on [n - 2]. This makes proofs
    about [evenb n] harder when done by induction on [n], since we may
    need an induction hypothesis about [n - 2]. The following lemma
    gives a better characterization of [evenb (S n)]: *)

Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (destruct_induction)  *)
(** Briefly explain the difference between the tactics
    [destruct] and [induction].

(* FILL IN HERE *)

*)
(** [] *)

(* ###################################################################### *)
(** * Proofs Within Proofs *)

(** In Coq, as in informal mathematics, large proofs are often
    broken into a sequence of theorems, with later proofs referring to
    earlier theorems.  But sometimes a proof will require some
    miscellaneous fact that is too trivial and of too little general
    interest to bother giving it its own top-level name.  In such
    cases, it is convenient to be able to simply state and prove the
    needed "sub-theorem" right at the point where it is used.  The
    [assert] tactic allows us to do this.  For example, our earlier
    proof of the [mult_0_plus] theorem referred to a previous theorem
    named [plus_O_n].  We could instead use [assert] to state and
    prove [plus_O_n] in-line: *)

Theorem mult_0_plus' : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  assert (H: 0 + n = n). { reflexivity. }
  rewrite -> H.
  reflexivity.  Qed.

(** The [assert] tactic introduces two sub-goals.  The first is
    the assertion itself; by prefixing it with [H:] we name the
    assertion [H].  (We can also name the assertion with [as] just as
    we did above with [destruct] and [induction], i.e., [assert (0 + n
    = n) as H].)  Note that we surround the proof of this assertion
    with curly braces [{ ... }], both for readability and so that,
    when using Coq interactively, we can see more easily when we have
    finished this sub-proof.  The second goal is the same as the one
    at the point where we invoke [assert] except that, in the context,
    we now have the assumption [H] that [0 + n = n].  That is,
    [assert] generates one subgoal where we must prove the asserted
    fact and a second subgoal where we can use the asserted fact to
    make progress on whatever we were trying to prove in the first
    place. *)

(** The [assert] tactic is handy in many sorts of situations.  For
    example, suppose we want to prove that [(n + m) + (p + q) = (m +
    n) + (p + q)]. The only difference between the two sides of the
    [=] is that the arguments [m] and [n] to the first inner [+] are
    swapped, so it seems we should be able to use the commutativity of
    addition ([plus_comm]) to rewrite one into the other.  However,
    the [rewrite] tactic is a little stupid about _where_ it applies
    the rewrite.  There are three uses of [+] here, and it turns out
    that doing [rewrite -> plus_comm] will affect only the _outer_
    one... *)

Theorem plus_rearrange_firsttry : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  (* We just need to swap (n + m) for (m + n)...
     it seems like plus_comm should do the trick! *)
  rewrite -> plus_comm.
  (* Doesn't work...Coq rewrote the wrong plus! *)
Abort.

(** To get [plus_comm] to apply at the point where we want it to, we
    can introduce a local lemma stating that [n + m = m + n] (for the
    particular [m] and [n] that we are talking about here), prove this
    lemma using [plus_comm], and then use it to do the desired
    rewrite. *)

Theorem plus_rearrange : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  assert (H: n + m = m + n).
  { rewrite -> plus_comm. reflexivity. }
  rewrite -> H. reflexivity.  Qed.

(* ###################################################################### *)
(** * More Exercises *)

(** **** Exercise: 3 stars, recommended (mult_comm)  *)
(** Use [assert] to help prove this theorem.  You shouldn't need to
    use induction. *)

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* FILL IN HERE *) Admitted.

(** Now prove commutativity of multiplication.  (You will probably
    need to define and prove a separate subsidiary theorem to be used
    in the proof of this one.  You may find that [plus_swap] comes in
    handy.) *)

Theorem mult_comm : forall m n : nat,
  m * n = n * m.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, optional (more_exercises)  *)
(** Take a piece of paper.  For each of the following theorems, first
    _think_ about whether (a) it can be proved using only
    simplification and rewriting, (b) it also requires case
    analysis ([destruct]), or (c) it also requires induction.  Write
    down your prediction.  Then fill in the proof.  (There is no need
    to turn in your piece of paper; this is just to encourage you to
    reflect before you hack!) *)

Theorem leb_refl : forall n:nat,
  true = leb n n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem zero_nbeq_S : forall n:nat,
  beq_nat 0 (S n) = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_ble_compat_l : forall n m p : nat,
  leb n m = true -> leb (p + n) (p + m) = true.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem S_nbeq_0 : forall n:nat,
  beq_nat (S n) 0 = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem all3_spec : forall b c : bool,
    orb
      (andb b c)
      (orb (negb b)
               (negb c))
  = true.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  (* FILL IN HERE *) Admitted.

Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (beq_nat_refl)  *)
(** Prove the following theorem.  (Putting the [true] on the left-hand
    side of the equality may look odd, but this is how the theorem is
    stated in the Coq standard library, so we follow suit.  Rewriting
    works equally well in either direction, so we will have no problem
    using the theorem no matter which way we state it.) *)

Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (plus_swap')  *)
(** The [replace] tactic allows you to specify a particular subterm to
   rewrite and what you want it rewritten to: [replace (t) with (u)]
   replaces (all copies of) expression [t] in the goal by expression
   [u], and generates [t = u] as an additional subgoal. This is often
   useful when a plain [rewrite] acts on the wrong part of the goal.

   Use the [replace] tactic to do a proof of [plus_swap'], just like
   [plus_swap] but without needing [assert (n + m = m + n)].
*)

Theorem plus_swap' : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, recommended (binary_commute)  *)
(** Recall the [increment] and [binary-to-unary] functions that you
    wrote for the [binary] exercise in the [Basics] chapter.  Prove
    that these functions commute -- that is, incrementing a binary
    number and then converting it to unary yields the same result as
    first converting it to unary and then incrementing.
    Name your theorem [bin_to_nat_pres_incr].

    Before you start working on this exercise, please copy the
    definitions from your solution to the [binary] exercise here so
    that this file can be graded on its own.  If you find yourself
    wanting to change your original definitions to make the property
    easier to prove, feel free to do so! *)

(* FILL IN HERE *)
(** [] *)

(** **** Exercise: 5 stars, advanced (binary_inverse)  *)
(** This exercise is a continuation of the previous exercise about
    binary numbers.  You will need your definitions and theorems from
    there to complete this one.

    (a) First, write a function to convert natural numbers to binary
        numbers.  Then prove that starting with any natural number,
        converting to binary, then converting back yields the same
        natural number you started with.

    (b) You might naturally think that we should also prove the
        opposite direction: that starting with a binary number,
        converting to a natural, and then back to binary yields the
        same number we started with.  However, this is not true!
        Explain what the problem is.

    (c) Define a "direct" normalization function -- i.e., a function
        [normalize] from binary numbers to binary numbers such that,
        for any binary number b, converting to a natural and then back
        to binary yields [(normalize b)].  Prove it.  (Warning: This
        part is tricky!)

    Again, feel free to change your earlier definitions if this helps
    here.
*)

(* FILL IN HERE *)
(** [] *)

(* ###################################################################### *)
(** * Formal vs. Informal Proof (Optional) *)

(** "Informal proofs are algorithms; formal proofs are code." *)

(** The question of what constitutes a proof of a mathematical
    claim has challenged philosophers for millennia, but a rough and
    ready definition could be this: A proof of a mathematical
    proposition [P] is a written (or spoken) text that instills in the
    reader or hearer the certainty that [P] is true.  That is, a proof
    is an act of communication.

    Acts of communication may involve different sorts of readers.  On
    one hand, the "reader" can be a program like Coq, in which case
    the "belief" that is instilled is that [P] can be mechanically
    derived from a certain set of formal logical rules, and the proof
    is a recipe that guides the program in checking this fact.  Such
    recipes are _formal_ proofs.

    Alternatively, the reader can be a human being, in which case the
    proof will be written in English or some other natural language,
    and will thus necessarily be _informal_.  Here, the criteria for
    success are less clearly specified.  A "valid" proof is one that
    makes the reader believe [P].  But the same proof may be read by
    many different readers, some of whom may be convinced by a
    particular way of phrasing the argument, while others may not be.
    Some readers may be particularly pedantic, inexperienced, or just
    plain thick-headed; the only way to convince them will be to make
    the argument in painstaking detail.  But other readers, more
    familiar in the area, may find all this detail so overwhelming
    that they lose the overall thread; all they want is to be told the
    main ideas, since it is easier for them to fill in the details for
    themselves than to wade through a written presentation of them.
    Ultimately, there is no universal standard, because there is no
    single way of writing an informal proof that is guaranteed to
    convince every conceivable reader.

    In practice, however, mathematicians have developed a rich set of
    conventions and idioms for writing about complex mathematical
    objects that -- at least within a certain community -- make
    communication fairly reliable.  The conventions of this stylized
    form of communication give a fairly clear standard for judging
    proofs good or bad.

    Because we are using Coq in this course, we will be working
    heavily with formal proofs.  But this doesn't mean we can
    completely forget about informal ones!  Formal proofs are useful
    in many ways, but they are _not_ very efficient ways of
    communicating ideas between human beings. *)

(** For example, here is a proof that addition is associative: *)

Theorem plus_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof. intros n m p. induction n as [| n' IHn']. reflexivity.
  simpl. rewrite -> IHn'. reflexivity.  Qed.

(** Coq is perfectly happy with this.  For a human, however, it
    is difficult to make much sense of it.  We can use comments and
    bullets to show the structure a little more clearly... *)

Theorem plus_assoc'' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p. induction n as [| n' IHn'].
  - (* n = 0 *)
    reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.   Qed.

(** ... and if you're used to Coq you may be able to step
    through the tactics one after the other in your mind and imagine
    the state of the context and goal stack at each point, but if the
    proof were even a little bit more complicated this would be next
    to impossible.

    A (pedantic) mathematician might write the proof something like
    this: *)
(** - _Theorem_: For any [n], [m] and [p],
      n + (m + p) = (n + m) + p.
    _Proof_: By induction on [n].

    - First, suppose [n = 0].  We must show
        0 + (m + p) = (0 + m) + p.
      This follows directly from the definition of [+].

    - Next, suppose [n = S n'], where
        n' + (m + p) = (n' + m) + p.
      We must show
        (S n') + (m + p) = ((S n') + m) + p.
      By the definition of [+], this follows from
        S (n' + (m + p)) = S ((n' + m) + p),
      which is immediate from the induction hypothesis.  _Qed_. *)

(** The overall form of the proof is basically similar, and of
    course this is no accident: Coq has been designed so that its
    [induction] tactic generates the same sub-goals, in the same
    order, as the bullet points that a mathematician would write.  But
    there are significant differences of detail: the formal proof is
    much more explicit in some ways (e.g., the use of [reflexivity])
    but much less explicit in others (in particular, the "proof state"
    at any given point in the Coq proof is completely implicit,
    whereas the informal proof reminds the reader several times where
    things stand). *)

(** **** Exercise: 2 stars, advanced, recommended (plus_comm_informal)  *)
(** Translate your solution for [plus_comm] into an informal proof. *)

(** Theorem: Addition is commutative.

    Proof: (* FILL IN HERE *)
*)
(** [] *)

(** **** Exercise: 2 stars, optional (beq_nat_refl_informal)  *)
(** Write an informal proof of the following theorem, using the
    informal proof of [plus_assoc] as a model.  Don't just
    paraphrase the Coq tactics into English!

    Theorem: [true = beq_nat n n] for any [n].

    Proof: (* FILL IN HERE *)
[] *)

(** $Date: 2016-01-15 17:30:08 -0500 (Fri, 15 Jan 2016) $ *)


(*
MacBook-Air:~ billw$ /Applications/CoqIDE_8.4pl5.app/Contents/Resources/bin/coqtop
Welcome to Coq 8.4pl5 (October 2014)

Coq < Require Import Classical.

Coq < Section Exercise_13.

Coq < Goal forall f a l d:Prop, (~(f /\ a) /\ ~(l \/ ~a) /\ (d -> (f \/ l))) -> (~d).
1 subgoal

  ============================
   forall f a l d : Prop, ~ (f /\ a) /\ ~ (l \/ ~ a) /\ (d -> f \/ l) -> ~ d

Unnamed_thm < intros.
1 subgoal

  f : Prop
  a : Prop
  l : Prop
  d : Prop
  H : ~ (f /\ a) /\ ~ (l \/ ~ a) /\ (d -> f \/ l)
  ============================
   ~ d

Unnamed_thm < elim H.
1 subgoal

  f : Prop
  a : Prop
  l : Prop
  d : Prop
  H : ~ (f /\ a) /\ ~ (l \/ ~ a) /\ (d -> f \/ l)
  ============================
   ~ (f /\ a) -> ~ (l \/ ~ a) /\ (d -> f \/ l) -> ~ d

Unnamed_thm < intro.
1 subgoal

  f : Prop
  a : Prop
  l : Prop
  d : Prop
  H : ~ (f /\ a) /\ ~ (l \/ ~ a) /\ (d -> f \/ l)
  H0 : ~ (f /\ a)
  ============================
   ~ (l \/ ~ a) /\ (d -> f \/ l) -> ~ d

Unnamed_thm < intro.
1 subgoal

  f : Prop
  a : Prop
  l : Prop
  d : Prop
  H : ~ (f /\ a) /\ ~ (l \/ ~ a) /\ (d -> f \/ l)
  H0 : ~ (f /\ a)
  H1 : ~ (l \/ ~ a) /\ (d -> f \/ l)
  ============================
   ~ d

Unnamed_thm < firstorder.
No more subgoals.

Unnamed_thm < Qed.
intros.
elim H.
intro.
intro.
firstorder .

Unnamed_thm is defined

Coq <

*)

Require Import Classical.
Section Exercise_13.
Goal forall f a l d:Prop, (~(f /\ a) /\ ~(l \/ ~a) /\ (d -> (f \/ l))) -> (~d).
intros.
elim H.
intro.
intro.
 firstorder .
 Qed.


Require Import aes.api_specs.
Require Import aes.partially_filled.
Require Import aes.bitfiddling.
Open Scope Z.

(* Note: x must be non-zero, y is allowed to be zero (because x is a constant in all usages, its
   non-zero-check seems to be removed by the parser). *)
Definition mul_with_table(x y: Z)(pow: list int)(log: list Z): int :=
  if Int.eq (if Int.eq (Int.repr y) Int.zero then Int.zero else Int.one) Int.zero
  then Int.zero
  else Znth (Int.unsigned
               (Int.mods (Int.repr (Znth x log 0 + Znth y log 0))
                  (Int.repr 255))) pow Int.zero.

Lemma mul_equiv: forall (x y: Z) (pow : list int) (log : list Z),
  (forall j : Z, 0 <= j < 256 -> Znth j pow Int.zero = pow3 j) ->
  Zlength pow = 256 ->
  (forall j : Z, 1 <= j < 256 -> Znth j log 0 = log3 (Int.repr j)) ->
  Zlength log = 256 ->
  1 <= x < 256 ->
  0 <= y < 256 ->
  mul_with_table x y pow log = mul (Int.repr x) (Int.repr y).
Proof.
  intros x y pow log Hpow Lpow Hlog Llop Bx By.
  unfold mul_with_table, mul.
  assert (y = 0 \/ 1 <= y < 256) as Cy by omega; destruct Cy as [Cy | Cy];
  subst; simpl.
  - destruct (Int.eq (Int.repr x)); reflexivity.
  - rewrite (Hlog _ Bx). rewrite (Hlog _ Cy).
    destruct (Int.eq (Int.repr x)) eqn: D.
    + apply int_eq_e in D. change Int.zero with (Int.repr 0) in D.
      apply repr_inj_unsigned in D; repable_signed.
    + destruct (Int.eq (Int.repr y) Int.zero).
      * reflexivity.
      * simpl.
        assert (forall j : Z, 0 <= j < 255 -> Znth j pow Int.zero = pow3 j) as Hpow'. {
          intros. apply Hpow. omega.
        }
        rewrite Hpow'; [ reflexivity | apply mod_range ]; try omega.
        pose proof (log3range x). pose proof (log3range y). omega.
Qed.

Definition Z_to_val(x: Z): val := if zeq x (-1) then Vundef else Vint (Int.repr x).

Lemma Z_to_val_to_Vint: forall j,
  j <> -1 ->
  Z_to_val j = Vint (Int.repr j).
Proof.
  intros. unfold Z_to_val. destruct (zeq j (-1)) as [E | E]. omega. reflexivity.
Qed.

(* Calls forward_if with the current precondition to which the provided conditions are added *)
(* QQQ TODO does this already exist? Add to library? *)
Ltac forward_if_diff add := match add with
| (PROPx ?P2 (LOCALx ?Q2 (SEPx ?R2))) => match goal with
  | |- semax ?Delta (PROPx ?P1 (LOCALx ?Q1 (SEPx ?R1))) _ _ =>
    let P3 := fresh "P3" in let Q3 := fresh "Q3" in let R3 := fresh "R3" in
    pose (P3 := P1 ++ P2); pose (Q3 := Q1 ++ Q2); pose (R3 := R1 ++ R2);
    simpl in P3, Q3, R3;
    forward_if (PROPx P3 (LOCALx Q3 (SEPx R3)));
    subst P3 Q3 R3
  end
end.

(* TODO floyd this lemma should be invoked by entailer!
   Note: in summaray, this already works for data_at, but why doesn't it work for field_at?
   QQQ: And why/how does it work for data_at? *)
Lemma field_at_update_val: forall sh t gfs v v' p,
  v = v' -> field_at sh t gfs v p |-- field_at sh t gfs v' p.
Proof.
  intros. rewrite H. apply derives_refl.
Qed.

Lemma mod255_condition: forall b,
  is_true (negb (b && Int.eq (Int.repr 255) Int.mone)).
Proof.
  intros. unfold is_true, negb.
  destruct (Int.eq (Int.repr 255) Int.mone) eqn: E.
  - discriminate.
  - rewrite andb_false_r. exact I.
Qed.

Definition rcon_loop_inv00(i: Z)(lvar0 lvar1 tables: val)(frozen: list mpred) : environ -> mpred :=
     PROP ( 0 <= i) (* note: the upper bound is added by the tactic, but the lower isn't! *)
     LOCAL (temp _x (Vint (pow2 i));
            lvar _log (tarray tint 256) lvar1;
            lvar _pow (tarray tint 256) lvar0;
            gvar _tables tables)
     SEP (FRZL frozen;
          field_at Ews t_struct_tables [StructField _RCON]
                   ((map Vint (repeat_op_table i Int.one times2)) ++ (repeat_op_table (10-i) Vundef id))
                   tables).

Definition rcon_loop_inv0(lvar0 lvar1 tables: val)(frozen: list mpred) :=  EX i: Z,
  rcon_loop_inv00 i lvar0 lvar1 tables frozen.

(* TODO floyd if I inline inv00 into inv0, why doesn't this typecheck?
Definition rcon_loop_inv(lvar0 lvar1 tables: val) :=
  EX i: Z,
     PROP ( 0 <= i) (* note: the upper bound is added by the tactic, but the lower isn't! *)
     LOCAL (temp _x (Vint (pow2 i));
            lvar _log (tarray tint 256) lvar1;
            lvar _pow (tarray tint 256) lvar0;
            gvar _tables tables)
     SEP (field_at Ews t_struct_tables [StructField _RCON]
                   ((map Vint (repeat_op_table i Int.one times2)) ++ (repeat_op_table (10-i) Vundef id))
                   tables).
*)

Definition gen_sbox_inv00 i lvar0 lvar1 tables log pow frozen :=
    PROP ( )
    LOCAL (lvar _log (tarray tint 256) lvar1;
           lvar _pow (tarray tint 256) lvar0;
           gvar _tables tables)
    SEP (FRZL frozen; data_at Tsh (tarray tint 256) log lvar1; data_at Tsh (tarray tint 256) pow lvar0;
         EX fsb : list val,
           !!(Zlength fsb = 256) &&
           !!(forall j, 0 <= j < i -> Znth j fsb Vundef = Vint (Znth j FSb Int.zero)) &&
           !!(Znth 0 fsb Vundef = Vint (Int.repr 99))
           && field_at Ews t_struct_tables [StructField _FSb] fsb tables;
         EX rsb : list val,
           !!(Zlength rsb = 256) &&
           !!(forall j, 1 <= j < i ->
                (Znth (Int.unsigned (Znth j FSb Int.zero)) rsb Vundef) = Vint (Int.repr j)) &&
           !!(Znth 99 rsb Vundef = Vint Int.zero)
           && field_at Ews t_struct_tables [StructField _RSb] rsb tables).

Definition gen_sbox_inv0 lvar0 lvar1 tables log pow frozen :=
  EX i: Z, gen_sbox_inv00 i lvar0 lvar1 tables log pow frozen.

(* TODO floyd put in sublist? *)
Lemma list_equiv: forall {T: Type} (l1 l2: list T) (d: T) (n: Z),
  Zlength l1 = n ->
  Zlength l2 = n ->
  (forall j, 0 <= j < n -> Znth j l1 d = Znth j l2 d) ->
  l1 = l2.
Proof.
  intros T l1. induction l1; intros.
  - cbv in H. subst n. apply Zlength_nil_inv in H0. subst l2. reflexivity.
  - rewrite Zlength_cons in H.
    pose proof (Zlength_nonneg l1).
    rename a into a1. destruct l2 as [ | a2 l2 ].
    * cbv in H0. subst n. omega.
    * f_equal.
      + assert (0 <= 0 < n) as B by omega. specialize (H1 0 B). cbv in H1. assumption.
      + rewrite Zlength_cons in H0. apply (IHl1 l2 d (n-1)); try omega.
        intros. assert (0 <= (j+1) < n) as B by omega. specialize (H1 (j+1) B).
        do 2 rewrite Znth_pos_cons in H1 by omega.
        replace (j + 1 - 1) with j in H1 by omega.
        assumption.
Qed.

Definition gen_ftrt_inv00 i lvar0 lvar1 tables log pow :=
    PROP ( )
    LOCAL (lvar _log (tarray tint 256) lvar1;
           lvar _pow (tarray tint 256) lvar0;
           gvar _tables tables)
    SEP (data_at Tsh (tarray tint 256) pow lvar0;
         data_at Tsh (tarray tint 256) log lvar1;
         field_at Ews t_struct_tables [StructField _FSb] (map Vint FSb) tables;
         field_at Ews t_struct_tables [StructField _FT0] (partially_filled i 256 calc_FT0) tables;
         field_at Ews t_struct_tables [StructField _FT1] (partially_filled i 256 calc_FT1) tables;
         field_at Ews t_struct_tables [StructField _FT2] (partially_filled i 256 calc_FT2) tables;
         field_at Ews t_struct_tables [StructField _FT3] (partially_filled i 256 calc_FT3) tables;
         field_at Ews t_struct_tables [StructField _RSb] (map Vint RSb) tables;
         field_at Ews t_struct_tables [StructField _RT0] (partially_filled i 256 calc_RT0) tables;
         field_at Ews t_struct_tables [StructField _RT1] (partially_filled i 256 calc_RT1) tables;
         field_at Ews t_struct_tables [StructField _RT2] (partially_filled i 256 calc_RT2) tables;
         field_at Ews t_struct_tables [StructField _RT3] (partially_filled i 256 calc_RT3) tables;
         field_at Ews t_struct_tables [StructField _RCON] (map Vint RCON) tables).

Definition gen_ftrt_inv0 lvar0 lvar1 tables log pow :=
  EX i: Z, gen_ftrt_inv00 i lvar0 lvar1 tables log pow.

Lemma body_gen_tables: semax_body Vprog Gprog f_aes_gen_tables gen_tables_spec.
Proof.
  start_function.
  reassoc_seq.
  (* DONE floyd: Thanks to reassoc_seq, we don't need the two preparation steps any more *)
  forward_for_simple_bound 256 (EX i: Z,
    PROP ( 0 <= i ) (* TODO floyd: why do we only get "Int.min_signed <= i < 256", instead of lo=0 ?
                       Probably because there are 2 initialisations in the for-loop... *)
    LOCAL (temp _x (Vint (pow3 i));
        (* TODO documentation should say that I don't need to do this *)
        (* TODO floyd: tactic should tell me so *)
        (* temp _i (Vint (Int.repr i)); *)
           lvar _log (tarray tint 256) lvar1;
           lvar _pow (tarray tint 256) lvar0;
           gvar _tables tables)
    SEP (EX log : list val,
           !!(Zlength log = 256) &&
           (* Note: log[1] is set to 0 in the first iteration, and overwritten with 255 in the last
              iteration, so we needn't assert anything about j=0, but we do about j=255.
              And btw, log[0] remains Vundef.
              Think "each j has to be stored in the right cell of the log array". *)
           !!(forall j, 1 <= j < i -> Vint (Int.repr j)
                = Znth (Int.unsigned (pow3 j)) log Vundef) &&
           !!(Znth 0 log Vundef = Vundef)
           && data_at Tsh (tarray tint 256) log lvar1;
         EX pow : list val,
           !!(Zlength pow = 256) &&
           !!(forall j, 0 <= j < i -> Znth j pow Vundef = Vint (pow3 j))
           && data_at Tsh (tarray tint 256) pow lvar0;
         tables_uninitialized tables)).
  { (* init *)
    forward. forward. Exists 0. entailer!. do 2 Exists (repeat Vundef 256).
    entailer!.
    split; intros; omega. (* TODO floyd why doesn't entailer! do this itself? *)
  }
  { (* body *)
    (* forward. TODO floyd: "forward" should tell me to use Intros instead of just failing *)
    Intros log pow.
    freeze [0; 2] Fr.
    forward.
    (* forward. "Error: No applicable tactic."
       TODO floyd: error message should say that I have to thaw *)
    thaw Fr.
    forward.
    + entailer!. apply pow3_range; omega.
    + (* t'1 = ( x & 0x80 ) ? 0x1B : 0x00 ) *)
      forward_if_diff (PROP () LOCAL (temp _t'1 (Vint (
        if Int.eq (Int.and (pow3 i) (Int.repr 128)) Int.zero
        then Int.zero
        else (Int.repr 27)
      ))) SEP ()).
      * (* then-branch of "_ ? _ : _" *)
        forward. rewrite Int.eq_false by assumption. entailer!.
      * (* else-branch of "_ ? _ : _" *)
        forward.
        match goal with
        | H: @eq int _ _ |- _ => rewrite H
        end.
        rewrite Int.eq_true.
        entailer!.
      * (* after  "_ ? _ : _" *)
        (* x = (x ^ ((x << 1) ^ t'1)) & 0xFF *)
        forward.
        entailer!.
        { f_equal. unfold pow3. rewrite repeat_op_step by omega. reflexivity. }
        { Exists (upd_Znth i pow (Vint (pow3 i))).
          Exists (upd_Znth (Int.unsigned (pow3 i)) log (Vint (Int.repr i))).
          entailer!. assert (0 <= i < 256) by omega. repeat split.
          - rewrite upd_Znth_diff.
              + assumption.
              + omega.
              + replace (Zlength log) with 256 by assumption. apply pow3_range; omega.
              + intro E. change 0 with (Int.unsigned Int.zero) in E. apply unsigned_eq_eq in E.
                symmetry in E. apply (pow3_not0 i E).
          - replace 256 with (Zlength log) by assumption.
            apply upd_Znth_Zlength.
            replace (Zlength log) with 256 by assumption.
            apply pow3_range; omega.
          - intros. assert (1 <= j < i \/ j = i) as C by omega. destruct C as [C | C].
            * rewrite upd_Znth_diff.
              + auto.
              + replace (Zlength log) with 256 by assumption. apply pow3_range; omega.
              + replace (Zlength log) with 256 by assumption. apply pow3_range; omega.
              + intro E. apply unsigned_eq_eq in E.
                apply pow3_inj in E. unfold Int.eqmod in E. destruct E as [k E]. omega.
            * subst. rewrite upd_Znth_same.
              + reflexivity.
              + replace (Zlength log) with 256 by assumption. apply pow3_range; omega.
          - replace 256 with (Zlength pow) by assumption.
            apply upd_Znth_Zlength. omega.
          - intros. assert (0 <= j < i \/ j = i) as C by omega. destruct C as [C | C].
            * rewrite upd_Znth_diff by omega. auto.
            * subst. rewrite upd_Znth_same by omega. reflexivity.
        }
  } {
  Intros log pow.

  unfold tables_uninitialized.
  unfold_data_at 3%nat.
  freeze [0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11] Fr.

  forward_for_simple_bound 10 (rcon_loop_inv0 lvar0 lvar1 tables Fr).
  { (* init *)
    forward. forward. Exists 0. entailer!.
  }
  { (* body *)
    forward. entailer!.
    (* t'2 = ( x & 0x80 ) ? 0x1B : 0x00 ) *)
    forward_if_diff (PROP () LOCAL (temp _t'2 (Vint (
      if Int.eq (Int.and (pow2 i) (Int.repr 128)) Int.zero
      then Int.zero
      else (Int.repr 27)
    ))) SEP ()).
    * (* then-branch of "_ ? _ : _" *)
      forward. rewrite Int.eq_false by assumption. entailer!.
    * (* else-branch of "_ ? _ : _" *)
      forward.
      match goal with
      | H: @eq int _ _ |- _ => rewrite H
      end.
      rewrite Int.eq_true.
      entailer!.
    * (* after  "_ ? _ : _" *)
      (* x = ((x << 1) ^ t'2)) & 0xFF *)
      forward.
      entailer!.
      - f_equal. unfold pow2 at 1. rewrite repeat_op_step by omega. reflexivity.
      - apply field_at_update_val.
        rewrite upd_Znth_app2.
        + rewrite Zlength_map. rewrite repeat_op_table_length by assumption.
          replace (i - i) with 0 by omega. rewrite upd_Znth0.
          rewrite repeat_op_table_length by omega.
          rewrite repeat_op_table_step by omega.
          rewrite map_app. rewrite <- app_assoc. f_equal. simpl. f_equal.
          replace (10 - i) with (1 + (10 - (i + 1))) by omega.
          apply sublist_repeat_op_table_id; omega.
        + pose proof (Zlength_nonneg ((repeat_op_table (10 - i) Vundef id))).
          rewrite Zlength_map. rewrite repeat_op_table_length by omega. omega.
  } {
  rewrite app_nil_r.

  (* Before using log and pow, let's turn these "list val" into "list int" or "list Z", respectively. *)
  rename log into log0, pow into pow0.
  assert (exists pow, pow0 = map Vint pow /\ forall j, 0 <= j < 256 -> Znth j pow Int.zero = pow3 j)
  as E. {
    exists (map force_int pow0). split.
    - apply list_equiv with (d := Vundef) (n := 256); rewrite ?Zlength_map; try assumption.
      intros. autorewrite with sublist. rewrite H4 by omega. reflexivity.
    - intros. autorewrite with sublist. rewrite H4 by omega. reflexivity.
  }
  destruct E as [pow [E Hpow]]. subst pow0. clear H4. rewrite Zlength_map in H3. rename H3 into Lpow.
  assert (exists log, log0 = map Z_to_val log /\
                      forall j, 1 <= j < 256 -> Znth j log 0 = log3 (Int.repr j))
  as E. {
    exists (map (fun x => match x with
                          | Vint i => Int.unsigned i
                          | _ => -1
                          end)
                 log0). split.
    - apply list_equiv with (d := Vundef) (n := 256); rewrite ?Zlength_map; try assumption.
      intros. autorewrite with sublist.
      assert (j = 0 \/ j <> 0) as C by omega. destruct C as [C | C].
      + subst j. rewrite H0. reflexivity.
      + assert (1 <= j < 256) as A by omega.
        specialize (H2 (log3 (Int.repr j))).
        pose proof (log3range j A).
        rewrite pow3log3 in H2 by assumption.
        rewrite <- H2 by assumption.
        rewrite Int.unsigned_repr by repable_signed. unfold Z_to_val.
        destruct (zeq (log3 (Int.repr j)) (-1)) as [E | E]; [ | reflexivity ].
        rewrite E in H4. omega.
    - intros. autorewrite with sublist.
      specialize (H2 (log3 (Int.repr j))).
      pose proof (log3range j H3).
      rewrite pow3log3 in H2 by assumption.
      rewrite <- H2 by assumption.
      rewrite Int.unsigned_repr by repable_signed.
      reflexivity.
  }
  destruct E as [log [E Hlog]]. subst log0. clear H2. rewrite Zlength_map in H1. rename H1 into Llog.
  clear H H0.
  assert (forall j, 1 <= j < 256 ->
    Z_to_val (Znth j log 0) = Vint (Int.repr (log3 (Int.repr j)))
  ) as Hlog'. {
    intros. rewrite Hlog by assumption. unfold Z_to_val.
    destruct (zeq (log3 (Int.repr j)) (-1)) as [Eq | Ne].
    - pose proof (log3range j). omega.
    - reflexivity.
  }

  Transparent FSb RSb.

  (* generate the forward and reverse S-boxes *)
  thaw Fr.
  freeze [3; 4; 5; 6; 8; 9; 10; 11; 12] Fr.
  forward.
  forward.
  forward_for_simple_bound 256 (gen_sbox_inv0 lvar0 lvar1 tables (map Z_to_val log) (map Vint pow) Fr).
  { (* loop invariant holds initially: *)
    entailer!.
    Exists (upd_Znth 99 Vundef256 (Vint (Int.repr 0))).
    Exists (upd_Znth 0 Vundef256 (Vint (Int.repr 99))).
    entailer!. split.
    - intros. assert (j = 0) by omega. subst j. rewrite upd_Znth_same.
      * reflexivity.
      * change (Zlength Vundef256) with 256. omega.
    - intros. omega.
  }
  { (* loop body preserves invariant: *)
    forward. { entailer!. rewrite Hlog' by omega. auto. }
    pose proof (log3range i).
    rewrite Hlog' by omega.
    (* TODO floyd: If I don't do the above to make sure that "temp _logi" is a Vint,
       "forward" fails, with the default error, because it cannot calculate the array index. *)
    forward.

    Ltac fold_rotl1 :=
    repeat match goal with
    | |- context[Int.and (Int.or (Int.shl ?b (Int.repr 1)) (Int.shr ?b (Int.repr 7))) (Int.repr 255)]
      => change (Int.and (Int.or (Int.shl  b (Int.repr 1)) (Int.shr  b (Int.repr 7))) (Int.repr 255))
         with (rotl1 b)
    end.

    forward. forward. fold_rotl1.
    forward. forward. fold_rotl1.
    forward. forward. fold_rotl1.
    forward. forward. fold_rotl1.
    forward.
    rewrite Hpow by omega.
    match goal with
    | |- context [ temp _x (Vint ?v) ] => change v with (calc_FSb_nonzero i)
    end.
    rewrite FSb_equiv by omega.

    Intro fsb. Intro rsb.
    forward. forward.
    - (* entailment of "forward" *)
      entailer!.
      apply FSb_range.
    - (* postcondition implies loop invariant *)
      entailer!.
        match goal with
        | |- (field_at _ _ _ ?fsb' _ * field_at _ _ _ ?rsb' _)%logic |-- _ => Exists rsb'; Exists fsb'
        end.
        entailer!. repeat split.
        + rewrite upd_Znth_diff; (omega || auto).
        + rewrite upd_Znth_Zlength; omega.
        + intros.
          assert (0 <= j < i \/ j = i) as C
          by omega. destruct C as [C | C].
          { rewrite upd_Znth_diff; (omega || auto). }
          { subst j. rewrite upd_Znth_same.
            - repeat rewrite zero_ext_nop; try reflexivity; apply FSb_range.
            - omega.
          }
        + intros.
          assert (1 <= j < i \/ j = i) as C
          by omega. destruct C as [C | C].
          { rewrite upd_Znth_diff.
            - auto.
            - replace (Zlength rsb) with 256 by assumption. apply FSb_range.
            - replace (Zlength rsb) with 256 by assumption. apply FSb_range.
            - intro HH. apply unsigned_eq_eq in HH.
              apply FSb_inj in HH; omega.
          }
          { subst j. rewrite upd_Znth_same.
            - repeat rewrite zero_ext_nop; try reflexivity; rewrite Int.unsigned_repr; repable_signed.
            - replace (Zlength rsb) with 256 by assumption. apply FSb_range.
          }
        + rewrite upd_Znth_diff.
          { auto. }
          { omega. }
          { replace (Zlength rsb) with 256 by assumption. apply FSb_range. }
          { replace 99 with (Int.unsigned (Znth 0 FSb Int.zero)) by reflexivity.
            intro HH. apply unsigned_eq_eq in HH. apply FSb_inj in HH; omega. }
        + rewrite upd_Znth_Zlength; [ omega | ].
          replace (Zlength rsb) with 256 by reflexivity. apply FSb_range.
  }

  thaw Fr.
  Intro fsb. Intro rsb.

  (* TODO floyd: the following should be done by normalize *)
  assert_PROP (
    (Zlength rsb = 256) /\
    (forall j : Z, 1 <= j < 256 ->
       Znth (Int.unsigned (Znth j FSb Int.zero)) rsb Vundef = Vint (Int.repr j)) /\
    (Znth 99 rsb Vundef = Vint Int.zero)
  ) as P. { entailer!. }
  destruct P as [?H [?H ?H]].
  match goal with
  | |- semax ?D (PROPx ?P (LOCALx ?Q (SEPx ?R))) ?e ?Post => match R with
    | [?s0; ?s1; ?s2; ?s3; ?s4; ?s5; ?s6; ?s7; ?s8; ?s9; ?s10; ?s11; ?s12] => match s12 with
      | _ && _ && _ && ?f => apply semax_pre with (P' :=
         (PROPx P (LOCALx Q (SEPx [s0; s1; s2; s3; s4; s5; s6; s7; s8; s9; s10; s11; f]))))
      end
    end
  end. { entailer!. }

  assert (fsb = (map Vint FSb)) as E. {
    apply list_equiv with (d := Vundef) (n := 256).
    - assumption.
    - rewrite Zlength_map. reflexivity.
    - intros. rewrite Znth_map with (d' := Int.zero); auto.
  }
  subst fsb.
  assert (rsb = (map Vint RSb)) as E. {
    apply list_equiv with (d := Vundef) (n := 256).
    - assumption.
    - rewrite Zlength_map. reflexivity.
    - intros. assert (j = 99 \/ j <> 99) as C by omega. destruct C as [C | C].
      + subst j. auto.
      + rewrite (FSb_RSb_id j) at 1 by assumption. rewrite H4.
        * rewrite Int.repr_unsigned. symmetry. apply Znth_map with (d' := Int.zero).
          replace (Zlength RSb) with 256 by reflexivity. omega.
        * assert (Int.unsigned (Znth j RSb Int.zero) = 0 \/ Int.unsigned (Znth j RSb Int.zero) <> 0)
          as D by omega. destruct D as [D | D].
          { change 0 with (Int.unsigned Int.zero) in D. apply unsigned_eq_eq in D.
            change Int.zero with (Znth 99 RSb Int.zero) in D at 2.
            apply RSb_inj in D; omega. }
          { pose proof (RSb_range j). omega. }
  }
  subst rsb.
  clear H H0 H1 H2 H3 H4 H5.

  (* generate the forward and reverse tables *)
  forward_for_simple_bound 256 (gen_ftrt_inv0 lvar0 lvar1 tables (map Z_to_val log) (map Vint pow)).
  { (* loop invariant holds initially: *)
    entailer!.
  }
  { (* loop body preserves invariant: *)

    (* forward tables: *)
    assert (forall i, Int.unsigned (Znth i FSb Int.zero) <= Byte.max_unsigned). {
      pose proof FSb_range as F. intro. change Byte.max_unsigned with 255. specialize (F i0). omega.
    }
    forward.
    Opaque FSb RSb.
    (* t'3 = ( x & 0x80 ) ? 0x1B : 0x00 ) *)
    forward_if_diff (PROP () LOCAL (temp _t'3 (Vint (
      if Int.eq (Int.and (Znth i FSb Int.zero) (Int.repr 128)) Int.zero
      then Int.zero
      else (Int.repr 27)
    ))) SEP ()).
    * (* then-branch of "_ ? _ : _" *)
      forward. rewrite Int.eq_false by assumption. entailer!.
    * (* else-branch of "_ ? _ : _" *)
      forward.
      match goal with
      | H: @eq int _ _ |- _ => rewrite H
      end.
      rewrite Int.eq_true.
      entailer!.
    * (* after  "_ ? _ : _" *)
      forward.
      match goal with
      | |- context [ temp _y (Vint ?v) ] => change v with (times2 (Znth i FSb Int.zero))
      end.
      forward.
      forward.
      match goal with
      | |- context [ field_at _ _ _ (upd_Znth i (partially_filled i 256 calc_FT0) (Vint ?v)) _ ] =>
        change v with (calc_FT0 i)
      end.
      rewrite (update_partially_filled i calc_FT0) by assumption.

      Ltac canon_load_result Hresult ::= rewrite Znth_partially_filled in Hresult by omega.
      forward. forward.
      match goal with
      | |- context [ field_at _ _ _ (upd_Znth i (partially_filled i 256 calc_FT1) (Vint ?v)) _ ] =>
        change v with (calc_FT1 i)
      end.
      rewrite (update_partially_filled i calc_FT1) by assumption.

      forward. forward.
      match goal with
      | |- context [ field_at _ _ _ (upd_Znth i (partially_filled i 256 calc_FT2) (Vint ?v)) _ ] =>
        change v with (calc_FT2 i)
      end.
      rewrite (update_partially_filled i calc_FT2) by assumption.

      forward. forward.
      match goal with
      | |- context [ field_at _ _ _ (upd_Znth i (partially_filled i 256 calc_FT3) (Vint ?v)) _ ] =>
        change v with (calc_FT3 i)
      end.
      rewrite (update_partially_filled i calc_FT3) by assumption.

      (* reset back to normal: *)
      Ltac canon_load_result Hresult ::= default_canon_load_result Hresult.

    (* reverse tables: *)
    assert (forall i, Int.unsigned (Znth i RSb Int.zero) <= Byte.max_unsigned). {
      pose proof RSb_range as F. intro. change Byte.max_unsigned with 255. specialize (F i0). omega.
    }
    forward.
    (* MUL(0x0E, x, prod1); *)
    assert (forall j, 1 <= j < 256 -> Znth j log 0 <> -1). {
      intros j B. specialize (Hlog j B). pose proof (log3range j B). omega.
    }
    Ltac canon_load_result Hresult ::=
      (* default: *)
      default_canon_load_result Hresult;
      (* additional: *)
      try rewrite Z_to_val_to_Vint in Hresult by
      match goal with
      | H : forall j : Z, 1 <= j < 256 -> Znth j _ _ <> -1 |- _ => apply H; omega
      end.

    pose proof RSb_range as F. replace 256 with (Zlength log) in F by assumption.
    (* Note: Looking at the expression
       (Sset _t'4 (Ecast (Etempvar _x tint) tbool))
       which should be the parse result of "0x0E && x", it seems that the parser optimized away
       the constant "0x0E"... *)
    forward.
    forward_if_diff (PROP () LOCAL (temp _prod1 (Vint (
      if Int.eq (cast_int_int IBool Unsigned (Znth i RSb Int.zero)) Int.zero
      then Int.zero
      else (Znth (Int.unsigned
              (Int.mods (Int.repr (Znth 14 log 0 + Znth (Int.unsigned (Znth i RSb Int.zero)) log 0))
                        (Int.repr 255))) pow Int.zero)
    ))) SEP ()).
    { (* TODO floyd: this should be derived automatically from H3 *)
      assert (Int.unsigned (Znth i RSb Int.zero) <> 0) as Ne. {
        intro E. apply H3. change 0 with (Int.unsigned Int.zero) in E.
        apply unsigned_eq_eq in E. rewrite E. rewrite Int.eq_true. reflexivity.
      }
      pose proof (RSb_range i).
      forward. forward. forward. {
        entailer!.
       (* We have to show that we're not in the case "INT_MIN % -1", because that's undefined behavior.
          TODO floyd: Make sure floyd can solve this automatically, also in solve_efield_denote, so
          that we don't have to factor out the modulo, but can use it directly as the array index. *)
        apply mod255_condition.
      }
      assert (0 <= Znth 14 log 0 + Znth (Int.unsigned (Znth i RSb Int.zero)) log 0) as A. {
        do 2 rewrite Hlog by omega.
        pose proof (log3range 14).
        pose proof (log3range (Int.unsigned (Znth i RSb Int.zero))). omega.
      }
      pose proof (mod_range _ 255 A).
      forward.
      entailer!.
      destruct (Int.eq (Znth i RSb Int.zero) Int.zero) eqn: E.
      - exfalso. apply H3. reflexivity.
      - simpl. reflexivity.
    }
    { (* else-branch *)
      forward. entailer!.
      destruct (Int.eq (Znth i RSb Int.zero) Int.zero) eqn: E.
      - simpl. reflexivity.
      - discriminate.
    }

    (* MUL(0x09, x, prod2); *)
    forward.
    forward_if_diff (PROP () LOCAL (temp _prod2 (Vint (
      if Int.eq (cast_int_int IBool Unsigned (Znth i RSb Int.zero)) Int.zero
      then Int.zero
      else (Znth (Int.unsigned
              (Int.mods (Int.repr (Znth 9 log 0 + Znth (Int.unsigned (Znth i RSb Int.zero)) log 0))
                        (Int.repr 255))) pow Int.zero)
    ))) SEP ()). {
      assert (Int.unsigned (Znth i RSb Int.zero) <> 0) as Ne. {
        intro E. apply H3. change 0 with (Int.unsigned Int.zero) in E.
        apply unsigned_eq_eq in E. rewrite E. rewrite Int.eq_true. reflexivity.
      }
      pose proof (RSb_range i).
      forward. forward. forward. { entailer!. apply mod255_condition. }
      assert (0 <= Znth 9 log 0 + Znth (Int.unsigned (Znth i RSb Int.zero)) log 0) as A. {
        do 2 rewrite Hlog by omega.
        pose proof (log3range 9).
        pose proof (log3range (Int.unsigned (Znth i RSb Int.zero))). omega.
      }
      pose proof (mod_range _ 255 A).
      forward.
      entailer!.
      destruct (Int.eq (Znth i RSb Int.zero) Int.zero) eqn: E.
      - exfalso. apply H3. reflexivity.
      - simpl. reflexivity.
    }
    { (* else-branch *)
      forward. entailer!.
      destruct (Int.eq (Znth i RSb Int.zero) Int.zero) eqn: E.
      - simpl. reflexivity.
      - discriminate.
    }

    (* MUL(0x0D, x, prod3); *)
    forward.
    forward_if_diff (PROP () LOCAL (temp _prod3 (Vint (
      if Int.eq (cast_int_int IBool Unsigned (Znth i RSb Int.zero)) Int.zero
      then Int.zero
      else (Znth (Int.unsigned
              (Int.mods (Int.repr (Znth 13 log 0 + Znth (Int.unsigned (Znth i RSb Int.zero)) log 0))
                        (Int.repr 255))) pow Int.zero)
    ))) SEP ()). {
      assert (Int.unsigned (Znth i RSb Int.zero) <> 0) as Ne. {
        intro E. apply H3. change 0 with (Int.unsigned Int.zero) in E.
        apply unsigned_eq_eq in E. rewrite E. rewrite Int.eq_true. reflexivity.
      }
      pose proof (RSb_range i).
      forward. forward. forward. { entailer!. apply mod255_condition. }
      assert (0 <= Znth 13 log 0 + Znth (Int.unsigned (Znth i RSb Int.zero)) log 0) as A. {
        do 2 rewrite Hlog by omega.
        pose proof (log3range 13).
        pose proof (log3range (Int.unsigned (Znth i RSb Int.zero))). omega.
      }
      pose proof (mod_range _ 255 A).
      forward.
      entailer!.
      destruct (Int.eq (Znth i RSb Int.zero) Int.zero) eqn: E.
      - exfalso. apply H3. reflexivity.
      - simpl. reflexivity.
    }
    { (* else-branch *)
      forward. entailer!.
      destruct (Int.eq (Znth i RSb Int.zero) Int.zero) eqn: E.
      - simpl. reflexivity.
      - discriminate.
    }

    (* MUL(0x0B, x, prod4); *)
    forward.
    forward_if_diff (PROP () LOCAL (temp _prod4 (Vint (
      if Int.eq (cast_int_int IBool Unsigned (Znth i RSb Int.zero)) Int.zero
      then Int.zero
      else (Znth (Int.unsigned
              (Int.mods (Int.repr (Znth 11 log 0 + Znth (Int.unsigned (Znth i RSb Int.zero)) log 0))
                        (Int.repr 255))) pow Int.zero)
    ))) SEP ()). {
      assert (Int.unsigned (Znth i RSb Int.zero) <> 0) as Ne. {
        intro E. apply H3. change 0 with (Int.unsigned Int.zero) in E.
        apply unsigned_eq_eq in E. rewrite E. rewrite Int.eq_true. reflexivity.
      }
      pose proof (RSb_range i).
      forward. forward. forward. { entailer!. apply mod255_condition. }
      assert (0 <= Znth 11 log 0 + Znth (Int.unsigned (Znth i RSb Int.zero)) log 0) as A. {
        do 2 rewrite Hlog by omega.
        pose proof (log3range 11).
        pose proof (log3range (Int.unsigned (Znth i RSb Int.zero))). omega.
      }
      pose proof (mod_range _ 255 A).
      forward.
      entailer!.
      destruct (Int.eq (Znth i RSb Int.zero) Int.zero) eqn: E.
      - exfalso. apply H3. reflexivity.
      - simpl. reflexivity.
    }
    { (* else-branch *)
      forward. entailer!.
      destruct (Int.eq (Znth i RSb Int.zero) Int.zero) eqn: E.
      - simpl. reflexivity.
      - discriminate.
    }
    replace (if Int.eq                      (Znth i RSb Int.zero)   Int.zero then Int.zero else Int.one)
    with (if Int.eq (Int.repr (Int.unsigned (Znth i RSb Int.zero))) Int.zero then Int.zero else Int.one)
    by (rewrite Int.repr_unsigned; reflexivity).

    let t := constr:(mul_with_table 14 (Int.unsigned (Znth i RSb Int.zero)) pow log) in
      let u := eval unfold mul_with_table in t in change u with t.
    let t := constr:(mul_with_table 9 (Int.unsigned (Znth i RSb Int.zero)) pow log) in
      let u := eval unfold mul_with_table in t in change u with t.
    let t := constr:(mul_with_table 13 (Int.unsigned (Znth i RSb Int.zero)) pow log) in
      let u := eval unfold mul_with_table in t in change u with t.
    let t := constr:(mul_with_table 11 (Int.unsigned (Znth i RSb Int.zero)) pow log) in
      let u := eval unfold mul_with_table in t in change u with t.

    pose proof RSb_range.
    do 4 rewrite mul_equiv by (auto || omega).

    forward.
    match goal with
    | |- context [ field_at _ _ _ (upd_Znth i (partially_filled i 256 calc_RT0) (Vint ?v)) _ ] =>
      change v with (calc_RT0 i)
    end.
    rewrite (update_partially_filled i calc_RT0) by assumption.

    Ltac canon_load_result Hresult ::= rewrite Znth_partially_filled in Hresult by omega.
    forward. forward.
    match goal with
    | |- context [ field_at _ _ _ (upd_Znth i (partially_filled i 256 calc_RT1) (Vint ?v)) _ ] =>
      change v with (calc_RT1 i)
    end.
    rewrite (update_partially_filled i calc_RT1) by assumption.

    forward. forward.
    match goal with
    | |- context [ field_at _ _ _ (upd_Znth i (partially_filled i 256 calc_RT2) (Vint ?v)) _ ] =>
      change v with (calc_RT2 i)
    end.
    rewrite (update_partially_filled i calc_RT2) by assumption.

    forward. forward.
    match goal with
    | |- context [ field_at _ _ _ (upd_Znth i (partially_filled i 256 calc_RT3) (Vint ?v)) _ ] =>
      change v with (calc_RT3 i)
    end.
    rewrite (update_partially_filled i calc_RT3) by assumption.

    Ltac canon_load_result Hresult ::= default_canon_load_result Hresult.

    (* postcondition implies loop invariant: *)
    entailer!.
  }
  unfold partially_filled. change (repeat_op_table (256 - 256) Vundef id) with (@nil val).
  do 8 rewrite app_nil_r.

  (* loop invariant at 256 implies postcondition of gen_tables: *)
  (* TODO floyd "forward" takes forever here, because RT0 is so complex (even thoug it's opaque for
     reduction) *)
  unfold POSTCONDITION, abbreviate.
  unfold tables_initialized.
  unfold_data_at 3%nat.
  change (fill_list 256 calc_FT0) with FT0.
  change (fill_list 256 calc_FT1) with FT1.
  change (fill_list 256 calc_FT2) with FT2.
  change (fill_list 256 calc_FT3) with FT3.
  change (fill_list 256 calc_RT0) with RT0.
  change (fill_list 256 calc_RT1) with RT1.
  change (fill_list 256 calc_RT2) with RT2.
  change (fill_list 256 calc_RT3) with RT3.

  forget RT0 as RT0'.
  forget RT1 as RT1'.
  forget RT2 as RT2'.
  forget RT3 as RT3'.

  forward.
  Exists lvar1.
  (* TODO floyd if I do "Exists log" instead, I get a default error, instead of a typechecking error *)
  Exists lvar0.
  entailer!.
} }
(*  Show.*)
Time Qed.
(* Coq 8.5.2: 177s
   Coq 8.6  :  75s
*)


Require Import List.
From Hammer Require Hammer.

Local Lemma hd_skip : forall {A} (l : list A) n, hd_error (skipn n l) = nth_error l n.
Proof.
  induction l; Reconstr.scrush.
Qed.

Local Lemma first_add : forall {A} (l : list A) (n : nat), firstn (S n) l = (firstn n l) ++ (match nth_error l n with | Some e => (e :: nil) | None => nil end).
Proof. induction l.
 - Reconstr.scrush.
 - Reconstr.ryelles4 (@Coq.Lists.List.firstn_O, @hd_skip) (@Coq.Lists.List.firstn, @Coq.Init.Datatypes.app, @Coq.Lists.List.nth_error, @Coq.Lists.List.skipn).
Qed.

Local Lemma Forall_last : forall {A} (l : list A) (P : A -> Prop) (x : A), Forall P l /\ P x <-> Forall P (l ++ (x :: nil)).
Proof.
 induction l; Reconstr.scrush.
Qed.

Local Lemma skip_one : forall {A} l tail (head : A) n, head :: tail = skipn n l -> tail = skipn (S n) l.
Proof.
 induction l.
 - induction tail.
   + auto.
   + Reconstr.scrush.
 - Reconstr.scrush.
Qed.

Definition first_index {A}
                       (l : list A)
                       (P : A -> Prop)
                       (P_dec : forall e, {P e} + {~P e})
                       : {n | Forall (fun e => ~P e) (firstn n l)
                              /\ match (nth_error l n) with
                                 | Some e => P e
                                 | None => False end }
                         + {Forall (fun e => ~P e) l}.
Proof.
  (* right fold *)
  (*induction l as [|next tail_l IHl]; auto.
  destruct (P_dec next) as [?|not_P_next].
  - left. exists O. Reconstr.scrush.
  - destruct IHl as [found|not_found].
    + destruct found as [found_n found_n_prop].
      left. exists (S found_n). Reconstr.scrush.
    + right. Reconstr.scrush.
Restart.*)
  (* left fold *)
  pose (ind_type := {rec : ((list A) * nat) | Forall (fun e => ~P e) (firstn (snd rec) l) /\ (fst rec) = skipn (snd rec) l }).
  pose (Wfr := Wf_nat.well_founded_ltof ind_type (fun e => length (fst (proj1_sig e)))).
  assert (start : ind_type). { exists (l, O). Reconstr.scrush. }
  refine (well_founded_induction_type Wfr (fun _ => _) _ start).
  clear start.
  intros initial.
  destruct initial as [initial_existential initial_prop].
  destruct initial_existential as [initial_list initial_counter].
  destruct initial_prop as [first_prop fst_eq].
  destruct initial_list as [|initial_list_head initial_list_tail].
  - intros. right. simpl in *.
    rewrite <- (firstn_skipn initial_counter l).
    rewrite <- fst_eq. rewrite app_nil_r. auto.
  - destruct (P_dec initial_list_head).
    + intros. left. exists initial_counter.
      pose (head_eq_nth := hd_skip l initial_counter).
      simpl in *.
      rewrite <- head_eq_nth.
      rewrite <- fst_eq. auto.
    + intros rec. refine (rec ?[next] _).
      [next]:{ unfold ind_type. exists (initial_list_tail, S initial_counter).
               pose (head_eq_nth := hd_skip l initial_counter). split.
               - simpl snd.
                 simpl in fst_eq.
                 destruct (Forall_last (firstn initial_counter l) (fun e => ~P e) initial_list_head) as [H _].
                 rewrite (first_add l initial_counter). rewrite <- (hd_skip l initial_counter). rewrite <- fst_eq.
                 auto.
               - simpl fst. simpl snd.
                 rewrite skip_one with l initial_list_tail initial_list_head initial_counter; auto. }
      Reconstr.scrush.
Defined.


From RL Require Export TraceThm.

From Coq Require Import
     Arith
     Lia
     List.

From ITree Require Import
     ITree
     ITreeFacts
     Traces.

Import ListNotations.
Import ITreeNotations.
Import MonadNotation.
Open Scope monad_scope.

(* * Idea * *)
(* An environment is an transition system over state space and action space. An deterministic environment has type "State * Action -> State" and an agent policy has type "State -> Action". Now represent an environment as an itree and agent policy as effect. *)

(* * Example * *)
(* One-demension road with cliff. State space has type "nat" and there is a cliff at position "4". Action space is "{Left, Right}". If the car reach position "4" it will crash. A safe environment should not let this happen while any decision the agent makes. *)

Definition StateT := nat.

Inductive ActionT : Type :=
| Left
| Right.

(* An one-dimension road environment. Input action "Left" then go left, input action "Right" then go right.  *)

Definition unsafe_env_body : StateT -> ActionT -> StateT :=
  fun state action =>
    match action with
    | Left => state - 1
    | Right => state + 1
    end.

(* A safe environment adds a barrier at 3. *)

Definition safe_env_body : StateT -> ActionT -> StateT :=
  fun state action =>
    match action with
    | Left => state - 1
    | Right => if state =? 3 then 3 else state + 1
    end.

Definition unsafe_env : itree rlE unit := env_generator unsafe_env_body.
Definition safe_env : itree rlE unit := env_generator safe_env_body.

Lemma safe_inductive_invariant : forall (s s': StateT) (a: ActionT),
    safe_env_body s a = s' -> s <= 3 -> s' <= 3.
Proof.
  unfold safe_env_body.
  intros.
  repeat match goal with
         | H : context [if s =? _ then _ else _] |- _ => destruct s; cbn in H
         | H : context [match a with _ => _ end] |- _ => destruct a
         | _ => subst; auto; lia
         end.
Qed.

Definition trace_from_safe := fun tr => @trace_init StateT ActionT (fun s => s <= 3) tr.
Definition trace_fall := fun tr => @trace_end StateT ActionT (fun s' => s' = 4) tr.

(* The following safe lemma can be proved by the inductive invariant. *)

Lemma safe: forall (tr: @trace rlE unit),
    @state_trace StateT actionE tr ->
    trace_from_safe tr ->
    trace_fall tr ->
    not (is_trace safe_env tr).
Proof.
  unfold not, trace_from_safe, trace_fall.
  intros. unfold safe_env, env_generator in H2.
  apply env_trace_is_step_trace in H2.
  remember safe_env_body as z.
  induction H2; try inv_trace_end; try inv_trace_init.
  - apply safe_inductive_invariant in H4; auto. lia.
  - apply IHstep_trace; auto.
    + do 3 (apply decrease_state_trace in H). auto.
    + remember (safe_env_body s a) as z.
      assert (z <= 3).
      rewrite Heqz. apply safe_inductive_invariant with s a; auto.
      * do 2 (apply decrease_state_trace in H).
        inv_dep H; try inv_trace_end; auto.
        constructor; auto.
        inversion H2.
        inversion H2.
Qed.


(** * System Fsub subtyping without arrow types *)

Require Export unscoped.

Reserved Notation " Γ |-' s <: t" (at level 68, s, t at next level).

(** ** Syntax of types *)

Inductive type : Type :=
  | var_type : fin -> type
  | top : type
  | all : type -> type -> type.

Fixpoint ren_type (ξ : fin -> fin) (t : type) : type  :=
  match t return type with
  | var_type n => var_type (ξ n)
  | top  => top
  | all t0 t1 => all (ren_type ξ t0) (ren_type (up_ren ξ) t1)
  end.

Fixpoint subst_type (θ : fin -> type) (t : type) : type  :=
  match t return type with
  | var_type n => θ n
  | top  => top
  | all t0 t1 => all (subst_type θ t0) (subst_type (var_type 0 .: θ >> ren_type ↑) t1)
  end.

(** ** Subtyping relation *)

Inductive sub' (Γ : list type) : type -> type -> Prop :=
  | Refl τ : Γ |-' τ <: τ
  | Trans σ τ υ : Γ |-' σ <: τ -> Γ |-' τ <: υ ->
      Γ |-' σ <: υ
  | Top τ : Γ |-' τ <: top
  | Var n : Γ |-' var_type n <: nth_default (var_type n) Γ n
  | All σ1 σ2 τ1 τ2 : Γ |-' τ1 <: σ1 -> map (ren_type ↑) (τ1 :: Γ) |-' σ2 <: τ2  ->
      Γ |-' (all σ1 σ2) <: (all τ1 τ2)
  where "Γ |-' σ <: τ" := (sub' Γ σ τ).

(** ** Subtyping problem *)

Definition Fsub'_SUBTYPE : (list type * (type * type)) -> Prop
  := fun ctt => let (Γ, tt) := ctt in let (σ, τ) := tt
    in Γ |-' σ <: τ.


Require Import Coq.Lists.List.
Require Import Coq.Strings.String.
Require Import Coq.ZArith.ZArith.
Require Import Coq.micromega.Psatz.
Require Import compcert.lib.Integers.
Local Open Scope Z.

Definition var_name: Type := string.

(** 程序状态 *)
Record prog_state: Type := {
  vars: var_name -> int64;
  mem: int64 -> option int64;
}.

(** 事件 *)
Inductive event: Type :=
  | EV_Malloc (arg: int64) (ret: int64)
  | EV_ReadInt (ret: int64)
  | EV_ReadChar (ret: int64)
  | EV_WriteInt (arg: int64)
  | EV_WriteChar (arg: int64).

(** 表达式 *)
Inductive binop : Type :=
  | OOr | OAnd
  | OLt | OLe | OGt | OGe | OEq | ONe
  | OPlus | OMinus | OMul | ODiv | OMod.

Inductive unop : Type :=
  | ONot | ONeg.

Inductive expr : Type :=
  | ENum (n: Z): expr
  | EVar (x: var_name): expr
  | EBinop (op: binop) (e1 e2: expr): expr
  | EUnop (op: unop) (e: expr): expr
  | EDeref (e: expr): expr
  | EMalloc (e: expr)
  | EReadInt
  | EReadChar.

(** 语句 *)
Inductive com : Type :=
  | CAss (e1 e2: expr): com
  | CSeq (c1 c2: com): com
  | CIf (e: expr) (c1 c2: com): com
  | CWhile (e: expr) (c: com): com
  | CWriteInt (e: expr)
  | CWriteChar (e: expr).

Definition arith_compute1
             (Zfun: Z -> Z -> Z)
             (int64fun: int64 -> int64 -> int64)
             (n1 n2 n: int64): Prop :=
    n = int64fun n1 n2 /\
    Zfun (Int64.signed n1) (Int64.signed n2)
      <= Int64.max_signed /\
    Zfun (Int64.signed n1) (Int64.signed n2)
      >= Int64.min_signed.

Definition arith_compute2
             (int64fun: int64 -> int64 -> int64)
             (n1 n2 n: int64): Prop :=
    n = int64fun n1 n2 /\
    Int64.signed n2 <> 0 /\
    (Int64.signed n1 <> Int64.min_signed \/
     Int64.signed n2 <> - 1).

Definition cmp_compute
             (c: comparison)
             (n1 n2 n: int64): Prop :=
    n = if Int64.cmp c n1 n2 then Int64.repr 1 else Int64.repr 0.

Definition malloc_action
             (n1 n2: int64) (*malloc n1 bytes on addr n2, 8byte aligned.*)
             (s1: prog_state)
             (tr: list event)
             (s2: prog_state): Prop :=
  exists k: Z, (*k: number of bytes(or Qwords?) allocated.*)
    k > 1 /\
    8 * (k - 1) < Int64.signed n1 <= 8 * k /\
    (8 | Int64.signed n2) /\ (*Here it says that n2 can be evenly divided by 8*)
    Int64.signed n2 + 8 * k < Int64.max_signed /\
    tr = EV_Malloc n1 n2 :: nil /\
    (forall i,
      0 <= i < k ->
      s1.(mem) (Int64.repr (Int64.signed n2 + 8 * i)) = None /\
      s2.(mem) (Int64.repr (Int64.signed n2 + 8 * i)) <> None).