-- Frap/Hoare.lean

import Frap.Trans

namespace Imp

open AExp

open BExp

open Com

open CEval

namespace Hoare

infix:36 " ->> " => assert_implies

-- 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:21 "while" imp:20 "do" imp:20 "end" : imp

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

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: 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 : 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: inductive CEval : Com → State → State → Prop :=
  | e_skip : ∀ st,
      CEval c_skip st st
  | e_asgn : ∀ a n x st,
      aeval st a = n
      → CEval (c_asgn x a) st (update st x n)
  | e_seq : ∀ c₁ c₂ st st' st'',
      CEval c₁ st st' → CEval c₂ st' st''
      → CEval (c_seq c₁ c₂) st st''
  | e_ifTrue : ∀ b c₁ c₂ st st',
      beval st b = true → CEval c₁ st st'
      → CEval (c_if b c₁ c₂) st st'
  | e_ifFalse : ∀ b c₁ c₂ st st',
      beval st b = false → CEval c₂ st st'
      → CEval (c_if b c₁ c₂) st st'
  | e_whileFalse : ∀ b c st,
      beval st b = false
      → CEval (c_while b c) st st
  | e_whileTrue : ∀ b c st st' st'',
      beval st b = true
      → CEval c st st'
      → CEval (c_while b c) st' st''
      → CEval (c_while b c) st st''

syntax:30 term " =[ " imp " ]=> " term : term
macro_rules
  | `(term|$st =[ $c ]=> $st') => `(CEval <{$c}> $st $st')

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'

-- 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:

-- Local lemmas used:

-- Target theorem and proof:
theorem hoare_while P b c :
    {* fun st => P st ∧ beval st b *} c {* P *}
    → {* P *} c_while b c {* fun st => P st ∧ ¬(beval st b) *}
:= by
  intro hHoare st st' hPre hEval
  -- we proceed by induction on `hEval`
  generalize hloop : c_while b c = cmd at *
  induction hEval with simp at *
  | e_whileFalse =>
    constructor
    . exact hPre
    . simp [*]
  | e_whileTrue =>
    simp [*] at *
    rename_i ih
    apply ih
    apply hHoare
    . constructor
      . apply hPre
      . assumption
    . assumption

/-
We call `P` a _loop invariant_ of `while b do c` if
  `{P ∧ b} c {P}`
is a valid Hoare triple.

This means that `P` will be true at the end of the loop body whenever the loop body executes.
If `P` contradicts `b`, this holds trivially since the precondition is false.

For instance, `X = 0` is a loop invariant of
  `while X = 2 do X := 1 end`
since the program will never enter the loop.

The program
  `while Y > 10 do Y := Y - 1; Z := Z + 1 end`
admits an interesting loop invariant:
  `X = Y + Z`
Note that this doesn't contradict the loop guard but neither is it a command invariant of
  `Y := Y - 1; Z := Z + 1`
since, if `X = 5`, `Y = 0` and `Z = 5`, running the command will set `Y + Z` to 6, because `Y` remains 0.
The loop guard `Y > 10` guarantees that this will not be the case.
We will see many such loop invariants in the following lecture.
-/

example :
    -- { x ≤ 3 }
    {* fun st => st x ≤ 3 *}
    <{
      while x <= 2 do
        x := x + 1