-- LeroyCompilerVerificationCourse/Constprop.lean

import LeroyCompilerVerificationCourse.Imp

import Std.Data.HashMap

open Classical in

def Store := Std.HashMap ident Int

@[grind] def Le (S1 S2 : Store) : Prop :=
  ∀ x n, S2.get? x = .some n -> S1.get? x = .some n

@[grind] def Top : Store := Std.HashMap.emptyWithCapacity

def Equal (S1 S2 : Store) := Std.HashMap.Equiv S1 S2

@[grind] noncomputable def fixpoint_rec (F : Store -> Store) (fuel : Nat) (S : Store) : Store :=
  match fuel with
  | 0 => Top
  | fuel + 1 =>
      let S' := F S
      if Equal S' S then S else fixpoint_rec F fuel S'

@[grind] def num_iter : Nat := 20

@[grind] noncomputable def fixpoint (F : Store -> Store) (init_S : Store) : Store :=
  fixpoint_rec F num_iter init_S

-- Repository definitions used:
content: def ident := String deriving BEq, Repr, Hashable

-- 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: def Store := Std.HashMap ident Int

content: @[grind] def Le (S1 S2 : Store) : Prop :=
  ∀ x n, S2.get? x = .some n -> S1.get? x = .some n

content: @[grind] def Top : Store := Std.HashMap.emptyWithCapacity

content: def Equal (S1 S2 : Store) := Std.HashMap.Equiv S1 S2

content: @[grind] noncomputable def fixpoint_rec (F : Store -> Store) (fuel : Nat) (S : Store) : Store :=
  match fuel with
  | 0 => Top
  | fuel + 1 =>
      let S' := F S
      if Equal S' S then S else fixpoint_rec F fuel S'

content: @[grind] def num_iter : Nat := 20

content: @[grind] noncomputable def fixpoint (F : Store -> Store) (init_S : Store) : Store :=
  fixpoint_rec F num_iter init_S

-- Local lemmas used:
content: theorem Equal_Le : ∀ S1 S2, Equal S1 S2 -> Le S1 S2

-- Target theorem and proof:
theorem fixpoint_sound (F : Store → Store) (init_S : Store) (h : S = fixpoint F init_S) :
  Le (F S) S
:= by
    have A : ∀ fuel S,
             fixpoint_rec F fuel S = Top
             \/ Equal (F (fixpoint_rec F fuel S)) (fixpoint_rec F fuel S) := by
      intro fuel
      induction fuel
      case zero => grind
      case succ fuel' ih  =>
        grind
    have E : S = Top \/ Equal (F S) S = true := by grind
    cases E <;> grind [Equal_Le]