Lecture 5: Interpreters

Require Import String.[Loading ML file ring_plugin.cmxs (using legacy method) ... done]
Open Scope string_scope. (* Lets us to write strings as "x". *)
Require Import List.
Import ListNotations.
Open Scope list_scope. (* Lets us to write lists as [1; 2; 3] *)
Require Import Lia.[Loading ML file zify_plugin.cmxs (using legacy method) ... done]
[Loading ML file micromega_plugin.cmxs (using legacy method) ... done]

Arithmetic Expressions

A data type for arithmetic expressions

Inductive expr : Type :=
  | Const : nat -> expr
  | Var : string -> expr
  | Plus : expr -> expr -> expr
  | Mult : expr -> expr -> expr.

Evaluation. We represent the environment as a function from variables to values.

Fixpoint eval (env : string -> nat) (e : expr) : nat :=
  match e with
  | Const n => n
  | Var x => env x
  | Plus e1 e2 => eval env e1 + eval env e2
  | Mult e1 e2 => eval env e1 * eval env e2
  end.

Example

Definition e := Plus
                  (Mult (Const 2) (Var "x"))
                  (Mult (Const 3) (Var "y")).
Definition env :=
  fun x => match x with "x" => 1 | "y" => 2 | _ => 0 end.
Compute eval env e.= 8
: nat

Simplification

Simplifies constants and uses the laws of arithmetic:

a + 0 = a and 0 + a = a
a * 0 = 0 and 0 * a = 0
a * 1 = a and 1 * a = a

Fixpoint simplify (e : expr) : expr :=
  match e with
  | Const n => Const n
  | Var x => Var x
  | Plus e1 e2 => 
    match simplify e1, simplify e2 with
    | Const 0, e2' => e2'
    | e1', Const 0 => e1'
    | Const n, Const m => Const (n + m)
    | e1', e2' => Plus e1' e2'
    end
  | Mult e1 e2 => 
    match simplify e1, simplify e2 with
    | Const 0, _ => Const 0
    | _, Const 0 => Const 0
    | Const 1, e2' => e2'
    | e1', Const 1 => e1'
    | Const n, Const m => Const (n * m)
    | e1', e2' => Mult e1' e2'
    end
  end.

We prove that simplify doesn't change the meaning of the expression

Lemma eval_simplify env e :
  eval env (simplify e) = eval env e.env: string -> nat
e: expr
eval env (simplify e) = eval env e
Proof.env: string -> nat
e: expr
eval env (simplify e) = eval env e
  induction e; simpl.env: string -> nat
n: nat
n = n
env: string -> nat
s: string
env s = env s
env: string -> nat
e1, e2: expr
IHe1: eval env (simplify e1) = eval env e1
IHe2: eval env (simplify e2) = eval env e2
eval env
  match simplify e1 with
  | Const 0 => simplify e2
  | Const (S n0 as n) =>
      match simplify e2 with
      | Const 0 => Const (S n0)
      | Const (S _ as m) => Const (n + m)
      | Var s => Plus (Const (S n0)) (Var s)
      | Plus e0 e3 => Plus (Const (S n0)) (Plus e0 e3)
      | Mult e0 e3 => Plus (Const (S n0)) (Mult e0 e3)
      end
  | Var s =>
      match simplify e2 with
      | Const 0 => Var s
      | Const (S n0) => Plus (Var s) (Const (S n0))
      | Var s0 => Plus (Var s) (Var s0)
      | Plus e0 e3 => Plus (Var s) (Plus e0 e3)
      | Mult e0 e3 => Plus (Var s) (Mult e0 e3)
      end
  | Plus e0 e3 =>
      match simplify e2 with
      | Const 0 => Plus e0 e3
      | Const (S n0) =>
          Plus (Plus e0 e3) (Const (S n0))
      | Var s => Plus (Plus e0 e3) (Var s)
      | Plus e4 e5 => Plus (Plus e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Plus (Plus e0 e3) (Mult e4 e5)
      end
  | Mult e0 e3 =>
      match simplify e2 with
      | Const 0 => Mult e0 e3
      | Const (S n0) =>
          Plus (Mult e0 e3) (Const (S n0))
      | Var s => Plus (Mult e0 e3) (Var s)
      | Plus e4 e5 => Plus (Mult e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Plus (Mult e0 e3) (Mult e4 e5)
      end
  end = eval env e1 + eval env e2
env: string -> nat
e1, e2: expr
IHe1: eval env (simplify e1) = eval env e1
IHe2: eval env (simplify e2) = eval env e2
eval env
  match simplify e1 with
  | Const 0 => Const 0
  | Const 1 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const (S n1) => Const (S n1)
      | Var s => Var s
      | Plus e0 e3 => Plus e0 e3
      | Mult e0 e3 => Mult e0 e3
      end
  | Const (S (S n1) as n) =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Const (S (S n1))
      | Const (S (S _) as m) => Const (n * m)
      | Var s => Mult (Const (S (S n1))) (Var s)
      | Plus e0 e3 =>
          Mult (Const (S (S n1))) (Plus e0 e3)
      | Mult e0 e3 =>
          Mult (Const (S (S n1))) (Mult e0 e3)
      end
  | Var s =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Var s
      | Const (S (S n1)) =>
          Mult (Var s) (Const (S (S n1)))
      | Var s0 => Mult (Var s) (Var s0)
      | Plus e0 e3 => Mult (Var s) (Plus e0 e3)
      | Mult e0 e3 => Mult (Var s) (Mult e0 e3)
      end
  | Plus e0 e3 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Plus e0 e3
      | Const (S (S n1)) =>
          Mult (Plus e0 e3) (Const (S (S n1)))
      | Var s => Mult (Plus e0 e3) (Var s)
      | Plus e4 e5 => Mult (Plus e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Mult (Plus e0 e3) (Mult e4 e5)
      end
  | Mult e0 e3 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Mult e0 e3
      | Const (S (S n1)) =>
          Mult (Mult e0 e3) (Const (S (S n1)))
      | Var s => Mult (Mult e0 e3) (Var s)
      | Plus e4 e5 => Mult (Mult e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Mult (Mult e0 e3) (Mult e4 e5)
      end
  end = eval env e1 * eval env e2
  - (* Const *)env: string -> nat
n: nat
n = n
    reflexivity.
  - (* Var *)env: string -> nat
s: string
env s = env s
    reflexivity.
  - (* Plus *)env: string -> nat
e1, e2: expr
IHe1: eval env (simplify e1) = eval env e1
IHe2: eval env (simplify e2) = eval env e2
eval env
  match simplify e1 with
  | Const 0 => simplify e2
  | Const (S n0 as n) =>
      match simplify e2 with
      | Const 0 => Const (S n0)
      | Const (S _ as m) => Const (n + m)
      | Var s => Plus (Const (S n0)) (Var s)
      | Plus e0 e3 => Plus (Const (S n0)) (Plus e0 e3)
      | Mult e0 e3 => Plus (Const (S n0)) (Mult e0 e3)
      end
  | Var s =>
      match simplify e2 with
      | Const 0 => Var s
      | Const (S n0) => Plus (Var s) (Const (S n0))
      | Var s0 => Plus (Var s) (Var s0)
      | Plus e0 e3 => Plus (Var s) (Plus e0 e3)
      | Mult e0 e3 => Plus (Var s) (Mult e0 e3)
      end
  | Plus e0 e3 =>
      match simplify e2 with
      | Const 0 => Plus e0 e3
      | Const (S n0) =>
          Plus (Plus e0 e3) (Const (S n0))
      | Var s => Plus (Plus e0 e3) (Var s)
      | Plus e4 e5 => Plus (Plus e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Plus (Plus e0 e3) (Mult e4 e5)
      end
  | Mult e0 e3 =>
      match simplify e2 with
      | Const 0 => Mult e0 e3
      | Const (S n0) =>
          Plus (Mult e0 e3) (Const (S n0))
      | Var s => Plus (Mult e0 e3) (Var s)
      | Plus e4 e5 => Plus (Mult e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Plus (Mult e0 e3) (Mult e4 e5)
      end
  end = eval env e1 + eval env e2
    rewrite <-IHe1, <-IHe2.env: string -> nat
e1, e2: expr
IHe1: eval env (simplify e1) = eval env e1
IHe2: eval env (simplify e2) = eval env e2
eval env
  match simplify e1 with
  | Const 0 => simplify e2
  | Const (S n0 as n) =>
      match simplify e2 with
      | Const 0 => Const (S n0)
      | Const (S _ as m) => Const (n + m)
      | Var s => Plus (Const (S n0)) (Var s)
      | Plus e0 e3 => Plus (Const (S n0)) (Plus e0 e3)
      | Mult e0 e3 => Plus (Const (S n0)) (Mult e0 e3)
      end
  | Var s =>
      match simplify e2 with
      | Const 0 => Var s
      | Const (S n0) => Plus (Var s) (Const (S n0))
      | Var s0 => Plus (Var s) (Var s0)
      | Plus e0 e3 => Plus (Var s) (Plus e0 e3)
      | Mult e0 e3 => Plus (Var s) (Mult e0 e3)
      end
  | Plus e0 e3 =>
      match simplify e2 with
      | Const 0 => Plus e0 e3
      | Const (S n0) =>
          Plus (Plus e0 e3) (Const (S n0))
      | Var s => Plus (Plus e0 e3) (Var s)
      | Plus e4 e5 => Plus (Plus e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Plus (Plus e0 e3) (Mult e4 e5)
      end
  | Mult e0 e3 =>
      match simplify e2 with
      | Const 0 => Mult e0 e3
      | Const (S n0) =>
          Plus (Mult e0 e3) (Const (S n0))
      | Var s => Plus (Mult e0 e3) (Var s)
      | Plus e4 e5 => Plus (Mult e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Plus (Mult e0 e3) (Mult e4 e5)
      end
  end =
eval env (simplify e1) + eval env (simplify e2) clear IHe1 IHe2.env: string -> nat
e1, e2: expr
eval env
  match simplify e1 with
  | Const 0 => simplify e2
  | Const (S n0 as n) =>
      match simplify e2 with
      | Const 0 => Const (S n0)
      | Const (S _ as m) => Const (n + m)
      | Var s => Plus (Const (S n0)) (Var s)
      | Plus e0 e3 => Plus (Const (S n0)) (Plus e0 e3)
      | Mult e0 e3 => Plus (Const (S n0)) (Mult e0 e3)
      end
  | Var s =>
      match simplify e2 with
      | Const 0 => Var s
      | Const (S n0) => Plus (Var s) (Const (S n0))
      | Var s0 => Plus (Var s) (Var s0)
      | Plus e0 e3 => Plus (Var s) (Plus e0 e3)
      | Mult e0 e3 => Plus (Var s) (Mult e0 e3)
      end
  | Plus e0 e3 =>
      match simplify e2 with
      | Const 0 => Plus e0 e3
      | Const (S n0) =>
          Plus (Plus e0 e3) (Const (S n0))
      | Var s => Plus (Plus e0 e3) (Var s)
      | Plus e4 e5 => Plus (Plus e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Plus (Plus e0 e3) (Mult e4 e5)
      end
  | Mult e0 e3 =>
      match simplify e2 with
      | Const 0 => Mult e0 e3
      | Const (S n0) =>
          Plus (Mult e0 e3) (Const (S n0))
      | Var s => Plus (Mult e0 e3) (Var s)
      | Plus e4 e5 => Plus (Mult e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Plus (Mult e0 e3) (Mult e4 e5)
      end
  end =
eval env (simplify e1) + eval env (simplify e2)
    destruct (simplify e1), (simplify e2); simpl; try lia;
    destruct n; simpl; try lia.env: string -> nat
e1, e2: expr
n, n0: nat
eval env
  match n0 with
  | 0 => Const (S n)
  | S _ => Const (S (n + n0))
  end = S (n + n0)
    destruct n0; simpl; lia.
  - (* Mult *)env: string -> nat
e1, e2: expr
IHe1: eval env (simplify e1) = eval env e1
IHe2: eval env (simplify e2) = eval env e2
eval env
  match simplify e1 with
  | Const 0 => Const 0
  | Const 1 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const (S n1) => Const (S n1)
      | Var s => Var s
      | Plus e0 e3 => Plus e0 e3
      | Mult e0 e3 => Mult e0 e3
      end
  | Const (S (S n1) as n) =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Const (S (S n1))
      | Const (S (S _) as m) => Const (n * m)
      | Var s => Mult (Const (S (S n1))) (Var s)
      | Plus e0 e3 =>
          Mult (Const (S (S n1))) (Plus e0 e3)
      | Mult e0 e3 =>
          Mult (Const (S (S n1))) (Mult e0 e3)
      end
  | Var s =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Var s
      | Const (S (S n1)) =>
          Mult (Var s) (Const (S (S n1)))
      | Var s0 => Mult (Var s) (Var s0)
      | Plus e0 e3 => Mult (Var s) (Plus e0 e3)
      | Mult e0 e3 => Mult (Var s) (Mult e0 e3)
      end
  | Plus e0 e3 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Plus e0 e3
      | Const (S (S n1)) =>
          Mult (Plus e0 e3) (Const (S (S n1)))
      | Var s => Mult (Plus e0 e3) (Var s)
      | Plus e4 e5 => Mult (Plus e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Mult (Plus e0 e3) (Mult e4 e5)
      end
  | Mult e0 e3 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Mult e0 e3
      | Const (S (S n1)) =>
          Mult (Mult e0 e3) (Const (S (S n1)))
      | Var s => Mult (Mult e0 e3) (Var s)
      | Plus e4 e5 => Mult (Mult e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Mult (Mult e0 e3) (Mult e4 e5)
      end
  end = eval env e1 * eval env e2
    rewrite <-IHe1, <-IHe2.env: string -> nat
e1, e2: expr
IHe1: eval env (simplify e1) = eval env e1
IHe2: eval env (simplify e2) = eval env e2
eval env
  match simplify e1 with
  | Const 0 => Const 0
  | Const 1 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const (S n1) => Const (S n1)
      | Var s => Var s
      | Plus e0 e3 => Plus e0 e3
      | Mult e0 e3 => Mult e0 e3
      end
  | Const (S (S n1) as n) =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Const (S (S n1))
      | Const (S (S _) as m) => Const (n * m)
      | Var s => Mult (Const (S (S n1))) (Var s)
      | Plus e0 e3 =>
          Mult (Const (S (S n1))) (Plus e0 e3)
      | Mult e0 e3 =>
          Mult (Const (S (S n1))) (Mult e0 e3)
      end
  | Var s =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Var s
      | Const (S (S n1)) =>
          Mult (Var s) (Const (S (S n1)))
      | Var s0 => Mult (Var s) (Var s0)
      | Plus e0 e3 => Mult (Var s) (Plus e0 e3)
      | Mult e0 e3 => Mult (Var s) (Mult e0 e3)
      end
  | Plus e0 e3 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Plus e0 e3
      | Const (S (S n1)) =>
          Mult (Plus e0 e3) (Const (S (S n1)))
      | Var s => Mult (Plus e0 e3) (Var s)
      | Plus e4 e5 => Mult (Plus e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Mult (Plus e0 e3) (Mult e4 e5)
      end
  | Mult e0 e3 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Mult e0 e3
      | Const (S (S n1)) =>
          Mult (Mult e0 e3) (Const (S (S n1)))
      | Var s => Mult (Mult e0 e3) (Var s)
      | Plus e4 e5 => Mult (Mult e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Mult (Mult e0 e3) (Mult e4 e5)
      end
  end =
eval env (simplify e1) * eval env (simplify e2) clear IHe1 IHe2.env: string -> nat
e1, e2: expr
eval env
  match simplify e1 with
  | Const 0 => Const 0
  | Const 1 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const (S n1) => Const (S n1)
      | Var s => Var s
      | Plus e0 e3 => Plus e0 e3
      | Mult e0 e3 => Mult e0 e3
      end
  | Const (S (S n1) as n) =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Const (S (S n1))
      | Const (S (S _) as m) => Const (n * m)
      | Var s => Mult (Const (S (S n1))) (Var s)
      | Plus e0 e3 =>
          Mult (Const (S (S n1))) (Plus e0 e3)
      | Mult e0 e3 =>
          Mult (Const (S (S n1))) (Mult e0 e3)
      end
  | Var s =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Var s
      | Const (S (S n1)) =>
          Mult (Var s) (Const (S (S n1)))
      | Var s0 => Mult (Var s) (Var s0)
      | Plus e0 e3 => Mult (Var s) (Plus e0 e3)
      | Mult e0 e3 => Mult (Var s) (Mult e0 e3)
      end
  | Plus e0 e3 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Plus e0 e3
      | Const (S (S n1)) =>
          Mult (Plus e0 e3) (Const (S (S n1)))
      | Var s => Mult (Plus e0 e3) (Var s)
      | Plus e4 e5 => Mult (Plus e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Mult (Plus e0 e3) (Mult e4 e5)
      end
  | Mult e0 e3 =>
      match simplify e2 with
      | Const 0 => Const 0
      | Const 1 => Mult e0 e3
      | Const (S (S n1)) =>
          Mult (Mult e0 e3) (Const (S (S n1)))
      | Var s => Mult (Mult e0 e3) (Var s)
      | Plus e4 e5 => Mult (Mult e0 e3) (Plus e4 e5)
      | Mult e4 e5 => Mult (Mult e0 e3) (Mult e4 e5)
      end
  end =
eval env (simplify e1) * eval env (simplify e2)
    destruct (simplify e1), (simplify e2); simpl; try lia;
    destruct n; simpl; try lia;
    destruct n; simpl; try lia;
    destruct n0; simpl; try lia.env: string -> nat
e1, e2: expr
n, n0: nat
eval env
  match n0 with
  | 0 => Const (S (S n))
  | S _ => Const (S (n0 + S (n0 + n * S n0)))
  end = S (n0 + S (n0 + n * S n0))
    destruct n0; simpl; lia.
Qed.

Interlude: induction

Check expr_ind.expr_ind
     : forall P : expr -> Prop,
       (forall n : nat, P (Const n)) ->
       (forall s : string, P (Var s)) ->
       (forall e : expr,
        P e -> forall e0 : expr, P e0 -> P (Plus e e0)) ->
       (forall e : expr,
        P e -> forall e0 : expr, P e0 -> P (Mult e e0)) ->
       forall e : expr, P e

The induction principle is a recursive function.

Fixpoint expr_ind' (P : expr -> Prop)
  (Hconst : forall n, P (Const n))
  (Hvar : forall s, P (Var s))
  (Hplus : forall e1 e2, P e1 -> P e2 -> P (Plus e1 e2))
  (Hmult : forall e1 e2, P e1 -> P e2 -> P (Mult e1 e2))
  (e : expr) : P e :=
  match e with
  | Const n => Hconst n
  | Var s => Hvar s
  | Plus e1 e2 => 
    Hplus e1 e2 (expr_ind' P Hconst Hvar Hplus Hmult e1)
                (expr_ind' P Hconst Hvar Hplus Hmult e2)
  | Mult e1 e2 => 
    Hmult e1 e2 (expr_ind' P Hconst Hvar Hplus Hmult e1)
                (expr_ind' P Hconst Hvar Hplus Hmult e2)
  end.

Check expr_ind'.expr_ind'
     : forall P : expr -> Prop,
       (forall n : nat, P (Const n)) ->
       (forall s : string, P (Var s)) ->
       (forall e1 e2 : expr,
        P e1 -> P e2 -> P (Plus e1 e2)) ->
       (forall e1 e2 : expr,
        P e1 -> P e2 -> P (Mult e1 e2)) ->
       forall e : expr, P e

Infinitary trees

Inductive tree :=
  | Leaf : tree
  | Node : (nat -> tree) -> tree.

Definition t0 := Node (fun n => Leaf).
Definition t1 := Node (fun n => if Nat.leb n 10 then t0 else Leaf).

Fixpoint branch n :=
  match n with
  | 0 => Leaf
  | S n' => Node (fun m => if Nat.leb n m then branch n' else Leaf)
  end.

Definition t2 := Node (fun n => t1).

Fixpoint wide n :=
  match n with
  | 0 => Leaf
  | S n' => Node (fun m => wide n')
  end.

Definition t3 := wide 10.

Depth of an infinitary tree along a path.

This shows the sense in which the tree is finite: the depth along each path is a finite natural number.

Fixpoint depth (path : nat -> nat) (t : tree) : nat :=
  match t with
  | Leaf => 0
  | Node f => 1 + depth (fun x => path (1 + x)) (f (path 0))
  end.

Compute depth (fun n => 0) t3.= 10
: nat

Definition t4 := Node (fun n => wide n).
Definition t5 := Node (fun n => Node (fun m => wide (n + m))).

Compute depth (fun n => 10) t4.= 11
: nat
Compute depth (fun n => 3 + n*n) t5.= 9
: nat

Conclusion. A value of an inductive type: * Can be infinitely wide * Can be infinitely deep * But has finite depth along any given path

Stack Machine

We now define a stack machine, and compile arithmetic expressions to it. The stack machine has a stack of numbers, and the following operations:

Inductive op :=
  | PushOp : nat -> op
  | VarOp : string -> op
  | AddOp : op
  | MultOp : op.

To compile an expression, we first compile its subexpressions (which will put their results on the stack), and then we add the operations that combine the results of the subexpressions to get the final result.

Fixpoint compile (e : expr) : list op :=
  match e with
  | Const n => [PushOp n]
  | Var x => [VarOp x]
  | Plus e1 e2 => compile e1 ++ compile e2 ++ [AddOp]
  | Mult e1 e2 => compile e1 ++ compile e2 ++ [MultOp]
  end.

Compute compile e.= [PushOp 2; VarOp "x"; MultOp; PushOp 3;
   VarOp "y"; MultOp; AddOp]
: list op

The following function runs a single operation on the input stack, and returns the output stack. In the case of stack underflow, it returns None.

Definition run1 (env : string -> nat) (stack : list nat) (op : op) : option (list nat) :=
  match op, stack with
  | PushOp n, s => Some (n :: s)
  | VarOp x, s => Some (env x :: s)
  | AddOp, s1 :: s2 :: s => Some ((s2 + s1) :: s)
  | MultOp, s1 :: s2 :: s => Some ((s2 * s1) :: s)
  | _, _ => None
  end.

This function runs an entire list of operations.

Fixpoint run (env : string -> nat) (stack : list nat) (ops : list op) : option (list nat) :=
  match ops, stack with
  | [], s => Some s
  | op :: ops, s => 
    match run1 env s op with
    | Some s' => run env s' ops
    | None => None
    end
  end.

We prove that compiling and then running gives the same result as evaluating. To make the induction go through, we need the following generalized lemma.

Lemma run_compile_ind env e stack ops :
  run env stack (compile e ++ ops) = run env (eval env e :: stack) ops.env: string -> nat
e: expr
stack: list nat
ops: list op
run env stack (compile e ++ ops) =
run env (eval env e :: stack) ops
Proof.env: string -> nat
e: expr
stack: list nat
ops: list op
run env stack (compile e ++ ops) =
run env (eval env e :: stack) ops
  revert env stack ops.e: expr
forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e ++ ops) =
run env (eval env e :: stack) ops
  induction e; intros env stack ops; simpl.n: nat
env: string -> nat
stack: list nat
ops: list op
run env (n :: stack) ops = run env (n :: stack) ops
s: string
env: string -> nat
stack: list nat
ops: list op
run env (env s :: stack) ops =
run env (env s :: stack) ops
e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env stack
  ((compile e1 ++ compile e2 ++ [AddOp]) ++ ops) =
run env (eval env e1 + eval env e2 :: stack) ops
e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env stack
  ((compile e1 ++ compile e2 ++ [MultOp]) ++ ops) =
run env (eval env e1 * eval env e2 :: stack) ops
  - (* Const *)n: nat
env: string -> nat
stack: list nat
ops: list op
run env (n :: stack) ops = run env (n :: stack) ops
    reflexivity.
  - (* Var *)s: string
env: string -> nat
stack: list nat
ops: list op
run env (env s :: stack) ops =
run env (env s :: stack) ops
    reflexivity.
  - (* Plus *)e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env stack
  ((compile e1 ++ compile e2 ++ [AddOp]) ++ ops) =
run env (eval env e1 + eval env e2 :: stack) ops
    rewrite <-!app_assoc.e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env stack
  (compile e1 ++ compile e2 ++ [AddOp] ++ ops) =
run env (eval env e1 + eval env e2 :: stack) ops rewrite IHe1.e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env (eval env e1 :: stack)
  (compile e2 ++ [AddOp] ++ ops) =
run env (eval env e1 + eval env e2 :: stack) ops rewrite IHe2.e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env (eval env e2 :: eval env e1 :: stack)
  ([AddOp] ++ ops) =
run env (eval env e1 + eval env e2 :: stack) ops simpl.e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env (eval env e1 + eval env e2 :: stack) ops =
run env (eval env e1 + eval env e2 :: stack) ops reflexivity.
  - (* Mult *)e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env stack
  ((compile e1 ++ compile e2 ++ [MultOp]) ++ ops) =
run env (eval env e1 * eval env e2 :: stack) ops
    rewrite <-!app_assoc.e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env stack
  (compile e1 ++ compile e2 ++ [MultOp] ++ ops) =
run env (eval env e1 * eval env e2 :: stack) ops rewrite IHe1.e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env (eval env e1 :: stack)
  (compile e2 ++ [MultOp] ++ ops) =
run env (eval env e1 * eval env e2 :: stack) ops rewrite IHe2.e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env (eval env e2 :: eval env e1 :: stack)
  ([MultOp] ++ ops) =
run env (eval env e1 * eval env e2 :: stack) ops simpl.e1, e2: expr
IHe1: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e1 ++ ops) =
run env (eval env e1 :: stack) ops
IHe2: forall (env : string -> nat) 
  (stack : list nat) (ops : list op),
run env stack (compile e2 ++ ops) =
run env (eval env e2 :: stack) ops
env: string -> nat
stack: list nat
ops: list op
run env (eval env e1 * eval env e2 :: stack) ops =
run env (eval env e1 * eval env e2 :: stack) ops reflexivity.
Qed.

Final result: compiling and then running gives the same result as evaluating

Lemma run_compile env e :
  run env [] (compile e) = Some [eval env e].env: string -> nat
e: expr
run env [] (compile e) = Some [eval env e]
Proof.env: string -> nat
e: expr
run env [] (compile e) = Some [eval env e]
  assert (compile e = compile e ++ []) as ->.env: string -> nat
e: expr
compile e = compile e ++ []
env: string -> nat
e: expr
run env [] (compile e ++ []) = Some [eval env e]
  {env: string -> nat
e: expr
compile e = compile e ++ [] symmetry.env: string -> nat
e: expr
compile e ++ [] = compile e apply app_nil_r. }env: string -> nat
e: expr
run env [] (compile e ++ []) = Some [eval env e]
  apply run_compile_ind.
Qed.