(** Heavily annotated for a tutorial introduction. *)

(** First, import the entire Floyd proof automation system, which includes
 ** the VeriC program logic and the MSL theory of separation logic**)
Require Import VST.floyd.proofauto.

(** Import the [reverse.v] file, which is produced by CompCert's clightgen
 ** from reverse.c.   The file reverse.v defines abbreviations for identifiers
 ** (variable names, etc.) of the C program, such as _head, _reverse.
 ** It also defines "prog", which is the entire abstract syntax tree
 ** of the C program *)
Require Import VST.progs.reverse.

(* The C programming language has a special namespace for struct
** and union identifiers, e.g., "struct foo {...}".  Some type-based operators
** in the program logic need access to an interpretation of this namespace,
** i.e., the meaning of each struct-identifier such as "foo".  The next
** line (which looks identical for any program) builds this
** interpretation, called "CompSpecs" *)
#[export] Instance CompSpecs : compspecs. make_compspecs prog. Defined.

(** Calculate the "types-of-global-variables" specification
 ** directly from the program *)
Definition Vprog : varspecs. mk_varspecs prog. Defined.

(** A convenience definition *)
Definition t_struct_list := Tstruct _list noattr.

(** Inductive definition of linked lists *)
Fixpoint listrep (sigma: list val) (x: val) : mpred :=
 match sigma with
 | h::hs =>
    EX y:val,
      data_at Tsh t_struct_list (h,y) x  *  listrep hs y
 | nil =>
    !! (x = nullval) && emp
 end.

Fixpoint lsegrec (sigma: list val) (x z: val) : mpred :=
 match sigma with
 | h::hs =>
    EX y:val,
      data_at Tsh t_struct_list (h,y) x  *  lsegrec hs y z
 | nil =>
    !! (x = z) && emp
 end.

(* This file is only to demonstrate object language induction. *)

(* induction rule *)

Lemma list_ind_in_logc: forall {A: Type} (P: mpred) (Q: list A -> mpred),
  (P |-- Q nil) ->
  (P |-- ALL a: A, (ALL l: list A, Q l --> Q (a :: l))) ->
  P |-- ALL l: list A, Q l.
Proof.
  intros.
  apply allp_right; intro l.
  induction l; auto.
  rewrite (add_andp _ _ IHl), (add_andp _ _ H0).
  apply imp_andp_adjoint.
  apply andp_left2.
  apply (allp_left _ a).
  apply (allp_left _ l).
  auto.
Qed.

(* application *)

Lemma listrep2lsegrec: forall l x,
  listrep l x |-- lsegrec l x nullval.
Proof.
  assert (emp |-- ALL l: list val, (ALL x: val, listrep l x -* lsegrec l x nullval)).
  + apply list_ind_in_logc.
    - apply allp_right; intros.
      apply wand_sepcon_adjoint.
      rewrite emp_sepcon.
      simpl.
      apply derives_refl.
    - apply allp_right; intros a.
      apply allp_right; intros l.
      apply imp_andp_adjoint.
      apply allp_right; intros x.
      apply andp_left2.
      apply wand_sepcon_adjoint.
      simpl.
      Intros y.
      Exists y.
      apply wand_sepcon_adjoint.
      apply (allp_left _ y).
      apply wand_sepcon_adjoint.
      cancel.
      apply wand_sepcon_adjoint.
      apply derives_refl.
  + intros.
    rewrite <- (emp_sepcon (listrep _ _)).
    apply wand_sepcon_adjoint.
    eapply derives_trans; [exact H | clear H].
    apply (allp_left _ l).
    apply (allp_left _ x).
    apply derives_refl.
Qed.


From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.
From extructures Require Import ord fset fmap.
From CoqUtils Require Import hseq word.

Require Import lib.utils.
Require Import common.types.
Require Import concrete.concrete.
Require Import concrete.exec.
Require Import symbolic.symbolic.
Require Import symbolic.exec.
Require Import symbolic.rules.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Hint Constructors restricted_exec.
Hint Unfold exec.
Hint Resolve restricted_exec_trans.

Section Refinement.

Context {mt : machine_types}
        {ops : machine_ops mt}
        {opss : machine_ops_spec ops}
        {sp : Symbolic.params}
        {e : encodable mt Symbolic.ttypes}.

Definition refine_memory (amem : Symbolic.memory mt _) (cmem : Concrete.memory mt) :=
  (forall w x ctg atg,
     decode Symbolic.M cmem ctg = Some (User atg) ->
     cmem w = Some x@ctg ->
     amem w = Some x@atg) /\
  (forall w x atg,
     amem w = Some x@atg ->
     exists2 ctg,
       decode Symbolic.M cmem ctg = Some (User atg) &
       cmem w = Some x@ctg).

Definition refine_registers (areg : Symbolic.registers mt _)
                            (creg : Concrete.registers mt)
                            (cmem : Concrete.memory mt) :=
  (forall r x ctg atg,
     decode Symbolic.R cmem ctg = Some atg ->
     creg r = Some x@ctg ->
     areg r = Some x@atg) /\
  (forall r x atg,
     areg r = Some x@atg ->
     exists2 ctg,
       decode Symbolic.R cmem ctg = Some atg &
       creg r = Some x@ctg).

Definition in_monitor (st : Concrete.state mt) :=
  Concrete.is_monitor_tag (Concrete.pct st).
Hint Unfold in_monitor.

Definition in_user st : bool :=
  decode Symbolic.P (Concrete.mem st) (Concrete.pct st).
Hint Unfold in_user.

Definition cache_correct cache cmem :=
  forall cmvec crvec,
    Concrete.cache_lookup cache masks cmvec = Some crvec ->
    decode Symbolic.P cmem (Concrete.ctpc cmvec) ->
    exists ivec ovec,
      [/\ decode_ivec e cmem cmvec = Some ivec,
          decode_ovec e (Symbolic.op ivec) cmem crvec = Some ovec &
          Symbolic.transfer ivec = Some ovec ].

Definition in_mvec addr := addr \in Concrete.mvec_fields mt.

Definition mvec_in_monitor (cmem : Concrete.memory mt) :=
  forall addr,
    in_mvec addr ->
    exists w : mword mt, cmem addr = Some w@Concrete.TMonitor.

Lemma store_mvec_mvec_in_monitor cmem mvec :
  mvec_in_monitor (Concrete.store_mvec cmem mvec).
Proof.
move=> k; rewrite /Concrete.store_mvec unionmE.
set m := mkfmap _.
rewrite -mem_domm domm_mkfmap /in_mvec /Concrete.mvec_fields.
move=> E; rewrite E; have: k \in domm m by rewrite domm_mkfmap.
rewrite mem_domm {E}; case E: (m k) => [v|] // _.
move/mkfmap_Some: E; rewrite !inE.
do !(case/orP=> [/eqP [_ ->]|]; eauto).
by move/eqP => [_ ->]; eauto.
Qed.

(* CH: I find the way the "monitor invariant" is stated rather
   indirect. Is there no direct way to define this? *)
(* AAA: We need to add the cache as an argument here, since we don't
   assume anything about ground rules right now *)

Record monitor_invariant : Type := {
  monitor_invariant_statement :> Concrete.memory mt ->
                                Concrete.registers mt ->
                                Concrete.rules mt ->
                                Symbolic.internal_state -> Prop;

  monitor_invariant_upd_mem :
    forall regs mem1 mem2 cache addr w1 ct ut w2 int
           (MINV : monitor_invariant_statement mem1 regs cache int)
           (GET : mem1 addr = Some w1@ct)
           (DEC : decode Symbolic.M mem1 ct = Some (User ut))
           (UPD : updm mem1 addr w2 = Some mem2),
      monitor_invariant_statement mem2 regs cache int;

  monitor_invariant_upd_reg :
    forall mem regs1 regs2 cache r w1 ct1 ut1 w2 ct2 ut2 int
           (MINV : monitor_invariant_statement mem regs1 cache int)
           (GET : regs1 r = Some w1@ct1)
           (DEC1 : decode Symbolic.R mem ct1 = Some ut1)
           (UPD : updm regs1 r w2@ct2 = Some regs2)
           (DEC2 : decode Symbolic.R mem ct2 = Some ut2),
      monitor_invariant_statement mem regs2 cache int;

  monitor_invariant_store_mvec :
    forall mem mvec regs cache int
           (MINV : monitor_invariant_statement mem regs cache int),
      monitor_invariant_statement (Concrete.store_mvec mem mvec)
                                 regs cache int
}.

Hint Resolve monitor_invariant_upd_mem.
Hint Resolve monitor_invariant_upd_reg.
Hint Resolve monitor_invariant_store_mvec.

Variable mi : monitor_invariant.

Lemma in_user_in_monitor :
  forall st, in_user st -> ~~ in_monitor st.
Proof.
  move=> st.
  rewrite /in_user /in_monitor /Concrete.is_monitor_tag.
  apply contraTN=> /eqP ->.
  by rewrite decode_monitor_tag.
Qed.

Variable table : Symbolic.syscall_table mt.

Definition is_nop (i : mword mt) : bool :=
  match decode_instr i with
  | Some Nop => true
  | _ => false
  end.

Lemma is_nopP : forall i, is_nop i <-> decode_instr i = Some (Nop _).
Proof.
  rewrite /is_nop.
  move => i.
  by case: (decode_instr i) => [[]|] //=.
Qed.

Definition wf_entry_points (cmem : Concrete.memory mt) :=
  forall addr t,
    (exists2 sc, table addr = Some sc &
                 Symbolic.entry_tag sc = t) <->
    is_true match cmem addr with
            | Some i@it => is_nop i && (decode Symbolic.M cmem it == Some (Entry t))
            | None => false
            end.

Lemma wf_entry_points_if cmem addr sc :
  wf_entry_points cmem ->
  table addr = Some sc ->
  exists i it,
  [/\ cmem addr = Some i@it,
      decode Symbolic.M cmem it = Some (Entry (Symbolic.entry_tag sc)) &
      is_nop i ].
Proof.
  move => WFENTRYPOINTS GETCALL.
  have: exists2 sc', table addr = Some sc' &
                     Symbolic.entry_tag sc' = Symbolic.entry_tag sc by eauto.
  move/WFENTRYPOINTS.
  case: (cmem addr) => [[i it]|] //.
  move/andP => [H1 H2]. exists i, it.
  split; trivial.
  by apply/eqP.
Qed.

Lemma wf_entry_points_only_if cmem addr i it t :
  wf_entry_points cmem ->
  cmem addr = Some i@it ->
  decode Symbolic.M cmem it = Some (Entry t) ->
  is_nop i ->
  exists2 sc,
    table addr = Some sc &
    Symbolic.entry_tag sc = t.
Proof.
  move => WF GET DEC ISNOP.
  apply/WF.
  by rewrite GET DEC eqxx andbT.
Qed.

Lemma entry_point_undefined cmem smem addr v it t :
  refine_memory smem cmem ->
  cmem addr = Some v@it ->
  decode Symbolic.M cmem it = Some (Entry t) ->
  smem addr = None.
Proof.
  move => REFM GET DEC.
  case GET': (smem addr) => [[v' t']|] //.
  move/(proj2 REFM): GET'.
  rewrite GET. case=> it' H1 [? ?]. subst v' it'. congruence.
Qed.

Inductive refine_state (sst : Symbolic.state mt) (cst : Concrete.state mt) : Prop := RefineState {
  rs_pc : Symbolic.pcv sst = Concrete.pcv cst;
  rs_pct : decode Symbolic.P (Concrete.mem cst) (Concrete.pct cst) =
           Some (Symbolic.pct sst);
  rs_refm : refine_memory (Symbolic.mem sst) (Concrete.mem cst);
  rs_refr : refine_registers (Symbolic.regs sst) (Concrete.regs cst) (Concrete.mem cst);
  rs_cache : cache_correct (Concrete.cache cst) (Concrete.mem cst);
  rs_mvec : mvec_in_monitor (Concrete.mem cst);
  rs_entry_points : wf_entry_points (Concrete.mem cst);
  rs_minv : mi (Concrete.mem cst) (Concrete.regs cst)
               (Concrete.cache cst) (Symbolic.internal sst)
}.

Lemma refine_state_in_user sst cst :
  refine_state sst cst ->
  in_user cst.
Proof.
  case=> ? DEC *.
  by rewrite /in_user DEC.
Qed.

Lemma refine_memory_upd cache aregs cregs amem cmem cmem' addr v v' ct t ct' t' :
  cache_correct cache cmem ->
  refine_registers aregs cregs cmem ->
  refine_memory amem cmem ->
  cmem addr = Some v@ct ->
  decode Symbolic.M cmem ct = Some (User t) ->
  updm cmem addr v'@ct' = Some cmem' ->
  decode Symbolic.M cmem ct' = Some (User t') ->
  exists amem',
    [/\ updm amem addr v'@t' = Some amem',
        cache_correct cache cmem',
        refine_registers aregs cregs cmem' &
        refine_memory amem' cmem'].
Proof.
  move=> Hcache Hregs Hmem Hget Hdec Hupd Hdec'.
  have Hget' := proj1 Hmem _ _ _ _ Hdec Hget.
  move: Hupd; rewrite /updm Hget Hget' /= => - [<-].
  have Hdec_eq := decode_monotonic v' _ Hget Hdec Hdec'.
  eexists; split; trivial.
  - move=> cmvec crvec Hlookup.
    case Hdec_pc: (decode _ _ _) => [pct|] //= Hpct_user.
    rewrite Hdec_eq in Hdec_pc.
    have := Hcache cmvec crvec Hlookup.
    rewrite Hdec_pc => /(_ Hpct_user) [ivec [ovec [Hdec_ivec Hdec_ovec Htrans]]].
    rewrite -(decode_ivec_monotonic v' Hget Hdec Hdec') in Hdec_ivec.
    rewrite -(decode_ovec_monotonic _ v' Hget Hdec Hdec') in Hdec_ovec.
    by eauto using And3.
  - split.
    + move=> w x ct'' st'' Hdec_ct' Hget''.
      rewrite Hdec_eq in Hdec_ct'.
      by eapply (proj1 Hregs); eauto.
    + move=> w x st'' /(proj2 Hregs _ _ _) [ct'' Hdec_ct'' Hget''].
      rewrite -Hdec_eq in Hdec_ct''.
      by eauto.
  - split.
    + move=> w x ct'' st'' Hdec_ct' Hget''.
      rewrite Hdec_eq in Hdec_ct'.
      move: Hget''; rewrite !setmE.
      have [Heq|Hneq] := w =P addr.
      * subst w; move=> [? ?]; subst.
        by move: Hdec_ct'; rewrite Hdec' => -[->].
      * by eapply (proj1 Hmem); eauto.
    + move=> w x st Hget''; move: Hget'' Hdec_eq; rewrite /updm !setmE.
      have [_ {w}|Hneq] := altP (w =P addr).
        move => [-> Ht]; eexists ct'=> //.
        by rewrite Hdec_eq Hdec' Ht.
      move=> Hget''.
      have [ct'' Hdec_ct'' Hget_ct''] := proj2 Hmem _ _ _ Hget''.
      rewrite Hget_ct''=> Hdec''; eexists ct''=> //.
      by rewrite Hdec''.
Qed.

Lemma wf_entry_points_user_upd cmem cmem' addr v v' ct t ct' t' :
  wf_entry_points cmem ->
  cmem addr = Some v@ct ->
  decode Symbolic.M cmem ct = Some (User t) ->
  updm cmem addr v'@ct' = Some cmem' ->
  decode Symbolic.M cmem ct' = Some (User t') ->
  wf_entry_points cmem'.
Proof.
move=> Hwf Hget Hdec Hupd Hdec' addr' t''; rewrite Hwf.
have := decode_monotonic _ _ Hget Hdec Hdec'.
move: Hupd; rewrite /updm Hget /= => - [<-] {cmem'} Hmono.
rewrite setmE.
have [-> {addr'}|_] := altP (addr' =P addr).
  by rewrite Hget !Hmono Hdec Hdec' !andbF.
case: (cmem addr') => [[i ti]|] //.
  by rewrite Hmono.
Qed.

Lemma mvec_in_monitor_user_upd cmem cmem' addr v v' ct t ct' t' :
  mvec_in_monitor cmem ->
  cmem addr = Some v@ct ->
  decode Symbolic.M cmem ct = Some (User t) ->
  updm cmem addr v'@ct' = Some cmem' ->
  decode Symbolic.M cmem ct' = Some (User t') ->
  mvec_in_monitor cmem'.
Proof.
  intros MVEC GET DEC UPD DEC'.
  intros addr' H.
  specialize (MVEC addr' H). destruct MVEC as [w' KER].
  assert (NEQ : addr' <> addr).
  { intros E. subst addr'.
    have CONTRA : Concrete.TMonitor = ct by congruence. subst ct.
    by rewrite decode_monitor_tag in DEC. }
  move: UPD; rewrite /updm GET /= => - [<-].
  by rewrite setmE (introF eqP NEQ) KER; eauto.
Qed.

Lemma mvec_in_monitor_monitor_upd cmem cmem' addr w :
  mvec_in_monitor cmem ->
  updm cmem addr w@Concrete.TMonitor = Some cmem' ->
  mvec_in_monitor cmem'.
Proof.
intros MVEC UPD addr' IN.
move: UPD; rewrite /updm; case: (cmem _) => //= _ [<-].
rewrite setmE.
by have [?|/eqP NEQ] := altP (addr' =P addr); simpl in *; subst; eauto.
Qed.

Lemma refine_memory_upd' cache aregs cregs amem amem' cmem addr v ct t :
  cache_correct cache cmem ->
  refine_registers aregs cregs cmem ->
  refine_memory amem cmem ->
  updm amem addr v@t = Some amem' ->
  decode Symbolic.M cmem ct = Some (User t) ->
  exists cmem',
    [/\ updm cmem addr v@ct = Some cmem',
        cache_correct cache cmem',
        refine_registers aregs cregs cmem' &
        refine_memory amem' cmem' ].
Proof.
  move=> Hcache Hregs Hmem Hupd Hdec.
  have [[x t'] Hget] : exists a, amem addr = Some a.
    by move: Hupd; rewrite /updm; case: (amem _); eauto.
  have [ct' Hdec' Hget'] := proj2 Hmem _ _ _ Hget.
  have Hupd' : updm cmem addr v@ct = Some (setm cmem addr v@ct).
    by rewrite /updm Hget'.
  have Hdec_eq := decode_monotonic v _ Hget' Hdec' Hdec.
  rewrite Hupd'. eexists. split; eauto.
  - move=> cmvec crvec Hlookup.
    rewrite Hdec_eq.
    move=> /(Hcache _ _ Hlookup) [ivec [ovec [Hdec_i Hdec_o Htrans]]].
    rewrite -(decode_ivec_monotonic v Hget' Hdec' Hdec) in Hdec_i.
    rewrite -(decode_ovec_monotonic _ v Hget' Hdec' Hdec) in Hdec_o.
    by eauto using And3.
  - split.
    + move=> r x'' ct'' st'' Hdec_ct'' Hget''.
      rewrite Hdec_eq in Hdec_ct''.
      by apply (proj1 Hregs _ _ _ _ Hdec_ct'' Hget'').
    + move=> r x'' st'' /(proj2 Hregs) [ct'' Hdec_ct'' Hget''].
      rewrite -Hdec_eq in Hdec_ct''.
      by eauto.
  - move: Hupd; rewrite /updm Hget=> - [<-] {amem'}; split.
    + move=> w x'' ct'' st''.
      rewrite Hdec_eq !setmE.
      have [_ {w}|_] := altP (w =P addr).
        move=> Hdec_ct'' [Hv Hct]. move: Hv Hct Hdec_ct'' => <- <- {x'' ct''}.
        by rewrite Hdec; move => [->].
      by apply (proj1 Hmem).
    + move=> w x' st'.
      rewrite !setmE.
      case: (w == addr) => [{w} [<- <-] {x' st'}|].
        exists ct=> //.
        by rewrite Hdec_eq.
      move=> /(proj2 Hmem) [ct'' Hdec_ct'' Hget''].
      exists ct''=> //.
      by rewrite Hdec_eq.
Qed.

Lemma refine_registers_upd areg creg creg' cmem r v v' ct t ct' t' :
  refine_registers areg creg cmem ->
  creg r = Some v@ct ->
  decode Symbolic.R cmem ct = Some t ->
  updm creg r v'@ct' = Some creg' ->
  decode Symbolic.R cmem ct' = Some t' ->
  exists2 areg',
    updm areg r v'@t' = Some areg' &
    refine_registers areg' creg' cmem.
Proof.
  move=> Hregs Hget Hdec Hupd Hdec'.
  have Hget' := proj1 Hregs _ _ _ _ Hdec Hget.
  have Hupd' : updm areg r v'@t' = Some (setm areg r v'@t').
    by rewrite /updm Hget'.
  move: Hupd; rewrite {1}/updm Hget /= => - [<-].
  rewrite Hupd'; eexists => //; split.
  - move=> r' x ct'' st''.
    rewrite !setmE.
    case: (r' == r) => [Hdec'' [Hx Hct'']|].
      move: Hx Hct'' Hdec'' => <- <-.
      by rewrite Hdec'=> [[->]].
    by apply (proj1 Hregs).
  - move=> r' x st''.
    rewrite !setmE.
    case: (r' == r) => [[<- <-] {x st''}|]; first by eauto.
    by apply (proj2 Hregs).
Qed.

Lemma refine_registers_upd' areg areg' creg cmem r v ct t :
  refine_registers areg creg cmem ->
  updm areg r v@t = Some areg' ->
  decode Symbolic.R cmem ct = Some t ->
  exists2 creg',
    updm creg r v@ct = Some creg' &
    refine_registers areg' creg' cmem.
Proof.
  rewrite /updm; case Hget: (areg r)=> [[v0 t0]|] //= Hregs [<-] Hdec.
  have [ct0 Hdec' Hget'] := proj2 Hregs _ _ _ Hget.
  rewrite Hget' /=.
  eexists=> //; split.
  - move=> r' x ct' st'; rewrite !setmE.
    case: (r' == r) => [Hdec_ct' [Hx Hct']|].
      move: Hx Hct' Hdec_ct' => <- <- {x ct'}.
      by rewrite Hdec => [[<-]].
    by apply (proj1 Hregs).
  - move=> r' x st'; rewrite !setmE.
    case: (r' == r) => [[<- <-] {x st'}|]; first by rewrite -Hdec; eauto.
    by apply (proj2 Hregs).
Qed.

Inductive hit_step cst cst' : Prop :=
| hs_intro (USER : in_user cst)
           (USER' : in_user cst')
           (STEP : Concrete.step _ masks cst cst').

Definition monitor_exec kst kst' :=
  restricted_exec (Concrete.step _ masks)
                  (fun s => in_monitor s)
                  kst kst'.
Hint Unfold monitor_exec.

Definition monitor_user_exec kst st : Prop :=
  exec_until (Concrete.step _ masks)
             (fun s => in_monitor s)
             (fun s => ~~ in_monitor s)
             kst st.

Inductive user_monitor_user_step cst cst' : Prop :=
| ukus_intro kst
             (USER : in_user cst)
             (STEP : Concrete.step _ masks cst kst)
             (EXEC : monitor_user_exec kst cst').

Lemma user_monitor_user_step_weaken cst cst' :
  user_monitor_user_step cst cst' ->
  exec (Concrete.step _ masks) cst cst'.
Proof.
  move => [cst'' ? ? ?].
  eapply re_step; trivial; try eassumption.
  eapply exec_until_weaken; eassumption.
Qed.

Definition user_step cst cst' :=
  hit_step cst cst' \/ user_monitor_user_step cst cst'.

Lemma analyze_cache cache cmem cmvec crvec :
  cache_correct cache cmem ->
  Concrete.cache_lookup cache masks cmvec = Some crvec ->
  decode Symbolic.P cmem (Concrete.ctpc cmvec) ->
  let op := Concrete.cop cmvec in
  if Symbolic.privileged_op op then False else
  exists tpc : Symbolic.tag_type Symbolic.ttypes Symbolic.P, decode Symbolic.P cmem (Concrete.ctpc cmvec) = Some tpc /\
  ((exists (ti : Symbolic.tag_type Symbolic.ttypes Symbolic.M)
           (ts : hseq (Symbolic.tag_type Symbolic.ttypes) (Symbolic.inputs op))
           (rtpc : Symbolic.tag_type Symbolic.ttypes Symbolic.P)
           (rt : Symbolic.type_of_result Symbolic.ttypes (Symbolic.outputs op)),
    let ovec := Symbolic.OVec rtpc rt in
    [/\ decode Symbolic.M cmem (Concrete.cti cmvec) = Some (User ti) ,
        decode_ovec e op cmem crvec = Some ovec ,
        Symbolic.transfer (Symbolic.IVec op tpc ti ts) = Some ovec &
        decode_fields e _ cmem (Concrete.ct1 cmvec, Concrete.ct2 cmvec, Concrete.ct3 cmvec) =
        Some (hmap (fun k x => Some (wtag_of_tag x)) ts) ]) \/
   exists t : Symbolic.entry_tag_type Symbolic.ttypes,
     [/\ op = NOP ,
         decode Symbolic.M cmem (Concrete.cti cmvec) = Some (Entry t) &
         Concrete.ctrpc crvec = Concrete.TMonitor ]).
Proof.
  case: cmvec => op tpc ti t1 t2 t3 /= CACHE LOOKUP INUSER.
  case: (CACHE _ crvec LOOKUP INUSER) =>
  [[[op'|] tpc' ti' ts] /= [ovec /= [/decode_ivec_inv /= E1 E2 E3]]]; last first.
    case: E1 => [? ? ->]. subst op.
    move: E2 => /=.
    have [-> _| //] := (Concrete.ctrpc _ =P _).
    by eauto 11 using And3.
  case: E1 => [? Hpriv -> ->]. subst op' => ->.
  rewrite (negbTE Hpriv). eexists. split; eauto.
  case: ovec E2 E3 => trpc tr /=.
  case: (decode _ cmem _) => [trpc'|] //= DEC.
  by eauto 11 using And4.
Qed.

Lemma miss_state_not_user st mvec :
  ~~ (in_user (Concrete.miss_state st mvec)).
Proof.
  apply/negP=> INUSER.
  apply in_user_in_monitor in INUSER.
  unfold Concrete.miss_state in INUSER.
  unfold in_monitor, Concrete.is_monitor_tag in INUSER.
  by rewrite /= eqxx in INUSER.
Qed.

Lemma valid_initial_user_instr_tags cst cst' v ti :
  cache_correct (Concrete.cache cst) (Concrete.mem cst) ->
  in_user cst ->
  in_user cst' ->
  Concrete.step _ masks cst cst' ->
  Concrete.mem cst (Concrete.pcv cst) = Some v@ti ->
  oapp (fun x => is_user x) false (decode Symbolic.M (Concrete.mem cst) ti).
Proof.
  move=> Hcache Huser Huser' Hstep Hget.
  have [cmvec [Hcmvec]] := step_lookup_success_or_fault Hstep.
  case Hlookup: (Concrete.cache_lookup _ _ _) => [crvec|].
    have := Hcache _ _ Hlookup.
    rewrite (build_cmvec_ctpc Hcmvec) => /(_ Huser) [ivec [ovec [Hdec_i Hdec_o Htrans]]] Hpc_cst'.
    have := build_cmvec_cop_cti Hcmvec.
    rewrite Hget => [[i [instr [[<- -> {i}] _ _]]]].
    have := decode_ivec_inv Hdec_i.
    case: ivec ovec {Hdec_i} Hdec_o Htrans => [[op'|] tpc' ti' ts'] /= ovec Hdec_o Htrans.
      by move=> [? ? ? -> ?].
    move=> [_ _ _].
    move: ovec Huser' {Htrans} Hdec_o.
    rewrite /in_user /= -{}Hpc_cst' => [[]].
    have [->|//] := (_ =P _).
    by rewrite decode_monitor_tag.
  rewrite /= => Hcst'.
  move: Huser'.
  by rewrite /in_user {}Hcst' /= decode_monitor_tag.
Qed.

Lemma valid_pcs st st' :
  Concrete.step _ masks st st' ->
  cache_correct (Concrete.cache st) (Concrete.mem st) ->
  in_user st ->
  (exists t,
     decode Symbolic.P (Concrete.mem st') (Concrete.pct st') = Some t) \/
  Concrete.pct st' = Concrete.TMonitor.
Proof.
  move=> Hstep Hcache Huser.
  have [cmvec [Hcmvec]] := step_lookup_success_or_fault Hstep.
  case Hlookup: (Concrete.cache_lookup _ _ _) => [crvec|].
    have := Hcache _ _ Hlookup.
    rewrite (build_cmvec_ctpc Hcmvec) => /(_ Huser) [ivec [ovec [Hdec_i Hdec_o Htrans]]] Hpc_st'.
    have := decode_ivec_inv Hdec_i.
    case: ivec ovec Hdec_i Hdec_o Htrans=> [[op|] tpc ti ts] ovec Hdec_i Hdec_o Htrans.
      move=> [Hop Hpriv _ _ _].
      move: ti ts ovec {Htrans} Hdec_i Hdec_o.
      rewrite Hop /= -{}Hpc_st' => ti ts ovec.
      case Hdec: (decode Symbolic.P (Concrete.mem st) _) => [st''|] //= Hdec_i Hdec_o.
      suff : @decode _ _ e Symbolic.P (Concrete.mem st') =1
             @decode _ _ e Symbolic.P (Concrete.mem st).
        move=> E. rewrite -E in Hdec. by eauto.
      move/concrete.exec.stepP: Hstep Hcmvec Hdec_i Hdec_o.
      rewrite /step /build_cmvec {1}(Concrete.state_eta st) /=.
      case Hget: (getm _ (Concrete.pcv _)) => [[i cti]|] //=.
      case Hdec_i: (decode_instr i) => [instr|] //=.
      destruct instr; move=> Hstep; match_inv; try by []; move => [?]; subst cmvec;
      unfold Concrete.next_state_reg, Concrete.next_state_pc,
             Concrete.next_state_reg_and_pc, Concrete.next_state in *;
      simpl in *;
      match goal with
      | H : match _ with _ => _ end = Some _ |- _ =>
        rewrite Hlookup in H
      end; match_inv;
      repeat match goal with
      | H : Some _ = Some _ |- _ => inv H; simpl in *
      end; trivial.
      rewrite /decode_ivec /= => ?.
      match_inv; simpl in *;
      repeat match goal with
      | H : hshead _ = _ |- _ => rewrite /hshead /hnth eq_axiomK /= in H
      | a : atom _ _ |- _ => destruct a
      | H : OP _ = OP _ |- _ => inversion H; subst; clear H
      end; simpl in *; subst.
      move=> H /=; match_inv.
      move: E1; rewrite /updm; case: (getm _ _) => /= [_|] // [<-].
      by eapply decode_monotonic; eauto.
    rewrite {}Hpc_st'.
    case=> [_ _ _].
    move: ovec {Htrans} Hdec_o.
    rewrite /= => [[]].
    by have [->|//] := _ =P Concrete.TMonitor; auto.
  by rewrite /= => ->; auto.
Qed.

Hint Unfold Symbolic.next_state.
Hint Unfold Symbolic.next_state_reg_and_pc.
Hint Unfold Symbolic.next_state_pc.
Hint Unfold Symbolic.next_state_reg.

Definition user_tags_unchanged cmem cmem' :=
  forall ctg tk stg,
    decode tk cmem ctg = Some stg <->
    decode tk cmem' ctg = Some stg.

Definition user_mem_unchanged (cmem cmem' : Concrete.memory mt) :=
  forall addr (w : mword mt) ct t,
    decode Symbolic.M cmem ct = Some t ->
    (cmem addr = Some w@ct <->
     cmem' addr = Some w@ct).

Definition user_regs_unchanged (cregs cregs' : Concrete.registers mt) cmem :=
  forall r (w : mword mt) ct t,
    decode Symbolic.R cmem ct = Some t ->
    (cregs r = Some w@ct <->
     cregs' r = Some w@ct).

Lemma get_mem_no_user smem mem addr v ctg t :
  refine_memory smem mem ->
  getm smem addr = None ->
  getm mem addr = Some v@ctg ->
  decode Symbolic.M mem ctg = Some t ->
  exists ut, t = Entry ut.
Proof.
  intros REF SGET GET DEC.
  destruct t.
  - move: (proj1 REF addr v ctg s DEC GET).
    by rewrite SGET.
  - eexists; reflexivity.
Qed.

(* Returns true iff our machine is at the beginning of a system call
and the cache says it is allowed to execute. To simplify this
definition, we assume that system calls are only allowed to begin with
Nop, which is consistent with how we've defined our symbolic handler
in rules.v. *)
Definition cache_allows_syscall (cst : Concrete.state mt) : bool :=
  match table (Concrete.pcv cst) with
  | Some _ =>
    match build_cmvec cst with
    | Some cmvec => Concrete.cache_lookup (Concrete.cache cst) masks cmvec
    | None => false
    end
  | None => false
  end.

Class monitor_code_fwd_correctness : Prop := {

(* BCP: Added some comments -- please check! *)
  handler_correct_allowed_case_fwd :
  forall mem cmvec ivec ovec reg cache old_pc int,
    (* If monitor invariant holds... *)
    mi mem reg cache int ->
    (* and calling the handler on the current m-vector succeeds and returns rvec... *)
    decode_ivec e mem cmvec = Some ivec ->
    Symbolic.transfer ivec = Some ovec ->
    (* and storing the concrete representation of the m-vector yields new memory mem'... *)
    let mem' := Concrete.store_mvec mem cmvec in
    (* and the concrete rule cache is correct (in the sense that every
       rule it holds is exactly the concrete representations of
       some (mvec,rvec) pair in the relation defined by the [handler]
       function) ... *)
    cache_correct cache mem ->
    (* THEN if we start the concrete machine in monitor mode (i.e.,
       with the PC tagged TMonitor) at the beginning of the fault
       handler (and with the current memory, and with the current PC
       in the return-addr register epc)) and let it run until it
       reaches a user-mode state st'... *)
    exists st' crvec,
      monitor_user_exec
        (Concrete.State mem' reg cache
                          (Concrete.fault_handler_start _)@Concrete.TMonitor
                          old_pc)
        st' /\
      (* then the new cache is still correct... *)
      cache_correct (Concrete.cache st') (Concrete.mem st') /\
      (* and the new cache now contains a rule mapping mvec to rvec... *)
      Concrete.cache_lookup (Concrete.cache st') masks cmvec = Some crvec /\
      decode_ovec e (Symbolic.op ivec) (Concrete.mem st') crvec = Some ovec /\
      (* and the mvec has been tagged as monitor data (BCP: why is this important??) *)
      mvec_in_monitor (Concrete.mem st') /\
      (* and we've arrived at the return address that was in epc with
         unchanged user memory and registers... *)
      user_tags_unchanged mem (Concrete.mem st') /\
      user_mem_unchanged mem (Concrete.mem st') /\
      user_regs_unchanged reg (Concrete.regs st') mem /\
      Concrete.pc st' = old_pc /\
      (* and the system call entry points are all tagged ENTRY (BCP:
         Why do we care, and if we do then why isn't this part of the
         monitor invariant?  Could user code possibly change it?) *)
      wf_entry_points (Concrete.mem st') /\
      (* and the monitor invariant still holds. *)
      mi (Concrete.mem st') (Concrete.regs st') (Concrete.cache st') int;

  syscalls_correct_allowed_case_fwd :
  forall amem areg apc atpc int
         amem' areg' apc' atpc' int'
         cmem creg cache ctpc epc sc,
    (* and the monitor invariant holds... *)
    mi cmem creg cache int ->
    (* and the USER-tagged portion of the concrete memory cmem
       corresponds to the abstract (symbolic??) memory amem... *)
    refine_memory amem cmem ->
    (* and the USER-tagged concrete registers in creg correspond to
       the abstract register set areg... *)
    refine_registers areg creg cmem ->
    (* and the rule cache is correct... *)
    cache_correct cache cmem ->
    (* and the mvec has been tagged as monitor data (BCP: again, why is this
       important... and why is it now part of the premises whereas
       upstairs it was part of the conclusion??) *)
    mvec_in_monitor cmem ->
    (* and the symbolic system call at addr is the function
       sc... (BCP: This would make more sense after the next
       hypothesis) *)
    table apc = Some sc ->
    (* and running sc on the current abstract machine state reaches a
       new state with primes on everything... *)
    Symbolic.run_syscall sc (Symbolic.State amem areg apc@atpc int) = Some (Symbolic.State amem' areg' apc'@atpc' int') ->
    decode Symbolic.P cmem ctpc = Some atpc ->
    let cst := Concrete.State cmem
                                creg
                                cache
                                apc@ctpc epc in

    cache_allows_syscall cst ->

    (* THEN if we start the concrete machine in monitor mode at the
       beginning of the corresponding system call code and let it run
       until it reaches a user-mode state with primes on everything... *)

    exists cmem' creg' cache' ctpc' epc',
      user_monitor_user_step cst
                            (Concrete.State cmem' creg' cache'
                                              apc'@ctpc' epc') /\

      (* then the new concrete state is in the same relation as before
         with the new abstract state and the same invariants
         hold (BCP: Plus one more about ra!). *)
      decode Symbolic.P cmem' ctpc' = Some atpc' /\
      refine_memory amem' cmem' /\
      refine_registers areg' creg' cmem' /\
      cache_correct cache' cmem' /\
      mvec_in_monitor cmem' /\
      wf_entry_points cmem' /\
      mi cmem' creg' cache' int'

}.

Class monitor_code_bwd_correctness : Prop := {

  handler_correct_allowed_case_bwd :
  forall mem cmvec reg cache old_pc int st',
    mi mem reg cache int ->
    let mem' := Concrete.store_mvec mem cmvec in
    cache_correct cache mem ->
    monitor_user_exec
        (Concrete.State mem' reg cache
                          (Concrete.fault_handler_start _)@Concrete.TMonitor
                          old_pc)
        st' ->
    exists ivec ovec,
      decode_ivec e mem cmvec = Some ivec /\
      Symbolic.transfer ivec = Some ovec /\
      cache_correct (Concrete.cache st') (Concrete.mem st') /\
      mvec_in_monitor (Concrete.mem st') /\
      user_tags_unchanged mem (Concrete.mem st') /\
      user_mem_unchanged mem (Concrete.mem st') /\
      user_regs_unchanged reg (Concrete.regs st') mem /\
      Concrete.pc st' = old_pc /\
      wf_entry_points (Concrete.mem st') /\
      mi (Concrete.mem st') (Concrete.regs st') (Concrete.cache st') int;

  handler_correct_disallowed_case :
  forall mem cmvec reg cache old_pc int st',
    (* If monitor invariant holds... *)
    mi mem reg cache int ->
    (* and calling the handler on mvec FAILS... *)
    match decode_ivec e mem cmvec with
    | Some ivec => ~~ Symbolic.transfer ivec
    | None => true
    end ->
    (* and storing the concrete representation of the m-vector yields new memory mem'... *)
    let mem' := Concrete.store_mvec mem cmvec in
    (* then if we start the concrete machine in monitor mode and let it
       run, it will never reach a user-mode state. *)
    ~~ in_monitor st' ->
    ~ exec (Concrete.step _ masks)
      (Concrete.State mem' reg cache
                        (Concrete.fault_handler_start _)@Concrete.TMonitor
                        old_pc)
      st';

  syscalls_correct_allowed_case_bwd :
  forall amem areg apc atpc int
         cmem creg cache ctpc epc
         cmem' creg' cache' cpc' ctpc' epc' sc,
    mi cmem creg cache int ->
    refine_memory amem cmem ->
    refine_registers areg creg cmem ->
    cache_correct cache cmem ->
    mvec_in_monitor cmem ->
    table apc = Some sc ->
    decode Symbolic.P cmem ctpc = Some atpc ->
    let cst := Concrete.State cmem
                                creg
                                cache
                                apc@ctpc epc in
    cache_allows_syscall cst ->
    user_monitor_user_step cst
                          (Concrete.State cmem' creg' cache'
                                            cpc'@ctpc' epc') ->
    exists amem' areg' atpc' int',
      Symbolic.run_syscall sc (Symbolic.State amem areg apc@atpc int) =
      Some (Symbolic.State amem' areg' cpc'@atpc' int') /\
      decode Symbolic.P cmem' ctpc' = Some atpc' /\
      refine_memory amem' cmem' /\
      refine_registers areg' creg' cmem' /\
      cache_correct cache' cmem' /\
      mvec_in_monitor cmem' /\
      wf_entry_points cmem' /\
      mi cmem' creg' cache' int'

}.

End Refinement.


(*

  Copyright 2014 Cornell University
  Copyright 2015 Cornell University
  Copyright 2016 Cornell University
  Copyright 2017 Cornell University

  This file is part of VPrl (the Verified Nuprl project).

  VPrl is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  VPrl is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with VPrl.  If not, see <http://www.gnu.org/licenses/>.

  Websites: http://nuprl.org/html/verification/
            http://nuprl.org/html/Nuprl2Coq
            https://github.com/vrahli/NuprlInCoq

  Authors: Abhishek Anand & Vincent Rahli

*)

Require Export cequiv_seq_util.
Require Export sequents_tacs2.
(*Require Export per_props4.*)
Require Export per_can.
Require Export per_props_atom.
Require Export per_props_ffatom.
Require Export per_props_squash.
Require Export per_props_nat2.

(* !!MOVE *)
Lemma member_mkc_squash {p} :
  forall lib (T : @CTerm p),
    member lib mkc_axiom (mkc_squash T)
    <=> inhabited_type lib T.
Proof.
  intros.
  rw @equality_in_mkc_squash.
  split; intro h; repnd; dands; auto; spcast;
  apply computes_to_valc_refl; eauto 3 with slow.
Qed.

Lemma tequality_natk2nat_nat {o} :
  forall lib n,
    @tequality o lib (natk2nat (mkc_nat n)) (natk2nat (mkc_nat n)).
Proof.
  introv.
  apply tequality_natk2nat.
  exists (Z.of_nat n) (Z.of_nat n).
  dands; spcast; try (apply computes_to_valc_refl; eauto 3 with slow).
  introv ltk.
  destruct (Z_lt_le_dec k (Z.of_nat n)); sp.
Qed.
Hint Resolve tequality_natk2nat_nat : slow.

Lemma equality_in_nout {o} :
  forall lib (a b : @CTerm o),
    equality lib a b mkc_nout
    <=> {u : CTerm
         , noutokensc u
         # ccequivc lib a u
         # ccequivc lib b u}.
Proof.
  introv.
  unfold mkc_nout.
  rw @equality_in_set.
  split; intro h; repnd.

  - allrw @mkcv_ffatoms_substc.
    allrw @mkc_var_substc.
    apply inhabited_free_from_atoms in h; exrepnd.
    allrw @equality_in_base_iff; spcast.
    exists u; dands; spcast; auto.
    eapply cequivc_trans;[|eauto].
    apply cequivc_sym; auto.

  - exrepnd.
    dands.

    + introv equ.
      allrw @equality_in_base_iff; spcast.
      allrw @mkcv_ffatoms_substc.
      allrw @mkc_var_substc.
      unfold mkc_ffatoms.
      apply tequality_free_from_atoms; dands; eauto 3 with slow.
      apply equality_in_base_iff; spcast; auto.

    + spcast.
      apply equality_in_base_iff; spcast; auto.
      eapply cequivc_trans;[eauto|].
      apply cequivc_sym; auto.

    + spcast.
      allrw @mkcv_ffatoms_substc.
      allrw @mkc_var_substc.
      unfold mkc_ffatoms.
      apply inhabited_free_from_atoms.
      exists u; dands; eauto 3 with slow.

      * apply tequality_base.

      * apply equality_in_base_iff; spcast; auto.
Qed.

Lemma type_mkc_nout {o} :
  forall lib, @type o lib mkc_nout.
Proof.
  introv.
  unfold mkc_nout.
  apply tequality_set; dands; auto.
  introv eb.
  allrw @mkcv_ffatoms_substc.
  allrw @mkc_var_substc.
  unfold mkc_ffatoms.
  apply tequality_free_from_atoms; dands; eauto 3 with slow.
Qed.
Hint Resolve type_mkc_nout : slow.

Lemma tequality_natk2nout {o} :
  forall lib (a b : @CTerm o),
    tequality lib (natk2nout a) (natk2nout b)
     <=> {k1 : Z
          , {k2 : Z
          , (a) ===>(lib) (mkc_integer k1)
          # (b) ===>(lib) (mkc_integer k2)
          # (forall k : Z,
               (0 <= k)%Z ->
               ((k < k1)%Z # (k < k2)%Z){+}(k1 <= k)%Z # (k2 <= k)%Z)}}.
Proof.
  introv.
  unfold natk2nout.
  rw @tequality_mkc_fun.
  rw @tequality_mkc_natk.
  split; intro k; exrepnd; dands; eauto 3 with slow.

  - spcast; exists k1 k0; dands; spcast; auto.

  - spcast; exists k1 k2; dands; spcast; auto.

  - introv inh; apply type_mkc_nout.
Qed.

Lemma tequality_natk2nout_nat {o} :
  forall lib n,
    @tequality o lib (natk2nout (mkc_nat n)) (natk2nout (mkc_nat n)).
Proof.
  introv.
  apply tequality_natk2nout.
  exists (Z.of_nat n) (Z.of_nat n).
  dands; spcast; try (apply computes_to_valc_refl; eauto 3 with slow).
  introv ltk.
  destruct (Z_lt_le_dec k (Z.of_nat n)); sp.
Qed.
Hint Resolve tequality_natk2nout_nat : slow.

Lemma type_nat2nout {o} :
  forall (lib : @library o), type lib nat2nout.
Proof.
  introv.
  unfold nat2nout.
  apply type_mkc_fun; dands; eauto 3 with slow.
Qed.
Hint Resolve type_nat2nout : slow.

(* ========================== *)

Lemma implies_equality_natk2nat {o} :
  forall lib (f g : @CTerm o) n,
    (forall m,
       m < n
       -> {k : nat
           & computes_to_valc lib (mkc_apply f (mkc_nat m)) (mkc_nat k)
           # computes_to_valc lib (mkc_apply g (mkc_nat m)) (mkc_nat k)})
    -> equality lib f g (natk2nat (mkc_nat n)).
Proof.
  introv imp.
  apply equality_in_fun; dands; eauto 3 with slow.

  { apply type_mkc_natk.
    exists (Z.of_nat n); spcast.
    apply computes_to_valc_refl; eauto 3 with slow. }

  introv e.
  apply equality_in_natk in e; exrepnd; spcast.

  eapply equality_respects_cequivc_left;
    [apply implies_cequivc_apply;
      [apply cequivc_refl
      |apply cequivc_sym;
        apply computes_to_valc_implies_cequivc;
        exact e0]
    |].

  eapply equality_respects_cequivc_right;
    [apply implies_cequivc_apply;
      [apply cequivc_refl
      |apply cequivc_sym;
        apply computes_to_valc_implies_cequivc;
        exact e2]
    |].

  clear dependent a.
  clear dependent a'.

  apply computes_to_valc_isvalue_eq in e3; eauto 3 with slow.
  rw @mkc_nat_eq in e3; ginv.

  assert (m < n) as ltm by omega.
  clear e1.

  apply equality_in_tnat.
  pose proof (imp m ltm) as h; exrepnd.
  exists k; dands; spcast; auto.
Qed.

Lemma implies_member_natk2nat {o} :
  forall lib (f : @CTerm o) n,
    (forall m,
       m < n
       -> {k : nat & computes_to_valc lib (mkc_apply f (mkc_nat m)) (mkc_nat k)})
    -> member lib f (natk2nat (mkc_nat n)).
Proof.
  introv imp.
  apply implies_equality_natk2nat.
  introv ltm.
  apply imp in ltm; exrepnd.
  exists k; auto.
Qed.

Lemma equality_natk2nat_implies {o} :
  forall lib m (f g : @CTerm o) n,
    m < n
    -> equality lib f g (natk2nat (mkc_nat n))
    -> {k : nat
        & computes_to_valc lib (mkc_apply f (mkc_nat m)) (mkc_nat k)
        # computes_to_valc lib (mkc_apply g (mkc_nat m)) (mkc_nat k)}.
Proof.
  introv ltm mem.
  apply equality_in_fun in mem; repnd.
  clear mem0 mem1.
  pose proof (mem (mkc_nat m) (mkc_nat m)) as h; clear mem.
  autodimp h hyp.

  { apply equality_in_natk.
    exists m (Z.of_nat n); dands; spcast; try omega;
    try (apply computes_to_valc_refl; eauto 2 with slow). }

  apply equality_in_tnat in h.
  apply equality_of_nat_imp_tt in h.
  unfold equality_of_nat_tt in h; exrepnd.
  exists k; auto.
Qed.

Lemma member_natk2nat_implies {o} :
  forall lib m (f : @CTerm o) n,
    m < n
    -> member lib f (natk2nat (mkc_nat n))
    -> {k : nat & computes_to_valc lib (mkc_apply f (mkc_nat m)) (mkc_nat k)}.
Proof.
  introv ltm mem.
  eapply equality_natk2nat_implies in mem;[|exact ltm].
  exrepnd.
  exists k; auto.
Qed.

(* ========================== *)

Definition eq_kseq {o} lib (s1 s2 : @CTerm o) (n : nat) :=
  equality lib s1 s2 (natk2nat (mkc_nat n)).

Lemma eq_kseq_left {o} :
  forall lib (seq1 seq2 : @CTerm o) k,
    eq_kseq lib seq1 seq2 k
    -> eq_kseq lib seq1 seq1 k.
Proof.
  introv e.
  apply equality_refl in e; auto.
Qed.

Definition fun_sim_eq {o} lib s1 H (t : @NTerm o) w (u : CTerm) :=
  {s2 : CSub
   & {c2 : cover_vars t s2
   & similarity lib s1 s2 H
   # u = lsubstc t w s2 c2}}.


Require Import Coq.Lists.List.
Require Import Logic.GeneralLogic.Base.
Require Import Logic.GeneralLogic.ProofTheory.BasicSequentCalculus.
Require Import Logic.MinimumLogic.Syntax.
Require Import Logic.MinimumLogic.ProofTheory.Minimum.
Require Import Logic.MinimumLogic.ProofTheory.RewriteClass.
Require Import Logic.PropositionalLogic.Syntax.
Require Import Logic.PropositionalLogic.ProofTheory.Intuitionistic.
Require Import Logic.PropositionalLogic.ProofTheory.Classical.
Require Import Logic.PropositionalLogic.ProofTheory.DeMorgan.
Require Import Logic.PropositionalLogic.ProofTheory.GodelDummett.
Require Import Logic.PropositionalLogic.ProofTheory.RewriteClass.
Require Import SeparationLogic.Syntax.
Require Import SeparationLogic.ProofTheory.SeparationLogic.
Require Import SeparationLogic.ProofTheory.RewriteClass.
Require Import SeparationLogic.ProofTheory.IterSepcon.
Require Import SeparationLogic.ProofTheory.TheoryOfSeparationAxioms.

Require Import Logic.LogicGenerator.Utils.
Require Import Logic.LogicGenerator.ConfigDenot.
Require Import Logic.LogicGenerator.ConfigCompute.
Require Logic.LogicGenerator.ConfigLang.

Require Config.

Section Generate.
Context {L: Language}
        {minL: MinimumLanguage L}
        {pL: PropositionalLanguage L}
        {sepconL : SepconLanguage L}
        {wandL : WandLanguage L}
        {empL: EmpLanguage L}
        {iter_sepcon_L: IterSepconLanguage L}
        {GammaP: Provable L}
        {GammaD: Derivable L}
        {iter_sepcon_Def: NormalIterSepcon L}
        {AX: NormalAxiomatization L GammaP GammaD}
        {SC : NormalSequentCalculus L GammaP GammaD}
        {minAX: MinimumAxiomatization L GammaP}
        {ipAX: IntuitionisticPropositionalLogic L GammaP}
        {cpAX: ClassicalPropositionalLogic L GammaP}
        {dmpAX: DeMorganPropositionalLogic L GammaP}
        {gdpAX: GodelDummettPropositionalLogic L GammaP}
        {sepconAX: SepconAxiomatization L GammaP}
        {wandAX: WandAxiomatization L GammaP}
        {empAX: EmpAxiomatization L GammaP}
        {sepcon_orp_AX: SepconOrAxiomatization L GammaP}
        {sepcon_falsep_AX: SepconFalseAxiomatization L GammaP}
        {sepconAX_weak: SepconAxiomatization_weak L GammaP}
        {sepconAX_weak_iffp: SepconAxiomatization_weak_iffp L GammaP}
        {sepcon_mono_AX: SepconMonoAxiomatization L GammaP}
        {empAX_iffp: EmpAxiomatization_iffp L GammaP}
        {extAX: ExtSeparationLogic L GammaP}
        {nseAX: NonsplitEmpSeparationLogic L GammaP}
        {deAX: DupEmpSeparationLogic L GammaP}
        {mfAX: MallocFreeSeparationLogic L GammaP}
        {gcAX: GarbageCollectSeparationLogic L GammaP}
        {bSC : BasicSequentCalculus L GammaD}
        {fwSC : FiniteWitnessedSequentCalculus L GammaD}
        {minSC: MinimumSequentCalculus L GammaD}
        {ipSC: IntuitionisticPropositionalSequentCalculus L GammaD}
        {cpSC: ClassicalPropositionalSequentCalculus L GammaD}
        .

Import NameListNotations.

Definition foo :=
  ltac:(
    let res := eval compute in
    (ConfigCompute.result
       Config.how_connectives
       Config.how_judgements
       Config.transparent_names
       Config.primitive_rule_classes)
    in exact res).

Definition primitive_types: list Name :=
  map_with_hint
    (ConfigDenot.D.types, ConfigDenot.S.types)
    (ConfigLang.Output.primitive_types foo).

Definition transparent_types: list Name :=
  map_with_hint
    (ConfigDenot.D.types, ConfigDenot.S.types)
    (ConfigLang.Output.transparent_types foo).

Definition derived_types: list Name :=
  map_with_hint
    (ConfigDenot.D.how_types, ConfigDenot.S.how_types)
    (ConfigLang.Output.derived_types foo).

Definition primitive_connectives: list Name :=
  map_with_hint
    (ConfigDenot.D.connectives, ConfigDenot.S.connectives)
    (ConfigLang.Output.primitive_connectives foo).

Definition transparent_connectives: list Name :=
  map_with_hint
    (ConfigDenot.D.connectives, ConfigDenot.S.connectives)
    (ConfigLang.Output.transparent_connectives foo).

Definition derived_connectives: list Name :=
  map_with_hint
    (ConfigDenot.D.how_connectives, ConfigDenot.S.how_connectives)
    (ConfigLang.Output.derived_connectives foo).

Definition primitive_judgements: list Name :=
  map_with_hint
    (ConfigDenot.D.judgements, ConfigDenot.S.judgements)
    (ConfigLang.Output.primitive_judgements foo).

Definition transparent_judgements: list Name :=
  map_with_hint
    (ConfigDenot.D.judgements, ConfigDenot.S.judgements)
    (ConfigLang.Output.transparent_judgements foo).

Definition derived_judgements: list Name :=
  map_with_hint
    (ConfigDenot.D.how_judgements, ConfigDenot.S.how_judgements)
    (ConfigLang.Output.derived_judgements foo).

Definition aux_primitive_instances: list Name :=
  map_with_hint
    (ConfigDenot.D.classes, ConfigDenot.S.instances_build)
    (ConfigLang.Output.primitive_classes foo).

Definition aux_refl_instances_for_derivation: list Name :=
  map_with_hint
    (ConfigDenot.D.refl_classes, ConfigDenot.S.refl_instances)
    (ConfigLang.Output.refl_classes_for_derivation foo).

Definition aux_derived_instances: list Name :=
  map_with_hint
    (ConfigDenot.S.D_instance_transitions, ConfigDenot.S.instance_transitions)
    (ConfigLang.Output.how_derive_classes foo).

Definition primary_rules: list Name :=
  map_with_hint
    (ConfigDenot.S.D_primary_rules, ConfigDenot.S.primary_rules)
    (ConfigLang.Output.primary_rules foo).

Let derived_rules': list Name :=
  (map_with_hint
    (ConfigDenot.S.D_primary_rules, ConfigDenot.S.primary_rules)
    (ConfigLang.Output.derived_primary_rules foo)) ++
  map_with_hint
    (ConfigDenot.S.D_derived_rules, ConfigDenot.S.derived_rules)
    (ConfigLang.Output.derived_derived_rules foo).

Definition derived_rules : list Name :=
  ltac:(let res0 := eval unfold derived_rules' in derived_rules' in
        let res1 := eval unfold app at 1 in res0 in
            exact res1).

Definition derived_rules_as_instance :=
  map_with_hint
    (ConfigDenot.S.D_derived_rules, ConfigDenot.S.derived_rules)
    (ConfigLang.Output.derived_rules_as_instance foo).

Import ListNotations.

Inductive PrintType := IPar (Inline_list: list Name) | Axm | Der | Def | AIns | DIns.

Ltac print prt name :=
  match name with
  | BuildName ?n =>
    match type of n with
    | ?T =>
      match prt with
      | IPar ?l =>
        let l := eval hnf in l in
        let should_inline := in_name_list n l in
        match should_inline with
        | true => idtac "  Parameter Inline" n ":" T "."
        | false => idtac "  Parameter" n ":" T "."
        end
      | Axm => idtac "  Axiom" n ":" T "."
      | Der => match n with
               | (?n0, ?n1) => idtac "  Definition" n0 ":=" n1 "."
               end
      | Def => idtac "  Definition" n ":" T ":=" n "."
      | AIns => match n with
                | (?n0, ?n1) =>
                  match type of n0 with
                  | ?T0 => idtac "  Instance" n0 ":" T0 ":=" n1 "."
                  end
                end
      | DIns => idtac "  Existing Instance" n "."
      end
    end
  end.

Ltac newline := idtac "".

Set Printing Width 1000.

Ltac two_stage_print :=
  idtac "Require Import Coq.Lists.List.";
  idtac "Require Import Coq.Sets.Ensembles.";
  idtac "Import ListNotations.";

  newline;

  idtac "Module Type LanguageSig.";
  dolist (print (IPar transparent_types)) primitive_types;
  dolist (print Der) derived_types;
  dolist (print (IPar transparent_judgements)) primitive_judgements;
  dolist (print (IPar transparent_connectives)) primitive_connectives;
  idtac "End LanguageSig.";

  newline;

  idtac "Module DerivedNames (Names: LanguageSig).";
  idtac "  Import Names.";
  dolist (print Der) derived_connectives;
  dolist (print Der) derived_judgements;
  idtac "End DerivedNames.";

  newline;

  idtac "Module Type PrimitiveRuleSig (Names: LanguageSig).";
  idtac "Import Names.";
  idtac "Include DerivedNames (Names).";
  dolist (print Axm) primary_rules;
  idtac "End PrimitiveRuleSig.";

  newline;

  idtac "Module Type LogicTheoremSig (Names: LanguageSig) (Rules: PrimitiveRuleSig Names).";
  idtac "  Include Rules.";
  idtac "  Import Names Rules.";
  dolist (print Axm) derived_rules;
  dolist (print DIns) derived_rules_as_instance;
  idtac "End LogicTheoremSig.";

  newline;

  idtac "Require Import Logic.GeneralLogic.Base.";
  idtac "Require Import Logic.GeneralLogic.ProofTheory.BasicSequentCalculus.";
  idtac "Require Import Logic.MinimumLogic.Syntax.";
  idtac "Require Import Logic.MinimumLogic.ProofTheory.Minimum.";
  idtac "Require Import Logic.MinimumLogic.ProofTheory.RewriteClass.";
  idtac "Require Import Logic.PropositionalLogic.Syntax.";
  idtac "Require Import Logic.PropositionalLogic.ProofTheory.Intuitionistic.";
  idtac "Require Import Logic.PropositionalLogic.ProofTheory.DeMorgan.";
  idtac "Require Import Logic.PropositionalLogic.ProofTheory.GodelDummett.";
  idtac "Require Import Logic.PropositionalLogic.ProofTheory.Classical.";
  idtac "Require Import Logic.PropositionalLogic.ProofTheory.RewriteClass.";
  idtac "Require Import Logic.SeparationLogic.Syntax.";
  idtac "Require Import Logic.SeparationLogic.ProofTheory.SeparationLogic.";
  idtac "Require Import Logic.SeparationLogic.ProofTheory.RewriteClass.";
  idtac "Require Import SeparationLogic.ProofTheory.TheoryOfSeparationAxioms.";
  idtac "Require Import SeparationLogic.ProofTheory.IterSepcon.";

  newline;

  idtac "Module LogicTheorem (Names: LanguageSig) (Rules: PrimitiveRuleSig Names): LogicTheoremSig Names Rules.";
  idtac "  Import Names Rules.";
  idtac "  Include Rules.";
  dolist (print AIns) aux_primitive_instances;
  dolist (print AIns) aux_refl_instances_for_derivation;
  dolist (print AIns) aux_derived_instances;
  dolist (print Def) derived_rules;
  dolist (print DIns) derived_rules_as_instance;
  idtac "End LogicTheorem.";

  newline;

  idtac "Require Logic.PropositionalLogic.DeepEmbedded.Solver.";
  idtac "Module IPSolver (Names: LanguageSig).";
  idtac "  Import Names.";
  idtac "  Ltac ip_solve :=";
  idtac "    change expr with Base.expr;";
  idtac "    change provable with Base.provable;";
  idtac "    change impp with Syntax.impp;";
  idtac "    change andp with Syntax.andp;";
  idtac "    intros; Solver.SolverSound.ipSolver.";
  idtac "End IPSolver.";

  idtac.

Goal False.
  two_stage_print.
Abort.

End Generate.


(*

  Copyright 2014 Cornell University
  Copyright 2015 Cornell University

  This file is part of VPrl (the Verified Nuprl project).

  VPrl is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  VPrl is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with VPrl.  If not, see <http://www.gnu.org/licenses/>.

  Website: http://nuprl.org/html/verification/
  Authors: Abhishek Anand & Vincent Rahli & Mark Bickford

 *)

Require Export per_props_atom.

Lemma tequality_free_from_atom {o} :
  forall lib (T1 T2 : @CTerm o) x1 x2 a1 a2,
    tequality
      lib
      (mkc_free_from_atom T1 x1 a1)
      (mkc_free_from_atom T2 x2 a2)
      <=> (tequality lib T1 T2
           # equality lib x1 x2 T1
           # equality lib a1 a2 mkc_uatom).
Proof.
  introv.
  sp_iff Case.

  - Case "->".
    intros teq.
    unfold tequality, nuprl in teq; exrepnd.
    inversion teq0; subst; try not_univ.
    allunfold_per.
    computes_to_value_isvalue.
    unfold tequality; dands; tcsp.

    + exists eqa; auto.

    + exists eqa; dands; auto.
      allapply @nuprl_refl; auto.

    + rw @equality_in_uatom_iff.
      exists u; dands; spcast; auto.

  - Case "<-".
    introv e; exrepnd.
    rename e0 into teq.
    rename e1 into eqx.
    rename e into equ.
    unfold tequality in teq; exrepnd.
    allrw @equality_in_uatom_iff; exrepnd; spcast.
    exists (per_ffatom_eq lib eq a x1).
    apply CL_ffatom.
    unfold per_ffatom.
    exists T1 T2 x1 x2 a1 a2 eq a.

    dands; spcast; auto;
    try (complete (spcast; apply computes_to_valc_refl;
                   try (apply iscvalue_mkc_free_from_atom))).
    eapply equality_eq1 in teq0; apply teq0; auto.
Qed.

Hint Resolve iscvalue_mkc_uatom : slow.

Lemma equality_free_from_atom_in_uni {o} :
  forall lib (T1 T2 : @CTerm o) x1 x2 a1 a2 i,
    equality
      lib
      (mkc_free_from_atom T1 x1 a1)
      (mkc_free_from_atom T2 x2 a2)
      (mkc_uni i)
      <=> (equality lib T1 T2 (mkc_uni i)
           # equality lib x1 x2 T1
           # equality lib a1 a2 mkc_uatom).
Proof.
  introv.
  sp_iff Case.

  - Case "->".
    intros teq.
    unfold equality, nuprl in teq; exrepnd.
    inversion teq1; subst; try not_univ.
    duniv j h.
    allrw @univi_exists_iff; exrepd.
    computes_to_value_isvalue; GC.
    discover; exrepnd.
    rename eqa into eqi.
    ioneclose; subst; try not_univ.

    unfold per_ffatom in *; exrepnd; spcast.
    computes_to_value_isvalue; GC.
    dands.

    {
      exists eq; sp.
      allrw.
      exists eqa; sp.
    }

    {
      exists eqa; sp.
      allfold (@nuprli o lib j0).
      apply nuprli_implies_nuprl with (i := j0); sp.
      allapply @nuprli_refl; sp.
    }

    {
      exists (equality_of_uatom lib).
      dands; auto.
      - apply CL_uatom; unfold per_uatom; dands; spcast; auto;
          apply computes_to_valc_refl; eauto 2 with slow.
      - exists u; dands; spcast; auto.
    }

  - Case "<-".
    intro eqs.
    destruct eqs as [eqa eqb].
    destruct eqb as [eqb eqc].

    unfold equality in eqb; exrepnd.
    rename eq into eqT.
    apply equality_in_uatom_iff in eqc; exrepnd; spcast.

    unfold equality in eqa; exrepnd.
    rename eq into eqi.

    exists eqi; dands; auto.
    inversion eqa1; subst; try not_univ;[].
    duniv j h.
    allrw @univi_exists_iff; exrepd; spcast.
    computes_to_value_isvalue; GC.
    discover; exrepnd.

    allrw.
    exists (per_ffatom_eq lib eqT a x1).
    apply CL_ffatom.
    unfold per_ffatom.
    exists T1 T2 x1 x2 a1 a2 eqT a.

    dands; spcast; auto;
    try (complete (spcast; apply computes_to_valc_refl;
                   try (apply iscvalue_mkc_free_from_atom))).

    fold (nuprli lib j0) in *.
    applydup @nuprli_implies_nuprl in h0.
    pose proof (nuprl_uniquely_valued lib T1 eqT eqa) as q.
    repeat (autodimp q hyp);[eapply nuprl_refl; eauto|].
    eapply nuprli_ext;[exact h0|].
    apply eq_term_equals_sym; auto.
Qed.

Lemma tequality_free_from_atoms {o} :
  forall lib (T1 T2 : @CTerm o) x1 x2,
    tequality
      lib
      (mkc_free_from_atoms T1 x1)
      (mkc_free_from_atoms T2 x2)
      <=> (tequality lib T1 T2
           # equality lib x1 x2 T1).
Proof.
  introv.
  sp_iff Case.

  - Case "->".
    intros teq.
    unfold tequality, nuprl in teq; exrepnd.
    inversion teq0; subst; try not_univ.
    allunfold_per.
    computes_to_value_isvalue.
    unfold tequality; dands; tcsp.

    + exists eqa; auto.

    + exists eqa; dands; auto.
      allapply @nuprl_refl; auto.

  - Case "<-".
    introv e; exrepnd.
    rename e0 into teq.
    rename e into eqx.
    unfold tequality in teq; exrepnd.
    allrw @equality_in_uatom_iff; exrepnd; spcast.
    exists (per_ffatoms_eq lib eq x1).
    apply CL_ffatoms.
    unfold per_ffatoms.
    exists T1 T2 x1 x2 eq.

    dands; spcast; auto;
    try (complete (spcast; apply computes_to_valc_refl;
                   try (apply iscvalue_mkc_free_from_atoms))).
    eapply equality_eq1 in teq0; apply teq0; auto.
Qed.

Definition name_not_in_upto_eq {o} lib (a x T : @CTerm o) :=
  {u : get_patom_set o
   , {y : CTerm
   , a ===>(lib) (mkc_utoken u)
   # equality lib x y T
   # !LIn u (getc_utokens y)}}.

Lemma name_not_in_utpo_iff_eq {o} :
  forall lib (A1 A2 : @CTerm o) eqa a x,
    nuprl lib A1 A2 eqa
    -> (name_not_in_upto lib a x eqa <=> name_not_in_upto_eq lib a x A1).
Proof.
  introv n.
  unfold name_not_in_upto.
  unfold name_not_in_upto_eq.
  split; intro h; exrepnd.

  - exists u y; dands; auto.
    eapply equality_eq1 in n; apply n; auto.

  - exists u y; dands; auto.
    eapply equality_eq1 in n; apply n; auto.
Qed.

Lemma tequality_efree_from_atom {o} :
  forall lib (T1 T2 : @CTerm o) x1 x2 a1 a2,
    tequality
      lib
      (mkc_efree_from_atom T1 x1 a1)
      (mkc_efree_from_atom T2 x2 a2)
      <=> (tequality lib T1 T2
           # (name_not_in_upto_eq lib a1 x1 T1 <=> name_not_in_upto_eq lib a2 x2 T2)).
Proof.
  introv.
  sp_iff Case.

  - Case "->".
    intros teq.
    unfold tequality, nuprl in teq; exrepnd.
    inversion teq0; subst; try not_univ.
    allunfold_per.
    computes_to_value_isvalue.
    unfold tequality; dands; tcsp.

    + exists eqa; auto.

    + pose proof (name_not_in_utpo_iff_eq lib A1 A2 eqa a0 x0) as i1.
      autodimp i1 hyp.
      pose proof (name_not_in_utpo_iff_eq lib A2 A1 eqa a3 x3) as i2.
      autodimp i2 hyp.
      { apply nuprl_sym; auto. }
      rw <- i1; rw <- i2; auto.

  - Case "<-".
    introv e; exrepnd.
    rename e0 into teq.
    rename e into eqx.
    unfold tequality in teq; exrepnd.
    exists (per_effatom_eq lib eq a1 x1).
    apply CL_effatom.
    unfold per_effatom.
    exists T1 T2 x1 x2 a1 a2 eq.

    dands; spcast; auto;
    try (complete (spcast; apply computes_to_valc_refl;
                   try (apply iscvalue_mkc_efree_from_atom))).
    pose proof (name_not_in_utpo_iff_eq lib T1 T2 eq a1 x1) as i1.
    autodimp i1 hyp.
    pose proof (name_not_in_utpo_iff_eq lib T2 T1 eq a2 x2) as i2.
    autodimp i2 hyp.
    { apply nuprl_sym; auto. }
    rw i1; rw i2; auto.
Qed.

Lemma equality_in_free_from_atom {o} :
  forall lib (t1 t2 T t a : @CTerm o),
    equality lib t1 t2 (mkc_free_from_atom T t a)
    <=> {y : CTerm
         , {u : get_patom_set o
         , t1 ===>(lib) mkc_axiom
         # t2 ===>(lib) mkc_axiom
         # a ===>(lib) (mkc_utoken u)
         # type lib T
         # equality lib t y T
         # !LIn u (getc_utokens y)}}.
Proof.
  introv.
  sp_iff Case.

  - Case "->".
    introv equ.
    unfold equality, nuprl in equ; exrepnd.
    inversion equ1; subst; try not_univ.
    match goal with
      | [ H : per_ffatom _ _ _ _ _ |- _ ] => rename H into h
    end.
    unfold per_ffatom in h; exrepnd; spcast.
    allfold (@nuprl o lib).
    computes_to_value_isvalue.
    apply h1 in equ0.
    unfold per_ffatom_eq in equ0; exrepnd.
    exists y u; dands; spcast; auto.

    + exists eqa; auto.

    + eapply equality_eq in h3; apply h3; auto.

  - Case "<-".
    introv equ; repnd; spcast.
    unfold member, equality in equ; exrepnd; spcast.

    exists (per_ffatom_eq lib eq u t).
    dands.

    + apply CL_ffatom.
      exists T T t t a a eq u; dands; auto; spcast; auto;
      try (apply computes_to_valc_refl; try (apply iscvalue_mkc_free_from_atom)).
      eapply equality_eq_refl; eauto.

    + unfold per_ffatom_eq; dands; spcast; auto.
      exists y.
      dands; auto.
Qed.

Lemma equality_in_free_from_atoms {o} :
  forall lib (a b T t : @CTerm o),
    equality lib a b (mkc_free_from_atoms T t)
    <=> {u : CTerm
         , a ===>(lib) mkc_axiom
         # b ===>(lib) mkc_axiom
         # type lib T
         # equality lib t u T
         # noutokensc u}.
Proof.
  introv.
  sp_iff Case.

  - Case "->".
    introv equ.
    unfold equality, nuprl in equ; exrepnd.
    inversion equ1; subst; try not_univ.
    match goal with
      | [ H : per_ffatoms _ _ _ _ _ |- _ ] => rename H into h
    end.
    unfold per_ffatoms in h; exrepnd; spcast.
    allfold (@nuprl o lib).
    computes_to_value_isvalue.
    apply h0 in equ0.
    unfold per_ffatoms_eq in equ0; exrepnd.
    exists y; dands; auto.

    + exists eqa; auto.

    + eapply equality_eq in h3; apply h3; auto.

  - Case "<-".
    introv equ; repnd; spcast.
    unfold member, equality in equ; exrepnd.

    exists (per_ffatoms_eq lib eq t).
    dands.

    + apply CL_ffatoms.
      exists T T t t eq; dands; auto; spcast;
      try (apply computes_to_valc_refl; try (apply iscvalue_mkc_free_from_atoms)).
      eapply equality_eq_refl; eauto.

    + unfold per_ffatoms_eq; dands; spcast; auto.
      exists u.
      dands; auto.
Qed.

Lemma inhabited_free_from_atoms {o} :
  forall lib (T t : @CTerm o),
    inhabited_type lib (mkc_free_from_atoms T t)
    <=> {u : CTerm
         , type lib T
         # equality lib t u T
         # noutokensc u}.
Proof.
  introv.
  unfold inhabited_type.
  sp_iff Case; introv h; exrepnd.
  - apply equality_in_free_from_atoms in h0; exrepnd.
    exists u; dands; auto.
  - exists (@mkc_axiom o).
    apply equality_in_free_from_atoms.
    exists u; dands; spcast; auto;
    try (apply computes_to_valc_refl; try (apply iscvalue_mkc_axiom)).
Qed.

Lemma equality_in_efree_from_atom {o} :
  forall lib (t1 t2 T t a : @CTerm o),
    equality lib t1 t2 (mkc_efree_from_atom T t a)
    <=> {y : CTerm
         , {u : get_patom_set o
         , t1 ===>(lib) mkc_axiom
         # t2 ===>(lib) mkc_axiom
         # a ===>(lib) (mkc_utoken u)
         # type lib T
         # equality lib t y T
         # !LIn u (getc_utokens y)}}.
Proof.
  introv.
  sp_iff Case.

  - Case "->".
    introv equ.
    unfold equality, nuprl in equ; exrepnd.
    inversion equ1; subst; try not_univ.
    match goal with
      | [ H : per_effatom _ _ _ _ _ |- _ ] => rename H into h
    end.
    unfold per_effatom in h; exrepnd; spcast.
    allfold (@nuprl o lib).
    computes_to_value_isvalue.
    apply h0 in equ0.
    unfold per_effatom_eq in equ0; exrepnd.
    allunfold @name_not_in_upto; exrepnd.
    exists y u; dands; spcast; auto.

    + exists eqa; auto.

    + eapply equality_eq in h3; apply h3; auto.

  - Case "<-".
    introv equ; repnd; spcast.
    unfold member, equality in equ; exrepnd; spcast.

    exists (per_effatom_eq lib eq a t).
    dands.

    + apply CL_effatom.
      exists T T t t a a eq; dands; auto; spcast; auto;
      try (apply computes_to_valc_refl; try (apply iscvalue_mkc_efree_from_atom)).

    + unfold per_effatom_eq; dands; spcast; auto.
      exists u y.
      dands; spcast; auto.
Qed.


From Coq Require Import Lists.List.
From Coq Require Import BinNums.
From Coq Require Import ZArith.BinInt.
From Coq Require Import ZArith.BinIntDef.
From Coq Require Import ZArith.Zdigits.
From Coq Require Import ZArith Psatz.
Import ListNotations.

Open Scope Z_scope.

Inductive MMove :=
  | MX
  | MY
  | MZ
.

Inductive EMove :=
  | EA
  | EB
  | EC
.

Inductive Rule :=
  | R : EMove -> MMove -> Rule
.

Definition input : list Rule := [
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MY;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EB MX;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EB MX;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EB MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MX;
  R EB MY;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MX;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MY;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EB MY;
  R EB MX;
  R EB MX;
  R EA MX;
  R EB MX;
  R EA MZ;
  R EB MX;
  R EA MY;
  R EA MX;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EA MY;
  R EB MX;
  R EA MY;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MY;
  R EA MX;
  R EA MZ;
  R EA MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EB MY;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EB MZ;
  R EA MX;
  R EA MZ;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EB MX;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EC MX;
  R EB MX;
  R EB MY;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EB MY;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EA MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MX;
  R EB MX;
  R EA MX;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EC MX;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EA MY;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MX;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EB MY;
  R EC MZ;
  R EA MX;
  R EC MX;
  R EC MY;
  R EA MZ;
  R EC MX;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MX;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EB MX;
  R EA MX;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EA MX;
  R EB MX;
  R EA MY;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EB MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EA MZ;
  R EB MX;
  R EB MX;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EB MX;
  R EC MY;
  R EA MZ;
  R EA MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EA MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EA MX;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MY;
  R EA MZ;
  R EB MX;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EA MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EB MY;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EA MZ;
  R EC MZ;
  R EA MY;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EB MZ;
  R EB MX;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EB MZ;
  R EB MY;
  R EC MX;
  R EB MX;
  R EC MX;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EB MY;
  R EC MY;
  R EC MY;
  R EC MX;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EB MZ;
  R EB MX;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EB MY;
  R EB MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EA MX;
  R EA MZ;
  R EB MX;
  R EA MZ;
  R EB MY;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EB MX;
  R EC MY;
  R EB MZ;
  R EC MY;
  R EC MX;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EB MY;
  R EB MY;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EB MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MX;
  R EA MX;
  R EA MY;
  R EC MY;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EB MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EA MZ;
  R EC MX;
  R EB MX;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EB MX;
  R EB MX;
  R EC MY;
  R EC MX;
  R EB MX;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EB MX;
  R EC MX;
  R EC MY;
  R EC MZ;
  R EA MX;
  R EA MX;
  R EA MY;
  R EC MX;
  R EC MY;
  R EB MX;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MY;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EA MY;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EB MY;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EB MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EA MY;
  R EB MX;
  R EC MZ;
  R EA MY;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EB MX;
  R EA MX;
  R EA MZ;
  R EC MZ;
  R EB MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EB MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EA MY;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EA MY;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EA MX;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EB MZ;
  R EC MX;
  R EC MY;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EA MX;
  R EA MX;
  R EC MZ;
  R EA MX;
  R EB MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EA MZ;
  R EC MX;
  R EC MY;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MX;
  R EA MY;
  R EB MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MX;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EA MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MX;
  R EA MX;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EA MY;
  R EC MZ;
  R EB MY;
  R EC MX;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EB MZ;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EA MY;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MX;
  R EB MX;
  R EC MZ;
  R EB MY;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MY;
  R EA MZ;
  R EB MY;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MY;
  R EC MX;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EA MX;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EA MX;
  R EB MY;
  R EB MX;
  R EB MX;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EA MX;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EA MX;
  R EB MY;
  R EA MX;
  R EA MZ;
  R EB MY;
  R EC MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EB MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EA MY;
  R EA MZ;
  R EA MX;
  R EB MX;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EB MX;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EB MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EB MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MY;
  R EB MX;
  R EB MY;
  R EA MZ;
  R EA MY;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EA MX;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EB MX;
  R EB MX;
  R EC MY;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EB MX;
  R EB MY;
  R EA MX;
  R EB MX;
  R EA MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EB MY;
  R EA MZ;
  R EA MX;
  R EB MX;
  R EC MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EB MY;
  R EC MY;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EC MX;
  R EC MX;
  R EC MY;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EB MY;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EB MZ;
  R EB MY;
  R EA MY;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MY;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EA MY;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EC MY;
  R EA MY;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MY;
  R EB MY;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EA MX;
  R EC MY;
  R EA MX;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MY;
  R EA MZ;
  R EB MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EC MY;
  R EB MY;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EB MX;
  R EC MY;
  R EC MY;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EB MX;
  R EB MY;
  R EB MX;
  R EB MX;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EB MX;
  R EB MX;
  R EC MY;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MX;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MX;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MX;
  R EC MY;
  R EA MX;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EA MX;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EB MX;
  R EB MY;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EB MY;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EA MX;
  R EB MZ;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MX;
  R EB MX;
  R EB MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MZ;
  R EC MZ;
  R EC MY;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EC MY;
  R EB MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EA MX;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EB MZ;
  R EB MX;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EB MX;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EA MY;
  R EB MX;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EA MZ;
  R EC MX;
  R EB MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EA MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EB MZ;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EB MY;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EB MX;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EB MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MY;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MX;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EB MX;
  R EB MX;
  R EA MZ;
  R EB MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MX;
  R EC MX;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EA MX;
  R EB MX;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EA MY;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EB MX;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EC MY;
  R EC MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EB MX;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EB MZ;
  R EB MX;
  R EA MZ;
  R EA MZ;
  R EB MY;
  R EB MY;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EB MX;
  R EB MX;
  R EA MX;
  R EC MZ;
  R EA MX;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EC MX;
  R EA MX;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EB MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MX;
  R EA MX;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MY;
  R EA MX;
  R EA MZ;
  R EC MX;
  R EB MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MX;
  R EA MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EB MZ;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EA MX;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EB MY;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EB MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EC MX;
  R EA MY;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EA MX;
  R EB MY;
  R EA MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MY;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EB MY;
  R EA MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MY;
  R EC MZ;
  R EA MX;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MY;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EB MX;
  R EB MX;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MY;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EB MZ;
  R EB MY;
  R EB MX;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EA MX;
  R EC MX;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EA MY;
  R EB MY;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MY;
  R EC MZ;
  R EA MY;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EB MX;
  R EC MX;
  R EB MX;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EC MX;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EB MX;
  R EC MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MX;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EB MZ;
  R EB MX;
  R EB MX;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MY;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EA MZ;
  R EA MZ;
  R EA MZ;
  R EC MY;
  R EB MY;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MX;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MY;
  R EB MX;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MY;
  R EB MX;
  R EA MZ;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MY;
  R EC MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EA MX;
  R EC MY;
  R EB MY;
  R EA MX;
  R EB MZ;
  R EB MX;
  R EA MX;
  R EA MX;
  R EA MX;
  R EB MY;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EC MX;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EB MX;
  R EC MY;
  R EA MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EB MY;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EB MX;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EB MX;
  R EB MX;
  R EA MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EB MY;
  R EA MX;
  R EC MY;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EB MZ;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EC MY;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EA MZ;
  R EA MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EB MZ;
  R EA MX;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MX;
  R EA MX;
  R EC MZ;
  R EB MX;
  R EB MZ;
  R EC MY;
  R EC MZ;
  R EA MX;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EA MY;
  R EC MZ;
  R EA MZ;
  R EC MY;
  R EC MY;
  R EA MY;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EC MZ;
  R EC MY;
  R EA MX;
  R EA MZ;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EB MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MX;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MX;
  R EC MZ;
  R EC MX;
  R EC MY;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EB MY;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EA MX;
  R EA MZ;
  R EA MX;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EC MY;
  R EA MZ;
  R EC MZ;
  R EB MX;
  R EB MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MY;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MX;
  R EA MX;
  R EB MZ;
  R EC MY;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MY;
  R EB MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EA MX;
  R EA MZ;
  R EC MZ;
  R EC MY;
  R EC MY;
  R EC MZ;
  R EA MY;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EC MY;
  R EC MZ;
  R EC MZ;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EB MX;
  R EA MZ;
  R EB MX;
  R EC MZ;
  R EC MX;
  R EA MX;
  R EC MZ;
  R EC MZ;
  R EC MZ;
  R EC MX;
  R EA MZ;
  R EA MZ;
  R EB MX;
  R EA MZ;
  R EC MZ;
  R EC MZ;
  R EA MZ
  ]
.

Definition score_e (r : EMove) :=
  match r with
  | EA => 3
  | EB => 0
  | EC => 6
  end.

Definition score_m (m : MMove) :=
  match m with
  | MX => 0
  | MY => 4
  | MZ => 8
  end.

Definition score (r : Rule) :=
  match r with
  | R e m => ((score_e e) + (score_m m)) mod 9 + 1
  end.

Fixpoint zsum (l : list Z) :=
  match l with
  | nil => 0
  | (x :: t) => x + zsum t
  end.

Compute (zsum (map score [R EA MY;R EB MX;R EC MZ])).
Compute (zsum (map score input)).

Definition score_res (r : Rule) :=
  match r with
  | R EA m => match m with
    | MX => MZ
    | MY => MX
    | MZ => MY
    end
  | R EB m => match m with
    | MX => MX
    | MY => MY
    | MZ => MZ
    end
  | R EC m => match m with
    | MX => MY
    | MY => MZ
    | MZ => MX
    end
  end.

Definition score_2 (r : Rule) :=
  match r with
  | R EA m => score (R EA (score_res r))
  | R EB m => score (R EB (score_res r))
  | R EC m => score (R EC (score_res r))
  end.

Compute (zsum (map score_2 [R EA MY;R EB MX;R EC MZ])).
Compute (zsum (map score_2 input)).