-- VerifiedCompiler.lean

namespace Term

namespace Equiv

infixl:50 " ~ " => Equiv

end Equiv

end Term

open Term (eval)

inductive Instruction
  | const (n : Nat)
  | and
  | jmp (offset : Nat)
  | jez (offset : Nat)

abbrev Program := List Instruction

abbrev Stack := List Nat

def Nat.conj : Nat → Nat → Nat
  | 0, _ | _, 0 => 0
  | _, _        => 1

structure Instruction.Result where
  stack : Stack
  offset := 0

def Instruction.exec : Instruction → Stack → Option Instruction.Result
  | .const n,    stack        => some { stack := n :: stack }
  | .and,        r :: l :: tl => some { stack := (l.conj r) :: tl }
  | .and,        _            => none
  | .jmp offset, stack        => some { stack, offset }
  | .jez offset, 0 :: tl      => some { stack := tl, offset }
  | .jez _,      _ :: tl      => some { stack := tl }
  | .jez _,      _            => none

namespace Program

def goto : Program → Nat → Option Program
  | prog,    0          => prog
  | [],      _ + 1      => none
  | _ :: tl, offset + 1 => goto tl offset

def exec : Program → Stack → Option Stack
  | [],       stack => stack
  | hd :: tl, stack =>
    match Instruction.exec hd stack with
    | none => none
    | some { stack, offset } =>
      match h : goto tl offset with
      | none   => none
      | some p => exec p stack
termination_by p => p.length
decreasing_by simp +arith [goto_decreasing h]

end Program

infixl:60 " ≈ " => HEquiv

namespace Instruction

end Instruction

namespace Program

-- 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 Instruction
  | const (n : Nat)
  | and
  | jmp (offset : Nat)
  | jez (offset : Nat)

content: abbrev Program := List Instruction

content: abbrev Stack := List Nat

content: def Nat.conj : Nat → Nat → Nat
  | 0, _ | _, 0 => 0
  | _, _        => 1

content: structure Instruction.Result where
  stack : Stack
  offset := 0

content: def Instruction.exec : Instruction → Stack → Option Instruction.Result
  | .const n,    stack        => some { stack := n :: stack }
  | .and,        r :: l :: tl => some { stack := (l.conj r) :: tl }
  | .and,        _            => none
  | .jmp offset, stack        => some { stack, offset }
  | .jez offset, 0 :: tl      => some { stack := tl, offset }
  | .jez _,      _ :: tl      => some { stack := tl }
  | .jez _,      _            => none

content: def goto : Program → Nat → Option Program
  | prog,    0          => prog
  | [],      _ + 1      => none
  | _ :: tl, offset + 1 => goto tl offset

content: def exec : Program → Stack → Option Stack
  | [],       stack => stack
  | hd :: tl, stack =>
    match Instruction.exec hd stack with
    | none => none
    | some { stack, offset } =>
      match h : goto tl offset with
      | none   => none
      | some p => exec p stack
termination_by p => p.length
decreasing_by simp +arith [goto_decreasing h]

-- Local lemmas used:
content: theorem goto_mono (prog₂ : Program) (h : goto prog₁ offset = some prog₁') :
    goto (prog₁ ++ prog₂) offset = some (prog₁' ++ prog₂)

-- Target theorem and proof:
@[simp]
theorem exec_prog_mono (prog₂ : Program) (h : exec prog₁ s₁ = some s₂) :
    exec (prog₁ ++ prog₂) s₁ = exec prog₂ s₂
:= by
  induction prog₁, s₁ using exec.induct <;> try (simp_all [exec]; done)
  next hh hg =>
    simp only [exec, hh] at h
    rw [hg] at h
    contradiction
  next hh _ hg hi =>
    simp only [exec, hh, List.cons_append] at *
    rw [hg] at h
    rw [Program.goto_mono _ hg, ←(hi h)]