(** * Induction: Demostracion por Induccion *)

(** La siguiente linea importa todas nuestras definiciones del
    capitulo anterior. *)

Require Export Basics.

(** Para que funcione, necesita usar [coqc] para compilar [Basics.v]
    en [Basics.vo] (Esto es como hacer un archivo .class de un archivo
    .java, o un archivo .o de un .c).

    Aqui presentamos dos formas de compilar el codigo:

     - CoqIDE:

         Abrir [Basics.v].
         En el menu "Compile", click en "Compile Buffer".

     - Linea de comandos:

         Ejecute [coqc Basics.v]

    *)

(* ###################################################################### *)
(** * Nombrando Casos *)

(** El hecho de que no hay un comando explicito para moverse de una
    rama de un analisis por caso al siguiente puede hacer los scripts
    de prueba dificiles de leer.  En pruebas grandes, con casos
    anidados, uno se puede desorientar facilmente cuando se esta
    frente a Coq llendo paso a paso en una prueba.  (Imaginese
    tratando de acordarse que los primeros cinco sub-casos pertenecen
    a la primer rama del analisis por caso principal, y los siete
    siguientes pertenencen al segundo...)  Un uso disciplinado de
    identacion y comentarios puede ayudar, pero una forma mejor es
    usar la tactica [Case]. *)

(* [Case] no viene por default in Coq: tenemos que definirla nosotros
    mismos.  No hay necesidad de entender como funciona -- puede
    simplemente saltear la definicion e ir derecho al ejemplo que
    sigue.  Usa ciertas herramientas de Coq que todavia no hemos
    discutido -- la libreria de strings y el comando [Ltac], que nos
    permite declarar tacticas propias.  Kudos a Aaron Bohannon por
    este lindo hack! *)

Require String. Open Scope string_scope.

Ltac move_to_top x :=
  match reverse goal with
  | H : _ |- _ => try move x after H
  end.

Tactic Notation "assert_eq" ident(x) constr(v) :=
  let H := fresh in
  assert (x = v) as H by reflexivity;
  clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
  first [
    set (x := name); move_to_top x
  | assert_eq x name; move_to_top x
  | fail 1 "because we are working on a different case" ].

Tactic Notation "Case" constr(name) := Case_aux Case name.
Tactic Notation "SCase" constr(name) := Case_aux SCase name.
Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.

(** Aqui hay un ejemplo de como [Case] se usa.  Vaya paso a paso en la
   prueba y observe como el contexto cambia. *)

Theorem andb_true_elim1 : forall b c : bool,
  andb b c = true -> b = true.
Proof.
  intros b c H.
  destruct b.
  Case "b = true".  (* <----- aqui *)
    reflexivity.
  Case "b = false".  (* <---- y aqui *)
    rewrite <- H.
    reflexivity.
Qed.

(** [Case] hace algo muy simple: Simplemente agrega el string que le
    pasemos ("tageado" con el identificador "Case") al contexto del
    objetivo actual.  Cuando se generan sub-objetivos, este string es
    copiado en sus contextos.  Cuando el ultimo de los sub-objetivos
    es finalmente demostrado y el siguiente ojetivo de nivel superior
    se activa, este string no va a aparecer mas en el contexto, y
    podremos determinar que hemos terminado con el caso.  Tambien,
    como "sanity check" (checkeo de sanidad?), si intentamos ejecutar
    un nuevo [Case] mientras estamos resolviendo uno, vamos a obtener
    un mensaje claro de error.

    Para casos anidados (e.g., para cuando utilizamos [destruct] en el
    caso creado por otro [destruct]), hay una tactica [SCase] (por
    "sub-caso"). *)

(** **** Ejercicio: 2 stars (andb_true_elim2) *)
(** Demuestre [andb_true_elim2], marcando casos (y sub-casos) cuando
    utilice [destruct]. *)

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** No hay reglas estrictas y definidas de como una demostracion puede
    ser estructurada en Coq -- en particular, donde se deben quebrar
    las lineas y como las distintas secciones de una demostracion
    deben ser identadas.  Sin embargo, si se marca explicitamente con
    [Case] los lugares donde los sub-casos son generados, entonces la
    demostracion puede ser legible independientemente de otros aspectos en
    el formateo de la misma.

    Este es un buen lugar para mencionar otro "tip" (posiblemente
    obvio) acerca del ancho de las lineas.  En general, los usuarios
    principiantes de Coq tienden a ser extremistas, escribiendo o una
    tactica por linea, o pruebas enteras en una linea.  El buen
    estilo se encuentra un poco en el medio.  En particular, una
    convencion razonable es limitarse a los 80 caracteres por linea.
    Lineas mas largas que esto pueden ser dificiles de leer y pueden
    ser dificiles de imprimir.  Muchos editores tienen facilidades
    para enforzar este limite. *)

(* ###################################################################### *)
(** * Pruebas por Induccion *)

(** Hemos provado en el capitulo anterior que [0] es un elemento
    neutral para [+] a la izquierda usando un argumento simple.  El
    hecho de que tambien es neutral a la _derecha_... *)

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

(** ... no puede ser provado en la misma forma.  Aplicando simplemente
  [reflexivity] no funciona: el [n] en [n + 0] es un numero
  desconocido arbitrario, con lo que el [match] en la definicion de
  [+] no puede ser simplificado.  *)

Proof.
  intros n.
  simpl. (* No hace nada! *)
Abort.

(** Razonando por casos usando [destruct n] no nos lleva muy lejos: el
   caso [n = 0] funciona, pero en el caso [n = S n'] para algun [n']
   nos quedamos bloqueados de la misma forma.  Podemos usar [destruct
   n'] para ir un paso mas alla, pero [n] puede ser arbitrariamente
   grande, con lo que si seguimos de esta forma nunca vamos a
   terminar. *)

Theorem plus_0_r_secondtry : forall n:nat,
  n + 0 = n.
Proof.
  intros n. destruct n as [| n'].
  Case "n = 0".
    reflexivity. (* todo bien hasta aca... *)
  Case "n = S n'".
    simpl.       (* ...pero aca estamos bloqueados como antes. *)
Abort.

(** Para demostrar este tipo de teoremas -- de hecho, para demostrar
    casi cualquier teorema sobre numeros, listas, y cualquier otro
    tipo de datos definido inductivamente -- necesitamos un
    razonamiento mas elaborado: _induccion_.

    Recuerden el principio de induccion sobre numeros naturales: Si
    [P(n)] es una proposicion involucrando un numero natural [n] y
    queremos ver que P es cierto para _todo_ numero [n], podemos
    razonar de la siguiente forma:
    - mostrar que [P(O)] vale;
    - mostrar que, para cualquier [n'], si [P(n')] vale, entonces vale
    [P(S n')];
    - concluir que [P(n)] vale para todo [n].

    En Coq, estos pasos son iguales, pero el orden es inverso:
    comenzamos con el obejtivo que queremos probar [P(n)] para todo
    [n] y lo dividimos (aplicando la tactica [induction]) en dos
    sub-objetivos: primero [P(O)] luego [P(n') -> P(S n')].  Asi es
    como funciona en el problema que estuvimos trabajando hasta ahora:
    *)

Theorem plus_0_r : forall n:nat, n + 0 = n.
Proof.
  intros n. induction n as [| n'].
  Case "n = 0".     reflexivity.
  Case "n = S n'".  simpl. rewrite -> IHn'. reflexivity.  Qed.

(** Como [destruct], la tactica [induction] toma una clausula [as...]
    que especifica los nombres de las variables a ser introducidas en
    los sub-objetivos.  En la primer rama, [n] es reemplazado por [0]
    el objetivo es [0 + 0 = 0], que es cierto por simplificacion.  En el
    segundo, [n] es reemplazado por [S n'] y la hipotesis [n' + 0 =
    n'] es agregada al contexto (con el nombre [IHn'], es decir, la
    Hipotesis Inductiva para [n']).  El objetivo en este caso es [(S
    n') + 0 = S n'], que se puede simplificar a [S (n' + 0) = S n'],
    que a su cez se puede resolver usando la hipotesis inductiva. *)

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

(** **** Ejercicio: 2 stars (basic_induction) *)

(** Pruebe los siguientes teoremas usando induccion.  Tal ver requiera
    utilizar algun resultado previo. *)

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

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

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

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

(** **** Ejercicio: 2 stars (double_plus) *)

(** Considere la siguiente funcion, que duplica el argumento: *)

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

(** Use induccion para probar este simple lema sobre [double]: *)

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

(** **** Ejercicio: 1 star (destruct_induction) *)
(** Explique brevemente la diferencia entre las tacticas
    [destruct] e [induction].

(* FILL IN HERE *)

*)
(** [] *)

(* ###################################################################### *)
(** * Pruebas dentro de Pruebas *)

(** En Coq, al igual que en los razonamientos matematicos informales,
    las demostraciones largas son usualmente divididas en una
    secuencia de teoremas, con las demostraciones del final utilizando
    los teoremas demostrados anteriormente.  Ocasionalmente, sin
    embargo, una demostracion puede necesitar algun hecho (fact) que
    es trivial y de poco interes general para molestarse en darle un
    nombre propio.  En tales casos, es conveniente poder establecer y
    demostrar localmente un "sub-teorema" en el punto en que debe ser
    utilizado.  La tactica [assert] nos permite hacer esto.  Por
    ejemplo, en nuestra demostracion del teorema [mult_0_plus] nos
    referimos a otro teorema [plus_O_n].  Podemos utilizar [assert]
    para establecer [plus_O_n] "in-line": *)

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

(** La tactica [assert] introduce dos sub-objetivos.  El primero es la
    asercion en si misma; al prefijarla con [H:], le hemos dado como
    nombre [H].  (Note que tambien podemos utilizar [as] como hicimos
    con [destruct] e [induction], i.e., [assert (0 + n = n) as H].
    Tambien note que hemos marcado la prueba de esta asercion con un
    [Case], para mejorar la legibilidad de la prueba y para, mientras
    usamos Coq interactivamente, saber que hemos concluido la prueba
    de la asercion observando que el string ["Proof of assertion"]
    desaparece del contexto.)  El segundo objetivo es el mismo que el
    que teniamos antes de invocar [assert], excepto que ahora tiene
    una hipotesis llamada [H] que establece [0 + n = n].  Es decir,
    [assert] genera un sub-objetivo para demostrar la asercion, y un
    segundo sub-objetivo donde la asercion esta a nuestra mano para
    utilizar y hacer progreso en la prueba principal. *)

(** Actualmente, [assert] nos va a ser util en muchos tipos de
    situaciones.  Por ejemplo, suponga que queremos probar que [(n +
    m) + (p + q) = (m + n) + (p + q)].  La unica diferencia entre los
    dos lados del igual es que los argumentos [m] y [n] en el primer
    [+] estan intercambiados, con lo que pareceria que podemos
    utilizar la comutatividad de la suma ([plus_comm]) para reescribir
    uno en otro.  Sin embargo, la tactica [rewrite] es un poco
    estupida respecto de _donde_ aplicar la reescritura.  Hay tres usos
    de [+] aqui, y resulta que si hacemos [rewrite -> plus_comm] vamos
    a afectar el de mas _afuera_. *)

Theorem plus_rearrange_firsttry : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  (* Necesitamos intercambiar (n + m) por (m + n)...
     pareceria que plus_comm debiera funcionar! *)
  rewrite -> plus_comm.
  (* No funciona... Coq reescribio la suma incorrecta! *)
Abort.

(** Para poder aplicar [plus_comm] en el lugar que queremos, podemos
    introducir un lema local estableciendo [n + m = m + n] (para los
    [m] y [n] particulares que utilizamos en la demostracion), demostrar
    este lema utilizando [plus_comm], y usar luego este lema para reescribir
    el lugar correcto. *)

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

(** **** Ejercicio: 4 stars (mult_comm) *)
(** Utilice [assert] para ayudar probar este teorema.  No deberia
    necesitar [induction]. *)

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

(** Ahora demuestre la conmutatividad de la multiplicacion.  (Va a
    necesitar posiblemente demostrar un teorema subsidiario para
    usarlo en este.)  Puede encontrar util [plus_swap]. *)

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

(** **** Ejercicio: 2 stars, opcional (evenb_n__oddb_Sn) *)

(** Pruebe el siguiente teorema sencillo: *)

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

(* ###################################################################### *)
(** * Mas ejercicios *)

(** **** Ejercicio: 3 stars, opcional (more_exercises) *)
(** Tome un pedazo de papel.  Por cada uno de los siguientes teoremas,
    primero _piense_ acerca de si (a) puede ser demostrado utilizando
    simplemente [rewrite], [simpl] y [reflexivity], o (b) tambien
    requiere analisis por caso ([destruct]), o (c) tambien requiere
    induccion.  Escriba su prediccion.  Entonces complete las
    demostraciones.  (No hay necesidad de entregar el papel, este
    ejercicio es para estimular el pensamiento antes de hackear!) *)

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

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

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

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

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

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

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

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

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

(** **** Ejercicio: 2 stars, opcional (beq_nat_refl) *)
(** Pruebe el siguiente teorema.  Poner [true] en el lado izquierdo de
    la igualdad puede verse raro, pero es asi como el teorema esta
    escrito en la libreria estandard de Coq, y nosotros copiamos en
    consecuencia.  Como se puede reescribir igualmente en cualquier
    direccion, no vamos a tener problemas usando el teorema, sin
    importar en que forma lo escribamos. *)

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

(** **** Exercise: 2 stars, optional (plus_swap') *)
(** La tactica [replace] permite especificar un subtermino particular
   a reescribir, y a que se debe reescribir.  Mas precisamente,
   [replace (t) with (u)] reemplaza (todas las copias de) la expresion
   [t] en el objetivo por la expresion [u], y genera [t = u] como
   sub-objetivo adicional. Esto es util cuando [rewrite] reescribe una
   parte incorrecta del objetivo.

   Utilice la tactica [replace] para demostrar [plus_swap'], similar a
   [plus_swap] pero sin necesitar [assert (n + m = m + n)].  *)

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

(** **** Ejercicio: 3 stars (binary_commute) *)
(** Recuerde las funciones [increment] y [binary-to-unary] que
    escribio para el ejercicio [binary] en el capitulo [Basics].
    Pruebe que estas funciones conmutan -- es decir, que incrementar
    un numero binario y convertirlo a unitario es igual a convertirlo
    en unario primero y luego incrementarlo.

    (Antes de empezar a trabajar en este ejercicio, por favor copie
    sus definiciones del ejercicio [binary] aqui, para que este
    archivo pueda ser evaluado independientemente.  Si necesita
    modificar las definiciones para hacer la prueba mas facil,
    sientase libre de hacerlo). *)

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

(** **** Ejercicio: 5 stars, advanced (binary_inverse) *)
(** Este ejercicio es una continuacion del ejercicio anterior acerca
    numeros binarios.  Usted debe completar las definiciones y
    teoremas del ejercicio previo antes de hacer este ejercicio.

    (a) Primero, escriba una funcion para convertir numeros naturales a
        numeros binarios.  Luego, pruebe que convertir un numero
        natural a binario, y luego convertir a natural el resultado,
        resulta en el mismo numero.

    (b) Tal vez usted considere que tambien podemos probar lo
        contrario, es decir, que convertir un numero binario en natural
        y viceversa resulta en el mismo numero natural.  Sin embargo,
        no es asi!  Explique por que.

    (c) Defina una funcion [normalize] de numeros binarios a numeros
        binarios tal que para cada numero binario b, convertir b a
        numero natural y viceversa resulta en [(normalize b)].  Demuestrelo.

    Como antes, sientase en la libertad de cambiar las definiciones si
    asi lo desea.  *)

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

(* ###################################################################### *)
(** * Material Avanzado *)

(** ** Prueba Formal vs. Informal *)

(** "Pruebas informales son algoritmos; pruebas formales son codigo." *)

(** La pregunta de que exactamente constituye una "prueba" de un
    teorema matematico a intrigado a filosofos por milenios.  Una
    definicion burda y rapida puede ser: una prueba de una proposicion
    matematica [P] es un texto escrito (o dicho) que infunde en el
    lector (o receptor) la certeza de que [P] es verdad.  Es decir,
    una prueba es un acto de comunicacion.

    Ahora, la comunicacion en general puede incluir tipos diferentes
    de lectores.  En una mano, el "lector" puede ser un programa como
    Coq, en cuyo caso la "creencia" que es inculcada es un checkeo
    mecanico de que [P] puede ser derivado de un conjunto de reglas
    logicas, y la prueba es una receta que guia al programa para
    realizar este checkeo.  Estas recetas son pruebas _formales_.

    Alternativamente, el lector puede ser un ser humano, en cuyo caso
    la prueba puede ser escrita en espaniol o cualquier otro lenguaje
    natural, necesariamente _informal_.  Aqui, el criterio para el
    exito esta especificado de forma mas difusa.  Una "buena" prueba
    es una que convence al lector de que [P] vale.  Pero la misma
    prueba puede ser leida por muchos lectores diferentes, en los que
    algunos pueden convencerse de cierto argumento, mientras que otros
    pueden ponerlo en duda.  Un lector puede ser particularmente
    pedante, inexperto, o simplemente lento; la unica forma de
    convencerlo va a ser haciendo el argumento extremadamente
    puntillosamente.  Pero otro lector, conocedor del area, puede
    encontrar estos detalles tan apabullantes, que le hacen perder el
    argumento principal.  Lo unico que necesita es que le digan las
    ideas principales, porque es mas facil llenar los detalles por si
    mismo.  De ultima, no hay un estandard universal, porque no hay una
    sola forma de escribir una prueba informal de forma tal que
    convenza a todos los lectores.  En practica, sin embargo, los
    matematicos han desarrollado una serie de convenciones y modismos
    para escribir acerca de objetos matematicos complejos que, para
    cierta comunidad, hace la comunicacion decentemente fiable.  Las
    convenciones utilizadas en esta forma estilizadad de comunicacion
    da paso a estandardes claros para juzgar una prueba buena o mala.

    Como estamos usando Coq en este curso, vamos a trabajar
    fuertemente con pruebas formales.  Pero eso no significa que
    podemos ignorar las pruebas informales!  Las pruebas formales son
    utiles en muchos sentidos, pero no son muy eficientes como
    mechanismo para comunicar ideas entre humanos. *)

(** Por ejemplo, aqui hay un ejemplo de que la suma de los naturales
    es asociativa: *)

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

(** Coq esta perfectamente feliz con esta prueba.  Para un humano, sin
    embargo, es dificil entender que esta pasando.  Si el lector esta
    acostumbrado a Coq, puede ir paso por paso en su cabeza,
    imaginando cual es el estado del contexto y el objetivo en cada
    paso, pero si la prueba fuera ligeramente mas complicada, esto
    seria completamente imposible.  En cambio, un matematico
    escribiria algo asi: *)

(** - _Teorema_: Para cada [n], [m] y [p],
      n + (m + p) = (n + m) + p.
    _Prueba_: Por induccion en [n].

    - Primero, suponga [n = 0].  Debemos mostrar
        0 + (m + p) = (0 + m) + p.
      Esto se desprende de la definicion de [+].

    - Siguiente, suponga [n = S n'], donde
        n' + (m + p) = (n' + m) + p.
      Debemos mostrar
        (S n') + (m + p) = ((S n') + m) + p.
      Por definicion de [+], esto es equivalente a
        S (n' + (m + p)) = S ((n' + m) + p),
      que es inmediato por la hipotesis inductiva. [] *)

(** El aspecto general de la prueba es basicamente similar.  Y esto no
    es pura casualidad: Coq ha sido diseniado de forma que la tactica
    [induction] genera los mismos sub-objetivos, en el mismo orden,
    que las vinietas que un matematico/a podria escribir.  Pero las
    pruebas difieren en los detalles: la prueba formal es mucho mas
    explicita en algunos aspectos (ej., el uso de [reflexivity]) pero
    mucho menos explicita en otros (en particular, el "estado de la
    prueba" en cada paso en la prueba en Coq es implicita, mientras
    que en la prueba informal se le recuerda al lector varias veces
    sobre el punto en el que se esta). *)

(** Aca hay una prueba formal con una estructura mas clara: *)

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

(** **** Ejercicio: 2 stars, advanced (plus_comm_informal) *)
(** Traduzca su prueba de [plus_comm] en una prueba informal. *)

(** Teorema: La adicion es conmutativa.

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

(** **** Ejercicio: 2 stars, opcional (beq_nat_refl_informal) *)
(** Escriba una prueba informal del siguiente teorema, usando la
    prueba informal de [plus_assoc] como modelo.  No se restringa a
    parafrasear las tacticas de Coq en espaniol!

    Teorema: [true = beq_nat n n] para cada [n].

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

(* $Date: 2013-07-17 16:19:11 -0400 (Wed, 17 Jul 2013) $ *)


(* *********************************************************************)
(*                                                                     *)
(*            The CertiKOS Certified Kit Operating System              *)
(*                                                                     *)
(*                   The FLINT Group, Yale University                  *)
(*                                                                     *)
(*  Copyright The FLINT Group, Yale University.  All rights reserved.  *)
(*  This file is distributed under the terms of the Yale University    *)
(*  Non-Commercial License Agreement.                                  *)
(*                                                                     *)
(* *********************************************************************)
(* *********************************************************************)
(*                                                                     *)
(*              Constant used in Certikos                              *)
(*                                                                     *)
(*          Ronghui Gu <ronghui.gu@yale.edu>                           *)
(*                                                                     *)
(*          Yale Flint Group                                           *)
(*                                                                     *)
(* *********************************************************************)

Require Import Coqlib.
Require Import Integers.
Require Import Values.

(** This file provide some [constant] that will be used in the layer definitions and refinement proofs*)

(** Machine Configuration *)
Notation kern_low:= 262144.
Notation kern_high:= 983040.
Notation PgSize:= 4096.
Notation maxpage:= 1048576.
Notation num_proc:= 64.
Notation num_chan:= 64.
Notation one_k := 1024.
Notation adr_max := 4294967296.
Notation adr_low := 1073741824.
Notation adr_high := 4026531840.
Notation MagicNumber := (maxpage + 1).

Notation num_id:= 64.
Notation max_children := 3.

(** Page Table Permission*)
Notation PT_PERM_UP := 0.
Notation PT_PERM_P := 1. (**r kern: >1G, PTE_P *)
Notation PT_PERM_PTKF := 3. (**r kern: >1G, PTE_P|_W *)
Notation PT_PERM_PTKT := 259. (**r kern: <1G, PTE_P|_W|_G *)
Notation PT_PERM_PTU := 7. (**r usr: >1G, PTE_P|_W|_U *)
(* redundant *)
(*
Notation PDXPERM := 7.
Notation PTK_true := 259.
Notation PTK_false := 3.
 *)

Notation TSTATE_READY := 0.
Notation TSTATE_RUN := 1.
Notation TSTATE_SLEEP := 2.
Notation TSTATE_DEAD := 3.
Notation NPTEPERM := 7.
Notation NPDEPERM := 39.
Notation EPTEPERM := 7.
Notation EPDTEPERM := 39.
Notation VMCB_V_SIZE := 16.
Notation VMCB_Z_SIZE := 1008.
Notation XVMST_SIZE := 6.

Notation U_EDI := 0.
Notation U_ESI := 1.
Notation U_EBP := 2.
Notation U_OESP := 3.
Notation U_EBX := 4.
Notation U_EDX := 5.
Notation U_ECX := 6.
Notation U_EAX := 7.
Notation U_ES := 8.
Notation U_DS := 9.
Notation U_TRAPNO := 10.
Notation U_ERR := 11.
Notation U_EIP := 12.
Notation U_CS := 13.
Notation U_EFLAGS := 14.
Notation U_ESP := 15.
Notation U_SS := 16.

Notation UCTXT_SIZE := 17.
Notation STACK_TOP:= (Int.repr (kern_high * PgSize)).
Notation CPU_GDT_UDATA := (Vint (Int.repr 35)).
Notation CPU_GDT_UCODE := (Vint (Int.repr 27)).
Notation FL_IF := (Vint (Int.repr 512)).

(* Offset within VMCB_Z *)
Notation VMCB_Z_INTCEPT_LO_OFFSET     := 3.
Notation VMCB_Z_INTCEPT_HI_OFFSET     := 4.
Notation VMCB_Z_GASID_OFFSET          := 22.
Notation VMCB_Z_INT_CTL_OFFSET        := 24.
Notation VMCB_Z_INT_STATE_OFFSET      := 26.
Notation VMCB_Z_EXITCODE_LO_OFFSET    := 28.
Notation VMCB_Z_EXITINFO1_LO_OFFSET   := 30.
Notation VMCB_Z_EXITINFO2_LO_OFFSET   := 32.
Notation VMCB_Z_EXITINTINFO_LO_OFFSET := 34.
Notation VMCB_Z_EXITINTINFO_HI_OFFSET := 35.
Notation VMCB_Z_NESTED_CTL_OFFSET     := 36.
Notation VMCB_Z_EVENTINJ_LO_OFFSET    := 42.
Notation VMCB_Z_EVENTINJ_HI_OFFSET    := 43.
Notation VMCB_Z_NEXT_RIP_LO_OFFSET    := 50.

Notation VMCB_Z_ES_OFFSET             := 256.
Notation VMCB_Z_CS_OFFSET             := 260.
Notation VMCB_Z_SS_OFFSET             := 264.
Notation VMCB_Z_DS_OFFSET             := 268.
Notation VMCB_Z_FS_OFFSET             := 272.
Notation VMCB_Z_GS_OFFSET             := 276.
Notation VMCB_Z_GDTR_OFFSET           := 280.
Notation VMCB_Z_LDTR_OFFSET           := 284.
Notation VMCB_Z_IDTR_OFFSET           := 288.
Notation VMCB_Z_TR_OFFSET             := 292.

Notation VMCB_Z_EFER_LO_OFFSET        := 308.
Notation VMCB_Z_DR7_LO_OFFSET         := 344.
Notation VMCB_Z_DR6_LO_OFFSET         := 346.
Notation VMCB_Z_GPAT_LO_OFFSET        := 410.
Notation VMCB_Z_GPAT_HI_OFFSET        := 411.

(* Offsets within VMCB_Val *)
Notation VMCB_V_CR4_LO_OFFSET         := 338.
Notation VMCB_V_CR3_LO_OFFSET         := 340.
Notation VMCB_V_CR0_LO_OFFSET         := 342.
Notation VMCB_V_RFLAGS_LO_OFFSET      := 348.
Notation VMCB_V_RIP_LO_OFFSET         := 350.
Notation VMCB_V_RSP_LO_OFFSET         := 374.
Notation VMCB_V_RAX_LO_OFFSET         := 382.
Notation VMCB_V_CR2_LO_OFFSET         := 400.

(* SVM VMEXIT cpde *)
Notation VMEXIT_VINTR := 96.
Notation VMEXIT_IOIO  := 123.
Notation VMEXIT_NPF   := 1024.

(* Other constants *)
Notation VMCB_INTCEPT_VINT_SHIFT    := 4.

Notation VMCB_INT_CTL_VIRQ_SHIFT    := 8.
Notation VMCB_INT_CTL_IGN_TPR_SHIFT := 20.

Notation VMCB_EVENTINJ_VALID_SHIFT  := 31.
Notation VMCB_EVENTINJ_EV_SHIFT     := 11.
Notation VMCB_EVENTINJ_TYPE_SHIFT   := 8.
Notation VMCB_EVENTINJ_TYPE_INTR    := 0.
Notation VMCB_EVENTINJ_TYPE_EXCPT   := 3.

Notation VMCB_SEG_ATTR_SHIFT        := 2.
Notation VMCB_SEG_LIM_SHIFT         := 4.
Notation VMCB_SEG_BASE_SHIFT        := 8.

Notation EXIT_INTINFO_VALID_SHIFT   := 31.
Notation EXIT_INTINFO_TYPE_SHIFT    := 8.
Notation EXIT_INTINFO_TYPE_MASK     := (Z.shiftl 7 EXIT_INTINFO_TYPE_SHIFT).
Notation EXIT_INTINFO_TYPE_INTR     := 0.
Notation EXIT_INTINFO_VECTOR_MASK   := 255.

(* Offsets within XVMState *)
Notation XVMST_EBX_OFFSET := 0.
Notation XVMST_ECX_OFFSET := 1.
Notation XVMST_EDX_OFFSET := 2.
Notation XVMST_ESI_OFFSET := 3.
Notation XVMST_EDI_OFFSET := 4.
Notation XVMST_EBP_OFFSET := 5.

(* segment registers *)
Notation G_CS    := 0.
Notation G_DS    := 1.
Notation G_ES    := 2.
Notation G_FS    := 3.
Notation G_GS    := 4.
Notation G_SS    := 5.
Notation G_LDTR  := 6.
Notation G_TR    := 7.
Notation G_GDTR  := 8.
Notation G_IDTR  := 9.
Notation MAX_SEG := 10.
(* registers *)

Notation G_EAX    := 0.
Notation G_EBX    := 1.
Notation G_ECX    := 2.
Notation G_EDX    := 3.
Notation G_ESI    := 4.
Notation G_EDI    := 5.
Notation G_EBP    := 6.
Notation G_ESP    := 7.
Notation G_EIP    := 8.
Notation G_EFLAGS := 9.
Notation G_CR0    := 10.
Notation G_CR2    := 11.
Notation G_CR3    := 12.
Notation G_CR4    := 13.

Definition sz32_mask := Z.shiftl 1 6.
Definition sz16_mask := Z.shiftl 1 5.
Definition sz8_mask  := Z.shiftl 1 4.
Definition rep_mask  := Z.shiftl 1 3.
Definition str_mask  := Z.shiftl 1 2.

Notation in_mask := 1.
Notation SZ8  := 0.
Notation SZ16 := 1.
Notation SZ32 := 2.

Notation SHARED_MEM_READY := 0.
Notation SHARED_MEM_PEND := 1.
Notation SHARED_MEM_DEAD := 2.

(* Intel Virtualization *)

Notation five_one_two := 512.
(* VMCS Encoding *)
Notation C_VMCS_VPID := 0	(* 0x00000000 *).
Notation C_VMCS_GUEST_ES_SELECTOR := 2048	(* 0x00000800 *).
Notation C_VMCS_GUEST_CS_SELECTOR := 2050	(* 0x00000802 *).
Notation C_VMCS_GUEST_SS_SELECTOR := 2052	(* 0x00000804 *).
Notation C_VMCS_GUEST_DS_SELECTOR := 2054	(* 0x00000806 *).
Notation C_VMCS_GUEST_FS_SELECTOR := 2056	(* 0x00000808 *).
Notation C_VMCS_GUEST_GS_SELECTOR := 2058	(* 0x0000080A *).
Notation C_VMCS_GUEST_LDTR_SELECTOR := 2060	(* 0x0000080C *).
Notation C_VMCS_GUEST_TR_SELECTOR := 2062	(* 0x0000080E *).
Notation C_VMCS_HOST_ES_SELECTOR := 3072	(* 0x00000C00 *).
Notation C_VMCS_HOST_CS_SELECTOR := 3074	(* 0x00000C02 *).
Notation C_VMCS_HOST_SS_SELECTOR := 3076	(* 0x00000C04 *).
Notation C_VMCS_HOST_DS_SELECTOR := 3078	(* 0x00000C06 *).
Notation C_VMCS_HOST_FS_SELECTOR := 3080	(* 0x00000C08 *).
Notation C_VMCS_HOST_GS_SELECTOR := 3082	(* 0x00000C0A *).
Notation C_VMCS_HOST_TR_SELECTOR := 3084	(* 0x00000C0C *).
Notation C_VMCS_IO_BITMAP_A := 8192	(* 0x00002000 *).
Notation C_VMCS_IO_BITMAP_A_HI := 8193	(* 0x00002001 *).
Notation C_VMCS_IO_BITMAP_B := 8194	(* 0x00002002 *).
Notation C_VMCS_IO_BITMAP_B_HI := 8195	(* 0x00002003 *).
Notation C_VMCS_MSR_BITMAP := 8196	(* 0x00002004 *).
Notation C_VMCS_MSR_BITMAP_HI := 8197	(* 0x00002005 *).
Notation C_VMCS_EXIT_MSR_STORE := 8198	(* 0x00002006 *).
Notation C_VMCS_EXIT_MSR_LOAD := 8200	(* 0x00002008 *).
Notation C_VMCS_ENTRY_MSR_LOAD := 8202	(* 0x0000200A *).
Notation C_VMCS_EXECUTIVE_VMCS := 8204	(* 0x0000200C *).
Notation C_VMCS_TSC_OFFSET := 8208	(* 0x00002010 *).
Notation C_VMCS_VIRTUAL_APIC := 8210	(* 0x00002012 *).
Notation C_VMCS_APIC_ACCESS := 8212	(* 0x00002014 *).
Notation C_VMCS_EPTP := 8218	(* 0x0000201A *).
Notation C_VMCS_EPTP_HI := 8219	(* 0x0000201B *).
Notation C_VMCS_GUEST_PHYSICAL_ADDRESS := 9216	(* 0x00002400 *).
Notation C_VMCS_LINK_POINTER := 10240	(* 0x00002800 *).
Notation C_VMCS_GUEST_IA32_DEBUGCTL := 10242	(* 0x00002802 *).
Notation C_VMCS_GUEST_IA32_PAT := 10244	(* 0x00002804 *).
Notation C_VMCS_GUEST_IA32_EFER := 10246	(* 0x00002806 *).
Notation C_VMCS_GUEST_IA32_PERF_GLOBAL_CTRL  := 10248	(* 0x00002808 *).
Notation C_VMCS_GUEST_PDPTE0 := 10250	(* 0x0000280A *).
Notation C_VMCS_GUEST_PDPTE1 := 10252	(* 0x0000280C *).
Notation C_VMCS_GUEST_PDPTE2 := 10254	(* 0x0000280E *).
Notation C_VMCS_GUEST_PDPTE3 := 10256	(* 0x00002810 *).
Notation C_VMCS_HOST_IA32_PAT := 11264	(* 0x00002C00 *).
Notation C_VMCS_HOST_IA32_EFER := 11266	(* 0x00002C02 *).
Notation C_VMCS_HOST_IA32_PERF_GLOBAL_CTRL := 11268	(* 0x00002C04 *).
Notation C_VMCS_PIN_BASED_CTLS := 16384	(* 0x00004000 *).
Notation C_VMCS_PRI_PROC_BASED_CTLS := 16386	(* 0x00004002 *).
Notation C_VMCS_EXCEPTION_BITMAP := 16388	(* 0x00004004 *).
Notation C_VMCS_PF_ERROR_MASK := 16390	(* 0x00004006 *).
Notation C_VMCS_PF_ERROR_MATCH := 16392	(* 0x00004008 *).
Notation C_VMCS_CR3_TARGET_COUNT := 16394	(* 0x0000400A *).
Notation C_VMCS_EXIT_CTLS := 16396	(* 0x0000400C *).
Notation C_VMCS_EXIT_MSR_STORE_COUNT := 16398	(* 0x0000400E *).
Notation C_VMCS_EXIT_MSR_LOAD_COUNT := 16400	(* 0x00004010 *).
Notation C_VMCS_ENTRY_CTLS := 16402	(* 0x00004012 *).
Notation C_VMCS_ENTRY_MSR_LOAD_COUNT := 16404	(* 0x00004014 *).
Notation C_VMCS_ENTRY_INTR_INFO := 16406	(* 0x00004016 *).
Notation C_VMCS_ENTRY_EXCEPTION_ERROR := 16408	(* 0x00004018 *).
Notation C_VMCS_ENTRY_INST_LENGTH := 16410	(* 0x0000401A *).
Notation C_VMCS_TPR_THRESHOLD := 16412	(* 0x0000401C *).
Notation C_VMCS_SEC_PROC_BASED_CTLS := 16414	(* 0x0000401E *).
Notation C_VMCS_PLE_GAP := 16416	(* 0x00004020 *).
Notation C_VMCS_PLE_WINDOW := 16418	(* 0x00004022 *).
Notation C_VMCS_INSTRUCTION_ERROR := 17408	(* 0x00004400 *).
Notation C_VMCS_EXIT_REASON := 17410	(* 0x00004402 *).
Notation C_VMCS_EXIT_INTERRUPTION_INFO := 17412	(* 0x00004404 *).
Notation C_VMCS_EXIT_INTERRUPTION_ERROR := 17414	(* 0x00004406 *).
Notation C_VMCS_IDT_VECTORING_INFO := 17416	(* 0x00004408 *).
Notation C_VMCS_IDT_VECTORING_ERROR := 17418	(* 0x0000440A *).
Notation C_VMCS_EXIT_INSTRUCTION_LENGTH := 17420	(* 0x0000440C *).
Notation C_VMCS_EXIT_INSTRUCTION_INFO := 17422	(* 0x0000440E *).
Notation C_VMCS_GUEST_ES_LIMIT := 18432	(* 0x00004800 *).
Notation C_VMCS_GUEST_CS_LIMIT := 18434	(* 0x00004802 *).
Notation C_VMCS_GUEST_SS_LIMIT := 18436	(* 0x00004804 *).
Notation C_VMCS_GUEST_DS_LIMIT := 18438	(* 0x00004806 *).
Notation C_VMCS_GUEST_FS_LIMIT := 18440	(* 0x00004808 *).
Notation C_VMCS_GUEST_GS_LIMIT := 18442	(* 0x0000480A *).
Notation C_VMCS_GUEST_LDTR_LIMIT := 18444	(* 0x0000480C *).
Notation C_VMCS_GUEST_TR_LIMIT := 18446	(* 0x0000480E *).
Notation C_VMCS_GUEST_GDTR_LIMIT := 18448	(* 0x00004810 *).
Notation C_VMCS_GUEST_IDTR_LIMIT := 18450	(* 0x00004812 *).
Notation C_VMCS_GUEST_ES_ACCESS_RIGHTS := 18452	(* 0x00004814 *).
Notation C_VMCS_GUEST_CS_ACCESS_RIGHTS := 18454	(* 0x00004816 *).
Notation C_VMCS_GUEST_SS_ACCESS_RIGHTS := 18456	(* 0x00004818 *).
Notation C_VMCS_GUEST_DS_ACCESS_RIGHTS := 18458	(* 0x0000481A *).
Notation C_VMCS_GUEST_FS_ACCESS_RIGHTS := 18460	(* 0x0000481C *).
Notation C_VMCS_GUEST_GS_ACCESS_RIGHTS := 18462	(* 0x0000481E *).
Notation C_VMCS_GUEST_LDTR_ACCESS_RIGHTS := 18464	(* 0x00004820 *).
Notation C_VMCS_GUEST_TR_ACCESS_RIGHTS := 18466	(* 0x00004822 *).
Notation C_VMCS_GUEST_INTERRUPTIBILITY := 18468	(* 0x00004824 *).
Notation C_VMCS_GUEST_ACTIVITY := 18470	(* 0x00004826 *).
Notation C_VMCS_GUEST_SMBASE := 18472	(* 0x00004828 *).
Notation C_VMCS_GUEST_IA32_SYSENTER_CS := 18474	(* 0x0000482A *).
Notation C_VMCS_PREEMPTION_TIMER_VALUE := 18478	(* 0x0000482E *).
Notation C_VMCS_HOST_IA32_SYSENTER_CS := 19456	(* 0x00004C00 *).
Notation C_VMCS_CR0_MASK := 24576	(* 0x00006000 *).
Notation C_VMCS_CR4_MASK := 24578	(* 0x00006002 *).
Notation C_VMCS_CR0_SHADOW := 24580	(* 0x00006004 *).
Notation C_VMCS_CR4_SHADOW := 24582	(* 0x00006006 *).
Notation C_VMCS_CR3_TARGET0 := 24584	(* 0x00006008 *).
Notation C_VMCS_CR3_TARGET1 := 24586	(* 0x0000600A *).
Notation C_VMCS_CR3_TARGET2 := 24588	(* 0x0000600C *).
Notation C_VMCS_CR3_TARGET3 := 24590	(* 0x0000600E *).
Notation C_VMCS_EXIT_QUALIFICATION := 25600	(* 0x00006400 *).
Notation C_VMCS_IO_RCX := 25602	(* 0x00006402 *).
Notation C_VMCS_IO_RSI := 25604	(* 0x00006404 *).
Notation C_VMCS_IO_RDI := 25606	(* 0x00006406 *).
Notation C_VMCS_IO_RIP := 25608	(* 0x00006408 *).
Notation C_VMCS_GUEST_LINEAR_ADDRESS := 25610	(* 0x0000640A *).
Notation C_VMCS_GUEST_CR0 := 26624	(* 0x00006800 *).
Notation C_VMCS_GUEST_CR3 := 26626	(* 0x00006802 *).
Notation C_VMCS_GUEST_CR4 := 26628	(* 0x00006804 *).
Notation C_VMCS_GUEST_ES_BASE := 26630	(* 0x00006806 *).
Notation C_VMCS_GUEST_CS_BASE := 26632	(* 0x00006808 *).
Notation C_VMCS_GUEST_SS_BASE := 26634	(* 0x0000680A *).
Notation C_VMCS_GUEST_DS_BASE := 26636	(* 0x0000680C *).
Notation C_VMCS_GUEST_FS_BASE := 26638	(* 0x0000680E *).
Notation C_VMCS_GUEST_GS_BASE := 26640	(* 0x00006810 *).
Notation C_VMCS_GUEST_LDTR_BASE := 26642	(* 0x00006812 *).
Notation C_VMCS_GUEST_TR_BASE := 26644	(* 0x00006814 *).
Notation C_VMCS_GUEST_GDTR_BASE := 26646	(* 0x00006816 *).
Notation C_VMCS_GUEST_IDTR_BASE := 26648	(* 0x00006818 *).
Notation C_VMCS_GUEST_DR7 := 26650	(* 0x0000681A *).
Notation C_VMCS_GUEST_RSP := 26652	(* 0x0000681C *).
Notation C_VMCS_GUEST_RIP := 26654	(* 0x0000681E *).
Notation C_VMCS_GUEST_RFLAGS := 26656	(* 0x00006820 *).
Notation C_VMCS_GUEST_PENDING_DBG_EXCEPTIONS := 26658	(*  0x00006822 *).
Notation C_VMCS_GUEST_IA32_SYSENTER_ESP := 26660	(* 0x00006824 *).
Notation C_VMCS_GUEST_IA32_SYSENTER_EIP := 26662	(* 0x00006826 *).
Notation C_VMCS_HOST_CR0 := 27648	(* 0x00006C00 *).
Notation C_VMCS_HOST_CR3 := 27650	(* 0x00006C02 *).
Notation C_VMCS_HOST_CR4 := 27652	(* 0x00006C04 *).
Notation C_VMCS_HOST_FS_BASE := 27654	(* 0x00006C06 *).
Notation C_VMCS_HOST_GS_BASE := 27656	(* 0x00006C08 *).
Notation C_VMCS_HOST_TR_BASE := 27658	(* 0x00006C0A *).
Notation C_VMCS_HOST_GDTR_BASE := 27660	(* 0x00006C0C *).
Notation C_VMCS_HOST_IDTR_BASE := 27662	(* 0x00006C0E *).
Notation C_VMCS_HOST_IA32_SYSENTER_ESP := 27664	(* 0x00006C10 *).
Notation C_VMCS_HOST_IA32_SYSENTER_EIP := 27666	(* 0x00006C12 *).
Notation C_VMCS_HOST_RSP := 27668	(* 0x00006C14 *).
Notation C_VMCS_HOST_RIP := 27670	(* 0x00006c16 *).
Notation MAX_INT_16 := 65535.
Notation MAX_INT_32 := 4294967296.
Notation MAX_INT_64 := 18446744073709551616.

(* structure of vmx
struct vmx {
	/*
	 * VMCS does not store following registers for guest, so we have
	 * to do that by ourself.
	 */
	uint64_t	g_rax, g_rbx, g_rcx, g_rdx, g_rsi, g_rdi, g_rbp, g_rip;
	uint32_t	g_cr2;
	uint32_t	g_dr0, g_dr1, g_dr2, g_dr3, g_dr6;
	uint32_t	enter_tsc[2], exit_tsc[2];

	uint32_t	vpid;

	uint32_t	exit_reason;
	uint64_t	exit_qualification;
	int32_t		pending_intr;

	int		launched;
	int		failed;
        uint32_t        h_rdi, h_rbp;
};*)

Notation VMX_G_RAX := 0.
Notation VMX_G_RBX := 8.
Notation VMX_G_RCX := 16.
Notation VMX_G_RDX := 24.
Notation VMX_G_RSI := 32.
Notation VMX_G_RDI := 40.
Notation VMX_G_RBP := 48.
Notation VMX_G_RIP := 56.
Notation VMX_G_CR2 := 64.
Notation VMX_G_DR0 := 68.
Notation VMX_G_DR1 := 72.
Notation VMX_G_DR2 := 76.
Notation VMX_G_DR3 := 80.
Notation VMX_G_DR6 := 84.
Notation VMX_ENTER_TSC0 := 88.
Notation VMX_ENTER_TSC1 := 92.
Notation VMX_EXIT_TSC0 := 96.
Notation VMX_EXIT_TSC1 := 100.
Notation VMX_VPID := 104.
Notation VMX_EXIT_REASON := 108.
Notation VMX_EXIT_QUALIFICATION := 112.
Notation VMX_PENDING_INTR := 120.
Notation VMX_LAUNCHED := 124.
Notation VMX_FAILED := 128.
Notation VMX_HOST_EBP := 132.
Notation VMX_HOST_EDI := 136.
Notation VMX_HOST_EIP := 140.
Notation VMX_Size := 144.

Notation VMX_G_RAX' := 0.
Notation VMX_G_RBX' := 2.
Notation VMX_G_RCX' := 4.
Notation VMX_G_RDX' := 6.
Notation VMX_G_RSI' := 8.
Notation VMX_G_RDI' := 10.
Notation VMX_G_RBP' := 12.
Notation VMX_G_RIP' := 14.
Notation VMX_G_CR2' := 16.
Notation VMX_G_DR0' := 17.
Notation VMX_G_DR1' := 18.
Notation VMX_G_DR2' := 19.
Notation VMX_G_DR3' := 20.
Notation VMX_G_DR6' := 21.
Notation VMX_ENTER_TSC0' := 22.
Notation VMX_ENTER_TSC1' := 23.
Notation VMX_EXIT_TSC0' := 24.
Notation VMX_EXIT_TSC1' := 25.
Notation VMX_VPID' := 26.
Notation VMX_EXIT_REASON' := 27.
Notation VMX_EXIT_QUALIFICATION' := 28.
Notation VMX_PENDING_INTR' := 30.
Notation VMX_LAUNCHED' := 31.
Notation VMX_FAILED' := 32.
Notation VMX_HOST_EBP' := 33.
Notation VMX_HOST_EDI' := 34.
Notation VMX_HOST_EIP' := 35.
Notation VMX_Size' := 36.

Notation C_GUEST_EAX := 0.
Notation C_GUEST_EBX := 1.
Notation C_GUEST_ECX := 2.
Notation C_GUEST_EDX := 3.
Notation C_GUEST_ESI := 4.
Notation C_GUEST_EDI := 5.
Notation C_GUEST_EBP := 6.
Notation C_GUEST_ESP := 7.
Notation C_GUEST_EIP := 8.
Notation C_GUEST_EFLAGS := 9.
Notation C_GUEST_CR0 := 10.
Notation C_GUEST_CR2 := 11.
Notation C_GUEST_CR3 := 12.
Notation C_GUEST_CR4 := 13.
Notation C_GUEST_MAX_REG := 14.

Notation C_GUEST_CS := 0.
Notation C_GUEST_DS := 1.
Notation C_GUEST_ES := 2.
Notation C_GUEST_FS := 3.
Notation C_GUEST_GS := 4.
Notation C_GUEST_SS := 5.
Notation C_GUEST_LDTR := 6.
Notation C_GUEST_TR := 7.
Notation C_GUEST_GDTR := 8.
Notation C_GUEST_IDTR := 9.
Notation C_GUEST_MAX_SEG_DESC := 10.

Notation MSR_VMX_BASIC := 1152. (* 0x480 *)

Notation EXIT_QUAL_IO_ONE_BYTE := 0.
Notation EXIT_QUAL_IO_TWO_BYTE := 1.
Notation EXIT_QUAL_IO_FOUR_BYTE := 4.
Notation EXIT_QUAL_IO_SIZE := 7.

Notation EXIT_QUAL_IO_OUT := 0.
Notation EXIT_QUAL_IO_IN := 1.
Notation EXIT_QUAL_IO_DIR := 3.

Notation EXIT_REASON_MASK := 65535. (*0x0000ffff*)

Notation PROCBASED_INT_WINDOW_EXITING := 4.

Notation VMCS_INTERRUPTION_INFO_VALID := 2147483648. (* 1U << 31 *)
Notation VMCS_INTERRUPTION_INFO_EV := 2048. (* 11 *)

Notation VMCS_INTERRUPTIBILITY_STI_BLOCKING := 1.
Notation VMCS_INTERRUPTIBILITY_MOVSS_BLOCKING := 2.
Notation VMCS_INTERRUPTIBILITY_STI_or_MOVSS_BLOCKING := 3.

Notation CPU_GDT_KDATA := 16. (*0x10*)
Notation CPU_GDT_KCODE := 8. (*0x08*)
Notation CPU_GDT_TSS := 40. (*0x28*)

Notation MSR_IA32_SYSENTER_CS := 372.  (*0x174*)
Notation MSR_IA32_SYSENTER_ESP := 373.  (*0x175*)
Notation MSR_IA32_SYSENTER_EIP := 374.  (*0x176*)
Notation MSR_PAT := 631.  (*0x277*)
Notation MSR_IA32_PERF_GLOBAL_CTRL := 911.  (*0x38f*)
Notation MSR_EFER := 3221225600. (*0xc0000080*)

Notation CR0_PE := 1.  (*0x00000001*)
Notation CR0_MP := 2.  (*0x00000002*)
Notation CR0_EM := 4.  (*0x00000004*)
Notation CR0_TS := 8.  (*0x00000008*)
Notation CR0_NE := 32.  (*0x00000020*)
Notation CR0_WP := 65536.  (*0x00010000*)
Notation CR0_AM := 262144.  (*0x00040000*)
Notation CR0_PG := 2147483648.  (*0x80000000*)

Notation v0x60000010 := 1610612752. (*0x60000010*)
Notation CR4_VMXE := 8192. (*1 << 13*)
Notation v0x00000400 := 1024. (*0x00000400*)
Notation v0x7040600070406 := 1974748653749254. (*0x7040600070406ULL*)
Notation v0xffffffffffffffff := 18446744073709551615.

Notation EXIT_QUAL_IO_REP := 5.
Notation EXIT_QUAL_IO_STR := 4.
Notation EXIT_REASON_ENTRY_FAIL := 2147483648. (*1 << 31*)
Notation C_EXIT_QUAL_IO_PORT := 65536.
Notation v0xffffffff := 4294967295.
Notation v0xfff0 := 65520.
Notation v0xffff0ff0 := 4294905840.

(*EPT *)

Notation EPT_NO_PERM:= 4294967288. (*~(uint32_t) 0x7)*)
Notation EPT_ADDR_OFFSET_MASK := 4095.

Notation EPT_PG_IGNORE_PAT_or_PERM:= 71.
Notation EPT_ADDR_MASK := 4294963200. (*0xfffff000*)
Notation EPT_PG_MEMORY_TYPE := 3.

Notation EPTP_pml4 := 30.
Notation T_MCHK_SHIFT := 262144.

(* VMX_INFO *)
Notation VMX_INFO_VMX_ENABLED := 1.
Notation VMX_INFO_PINBASED_CTLS := 2.
Notation VMX_INFO_PROCBASED_CTLS := 3.
Notation VMX_INFO_PROCBASED_CTLS2 := 4.
Notation VMX_INFO_EXIT_CTLS := 5.
Notation VMX_INFO_ENTRY_CTLS := 6.
Notation VMX_INFO_CR0_ONES_MASK := 7.
Notation VMX_INFO_CR0_ZEROS_MASK := 9.
Notation VMX_INFO_CR4_ONES_MASK := 11.
Notation VMX_INFO_CR4_ZEROS_MASK := 13.
Notation VMX_INFO_VMX_REGION := 14.

Notation E_SUCC := 0. (*no errors *)
Notation E_MEM := 1. (* memory failure *)
Notation E_IPC := 2.
Notation E_INVAL_CALLNR := 3. (* invalid syscall number *)
Notation E_INVAL_ADDR := 4. (* invalid address *)
Notation E_INVAL_PID := 5. (* invalid process ID *)
Notation E_INVAL_REG := 6.
Notation E_INVAL_SEG := 7.
Notation E_INVAL_EVENT := 8.
Notation E_INVAL_PORT := 9.
Notation E_INVAL_HVM := 10.
Notation E_INVAL_CHID := 11.
Notation E_DISK_OP := 12. (* disk operation failure *)
Notation E_HVM_VMRUN := 13.
Notation E_HVM_MMAP := 14.
Notation E_HVM_REG := 15.
Notation E_HVM_SEG := 16.
Notation E_HVM_NEIP := 17.
Notation E_HVM_INJECT := 18.
Notation E_HVM_IOPORT := 19.
Notation E_HVM_MSR := 20.
Notation E_HVM_INTRWIN := 21.
Notation MAX_ERROR_NR := 22.

Notation v0xfffff000 := 4294963200.

Notation EXIT_REASON_INOUT:= 30.
Notation EXIT_REASON_EPT_FAULT:= 48.

Notation SYS_puts := 0.	(* output a string to the screen *)
Notation SYS_ring0_spawn := 1. (* create a new ring0 process *)
Notation SYS_spawn := 2. (* create a new process *)
Notation SYS_yield := 3. (* yield to another process *)
Notation SYS_sleep := 4.
Notation SYS_disk_op := 5. (* perform a disk operation *)
Notation SYS_disk_cap := 6. (* get the capacity of a disk in bytes *)
Notation SYS_is_chan_ready := 7.
Notation SYS_send := 8.
Notation SYS_recv := 9.
Notation SYS_get_tsc_per_ms := 10.
Notation SYS_hvm_run_vm := 11.
Notation SYS_hvm_get_exitinfo := 12.
Notation SYS_hvm_mmap := 13.
Notation SYS_hvm_set_seg := 14.
Notation SYS_hvm_set_reg := 15.
Notation SYS_hvm_get_reg := 16.
Notation SYS_hvm_get_next_eip := 17.
Notation SYS_hvm_inject_event := 18.
Notation SYS_hvm_check_int_shadow := 19.
Notation SYS_hvm_check_pending_event := 20.
Notation SYS_hvm_intercept_int_window := 21.
Notation SYS_hvm_get_tsc_offset := 22.
Notation SYS_hvm_set_tsc_offset := 23.
Notation SYS_hvm_handle_rdmsr := 24.
Notation SYS_hvm_handle_wrmsr := 25.
Notation SYS_get_quota := 26.
Notation MAX_SYSCALL_NR := 27. (* XXX: always put it at the end of __syscall_nr *)


Require Export Fiat.Common.Coq__8_4__8_5__Compat.
(** Sharpened ADT for an expression grammar with parentheses *)
Require Import Coq.Init.Wf Coq.Arith.Wf_nat.
Require Import Coq.ZArith.ZArith.
Require Import Coq.Lists.List Coq.Strings.String.
Require Import Coq.Numbers.Natural.Peano.NPeano.
Require Import Fiat.Parsers.ContextFreeGrammar.Core.
Require Import Fiat.Parsers.ContextFreeGrammar.PreNotations.
Require Import Fiat.Parsers.ContextFreeGrammar.Equality.
Require Import Coq.Program.Equality.
Require Import Coq.MSets.MSetPositive.
Require Import Fiat.Common.
Require Import Fiat.Common.Equality.
Require Import Fiat.Common.Wf.
Require Import Fiat.Common.Enumerable.
Require Import Fiat.Common.LogicFacts.
Require Import Fiat.Parsers.Splitters.RDPList.
Require Import Fiat.Parsers.Splitters.BruteForce.
Require Import Fiat.Parsers.ParserInterface.
Require Import Fiat.Parsers.BaseTypes.
Require Import Fiat.Parsers.CorrectnessBaseTypes.
Require Import Fiat.Parsers.BooleanRecognizerFull.
Require Import Fiat.Parsers.BooleanRecognizerCorrect.
Require Import Fiat.Common.List.Operations.
Require Import Fiat.Parsers.StringLike.Core.
Require Import Fiat.Parsers.StringLike.ForallChars.
Require Import Fiat.Parsers.StringLike.FirstChar.
Require Import Fiat.Parsers.StringLike.FirstCharSuchThat.
Require Import Fiat.Parsers.StringLike.LastChar.
Require Import Fiat.Parsers.StringLike.LastCharSuchThat.
Require Import Fiat.Parsers.StringLike.Properties.
Require Import Fiat.Parsers.MinimalParseOfParse.
Require Import Fiat.Parsers.ContextFreeGrammar.Properties.
Require Import Fiat.Parsers.ContextFreeGrammar.Fold.
Require Import Fiat.Parsers.BaseTypesLemmas.
Require Import Fiat.Parsers.ContextFreeGrammar.Valid.
Require Import Fiat.Parsers.ContextFreeGrammar.ValidProperties.
Require Import Fiat.Parsers.ContextFreeGrammar.ValidReflective.
Require Import Fiat.Parsers.Refinement.DisjointLemmasEarlyDeclarations.
Require Import Fiat.Parsers.Refinement.PossibleTerminalsSets.
Require Import Fiat.Common.BoolFacts.
Require Fiat.Parsers.Reachable.All.MinimalReachable.
Require Fiat.Parsers.Reachable.All.MinimalReachableOfReachable.
Require Fiat.Parsers.Reachable.All.ReachableParse.
Require Fiat.Parsers.Reachable.OnlyFirst.MinimalReachable.
Require Fiat.Parsers.Reachable.OnlyFirst.MinimalReachableOfReachable.
Require Fiat.Parsers.Reachable.OnlyFirst.ReachableParse.
Require Fiat.Parsers.Reachable.OnlyLast.MinimalReachable.
Require Fiat.Parsers.Reachable.OnlyLast.MinimalReachableOfReachable.
Require Fiat.Parsers.Reachable.OnlyLast.ReachableParse.
Require Fiat.Parsers.Reachable.MaybeEmpty.Core.
Require Fiat.Parsers.Reachable.MaybeEmpty.MinimalOfCore.
Require Fiat.Parsers.Reachable.MaybeEmpty.OfParse.

Set Implicit Arguments.

Local Open Scope string_like_scope.

Local Arguments string_beq : simpl never.

Section search_forward.
  Context {G : pregrammar' Ascii.ascii}
          {HSLM : StringLikeMin Ascii.ascii}
          {HSL : StringLike Ascii.ascii}
          {HSI : StringIso Ascii.ascii}
          {HSLP : StringLikeProperties Ascii.ascii}
          {HSIP : StringIsoProperties Ascii.ascii}
          (pdata : possible_data G).

  Local Notation possible_terminals_of nt
    := (@all_possible_ascii_of_nt G pdata nt).
  Local Notation possible_first_terminals_of_production its
    := (@possible_first_ascii_of_production G pdata its).
  Local Notation might_be_empty_of_production its
    := (@might_be_empty_of_pr_production G pdata its).

  Lemma terminals_disjoint_search_for_not'
        (str : @String Ascii.ascii HSLM)
        {nt its}
        (H_disjoint : disjoint ascii_beq
                               (possible_terminals_of nt)
                               (possible_first_terminals_of_production its))
        {n}
        (pit : parse_of_item G (StringLike.take n str) (NonTerminal nt))
        (pits : parse_of_production G (StringLike.drop n str) its)
        (H_reachable : production_is_reachable G (NonTerminal nt :: its))
  : forall_chars__char_in (take n str) (possible_terminals_of nt)
    /\ ((length str <= n /\ might_be_empty_of_production its)
        \/ (for_first_char
              (drop n str)
              (fun ch => negb (list_bin ascii_beq ch (possible_terminals_of nt)))
            /\ n < length str)).
  Proof.
    destruct H_reachable as [ nt' [ prefix [ HinV HinL ] ] ].
    pose proof HinV as HinV';
      rewrite <- (@initial_nonterminals_correct _ G (@rdp_list_predata _ G) (@rdp_list_rdata' _ G)) in HinV'.
    apply and_comm; split.
    { destruct (Compare_dec.le_dec (length str) n); [ left | right ].
      { split; trivial.
        pose proof (drop_length str n) as H.
        rewrite (proj2 (Nat.sub_0_le (length str) n)) in H by assumption.
        generalize dependent (drop n str); clear -pit HinV' HinL HSLP HSIP.
        intros.
        eapply might_be_empty_pr_parse_of_production; eassumption. }
      { split; try omega; [].
        eapply first_char_in__impl__for_first_char;
          [
          | apply possible_first_ascii_parse_of_production; eassumption ].
        intros ch H'.
        apply Bool.negb_true_iff, Bool.not_true_iff_false.
        intro H''.
        apply list_in_bl in H''; [ | apply (@ascii_bl) ].
        eapply fold_right_andb_map_in in H_disjoint; [ | eassumption ].
        apply Bool.negb_true_iff, Bool.not_true_iff_false in H_disjoint.
        apply H_disjoint.
        apply list_in_lb; [ apply (@ascii_lb) | assumption ]. } }
    { apply (all_possible_ascii_of_item_nt pit). }
  Qed.

  Lemma terminals_disjoint_search_for_not
        (str : @String Ascii.ascii HSLM)
        {nt its}
        (H_disjoint : disjoint ascii_beq (possible_terminals_of nt) (possible_first_terminals_of_production its))
        {n}
        (pit : parse_of_item G (StringLike.take n str) (NonTerminal nt))
        (pits : parse_of_production G (StringLike.drop n str) its)
        (H_reachable : production_is_reachable G (NonTerminal nt :: its))
    : is_first_char_such_that
        (might_be_empty_of_production its)
        str
        n
        (fun ch => negb (list_bin ascii_beq ch (possible_terminals_of nt))).
  Proof.
    pose proof (terminals_disjoint_search_for_not' _ H_disjoint pit pits H_reachable) as H.
    split;
      [ destruct H as [H0 H1]
      | destruct H as [H0 [[H1 H2] | H1]]; solve [ left; eauto | right; eauto ] ].
    revert H0.
    apply forall_chars__char_in__impl__forall_chars.
    intros ch H' H''.
    apply Bool.negb_true_iff, Bool.not_true_iff_false in H''.
    apply H''.
    apply list_in_lb; [ apply (@ascii_lb) | ]; assumption.
  Qed.

  Lemma terminals_disjoint_search_for'
        (str : @String Ascii.ascii HSLM)
        {nt its}
        (H_disjoint : disjoint ascii_beq (possible_terminals_of nt) (possible_first_terminals_of_production its))
        {n}
        (pit : parse_of_item G (StringLike.take n str) (NonTerminal nt))
        (pits : parse_of_production G (StringLike.drop n str) its)
        (H_reachable : production_is_reachable G (NonTerminal nt :: its))
    : forall_chars (take n str)
                   (fun ch => negb (list_bin ascii_beq ch (possible_first_terminals_of_production its)))
      /\ ((length str <= n /\ might_be_empty_of_production its)
          \/ (first_char_in
                (drop n str)
                (possible_first_terminals_of_production its)
              /\ n < length str)).
  Proof.
    destruct H_reachable as [ nt' [ prefix [ HinV HinL ] ] ].
    pose proof HinV as HinV';
      rewrite <- (@initial_nonterminals_correct _ G (@rdp_list_predata _ G) (@rdp_list_rdata' _ G)) in HinV'.
    apply and_comm; split.
    { destruct (Compare_dec.le_dec (length str) n); [ left | right ].
      { split; trivial.
        pose proof (drop_length str n) as H.
        rewrite (proj2 (Nat.sub_0_le (length str) n)) in H by assumption.
        generalize dependent (drop n str); clear -pit HinV' HinL HSLP HSIP.
        intros.
        eapply might_be_empty_pr_parse_of_production; eassumption. }
      { split; try omega; try assumption.
        apply possible_first_ascii_parse_of_production; assumption. } }
    { eapply forall_chars__char_in__impl__forall_chars.
      { intros ch H'.
        apply Bool.negb_true_iff, Bool.not_true_iff_false.
        intro H''.
        apply list_in_bl in H''; [ | apply (@ascii_bl) ].
        eapply fold_right_andb_map_in in H_disjoint; [ | eassumption ].
        apply Bool.negb_true_iff, Bool.not_true_iff_false in H_disjoint.
        apply H_disjoint.
        apply list_in_lb; [ apply (@ascii_lb) | assumption ]. }
      { apply all_possible_ascii_of_item_nt; assumption. } }
  Qed.

  Lemma terminals_disjoint_search_for
        (str : @String Ascii.ascii HSLM)
        {nt its}
        (H_disjoint : disjoint ascii_beq (possible_terminals_of nt) (possible_first_terminals_of_production its))
        {n}
        (pit : parse_of_item G (StringLike.take n str) (NonTerminal nt))
        (pits : parse_of_production G (StringLike.drop n str) its)
        (H_reachable : production_is_reachable G (NonTerminal nt :: its))
    : is_first_char_such_that
        (might_be_empty_of_production its)
        str
        n
        (fun ch => list_bin ascii_beq ch (possible_first_terminals_of_production its)).
  Proof.
    pose proof (terminals_disjoint_search_for' _ H_disjoint pit pits H_reachable) as H.
    split;
      [ destruct H as [H0 H1]
      | destruct H as [H0 [[H1 H2] | [H1 ?]]]; [ right | left; split ]; eauto ].
    { revert H0.
      apply forall_chars_Proper; [ reflexivity | ].
      intros ch H' H''.
      apply Bool.negb_true_iff, Bool.not_true_iff_false in H'.
      apply H'.
      assumption. }
    { revert H1.
      apply first_char_in__impl__for_first_char.
      intros ch H'.
      apply list_in_lb; [ apply (@ascii_lb) | ]; assumption. }
  Qed.
End search_forward.

Section search_backward.
  Context {G : pregrammar' Ascii.ascii}
          {HSLM : StringLikeMin Ascii.ascii}
          {HSL : StringLike Ascii.ascii}
          {HSI : StringIso Ascii.ascii}
          {HSLP : StringLikeProperties Ascii.ascii}
          {HSIP : StringIsoProperties Ascii.ascii}
          (pdata : possible_data G).

  Local Notation possible_terminals_of_production its
    := (@all_possible_ascii_of_production G pdata its).
  Local Notation possible_last_terminals_of nt
    := (@possible_last_ascii_of_nt G pdata nt).
  Local Notation might_be_empty_of nt
    := (@might_be_empty_of_pr_nt G pdata nt).

  Lemma terminals_disjoint_rev_search_for_not'
        (str : @String Ascii.ascii HSLM)
        {nt its}
        (H_disjoint : disjoint ascii_beq (possible_last_terminals_of nt) (possible_terminals_of_production its))
        {n}
        (pit : parse_of_item G (StringLike.take n str) (NonTerminal nt))
        (pits : parse_of_production G (StringLike.drop n str) its)
        (H_reachable : production_is_reachable G (NonTerminal nt :: its))
  : forall_chars__char_in (drop n str) (possible_terminals_of_production its)
    /\ ((n = 0 /\ might_be_empty_of nt)
        \/ (for_last_char
              (take n str)
              (fun ch => negb (list_bin ascii_beq ch (possible_terminals_of_production its)))
            /\ n > 0)).
  Proof.
    destruct H_reachable as [ nt' [ prefix [ HinV HinL ] ] ].
    pose proof HinV as HinV';
      rewrite <- (@initial_nonterminals_correct _ G (@rdp_list_predata _ G) (@rdp_list_rdata' _ G)) in HinV'.
    apply and_comm; split.
    { destruct (Compare_dec.zerop n); [ left | right ].
      { split; trivial; []; subst.
        eapply might_be_empty_pr_parse_of_item_nt; try eassumption.
        rewrite take_length; reflexivity. }
      { split; try omega; [].
        eapply last_char_in__impl__for_last_char;
          [
          | apply possible_last_ascii_parse_of_item_nt; eassumption ].
        intros ch H'.
        apply Bool.negb_true_iff, Bool.not_true_iff_false.
        intro H''.
        apply list_in_bl in H''; [ | apply (@ascii_bl) ].
        eapply fold_right_andb_map_in in H_disjoint; [ | eassumption ].
        apply Bool.negb_true_iff, Bool.not_true_iff_false in H_disjoint.
        apply H_disjoint.
        apply list_in_lb; [ apply (@ascii_lb) | assumption ]. } }
    { apply all_possible_ascii_of_parse_of_production; assumption. }
  Qed.

  Lemma terminals_disjoint_rev_search_for_not
        (str : @String Ascii.ascii HSLM)
        {nt its}
        (H_disjoint : disjoint ascii_beq (possible_last_terminals_of nt) (possible_terminals_of_production its))
        {n}
        (pit : parse_of_item G (StringLike.take n str) (NonTerminal nt))
        (pits : parse_of_production G (StringLike.drop n str) its)
        (H_reachable : production_is_reachable G (NonTerminal nt :: its))
    : is_after_last_char_such_that
        str
        n
        (fun ch => negb (list_bin ascii_beq ch (possible_terminals_of_production its))).
  Proof.
    pose proof (terminals_disjoint_rev_search_for_not' _ H_disjoint pit pits H_reachable) as H.
    split;
      [ destruct H as [H0 H1]
      | destruct H as [H0 [[H1 H2] | H1]];
        destruct_head and;
        try solve [ left; eauto
                  | right; eauto
                  | assumption
                  | apply for_last_char_nil; rewrite ?take_length; apply Min.min_case_strong; omega ] ].
    revert H0.
    apply forall_chars__char_in__impl__forall_chars.
    intros ch H' H''.
    apply Bool.negb_true_iff, Bool.not_true_iff_false in H''.
    apply H''; clear H''.
    apply list_in_lb; [ apply (@ascii_lb) | ]; assumption.
  Qed.

  Lemma terminals_disjoint_rev_search_for'
        (str : @String Ascii.ascii HSLM)
        {nt its}
        (H_disjoint : disjoint ascii_beq (possible_last_terminals_of nt) (possible_terminals_of_production its))
        {n}
        (pit : parse_of_item G (StringLike.take n str) (NonTerminal nt))
        (pits : parse_of_production G (StringLike.drop n str) its)
        (H_reachable : production_is_reachable G (NonTerminal nt :: its))
    : forall_chars (drop n str)
                   (fun ch => negb (list_bin ascii_beq ch (possible_last_terminals_of nt)))
      /\ ((n = 0 /\ might_be_empty_of nt)
          \/ (last_char_in
                (take n str)
                (possible_last_terminals_of nt)
              /\ n > 0)).
  Proof.
    destruct H_reachable as [ nt' [ prefix [ HinV HinL ] ] ].
    pose proof HinV as HinV';
      rewrite <- (@initial_nonterminals_correct _ G (@rdp_list_predata _ G) (@rdp_list_rdata' _ G)) in HinV'.
    apply and_comm; split.
    { destruct (Compare_dec.zerop n); [ left | right ].
      { split; trivial; [].
        eapply might_be_empty_pr_parse_of_item_nt; try eassumption.
        rewrite take_length; subst; reflexivity. }
      { split; try omega; try assumption; [].
        apply possible_last_ascii_parse_of_item_nt; assumption. } }
    { eapply forall_chars__char_in__impl__forall_chars.
      { intros ch H'.
        apply Bool.negb_true_iff, Bool.not_true_iff_false.
        intro H''.
        apply list_in_bl in H''; [ | apply (@ascii_bl) ].
        eapply fold_right_andb_map_in in H_disjoint; [ | eassumption ].
        apply Bool.negb_true_iff, Bool.not_true_iff_false in H_disjoint.
        apply H_disjoint.
        apply list_in_lb; [ apply (@ascii_lb) | eassumption ]. }
      { apply all_possible_ascii_of_parse_of_production; assumption. } }
  Qed.

  Lemma terminals_disjoint_rev_search_for
        (str : @String Ascii.ascii HSLM)
        {nt its}
        (H_disjoint : disjoint ascii_beq (possible_last_terminals_of nt) (possible_terminals_of_production its))
        {n}
        (pit : parse_of_item G (StringLike.take n str) (NonTerminal nt))
        (pits : parse_of_production G (StringLike.drop n str) its)
        (H_reachable : production_is_reachable G (NonTerminal nt :: its))
    : is_after_last_char_such_that
        str
        n
        (fun ch => list_bin ascii_beq ch (possible_last_terminals_of nt)).
  Proof.
    pose proof (terminals_disjoint_rev_search_for' _ H_disjoint pit pits H_reachable) as H.
    split;
      [ destruct H as [H0 H1]
      | destruct H as [H0 [[H1 H2] | [H1 ?]]];
        try solve [ right; eauto
                  | left; split; eauto
                  | assumption
                  | apply for_last_char_nil; rewrite ?take_length; apply Min.min_case_strong; omega ] ].
    { revert H0.
      apply forall_chars_Proper; [ reflexivity | ].
      intros ch H' H''.
      apply Bool.negb_true_iff, Bool.not_true_iff_false in H'.
      apply H'.
      assumption. }
    { revert H1.
      apply last_char_in__impl__for_last_char.
      intros ch H'.
      apply list_in_lb; [ apply (@ascii_lb) | ]; assumption. }
  Qed.
End search_backward.

Ltac get_grammar :=
  lazymatch goal with
  | [ |- context[ParserInterface.split_list_is_complete_idx ?G] ] => G
  end.

(*Ltac pose_rvalid_for G :=
  lazymatch goal with
  | [ H : is_true (grammar_rvalid G) |- _ ] => idtac
  | _ => let Hvalid := fresh "Hvalid" in
         assert (Hvalid : is_true (grammar_rvalid G))
           by (vm_compute; reflexivity)
  end.
Ltac pose_rvalid := let G := get_grammar in pose_rvalid_for G.*)

Module Export Exports.
  Export DisjointLemmasEarlyDeclarations.
  (** hide the arguments to Build_disjoint_search_data *)
  Local Arguments FromAbstractInterpretation.Build_fold_grammar_data' {_ _ _ _ _} _ _ : assert.
  Notation precomputed_search_data
    := (FromAbstractInterpretation.Build_fold_grammar_data' _ _).

  Ltac do_disjoint_precomputations _ ::=
    let G := get_grammar in
    lazymatch goal with
    | [ |- context[@ParserInterface.split_list_is_complete_idx _ G ?HSLM ?HSL] ]
      => pose (_ : @StringLikeProperties _ HSLM HSL)
    end;
    pose_possible_data_for G.
End Exports.


Require Import Coqlib.
Require Import AST.
Require Import Integers.
Require Import compcert.common.Values.
Require Import Memory.
Require Export Maps.
Require Import Events.
Require Import Globalenvs.

Require Import sepcomp.mem_lemmas. (*for mem_forward*)
Require Import sepcomp.core_semantics.
Require Import sepcomp.effect_semantics.
Require Import Op.
Require Import Registers.

Require Import sepcomp.RTL.
Require Import sepcomp.RTL_coop.

Inductive RTL_effstep (ge:genv):  (block -> Z -> bool) ->
            RTL_core -> mem -> RTL_core -> mem -> Prop :=
  | rtl_effstep_exec_Inop:
      forall s f sp pc rs m pc',
      (fn_code f)!pc = Some(Inop pc') ->
      RTL_effstep ge EmptyEffect (RTL_State s f sp pc rs) m
        (RTL_State s f sp pc' rs) m
  | rtl_effstep_exec_Iop:
      forall s f sp pc rs m op args res pc' v,
      (fn_code f)!pc = Some(Iop op args res pc') ->
      eval_operation ge sp op rs##args m = Some v ->
      RTL_effstep ge EmptyEffect (RTL_State s f sp pc rs) m
        (RTL_State s f sp pc' (rs#res <- v)) m
  | rtl_effstep_exec_Iload:
      forall s f sp pc rs m chunk addr args dst pc' a v,
      (fn_code f)!pc = Some(Iload chunk addr args dst pc') ->
      eval_addressing ge sp addr rs##args = Some a ->
      Mem.loadv chunk m a = Some v ->
      RTL_effstep ge EmptyEffect (RTL_State s f sp pc rs) m
        (RTL_State s f sp pc' (rs#dst <- v)) m
  | rtl_effstep_exec_Istore:
      forall s f sp pc rs m chunk addr args src pc' a m',
      (fn_code f)!pc = Some(Istore chunk addr args src pc') ->
      eval_addressing ge sp addr rs##args = Some a ->
      Mem.storev chunk m a rs#src = Some m' ->
      RTL_effstep ge (StoreEffect a (encode_val chunk (rs#src)))
        (RTL_State s f sp pc rs) m
        (RTL_State s f sp pc' rs) m'
  | rtl_effstep_exec_Icall:
      forall s f sp pc rs m sig ros args res pc' fd,
      (fn_code f)!pc = Some(Icall sig ros args res pc') ->
      find_function ge ros rs = Some fd ->
      funsig fd = sig ->
      RTL_effstep ge EmptyEffect
        (RTL_State s f sp pc rs) m
        (RTL_Callstate (Stackframe res f sp pc' rs :: s) fd rs##args) m
  | rtl_effstep_exec_Itailcall:
      forall s f stk pc rs m sig ros args fd m',
      (fn_code f)!pc = Some(Itailcall sig ros args) ->
      find_function ge ros rs = Some fd ->
      funsig fd = sig ->
      Mem.free m stk 0 f.(fn_stacksize) = Some m' ->
      RTL_effstep ge (FreeEffect m 0 (f.(fn_stacksize)) stk)
        (RTL_State s f (Vptr stk Int.zero) pc rs) m
        (RTL_Callstate s fd rs##args) m'

(* WE DO NOT TREAT BUILTINS
  | rtl_effstep_exec_Ibuiltin:
      forall s f sp pc rs m ef args res pc' t v m',
      (fn_code f)!pc = Some(Ibuiltin ef args res pc') ->
      external_call ef ge rs##args m t v m' ->
      RTL_effstep ge
         (BuiltinEffect ge (ef_sig ef) (rs##args) m)
         (RTL_State s f sp pc rs) m
         (RTL_State s f sp pc' (rs#res <- v)) m'
*)
  | rtl_effstep_exec_Icond:
      forall s f sp pc rs m cond args ifso ifnot b pc',
      (fn_code f)!pc = Some(Icond cond args ifso ifnot) ->
      eval_condition cond rs##args m = Some b ->
      pc' = (if b then ifso else ifnot) ->
      RTL_effstep ge EmptyEffect
        (RTL_State s f sp pc rs) m
        (RTL_State s f sp pc' rs) m
  | rtl_effstep_exec_Ijumptable:
      forall s f sp pc rs m arg tbl n pc',
      (fn_code f)!pc = Some(Ijumptable arg tbl) ->
      rs#arg = Vint n ->
      list_nth_z tbl (Int.unsigned n) = Some pc' ->
      RTL_effstep ge EmptyEffect
        (RTL_State s f sp pc rs) m
        (RTL_State s f sp pc' rs) m
  | rtl_effstep_exec_Ireturn:
      forall s f stk pc rs m or m',
      (fn_code f)!pc = Some(Ireturn or) ->
      Mem.free m stk 0 f.(fn_stacksize) = Some m' ->
      RTL_effstep ge (FreeEffect m 0 (f.(fn_stacksize)) stk)
        (RTL_State s f (Vptr stk Int.zero) pc rs) m
        (RTL_Returnstate s (regmap_optget or Vundef rs)) m'
  | rtl_effstep_exec_function_internal:
      forall s f args m m' stk,
      Mem.alloc m 0 f.(fn_stacksize) = (m', stk) ->
      RTL_effstep ge EmptyEffect
        (RTL_Callstate s (Internal f) args) m
        (RTL_State s
                  f
                  (Vptr stk Int.zero)
                  f.(fn_entrypoint)
                  (init_regs args f.(fn_params)))
        m'
(*no external calls
  | rtl_effstep_exec_function_external:
      forall s ef args res t m m',
      external_call ef ge args m t res m' ->
      RTL_effstep ge (Callstate s (External ef) args) m
         t (Returnstate s res m')*)
  | rtl_effstep_exec_return:
      forall res f sp pc rs s vres m,
      RTL_effstep ge EmptyEffect
        (RTL_Returnstate (Stackframe res f sp pc rs :: s) vres) m
        (RTL_State s f sp pc (rs#res <- vres)) m

  | rtl_effstep_sub_val: forall E EE c m c' m',
      (forall b ofs, Mem.valid_block m b ->
                     E b ofs = true -> EE b ofs = true) ->
      RTL_effstep ge E c m c' m' ->
      RTL_effstep ge EE c m c' m'.

Lemma rtl_eff_exec_Iload':
  forall ge s f sp pc rs m chunk addr args dst pc' rs' a v,
  (fn_code f)!pc = Some(Iload chunk addr args dst pc') ->
  Op.eval_addressing ge sp addr rs##args = Some a ->
  Mem.loadv chunk m a = Some v ->
  rs' = (rs#dst <- v) ->
  RTL_effstep ge EmptyEffect
      (RTL_State s f sp pc rs) m
      (RTL_State  s f sp pc' rs') m.
Proof.
  intros. subst rs'. eapply rtl_effstep_exec_Iload; eauto.
Qed.

Lemma rtl_eff_exec_Iop':
  forall g s f sp pc rs m op args res pc' rs' v,
  (fn_code f)!pc = Some(Iop op args res pc') ->
  Op.eval_operation g sp op rs##args m = Some v ->
  rs' = (Registers.Regmap.set res v rs) ->
  RTL_effstep g EmptyEffect (RTL_State s f sp pc rs) m
    (RTL_State s f sp pc' rs') m.
Proof.
  intros. subst rs'. eapply rtl_effstep_exec_Iop; eauto.
Qed.

Lemma rtl_effax1: forall (M : block -> Z -> bool) g c m c' m',
      RTL_effstep g M c m c' m' ->
      (corestep rtl_coop_sem g c m c' m' /\
       Mem.unchanged_on (fun (b : block) (ofs : Z) => M b ofs = false) m m').
Proof.
intros.
  induction H.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Inop; eassumption.
         apply Mem.unchanged_on_refl.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Iop; eassumption.
         apply Mem.unchanged_on_refl.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Iload; eassumption.
         apply Mem.unchanged_on_refl.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Istore; eassumption.
         eapply StoreEffect_Storev; eassumption.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Icall; eassumption.
         apply Mem.unchanged_on_refl.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Itailcall; eassumption.
         eapply FreeEffect_free; eassumption.
(*  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Ibuiltin; eassumption.
         eapply ec_builtinEffectPolymorphic; eassumption.*)
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Icond; eassumption.
         apply Mem.unchanged_on_refl.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Ijumptable; eassumption.
         apply Mem.unchanged_on_refl.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_Ireturn; eassumption.
         eapply FreeEffect_free; eassumption.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_function_internal; eassumption.
         eapply Mem.alloc_unchanged_on; eassumption.
  split. unfold corestep, coopsem; simpl.
         eapply rtl_corestep_exec_return; eassumption.
         apply Mem.unchanged_on_refl.
  (*effstep_sub_val*)
    destruct IHRTL_effstep.
    split; trivial.
    eapply unchanged_on_validblock; try eassumption.
    intros; simpl. remember (E b ofs) as d.
    destruct d; trivial. apply eq_sym in Heqd.
    rewrite (H _ _ H3 Heqd) in H4. discriminate.
Qed.

Lemma rtl_effax2: forall  g c m c' m',
      corestep rtl_coop_sem g c m c' m' ->
      exists M, RTL_effstep g M c m c' m'.
Proof.
intros. inv H.
    eexists. eapply rtl_effstep_exec_Inop; eassumption.
    eexists. eapply rtl_effstep_exec_Iop; eassumption.
    eexists. eapply rtl_effstep_exec_Iload; eassumption.
    eexists. eapply rtl_effstep_exec_Istore; eassumption.
    eexists. eapply rtl_effstep_exec_Icall; try eassumption. trivial.
    eexists. eapply rtl_effstep_exec_Itailcall; try eassumption. trivial.
   (* eexists. eapply rtl_effstep_exec_Ibuiltin; eassumption.*)
    eexists. eapply rtl_effstep_exec_Icond; try eassumption. trivial.
    eexists. eapply rtl_effstep_exec_Ijumptable; eassumption.
    eexists. eapply rtl_effstep_exec_Ireturn; eassumption.
    eexists. eapply rtl_effstep_exec_function_internal; eassumption.
    eexists. eapply rtl_effstep_exec_return.
Qed.

(*
Lemma RTL_effstep_sub: forall g U V c m c' m'
         (UV: forall b ofs, U b ofs = true -> V b ofs = true),
         (RTL_effstep g U c m c' m' -> RTL_effstep g V c m c' m').
Qed.
*)
(*
Definition cmin_effstep ge (E:block -> Z -> bool)
   (c : RTL_core) m (c' : RTL_core) m': Prop :=
   coopstep g c m c' m' /\ Mem.unchanged_on (fun b ofs => E b ofs = false) m m'.
*)

Program Definition rtl_eff_sem :
  @EffectSem genv RTL_core.
eapply Build_EffectSem with (sem := rtl_coop_sem)(effstep:=RTL_effstep).
apply rtl_effax1.
apply rtl_effax2.
intros.
eapply rtl_effstep_sub_val; eassumption.
Defined.


From mathcomp.ssreflect
Require Import ssreflect ssrbool ssrnat eqtype ssrfun seq.
From mathcomp
Require Import path.
Require Import Eqdep.
Require Import Relation_Operators.
From fcsl
Require Import pred prelude ordtype finmap pcm unionmap heap.
From DiSeL
Require Import Freshness State EqTypeX Protocols Worlds NetworkSem Rely.
From DiSeL
Require Import Actions Injection Process Always HoareTriples InferenceRules.
From DiSeL
Require Import InductiveInv While.
From DiSeL
Require Import CalculatorProtocol CalculatorInvariant.
From DiSeL
Require Import CalculatorClientLib CalculatorServerLib.

Export CalculatorProtocol.

Section DelegatingCalculator.

Variables (l1 l2 : Label).
Hypothesis (lab_disj : l2 != l1).

Variable f : input -> option nat.
Variable prec : input -> bool.
Variables (cs1 cls1 : seq nid).
Variables (cs2 cls2 : seq nid).
Notation nodes1 := (cs1 ++ cls1).
Notation nodes2 := (cs2 ++ cls2).
Hypothesis Huniq1 : uniq nodes1.
Hypothesis Huniq2 : uniq nodes2.

(* Protocol I'm a server in *)
Notation cal1 := (cal_with_inv l1 f prec cs1 cls1).
Notation cal2 := (cal_with_inv l2 f prec cs2 cls2).

Notation W1 := (mkWorld cal1).
Notation W2 := (mkWorld cal2).

(* Composite world *)
Definition V := W1 \+ W2.
Lemma validV : valid V.
Proof.
rewrite /V; apply/andP=>/=.
split; first by rewrite validPtUn/= validPt/= domPt inE/=.
by rewrite unitR valid_unit.
Qed.

(* This server node *)
Variable sv : nid.
(* It's a server in protocol cal1 *)
Hypothesis  Hs1 : sv \in cs1.
(* It's a client in protocol cal2 *)
Hypothesis  Hc2 : sv \in cls2.
(* Delegate server *)
Variable sd : nid.
Hypothesis  Hs2 : sd \in cs2.

Notation loc i k := (getLocal sv (getStatelet i k)).
Notation loc1 i := (loc i l1).
Notation loc2 i := (loc i l2).

(* Delegate computation to someone else *)
Definition delegate_f := compute_f l2 f prec cs2 cls2 _ Hc2 sd.

Notation cal_ii := (ii l1 f prec cs1 cls1).

Definition receive_msg :=
  with_inv cal_ii (blocking_receive_req l1 f prec cs1 cls1 _ Hs1).
Definition send_ans to args ans :=
  with_inv cal_ii (send_answer l1 f prec cs1 cls1 _ Hs1 to args ans).

Definition delegating_body_spec :=
  forall _ : unit,
      DHT [sv, V]
  (fun i =>
     loc1 i = st :-> ([::]:reqs) /\
     loc2 i = st :-> ([::]:reqs),
   fun (r : unit) m =>
     loc1 m = st :-> ([::]:reqs) /\
     loc2 m = st :-> ([::]:reqs)).

Program Definition delegating_body :
  delegating_body_spec := fun (_ : unit) =>
  Do _ (
    r <-- uinject (receive_msg);
    let: (from, args) := r in
    (* Delegate computations *)
    ans <-- uinject (delegate_f args);
    uinject (send_ans from args ans);;
    ret sv V tt).

Lemma hook_complete_unit (c : context) : hook_complete (c, Unit).
Proof. by move=>????; rewrite dom0. Qed.

Lemma hooks_consistent_unit (c : context) : hooks_consistent c Unit.
Proof. by move=>????; rewrite dom0. Qed.

Next Obligation.
rewrite -(unitR V)/V.
have V: valid (W1 \+ W2 \+ Unit) by rewrite unitR validV.
apply: (injectL V); do?[apply: hook_complete_unit | apply: hooks_consistent_unit].
by move=>??????; rewrite dom0.
Defined.

Next Obligation.
rewrite -(unitR V)/V.
have V: valid (W1 \+ W2 \+ Unit) by rewrite unitR validV.
apply: (injectR V); do?[apply: hook_complete_unit | apply: hooks_consistent_unit].
by move=>??????; rewrite dom0.
Qed.

Next Obligation.
rewrite -(unitR V)/V.
have V: valid (W1 \+ W2 \+ Unit) by rewrite unitR validV.
apply: (injectL V); do?[apply: hook_complete_unit | apply: hooks_consistent_unit].
by move=>??????; rewrite dom0.
Defined.

Lemma hcomp l : hook_complete (mkWorld l).
Proof. by move=>????; rewrite dom0. Qed.

Next Obligation.
move=>i/=[K1 L1]; apply: vrf_coh=>CD1; apply: step.
move: (coh_split CD1 (hcomp cal1) (hcomp cal2))=>[i1[j1]][C1 D1 Z]; subst i.
apply: inject_rule=>//.
have E1 : loc (i1 \+ j1) l1 = loc i1 l1
  by rewrite (locProjL CD1 _ C1)// domPt inE/=.
rewrite E1 in K1.
apply: with_inv_rule=>//.
apply: (gh_ex (g:=[::])).
apply: call_rule=>//[[from args]] i2/=[K2]H1 H2 _ j2 CD2 R1.
have E2 : loc (i1 \+ j1) l2 = loc j1 l2.
  by rewrite (locProjR CD1 _ D1)// domPt inE/=.
(* Adapt the second protocol's view *)
rewrite E2 -(rely_loc' l2 R1) in L1.
apply: step; clear C1 D1.
have D2: j2 \In Coh W2 by case: (rely_coh R1)=>/= _; rewrite injExtL//(cohW CD1).
clear R1; rewrite joinC; apply: inject_rule=>//.
apply: call_rule=>//ans j3[L3]F D3 i3 CD3/= R2.
have C3: i3 \In Coh W1 by case: (rely_coh R2)=>/= _; rewrite injExtR//(cohW CD3).
apply: step; rewrite joinC.
rewrite -(rely_loc' _ R2) in K2; move:K2=>K3; clear R2.
apply: inject_rule=>//; apply: with_inv_rule=>//.
apply: (gh_ex (g:=[:: (from, sv, args)])).
apply: call_rule; first by rewrite inE eqxx.
move=>_ i4 [K4 _] _ j4 CD4 R3.
rewrite -(rely_loc' _ R3) in L3; move: L3=>L4.
apply: ret_rule=>m R _; rewrite (rely_loc' _ R).
move/rely_coh: (R3)=>[]; rewrite injExtL ?(cohW CD2)//.
move=>_ D4; clear R3; rewrite !(rely_loc' _ R); clear R.
have X: l2 \in dom W2.1 by rewrite domPt inE eqxx.
rewrite (@locProjR _ _ _ _ _ CD4 X D4); split=>//.
have X': l1 \in dom W1.1 by rewrite domPt inE eqxx.
rewrite /= eqxx in K4; rewrite (@locProjL _ _ _ _ _ CD4 X' _)//.
by apply: (cohUnKL CD4 D4); apply: hook_complete_unit.
Qed.

Definition delegating_server_loop_cond (res : unit) := true.

Definition delegating_server_loop_inv :=
  fun (_ r : unit) i =>
    loc1 i = st :-> ([::]:reqs) /\
    loc2 i = st :-> ([::]:reqs).

Program Definition delegating_server_loop :
  DHT [sv, V]
  (fun i => loc1 i = st :-> ([::]:reqs) /\
            loc2 i = st :-> ([::]:reqs),
   fun (r : unit) m => False) :=
  Do _ (@while sv V _ _ delegating_server_loop_cond delegating_server_loop_inv _
        (fun r => Do _ (delegating_body r))) tt.

Next Obligation. by apply: with_spec (x x0). Defined.
Next Obligation.
by move:H; rewrite /delegating_server_loop_inv !(rely_loc' _ H0).
Qed.
Next Obligation. by apply: with_spec x. Defined.
Next Obligation.
by apply: ghC=>i1 s[H1 H2] C1/=; apply: call_rule.
Qed.
Next Obligation.
move=>i/=E1; apply: call_rule'=>//.
- by move=>C1; exists tt=>//.
by move=>s' m/(_ s')/=; case.
Qed.

End DelegatingCalculator.


Require Import CoqlibC.
Require Import SmallstepC.
Require Import Simulation.
Require Import ModSem AsmregsC GlobalenvsC MemoryC ASTC.
Require Import Skeleton SimModSemLift SimMem SimMemLift SimSymb.
Require Import Sound Preservation ModSemProps.

Set Implicit Arguments.

Section MATCHSIMFORWARD.

  Context {SM: SimMem.class} {SS: SimSymb.class SM} {SU: Sound.class}.
  Context {SML: SimMemLift.class SM}.

  Variable msp: ModSemPair.t.
  Variable index: Type.
  Variable order: index -> index -> Prop.
  Hypothesis WFORD: well_founded order.
  Let ms_src: ModSem.t := msp.(ModSemPair.src).
  Let ms_tgt: ModSem.t := msp.(ModSemPair.tgt).
  Variable sidx: Type.
  Hypothesis INHAB: inhabited sidx.
  Variable sound_states: sidx -> Sound.t -> mem -> ms_src.(state) -> Prop.
  Hypothesis PRSV: forall si, local_preservation ms_src (sound_states si).

  Variable match_states: forall
      (idx: index) (st_src0: ms_src.(ModSem.state)) (st_tgt0: ms_tgt.(ModSem.state)) (sm0: SimMem.t),
      Prop.

  Variable match_states_at: forall
      (st_src0: ms_src.(ModSem.state)) (st_tgt0: ms_tgt.(ModSem.state)) (sm_at sm_arg: SimMem.t),
      Prop.

  (* you maintain some kind of `ownership` here. *)
  (* normal ownership: if I alloced, I can free that *)
  (* here: if I freed, I can unfree that *)
  Variable has_footprint: forall
      (st_init_src: ms_src.(ModSem.state)) (st_init_tgt: ms_tgt.(ModSem.state)) (sm0: SimMem.t),
      Prop.

  Variable mle_excl: forall
      (st_init_src: ms_src.(ModSem.state)) (st_init_tgt: ms_tgt.(ModSem.state)) (sm0: SimMem.t) (sm1: SimMem.t),
      Prop.

  Hypothesis FOOTEXCL: forall st_at_src st_at_tgt sm0 sm1 sm2
        (MWF: SimMem.wf sm0)
        (FOOT: has_footprint st_at_src st_at_tgt sm0)
        (MLEEXCL: (mle_excl st_at_src st_at_tgt) sm1 sm2)
        (MLE: SimMem.le sm0 sm1),
        <<MLE: SimMem.le sm0 sm2>>.

  Hypothesis (EXCLPRIV: forall st_init_src st_init_tgt sm0 sm1
                 (MWF: SimMem.wf sm0)
                 (EXCL: mle_excl st_init_src st_init_tgt sm0 sm1),
                 <<LE: SimMem.lepriv sm0 sm1>>).

  Inductive match_states_at_helper
            (idx_at: index) (st_src0: ms_src.(ModSem.state)) (st_tgt0: ms_tgt.(ModSem.state)) (sm_at sm_arg: SimMem.t): Prop :=
  | match_states_at_intro
      (MATCH: match_states idx_at st_src0 st_tgt0 sm_at)
      args_src args_tgt
      (CALLSRC: ms_src.(ModSem.at_external) st_src0 args_src)
      (CALLTGT: ms_tgt.(ModSem.at_external) st_tgt0 args_tgt)
      (SIMARGS: SimMem.sim_args args_src args_tgt sm_arg)
      (MLE: SimMem.le sm_at sm_arg)
      (MWF: SimMem.wf sm_arg)
      (MATCHARG: match_states_at st_src0 st_tgt0 sm_at sm_arg).
      (* (FOOT: has_footprint st_src0 st_tgt0 sm_at) *)

  Hypothesis INITBSIM: forall sm_arg args_src args_tgt st_init_tgt
      (SIMSKENV: ModSemPair.sim_skenv msp sm_arg)
      (MWF: SimMem.wf sm_arg)
      (SIMARGS: SimMem.sim_args args_src args_tgt sm_arg)
      (INITTGT: ms_tgt.(ModSem.initial_frame) args_tgt st_init_tgt)
      (SAFESRC: exists _st_init_src, ms_src.(ModSem.initial_frame) args_src _st_init_src),
      exists st_init_src sm_init idx_init,
        (<<INITSRC: ms_src.(ModSem.initial_frame) args_src st_init_src>>) /\
        (<<MLE: SimMem.le sm_arg sm_init>>) /\
        (<<MATCH: match_states idx_init st_init_src st_init_tgt sm_init>>).

  Hypothesis INITPROGRESS: forall sm_arg args_src args_tgt
      (SIMSKENV: ModSemPair.sim_skenv msp sm_arg)
      (MWF: SimMem.wf sm_arg)
      (SIMARGS: SimMem.sim_args args_src args_tgt sm_arg)
      (SAFESRC: exists st_init_src, ms_src.(ModSem.initial_frame) args_src st_init_src),
      exists st_init_tgt, (<<INITTGT: ms_tgt.(ModSem.initial_frame) args_tgt st_init_tgt>>).

  Hypothesis ATMWF: forall idx0 st_src0 st_tgt0 sm0
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (CALLSRC: ms_src.(ModSem.is_call) st_src0),
      <<MWF: SimMem.wf sm0>>.

  Hypothesis ATFSIM: forall idx0 st_src0 st_tgt0 sm0 args_src
      (SIMSKENV: ModSemPair.sim_skenv msp sm0)
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (CALLSRC: ms_src.(ModSem.at_external) st_src0 args_src)
      (SOUND: forall si, exists su0 m_init, (sound_states si) su0 m_init st_src0),
      exists args_tgt sm_arg,
        (<<CALLTGT: ms_tgt.(ModSem.at_external) st_tgt0 args_tgt>>) /\
        (<<SIMARGS: SimMem.sim_args args_src args_tgt sm_arg>>) /\
        (<<FOOT: has_footprint st_src0 st_tgt0 sm0>>) /\
        (<<MLE: SimMem.le sm0 sm_arg>>) /\
        (<<MWF: SimMem.wf sm_arg>>) /\
        (<<MATCHAT: match_states_at st_src0 st_tgt0 sm0 sm_arg>>).

  Hypothesis AFTERFSIM: forall idx0 st_src0 st_tgt0 sm0 sm_arg sm_ret retv_src retv_tgt st_src1
      (SIMSKENV: ModSemPair.sim_skenv msp sm0)
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (MLE: SimMem.le sm0 sm_arg)
      (* (MWF: SimMem.wf sm_arg) *)
      (MLE: SimMem.le (SimMemLift.lift sm_arg) sm_ret)
      (MWF: SimMem.wf sm_ret)
      (SIMRET: SimMem.sim_retv retv_src retv_tgt sm_ret)
      (AFTERSRC: ms_src.(ModSem.after_external) st_src0 retv_src st_src1)
      (SOUND: forall si, exists su0 m_init, (sound_states si) su0 m_init st_src0)

      (* history *)
      (HISTORY: match_states_at_helper idx0 st_src0 st_tgt0 sm0 sm_arg)

      (* just helpers *)
      (MWFAFTR: SimMem.wf (SimMemLift.unlift sm_arg sm_ret))
      (MLEAFTR: SimMem.le sm_arg (SimMemLift.unlift sm_arg sm_ret)),
      exists sm_after idx1 st_tgt1,
        (<<MLE: mle_excl st_src0 st_tgt0 (SimMemLift.unlift sm_arg sm_ret) sm_after>>) /\
        forall (MLE: SimMem.le sm0 sm_after) (* helper *),
          ((<<AFTERTGT: ms_tgt.(ModSem.after_external) st_tgt0 retv_tgt st_tgt1>>) /\
           (<<MATCH: match_states idx1 st_src1 st_tgt1 sm_after>>)).

  Hypothesis FINALFSIM: forall idx0 st_src0 st_tgt0 sm0 retv_src
      (SIMSKENV: ModSemPair.sim_skenv msp sm0)
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (FINALSRC: ms_src.(ModSem.final_frame) st_src0 retv_src),
      exists sm_ret retv_tgt,
        (<<FINALTGT: ms_tgt.(ModSem.final_frame) st_tgt0 retv_tgt>>) /\
        (<<SIMRET: SimMem.sim_retv retv_src retv_tgt sm_ret>>) /\
        (<<MLE: SimMem.le sm0 sm_ret>>) /\
        (<<MWF: SimMem.wf sm_ret>>).

  Let STEPFSIM idx0 st_src0 st_tgt0 sm0 :=
      (<<RECEP: receptive_at ms_src st_src0>>) /\
      (<<STEPFSIM: forall tr st_src1
             (STEPSRC: Step ms_src st_src0 tr st_src1) ,
             exists st_src2 idx1 st_tgt1 sm1,
               (<<STARSRC: Star ms_src st_src1 nil st_src2>>) /\
               (<<PLUS: DPlus ms_tgt st_tgt0 tr st_tgt1>> \/
                           <<STAR: DStar ms_tgt st_tgt0 tr st_tgt1 /\ order idx1 idx0>>)
               /\ (<<MLE: SimMem.le sm0 sm1>>)
               (* Note: We require le for mle_preserves_sim_ge, but we cannot require SimMem.wf, beacuse of DCEproof *)
               /\ (<<MATCH: match_states idx1 st_src2 st_tgt1 sm1>>)>>).

  Let STEPBSIM idx0 st_src0 st_tgt0 sm0 :=
      (<<PROGRESS: safe_modsem ms_src st_src0 -> ModSem.is_step ms_tgt st_tgt0>>) /\
      (<<STEPBSIM: forall tr st_tgt1
             (STEPTGT: Step ms_tgt st_tgt0 tr st_tgt1) ,
             exists idx1 st_src1 sm1,
               (<<PLUS: Plus ms_src st_src0 tr st_src1>> \/
                           <<STAR: Star ms_src st_src0 tr st_src1 /\ order idx1 idx0>>)
               /\ (<<MLE: SimMem.le sm0 sm1>>)
               (* Note: We require le for mle_preserves_sim_ge, but we cannot require SimMem.wf, beacuse of DCEproof *)
               /\ (<<MATCH: match_states idx1 st_src1 st_tgt1 sm1>>)>>).

  Hypothesis STEPSIM: forall idx0 st_src0 st_tgt0 sm0
      (SIMSKENV: ModSemPair.sim_skenv msp sm0)
      (NOTCALL: ~ ModSem.is_call ms_src st_src0)
      (NOTRET: ~ ModSem.is_return ms_src st_src0)
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (SOUND: forall si, exists su0 m_init, (sound_states si) su0 m_init st_src0),
      STEPFSIM idx0 st_src0 st_tgt0 sm0 \/ STEPBSIM idx0 st_src0 st_tgt0 sm0.

  Hypothesis BAR: bar_True.

  Lemma match_states_lxsim
        i0 st_src0 st_tgt0 sm0
        (SIMSKENV: ModSemPair.sim_skenv msp sm0)
        (* (MWF: SimMem.wf sm0) *)
        (* (MCOMPAT: mem_compat st_src0 st_tgt0 sm0) *)
        (MATCH: match_states i0 st_src0 st_tgt0 sm0):
        (* su0 *)
      (* <<LXSIM: lxsim ms_src ms_tgt (sound_state su0) sm_init i0.(to_idx WFORD) st_src0 st_tgt0 sm0>> *)
      <<LXSIM: lxsimL ms_src ms_tgt (fun st => forall si, exists su0 m_init, sound_states si su0 m_init st)
                      has_footprint mle_excl
                      (Ord.lift_idx (wf_lex_ord WFORD lt_wf) (i0, 1%nat)) st_src0 st_tgt0 sm0>>.
  Proof.
    (* move su0 at top. *)
    revert_until BAR. pcofix CIH. i. pfold. ii.
    generalize (classic (ModSem.is_call ms_src st_src0)). intro CALLSRC; des.
    { (* CALL *)
      - (* u in CALLSRC. des. *)
        exploit ATMWF; eauto. i; des. ii. eapply lxsim_at_external; eauto. ii. clear CALLSRC.
        exploit ATFSIM; eauto. { ii. eapply SUSTAR; eauto. eapply star_refl. } i; des.
        (* determ_tac ModSem.at_external_dtm. clear_tac. *)
        esplits; eauto. i. exploit AFTERFSIM; try apply SAFESRC; try apply SIMRET; eauto.
        { ii. eapply SUSTAR. eapply star_refl. }
        { econs; eauto. }
        { eapply SimMemLift.unlift_wf; eauto. }
        { eapply SimMemLift.lift_spec; eauto. }
        i; des.
        assert(MLE3: SimMem.le sm0 sm_after).
        { eapply FOOTEXCL; et. etrans; et. eapply SimMemLift.lift_spec; et. }
        spc H1. des. esplits; eauto. right.
        eapply CIH; [..|eauto].
        { eapply ModSemPair.mfuture_preserves_sim_skenv; try apply SIMSKENV; eauto.
          apply rtc_once. left. et.
        }
    }
    generalize (classic (ModSem.is_return ms_src st_src0)). intro RETSRC; des.
    { (* RETURN *)
      u in RETSRC. des. exploit FINALFSIM; eauto. i; des. ii.
      eapply lxsim_final; try apply SIMRET; eauto.
    }
    exploit STEPSIM; eauto. { ii. eapply SUSTAR; eauto. eapply star_refl. } clear STEPSIM. intro STEPSIM.
    destruct STEPSIM as [STEPFSIM0|STEPBSIM0].
    { eapply lxsim_step_forward; eauto. i.
      r in STEPFSIM0. des.
      esplits; eauto. econs 1; eauto. ii. exploit STEPFSIM1; eauto. i; des_safe. esplits; eauto.
      - des.
        + left. eauto.
        + right. esplits; eauto. eapply Ord.lift_idx_spec; eauto. econs 1; eauto.
      - left. pfold. ii. eapply lxsim_step_backward; eauto. ii.
        econs 2; eauto.
        { esplits; eauto. eapply Ord.lift_idx_spec; eauto. econs 2; eauto. }
        { refl. }
        right. eapply CIH; [..|eauto].
        { eapply ModSemPair.mfuture_preserves_sim_skenv; try apply SIMSKENV; eauto. apply rtc_once; eauto. }
    }
    { rr in STEPBSIM0.
      eapply lxsim_step_backward; eauto. ii. des.
      econs 1; eauto.
      - ii. exploit STEPBSIM1; eauto. i; des_safe. esplits; eauto.
        + des.
          * left. eauto.
          * right. esplits; eauto. eapply Ord.lift_idx_spec; eauto. econs 1; eauto.
        + right. eapply CIH; [..|eauto].
          { eapply ModSemPair.mfuture_preserves_sim_skenv; try apply SIMSKENV; eauto. apply rtc_once; eauto. }
      - eapply PROGRESS; eauto.
    }
  Qed.

  Theorem match_states_sim: <<SIM: msp.(ModSemPair.sim)>>.
  Proof.
    eapply sim_mod_sem_implies; et. inv INHAB. econs; eauto.
    { i. eapply local_preservation_noguarantee_weak; eauto. }
    ii; ss. folder.
    exploit SimSymb.sim_skenv_func_bisim; eauto. { apply SIMSKENV. } intro FSIM; des.
    inv FSIM. exploit FUNCFSIM; eauto. { apply SimMem.sim_args_sim_fptr; et. } i; des.
    split; ii.
    - exploit INITBSIM; eauto. i; des.
      esplits; eauto.
      eapply match_states_lxsim; eauto.
      { eapply ModSemPair.mfuture_preserves_sim_skenv; try apply SIMSKENV; eauto. apply rtc_once; eauto. }
    - exploit INITPROGRESS; eauto.
  Unshelve.
    all: ss.
  Qed.

End MATCHSIMFORWARD.


Require Import coqutil.Datatypes.PropSet.
Require Import riscv.Spec.Primitives.
Require Import riscv.Platform.RiscvMachine.
Require Import riscv.Platform.MetricRiscvMachine.
Require Import riscv.Platform.MetricLogging.
Require Import riscv.Utility.Utility.
Require Import riscv.Utility.runsToNonDet.
Require Import compiler.util.Common.
Require Import coqutil.Tactics.Simp.
Require Import compiler.SeparationLogic.
Require Export coqutil.Word.SimplWordExpr.
Require Import compiler.GoFlatToRiscv.
Require Import compiler.DivisibleBy4.
Require Import compiler.EmitsValid.
Require Import compiler.MetricsToRiscv.
Require Import compiler.FlatImp.
Require Import compiler.RunInstruction.
Require Import compiler.FlatToRiscvDef.
Require Import compiler.FlatToRiscvCommon.
Require Import compiler.FlatToRiscvLiterals.
Require Import riscv.Utility.InstructionCoercions.
Require Import riscv.Spec.Decode.
Require Import riscv.Utility.Monads.
Require Import riscv.Spec.Machine.

Arguments Jal (_)%Z (_)%Z. (* needed when inside a (_)%sep *)

Section Proofs.
  Context {iset: Decode.InstructionSet}.
  Context {fun_pos_env: map.map String.string Z}.
  Context {width: Z} {BW: Bitwidth width} {word: word.word width}.
  Context {word_ok: word.ok word}.
  Context {locals: map.map Z word}.
  Context {mem: map.map word byte}.
  Context {env: map.map String.string (list Z * list Z * FlatImp.stmt Z)}.
  Context {M: Type -> Type}.
  Context {MM: Monads.Monad M}.
  Context {RVM: Machine.RiscvProgram M word}.
  Context {PRParams: PrimitivesParams M MetricRiscvMachine}.
  Context {ext_spec: Semantics.ExtSpec}.
  Context {word_riscv_ok: RiscvWordProperties.word.riscv_ok word}.
  Context {locals_ok: map.ok locals}.
  Context {mem_ok: map.ok mem}.
  Context {fun_pos_env_ok: map.ok fun_pos_env}.
  Context {env_ok: map.ok env}.
  Context {PR: MetricPrimitives.MetricPrimitives PRParams}.
  Context {BWM: bitwidth_iset width iset}.
  Context (compile_ext_call: fun_pos_env -> Z -> Z -> stmt Z -> list Instruction).

  Add Ring wring : (word.ring_theory (word := word))
      (preprocess [autorewrite with rew_word_morphism],
       morphism (word.ring_morph (word := word)),
       constants [word_cst]).

  Notation RiscvMachine := MetricRiscvMachine.

  Notation "'len' l" := (Z.of_nat (List.length l)) (at level 10).
  Notation "[/ a ]" := (word.of_Z a). (* squeeze/ a Z into a word *)
  Notation "[\ a ]" := (word.unsigned a). (* open up\ a word so that it becomes a Z *)

  Definition pc_in_range(m: RiscvMachine)(base: word)(l: Z): Prop :=
    [\getPc m] mod 4 = 0 /\
    [\word.sub (getPc m) base] <= l /\
    getNextPc m = word.add (getPc m) [/4].

  Definition Inv(m: RiscvMachine): Prop :=
    exists (insts: list Instruction) (data: list byte)
           (p_insts: word) (p_data: word),
      pc_in_range m p_insts (4 * len insts) /\
      (* begin ignore *)
      subset (footpr (program iset p_insts insts *
                      ptsto_instr iset (word.add p_insts [/4 * len insts])
                                  (Jal RegisterNames.zero (-4 * len insts)))%sep)
             (of_list m.(getXAddrs)) /\
      (* end ignore *)
      (program iset p_insts insts *
       ptsto_instr iset (word.add p_insts [/4 * len insts]) (Jal RegisterNames.zero (-4 * len insts)) *
       array ptsto [/1] p_data data)%sep m.(getMem) /\
      (* TODO we would also have to say that Sb and Lb only touch memory within data *)
      (forall inst, In inst insts -> (exists r1 r2 ofs, inst = Sb r1 r2 ofs) \/
                                     (exists r1 r2 ofs, inst = Lb r1 r2 ofs) \/
                                     (exists r1 r2 r3,  inst = Add r1 r2 r3)).

  Lemma pc_stays_in_range_and_instructions_remain_the_same_for_one_step:
    forall m, Inv m -> mcomp_sat (Run.run1 iset) m Inv.
  Proof.
    intros m HI.
    unfold Inv, pc_in_range in *.
    destruct_RiscvMachine m.
    simp.
    assert (exists insts0 inst insts1, insts = insts0 ++ [inst] ++ insts1 /\
                                       m_pc = word.add p_insts [/4 * len insts0])
      as P by admit.
    simp.
    match goal with
    | H: forall (_: Instruction), In _ _ -> _ |- _ =>
      specialize (H inst);
        rename H into A; move A at bottom
    end.
    specialize_hyp A. {
      eauto 10 using in_cons, in_or_app, in_eq.
    }
    destruct A as [ A | [A | A] ]; simp.
    - simulate'.

  Abort.

End Proofs.

Require compilerExamples.MMIO.
Require Import riscv.Platform.FE310ExtSpec.

Section PrintExamples.
  Context {iset: Decode.InstructionSet}.
  Context {fun_pos_env: map.map String.string Z}.
  Context {width: Z} {BW: Bitwidth width} {word: word.word width}.
  Context {word_ok: word.ok word}.
  Context {locals: map.map Z word}.
  Context {mem: map.map word byte}.
  Context {env: map.map String.string (list Z * list Z * FlatImp.stmt Z)}.
  Context {M: Type -> Type}.
  Context {MM: Monads.Monad M}.
  Context {RVM: Machine.RiscvProgram M word}.
  Context {PRParams: PrimitivesParams M MetricRiscvMachine}.
  Context {ext_spec: Semantics.ExtSpec}.
  Context {word_riscv_ok: RiscvWordProperties.word.riscv_ok word}.
  Context {locals_ok: map.ok locals}.
  Context {mem_ok: map.ok mem}.
  Context {fun_pos_env_ok: map.ok fun_pos_env}.
  Context {env_ok: map.ok env}.
  Context {PR: MetricPrimitives.MetricPrimitives PRParams}.
  Context {BWM: bitwidth_iset width iset}.
  Context (compile_ext_call: fun_pos_env -> Z -> Z -> stmt Z -> list Instruction).

  Import MonadNotations.
  Open Scope bool_scope.
  Open Scope string_scope.

  Goal False.
    set (executeM := riscv.Spec.ExecuteM.execute).
    unfold ExecuteM.execute in *.

    unfold highBits in *; simpl in *.

  Abort.

  Goal False.
    set (isMMIOAddr := MinimalMMIO.isMMIOAddr).
    simpl in *.

    unfold isOTP, isPRCI, isGPIO0, isUART0 in *.

    set (test := (isMMIOAddr (word.of_Z (0x00020004)))).
  Abort.

  Goal False.
    set (executeI := riscv.Spec.ExecuteI.execute).
    unfold ExecuteI.execute in *.

  Abort.

End PrintExamples.