(** The main task in translating Csharpminor to Cminor is to explicitly
  stack-allocate local variables whose address is taken: these local
  variables become sub-blocks of the Cminor stack data block for the
  current function.  Taking the address of such a variable becomes
  a [Oaddrstack] operation with the corresponding offset.  Accessing
  or assigning such a variable becomes a load or store operation at
  that address.  Only scalar local variables whose address is never
  taken in the Csharpminor code can be mapped to Cminor local
  variable, since the latter do not reside in memory.

  Another task performed during the translation to Cminor is to eliminate
  redundant casts to small numerical types (8- and 16-bit integers,
  single-precision floats).

  Finally, the Clight-like [switch] construct of Csharpminor
  is transformed into the simpler, lower-level [switch] construct
  of Cminor.
*)

(** * Handling of variables *)

(** To every Csharpminor variable, the compiler associates its offset
  in the Cminor stack data block. *)

Definition compilenv := PTree.t Z.(** * Helper functions for code generation *)

(** When the translation of an expression is stored in memory,
  one or several casts at the toplevel of the expression can be redundant
  with that implicitly performed by the memory store.
  [store_arg] detects this case and strips away the redundant cast. *)

Function uncast_int (m: int) (e: expr) {struct e} : expr :=
  match e with
  | Eunop (Ocast8unsigned|Ocast8signed) e1 =>
      if Int.eq (Int.and (Int.repr 255) m) m then uncast_int m e1 else e
  | Eunop (Ocast16unsigned|Ocast16signed) e1 =>
      if Int.eq (Int.and (Int.repr 65535) m) m then uncast_int m e1 else e
  | Ebinop Oand e1 (Econst (Ointconst n)) =>
      if Int.eq (Int.and n m) m then uncast_int m e1 else e
  | Ebinop Oshru e1 (Econst (Ointconst n)) =>
      if Int.eq (Int.shru (Int.shl m n) n) m
      then Ebinop Oshru (uncast_int (Int.shl m n) e1) (Econst (Ointconst n))
      else e
  | Ebinop Oshr e1 (Econst (Ointconst n)) =>
      if Int.eq (Int.shru (Int.shl m n) n) m
      then Ebinop Oshr (uncast_int (Int.shl m n) e1) (Econst (Ointconst n))
      else e
  | _ => e
  end.Definition uncast_int8 (e: expr) : expr := uncast_int (Int.repr 255) e.Definition uncast_int16 (e: expr) : expr := uncast_int (Int.repr 65535) e.Function uncast_float32 (e: expr) : expr :=
  match e with
  | Eunop Osingleoffloat e1 => uncast_float32 e1
  | _ => e
  end.Function store_arg (chunk: memory_chunk) (e: expr) : expr :=
  match chunk with
  | Mint8signed | Mint8unsigned => uncast_int8 e
  | Mint16signed | Mint16unsigned => uncast_int16 e
  | Mfloat32 => uncast_float32 e
  | _ => e
  end.Definition make_store (chunk: memory_chunk) (e1 e2: expr): stmt :=
  Sstore chunk e1 (store_arg chunk e2).Definition make_stackaddr (ofs: Z): expr :=
  Econst (Oaddrstack (Int.repr ofs)).Definition make_globaladdr (id: ident): expr :=
  Econst (Oaddrsymbol id Int.zero).Definition make_unop (op: unary_operation) (e: expr): expr :=
  match op with
  | Ocast8unsigned => Eunop Ocast8unsigned (uncast_int8 e)
  | Ocast8signed => Eunop Ocast8signed (uncast_int8 e)
  | Ocast16unsigned => Eunop Ocast16unsigned (uncast_int16 e)
  | Ocast16signed => Eunop Ocast16signed (uncast_int16 e)
  | Osingleoffloat => Eunop Osingleoffloat (uncast_float32 e)
  | _ => Eunop op e
  end.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.(** * Optimization of casts *)

(** To remove redundant casts, we perform a modest static analysis
  on the values of expressions, classifying them into the following
  ranges. *)

Inductive approx : Type :=
  | Any                   (**r any value *)
  | Int1                  (**r [0] or [1] *)
  | Int7                  (**r [[0,127]] *)
  | Int8s                 (**r [[-128,127]] *)
  | Int8u                 (**r [[0,255]] *)
  | Int15                 (**r [[0,32767]] *)
  | Int16s                (**r [[-32768,32767]] *)
  | Int16u                (**r [[0,65535]] *)
  | Float32.Definition bge (x y: approx) : bool :=
  match x, y with
  | Any, _ => true
  | Int1, Int1 => true
  | Int7, (Int1 | Int7) => true
  | Int8s, (Int1 | Int7 | Int8s) => true
  | Int8u, (Int1 | Int7 | Int8u) => true
  | Int15, (Int1 | Int7 | Int8u | Int15) => true
  | Int16s, (Int1 | Int7 | Int8s | Int8u | Int15 | Int16s) => true
  | Int16u, (Int1 | Int7 | Int8u | Int15 | Int16u) => true
  | Float32, Float32 => true
  | _, _ => false
  end.Definition of_int (n: int) :=
  if Int.eq_dec n Int.zero || Int.eq_dec n Int.one then Int1
  else if Int.eq_dec n (Int.zero_ext 7 n) then Int7
  else if Int.eq_dec n (Int.zero_ext 8 n) then Int8u
  else if Int.eq_dec n (Int.sign_ext 8 n) then Int8s
  else if Int.eq_dec n (Int.zero_ext 15 n) then Int15
  else if Int.eq_dec n (Int.zero_ext 16 n) then Int16u
  else if Int.eq_dec n (Int.sign_ext 16 n) then Int16s
  else Any.Definition of_float (n: float) :=
  if Float.eq_dec n (Float.singleoffloat n) then Float32 else Any.Definition of_chunk (chunk: memory_chunk) :=
  match chunk with
  | Mint8signed => Int8s
  | Mint8unsigned => Int8u
  | Mint16signed => Int16s
  | Mint16unsigned => Int16u
  | Mint32 => Any
  | Mint64 => Any
  | Mfloat32 => Float32
  | Mfloat64 => Any
  | Mfloat64al32 => Any
  end.Definition unop (op: unary_operation) (a: approx) :=
  match op with
  | Ocast8unsigned => Int8u
  | Ocast8signed => Int8s
  | Ocast16unsigned => Int16u
  | Ocast16signed => Int16s
  | Osingleoffloat => Float32
  | _ => Any
  end.Definition unop_is_redundant (op: unary_operation) (a: approx) :=
  match op with
  | Ocast8unsigned => bge Int8u a
  | Ocast8signed => bge Int8s a
  | Ocast16unsigned => bge Int16u a
  | Ocast16signed => bge Int16s a
  | Osingleoffloat => bge Float32 a
  | _ => false
  end.Definition bitwise_and (a1 a2: approx) :=
  if bge Int1 a1 || bge Int1 a2 then Int1
  else if bge Int8u a1 || bge Int8u a2 then Int8u
  else if bge Int16u a1 || bge Int16u a2 then Int16u
  else Any.Definition bitwise_or (a1 a2: approx) :=
  if bge Int1 a1 && bge Int1 a2 then Int1
  else if bge Int8u a1 && bge Int8u a2 then Int8u
  else if bge Int16u a1 && bge Int16u a2 then Int16u
  else Any.Definition binop (op: binary_operation) (a1 a2: approx) :=
  match op with
  | Oand => bitwise_and a1 a2
  | Oor | Oxor => bitwise_or a1 a2
  | Ocmp _ => Int1
  | Ocmpu _ => Int1
  | Ocmpf _ => Int1
  | _ => Any
  end.(** * Translation of expressions and statements. *)

(** Generation of a Cminor expression for taking the address of
  a Csharpminor variable. *)

Definition var_addr (cenv: compilenv) (id: ident): expr :=
  match PTree.get id cenv with
  | Some ofs => make_stackaddr ofs
  | None     => make_globaladdr id
  end.(** Translation of constants. *)

Definition transl_constant (cst: Csharpminor.constant): (constant * approx) :=
  match cst with
  | Csharpminor.Ointconst n =>
      (Ointconst n, Approx.of_int n)
  | Csharpminor.Ofloatconst n =>
      (Ofloatconst n, Approx.of_float n)
  | Csharpminor.Olongconst n =>
      (Olongconst n, Any)
  end.(** To translate [switch] statements, we wrap the statements associated with
  the various cases in a cascade of nested Cminor blocks.
  The multi-way branch is performed by a Cminor [switch]
  statement that exits to the appropriate case.  For instance:
<<
switch (e) {        --->    block { block { block {
  case N1: s1;                switch (e) { N1: exit 0; N2: exit 1; default: exit 2; }
  case N2: s2;                } ; s1  // with exits shifted by 2
  default: s;                 } ; s2  // with exits shifted by 1
}                             } ; s   // with exits unchanged
>>
  To shift [exit] statements appropriately, we use a second
  compile-time environment, of type [exit_env], which
  records the blocks inserted during the translation.
  A [true] element means the block was present in the original code;
  a [false] element, that it was inserted during translation.
*)

Definition exit_env := list bool.Fixpoint shift_exit (e: exit_env) (n: nat) {struct e} : nat :=
  match e, n with
  | nil, _ => n
  | false :: e', _ => S (shift_exit e' n)
  | true :: e', O => O
  | true :: e', S m => S (shift_exit e' m)
  end.Fixpoint switch_table (ls: lbl_stmt) (k: nat) {struct ls} : list (int * nat) :=
  match ls with
  | LSdefault _ => nil
  | LScase ni _ rem => (ni, k) :: switch_table rem (S k)
  end.Fixpoint switch_env (ls: lbl_stmt) (e: exit_env) {struct ls}: exit_env :=
  match ls with
  | LSdefault _ => e
  | LScase _ _ ls' => false :: switch_env ls' e
  end.(** * Stack layout *)

(** Layout of the Cminor stack data block and construction of the
  compilation environment.  Every Csharpminor local variable is
  allocated a slot in the Cminor stack data.  Sufficient padding is
  inserted to ensure adequate alignment of addresses. *)

Definition block_alignment (sz: Z) : Z :=
  if zlt sz 2 then 1
  else if zlt sz 4 then 2
  else if zlt sz 8 then 4 else 8.Definition assign_variable
    (cenv_stacksize: compilenv * Z) (id_sz: ident * Z) : compilenv * Z :=
  let (id, sz) := id_sz in
  let (cenv, stacksize) := cenv_stacksize in
  let ofs := align stacksize (block_alignment sz) in
  (PTree.set id ofs cenv, ofs + Zmax 0 sz).Definition assign_variables (cenv_stacksize: compilenv * Z) (vars: list (ident * Z)) : compilenv * Z :=
  List.fold_left assign_variable vars cenv_stacksize.Definition t := (ident * Z)%type.Definition leb (v1 v2: t) : bool := zle (snd v1) (snd v2).

Theorem leb_total: forall v1 v2, leb v1 v2 = true \/ leb v2 v1 = true.