-- Frap/Exercises/Trans.lean

import Frap.Trans

namespace Hidden.AExp

open AExp

end Hidden.AExp

namespace Imp

open AExp

open BExp

open Com

open CEval

def optimize_0plus_aexp (a : AExp) : AExp :=
  match a with
  | a_num _ => a
  | a_id _ => a
  | a_plus (a_num 0) a₂ => optimize_0plus_aexp a₂
  | a_plus a₁ a₂ => a_plus (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | a_minus a₁ a₂ => a_minus (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | a_mult a₁ a₂ => a_mult (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)

def optimize_0plus_bexp (b : BExp) : BExp :=
  match b with
  | b_true => b_true
  | b_false => b_false
  | b_eq a₁ a₂ => b_eq (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | b_neq a₁ a₂ => b_neq (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | b_le a₁ a₂ => b_le (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | b_not b₁ => b_not (optimize_0plus_bexp b₁)
  | b_and b₁ b₂ => b_and (optimize_0plus_bexp b₁) (optimize_0plus_bexp b₂)
  | b_or b₁ b₂ => b_or (optimize_0plus_bexp b₁) (optimize_0plus_bexp b₂)

def optimize_0plus_com (c : Com) : Com :=
  match c with
  | c_skip => c_skip
  | c_asgn x a => c_asgn x (optimize_0plus_aexp a)
  | c_seq c₁ c₂ => c_seq (optimize_0plus_com c₁) (optimize_0plus_com c₂)
  | c_if b c₁ c₂ => c_if (optimize_0plus_bexp b) (optimize_0plus_com c₁) (optimize_0plus_com c₂)
  | c_while b c => c_while (optimize_0plus_bexp b) (optimize_0plus_com c)

 

example :
    optimize_0plus_com <{ while x != 0 do x := 0 + x - 1 end }>
    = <{ while x != 0 do x := x - 1 end }> := by admit /- proof elided -/

-- Repository definitions used:
content: syntax "<{" imp "}>" : term

syntax:21 "while" imp:20 "do" imp:20 "end" : imp

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

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

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

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 ctrans_sound (ctrans : Com → Com) :=
  ∀ (c : Com), cequiv c (ctrans c)

content: def cequiv (c₁ c₂ : Com) : Prop :=
  ∀ st st' : State, (st =[<[c₁]>]=> st') ↔ (st =[<[c₂]>]=> st')

content: abbrev State := String → Nat

content: def btrans_sound (btrans : BExp → BExp) :=
  ∀ (b : BExp), bequiv b (btrans b)

content: def bequiv (b₁ b₂ : BExp) : Prop :=
  ∀ (st : State), beval st b₁ = beval st b₂

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 y := "y"

content: abbrev x := "x"

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: def update (st : State) (k : String) (v : Nat) : State :=
  fun x => if x == k then v else st x

content: def atrans_sound (atrans : AExp → AExp) :=
  ∀ (a : AExp), aequiv a (atrans a)

content: def aequiv (a₁ a₂ : AExp) : Prop :=
  ∀ (st : State), aeval st a₁ = aeval st a₂

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

-- Repository lemmas used:
content: theorem c_while_congruence b b' c c'
    : bequiv b b' → cequiv c c'
      → cequiv <{while <[b]> do <[c]> end}> <{while <[b']> do <[c']> end}>

content: theorem sym_bequiv b₁ b₂ : bequiv b₁ b₂ → bequiv b₂ b₁

content: theorem sym_cequiv c₁ c₂ : cequiv c₁ c₂ → cequiv c₂ c₁

content: theorem c_if_congruence b b' c₁ c₁' c₂ c₂'
    : bequiv b b' → cequiv c₁ c₁' → cequiv c₂ c₂'
      → cequiv (c_if b c₁ c₂) (c_if b' c₁' c₂')

content: theorem c_asgn_congruence x a a'
    : aequiv a a' → cequiv <{x := <[a]>}> <{x := <[a']>}>

content: theorem c_seq_congruence c₁ c₁' c₂ c₂'
    : cequiv c₁ c₁' → cequiv c₂ c₂' → cequiv (c_seq c₁ c₂) (c_seq c₁' c₂')

content: theorem refl_cequiv c : cequiv c c

-- Local definitions used:
content: def optimize_0plus_aexp (a : AExp) : AExp :=
  match a with
  | a_num _ => a
  | a_id _ => a
  | a_plus (a_num 0) a₂ => optimize_0plus_aexp a₂
  | a_plus a₁ a₂ => a_plus (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | a_minus a₁ a₂ => a_minus (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | a_mult a₁ a₂ => a_mult (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)

content: def optimize_0plus_bexp (b : BExp) : BExp :=
  match b with
  | b_true => b_true
  | b_false => b_false
  | b_eq a₁ a₂ => b_eq (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | b_neq a₁ a₂ => b_neq (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | b_le a₁ a₂ => b_le (optimize_0plus_aexp a₁) (optimize_0plus_aexp a₂)
  | b_not b₁ => b_not (optimize_0plus_bexp b₁)
  | b_and b₁ b₂ => b_and (optimize_0plus_bexp b₁) (optimize_0plus_bexp b₂)
  | b_or b₁ b₂ => b_or (optimize_0plus_bexp b₁) (optimize_0plus_bexp b₂)

content: def optimize_0plus_com (c : Com) : Com :=
  match c with
  | c_skip => c_skip
  | c_asgn x a => c_asgn x (optimize_0plus_aexp a)
  | c_seq c₁ c₂ => c_seq (optimize_0plus_com c₁) (optimize_0plus_com c₂)
  | c_if b c₁ c₂ => c_if (optimize_0plus_bexp b) (optimize_0plus_com c₁) (optimize_0plus_com c₂)
  | c_while b c => c_while (optimize_0plus_bexp b) (optimize_0plus_com c)

 

example :
    optimize_0plus_com <{ while x != 0 do x := 0 + x - 1 end }>
    = <{ while x != 0 do x := x - 1 end }> := by admit /- proof elided -/

-- Local lemmas used:
content: theorem optimize_0plus_aexp_sound : atrans_sound optimize_0plus_aexp

content: theorem optimize_0plus_bexp_sound : btrans_sound optimize_0plus_bexp

-- Target theorem and proof:
theorem optimize_0plus_com_sound : ctrans_sound optimize_0plus_com
:= by
  intros c
  induction c with simp [*] at *
  | c_skip => apply refl_cequiv
  | c_asgn => apply c_asgn_congruence; apply optimize_0plus_aexp_sound
  | c_seq =>
    apply c_seq_congruence
    . assumption
    . assumption
  | c_if =>
    apply c_if_congruence
    . apply optimize_0plus_bexp_sound
    . assumption
    . assumption
  | c_while =>
    apply c_while_congruence
    . apply optimize_0plus_bexp_sound
    . assumption