(* begin hide *)
Lists.List
Strings.String
Morphisms
ZArith
Setoid
RelationClasses.
Basics.Category
Basics.Monad
ITree
ITreeMonad
ITreeFacts
Events.StateFacts
Events.MapDefault
Events.MapDefaultFacts
Events.State.
Core.RelDec
Structures.Monad
Structures.Maps
Programming.Show
Data.Map.FMapAList.
Open Scope string_scope.
Open Scope cat_scope.
(* end hide *)
(* optimizations ------------------------------------------------------------ *)
(** A (simple) optimization is just a function from asm units to asm units. *)
Definition optimization {A B} := asm A B -> asm A B.
(** An optimization is correct if it yields an equivalent computation.  - Note that eq_asm requires that resulting register environment and the resulting heap must be equivalent, so this formulation of correctness does not permit the elimination of local variables or differences in the state.  Those optimizations would require more contextual information. *)
(** We define an appropriate notion of equivalence on these state components. This will be useful for defining optimizations at the [Asm] level. *)
Definition EQ_registers (d:value) (regs1 regs2 : registers) : Prop :=
@eq_map _ _ _ _ d regs1 regs2.
Global Instance EQ_registers_refl {d} : Reflexive (EQ_registers d).
unfold EQ_registers. typeclasses eauto.
Qed.
Global Instance EQ_registers_sym {d} : Symmetric (EQ_registers d).
unfold EQ_registers. typeclasses eauto.
Qed.
Global Instance EQ_registers_trans {d} : Transitive (EQ_registers d).
unfold EQ_registers. typeclasses eauto.
Qed.
Global Instance EQ_registers_eqv {d} : Equivalence (EQ_registers d).
constructor; typeclasses eauto.
Qed.
Definition EQ_memory (mem1 mem2 : memory) : Prop :=
@eq_map _ _ _ _ 0 mem1 mem2.
Global Instance EQ_memory_refl : Reflexive (EQ_memory).
unfold EQ_memory. typeclasses eauto.
Qed.
Global Instance EQ_memory_sym : Symmetric (EQ_memory).
unfold EQ_memory. typeclasses eauto.
Qed.
Global Instance EQ_memory_trans : Transitive (EQ_memory).
unfold EQ_memory. typeclasses eauto.
Qed.
Global Instance EQ_memory_eqv : Equivalence (EQ_memory).
constructor; typeclasses eauto.
Qed.
Definition rel_asm {B} : memory * (registers * B) -> memory * (registers * B) -> Prop :=
prod_rel EQ_memory (prod_rel (EQ_registers 0) eq).
Hint Unfold rel_asm.
(** The definition [interp_asm] also induces a notion of equivalence (open) _asm_ programs, which is just the equivalence of the ktree category *)
Definition eq_asm_denotations_EQ {E A B} (t1 t2 : Kleisli (itree (Reg +' Memory +' E)) A B) : Prop :=
forall a mem1 mem2 regs1 regs2,
EQ_memory mem1 mem2 ->
EQ_registers 0 regs1 regs2 ->
(eutt rel_asm)
(interp_asm (t1 a) mem1 regs1)
(interp_asm (t2 a) mem2 regs2).
Definition eq_asm_EQ {A B} (p1 p2 : asm A B) : Prop :=
eq_asm_denotations_EQ (denote_asm p1) (denote_asm p2).
Definition optimization_correct A B (opt:optimization) :=
forall (p : asm A B),
eq_asm_EQ p (opt p).
Definition EQ_asm {E A} (f g : memory -> registers -> itree E (memory * (registers * A))) : Prop :=
forall mem1 mem2 regs1 regs2,
EQ_memory mem1 mem2 ->
EQ_registers 0 regs1 regs2 ->
eutt (@rel_asm A) (f mem1 regs1) (g mem2 regs2).
Infix "≡" := EQ_asm (at level 70).

Lemma interp_asm_GetReg {E A} f r mem reg :
@eutt E _ _ (@rel_asm A)
(interp_asm (val <- trigger (GetReg r) ;; f val) mem reg)
((interp_asm (f (lookup_default r 0 reg))) mem reg).