-- Frap/Hoare.lean

import Frap.Trans

namespace Imp

open AExp

open BExp

open Com

open CEval

namespace Hoare

abbrev Assertion := State → Prop

def assert_implies (P Q : Assertion) : Prop :=
  ∀ st, P st → Q st

infix:36 " ->> " => assert_implies

def valid_hoare_triple (P : Assertion) (c : Com) (Q : Assertion) : Prop :=
  ∀ st st', P st → (st =[<[c]>]=> st') → Q st'

-- Repository definitions used:
content: syntax:21 "if" imp:20 "then" imp:20 "else" imp:20 "end" : imp

syntax "false" : imp

syntax "false" : term

syntax "true" : imp

syntax "true" : term

syntax "<{" imp "}>" : term

syntax:30 "{*" term "*}" term "{*" term "*}" : term

syntax "<[" term "]>" : imp

content: macro_rules
  | `(term|true) => `(Bool.true)
  | `(term|false) => `(Bool.false)
  | `(term|<{$x}>) => `(imp|$x)
  | `(imp|$n:num) => `(a_num $n)
  | `(imp|$s:str) => `(a_id $s)
  | `(imp|$x + $y) => `(a_plus <{$x}> <{$y}>)
  | `(imp|$x - $y) => `(a_minus <{$x}> <{$y}>)
  | `(imp|$x * $y) => `(a_mult <{$x}> <{$y}>)
  | `(imp|true) => `(b_true)
  | `(imp|false) => `(b_false)
  | `(imp|$x = $y) => `(b_eq <{$x}> <{$y}>)
  | `(imp|$x != $y) => `(b_neq <{$x}> <{$y}>)
  | `(imp|$x <= $y) => `(b_le <{$x}> <{$y}>)
  | `(imp|!$x) => `(b_not <{$x}>)
  | `(imp|$x && $y) => `(b_and <{$x}> <{$y}>)
  | `(imp|$x || $y) => `(b_or <{$x}> <{$y}>)
  | `(imp|($x)) => `(<{$x}>)
  | `(imp|$x:ident) => `(a_id $(Lean.quote (toString x.getId)))
  | `(imp|<[$t:term]>) => pure t

content: macro_rules
  | `(imp|skip) => `(c_skip)
  | `(imp|$x:str := $y) => `(c_asgn $x <{$y}>)
  | `(imp|$x:ident := $y) => `(c_asgn $x <{$y}>)
  | `(imp|$c1 ; $c2) => `(c_seq <{$c1}> <{$c2}>)
  | `(imp|if $b then $c1 else $c2 end) => `(c_if <{$b}> <{$c1}> <{$c2}>)
  | `(imp|while $b do $c end) => `(c_while <{$b}> <{$c}>)

content: macro_rules
  | `(term|$p <<->> $q) => `($p ->> $q ∧ $q ->> $p)

content: macro_rules
  | `(term|{*$p*} $c {*$q*}) => `(valid_hoare_triple $p $c $q)

content: abbrev x := "x"

content: inductive Com : Type :=
  | c_skip : Com
  | c_asgn : String → AExp → Com
  | c_seq : Com → Com → Com
  | c_if : BExp → Com → Com → Com
  | c_while : BExp → Com → Com
  | c_par : Com → Com → Com   

content: def beval (st : State) (b : BExp) : Bool :=
  match b with
  | b_true => true
  | b_false => false
  | b_eq a₁ a₂ => (aeval st a₁) == (aeval st a₂)
  | b_neq a₁ a₂ => (aeval st a₁) != (aeval st a₂)
  | b_le a₁ a₂ => (aeval st a₁) <= (aeval st a₂)
  | b_not b₁ => not (beval st b₁)
  | b_and b₁ b₂ => and (beval st b₁) (beval st b₂)
  | b_or b₁ b₂ => or (beval st b₁) (beval st b₂)

example : aeval (update empty x 5)
    <{3 + x * 2}>
    
    = 13 := by admit /- proof elided -/

content: def empty : State := fun _ => 0

content: abbrev State := String → Nat

content: abbrev y := "y"

content: abbrev z := "z"

content: def aeval (st : State) (a : AExp) : Nat :=
  match a with
  | a_num n => n
  | a_id x => st x
  | a_plus a₁ a₂ => (aeval st a₁) + (aeval st a₂)
  | a_minus a₁ a₂ => (aeval st a₁) - (aeval st a₂)
  | a_mult a₁ a₂ => (aeval st a₁) * (aeval st a₂)

content: inductive AExp where
  | a_num : Nat → AExp
  | a_id : String → AExp  
  | a_plus : AExp → AExp → AExp
  | a_minus : AExp → AExp → AExp
  | a_mult : AExp → AExp → AExp

content: inductive AExp where
  | a_num : Nat → AExp
  | a_plus : AExp → AExp → AExp
  | a_minus : AExp → AExp → AExp
  | a_mult : AExp → AExp → AExp

content: def update (st : State) (k : String) (v : Nat) : State :=
  fun x => if x == k then v else st x

content: inductive BExp where
  | b_true : BExp
  | b_false : BExp
  | b_eq : AExp → AExp → BExp
  | b_neq : AExp → AExp → BExp
  | b_le : AExp → AExp → BExp
  | b_not : BExp → BExp
  | b_and : BExp → BExp → BExp
  | b_or : BExp → BExp → BExp

content: inductive Com :=
  | c_skip : Com
  | c_asgn : String → AExp → Com
  | c_seq : Com → Com → Com
  | c_if : BExp → Com → Com → Com
  | c_while : BExp → Com → Com

-- 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: abbrev Assertion := State → Prop

content: def assert_implies (P Q : Assertion) : Prop :=
  ∀ st, P st → Q st

content: def valid_hoare_triple (P : Assertion) (c : Com) (Q : Assertion) : Prop :=
  ∀ st st', P st → (st =[<[c]>]=> st') → Q st'

-- Local lemmas used:
content: theorem hoare_asgn Q x a :
    {* fun st => Q (st[x ↦ aeval st a]) *} c_asgn x a {* Q *}

content: theorem hoare_consequence_pre P P' Q c :
    {* P' *} c {* Q *}
    → P ->> P'
    → {* P *} c {* Q *}

-- Target theorem and proof:
theorem hoare_if P Q b c₁ c₂ :
    {* fun st => P st ∧ beval st b *} c₁ {* Q *}
    → {* fun st => P st ∧ ¬(beval st b) *} c₂ {* Q *}
    → {* P *} c_if b c₁ c₂ {* Q *}
:= by
  intro hTrue hFalse st st' hPre hEval
  cases hEval
  . -- e_ifTrue
    rename_i hb hc₁
    apply hTrue
    . constructor
      . exact hPre
      . exact hb
    . exact hc₁
  . -- e_ifFalse
    rename_i hb hc₂
    apply hFalse
    . constructor
      . exact hPre
      . simp [hb]
    . exact hc₂

example :
    -- { True }
    {* fun _ => True *}
      <{if x = 0 then y := 2 else y := x + 1 end}>
    -- { x ≤ y }
    {* fun st => st x <= st y *} := by
  apply hoare_if
  . apply hoare_consequence_pre
    . apply hoare_asgn
    . intro st _
      simp [update] at *
      split <;> simp [*]
  . apply hoare_consequence_pre
    . apply hoare_asgn
    . intro st _
      simp [update]
      split
      . simp [*]
      . unfold x
        omega