-- VerifiedCompiler.lean

inductive Ty
  | bool
  | nat

inductive Value : Ty → Type
  | bool : Bool → Value .bool
  | nat  : Nat  → Value .nat

inductive Term : Ty → Type
  | val (v : Value τ)                          : Term τ
  | ite (cond : Term .bool) (pos neg : Term τ) : Term τ
  | and (lhs rhs : Term .bool)                 : Term .bool

namespace Term

def eval : Term τ → Value τ
  | val v => v
  | ite cond pos neg =>
    match eval cond with
    | true  => eval pos
    | false => eval neg
  | and lhs rhs =>
    match eval lhs, eval rhs with
    | true, true => true
    | _,    _    => false

def constFold : Term τ → Term τ
  | val v                             => val v
  | ite cond pos neg                  => ite (constFold cond) (constFold pos) (constFold neg)
  | and true true                     => true
  | and (Value.bool _) (Value.bool _) => false
  | and lhs rhs                       => and (constFold lhs) (constFold rhs)

def Equiv (t₁ t₂ : Term τ) : Prop :=
  eval t₁ = eval t₂

namespace Equiv

infixl:50 " ~ " => Equiv

end Equiv

-- Repository definitions used:
content: ...

-- Repository lemmas used:
content: theorem List.getElem_append_left{α : Type u_1} {l₁ l₂ : List α} {i : Nat} (hn : i < l₁.length) :\n(l₁ ++ l₂)[i] = l₁[i]

-- Local definitions used:
content: inductive Ty
  | bool
  | nat

content: inductive Value : Ty → Type
  | bool : Bool → Value .bool
  | nat  : Nat  → Value .nat

content: inductive Term : Ty → Type
  | val (v : Value τ)                          : Term τ
  | ite (cond : Term .bool) (pos neg : Term τ) : Term τ
  | and (lhs rhs : Term .bool)                 : Term .bool

content: def eval : Term τ → Value τ
  | val v => v
  | ite cond pos neg =>
    match eval cond with
    | true  => eval pos
    | false => eval neg
  | and lhs rhs =>
    match eval lhs, eval rhs with
    | true, true => true
    | _,    _    => false

content: def constFold : Term τ → Term τ
  | val v                             => val v
  | ite cond pos neg                  => ite (constFold cond) (constFold pos) (constFold neg)
  | and true true                     => true
  | and (Value.bool _) (Value.bool _) => false
  | and lhs rhs                       => and (constFold lhs) (constFold rhs)

content: def Equiv (t₁ t₂ : Term τ) : Prop :=
  eval t₁ = eval t₂

-- Local lemmas used:

-- Target theorem and proof:
theorem constFold_equiv (t : Term τ) : t ~ constFold t
:= by
  induction t
  case val v => rfl
  case ite hc hp hn => exact Equiv.ite_congr hc hp hn
  case and lhs rhs hl hr =>
    unfold constFold
    cases lhs <;> cases rhs
    case val.val v₁ v₂ => cases v₁; cases v₂; cases ‹Bool› <;> cases ‹Bool› <;> simp
    all_goals simp only [Equiv.and_congr hl hr]