3. Imp: Simple Imperative Programs
Needs some WORKINCLASSes and some quizzes
LATER: Another nice challenge exercise at some point would be to add C-style arrays (i.e., indirect read/write). This sets up some really nice challenge problems in Hoare (reasoning about arrays / aliasing / etc.).
SOONER: BCP 25: Maybe we should write / instead of && in assertions,
to save a mismatch in the dec_minimum exercise in Hoare₂?
At some point we could consider moving material from the old HoareLists to this chapter (and into later files, as appropriate). We haven't done it yet because it's a shame to complicate the nice simple presentation here when it's used as the basis for applications like Xavier's static analysis lectures. Also, we now have a whole volume on real separation logic...
In this chapter, we take a more serious look at how to use Lean as a tool to study other things. Our case study is a simple imperative programming language called Imp, embodying a tiny core fragment of conventional mainstream languages such as C and Java.
Here is a familiar mathematical function written in Imp.
Z := X;
Y := 1;
while (Z ≠ 0) {
Y := Y * Z;
Z := Z - 1
}
We concentrate here on defining the syntax and semantics of Imp; later in this volume we develop a theory of program equivalence and introduce Hoare Logic, a popular logic for reasoning about imperative programs.
We build Imp in three layers. The first — a core language of arithmetic and
boolean expressions — is developed in its own chapter, Slang;
read that one first. There you meet the abstract syntax of arithmetic
expressions (Aexp) and boolean expressions (Bexp), their evaluation both as
a recursive function and as an inductive relation (proved equivalent), and a
small optimize0plus program transformation together with its correctness
proof. Those expressions are variable-free.
This chapter picks up from there. First we extend the expressions with variables; then we add a language of commands — assignment, conditionals, sequencing, and loops.
3.1. Expressions With Variables
Let's return to defining Imp. The next thing we need to do is to enrich our arithmetic and boolean expressions with variables. To keep things simple, we'll assume that all variables are global and that they only hold numbers.
3.1.1. States
Since we'll want to look variables up to find out their current values,
we'll use total maps from the Typeclasses chapter of Logical Foundations. A machine state (or
just state) represents the current values of all variables at some
point in the execution of a program.
For simplicity, we assume that the state is defined for all variables,
even though any given program is only able to mention a finite number of
them. Because each variable stores a natural number, we represent the
state as a total map from strings (variable names) to Nat, and will use
0 as the default value in the store.
We give the type of variable identifiers a name, Ident. For now it is just
String; naming it makes the intent clearer.
open scoped MyGetElem
abbrev Ident := String
abbrev State := TotalMap Ident Nat
3.1.2. Syntax
We can add variables to the arithmetic expressions we had before simply
by including one more constructor. (This is a fresh Aexp, replacing
the variable-free one from the Slang chapter.)
inductive Aexp where
| num (n : Nat)
| id (x : Ident) -- NEW
| plus (a₁ a₂ : Aexp)
| minus (a₁ a₂ : Aexp)
| mult (a₁ a₂ : Aexp)
The Bexp definition is unchanged, except that it now refers to the new Aexp.
inductive Bexp where
| bool (b : Bool)
| eq (a₁ a₂ : Aexp)
| neq (a₁ a₂ : Aexp)
| le (a₁ a₂ : Aexp)
| gt (a₁ a₂ : Aexp)
| not (b : Bexp)
| and (b₁ b₂ : Bexp)
Defining a few variable names as shorthands will make examples easier to read.
def W : Ident := "W"
def X : Ident := "X"
def Y : Ident := "Y"
def Z : Ident := "Z"
3.1.3. Notations
To make Imp programs easier to read and write, we introduce some notations.
You do not need to understand exactly what these declarations do. Briefly, though, here is how the two blocks below fit together:
-
The
declare_syntax_catdirective adds a new non-terminal to Lean's grammar, calledimp_aexp. We'll add additional non-terminals further below. -
Each
syntaxdirective defines a grammar production. Seven of them build theimp_aexpcategory itself: the first two make a numeric literal and an identifier into animp_aexp, the next three build larger expressions (with annotations that fix precedence and associativity), and the last two are parentheses for grouping and~, the escape back to Lean. The eighth,aexp { … }, is a production of Lean's owntermcategory — it is what lets an Imp expression appear in ordinary Lean code. -
~esplices an already-elaborated Lean termeinto Imp syntax. We use it throughout the chapter to drop a previously-defined expression or command into a larger program, as inimp { while (X ≠ 0) { ~subtract_slowly_body } }. -
Finally,
macro_rulesis used to translate each production of theimp_aexpnon-terminal into a Lean expression.
Boolean expressions and, later, commands follow this same pattern exactly, so their declarations are collapsed where they appear: open one if you want to see the pattern repeated, and skip it otherwise.
Notation encoding: arithmetic expressions
/-- Arithmetic expressions of Imp -/
declare_syntax_cat imp_aexp
/-- Numeric literal -/
syntax:max num : imp_aexp
/-- `Ident` or Lean identifier -/
syntax:max ident : imp_aexp
/-- Addition -/
syntax:65 imp_aexp:65 " + " imp_aexp:66 : imp_aexp
/-- Subtraction -/
syntax:65 imp_aexp:65 " - " imp_aexp:66 : imp_aexp
/-- Multiplication -/
syntax:70 imp_aexp:70 " * " imp_aexp:71 : imp_aexp
/-- Parentheses for grouping -/
syntax:max "(" imp_aexp ")" : imp_aexp
/-- Escape to Lean -/
syntax:max "~" term:max : imp_aexp
/-- Embed an Imp arithmetic expression into a Lean term -/
syntax:80 "aexp " "{" imp_aexp "}" : term
namespace Imp.Elab
open Lean Elab Term Meta
def withSourceInfoOf {kind : Name} (ref : Syntax) (stx : TSyntax kind)
(canonical := true) : TSyntax kind :=
let info := SourceInfo.fromRef ref (canonical := canonical)
⟨stx.raw.setInfo info⟩
macro_rules
| `(aexp { $exp:imp_aexp }) => do
let stx ← match exp with
| `(imp_aexp| $n:num) => ``(Aexp.num $n)
| `(imp_aexp| ~$e:term) => ``(($e : Aexp))
| `(imp_aexp| $a + $b) => ``(Aexp.plus (aexp {$a}) (aexp {$b}))
| `(imp_aexp| $a - $b) => ``(Aexp.minus (aexp {$a}) (aexp {$b}))
| `(imp_aexp| $a * $b) => ``(Aexp.mult (aexp {$a}) (aexp {$b}))
| `(imp_aexp| ($a)) => ``(aexp {$a})
| _ => Lean.Macro.throwUnsupported
return withSourceInfoOf exp stx
elab_rules : term
| `(aexp { $x:ident }) => do
let some e ← resolveId? x (withInfo := true)
| throwErrorAt x "unknown identifier `{x.getId.eraseMacroScopes}`"
let type ← whnf (← inferType e)
tryPostponeIfMVar type
match_expr type with
| Aexp => pure e
| String => mkAppM ``Aexp.id #[e]
| _ => throwErrorAt x "expected an Imp identifier or arithmetic expression"
end Imp.Elab
Notation encoding: boolean expressions
/-- Boolean expressions of Imp -/
declare_syntax_cat imp_bexp
/-- Boolean literal (`true` or `false`) and Lean identifier -/
syntax:max ident : imp_bexp
/-- Equality of arithmetic expressions -/
syntax:50 imp_aexp:51 " = " imp_aexp:51 : imp_bexp
/-- Disequality of arithmetic expressions -/
syntax:50 imp_aexp:51 " ≠ " imp_aexp:51 : imp_bexp
/-- Less than or equal -/
syntax:50 imp_aexp:51 " ≤ " imp_aexp:51 : imp_bexp
/-- Greater than -/
syntax:50 imp_aexp:51 " > " imp_aexp:51 : imp_bexp
/-- Boolean negation -/
syntax:70 "¬ " imp_bexp:70 : imp_bexp
/-- Boolean conjunction (right associative) -/
syntax:35 imp_bexp:36 " ∧ " imp_bexp:35 : imp_bexp
/-- Parentheses for grouping -/
syntax:max "(" imp_bexp ")" : imp_bexp
/-- Escape to Lean -/
syntax:max "~" term:max : imp_bexp
/-- Embed an Imp boolean expression into a Lean term -/
syntax:80 "bexp " "{" imp_bexp "}" : term
Notation encoding: boolean expressions, macro rules
namespace Imp.Elab
open Lean
macro_rules
| `(bexp { $exp:imp_bexp }) => do
let stx ← match exp with
| `(imp_bexp| true) => ``(Bexp.bool true)
| `(imp_bexp| false) => ``(Bexp.bool false)
| `(imp_bexp| $x:ident) => ``(($x : Bexp))
| `(imp_bexp| ~$e:term) => ``(($e : Bexp))
| `(imp_bexp| $a:imp_aexp = $b:imp_aexp) => ``(Bexp.eq (aexp {$a}) (aexp {$b}))
| `(imp_bexp| $a:imp_aexp ≠ $b:imp_aexp) => ``(Bexp.neq (aexp {$a}) (aexp {$b}))
| `(imp_bexp| $a:imp_aexp ≤ $b:imp_aexp) => ``(Bexp.le (aexp {$a}) (aexp {$b}))
| `(imp_bexp| $a:imp_aexp > $b:imp_aexp) => ``(Bexp.gt (aexp {$a}) (aexp {$b}))
| `(imp_bexp| ¬ $b:imp_bexp) => ``(Bexp.not (bexp {$b}))
| `(imp_bexp| $b₁:imp_bexp ∧ $b₂:imp_bexp) => ``(Bexp.and (bexp {$b₁}) (bexp {$b₂}))
| `(imp_bexp| ($b:imp_bexp)) => ``(bexp {$b})
| _ => Macro.throwUnsupported
return withSourceInfoOf exp stx
end Imp.Elab
#check aexp { 3 + (X * 2) }
#check bexp { true ∧ ¬(X ≤ 4) }
3.1.4. Delaborators
Next, we write a suite of delaborators for Aexp and Bexp.
Delaborators are like the opposite of macro_rules -- they are used to pretty print elaborated terms back to the user.
Notation encoding: printing expressions back
namespace Imp.Delab
open Lean PrettyPrinter Delaborator SubExpr Parenthesizer Imp.Elab
@[category_parenthesizer imp_aexp]
def imp_aexp.parenthesizer : CategoryParenthesizer := fun prec => do
maybeParenthesize `imp_aexp true wrapParens prec <|
parenthesizeCategoryCore `imp_aexp prec
where
wrapParens (stx : Syntax) : Syntax := Unhygienic.run do
let stxInfo := SourceInfo.fromRef stx
let stx := stx.setInfo .none
let pstx ← `(imp_aexp| ($(⟨stx⟩)))
return pstx.raw.setInfo stxInfo
@[category_parenthesizer imp_bexp]
def imp_bexp.parenthesizer : CategoryParenthesizer := fun prec => do
Parenthesizer.maybeParenthesize `imp_bexp true wrapParens prec <|
Parenthesizer.parenthesizeCategoryCore `imp_bexp prec
where
wrapParens (stx : Syntax) : Syntax := Unhygienic.run do
let stxInfo := SourceInfo.fromRef stx
let stx := stx.setInfo .none
let pstx ← `(imp_bexp| ($(⟨stx⟩)))
return pstx.raw.setInfo stxInfo
Notation encoding: registering the delaborators
/--
Recognizes a term as being an `aexp { ... }` expression.
-/
def getAexp (stx : Term) : TSyntax `imp_aexp :=
withSourceInfoOf (canonical := false) stx <| Unhygienic.run do
match stx with
| `(aexp { $e:imp_aexp }) => return e
| _ => `(imp_aexp| ~$stx)
@[app_unexpander Aexp.num]
private def Aexp.unexpandNum : Unexpander
| `($_ $n:num) => `(aexp { $n:num })
| _ => throw ()
@[app_unexpander Aexp.id]
private def Aexp.unexpandId : Unexpander
| `($_ $x:ident) => `(aexp { $x:ident })
| _ => throw ()
@[app_unexpander Aexp.plus]
private def Aexp.unexpandPlus : Unexpander
| `($_ $a $b) => `(aexp { $(getAexp a) + $(getAexp b) })
| _ => throw ()
@[app_unexpander Aexp.minus]
private def Aexp.unexpandMinus : Unexpander
| `($_ $a $b) => `(aexp { $(getAexp a) - $(getAexp b) })
| _ => throw ()
@[app_unexpander Aexp.mult]
private def Aexp.unexpandMult : Unexpander
| `($_ $a $b) => `(aexp { $(getAexp a) * $(getAexp b) })
| _ => throw ()
/--
Recognizes a term as being an `bexp { ... }` expression.
-/
def getBexp (stx : Term) : TSyntax `imp_bexp :=
withSourceInfoOf (canonical := false) stx <| Unhygienic.run do
match stx with
| `(bexp { $e:imp_bexp }) => return e
| _ => `(imp_bexp| ~$stx)
/--
Delaborator for `Bexp.bool`. This is needed since we want to be sure we are
matching on the actual `true`/`false` expressions, rather than matching on the
delaborated identifiers `true`/`false` (which might not be accurate).
-/
@[app_delab Bexp.bool]
private def BExp.delabBool : Delab := whenPPOption getPPNotation do
let e ← getExpr
guard <| e.isAppOfArity ``Bexp.bool 1
match_expr e.appArg! with
| true => `(bexp { $(mkIdent `true):ident })
| false => `(bexp { $(mkIdent `false):ident })
| _ => failure
@[app_unexpander Bexp.eq]
private def Bexp.unexpandEq : Unexpander
| `($_ $a $b) => `(bexp { $(getAexp a):imp_aexp = $(getAexp b):imp_aexp })
| _ => throw ()
@[app_unexpander Bexp.neq]
private def Bexp.unexpandNeq : Unexpander
| `($_ $a $b) => `(bexp { $(getAexp a):imp_aexp ≠ $(getAexp b):imp_aexp })
| _ => throw ()
@[app_unexpander Bexp.le]
private def Bexp.unexpandLe : Unexpander
| `($_ $a $b) => `(bexp { $(getAexp a):imp_aexp ≤ $(getAexp b):imp_aexp })
| _ => throw ()
@[app_unexpander Bexp.gt]
private def Bexp.unexpandGt : Unexpander
| `($_ $a $b) => `(bexp { $(getAexp a):imp_aexp > $(getAexp b):imp_aexp })
| _ => throw ()
@[app_unexpander Bexp.not]
private def Bexp.unexpandNot : Unexpander
| `($_ $a) => `(bexp { ¬ $(getBexp a):imp_bexp })
| _ => throw ()
@[app_unexpander Bexp.and]
private def Bexp.unexpandAnd : Unexpander
| `($_ $a $b) => `(bexp { $(getBexp a):imp_bexp ∧ $(getBexp b):imp_bexp })
| _ => throw ()
end Imp.Delab
With these delaborators in place, Lean pretty-prints Imp expressions with the higher-level notations rather than their raw constructors.
The pretty-printed version of an expression might not exactly
match its original form.
For example, the parentheses around X * 2 in aexp { 3 + (X * 2) } are not printed because
they are redundant, which the parenthesizer knows.
/-- info: aexp {3 + X * 2} : Aexp -/
#guard_msgs in
#check aexp { 3 + (X * 2) }
/-- info: bexp {true ∧ ¬ (X ≤ 4)} : Bexp -/
#guard_msgs in
#check bexp { true ∧ ¬(X ≤ 4) }
3.1.5. Evaluation
The arithmetic and boolean evaluators must now be extended to handle
variables, taking a state st as an extra argument. A variable is
looked up in the state with the map-indexing notation st[x] from the
Typeclasses chapter in the Logical Foundations book.
For the notation to work, we used open scoped MyGetElem earlier,
which opens only the scoped items like notation from the module.
def Aexp.eval (st : State) (a : Aexp) : Nat :=
match a with
| num n => n
| id x => st[x] -- NEW
| plus a₁ a₂ => a₁.eval st + a₂.eval st
| minus a₁ a₂ => a₁.eval st - a₂.eval st
| mult a₁ a₂ => a₁.eval st * a₂.eval st
def Bexp.eval (st : State) (b : Bexp) : Bool :=
match b with
| bool b => b
| eq a₁ a₂ => a₁.eval st == a₂.eval st
| neq a₁ a₂ => a₁.eval st != a₂.eval st
| le a₁ a₂ => a₁.eval st ≤ a₂.eval st
| gt a₁ a₂ => a₁.eval st > a₂.eval st
| not b₁ => !b₁.eval st
| and b₁ b₂ => b₁.eval st && b₂.eval st
@[simp] theorem Aexp.eval_num (st : State) (n : Nat) : (num n).eval st = n := rfl
@[simp] theorem Aexp.eval_id (st : State) (x : Ident) : (Aexp.id x).eval st = st[x] := rfl
@[simp] theorem Aexp.eval_plus (st : State) (a₁ a₂ : Aexp) :
(plus a₁ a₂).eval st = a₁.eval st + a₂.eval st := rfl
@[simp] theorem Aexp.eval_minus (st : State) (a₁ a₂ : Aexp) :
(minus a₁ a₂).eval st = a₁.eval st - a₂.eval st := rfl
@[simp] theorem Aexp.eval_mult (st : State) (a₁ a₂ : Aexp) :
(mult a₁ a₂).eval st = a₁.eval st * a₂.eval st := rfl
@[simp] theorem Bexp.eval_bool (st : State) (b : Bool) : (bool b).eval st = b := rfl
@[simp] theorem Bexp.eval_eq (st : State) (a₁ a₂ : Aexp) :
(eq a₁ a₂).eval st = (a₁.eval st == a₂.eval st) := rfl
@[simp] theorem Bexp.eval_neq (st : State) (a₁ a₂ : Aexp) :
(neq a₁ a₂).eval st = (a₁.eval st != a₂.eval st) := rfl
@[simp] theorem Bexp.eval_le (st : State) (a₁ a₂ : Aexp) :
(le a₁ a₂).eval st = (a₁.eval st ≤ a₂.eval st : Bool) := rfl
@[simp] theorem Bexp.eval_gt (st : State) (a₁ a₂ : Aexp) :
(gt a₁ a₂).eval st = (a₁.eval st > a₂.eval st : Bool) := rfl
@[simp] theorem Bexp.eval_not (st : State) (b : Bexp) : (not b).eval st = !b.eval st := rfl
@[simp] theorem Bexp.eval_and (st : State) (b₁ b₂ : Bexp) :
(and b₁ b₂).eval st = (b₁.eval st && b₂.eval st) := rfl
We reuse the total-map notation (x →ₜ v etc.) for states.
example : aexp { 3 + (X * 2) }.eval (X →ₜ 5) = 13 := ⊢ Aexp.eval (X →ₜ 5) (aexp {3 + X * 2}) = 13 All goals completed! 🐙
example : aexp { Z + (X * Y) }.eval (X →ₜ 5 ; Y →ₜ 4) = 20 := ⊢ Aexp.eval (X →ₜ 5 ; Y →ₜ 4) (aexp {Z + X * Y}) = 20 All goals completed! 🐙
example : bexp { true ∧ ¬(X ≤ 4) }.eval (X →ₜ 5) = true := ⊢ Bexp.eval (X →ₜ 5) (bexp {true ∧ ¬ (X ≤ 4)}) = true All goals completed! 🐙
3.2. Commands
Now we are ready to define the syntax and behavior of Imp commands
(or statements). Informally, commands c are described by the
following BNF grammar:
| c | ::= | skip | |
| | | x := a | ||
| | | c ; c | ||
| | | if ( b ) { c } else { c } | ||
| | | while ( b ) { c } |
Here is the formal definition of the abstract syntax of commands.
inductive Com where
| skip
| asgn (x : Ident) (a : Aexp)
| seq (c₁ c₂ : Com)
| cond (b : Bexp) (c₁ c₂ : Com)
| whileDo (b : Bexp) (c : Com)
Notation encoding: commands, macro rules
/-- Imp commands -/
declare_syntax_cat imp_com
/-- The command that does nothing (`skip`) -/
syntax:max ident : imp_com
/-- Sequencing: one command after another (right associative. min + 1 = 11) -/
syntax:80 imp_com:11 Lean.Parser.semicolonOrLinebreak ppHardSpace imp_com:min : imp_com
/-- Assignment -/
syntax:max ident ppHardSpace ":=" ppHardSpace imp_aexp : imp_com
/-- Conditional -/
syntax:max "if " "(" imp_bexp ")" ppHardSpace "{" imp_com "}" ppHardSpace "else" ppHardSpace "{" imp_com "}" : imp_com
/-- Loop -/
syntax:max "while " "(" imp_bexp ")" ppHardSpace "{" imp_com "}" : imp_com
/-- Escape to Lean -/
syntax:max "~" term:max : imp_com
/-- Include an Imp command in Lean code -/
syntax:80 "imp" ppHardSpace "{" imp_com "}" : term
namespace Com
open Lean Imp.Elab
scoped macro_rules
| `(imp { $s }) => do
let stx ← match s with
| `(imp_com| skip) => ``(Com.skip)
| `(imp_com| $x:ident) => ``(($x : Com))
| `(imp_com| $c₁ ; $c₂) =>
``(Com.seq (imp {$c₁}) (imp {$c₂}))
| `(imp_com| $x:ident := $a) =>
``(Com.asgn $x (aexp {$a}))
| `(imp_com| if ($b) {$c₁} else {$c₂}) =>
``(Com.cond (bexp {$b}) (imp {$c₁}) (imp {$c₂}))
| `(imp_com| while ($b) {$c}) =>
``(Com.whileDo (bexp {$b}) (imp {$c}))
| `(imp_com| ~$c) => `(($c : Com))
| _ => Macro.throwUnsupported
return withSourceInfoOf s stx
end Com
open scoped Com
Notation encoding: printing commands back
namespace Imp.Delab
open Lean PrettyPrinter Delaborator SubExpr Imp.Elab
/--
Recognizes a term as being an `imp { ... }` expression.
-/
def getImp (stx : Term) : TSyntax `imp_com :=
withSourceInfoOf (canonical := false) stx <| Unhygienic.run do
match stx with
| `(imp { $e:imp_com }) => return e
| _ => `(imp_com| ~$stx)
@[app_unexpander Com.skip]
def unexpandComSkip : Unexpander
| _ => `(imp { $(mkIdent `skip):ident })
@[app_unexpander Com.asgn]
def unexpandComAsgn : Unexpander
| `($_ $x:ident $a) => `(imp { $x:ident := $(getAexp a) })
| _ => throw ()
@[app_unexpander Com.seq]
def unexpandComSeq : Unexpander
| `($_ $a $b) =>
match a with
| `(imp { $_ ; $_ }) =>
-- seq syntax is right associative, so need to quote `a`
`(imp { ~$a ; $(getImp b):imp_com })
| _ =>
`(imp { $(getImp a):imp_com ; $(getImp b):imp_com })
| _ => throw ()
@[app_unexpander Com.cond]
def unexpandComCond : Unexpander
| `($_ $b $c₁ $c₂) => `(imp { if ($(getBexp b)) { $(getImp c₁) } else { $(getImp c₂) } })
| _ => throw ()
@[app_unexpander Com.whileDo]
def unexpandComWhileDo : Unexpander
| `($_ $b $c) => `(imp { while ($(getBexp b)) { $(getImp c) } })
| _ => throw ()
end Imp.Delab
As an example, here is the factorial function again, written as a formal
definition. When this command terminates, the variable Y will
contain the factorial of the initial value of X. (Compare this to
the concrete Imp program at the very start of the chapter.)
def fact_in_lean : Com := imp {
Z := X
Y := 1
while (Z ≠ 0) {
Y := Y * Z
Z := Z - 1
}
}
Because we registered a delaborator, we can inspect a defined program with
#print, which pretty-prints (i.e., delaborates) the stored definition using the same syntax:
#print fact_in_lean
3.2.1. Desugaring Notations
Even though the notations are useful for getting the high-level picture,
it's sometimes helpful to turn off the notation to see the parsed structure as a plain term.
This can be done with set_option pp.notation false
(which we briefly mentioned in the Typeclasses chapter) as follows:
#check imp { X := X + 1 }
set_option pp.notation false in
#check imp { X := X + 1 }
3.2.2. More Examples
A few more examples.
Assignment:
def plus2 : Com := imp { X := X + 2 }
def XtimesYinZ : Com := imp { Z := X * Y }
Loops:
def subtract_slowly_body : Com := imp {
Z := Z - 1;
X := X - 1
}
def subtract_slowly : Com := imp {
while (X ≠ 0) {
~subtract_slowly_body
}
}
def subtract_3_from_5_slowly : Com := imp {
X := 3;
Z := 5;
~subtract_slowly
}
An infinite loop:
def loop : Com := imp { while (true) { skip } }
3.3. Evaluating Commands
Next we need to define what it means to evaluate an Imp command. The
fact that while loops don't necessarily terminate makes defining an
evaluation function tricky.
3.3.1. Evaluation as a Function (Failed Attempt)
In a more conventional functional language like OCaml or Haskell, we could define the evaluation function as follows:
def Com.eval (st : State) (c : Com) : State :=
match c with
| imp {skip} => st
| imp {x := ~a} => (x →ₜ a.eval st ; st)
| imp {c₁; c₂} =>
let st' := eval st c₁
eval st' c₂
| imp {if (b) {c₁} else {c₂}} =>
if b.eval st then eval st c₁
else eval st c₂
| imp {while (b) {c}} =>
if b.eval st then eval st (imp { c; while (b) {c}})
-- ^-- recursive call without a decreasing argument
else st
Lean doesn't accept such a definition
because the function we want to define is not guaranteed to terminate.
Indeed, it doesn't always terminate: the full Com.eval applied to
the loop program above would run forever. Since Lean aims to be not
just a programming language but also a consistent logic, any
potentially non-terminating function must be rejected.
Here is what would go wrong if Lean allowed non-terminating recursive functions:
theorem loop_false (n : Nat) : False := loop_false n
That is, propositions like False would become provable (loop_false 0
would be a proof of False), a disaster for logical consistency.
Thus, because it doesn't terminate on all inputs, the full Com.eval
cannot be written in Lean -- at least not without additional tricks and
workarounds.
Perhaps that discussion should be moved to -- or previewed in -- Logic.v? MRC'20: It's already in ProofObjects (which not everyone sees).
3.3.2. Evaluation as a Relation
Here's a better way: define Com.eval as a relation rather than a
function -- i.e., make its result a Prop rather than a State,
similar to what we did for Aexp.EvalR in the Slang chapter.
This is an important change. Besides freeing us from awkward workarounds,
it gives us more flexibility in the definition. For example, if we
add nondeterministic features like any to the language, we want the
definition of evaluation to be nondeterministic -- i.e., not only will it
not be total, it will not even be a function!
I kind of hate this notation. Is there something more standard in Lean? CSLib precedent maybe?
3.3.3. Operational Semantics
We'll use the notation st =[ c ]=> st' for the Com.EvalR relation:
st =[ c ]=> st' means that executing program c in a starting state
st results in an ending state st'. This can be pronounced "c takes
state st to st'".
Here is an informal definition of evaluation, presented as inference rules for readability:
----------------- (skip)
st =[ skip ]=> st
a.eval st = n
-------------------------------- (asgn)
st =[ x := a ]=> (x →ₜ n ; st)
st =[ c₁ ]=> st'
st' =[ c₂ ]=> st''
--------------------- (seq)
st =[ c₁;c₂ ]=> st''
b.eval st = true
st =[ c₁ ]=> st'
--------------------------------------- (ifTrue)
st =[ if (b) { c₁ } else { c₂ } ]=> st'
b.eval st = false
st =[ c₂ ]=> st'
--------------------------------------- (ifFalse)
st =[ if (b) { c₁ } else { c₂ } ]=> st'
b.eval st = false
---------------------------- (whileFalse)
st =[ while (b) { c } ]=> st
b.eval st = true
st =[ c ]=> st'
st' =[ while (b) { c } ]=> st''
------------------------------- (whileTrue)
st =[ while (b) { c } ]=> st''
Here is the formal definition. Make sure you understand how it corresponds to the inference rules.
inductive Com.EvalR : Com → State → State → Prop where
| skip {st : State} : EvalR (imp {skip}) st st
| asgn {st : State} {a : Aexp} {n : Nat} {x : Ident} (h : a.eval st = n) :
EvalR (imp {x := a}) st (x →ₜ n ; st)
| seq {c₁ c₂ : Com} {st st' st'' : State} (h₁ : EvalR c₁ st st') (h₂ : EvalR c₂ st' st'') :
EvalR (imp {c₁; c₂}) st st''
| ifTrue {st st' : State} {b : Bexp} {c₁ c₂ : Com} (hb : b.eval st = true)
(hc : EvalR c₁ st st') :
EvalR (imp {if (b) {c₁} else {c₂}}) st st'
| ifFalse {st st' : State} {b : Bexp} {c₁ c₂ : Com} (hb : b.eval st = false)
(hc : EvalR c₂ st st') :
EvalR (imp {if (b) {c₁} else {c₂}}) st st'
| whileFalse {b : Bexp} {st : State} {c : Com} (hb : b.eval st = false) :
EvalR (imp {while (b) {c}}) st st
| whileTrue {st st' st'' : State} {b : Bexp} {c : Com} (hb : b.eval st = true)
(hc : EvalR c st st') (hloop : Com.EvalR (imp {while (b) {c}}) st' st'') :
EvalR (imp {while (b) {c}}) st st''
Notation encoding: commands
class HasEval (Com : Type) (In : outParam <| Type) (Out : outParam <| Type) where
Eval : Com → In → Out → Prop
namespace HasEval
/-- Evaluation: `st =[ c ]=> st'` with `imp_com` command syntax -/
scoped syntax:lead term " =[ " imp_com:min " ]=> " term : term
scoped macro_rules
| `($st =[ $c:imp_com ]=> $st') => ``(HasEval.Eval (imp { $c }) $st $st')
namespace Delab
open Lean PrettyPrinter Delaborator SubExpr Imp.Delab
@[delab app.HasEval.Eval]
def delabTriple : Delab := whenPPOption getPPNotation do
guard <| (← getExpr).isAppOfArity ``HasEval.Eval 7
let c ← withNaryArg 4 delab
let st ← withNaryArg 5 delab
let st' ← withNaryArg 6 delab
match c with
| `(imp { $c:imp_com }) => ``($st =[ $c ]=> $st')
| c => ``($st =[ ~$c ]=> $st')
end Delab
end HasEval
open scoped HasEval
instance : HasEval Com State State where
Eval := Com.EvalR
@[simp]
theorem Com.evalR_eq {c : Com} {st st' : State} :
EvalR c st st' ↔ st =[ c ]=> st' := c:Comst:Statest':State⊢ c.EvalR st st' ↔ st =[ ~c ]=> st' All goals completed! 🐙
#check ∅ =[ skip ]=> ∅
The cost of defining evaluation as a relation instead of a function is that we now need to construct a proof that some program evaluates to some result state, rather than letting Lean's computation mechanism do it for us.
open scoped KVPair
open Com
example :
∅ =[
X := 2;
if (X ≤ 1) {
Y := 3
} else {
Z := 4
}
]=> {Z ↦ 4, X ↦ 2} := ⊢ ∅ =[ X := 2; if (X ≤ 1) {Y := 3} else {Z := 4} ]=> {Z ↦ 4, X ↦ 2}
-- To supply the intermediate state to the `seq` rule, which is sometimes necessary,
-- we can write `Com.EvalR.seq (st' := ...)`.
⊢ imp {X := 2}.EvalR ∅ {X ↦ 2}⊢ imp {if (X ≤ 1) {Y := 3} else {Z := 4}}.EvalR {X ↦ 2} {Z ↦ 4, X ↦ 2}
⊢ imp {X := 2}.EvalR ∅ {X ↦ 2} All goals completed! 🐙
⊢ imp {if (X ≤ 1) {Y := 3} else {Z := 4}}.EvalR {X ↦ 2} {Z ↦ 4, X ↦ 2} ⊢ Bexp.eval {X ↦ 2} (bexp {X ≤ 1}) = false⊢ imp {Z := 4}.EvalR {X ↦ 2} {Z ↦ 4, X ↦ 2}
⊢ Bexp.eval {X ↦ 2} (bexp {X ≤ 1}) = false All goals completed! 🐙
⊢ imp {Z := 4}.EvalR {X ↦ 2} {Z ↦ 4, X ↦ 2} All goals completed! 🐙
After apply EvalR.seq (st' := {X ↦ 2}), the infoview shows imp {X := 2}.EvalR ∅ {X ↦ 2} instead of ∅ =[ X := 2 ]=> {X ↦ 2}.
It would be silly to use apply EvalR.seq (st' := {X ↦ 2}) <;> try simp only [evalR_eq] at *.
Since the total-map update notation (→ₜ) is difficult to type, we prefer to use the {}-notation with KVPairs.
In the above proof, using EvalR.asgn rfl is convenient because it computes the value of the right-hand side and can use it to determine st'.
example {x : Nat} : ∅ =[ X := ~(.num x) ]=> {X ↦ x} := x:Nat⊢ ∅ =[ X := ~(Aexp.num x) ]=> {X ↦ x}
x:Nat⊢ Aexp.eval ∅ (Aexp.num x) = (X ↦ x).value
-- `⊢ Aexp.eval ∅ x = (X ↦ x).value`, which we can prove with `simp` or `rfl`
All goals completed! 🐙
example {x : Nat} : ∅ =[ X := ~(.num x) ]=> {X ↦ x} := x:Nat⊢ ∅ =[ X := ~(Aexp.num x) ]=> {X ↦ x}
All goals completed! 🐙
example : ∅ =[ X := 2; Y := 3 ]=> {Y ↦ 3, X ↦ 2} := ⊢ ∅ =[ X := 2; Y := 3 ]=> {Y ↦ 3, X ↦ 2}
⊢ imp {X := 2}.EvalR ∅ ?st'⊢ imp {Y := 3}.EvalR ?st' {Y ↦ 3, X ↦ 2}⊢ State
⊢ imp {X := 2}.EvalR ∅ ?st' -- `⊢ imp {X := 2}.EvalR ∅ ?st'`
All goals completed! 🐙 -- assigns the metavariable `?st'` to `{X ↦ 2}` (or equivalent)
⊢ imp {Y := 3}.EvalR (X →ₜ Aexp.eval ∅ (aexp {2})) {Y ↦ 3, X ↦ 2} ⊢ (X →ₜ 2) =[ Y := 3 ]=> {Y ↦ 3, X ↦ 2}
All goals completed! 🐙
This is a case where rfl is more powerful than simp, because it can assign the ?st' metavariable.
To demonstrate, here's a version with simp:
example : ∅ =[ X := 2; Y := 3 ]=> {Y ↦ 3, X ↦ 2} := ⊢ ∅ =[ X := 2; Y := 3 ]=> {Y ↦ 3, X ↦ 2}
⊢ imp {X := 2}.EvalR ∅ ?st'⊢ imp {Y := 3}.EvalR ?st' {Y ↦ 3, X ↦ 2}⊢ State
⊢ imp {X := 2}.EvalR ∅ ?st' ⊢ Aexp.eval ∅ (aexp {2}) = ?h₁.n⊢ Nat
⊢ 2 = ?h₁.n⊢ Nat -- doesn't work because `simp` doesn't assign the metavariable
⊢ imp {Y := 3}.EvalR (X →ₜ sorry) {Y ↦ 3, X ↦ 2} All goals completed! 🐙
However, it's possible to use simp as long as we have assigned st' ourselves:
example : ∅ =[ X := 2; Y := 3 ]=> {Y ↦ 3, X ↦ 2} := ⊢ ∅ =[ X := 2; Y := 3 ]=> {Y ↦ 3, X ↦ 2}
⊢ imp {X := 2}.EvalR ∅ {X ↦ 2}⊢ imp {Y := 3}.EvalR {X ↦ 2} {Y ↦ 3, X ↦ 2}
⊢ imp {X := 2}.EvalR ∅ {X ↦ 2} ⊢ Aexp.eval ∅ (aexp {2}) = (X ↦ 2).value
All goals completed! 🐙
⊢ imp {Y := 3}.EvalR {X ↦ 2} {Y ↦ 3, X ↦ 2} ⊢ Aexp.eval {X ↦ 2} (aexp {3}) = (Y ↦ 3).value
All goals completed! 🐙
theorem ceval_example₂ :
∅ =[
X := 0;
Y := 1;
Z := 2
]=> {Z ↦ 2, Y ↦ 1, X ↦ 0} := ⊢ ∅ =[ X := 0; Y := 1; Z := 2 ]=> {Z ↦ 2, Y ↦ 1, X ↦ 0}
solution!
⊢ imp {X := 0}.EvalR ∅ {X ↦ 0}⊢ imp {Y := 1; Z := 2}.EvalR {X ↦ 0} {Z ↦ 2, Y ↦ 1, X ↦ 0} -- Note: specifying the intermediate state is not necessary
⊢ imp {X := 0}.EvalR ∅ {X ↦ 0} All goals completed! 🐙
⊢ imp {Y := 1; Z := 2}.EvalR {X ↦ 0} {Z ↦ 2, Y ↦ 1, X ↦ 0} ⊢ imp {Y := 1}.EvalR {X ↦ 0} {Y ↦ 1, X ↦ 0}⊢ imp {Z := 2}.EvalR {Y ↦ 1, X ↦ 0} {Z ↦ 2, Y ↦ 1, X ↦ 0} -- Note: st' is not necessary
⊢ imp {Y := 1}.EvalR {X ↦ 0} {Y ↦ 1, X ↦ 0} All goals completed! 🐙
⊢ imp {Z := 2}.EvalR {Y ↦ 1, X ↦ 0} {Z ↦ 2, Y ↦ 1, X ↦ 0} All goals completed! 🐙
PR: I phrased these quizzes with the following alternatives: (A) Not true (B) True and easily provable (C) True and takes more work to prove (D) True and cannot be proved without additional axioms
Is the following proposition provable?
∀ (c : Com) (st st' : State),
st =[ skip; c ]=> st' →
st =[ c ]=> st'
(A) Yes (B) No (C) Not sure
Is the following proposition provable?
∀ (c₁ c₂ : Com) (st st' : State),
st =[ c₁; c₂ ]=> st' →
st =[ c₁ ]=> st →
st =[ c₂ ]=> st'
(A) Yes (B) No (C) Not sure
Is the following proposition provable?
∀ (b : Bexp) (c : Com) (st st' : State),
st =[ if (b) { c } else { c } ]=> st' →
st =[ c ]=> st'
(A) Yes (B) No (C) Not sure
Show solution
theorem quiz3_answer (b : Bexp) (c : Com) (st st' : State)
(h : st =[ if (b) { c } else { c } ]=> st') : st =[ c ]=> st' := b:Bexpc:Comst:Statest':Stateh:st =[ if (~b) {~c} else {~c} ]=> st'⊢ st =[ ~c ]=> st'
inversion h with
| ifTrue hb hc => All goals completed! 🐙
| ifFalse hb hc => All goals completed! 🐙
Is the following proposition provable?
∀ (b : Bexp),
(∀ st, b.eval st = true) →
∀ (c : Com) (st : State),
¬ ∃ st', st =[ while (b) { c } ]=> st'
(A) Yes (B) No (C) Not sure
Show solution
-- This one is tricky!
theorem quiz4_answer (b : Bexp) (hbtrue : ∀ st, b.eval st = true)
(c : Com) (st : State) : ¬ ∃ st', st =[ while (b) { c } ]=> st' := b:Bexphbtrue:∀ (st : State), Bexp.eval st b = truec:Comst:State⊢ ¬∃ st', st =[ while (~b) {~c} ]=> st'
b:Bexphbtrue:∀ (st : State), Bexp.eval st b = truec:Comst:Statest':Statehev:st =[ while (~b) {~c} ]=> st'⊢ False
b:Bexphbtrue:∀ (st : State), Bexp.eval st b = truec:Comst:Statest':Statehev:st =[ while (~b) {~c} ]=> st'key:∀ (cmd : Com) (s s' : State), (s =[ ~cmd ]=> s') → cmd = imp {while (~b) {~c}} → False⊢ False
exact key _ st st' hev rfl All goals completed! 🐙
Is the following proposition provable?
∀ (b : Bexp) (c : Com) (st : State),
(¬ ∃ st', st =[ while (b) { c } ]=> st') →
∀ st'', b.eval st'' = true
(A) Yes (B) No (C) Not sure
Show solution
This claim is false, so it cannot be proved -- the proof gets stuck immediately:
theorem quiz5_answer (b : Bexp) (c : Com) (st : State)
(H : ¬ ∃ st', st =[ while (b) { c } ]=> st') :
∀ st'', b.eval st'' = true := by b:Bexpc:Comst:StateH:¬∃ st', st =[ while (~b) {~c} ]=> st'⊢ ∀ (st'' : State), Bexp.eval st'' b = true
intro st'' b:Bexpc:Comst:StateH:¬∃ st', st =[ while (~b) {~c} ]=> st'st'':State⊢ Bexp.eval st'' b = true
-- Can't make any progress -- the claim is false!
3.3.4. Determinism of Evaluation
Changing from a computational to a relational definition of evaluation
is a good move because it frees us from the artificial requirement that
evaluation be a total function. But it raises a question: is the
relational definition really a partial function? Could the same
command, from the same state, evaluate to two different final states?
In fact, this cannot happen: Com.EvalR is a partial function.
theorem ceval_deterministic {c : Com} {st st1 st2 : State}
(e₁ : st =[ c ]=> st1) (e₂ : st =[ c ]=> st2) : st1 = st2 := by c:Comst:Statest1:Statest2:Statee₁:st =[ ~c ]=> st1e₂:st =[ ~c ]=> st2⊢ st1 = st2
induction e₁ generalizing st2 with
| skip => skip c:Comst:Statest1:Statest✝:Statest2:Statee₂:st✝ =[ skip ]=> st2⊢ st✝ = st2
inversion e₂ skip c:Comst:Statest1:Statest✝:State⊢ st✝ = st✝
rfl All goals completed! 🐙
| asgn => asgn c:Comst:Statest1:Statest✝:Statea✝:Aexpn✝:Natx✝:Identh✝:Aexp.eval st✝ a✝ = n✝st2:Statee₂:st✝ =[ x✝ := ~a✝ ]=> st2⊢ x✝ →ₜ n✝ ; st✝ = st2
inversion e₂ with
| asgn h' => subst_vars asgn c:Comst:Statest1:Statest✝:Statea✝:Aexpx✝:Ident⊢ x✝ →ₜ Aexp.eval st✝ a✝ ; st✝ = x✝ →ₜ Aexp.eval st✝ a✝ ; st✝; rfl All goals completed! 🐙
| seq h₁ h₂ ih₁ ih₂ => seq c:Comst:Statest1:Statec₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:Stateh₁:c₁✝.EvalR st✝ st'✝h₂:c₂✝.EvalR st'✝ st''✝ih₁:∀ {st2 : State}, (st✝ =[ ~c₁✝ ]=> st2) → st'✝ = st2ih₂:∀ {st2 : State}, (st'✝ =[ ~c₂✝ ]=> st2) → st''✝ = st2st2:Statee₂:st✝ =[ ~c₁✝; ~c₂✝ ]=> st2⊢ st''✝ = st2
inversion e₂ with
| seq st2' h₁' h₂' =>
apply ih₁ at h₁' seq c:Comst:Statest1:Statec₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:Stateh₁:c₁✝.EvalR st✝ st'✝h₂:c₂✝.EvalR st'✝ st''✝ih₁:∀ {st2 : State}, (st✝ =[ ~c₁✝ ]=> st2) → st'✝ = st2ih₂:∀ {st2 : State}, (st'✝ =[ ~c₂✝ ]=> st2) → st''✝ = st2st2:Statest2':Stateh₂':c₂✝.EvalR st2' st2h₁':st'✝ = st2'⊢ st''✝ = st2; subst h₁' seq c:Comst:Statest1:Statec₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:Stateh₁:c₁✝.EvalR st✝ st'✝h₂:c₂✝.EvalR st'✝ st''✝ih₁:∀ {st2 : State}, (st✝ =[ ~c₁✝ ]=> st2) → st'✝ = st2ih₂:∀ {st2 : State}, (st'✝ =[ ~c₂✝ ]=> st2) → st''✝ = st2st2:Stateh₂':c₂✝.EvalR st'✝ st2⊢ st''✝ = st2
exact ih₂ h₂' All goals completed! 🐙
| ifTrue hb hc ih => ifTrue c:Comst:Statest1:Statest✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb:Bexp.eval st✝ b✝ = truehc:c₁✝.EvalR st✝ st'✝ih:∀ {st2 : State}, (st✝ =[ ~c₁✝ ]=> st2) → st'✝ = st2st2:Statee₂:st✝ =[ if (~b✝) {~c₁✝} else {~c₂✝} ]=> st2⊢ st'✝ = st2
inversion e₂ with
| ifTrue hb' hc' => exact ih hc' All goals completed! 🐙
| ifFalse hb' hc' => simp_all All goals completed! 🐙
| ifFalse hb hc ih => ifFalse c:Comst:Statest1:Statest✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb:Bexp.eval st✝ b✝ = falsehc:c₂✝.EvalR st✝ st'✝ih:∀ {st2 : State}, (st✝ =[ ~c₂✝ ]=> st2) → st'✝ = st2st2:Statee₂:st✝ =[ if (~b✝) {~c₁✝} else {~c₂✝} ]=> st2⊢ st'✝ = st2
inversion e₂ with
| ifTrue hb' hc' => simp_all All goals completed! 🐙
| ifFalse hb' hc' => exact ih hc' All goals completed! 🐙
| whileFalse hb => whileFalse c:Comst:Statest1:Stateb✝:Bexpst✝:Statec✝:Comhb:Bexp.eval st✝ b✝ = falsest2:Statee₂:st✝ =[ while (~b✝) {~c✝} ]=> st2⊢ st✝ = st2
inversion e₂ with
| whileFalse hb' => rfl All goals completed! 🐙
| whileTrue hb' hc' hl' => simp_all All goals completed! 🐙
| whileTrue hb hc hloop ih₁ ih₂ => whileTrue c:Comst:Statest1:Statest✝:Statest'✝:Statest''✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:c✝.EvalR st✝ st'✝hloop:imp {while (~b✝) {~c✝}}.EvalR st'✝ st''✝ih₁:∀ {st2 : State}, (st✝ =[ ~c✝ ]=> st2) → st'✝ = st2ih₂:∀ {st2 : State}, (st'✝ =[ while (~b✝) {~c✝} ]=> st2) → st''✝ = st2st2:Statee₂:st✝ =[ while (~b✝) {~c✝} ]=> st2⊢ st''✝ = st2
inversion e₂ with
| whileFalse hb' => simp_all All goals completed! 🐙
| whileTrue st2' _ hc' hl' =>
apply ih₁ at hc' whileTrue c:Comst:Statest1:Statest✝:Statest'✝:Statest''✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:c✝.EvalR st✝ st'✝hloop:imp {while (~b✝) {~c✝}}.EvalR st'✝ st''✝ih₁:∀ {st2 : State}, (st✝ =[ ~c✝ ]=> st2) → st'✝ = st2ih₂:∀ {st2 : State}, (st'✝ =[ while (~b✝) {~c✝} ]=> st2) → st''✝ = st2st2:Statest2':Statehb✝:Bexp.eval st✝ b✝ = truehl':imp {while (~b✝) {~c✝}}.EvalR st2' st2hc':st'✝ = st2'⊢ st''✝ = st2; subst hc' whileTrue c:Comst:Statest1:Statest✝:Statest'✝:Statest''✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:c✝.EvalR st✝ st'✝hloop:imp {while (~b✝) {~c✝}}.EvalR st'✝ st''✝ih₁:∀ {st2 : State}, (st✝ =[ ~c✝ ]=> st2) → st'✝ = st2ih₂:∀ {st2 : State}, (st'✝ =[ while (~b✝) {~c✝} ]=> st2) → st''✝ = st2st2:Statehb✝:Bexp.eval st✝ b✝ = truehl':imp {while (~b✝) {~c✝}}.EvalR st'✝ st2⊢ st''✝ = st2
exact ih₂ hl' All goals completed! 🐙
Write an Imp program that sums the numbers from 1 to X (inclusive)
in the variable Y. Your program should update the state as shown in
pup_to_2_ceval, which you can reverse-engineer to discover the program
you should write. The proof of that theorem will be somewhat lengthy.
def pupToN : Com := solution!(
imp {
Y := 0;
while (1 ≤ X) {
Y := Y + X;
X := X - 1
}
})
theorem pup_to_2_ceval :
{X ↦ 2} =[ pupToN ]=> {X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2} := by ⊢ {X ↦ 2} =[ ~pupToN ]=> {X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2}
solution!
rw [pupToN ⊢ {X ↦ 2} =[ Y := 0; while (1 ≤ X) {Y := Y + X; X := X - 1} ]=> {X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2}] ⊢ {X ↦ 2} =[ Y := 0; while (1 ≤ X) {Y := Y + X; X := X - 1} ]=> {X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2}
apply Com.EvalR.seq (st' := (Y →ₜ 0 ; X →ₜ 2 ; ∅)) h₁ ⊢ imp {Y := 0}.EvalR {X ↦ 2} (Y →ₜ 0 ; X →ₜ 2)h₂ ⊢ imp {while (1 ≤ X) {Y := Y + X; X := X - 1}}.EvalR (Y →ₜ 0 ; X →ₜ 2) {X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2}
· h₁ ⊢ imp {Y := 0}.EvalR {X ↦ 2} (Y →ₜ 0 ; X →ₜ 2) apply Com.EvalR.asgn h₁ ⊢ Aexp.eval {X ↦ 2} (aexp {0}) = 0; rfl All goals completed! 🐙
· h₂ ⊢ imp {while (1 ≤ X) {Y := Y + X; X := X - 1}}.EvalR (Y →ₜ 0 ; X →ₜ 2) {X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2} apply Com.EvalR.whileTrue (st' := (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2 ; ∅)) h₂.hb ⊢ Bexp.eval (Y →ₜ 0 ; X →ₜ 2) (bexp {1 ≤ X}) = trueh₂.hc ⊢ imp {Y := Y + X; X := X - 1}.EvalR (Y →ₜ 0 ; X →ₜ 2) (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)h₂.hloop ⊢ imp {while (1 ≤ X) {Y := Y + X; X := X - 1}}.EvalR (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
{X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2}
· h₂.hb ⊢ Bexp.eval (Y →ₜ 0 ; X →ₜ 2) (bexp {1 ≤ X}) = true rfl All goals completed! 🐙
· h₂.hc ⊢ imp {Y := Y + X; X := X - 1}.EvalR (Y →ₜ 0 ; X →ₜ 2) (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) apply Com.EvalR.seq (st' := (Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2 ; ∅)) h₂.hc.h₁ ⊢ imp {Y := Y + X}.EvalR (Y →ₜ 0 ; X →ₜ 2) (Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)h₂.hc.h₂ ⊢ imp {X := X - 1}.EvalR (Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) <;> h₂.hc.h₁ ⊢ imp {Y := Y + X}.EvalR (Y →ₜ 0 ; X →ₜ 2) (Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)h₂.hc.h₂ ⊢ imp {X := X - 1}.EvalR (Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
(apply Com.EvalR.asgn h₂.hc.h₂ ⊢ Aexp.eval (Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) (aexp {X - 1}) = 1; rfl All goals completed! 🐙)
· h₂.hloop ⊢ imp {while (1 ≤ X) {Y := Y + X; X := X - 1}}.EvalR (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
{X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2} apply Com.EvalR.whileTrue
(st' := (X →ₜ 0 ; Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2 ; ∅)) h₂.hloop.hb ⊢ Bexp.eval (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) (bexp {1 ≤ X}) = trueh₂.hloop.hc ⊢ imp {Y := Y + X; X := X - 1}.EvalR (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
(X →ₜ 0 ; Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)h₂.hloop.hloop ⊢ imp {while (1 ≤ X) {Y := Y + X; X := X - 1}}.EvalR (X →ₜ 0 ; Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
{X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2}
· h₂.hloop.hb ⊢ Bexp.eval (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) (bexp {1 ≤ X}) = true rfl All goals completed! 🐙
· h₂.hloop.hc ⊢ imp {Y := Y + X; X := X - 1}.EvalR (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
(X →ₜ 0 ; Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) apply Com.EvalR.seq (st' := (Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2 ; ∅)) h₂.hloop.hc.h₁ ⊢ imp {Y := Y + X}.EvalR (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) (Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)h₂.hloop.hc.h₂ ⊢ imp {X := X - 1}.EvalR (Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
(X →ₜ 0 ; Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) <;> h₂.hloop.hc.h₁ ⊢ imp {Y := Y + X}.EvalR (X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) (Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)h₂.hloop.hc.h₂ ⊢ imp {X := X - 1}.EvalR (Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
(X →ₜ 0 ; Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
(apply Com.EvalR.asgn h₂.hloop.hc.h₂ ⊢ Aexp.eval (Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) (aexp {X - 1}) = 0; rfl All goals completed! 🐙)
· h₂.hloop.hloop ⊢ imp {while (1 ≤ X) {Y := Y + X; X := X - 1}}.EvalR (X →ₜ 0 ; Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2)
{X ↦ 0, Y ↦ 3, X ↦ 1, Y ↦ 2, Y ↦ 0, X ↦ 2} apply Com.EvalR.whileFalse h₂.hloop.hloop ⊢ Bexp.eval (X →ₜ 0 ; Y →ₜ 3 ; X →ₜ 1 ; Y →ₜ 2 ; Y →ₜ 0 ; X →ₜ 2) (bexp {1 ≤ X}) = false; rfl All goals completed! 🐙
3.4. Reasoning About Imp Programs
We'll get into more systematic and powerful techniques for reasoning about Imp programs in the next chapter, but we can already do a few things (albeit in a somewhat low-level way) just by working with the bare definitions. This section explores some examples.
theorem plus2_spec {st : State} {n : Nat} {st' : State}
(hx : st[X] = n) (heval : st =[ plus2 ]=> st') :
st'[X] = n + 2 := by st:Staten:Natst':Statehx:st[X] = nheval:st =[ ~plus2 ]=> st'⊢ st'[X] = n + 2
-- Inverting `heval` forces one step of the evaluation relation: since
-- `plus2` is an assignment, `st'` must be `st` extended at `X`.
rw [plus2 st:Staten:Natst':Statehx:st[X] = nheval:st =[ X := X + 2 ]=> st'⊢ st'[X] = n + 2] at heval st:Staten:Natst':Statehx:st[X] = nheval:st =[ X := X + 2 ]=> st'⊢ st'[X] = n + 2
inversion heval with
| asgn m h =>
simp [hx] at h ⊢ asgn st:Staten:Nathx:st[X] = nm:Nath:n + 2 = m⊢ m = n + 2
lia All goals completed! 🐙
State and prove a specification of XtimesYinZ.
/- Here is a specification in the style of `plus2_spec`: -/
theorem XtimesYinZ_spec₁ {st : State} {nx ny : Nat} {st' : State}
(hx : st[X] = nx) (hy : st[Y] = ny) (heval : st =[ XtimesYinZ ]=> st') :
st'[Z] = nx * ny := by st:Statenx:Natny:Natst':Statehx:st[X] = nxhy:st[Y] = nyheval:st =[ ~XtimesYinZ ]=> st'⊢ st'[Z] = nx * ny
rw [XtimesYinZ st:Statenx:Natny:Natst':Statehx:st[X] = nxhy:st[Y] = nyheval:st =[ Z := X * Y ]=> st'⊢ st'[Z] = nx * ny] at heval st:Statenx:Natny:Natst':Statehx:st[X] = nxhy:st[Y] = nyheval:st =[ Z := X * Y ]=> st'⊢ st'[Z] = nx * ny
inversion heval with
| asgn n h =>
simp_all All goals completed! 🐙
/- Though perhaps a cleaner specification would be: -/
theorem XtimesYinZ_spec {st : State} :
st =[ XtimesYinZ ]=> (Z →ₜ st[X] * st[Y] ; st) := by st:State⊢ st =[ ~XtimesYinZ ]=> Z →ₜ st[X] * st[Y] ; st
rw [XtimesYinZ st:State⊢ st =[ Z := X * Y ]=> Z →ₜ st[X] * st[Y] ; st] st:State⊢ st =[ Z := X * Y ]=> Z →ₜ st[X] * st[Y] ; st
apply EvalR.asgn st:State⊢ Aexp.eval st (aexp {X * Y}) = st[X] * st[Y]
rfl All goals completed! 🐙
/- A less informative specification would be ... -/
theorem XtimesYinZ_spec₂ {st : State} : ∃ st', st =[ XtimesYinZ ]=> st' := by st:State⊢ ∃ st', st =[ ~XtimesYinZ ]=> st'
exists (Z →ₜ st[X] * st[Y] ; st) st:State⊢ st =[ ~XtimesYinZ ]=> Z →ₜ st[X] * st[Y] ; st
exact XtimesYinZ_spec All goals completed! 🐙
We need to explain the generalize tactic.
I've changed some Hoare proofs from have key to generalize but the tactic hasn't been explained yet.
At least currently, it looks like generalize is introduced in Automation.lean.
Are we doing anything different here with generalize that is
unexplained there?
Hint: proceed by induction on the assumed derivation showing that loop
terminates. Most of the cases are immediately contradictory and so can be
solved in one step (by simp/contradiction on the impossible command
equation).
theorem loop_never_stops (st st' : State) : ¬ (st =[ loop ]=> st') := by st:Statest':State⊢ ¬st =[ ~loop ]=> st'
solution!
intro contra st:Statest':Statecontra:st =[ ~loop ]=> st'⊢ False
-- Generalize over the command so the induction remembers what `loop` is.
have key : ∀ (c : Com) (s s' : State), (s =[ c ]=> s') → c = loop → False := by st:Statest':State⊢ ¬st =[ ~loop ]=> st'
intro c s s' hce st:Statest':Statecontra:st =[ ~loop ]=> st'c:Coms:States':Statehce:s =[ ~c ]=> s'⊢ c = loop → False; simp only [loop] at * st:Statest':Statecontra:st =[ while (true) {skip} ]=> st'c:Coms:States':Statehce:s =[ ~c ]=> s'⊢ c = imp {while (true) {skip}} → False
induction hce with (intro heq whileTrue st:Statest':Statecontra:st =[ while (true) {skip} ]=> st'c:Coms:States':Statest✝:Statest'✝:Statest''✝:Stateb✝:Bexpc✝:Comhb✝:Bexp.eval st✝ b✝ = truehc✝:c✝.EvalR st✝ st'✝hloop✝:imp {while (~b✝) {~c✝}}.EvalR st'✝ st''✝hc_ih✝:c✝ = imp {while (true) {skip}} → Falsehloop_ih✝:imp {while (~b✝) {~c✝}} = imp {while (true) {skip}} → Falseheq:imp {while (~b✝) {~c✝}} = imp {while (true) {skip}}⊢ False; try contradiction All goals completed! 🐙)
| whileFalse hb => whileFalse st:Statest':Statecontra:st =[ while (true) {skip} ]=> st'c:Coms:States':Stateb✝:Bexpst✝:Statec✝:Comhb:Bexp.eval st✝ b✝ = falseheq:imp {while (~b✝) {~c✝}} = imp {while (true) {skip}}⊢ False
injection heq with e₁ _ whileFalse st:Statest':Statecontra:st =[ while (true) {skip} ]=> st'c:Coms:States':Stateb✝:Bexpst✝:Statec✝:Comhb:Bexp.eval st✝ b✝ = falsee₁:b✝ = bexp {true}c_eq✝:c✝ = imp {skip}⊢ False
subst e₁ whileFalse st:Statest':Statecontra:st =[ while (true) {skip} ]=> st'c:Coms:States':Statest✝:Statec✝:Comc_eq✝:c✝ = imp {skip}hb:Bexp.eval st✝ (bexp {true}) = false⊢ False; simp at hb st:Statest':Statecontra:st =[ ~loop ]=> st'key:∀ (c : Com) (s s' : State), (s =[ ~c ]=> s') → c = loop → False⊢ False
exact key loop st st' contra rfl All goals completed! 🐙
The following function yields true just on programs with no while
loops. Using inductive, write a property Com.NoWhilesR that holds
exactly when c is while-free, then prove it equivalent to Com.no_whiles.
def Com.no_whiles (c : Com) : Bool :=
match c with
| imp {skip} => true
| imp {x := ~a} => true
| imp {c₁; c₂} => no_whiles c₁ && no_whiles c₂
| imp {if (b) {ct} else {cf}} => no_whiles ct && no_whiles cf
| imp {while (b) {c}} => false
inductive Com.NoWhilesR : Com → Prop where
| skip : Com.NoWhilesR (imp { skip })
| asgn {x : Ident} {a : Aexp} : Com.NoWhilesR (imp { x := ~a })
| seq {c₁ c₂ : Com} (h₁ : Com.NoWhilesR c₁) (h₂ : Com.NoWhilesR c₂) :
Com.NoWhilesR (imp { c₁; c₂ })
| cond {b : Bexp} {c₁ c₂ : Com} (h₁ : Com.NoWhilesR c₁) (h₂ : Com.NoWhilesR c₂) :
Com.NoWhilesR (imp { if (b) { c₁ } else { c₂ } })
theorem no_whiles_eqv (c : Com) : c.no_whiles = true ↔ Com.NoWhilesR c := by c:Com⊢ c.no_whiles = true ↔ c.NoWhilesR
solution!
constructor mp c:Com⊢ c.no_whiles = true → c.NoWhilesRmpr c:Com⊢ c.NoWhilesR → c.no_whiles = true
· mp c:Com⊢ c.no_whiles = true → c.NoWhilesR induction c with (intro h mp.cond b✝:Bexpc₁✝:Comc₂✝:Comc₁_ih✝:c₁✝.no_whiles = true → c₁✝.NoWhilesRc₂_ih✝:c₂✝.no_whiles = true → c₂✝.NoWhilesRh:imp {if (~b✝) {~c₁✝} else {~c₂✝}}.no_whiles = true⊢ imp {if (~b✝) {~c₁✝} else {~c₂✝}}.NoWhilesR <;> mp.cond b✝:Bexpc₁✝:Comc₂✝:Comc₁_ih✝:c₁✝.no_whiles = true → c₁✝.NoWhilesRc₂_ih✝:c₂✝.no_whiles = true → c₂✝.NoWhilesRh:imp {if (~b✝) {~c₁✝} else {~c₂✝}}.no_whiles = true⊢ imp {if (~b✝) {~c₁✝} else {~c₂✝}}.NoWhilesR try constructor mp.cond.h₁ b✝:Bexpc₁✝:Comc₂✝:Comc₁_ih✝:c₁✝.no_whiles = true → c₁✝.NoWhilesRc₂_ih✝:c₂✝.no_whiles = true → c₂✝.NoWhilesRh:imp {if (~b✝) {~c₁✝} else {~c₂✝}}.no_whiles = true⊢ c₁✝.NoWhilesRmp.cond.h₂ b✝:Bexpc₁✝:Comc₂✝:Comc₁_ih✝:c₁✝.no_whiles = true → c₁✝.NoWhilesRc₂_ih✝:c₂✝.no_whiles = true → c₂✝.NoWhilesRh:imp {if (~b✝) {~c₁✝} else {~c₂✝}}.no_whiles = true⊢ c₂✝.NoWhilesR <;> mp.cond.h₁ b✝:Bexpc₁✝:Comc₂✝:Comc₁_ih✝:c₁✝.no_whiles = true → c₁✝.NoWhilesRc₂_ih✝:c₂✝.no_whiles = true → c₂✝.NoWhilesRh:imp {if (~b✝) {~c₁✝} else {~c₂✝}}.no_whiles = true⊢ c₁✝.NoWhilesRmp.cond.h₂ b✝:Bexpc₁✝:Comc₂✝:Comc₁_ih✝:c₁✝.no_whiles = true → c₁✝.NoWhilesRc₂_ih✝:c₂✝.no_whiles = true → c₂✝.NoWhilesRh:imp {if (~b✝) {~c₁✝} else {~c₂✝}}.no_whiles = true⊢ c₂✝.NoWhilesR simp_all [Com.no_whiles, Bool.and_eq_true] All goals completed! 🐙)
| whileDo b c ih => mp.whileDo b:Bexpc:Comih:c.no_whiles = true → c.NoWhilesRh:imp {while (~b) {~c}}.no_whiles = true⊢ imp {while (~b) {~c}}.NoWhilesR simp [Com.no_whiles] at h All goals completed! 🐙
· mpr c:Com⊢ c.NoWhilesR → c.no_whiles = true intro h mpr c:Comh:c.NoWhilesR⊢ c.no_whiles = true
induction h with simp_all [Com.no_whiles] All goals completed! 🐙
Imp programs that don't involve while loops always terminate. State and
prove a theorem no_whiles_terminating that says this. Use either
Com.no_whiles or Com.NoWhilesR, as you prefer.
theorem no_whiles_terminating {c : Com} (st : State) (h : Com.NoWhilesR c) :
∃ st', st =[ ~c ]=> st' := by c:Comst:Stateh:c.NoWhilesR⊢ ∃ st', st =[ ~c ]=> st'
solution!
induction h generalizing st with
| skip => skip c:Comst:State⊢ ∃ st', st =[ skip ]=> st' exists st skip c:Comst:State⊢ st =[ skip ]=> st; constructor All goals completed! 🐙
| @asgn x a => asgn c:Comx:Identa:Aexpst:State⊢ ∃ st', st =[ x := ~a ]=> st' exists (x →ₜ a.eval st ; st) asgn c:Comx:Identa:Aexpst:State⊢ st =[ x := ~a ]=> x →ₜ Aexp.eval st a ; st; constructor asgn c:Comx:Identa:Aexpst:State⊢ Aexp.eval st a = Aexp.eval st a; rfl All goals completed! 🐙
| seq h₁ h₂ ih₁ ih₂ => seq c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:State⊢ ∃ st', st =[ ~c₁✝; ~c₂✝ ]=> st'
obtain ⟨st', hc₁⟩ := ih₁ st seq c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:Statest':Statehc₁:st =[ ~c₁✝ ]=> st'⊢ ∃ st', st =[ ~c₁✝; ~c₂✝ ]=> st'
obtain ⟨st'', hc₂⟩ := ih₂ st' seq c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:Statest':Statehc₁:st =[ ~c₁✝ ]=> st'st'':Statehc₂:st' =[ ~c₂✝ ]=> st''⊢ ∃ st', st =[ ~c₁✝; ~c₂✝ ]=> st'
exists st'' seq c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:Statest':Statehc₁:st =[ ~c₁✝ ]=> st'st'':Statehc₂:st' =[ ~c₂✝ ]=> st''⊢ st =[ ~c₁✝; ~c₂✝ ]=> st''; constructor seq.h₁ c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:Statest':Statehc₁:st =[ ~c₁✝ ]=> st'st'':Statehc₂:st' =[ ~c₂✝ ]=> st''⊢ c₁✝.EvalR st ?seq.st'seq.h₂ c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:Statest':Statehc₁:st =[ ~c₁✝ ]=> st'st'':Statehc₂:st' =[ ~c₂✝ ]=> st''⊢ c₂✝.EvalR ?seq.st' st''seq.st' c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:Statest':Statehc₁:st =[ ~c₁✝ ]=> st'st'':Statehc₂:st' =[ ~c₂✝ ]=> st''⊢ State <;> seq.h₁ c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:Statest':Statehc₁:st =[ ~c₁✝ ]=> st'st'':Statehc₂:st' =[ ~c₂✝ ]=> st''⊢ c₁✝.EvalR st ?seq.st'seq.h₂ c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:Statest':Statehc₁:st =[ ~c₁✝ ]=> st'st'':Statehc₂:st' =[ ~c₂✝ ]=> st''⊢ c₂✝.EvalR ?seq.st' st''seq.st' c:Comc₁✝:Comc₂✝:Comh₁:c₁✝.NoWhilesRh₂:c₂✝.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁✝ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂✝ ]=> st'st:Statest':Statehc₁:st =[ ~c₁✝ ]=> st'st'':Statehc₂:st' =[ ~c₂✝ ]=> st''⊢ State assumption All goals completed! 🐙
| @cond b c₁ c₂ h₁ h₂ ih₁ ih₂ => cond c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:State⊢ ∃ st', st =[ if (~b) {~c₁} else {~c₂} ]=> st'
cases hb : b.eval st with
| true => cond.true c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = true⊢ ∃ st', st =[ if (~b) {~c₁} else {~c₂} ]=> st'
obtain ⟨st', hc₁⟩ := ih₁ st cond.true c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = truest':Statehc₁:st =[ ~c₁ ]=> st'⊢ ∃ st', st =[ if (~b) {~c₁} else {~c₂} ]=> st'
exists st' cond.true c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = truest':Statehc₁:st =[ ~c₁ ]=> st'⊢ st =[ if (~b) {~c₁} else {~c₂} ]=> st'; constructor cond.true.hb c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = truest':Statehc₁:st =[ ~c₁ ]=> st'⊢ Bexp.eval st b = truecond.true.hc c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = truest':Statehc₁:st =[ ~c₁ ]=> st'⊢ c₁.EvalR st st' <;> cond.true.hb c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = truest':Statehc₁:st =[ ~c₁ ]=> st'⊢ Bexp.eval st b = truecond.true.hc c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = truest':Statehc₁:st =[ ~c₁ ]=> st'⊢ c₁.EvalR st st' assumption All goals completed! 🐙
| false => cond.false c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = false⊢ ∃ st', st =[ if (~b) {~c₁} else {~c₂} ]=> st'
obtain ⟨st', hc₂⟩ := ih₂ st cond.false c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = falsest':Statehc₂:st =[ ~c₂ ]=> st'⊢ ∃ st', st =[ if (~b) {~c₁} else {~c₂} ]=> st'
exists st' cond.false c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = falsest':Statehc₂:st =[ ~c₂ ]=> st'⊢ st =[ if (~b) {~c₁} else {~c₂} ]=> st'; apply Com.EvalR.ifFalse cond.false.hb c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = falsest':Statehc₂:st =[ ~c₂ ]=> st'⊢ Bexp.eval st b = falsecond.false.hc c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = falsest':Statehc₂:st =[ ~c₂ ]=> st'⊢ c₂.EvalR st st' <;> cond.false.hb c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = falsest':Statehc₂:st =[ ~c₂ ]=> st'⊢ Bexp.eval st b = falsecond.false.hc c:Comb:Bexpc₁:Comc₂:Comh₁:c₁.NoWhilesRh₂:c₂.NoWhilesRih₁:∀ (st : State), ∃ st', st =[ ~c₁ ]=> st'ih₂:∀ (st : State), ∃ st', st =[ ~c₂ ]=> st'st:Statehb:Bexp.eval st b = falsest':Statehc₂:st =[ ~c₂ ]=> st'⊢ c₂.EvalR st st' assumption All goals completed! 🐙
And here is an alternative solution by induction on c (using
Com.no_whiles instead of Com.NoWhilesR):
theorem no_whiles_terminating' (c : Com) (st1 : State)
(hb : c.no_whiles = true) : ∃ st2, st1 =[ c ]=> st2 := by c:Comst1:Statehb:c.no_whiles = true⊢ ∃ st2, st1 =[ ~c ]=> st2
induction c generalizing st1 with
| skip => skip st1:Statehb:imp {skip}.no_whiles = true⊢ ∃ st2, st1 =[ skip ]=> st2 exists st1 skip st1:Statehb:imp {skip}.no_whiles = true⊢ st1 =[ skip ]=> st1; constructor All goals completed! 🐙
| asgn x a => asgn x:Identa:Aexpst1:Statehb:imp {x := ~a}.no_whiles = true⊢ ∃ st2, st1 =[ x := ~a ]=> st2 exists (x →ₜ a.eval st1 ; st1) asgn x:Identa:Aexpst1:Statehb:imp {x := ~a}.no_whiles = true⊢ st1 =[ x := ~a ]=> x →ₜ Aexp.eval st1 a ; st1; constructor asgn x:Identa:Aexpst1:Statehb:imp {x := ~a}.no_whiles = true⊢ Aexp.eval st1 a = Aexp.eval st1 a; rfl All goals completed! 🐙
| seq c₁ c₂ ih₁ ih₂ => seq c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:imp {~c₁; ~c₂}.no_whiles = true⊢ ∃ st2, st1 =[ ~c₁; ~c₂ ]=> st2
simp only [Com.no_whiles, Bool.and_eq_true] at hb seq c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = true⊢ ∃ st2, st1 =[ ~c₁; ~c₂ ]=> st2
obtain ⟨st1', hc₁⟩ := ih₁ st1 hb.1 seq c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = truest1':Statehc₁:st1 =[ ~c₁ ]=> st1'⊢ ∃ st2, st1 =[ ~c₁; ~c₂ ]=> st2
obtain ⟨st1'', hc₂⟩ := ih₂ st1' hb.2 seq c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = truest1':Statehc₁:st1 =[ ~c₁ ]=> st1'st1'':Statehc₂:st1' =[ ~c₂ ]=> st1''⊢ ∃ st2, st1 =[ ~c₁; ~c₂ ]=> st2
exists st1'' seq c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = truest1':Statehc₁:st1 =[ ~c₁ ]=> st1'st1'':Statehc₂:st1' =[ ~c₂ ]=> st1''⊢ st1 =[ ~c₁; ~c₂ ]=> st1''; constructor seq.h₁ c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = truest1':Statehc₁:st1 =[ ~c₁ ]=> st1'st1'':Statehc₂:st1' =[ ~c₂ ]=> st1''⊢ c₁.EvalR st1 ?seq.st'seq.h₂ c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = truest1':Statehc₁:st1 =[ ~c₁ ]=> st1'st1'':Statehc₂:st1' =[ ~c₂ ]=> st1''⊢ c₂.EvalR ?seq.st' st1''seq.st' c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = truest1':Statehc₁:st1 =[ ~c₁ ]=> st1'st1'':Statehc₂:st1' =[ ~c₂ ]=> st1''⊢ State <;> seq.h₁ c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = truest1':Statehc₁:st1 =[ ~c₁ ]=> st1'st1'':Statehc₂:st1' =[ ~c₂ ]=> st1''⊢ c₁.EvalR st1 ?seq.st'seq.h₂ c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = truest1':Statehc₁:st1 =[ ~c₁ ]=> st1'st1'':Statehc₂:st1' =[ ~c₂ ]=> st1''⊢ c₂.EvalR ?seq.st' st1''seq.st' c₁:Comc₂:Comih₁:∀ (st1 : State), c₁.no_whiles = true → ∃ st2, st1 =[ ~c₁ ]=> st2ih₂:∀ (st1 : State), c₂.no_whiles = true → ∃ st2, st1 =[ ~c₂ ]=> st2st1:Statehb:c₁.no_whiles = true ∧ c₂.no_whiles = truest1':Statehc₁:st1 =[ ~c₁ ]=> st1'st1'':Statehc₂:st1' =[ ~c₂ ]=> st1''⊢ State assumption All goals completed! 🐙
| cond b ct cf ih₁ ih₂ => cond b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:imp {if (~b) {~ct} else {~cf}}.no_whiles = true⊢ ∃ st2, st1 =[ if (~b) {~ct} else {~cf} ]=> st2
simp only [Com.no_whiles, Bool.and_eq_true] at hb cond b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = true⊢ ∃ st2, st1 =[ if (~b) {~ct} else {~cf} ]=> st2
cases hbev : b.eval st1 with
| true => cond.true b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = true⊢ ∃ st2, st1 =[ if (~b) {~ct} else {~cf} ]=> st2
obtain ⟨st2, h⟩ := ih₁ st1 hb.1 cond.true b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = truest2:Stateh:st1 =[ ~ct ]=> st2⊢ ∃ st2, st1 =[ if (~b) {~ct} else {~cf} ]=> st2
exists st2 cond.true b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = truest2:Stateh:st1 =[ ~ct ]=> st2⊢ st1 =[ if (~b) {~ct} else {~cf} ]=> st2; constructor cond.true.hb b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = truest2:Stateh:st1 =[ ~ct ]=> st2⊢ Bexp.eval st1 b = truecond.true.hc b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = truest2:Stateh:st1 =[ ~ct ]=> st2⊢ ct.EvalR st1 st2 <;> cond.true.hb b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = truest2:Stateh:st1 =[ ~ct ]=> st2⊢ Bexp.eval st1 b = truecond.true.hc b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = truest2:Stateh:st1 =[ ~ct ]=> st2⊢ ct.EvalR st1 st2 assumption All goals completed! 🐙
| false => cond.false b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = false⊢ ∃ st2, st1 =[ if (~b) {~ct} else {~cf} ]=> st2
obtain ⟨st2, h⟩ := ih₂ st1 hb.2 cond.false b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = falsest2:Stateh:st1 =[ ~cf ]=> st2⊢ ∃ st2, st1 =[ if (~b) {~ct} else {~cf} ]=> st2
exists st2 cond.false b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = falsest2:Stateh:st1 =[ ~cf ]=> st2⊢ st1 =[ if (~b) {~ct} else {~cf} ]=> st2; apply Com.EvalR.ifFalse cond.false.hb b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = falsest2:Stateh:st1 =[ ~cf ]=> st2⊢ Bexp.eval st1 b = falsecond.false.hc b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = falsest2:Stateh:st1 =[ ~cf ]=> st2⊢ cf.EvalR st1 st2 <;> cond.false.hb b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = falsest2:Stateh:st1 =[ ~cf ]=> st2⊢ Bexp.eval st1 b = falsecond.false.hc b:Bexpct:Comcf:Comih₁:∀ (st1 : State), ct.no_whiles = true → ∃ st2, st1 =[ ~ct ]=> st2ih₂:∀ (st1 : State), cf.no_whiles = true → ∃ st2, st1 =[ ~cf ]=> st2st1:Statehb:ct.no_whiles = true ∧ cf.no_whiles = truehbev:Bexp.eval st1 b = falsest2:Stateh:st1 =[ ~cf ]=> st2⊢ cf.EvalR st1 st2 assumption All goals completed! 🐙
| whileDo b c ih => whileDo b:Bexpc:Comih:∀ (st1 : State), c.no_whiles = true → ∃ st2, st1 =[ ~c ]=> st2st1:Statehb:imp {while (~b) {~c}}.no_whiles = true⊢ ∃ st2, st1 =[ while (~b) {~c} ]=> st2 simp [Com.no_whiles] at hb All goals completed! 🐙
3.5. Case Study (Optional)
Recall the factorial program (broken up into smaller pieces this time, for convenience of proving things about it).
def factBody : Com := imp {
Y := Y * Z;
Z := Z - 1
}
def factLoop : Com := imp {
while (Z ≠ 0) {
~factBody
}
}
def factCom : Com := imp {
Z := X;
Y := 1;
~factLoop
}
Here is an alternative "mathematical" definition of the factorial function:
def realFact (n : Nat) : Nat :=
match n with
| 0 => 1
| n' + 1 => (n' + 1) * realFact n'
We would like to show that they agree -- if we start factCom in
a state where variable X contains some number n, then it will
terminate in a state where variable Y contains the factorial of
n.
To show this, we rely on the critical idea of a loop invariant.
def FactInvariant (n : Nat) (st : State) : Prop :=
st[Y] * realFact st[Z] = realFact n
We show that the body of the factorial loop preserves the invariant:
theorem factBody_preserves_invariant {st st' : State} {n : Nat}
(hinv : FactInvariant n st) (hz : st[Z] ≠ 0)
(heval : st =[ ~factBody ]=> st') :
FactInvariant n st' := by st:Statest':Staten:Nathinv:FactInvariant n sthz:st[Z] ≠ 0heval:st =[ ~factBody ]=> st'⊢ FactInvariant n st'
rw [FactInvariant st:Statest':Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0heval:st =[ ~factBody ]=> st'⊢ st'[Y] * realFact st'[Z] = realFact n] at hinv ⊢ st:Statest':Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0heval:st =[ ~factBody ]=> st'⊢ st'[Y] * realFact st'[Z] = realFact n
rw [factBody st:Statest':Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0heval:st =[ Y := Y * Z; Z := Z - 1 ]=> st'⊢ st'[Y] * realFact st'[Z] = realFact n] at heval st:Statest':Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0heval:st =[ Y := Y * Z; Z := Z - 1 ]=> st'⊢ st'[Y] * realFact st'[Z] = realFact n
inversion heval with
| seq _ h₁ h₂ =>
inversion h₁ with
| asgn hy =>
inversion h₂ with
| asgn hz' =>
subst hy hz' asgn st:Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0⊢ (Z →ₜ Aexp.eval (Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st) (aexp {Z - 1}) ; Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st)[Y] *
realFact
(Z →ₜ Aexp.eval (Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st) (aexp {Z - 1}) ;
Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st)[Z] =
realFact n
have hyz : Y ≠ Z := by st:Statest':Staten:Nathinv:FactInvariant n sthz:st[Z] ≠ 0heval:st =[ ~factBody ]=> st'⊢ FactInvariant n st' decide asgn st:Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0hyz:Y ≠ Z⊢ (Z →ₜ Aexp.eval (Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st) (aexp {Z - 1}) ; Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st)[Y] *
realFact
(Z →ₜ Aexp.eval (Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st) (aexp {Z - 1}) ;
Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st)[Z] =
realFact n
have hzy : Z ≠ Y := by st:Statest':Staten:Nathinv:FactInvariant n sthz:st[Z] ≠ 0heval:st =[ ~factBody ]=> st'⊢ FactInvariant n st' decide asgn st:Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Y⊢ (Z →ₜ Aexp.eval (Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st) (aexp {Z - 1}) ; Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st)[Y] *
realFact
(Z →ₜ Aexp.eval (Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st) (aexp {Z - 1}) ;
Y →ₜ Aexp.eval st (aexp {Y * Z}) ; st)[Z] =
realFact n
simp [hyz, hzy] asgn st:Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Y⊢ st[Y] * st[Z] * realFact (st[Z] - 1) = realFact n
-- Show that `st[Z] = z + 1` for some `z`
cases hzz : st[Z] with
| zero => asgn.zero st:Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Yhzz:st[Z] = 0⊢ st[Y] * 0 * realFact (0 - 1) = realFact n contradiction All goals completed! 🐙
| succ z => asgn.succ st:Staten:Nathinv:st[Y] * realFact st[Z] = realFact nhz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Yz:Nathzz:st[Z] = z + 1⊢ st[Y] * (z + 1) * realFact (z + 1 - 1) = realFact n
rw [hzz, asgn.succ st:Staten:Nathz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Yz:Nathinv:st[Y] * realFact (z + 1) = realFact nhzz:st[Z] = z + 1⊢ st[Y] * (z + 1) * realFact (z + 1 - 1) = realFact n realFact asgn.succ st:Staten:Nathz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Yz:Nathinv:st[Y] * ((z + 1) * realFact z) = realFact nhzz:st[Z] = z + 1⊢ st[Y] * (z + 1) * realFact (z + 1 - 1) = realFact n] at hinv asgn.succ st:Staten:Nathz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Yz:Nathinv:st[Y] * ((z + 1) * realFact z) = realFact nhzz:st[Z] = z + 1⊢ st[Y] * (z + 1) * realFact (z + 1 - 1) = realFact n
rw [Nat.add_sub_cancel, asgn.succ st:Staten:Nathz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Yz:Nathinv:st[Y] * ((z + 1) * realFact z) = realFact nhzz:st[Z] = z + 1⊢ st[Y] * (z + 1) * realFact z = realFact n Nat.mul_assoc asgn.succ st:Staten:Nathz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Yz:Nathinv:st[Y] * ((z + 1) * realFact z) = realFact nhzz:st[Z] = z + 1⊢ st[Y] * ((z + 1) * realFact z) = realFact n] asgn.succ st:Staten:Nathz:st[Z] ≠ 0hyz:Y ≠ Zhzy:Z ≠ Yz:Nathinv:st[Y] * ((z + 1) * realFact z) = realFact nhzz:st[Z] = z + 1⊢ st[Y] * ((z + 1) * realFact z) = realFact n
exact hinv All goals completed! 🐙
From this, we can show that the whole loop also preserves the invariant:
theorem factLoop_preserves_invariant {st st' : State} {n : Nat}
(hinv : FactInvariant n st) (heval : st =[ ~factLoop ]=> st') :
FactInvariant n st' := by st:Statest':Staten:Nathinv:FactInvariant n stheval:st =[ ~factLoop ]=> st'⊢ FactInvariant n st'
generalize heq : factLoop = c at heval st:Statest':Staten:Nathinv:FactInvariant n stc:Comheq:factLoop = cheval:st =[ ~c ]=> st'⊢ FactInvariant n st'
induction heval with
| whileFalse hb => whileFalse st:Statest':Staten:Natc:Comb✝:Bexpst✝:Statec✝:Comhb:Bexp.eval st✝ b✝ = falsehinv:FactInvariant n st✝heq:factLoop = imp {while (~b✝) {~c✝}}⊢ FactInvariant n st✝
-- trivial when the loop doesn't run...
exact hinv All goals completed! 🐙
| @whileTrue st st' st'' b c hb hc hloop ih₁ ih₂ => whileTrue st✝:Statest'✝:Staten:Natc✝:Comst:Statest':Statest'':Stateb:Bexpc:Comhb:Bexp.eval st b = truehc:c.EvalR st st'hloop:imp {while (~b) {~c}}.EvalR st' st''ih₁:FactInvariant n st → factLoop = c → FactInvariant n st'ih₂:FactInvariant n st' → factLoop = imp {while (~b) {~c}} → FactInvariant n st''hinv:FactInvariant n stheq:factLoop = imp {while (~b) {~c}}⊢ FactInvariant n st''
-- if the loop does run, we know that `factBody` preserves
-- `FactInvariant` -- we just need to assemble the pieces
rw [factLoop whileTrue st✝:Statest'✝:Staten:Natc✝:Comst:Statest':Statest'':Stateb:Bexpc:Comhb:Bexp.eval st b = truehc:c.EvalR st st'hloop:imp {while (~b) {~c}}.EvalR st' st''ih₁:FactInvariant n st → factLoop = c → FactInvariant n st'ih₂:FactInvariant n st' → factLoop = imp {while (~b) {~c}} → FactInvariant n st''hinv:FactInvariant n stheq:imp {while (Z ≠ 0) {~factBody}} = imp {while (~b) {~c}}⊢ FactInvariant n st''] at heq whileTrue st✝:Statest'✝:Staten:Natc✝:Comst:Statest':Statest'':Stateb:Bexpc:Comhb:Bexp.eval st b = truehc:c.EvalR st st'hloop:imp {while (~b) {~c}}.EvalR st' st''ih₁:FactInvariant n st → factLoop = c → FactInvariant n st'ih₂:FactInvariant n st' → factLoop = imp {while (~b) {~c}} → FactInvariant n st''hinv:FactInvariant n stheq:imp {while (Z ≠ 0) {~factBody}} = imp {while (~b) {~c}}⊢ FactInvariant n st''
injection heq with hb' hc' whileTrue st✝:Statest'✝:Staten:Natc✝:Comst:Statest':Statest'':Stateb:Bexpc:Comhb:Bexp.eval st b = truehc:c.EvalR st st'hloop:imp {while (~b) {~c}}.EvalR st' st''ih₁:FactInvariant n st → factLoop = c → FactInvariant n st'ih₂:FactInvariant n st' → factLoop = imp {while (~b) {~c}} → FactInvariant n st''hinv:FactInvariant n sthb':bexp {Z ≠ 0} = bhc':factBody = c⊢ FactInvariant n st''
subst hb' hc' whileTrue st✝:Statest'✝:Staten:Natc:Comst:Statest':Statest'':Statehinv:FactInvariant n sthb:Bexp.eval st (bexp {Z ≠ 0}) = truehc:factBody.EvalR st st'ih₁:FactInvariant n st → factLoop = factBody → FactInvariant n st'hloop:imp {while (Z ≠ 0) {~factBody}}.EvalR st' st''ih₂:FactInvariant n st' → factLoop = imp {while (Z ≠ 0) {~factBody}} → FactInvariant n st''⊢ FactInvariant n st''
have hz : st[Z] ≠ 0 := by st:Statest':Staten:Nathinv:FactInvariant n stheval:st =[ ~factLoop ]=> st'⊢ FactInvariant n st'
intro hz st✝:Statest'✝:Staten:Natc:Comst:Statest':Statest'':Statehinv:FactInvariant n sthb:Bexp.eval st (bexp {Z ≠ 0}) = truehc:factBody.EvalR st st'ih₁:FactInvariant n st → factLoop = factBody → FactInvariant n st'hloop:imp {while (Z ≠ 0) {~factBody}}.EvalR st' st''ih₂:FactInvariant n st' → factLoop = imp {while (Z ≠ 0) {~factBody}} → FactInvariant n st''hz:st[Z] = 0⊢ False
simp [hz] at hb whileTrue st✝:Statest'✝:Staten:Natc:Comst:Statest':Statest'':Statehinv:FactInvariant n sthb:Bexp.eval st (bexp {Z ≠ 0}) = truehc:factBody.EvalR st st'ih₁:FactInvariant n st → factLoop = factBody → FactInvariant n st'hloop:imp {while (Z ≠ 0) {~factBody}}.EvalR st' st''ih₂:FactInvariant n st' → factLoop = imp {while (Z ≠ 0) {~factBody}} → FactInvariant n st''hz:st[Z] ≠ 0⊢ FactInvariant n st''
exact ih₂ (factBody_preserves_invariant hinv hz hc) rfl All goals completed! 🐙
| skip skip st:Statest':Staten:Natc:Comst✝:Statehinv:FactInvariant n st✝heq:factLoop = imp {skip}⊢ FactInvariant n st✝ | asgn asgn st:Statest':Staten:Natc:Comst✝:Statea✝:Aexpn✝:Natx✝:Identh✝:Aexp.eval st✝ a✝ = n✝hinv:FactInvariant n st✝heq:factLoop = imp {x✝ := ~a✝}⊢ FactInvariant n (x✝ →ₜ n✝ ; st✝) | seq seq st:Statest':Staten:Natc:Comc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:Stateh₁✝:c₁✝.EvalR st✝ st'✝h₂✝:c₂✝.EvalR st'✝ st''✝h₁_ih✝:FactInvariant n st✝ → factLoop = c₁✝ → FactInvariant n st'✝h₂_ih✝:FactInvariant n st'✝ → factLoop = c₂✝ → FactInvariant n st''✝hinv:FactInvariant n st✝heq:factLoop = imp {~c₁✝; ~c₂✝}⊢ FactInvariant n st''✝ | ifTrue ifTrue st:Statest':Staten:Natc:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = truehc✝:c₁✝.EvalR st✝ st'✝hc_ih✝:FactInvariant n st✝ → factLoop = c₁✝ → FactInvariant n st'✝hinv:FactInvariant n st✝heq:factLoop = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ FactInvariant n st'✝ | ifFalse ifFalse st:Statest':Staten:Natc:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = falsehc✝:c₂✝.EvalR st✝ st'✝hc_ih✝:FactInvariant n st✝ → factLoop = c₂✝ → FactInvariant n st'✝hinv:FactInvariant n st✝heq:factLoop = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ FactInvariant n st'✝ => ifFalse st:Statest':Staten:Natc:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = falsehc✝:c₂✝.EvalR st✝ st'✝hc_ih✝:FactInvariant n st✝ → factLoop = c₂✝ → FactInvariant n st'✝hinv:FactInvariant n st✝heq:factLoop = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ FactInvariant n st'✝ifTrue st:Statest':Staten:Natc:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = truehc✝:c₁✝.EvalR st✝ st'✝hc_ih✝:FactInvariant n st✝ → factLoop = c₁✝ → FactInvariant n st'✝hinv:FactInvariant n st✝heq:factLoop = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ FactInvariant n st'✝seq st:Statest':Staten:Natc:Comc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:Stateh₁✝:c₁✝.EvalR st✝ st'✝h₂✝:c₂✝.EvalR st'✝ st''✝h₁_ih✝:FactInvariant n st✝ → factLoop = c₁✝ → FactInvariant n st'✝h₂_ih✝:FactInvariant n st'✝ → factLoop = c₂✝ → FactInvariant n st''✝hinv:FactInvariant n st✝heq:factLoop = imp {~c₁✝; ~c₂✝}⊢ FactInvariant n st''✝asgn st:Statest':Staten:Natc:Comst✝:Statea✝:Aexpn✝:Natx✝:Identh✝:Aexp.eval st✝ a✝ = n✝hinv:FactInvariant n st✝heq:factLoop = imp {x✝ := ~a✝}⊢ FactInvariant n (x✝ →ₜ n✝ ; st✝)skip st:Statest':Staten:Natc:Comst✝:Statehinv:FactInvariant n st✝heq:factLoop = imp {skip}⊢ FactInvariant n st✝ simp [factLoop] at heq All goals completed! 🐙
Next, we show that, for any loop, if the loop terminates, then the condition guarding the loop must be false at the end:
theorem guard_false_after_loop {b : Bexp} {c : Com} {st st' : State}
(heval : st =[ while (~b) {~c} ]=> st') :
b.eval st' = false := by b:Bexpc:Comst:Statest':Stateheval:st =[ while (~b) {~c} ]=> st'⊢ Bexp.eval st' b = false
generalize heq : (imp { while (~b) {~c} }) = cmd at heval b:Bexpc:Comst:Statest':Statecmd:Comheq:imp {while (~b) {~c}} = cmdheval:st =[ ~cmd ]=> st'⊢ Bexp.eval st' b = false
induction heval with
| whileFalse hb => whileFalse b:Bexpc:Comst:Statest':Statecmd:Comb✝:Bexpst✝:Statec✝:Comhb:Bexp.eval st✝ b✝ = falseheq:imp {while (~b) {~c}} = imp {while (~b✝) {~c✝}}⊢ Bexp.eval st✝ b = false
injection heq with hb' _ whileFalse b:Bexpc:Comst:Statest':Statecmd:Comb✝:Bexpst✝:Statec✝:Comhb:Bexp.eval st✝ b✝ = falsehb':b = b✝c_eq✝:c = c✝⊢ Bexp.eval st✝ b = false
subst hb' whileFalse b:Bexpc:Comst:Statest':Statecmd:Comst✝:Statec✝:Comc_eq✝:c = c✝hb:Bexp.eval st✝ b = false⊢ Bexp.eval st✝ b = false
exact hb All goals completed! 🐙
| whileTrue _ _ _ _ ih₂ => whileTrue b:Bexpc:Comst:Statest':Statecmd:Comst✝:Statest'✝:Statest''✝:Stateb✝:Bexpc✝:Comhb✝:Bexp.eval st✝ b✝ = truehc✝:c✝.EvalR st✝ st'✝hloop✝:imp {while (~b✝) {~c✝}}.EvalR st'✝ st''✝hc_ih✝:imp {while (~b) {~c}} = c✝ → Bexp.eval st'✝ b = falseih₂:imp {while (~b) {~c}} = imp {while (~b✝) {~c✝}} → Bexp.eval st''✝ b = falseheq:imp {while (~b) {~c}} = imp {while (~b✝) {~c✝}}⊢ Bexp.eval st''✝ b = false exact ih₂ heq All goals completed! 🐙
| skip skip b:Bexpc:Comst:Statest':Statecmd:Comst✝:Stateheq:imp {while (~b) {~c}} = imp {skip}⊢ Bexp.eval st✝ b = false | asgn asgn b:Bexpc:Comst:Statest':Statecmd:Comst✝:Statea✝:Aexpn✝:Natx✝:Identh✝:Aexp.eval st✝ a✝ = n✝heq:imp {while (~b) {~c}} = imp {x✝ := ~a✝}⊢ Bexp.eval (x✝ →ₜ n✝ ; st✝) b = false | seq seq b:Bexpc:Comst:Statest':Statecmd:Comc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:Stateh₁✝:c₁✝.EvalR st✝ st'✝h₂✝:c₂✝.EvalR st'✝ st''✝h₁_ih✝:imp {while (~b) {~c}} = c₁✝ → Bexp.eval st'✝ b = falseh₂_ih✝:imp {while (~b) {~c}} = c₂✝ → Bexp.eval st''✝ b = falseheq:imp {while (~b) {~c}} = imp {~c₁✝; ~c₂✝}⊢ Bexp.eval st''✝ b = false | ifTrue ifTrue b:Bexpc:Comst:Statest':Statecmd:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = truehc✝:c₁✝.EvalR st✝ st'✝hc_ih✝:imp {while (~b) {~c}} = c₁✝ → Bexp.eval st'✝ b = falseheq:imp {while (~b) {~c}} = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ Bexp.eval st'✝ b = false | ifFalse ifFalse b:Bexpc:Comst:Statest':Statecmd:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = falsehc✝:c₂✝.EvalR st✝ st'✝hc_ih✝:imp {while (~b) {~c}} = c₂✝ → Bexp.eval st'✝ b = falseheq:imp {while (~b) {~c}} = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ Bexp.eval st'✝ b = false => ifFalse b:Bexpc:Comst:Statest':Statecmd:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = falsehc✝:c₂✝.EvalR st✝ st'✝hc_ih✝:imp {while (~b) {~c}} = c₂✝ → Bexp.eval st'✝ b = falseheq:imp {while (~b) {~c}} = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ Bexp.eval st'✝ b = falseifTrue b:Bexpc:Comst:Statest':Statecmd:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = truehc✝:c₁✝.EvalR st✝ st'✝hc_ih✝:imp {while (~b) {~c}} = c₁✝ → Bexp.eval st'✝ b = falseheq:imp {while (~b) {~c}} = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ Bexp.eval st'✝ b = falseseq b:Bexpc:Comst:Statest':Statecmd:Comc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:Stateh₁✝:c₁✝.EvalR st✝ st'✝h₂✝:c₂✝.EvalR st'✝ st''✝h₁_ih✝:imp {while (~b) {~c}} = c₁✝ → Bexp.eval st'✝ b = falseh₂_ih✝:imp {while (~b) {~c}} = c₂✝ → Bexp.eval st''✝ b = falseheq:imp {while (~b) {~c}} = imp {~c₁✝; ~c₂✝}⊢ Bexp.eval st''✝ b = falseasgn b:Bexpc:Comst:Statest':Statecmd:Comst✝:Statea✝:Aexpn✝:Natx✝:Identh✝:Aexp.eval st✝ a✝ = n✝heq:imp {while (~b) {~c}} = imp {x✝ := ~a✝}⊢ Bexp.eval (x✝ →ₜ n✝ ; st✝) b = falseskip b:Bexpc:Comst:Statest':Statecmd:Comst✝:Stateheq:imp {while (~b) {~c}} = imp {skip}⊢ Bexp.eval st✝ b = false simp at heq All goals completed! 🐙
Finally, we can patch it all together...
theorem factCom_correct {st st' : State} {n : Nat}
(hx : st[X] = n) (heval : st =[ ~factCom ]=> st') :
st'[Y] = realFact n := by st:Statest':Staten:Nathx:st[X] = nheval:st =[ ~factCom ]=> st'⊢ st'[Y] = realFact n
rw [factCom st:Statest':Staten:Nathx:st[X] = nheval:st =[ Z := X; Y := 1; ~factLoop ]=> st'⊢ st'[Y] = realFact n] at heval st:Statest':Staten:Nathx:st[X] = nheval:st =[ Z := X; Y := 1; ~factLoop ]=> st'⊢ st'[Y] = realFact n
inversion heval with
| seq _ h₁ h₂ =>
inversion h₁ with
| asgn hz =>
inversion h₂ with
| seq _ h₃ h₄ =>
inversion h₃ with
| asgn hy =>
subst hz hy asgn st:Statest':Staten:Nathx:st[X] = nh₄:factLoop.EvalR (Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'⊢ st'[Y] = realFact n
-- The invariant is true before the loop runs...
have hinv : FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st) := by
have hyz : Y ≠ Z := by st:Statest':Staten:Nathx:st[X] = nheval:st =[ ~factCom ]=> st'⊢ st'[Y] = realFact n decide st:Statest':Staten:Nathx:st[X] = nh₄:factLoop.EvalR (Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hyz:Y ≠ Z⊢ FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)
simp [FactInvariant, hyz, hx] asgn st:Statest':Staten:Nathx:st[X] = nh₄:factLoop.EvalR (Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)⊢ st'[Y] = realFact n
-- ...so when the loop is done running, the invariant
-- is maintained
have hinv' := factLoop_preserves_invariant hinv h₄ asgn st:Statest':Staten:Nathx:st[X] = nh₄:factLoop.EvalR (Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':FactInvariant n st'⊢ st'[Y] = realFact n
-- Finally, if the loop terminated, then `Z` is `0`; so `Y` must be
-- factorial of `X`
rw [factLoop asgn st:Statest':Staten:Nathx:st[X] = nh₄:imp {while (Z ≠ 0) {~factBody}}.EvalR
(Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':FactInvariant n st'⊢ st'[Y] = realFact n] at h₄ asgn st:Statest':Staten:Nathx:st[X] = nh₄:imp {while (Z ≠ 0) {~factBody}}.EvalR
(Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':FactInvariant n st'⊢ st'[Y] = realFact n
have hz := guard_false_after_loop h₄ asgn st:Statest':Staten:Nathx:st[X] = nh₄:imp {while (Z ≠ 0) {~factBody}}.EvalR
(Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':FactInvariant n st'hz:Bexp.eval st' (bexp {Z ≠ 0}) = false⊢ st'[Y] = realFact n
simp at hz asgn st:Statest':Staten:Nathx:st[X] = nh₄:imp {while (Z ≠ 0) {~factBody}}.EvalR
(Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':FactInvariant n st'hz:st'[Z] = 0⊢ st'[Y] = realFact n
rw [FactInvariant, asgn st:Statest':Staten:Nathx:st[X] = nh₄:imp {while (Z ≠ 0) {~factBody}}.EvalR
(Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':st'[Y] * realFact st'[Z] = realFact nhz:st'[Z] = 0⊢ st'[Y] = realFact n hz, asgn st:Statest':Staten:Nathx:st[X] = nh₄:imp {while (Z ≠ 0) {~factBody}}.EvalR
(Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':st'[Y] * realFact 0 = realFact nhz:st'[Z] = 0⊢ st'[Y] = realFact n realFact, asgn st:Statest':Staten:Nathx:st[X] = nh₄:imp {while (Z ≠ 0) {~factBody}}.EvalR
(Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':st'[Y] * 1 = realFact nhz:st'[Z] = 0⊢ st'[Y] = realFact n Nat.mul_one asgn st:Statest':Staten:Nathx:st[X] = nh₄:imp {while (Z ≠ 0) {~factBody}}.EvalR
(Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':st'[Y] = realFact nhz:st'[Z] = 0⊢ st'[Y] = realFact n] at hinv' asgn st:Statest':Staten:Nathx:st[X] = nh₄:imp {while (Z ≠ 0) {~factBody}}.EvalR
(Y →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {X}) ; st) (aexp {1}) ; Z →ₜ Aexp.eval st (aexp {X}) ; st) st'hinv:FactInvariant n (Y →ₜ 1 ; Z →ₜ st[X] ; st)hinv':st'[Y] = realFact nhz:st'[Z] = 0⊢ st'[Y] = realFact n
exact hinv' All goals completed! 🐙
One might wonder whether all this work with poking at states and unfolding definitions could be ameliorated with some more powerful lemmas and/or more uniform reasoning principles... Indeed, this is exactly the point of the Hoare chapters!
Prove a specification for subtract_slowly, using the above
specification of factCom and the invariant below as
guides.
def SsInvariant (n z : Nat) (st : State) : Prop :=
st[Z] - st[X] = z - n
theorem ss_body_preserves_invariant {st st' : State} {n z : Nat}
(hinv : SsInvariant n z st) (hx : st[X] ≠ 0)
(heval : st =[ ~subtract_slowly_body ]=> st') :
SsInvariant n z st' := by st:Statest':Staten:Natz:Nathinv:SsInvariant n z sthx:st[X] ≠ 0heval:st =[ ~subtract_slowly_body ]=> st'⊢ SsInvariant n z st'
rw [SsInvariant st:Statest':Staten:Natz:Nathinv:st[Z] - st[X] = z - nhx:st[X] ≠ 0heval:st =[ ~subtract_slowly_body ]=> st'⊢ st'[Z] - st'[X] = z - n] at hinv ⊢ st:Statest':Staten:Natz:Nathinv:st[Z] - st[X] = z - nhx:st[X] ≠ 0heval:st =[ ~subtract_slowly_body ]=> st'⊢ st'[Z] - st'[X] = z - n
rw [subtract_slowly_body st:Statest':Staten:Natz:Nathinv:st[Z] - st[X] = z - nhx:st[X] ≠ 0heval:st =[ Z := Z - 1; X := X - 1 ]=> st'⊢ st'[Z] - st'[X] = z - n] at heval st:Statest':Staten:Natz:Nathinv:st[Z] - st[X] = z - nhx:st[X] ≠ 0heval:st =[ Z := Z - 1; X := X - 1 ]=> st'⊢ st'[Z] - st'[X] = z - n
inversion heval with
| seq _ h₁ h₂ =>
inversion h₁ with
| asgn hz =>
inversion h₂ with
| asgn hx' =>
subst hz hx' asgn st:Staten:Natz:Nathinv:st[Z] - st[X] = z - nhx:st[X] ≠ 0⊢ (X →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st) (aexp {X - 1}) ; Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st)[Z] -
(X →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st) (aexp {X - 1}) ; Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st)[X] =
z - n
have hzx : Z ≠ X := by st:Statest':Staten:Natz:Nathinv:SsInvariant n z sthx:st[X] ≠ 0heval:st =[ ~subtract_slowly_body ]=> st'⊢ SsInvariant n z st' decide asgn st:Staten:Natz:Nathinv:st[Z] - st[X] = z - nhx:st[X] ≠ 0hzx:Z ≠ X⊢ (X →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st) (aexp {X - 1}) ; Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st)[Z] -
(X →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st) (aexp {X - 1}) ; Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st)[X] =
z - n
have hxz : X ≠ Z := by st:Statest':Staten:Natz:Nathinv:SsInvariant n z sthx:st[X] ≠ 0heval:st =[ ~subtract_slowly_body ]=> st'⊢ SsInvariant n z st' decide asgn st:Staten:Natz:Nathinv:st[Z] - st[X] = z - nhx:st[X] ≠ 0hzx:Z ≠ Xhxz:X ≠ Z⊢ (X →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st) (aexp {X - 1}) ; Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st)[Z] -
(X →ₜ Aexp.eval (Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st) (aexp {X - 1}) ; Z →ₜ Aexp.eval st (aexp {Z - 1}) ; st)[X] =
z - n
simp [hzx, hxz] asgn st:Staten:Natz:Nathinv:st[Z] - st[X] = z - nhx:st[X] ≠ 0hzx:Z ≠ Xhxz:X ≠ Z⊢ st[Z] - 1 - (st[X] - 1) = z - n
lia All goals completed! 🐙 -- Interestingly, this is all we need here!
theorem ss_preserves_invariant {st st' : State} {n z : Nat}
(hinv : SsInvariant n z st) (heval : st =[ ~subtract_slowly ]=> st') :
SsInvariant n z st' := by st:Statest':Staten:Natz:Nathinv:SsInvariant n z stheval:st =[ ~subtract_slowly ]=> st'⊢ SsInvariant n z st'
generalize heq : subtract_slowly = c at heval st:Statest':Staten:Natz:Nathinv:SsInvariant n z stc:Comheq:subtract_slowly = cheval:st =[ ~c ]=> st'⊢ SsInvariant n z st'
induction heval with
| whileFalse hb => whileFalse st:Statest':Staten:Natz:Natc:Comb✝:Bexpst✝:Statec✝:Comhb:Bexp.eval st✝ b✝ = falsehinv:SsInvariant n z st✝heq:subtract_slowly = imp {while (~b✝) {~c✝}}⊢ SsInvariant n z st✝ exact hinv All goals completed! 🐙
| @whileTrue st st' st'' b c hb hc hloop ih₁ ih₂ => whileTrue st✝:Statest'✝:Staten:Natz:Natc✝:Comst:Statest':Statest'':Stateb:Bexpc:Comhb:Bexp.eval st b = truehc:c.EvalR st st'hloop:imp {while (~b) {~c}}.EvalR st' st''ih₁:SsInvariant n z st → subtract_slowly = c → SsInvariant n z st'ih₂:SsInvariant n z st' → subtract_slowly = imp {while (~b) {~c}} → SsInvariant n z st''hinv:SsInvariant n z stheq:subtract_slowly = imp {while (~b) {~c}}⊢ SsInvariant n z st''
rw [subtract_slowly whileTrue st✝:Statest'✝:Staten:Natz:Natc✝:Comst:Statest':Statest'':Stateb:Bexpc:Comhb:Bexp.eval st b = truehc:c.EvalR st st'hloop:imp {while (~b) {~c}}.EvalR st' st''ih₁:SsInvariant n z st → subtract_slowly = c → SsInvariant n z st'ih₂:SsInvariant n z st' → subtract_slowly = imp {while (~b) {~c}} → SsInvariant n z st''hinv:SsInvariant n z stheq:imp {while (X ≠ 0) {~subtract_slowly_body}} = imp {while (~b) {~c}}⊢ SsInvariant n z st''] at heq whileTrue st✝:Statest'✝:Staten:Natz:Natc✝:Comst:Statest':Statest'':Stateb:Bexpc:Comhb:Bexp.eval st b = truehc:c.EvalR st st'hloop:imp {while (~b) {~c}}.EvalR st' st''ih₁:SsInvariant n z st → subtract_slowly = c → SsInvariant n z st'ih₂:SsInvariant n z st' → subtract_slowly = imp {while (~b) {~c}} → SsInvariant n z st''hinv:SsInvariant n z stheq:imp {while (X ≠ 0) {~subtract_slowly_body}} = imp {while (~b) {~c}}⊢ SsInvariant n z st''
injection heq with hb' hc' whileTrue st✝:Statest'✝:Staten:Natz:Natc✝:Comst:Statest':Statest'':Stateb:Bexpc:Comhb:Bexp.eval st b = truehc:c.EvalR st st'hloop:imp {while (~b) {~c}}.EvalR st' st''ih₁:SsInvariant n z st → subtract_slowly = c → SsInvariant n z st'ih₂:SsInvariant n z st' → subtract_slowly = imp {while (~b) {~c}} → SsInvariant n z st''hinv:SsInvariant n z sthb':bexp {X ≠ 0} = bhc':subtract_slowly_body = c⊢ SsInvariant n z st''
subst hb' hc' whileTrue st✝:Statest'✝:Staten:Natz:Natc:Comst:Statest':Statest'':Statehinv:SsInvariant n z sthb:Bexp.eval st (bexp {X ≠ 0}) = truehc:subtract_slowly_body.EvalR st st'ih₁:SsInvariant n z st → subtract_slowly = subtract_slowly_body → SsInvariant n z st'hloop:imp {while (X ≠ 0) {~subtract_slowly_body}}.EvalR st' st''ih₂:SsInvariant n z st' → subtract_slowly = imp {while (X ≠ 0) {~subtract_slowly_body}} → SsInvariant n z st''⊢ SsInvariant n z st''
have hx : st[X] ≠ 0 := by st:Statest':Staten:Natz:Nathinv:SsInvariant n z stheval:st =[ ~subtract_slowly ]=> st'⊢ SsInvariant n z st'
intro hx st✝:Statest'✝:Staten:Natz:Natc:Comst:Statest':Statest'':Statehinv:SsInvariant n z sthb:Bexp.eval st (bexp {X ≠ 0}) = truehc:subtract_slowly_body.EvalR st st'ih₁:SsInvariant n z st → subtract_slowly = subtract_slowly_body → SsInvariant n z st'hloop:imp {while (X ≠ 0) {~subtract_slowly_body}}.EvalR st' st''ih₂:SsInvariant n z st' → subtract_slowly = imp {while (X ≠ 0) {~subtract_slowly_body}} → SsInvariant n z st''hx:st[X] = 0⊢ False
simp [hx] at hb whileTrue st✝:Statest'✝:Staten:Natz:Natc:Comst:Statest':Statest'':Statehinv:SsInvariant n z sthb:Bexp.eval st (bexp {X ≠ 0}) = truehc:subtract_slowly_body.EvalR st st'ih₁:SsInvariant n z st → subtract_slowly = subtract_slowly_body → SsInvariant n z st'hloop:imp {while (X ≠ 0) {~subtract_slowly_body}}.EvalR st' st''ih₂:SsInvariant n z st' → subtract_slowly = imp {while (X ≠ 0) {~subtract_slowly_body}} → SsInvariant n z st''hx:st[X] ≠ 0⊢ SsInvariant n z st''
exact ih₂ (ss_body_preserves_invariant hinv hx hc) rfl All goals completed! 🐙
| skip skip st:Statest':Staten:Natz:Natc:Comst✝:Statehinv:SsInvariant n z st✝heq:subtract_slowly = imp {skip}⊢ SsInvariant n z st✝ | asgn asgn st:Statest':Staten:Natz:Natc:Comst✝:Statea✝:Aexpn✝:Natx✝:Identh✝:Aexp.eval st✝ a✝ = n✝hinv:SsInvariant n z st✝heq:subtract_slowly = imp {x✝ := ~a✝}⊢ SsInvariant n z (x✝ →ₜ n✝ ; st✝) | seq seq st:Statest':Staten:Natz:Natc:Comc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:Stateh₁✝:c₁✝.EvalR st✝ st'✝h₂✝:c₂✝.EvalR st'✝ st''✝h₁_ih✝:SsInvariant n z st✝ → subtract_slowly = c₁✝ → SsInvariant n z st'✝h₂_ih✝:SsInvariant n z st'✝ → subtract_slowly = c₂✝ → SsInvariant n z st''✝hinv:SsInvariant n z st✝heq:subtract_slowly = imp {~c₁✝; ~c₂✝}⊢ SsInvariant n z st''✝ | ifTrue ifTrue st:Statest':Staten:Natz:Natc:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = truehc✝:c₁✝.EvalR st✝ st'✝hc_ih✝:SsInvariant n z st✝ → subtract_slowly = c₁✝ → SsInvariant n z st'✝hinv:SsInvariant n z st✝heq:subtract_slowly = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ SsInvariant n z st'✝ | ifFalse ifFalse st:Statest':Staten:Natz:Natc:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = falsehc✝:c₂✝.EvalR st✝ st'✝hc_ih✝:SsInvariant n z st✝ → subtract_slowly = c₂✝ → SsInvariant n z st'✝hinv:SsInvariant n z st✝heq:subtract_slowly = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ SsInvariant n z st'✝ => ifFalse st:Statest':Staten:Natz:Natc:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = falsehc✝:c₂✝.EvalR st✝ st'✝hc_ih✝:SsInvariant n z st✝ → subtract_slowly = c₂✝ → SsInvariant n z st'✝hinv:SsInvariant n z st✝heq:subtract_slowly = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ SsInvariant n z st'✝ifTrue st:Statest':Staten:Natz:Natc:Comst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Comhb✝:Bexp.eval st✝ b✝ = truehc✝:c₁✝.EvalR st✝ st'✝hc_ih✝:SsInvariant n z st✝ → subtract_slowly = c₁✝ → SsInvariant n z st'✝hinv:SsInvariant n z st✝heq:subtract_slowly = imp {if (~b✝) {~c₁✝} else {~c₂✝}}⊢ SsInvariant n z st'✝seq st:Statest':Staten:Natz:Natc:Comc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:Stateh₁✝:c₁✝.EvalR st✝ st'✝h₂✝:c₂✝.EvalR st'✝ st''✝h₁_ih✝:SsInvariant n z st✝ → subtract_slowly = c₁✝ → SsInvariant n z st'✝h₂_ih✝:SsInvariant n z st'✝ → subtract_slowly = c₂✝ → SsInvariant n z st''✝hinv:SsInvariant n z st✝heq:subtract_slowly = imp {~c₁✝; ~c₂✝}⊢ SsInvariant n z st''✝asgn st:Statest':Staten:Natz:Natc:Comst✝:Statea✝:Aexpn✝:Natx✝:Identh✝:Aexp.eval st✝ a✝ = n✝hinv:SsInvariant n z st✝heq:subtract_slowly = imp {x✝ := ~a✝}⊢ SsInvariant n z (x✝ →ₜ n✝ ; st✝)skip st:Statest':Staten:Natz:Natc:Comst✝:Statehinv:SsInvariant n z st✝heq:subtract_slowly = imp {skip}⊢ SsInvariant n z st✝ simp [subtract_slowly] at heq All goals completed! 🐙
theorem ss_correct {st st' : State} {n z : Nat}
(hx : st[X] = n) (hz : st[Z] = z) (heval : st =[ ~subtract_slowly ]=> st') :
st'[Z] = z - n := by st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ ~subtract_slowly ]=> st'⊢ st'[Z] = z - n
have hinv : SsInvariant n z st := by
simp [SsInvariant, hx, hz] st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ ~subtract_slowly ]=> st'hinv:SsInvariant n z st⊢ st'[Z] = z - n
have hinv' := ss_preserves_invariant hinv heval st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ ~subtract_slowly ]=> st'hinv:SsInvariant n z sthinv':SsInvariant n z st'⊢ st'[Z] = z - n
rw [subtract_slowly st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ while (X ≠ 0) {~subtract_slowly_body} ]=> st'hinv:SsInvariant n z sthinv':SsInvariant n z st'⊢ st'[Z] = z - n] at heval st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ while (X ≠ 0) {~subtract_slowly_body} ]=> st'hinv:SsInvariant n z sthinv':SsInvariant n z st'⊢ st'[Z] = z - n
have hx' := guard_false_after_loop heval st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ while (X ≠ 0) {~subtract_slowly_body} ]=> st'hinv:SsInvariant n z sthinv':SsInvariant n z st'hx':Bexp.eval st' (bexp {X ≠ 0}) = false⊢ st'[Z] = z - n
simp at hx' st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ while (X ≠ 0) {~subtract_slowly_body} ]=> st'hinv:SsInvariant n z sthinv':SsInvariant n z st'hx':st'[X] = 0⊢ st'[Z] = z - n
rw [SsInvariant st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ while (X ≠ 0) {~subtract_slowly_body} ]=> st'hinv:SsInvariant n z sthinv':st'[Z] - st'[X] = z - nhx':st'[X] = 0⊢ st'[Z] = z - n] at hinv' st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ while (X ≠ 0) {~subtract_slowly_body} ]=> st'hinv:SsInvariant n z sthinv':st'[Z] - st'[X] = z - nhx':st'[X] = 0⊢ st'[Z] = z - n
simp [hx'] at hinv' st:Statest':Staten:Natz:Nathx:st[X] = nhz:st[Z] = zheval:st =[ while (X ≠ 0) {~subtract_slowly_body} ]=> st'hinv:SsInvariant n z sthx':st'[X] = 0hinv':st'[Z] = z - n⊢ st'[Z] = z - n
exact hinv' All goals completed! 🐙
3.6. Additional Exercises
Old HP calculators, programming languages like Forth and Postscript, and abstract machines like the Java Virtual Machine all evaluate arithmetic expressions using a stack. For instance, the expression
(2*3)+(3*(4-2))
would be written as
2 3 * 3 4 2 - * +
and evaluated like this (where we show the program being evaluated on the right and the contents of the stack on the left):
[ ] | 2 3 * 3 4 2 - * +
[2] | 3 * 3 4 2 - * +
[3, 2] | * 3 4 2 - * +
[6] | 3 4 2 - * +
[3, 6] | 4 2 - * +
[4, 3, 6] | 2 - * +
[2, 4, 3, 6] | - * +
[2, 3, 6] | * +
[6, 6] | +
[12] |
The goal of this exercise is to write a small compiler that
translates Aexps into stack machine instructions.
The instruction set for our stack language will consist of the following instructions:
-
sPush n: Push the numbernon the stack. -
sLoad x: Load the identifierxfrom the store and push it on the stack. -
sPlus: Pop the two top numbers from the stack, add them, and push the result onto the stack. -
sMinus: Similar, but subtract the first number from the second. -
sMult: Similar, but multiply.
namespace StackCompiler
inductive Sinstr : Type where
| sPush (n : Nat)
| sLoad (x : String)
| sPlus
| sMinus
| sMult
open Sinstr
Write a function to evaluate programs in the stack language. It should take as input a state, a stack represented as a list of numbers (top stack item is the head of the list), and a program represented as a list of instructions, and it should return the stack after executing the program. Test your function on the examples below.
Note that it is unspecified what to do when encountering an
sPlus, sMinus, or sMult instruction if the stack contains
fewer than two elements. In a sense, it is immaterial what we do,
since a correct compiler will never emit such a malformed program.
But for the sake of later exercises, it would be best to skip the
offending instruction and continue with the next one.
def sExecute (st : State) (stack : List Nat) (prog : List Sinstr) : List Nat :=
solution!(match prog, stack with
| [], _ => stack
| sPush n :: prog', _ => sExecute st (n :: stack) prog'
| sLoad x :: prog', _ => sExecute st (st[x] :: stack) prog'
| sPlus :: prog', n :: m :: stack' => sExecute st ((m + n) :: stack') prog'
| sMinus :: prog', n :: m :: stack' => sExecute st ((m - n) :: stack') prog'
| sMult :: prog', n :: m :: stack' => sExecute st ((m * n) :: stack') prog'
-- Bad state: skip the instruction
| _ :: prog', _ => sExecute st stack prog')
@[simp] theorem sExecute_nil (st : State) (stack : List Nat) :
sExecute st stack [] = stack := rfl
@[simp] theorem sExecute_push (st : State) (stack : List Nat) (n : Nat) (prog' : List Sinstr) :
sExecute st stack (sPush n :: prog') = sExecute st (n :: stack) prog' := rfl
@[simp] theorem sExecute_load (st : State) (stack : List Nat) (x : String) (prog' : List Sinstr) :
sExecute st stack (sLoad x :: prog') = sExecute st (st[x] :: stack) prog' := rfl
@[simp] theorem sExecute_plus (st : State) (n m : Nat) (stack' : List Nat) (prog' : List Sinstr) :
sExecute st (n :: m :: stack') (sPlus :: prog') = sExecute st ((m + n) :: stack') prog' := rfl
@[simp] theorem sExecute_minus (st : State) (n m : Nat) (stack' : List Nat) (prog' : List Sinstr) :
sExecute st (n :: m :: stack') (sMinus :: prog') = sExecute st ((m - n) :: stack') prog' := rfl
@[simp] theorem sExecute_mult (st : State) (n m : Nat) (stack' : List Nat) (prog' : List Sinstr) :
sExecute st (n :: m :: stack') (sMult :: prog') = sExecute st ((m * n) :: stack') prog' := rfl
@[simp] theorem sExecute_plus_bad (st : State) (stack : List Nat) (prog' : List Sinstr)
(hs : stack.length < 2) :
sExecute st stack (sPlus :: prog') = sExecute st stack prog' := by st:Statestack:List Natprog':List Sinstrhs:stack.length < 2⊢ sExecute st stack (sPlus :: prog') = sExecute st stack prog'
rcases stack with _ | ⟨_, _ | ⟨_, _⟩⟩ nil st:Stateprog':List Sinstrhs:[].length < 2⊢ sExecute st [] (sPlus :: prog') = sExecute st [] prog'cons.nil st:Stateprog':List Sinstrhead✝:Naths:[head✝].length < 2⊢ sExecute st [head✝] (sPlus :: prog') = sExecute st [head✝] prog'cons.cons st:Stateprog':List Sinstrhead✝¹:Nathead✝:Nattail✝:List Naths:(head✝¹ :: head✝ :: tail✝).length < 2⊢ sExecute st (head✝¹ :: head✝ :: tail✝) (sPlus :: prog') = sExecute st (head✝¹ :: head✝ :: tail✝) prog' <;> nil st:Stateprog':List Sinstrhs:[].length < 2⊢ sExecute st [] (sPlus :: prog') = sExecute st [] prog'cons.nil st:Stateprog':List Sinstrhead✝:Naths:[head✝].length < 2⊢ sExecute st [head✝] (sPlus :: prog') = sExecute st [head✝] prog'cons.cons st:Stateprog':List Sinstrhead✝¹:Nathead✝:Nattail✝:List Naths:(head✝¹ :: head✝ :: tail✝).length < 2⊢ sExecute st (head✝¹ :: head✝ :: tail✝) (sPlus :: prog') = sExecute st (head✝¹ :: head✝ :: tail✝) prog' trivial All goals completed! 🐙
@[simp] theorem sExecute_minus_bad (st : State) (stack : List Nat) (prog' : List Sinstr)
(hs : stack.length < 2) :
sExecute st stack (sMinus :: prog') = sExecute st stack prog' := by st:Statestack:List Natprog':List Sinstrhs:stack.length < 2⊢ sExecute st stack (sMinus :: prog') = sExecute st stack prog'
rcases stack with _ | ⟨_, _ | ⟨_, _⟩⟩ nil st:Stateprog':List Sinstrhs:[].length < 2⊢ sExecute st [] (sMinus :: prog') = sExecute st [] prog'cons.nil st:Stateprog':List Sinstrhead✝:Naths:[head✝].length < 2⊢ sExecute st [head✝] (sMinus :: prog') = sExecute st [head✝] prog'cons.cons st:Stateprog':List Sinstrhead✝¹:Nathead✝:Nattail✝:List Naths:(head✝¹ :: head✝ :: tail✝).length < 2⊢ sExecute st (head✝¹ :: head✝ :: tail✝) (sMinus :: prog') = sExecute st (head✝¹ :: head✝ :: tail✝) prog' <;> nil st:Stateprog':List Sinstrhs:[].length < 2⊢ sExecute st [] (sMinus :: prog') = sExecute st [] prog'cons.nil st:Stateprog':List Sinstrhead✝:Naths:[head✝].length < 2⊢ sExecute st [head✝] (sMinus :: prog') = sExecute st [head✝] prog'cons.cons st:Stateprog':List Sinstrhead✝¹:Nathead✝:Nattail✝:List Naths:(head✝¹ :: head✝ :: tail✝).length < 2⊢ sExecute st (head✝¹ :: head✝ :: tail✝) (sMinus :: prog') = sExecute st (head✝¹ :: head✝ :: tail✝) prog' trivial All goals completed! 🐙
@[simp] theorem sExecute_mult_bad (st : State) (stack : List Nat) (prog' : List Sinstr)
(hs : stack.length < 2) :
sExecute st stack (sMult :: prog') = sExecute st stack prog' := by st:Statestack:List Natprog':List Sinstrhs:stack.length < 2⊢ sExecute st stack (sMult :: prog') = sExecute st stack prog'
rcases stack with _ | ⟨_, _ | ⟨_, _⟩⟩ nil st:Stateprog':List Sinstrhs:[].length < 2⊢ sExecute st [] (sMult :: prog') = sExecute st [] prog'cons.nil st:Stateprog':List Sinstrhead✝:Naths:[head✝].length < 2⊢ sExecute st [head✝] (sMult :: prog') = sExecute st [head✝] prog'cons.cons st:Stateprog':List Sinstrhead✝¹:Nathead✝:Nattail✝:List Naths:(head✝¹ :: head✝ :: tail✝).length < 2⊢ sExecute st (head✝¹ :: head✝ :: tail✝) (sMult :: prog') = sExecute st (head✝¹ :: head✝ :: tail✝) prog' <;> nil st:Stateprog':List Sinstrhs:[].length < 2⊢ sExecute st [] (sMult :: prog') = sExecute st [] prog'cons.nil st:Stateprog':List Sinstrhead✝:Naths:[head✝].length < 2⊢ sExecute st [head✝] (sMult :: prog') = sExecute st [head✝] prog'cons.cons st:Stateprog':List Sinstrhead✝¹:Nathead✝:Nattail✝:List Naths:(head✝¹ :: head✝ :: tail✝).length < 2⊢ sExecute st (head✝¹ :: head✝ :: tail✝) (sMult :: prog') = sExecute st (head✝¹ :: head✝ :: tail✝) prog' trivial All goals completed! 🐙
theorem sExecute1 : sExecute ∅ [] [sPush 5, sPush 3, sPush 1, sMinus] = [2, 5] := by ⊢ sExecute ∅ [] [sPush 5, sPush 3, sPush 1, sMinus] = [2, 5]
solution!
rfl All goals completed! 🐙
theorem sExecute2 : sExecute {X ↦ 3} [3, 4] [sPush 4, sLoad X, sMult, sPlus] = [15, 4] := by ⊢ sExecute {X ↦ 3} [3, 4] [sPush 4, sLoad X, sMult, sPlus] = [15, 4]
solution!
rfl All goals completed! 🐙
Next, write a function that compiles an Aexp into a stack
machine program. The effect of running the program should be the
same as pushing the value of the expression on the stack.
def sCompile (a : Aexp) : List Sinstr :=
solution!(match a with
| .num n => [sPush n]
| .id x => [sLoad x]
| .plus a₁ a₂ => sCompile a₁ ++ sCompile a₂ ++ [sPlus]
| .minus a₁ a₂ => sCompile a₁ ++ sCompile a₂ ++ [sMinus]
| .mult a₁ a₂ => sCompile a₁ ++ sCompile a₂ ++ [sMult])
@[simp] theorem sCompile_num (n : Nat) : sCompile (.num n) = [sPush n] := rfl
@[simp] theorem sCompile_id (x : String) : sCompile (.id x) = [sLoad x] := rfl
@[simp] theorem sCompile_plus (a₁ a₂ : Aexp) :
sCompile (.plus a₁ a₂) = sCompile a₁ ++ sCompile a₂ ++ [sPlus] := rfl
@[simp] theorem sCompile_minus (a₁ a₂ : Aexp) :
sCompile (.minus a₁ a₂) = sCompile a₁ ++ sCompile a₂ ++ [sMinus] := rfl
@[simp] theorem sCompile_mult (a₁ a₂ : Aexp) :
sCompile (.mult a₁ a₂) = sCompile a₁ ++ sCompile a₂ ++ [sMult] := rfl
After you've defined sCompile, prove the following to test that it works.
theorem sCompile1 : sCompile (aexp { X - (2 * Y) }) = [sLoad X, sPush 2, sLoad Y, sMult, sMinus] := by ⊢ sCompile (aexp {X - 2 * Y}) = [sLoad X, sPush 2, sLoad Y, sMult, sMinus]
solution!
rfl All goals completed! 🐙
Execution can be decomposed in the following sense: executing
stack program p₁ ++ p₂ is the same as executing p₁, taking
the resulting stack, and executing p₂ from that stack. Prove
that fact.
theorem execute_app (st : State) (p₁ p₂ : List Sinstr) (stack : List Nat) :
sExecute st stack (p₁ ++ p₂) = sExecute st (sExecute st stack p₁) p₂ := by st:Statep₁:List Sinstrp₂:List Sinstrstack:List Nat⊢ sExecute st stack (p₁ ++ p₂) = sExecute st (sExecute st stack p₁) p₂
solution!
induction p₁ generalizing p₂ stack with
| nil => nil st:Statep₂:List Sinstrstack:List Nat⊢ sExecute st stack ([] ++ p₂) = sExecute st (sExecute st stack []) p₂ rfl All goals completed! 🐙
| cons a p' ih => cons st:Statea:Sinstrp':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Nat⊢ sExecute st stack (a :: p' ++ p₂) = sExecute st (sExecute st stack (a :: p')) p₂
cases a with
| sPush cons.sPush st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Natn✝:Nat⊢ sExecute st stack (sPush n✝ :: p' ++ p₂) = sExecute st (sExecute st stack (sPush n✝ :: p')) p₂ | sLoad cons.sLoad st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Natx✝:String⊢ sExecute st stack (sLoad x✝ :: p' ++ p₂) = sExecute st (sExecute st stack (sLoad x✝ :: p')) p₂ => cons.sLoad st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Natx✝:String⊢ sExecute st stack (sLoad x✝ :: p' ++ p₂) = sExecute st (sExecute st stack (sLoad x✝ :: p')) p₂cons.sPush st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Natn✝:Nat⊢ sExecute st stack (sPush n✝ :: p' ++ p₂) = sExecute st (sExecute st stack (sPush n✝ :: p')) p₂ simp_all All goals completed! 🐙
| sPlus cons.sPlus st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Nat⊢ sExecute st stack (sPlus :: p' ++ p₂) = sExecute st (sExecute st stack (sPlus :: p')) p₂ | sMinus cons.sMinus st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Nat⊢ sExecute st stack (sMinus :: p' ++ p₂) = sExecute st (sExecute st stack (sMinus :: p')) p₂ | sMult cons.sMult st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Nat⊢ sExecute st stack (sMult :: p' ++ p₂) = sExecute st (sExecute st stack (sMult :: p')) p₂ => cons.sMult st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Nat⊢ sExecute st stack (sMult :: p' ++ p₂) = sExecute st (sExecute st stack (sMult :: p')) p₂cons.sMinus st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Nat⊢ sExecute st stack (sMinus :: p' ++ p₂) = sExecute st (sExecute st stack (sMinus :: p')) p₂cons.sPlus st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Nat⊢ sExecute st stack (sPlus :: p' ++ p₂) = sExecute st (sExecute st stack (sPlus :: p')) p₂
if hs : stack.length < 2 then st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Naths:stack.length < 2⊢ sExecute st stack (sMult :: p' ++ p₂) = sExecute st (sExecute st stack (sMult :: p')) p₂
simp [hs, ih] All goals completed! 🐙
else st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrstack:List Naths:¬stack.length < 2⊢ sExecute st stack (sMult :: p' ++ p₂) = sExecute st (sExecute st stack (sMult :: p')) p₂
rcases stack with _ | ⟨_, _ | ⟨_, _⟩⟩ nil st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrhs:¬[].length < 2⊢ sExecute st [] (sMult :: p' ++ p₂) = sExecute st (sExecute st [] (sMult :: p')) p₂cons.nil st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrhead✝:Naths:¬[head✝].length < 2⊢ sExecute st [head✝] (sMult :: p' ++ p₂) = sExecute st (sExecute st [head✝] (sMult :: p')) p₂cons.cons st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrhead✝¹:Nathead✝:Nattail✝:List Naths:¬(head✝¹ :: head✝ :: tail✝).length < 2⊢ sExecute st (head✝¹ :: head✝ :: tail✝) (sMult :: p' ++ p₂) =
sExecute st (sExecute st (head✝¹ :: head✝ :: tail✝) (sMult :: p')) p₂ <;> nil st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrhs:¬[].length < 2⊢ sExecute st [] (sMult :: p' ++ p₂) = sExecute st (sExecute st [] (sMult :: p')) p₂cons.nil st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrhead✝:Naths:¬[head✝].length < 2⊢ sExecute st [head✝] (sMult :: p' ++ p₂) = sExecute st (sExecute st [head✝] (sMult :: p')) p₂cons.cons st:Statep':List Sinstrih:∀ (p₂ : List Sinstr) (stack : List Nat), sExecute st stack (p' ++ p₂) = sExecute st (sExecute st stack p') p₂p₂:List Sinstrhead✝¹:Nathead✝:Nattail✝:List Naths:¬(head✝¹ :: head✝ :: tail✝).length < 2⊢ sExecute st (head✝¹ :: head✝ :: tail✝) (sMult :: p' ++ p₂) =
sExecute st (sExecute st (head✝¹ :: head✝ :: tail✝) (sMult :: p')) p₂ simp_all All goals completed! 🐙
Now we'll prove the correctness of the compiler implemented in the
previous exercise. Begin by proving the following lemma. If it
becomes difficult, consider whether your implementation of
sExecute or sCompile could be simplified.
theorem sCompile_correct_aux (st : State) (a : Aexp) (stack : List Nat) :
sExecute st stack (sCompile a) = Aexp.eval st a :: stack := by st:Statea:Aexpstack:List Nat⊢ sExecute st stack (sCompile a) = Aexp.eval st a :: stack
solution!
induction a generalizing st stack with (simp_all [List.append_assoc, execute_app] All goals completed! 🐙 <;> rfl)
The main theorem should be a very easy corollary of that lemma.
theorem sCompile_correct (st : State) (a : Aexp) :
sExecute st [] (sCompile a) = [Aexp.eval st a] := by st:Statea:Aexp⊢ sExecute st [] (sCompile a) = [Aexp.eval st a]
solution!
exact sCompile_correct_aux st a [] All goals completed! 🐙
end StackCompiler
Most modern programming languages use a "short-circuit" evaluation
rule for boolean and: to evaluate Bexp.and b₁ b₂, first evaluate
b₁. If it evaluates to false, then the entire and
expression evaluates to false immediately, without evaluating
b₂. Otherwise, b₂ is evaluated to determine the result of the
and expression.
Write an alternate version of Bexp.eval that performs short-circuit
evaluation of Bexp.and in this manner, and prove that it is
equivalent to Bexp.eval. (N.b. This is only true because expression
evaluation in Imp is rather simple. In a bigger language where
evaluating an expression might diverge, the short-circuiting and
would not be equivalent to the original, since it would make more
programs terminate.)
def Bexp.evalSC (st : State) (b : Bexp) : Bool := solution!(
match b with
| .bool b => b
| .eq a₁ a₂ => a₁.eval st == a₂.eval st
| .neq a₁ a₂ => a₁.eval st != a₂.eval st
| .le a₁ a₂ => decide (a₁.eval st ≤ a₂.eval st)
| .gt a₁ a₂ => decide (a₁.eval st > a₂.eval st)
| .not b₁ => !b₁.evalSC st
| .and b₁ b₂ => match (b₁.evalSC st) with
| false => false
| true => b₂.evalSC st)
@[simp] theorem Bexp.evalSC_bool (st : State) (b : Bool) : (bool b).evalSC st = b := rfl
@[simp] theorem Bexp.evalSC_eq (st : State) (a₁ a₂ : Aexp) :
(eq a₁ a₂).evalSC st = (a₁.eval st == a₂.eval st) := rfl
@[simp] theorem Bexp.evalSC_neq (st : State) (a₁ a₂ : Aexp) :
(neq a₁ a₂).evalSC st = (a₁.eval st != a₂.eval st) := rfl
@[simp] theorem Bexp.evalSC_le (st : State) (a₁ a₂ : Aexp) :
(le a₁ a₂).evalSC st = decide (a₁.eval st ≤ a₂.eval st) := rfl
@[simp] theorem Bexp.evalSC_gt (st : State) (a₁ a₂ : Aexp) :
(gt a₁ a₂).evalSC st = decide (a₁.eval st > a₂.eval st) := rfl
@[simp] theorem Bexp.evalSC_not (st : State) (b : Bexp) :
(not b).evalSC st = !b.evalSC st := rfl
@[simp] theorem Bexp.evalSC_and (st : State) (b₁ b₂ : Bexp) :
(and b₁ b₂).evalSC st =
match b₁.evalSC st with
| false => false
| true => b₂.evalSC st := rfl
theorem Bexp.eval_eq_evalSC (st : State) (b : Bexp) :
b.eval st = b.evalSC st := by st:Stateb:Bexp⊢ eval st b = evalSC st b
solution!
induction b bool st:Stateb✝:Bool⊢ eval st (bool b✝) = evalSC st (bool b✝)eq st:Statea₁✝:Aexpa₂✝:Aexp⊢ eval st (bexp {~a₁✝ = ~a₂✝}) = evalSC st (bexp {~a₁✝ = ~a₂✝})neq st:Statea₁✝:Aexpa₂✝:Aexp⊢ eval st (bexp {~a₁✝ ≠ ~a₂✝}) = evalSC st (bexp {~a₁✝ ≠ ~a₂✝})le st:Statea₁✝:Aexpa₂✝:Aexp⊢ eval st (bexp {~a₁✝ ≤ ~a₂✝}) = evalSC st (bexp {~a₁✝ ≤ ~a₂✝})gt st:Statea₁✝:Aexpa₂✝:Aexp⊢ eval st (bexp {~a₁✝ > ~a₂✝}) = evalSC st (bexp {~a₁✝ > ~a₂✝})not st:Stateb✝:Bexpb_ih✝:eval st b✝ = evalSC st b✝⊢ eval st (bexp {¬ ~b✝}) = evalSC st (bexp {¬ ~b✝})and st:Stateb₁✝:Bexpb₂✝:Bexpb₁_ih✝:eval st b₁✝ = evalSC st b₁✝b₂_ih✝:eval st b₂✝ = evalSC st b₂✝⊢ eval st (bexp {~b₁✝ ∧ ~b₂✝}) = evalSC st (bexp {~b₁✝ ∧ ~b₂✝}) <;> bool st:Stateb✝:Bool⊢ eval st (bool b✝) = evalSC st (bool b✝)eq st:Statea₁✝:Aexpa₂✝:Aexp⊢ eval st (bexp {~a₁✝ = ~a₂✝}) = evalSC st (bexp {~a₁✝ = ~a₂✝})neq st:Statea₁✝:Aexpa₂✝:Aexp⊢ eval st (bexp {~a₁✝ ≠ ~a₂✝}) = evalSC st (bexp {~a₁✝ ≠ ~a₂✝})le st:Statea₁✝:Aexpa₂✝:Aexp⊢ eval st (bexp {~a₁✝ ≤ ~a₂✝}) = evalSC st (bexp {~a₁✝ ≤ ~a₂✝})gt st:Statea₁✝:Aexpa₂✝:Aexp⊢ eval st (bexp {~a₁✝ > ~a₂✝}) = evalSC st (bexp {~a₁✝ > ~a₂✝})not st:Stateb✝:Bexpb_ih✝:eval st b✝ = evalSC st b✝⊢ eval st (bexp {¬ ~b✝}) = evalSC st (bexp {¬ ~b✝})and st:Stateb₁✝:Bexpb₂✝:Bexpb₁_ih✝:eval st b₁✝ = evalSC st b₁✝b₂_ih✝:eval st b₂✝ = evalSC st b₂✝⊢ eval st (bexp {~b₁✝ ∧ ~b₂✝}) = evalSC st (bexp {~b₁✝ ∧ ~b₂✝}) simp_all and st:Stateb₁✝:Bexpb₂✝:Bexpb₁_ih✝:eval st b₁✝ = evalSC st b₁✝b₂_ih✝:eval st b₂✝ = evalSC st b₂✝⊢ (evalSC st b₁✝ && evalSC st b₂✝) =
match evalSC st b₁✝ with
| false => false
| true => evalSC st b₂✝ <;> and st:Stateb₁✝:Bexpb₂✝:Bexpb₁_ih✝:eval st b₁✝ = evalSC st b₁✝b₂_ih✝:eval st b₂✝ = evalSC st b₂✝⊢ (evalSC st b₁✝ && evalSC st b₂✝) =
match evalSC st b₁✝ with
| false => false
| true => evalSC st b₂✝ lia All goals completed! 🐙
Imperative languages like C and Java often include a break or
similar statement for interrupting the execution of loops. In this
exercise we consider how to add break to Imp. First, we need to
enrich the language of commands with an additional case. Because break
is a reserved keyword in Lean, we will abbreviate it as brk.
namespace Imp.Break
inductive Com where
| skip
| brk -- <--- NEW
| asgn (x : Ident) (a : Aexp)
| seq (c₁ c₂ : Com)
| cond (b : Bexp) (c₁ c₂ : Com)
| whileDo (b : Bexp) (c : Com)
Notation encoding: commands, macro rules
namespace Com
open Lean
scoped macro_rules
| `(imp { $s }) => do
let stx ← match s with
| `(imp_com| skip) => ``(Com.skip)
| `(imp_com| brk) => ``(Com.brk)
| `(imp_com| $x:ident) => ``(($x : Com))
| `(imp_com| $c₁ ; $c₂) =>
``(Com.seq (imp {$c₁}) (imp {$c₂}))
| `(imp_com| $x:ident := $a) =>
``(Com.asgn $x (aexp {$a}))
| `(imp_com| if ($b) {$c₁} else {$c₂}) =>
``(Com.cond (bexp {$b}) (imp {$c₁}) (imp {$c₂}))
| `(imp_com| while ($b) {$c}) =>
``(Com.whileDo (bexp {$b}) (imp {$c}))
| `(imp_com| ~$c) => `(($c : Com))
| _ => Macro.throwUnsupported
return Imp.Elab.withSourceInfoOf s stx
end Com
open scoped Com
namespace Delab
open Lean PrettyPrinter Imp.Delab
@[app_unexpander Com.brk]
private def unexpandComBrk : Unexpander
| _ => `(imp { $(mkIdent `brk):ident })
attribute [app_unexpander Com.skip] unexpandComSkip
attribute [app_unexpander Com.asgn] unexpandComAsgn
attribute [app_unexpander Com.seq] unexpandComSeq
attribute [app_unexpander Com.cond] unexpandComCond
attribute [app_unexpander Com.whileDo] unexpandComWhileDo
end Delab
/-- info: imp {brk} : Com -/
#guard_msgs in
#check imp {brk}
Next, we need to define the behavior of brk. Informally,
whenever brk is executed in a sequence of commands, it stops
the execution of that sequence and signals that the innermost
enclosing loop should terminate. (If there aren't any
enclosing loops, then the whole program simply terminates.) The
final state should be the same as the one in which the brk
statement was executed.
One important point is what to do when there are multiple loops
enclosing a given brk. In those cases, brk should only
terminate the innermost loop. Thus, after executing the
following...
X := 0;
Y := 1;
while (0 ≠ Y) {
while (true) {
brk
};
X := 1;
Y := Y - 1
}
... the value of X should be 1, and not 0.
One way of expressing this behavior is to add another parameter to
the evaluation relation that specifies whether evaluation of a
command executes a brk statement:
inductive Result : Type where
| sContinue
| sBreak
open Result
We will use the syntax st =[ c ]=> st' // s to mean that, if c is started in
state st, then it terminates in state st' and either signals
that the innermost surrounding loop (or the whole program) should
exit immediately (s = sBreak) or that execution should continue
normally (s = sContinue).
The definition of the st =[ c ]=> st' // s relation is very
similar to the one we gave above for the regular evaluation
relation (st =[ c ]=> st') -- we just need to handle the
termination signals appropriately:
-
If the command is
skip, then the state doesn't change and execution of any enclosing loop can continue normally. -
If the command is
brk, the state stays unchanged but we signal asBreak. -
If the command is an assignment, then we update the binding for that variable in the state accordingly and signal that execution can continue normally.
-
If the command is of the form
if (b) {c₁} else {c₂}, then the state is updated as in the original semantics of Imp, except that we also propagate the signal from the execution of whichever branch was taken. -
If the command is a sequence
c₁ ; c₂, we first executec₁. If this yields asBreak, we skip the execution ofc₂and propagate thesBreaksignal to the surrounding context; the resulting state is the same as the one obtained by executingc₁alone. Otherwise, we executec₂on the state obtained after executingc₁, and propagate the signal generated there. -
Finally, for a loop of the form
while (b) {c}, the semantics is almost the same as before. The only difference is that, whenbevaluates totrue, we executecand check the signal that it raises. If that signal issContinue, then the execution proceeds as in the original semantics. Otherwise, we stop the execution of the loop, and the resulting state is the same as the one resulting from the execution of the current iteration. In either case, sincebrkonly terminates the innermost loop,whilesignalssContinue.
Based on the above description, complete the definition of the
Com.EvalR relation:
inductive Com.EvalR : Com → State → State → Result → Prop where
| skip {st : State} : EvalR (imp {skip}) st st sContinue
| brk {st : State} : EvalR (imp {brk}) st st sBreak
| asgn {st : State} {a : Aexp} {n : Nat} {x : Ident} (h : a.eval st = n) :
EvalR (imp {x := a}) st (x →ₜ n ; st) sContinue
| seqContinue {c₁ c₂ : Com} {st st' st'' : State} {s : Result}
(h₁ : EvalR c₁ st st' sContinue)
(h₂ : EvalR c₂ st' st'' s) :
EvalR (imp {c₁; c₂}) st st'' s
| seqBreak {c₁ c₂ : Com} {st st' : State} (h : EvalR c₁ st st' sBreak) :
EvalR (imp {c₁; c₂}) st st' sBreak
| ifTrue {st st' : State} {b : Bexp} {c₁ c₂ : Com} {s : Result} (hb : b.eval st = true)
(hc : EvalR c₁ st st' s) :
EvalR (imp {if (b) {c₁} else {c₂}}) st st' s
| ifFalse {st st' : State} {b : Bexp} {c₁ c₂ : Com} {s : Result} (hb : b.eval st = false)
(hc : EvalR c₂ st st' s) :
EvalR (imp {if (b) {c₁} else {c₂}}) st st' s
| whileFalse {b : Bexp} {st : State} {c : Com} (hb : b.eval st = false) :
EvalR (imp {while (b) {c}}) st st sContinue
| whileContinue {st st' st'' : State} {b : Bexp} {c : Com} (hb : b.eval st = true)
(hc : EvalR c st st' sContinue)
(hloop : EvalR (imp {while (b) {c}}) st' st'' sContinue) :
EvalR (imp {while (b) {c}}) st st'' sContinue
| whileBreak {st st' : State} {b : Bexp} {c : Com} (hb : b.eval st = true)
(hc : EvalR c st st' sBreak) :
EvalR (imp {while (b) {c}}) st st' sContinue
scoped notation:40 st0:41 " =[ " c " ]=> " st1:41 " // " s:41 => Com.EvalR c st0 st1 s
Now prove the following properties of your definition:
theorem break_ignore {c : Com} (st st' : State) {s : Result}
(h : st =[ imp { brk ; c } ]=> st' // s) :
st = st' := by c:Comst:Statest':States:Resulth:st =[ imp {brk; ~c} ]=> st' // s⊢ st = st'
solution!
inversion h with
| seqContinue st'' h₁ h₂ =>
inversion h₁ All goals completed! 🐙
| seqBreak h =>
inversion h brk c:Comst:State⊢ st = st
rfl All goals completed! 🐙
theorem while_continue {b : Bexp} {c : Com} {st st' : State} {s : Result}
(h : st =[ imp { while (b) {c} } ]=> st' // s) :
s = sContinue := by b:Bexpc:Comst:Statest':States:Resulth:st =[ imp {while (~b) {~c}} ]=> st' // s⊢ s = sContinue
solution!
inversion h whileFalse b:Bexpc:Comst:Statehb✝:Bexp.eval st b = false⊢ sContinue = sContinuewhileContinue b:Bexpc:Comst:Statest':Statest'✝:Statehb✝:Bexp.eval st b = truehc✝:st =[ c ]=> st'✝ // sContinuehloop✝:st'✝ =[ imp {while (~b) {~c}} ]=> st' // sContinue⊢ sContinue = sContinuewhileBreak b:Bexpc:Comst:Statest':Statehb✝:Bexp.eval st b = truehc✝:st =[ c ]=> st' // sBreak⊢ sContinue = sContinue <;> whileFalse b:Bexpc:Comst:Statehb✝:Bexp.eval st b = false⊢ sContinue = sContinuewhileContinue b:Bexpc:Comst:Statest':Statest'✝:Statehb✝:Bexp.eval st b = truehc✝:st =[ c ]=> st'✝ // sContinuehloop✝:st'✝ =[ imp {while (~b) {~c}} ]=> st' // sContinue⊢ sContinue = sContinuewhileBreak b:Bexpc:Comst:Statest':Statehb✝:Bexp.eval st b = truehc✝:st =[ c ]=> st' // sBreak⊢ sContinue = sContinue rfl All goals completed! 🐙
theorem while_stops_on_break {b : Bexp} {c : Com} {st st' : State}
(h₁ : b.eval st = true)
(h₂ : st =[ imp { ~c } ]=> st' // sBreak) :
st =[ imp { while (~b) {~c} } ]=> st' // sContinue := by b:Bexpc:Comst:Statest':Stateh₁:Bexp.eval st b = trueh₂:st =[ c ]=> st' // sBreak⊢ st =[ imp {while (~b) {~c}} ]=> st' // sContinue
solution!
exact .whileBreak h₁ h₂ All goals completed! 🐙
theorem seq_continue {c₁ c₂ : Com} {st st' st'' : State}
(h₁ : st =[ imp { c₁ } ]=> st' // sContinue)
(h₂ : st' =[ imp { c₂ } ]=> st'' // sContinue) :
st =[ imp { c₁ ; c₂ } ]=> st'' // sContinue := by c₁:Comc₂:Comst:Statest':Statest'':Stateh₁:st =[ c₁ ]=> st' // sContinueh₂:st' =[ c₂ ]=> st'' // sContinue⊢ st =[ imp {~c₁; ~c₂} ]=> st'' // sContinue
solution!
exact .seqContinue h₁ h₂ All goals completed! 🐙
theorem seq_stops_on_break {c₁ c₂ : Com} {st st' : State}
(h : st =[ imp { c₁ } ]=> st' // sBreak) :
st =[ imp { c₁ ; c₂ } ]=> st' // sBreak := by c₁:Comc₂:Comst:Statest':Stateh:st =[ c₁ ]=> st' // sBreak⊢ st =[ imp {~c₁; ~c₂} ]=> st' // sBreak
solution!
exact .seqBreak h All goals completed! 🐙
Prove that if the condition of a while loop is true after it terminates, then the inner command must have breaked.
theorem while_break_true {b : Bexp} {c : Com} {st st' : State}
(h₁ : st =[ imp { while (b) {c} } ]=> st' // sContinue)
(h₂ : b.eval st' = true) :
∃ st'', st'' =[ imp { c } ]=> st' // sBreak := by b:Bexpc:Comst:Statest':Stateh₁:st =[ imp {while (~b) {~c}} ]=> st' // sContinueh₂:Bexp.eval st' b = true⊢ ∃ st'', st'' =[ c ]=> st' // sBreak
solution!
generalize heq : (imp {while (b) {c}}) = c' at h₁ b:Bexpc:Comst:Statest':Stateh₂:Bexp.eval st' b = truec':Comheq:imp {while (~b) {~c}} = c'h₁:st =[ c' ]=> st' // sContinue⊢ ∃ st'', st'' =[ c ]=> st' // sBreak
generalize hr : sContinue = s at h₁ ⊢ b:Bexpc:Comst:Statest':Stateh₂:Bexp.eval st' b = truec':Comheq:imp {while (~b) {~c}} = c's:Resulthr:sContinue = sh₁:st =[ c' ]=> st' // s⊢ ∃ st'', st'' =[ c ]=> st' // sBreak
induction h₁ with (inversion heq refl b:Bexpc:Comst:Statest':Statec':Coms:Resultst✝:Stateh₂:Bexp.eval st✝ b = truehr:sContinue = sContinuehb✝:Bexp.eval st✝ b = false⊢ ∃ st'', st'' =[ c ]=> st✝ // sBreak; try lia All goals completed! 🐙)
| whileContinue _ _ _ _ ih₂ => refl b:Bexpc:Comst:Statest':Statec':Coms:Resultst✝:Statest'✝:Statest''✝:Stateh₂:Bexp.eval st''✝ b = truehr:sContinue = sContinuehb✝:Bexp.eval st✝ b = truehc✝:st✝ =[ c ]=> st'✝ // sContinuehc_ih✝:Bexp.eval st'✝ b = true → imp {while (~b) {~c}} = c → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st'✝ // sBreakhloop✝:st'✝ =[ imp {while (~b) {~c}} ]=> st''✝ // sContinueih₂:Bexp.eval st''✝ b = true →
imp {while (~b) {~c}} = imp {while (~b) {~c}} → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st''✝ // sBreak⊢ ∃ st'', st'' =[ c ]=> st''✝ // sBreak
apply ih₂ refl.h₂ b:Bexpc:Comst:Statest':Statec':Coms:Resultst✝:Statest'✝:Statest''✝:Stateh₂:Bexp.eval st''✝ b = truehr:sContinue = sContinuehb✝:Bexp.eval st✝ b = truehc✝:st✝ =[ c ]=> st'✝ // sContinuehc_ih✝:Bexp.eval st'✝ b = true → imp {while (~b) {~c}} = c → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st'✝ // sBreakhloop✝:st'✝ =[ imp {while (~b) {~c}} ]=> st''✝ // sContinueih₂:Bexp.eval st''✝ b = true →
imp {while (~b) {~c}} = imp {while (~b) {~c}} → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st''✝ // sBreak⊢ Bexp.eval st''✝ b = truerefl.heq b:Bexpc:Comst:Statest':Statec':Coms:Resultst✝:Statest'✝:Statest''✝:Stateh₂:Bexp.eval st''✝ b = truehr:sContinue = sContinuehb✝:Bexp.eval st✝ b = truehc✝:st✝ =[ c ]=> st'✝ // sContinuehc_ih✝:Bexp.eval st'✝ b = true → imp {while (~b) {~c}} = c → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st'✝ // sBreakhloop✝:st'✝ =[ imp {while (~b) {~c}} ]=> st''✝ // sContinueih₂:Bexp.eval st''✝ b = true →
imp {while (~b) {~c}} = imp {while (~b) {~c}} → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st''✝ // sBreak⊢ imp {while (~b) {~c}} = imp {while (~b) {~c}}refl.hr b:Bexpc:Comst:Statest':Statec':Coms:Resultst✝:Statest'✝:Statest''✝:Stateh₂:Bexp.eval st''✝ b = truehr:sContinue = sContinuehb✝:Bexp.eval st✝ b = truehc✝:st✝ =[ c ]=> st'✝ // sContinuehc_ih✝:Bexp.eval st'✝ b = true → imp {while (~b) {~c}} = c → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st'✝ // sBreakhloop✝:st'✝ =[ imp {while (~b) {~c}} ]=> st''✝ // sContinueih₂:Bexp.eval st''✝ b = true →
imp {while (~b) {~c}} = imp {while (~b) {~c}} → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st''✝ // sBreak⊢ sContinue = sContinue <;> refl.h₂ b:Bexpc:Comst:Statest':Statec':Coms:Resultst✝:Statest'✝:Statest''✝:Stateh₂:Bexp.eval st''✝ b = truehr:sContinue = sContinuehb✝:Bexp.eval st✝ b = truehc✝:st✝ =[ c ]=> st'✝ // sContinuehc_ih✝:Bexp.eval st'✝ b = true → imp {while (~b) {~c}} = c → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st'✝ // sBreakhloop✝:st'✝ =[ imp {while (~b) {~c}} ]=> st''✝ // sContinueih₂:Bexp.eval st''✝ b = true →
imp {while (~b) {~c}} = imp {while (~b) {~c}} → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st''✝ // sBreak⊢ Bexp.eval st''✝ b = truerefl.heq b:Bexpc:Comst:Statest':Statec':Coms:Resultst✝:Statest'✝:Statest''✝:Stateh₂:Bexp.eval st''✝ b = truehr:sContinue = sContinuehb✝:Bexp.eval st✝ b = truehc✝:st✝ =[ c ]=> st'✝ // sContinuehc_ih✝:Bexp.eval st'✝ b = true → imp {while (~b) {~c}} = c → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st'✝ // sBreakhloop✝:st'✝ =[ imp {while (~b) {~c}} ]=> st''✝ // sContinueih₂:Bexp.eval st''✝ b = true →
imp {while (~b) {~c}} = imp {while (~b) {~c}} → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st''✝ // sBreak⊢ imp {while (~b) {~c}} = imp {while (~b) {~c}}refl.hr b:Bexpc:Comst:Statest':Statec':Coms:Resultst✝:Statest'✝:Statest''✝:Stateh₂:Bexp.eval st''✝ b = truehr:sContinue = sContinuehb✝:Bexp.eval st✝ b = truehc✝:st✝ =[ c ]=> st'✝ // sContinuehc_ih✝:Bexp.eval st'✝ b = true → imp {while (~b) {~c}} = c → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st'✝ // sBreakhloop✝:st'✝ =[ imp {while (~b) {~c}} ]=> st''✝ // sContinueih₂:Bexp.eval st''✝ b = true →
imp {while (~b) {~c}} = imp {while (~b) {~c}} → sContinue = sContinue → ∃ st'', st'' =[ c ]=> st''✝ // sBreak⊢ sContinue = sContinue try lia All goals completed! 🐙
| @whileBreak st => refl b:Bexpc:Comst✝:Statest':Statec':Coms:Resultst:Statest'✝:Stateh₂:Bexp.eval st'✝ b = truehr:sContinue = sContinuehb✝:Bexp.eval st b = truehc✝:st =[ c ]=> st'✝ // sBreakhc_ih✝:Bexp.eval st'✝ b = true → imp {while (~b) {~c}} = c → sContinue = sBreak → ∃ st'', st'' =[ c ]=> st'✝ // sBreak⊢ ∃ st'', st'' =[ c ]=> st'✝ // sBreak
exists st All goals completed! 🐙
Prove that your defined relation is deterministic.
theorem ceval_deterministic {c : Com} {st st₁ st₂ : State} {s₁ s₂ : Result}
(h₁ : st =[ imp { c } ]=> st₁ // s₁)
(h₂ : st =[ imp { c } ]=> st₂ // s₂) :
st₁ = st₂ ∧ s₁ = s₂ := by c:Comst:Statest₁:Statest₂:States₁:Results₂:Resulth₁:st =[ c ]=> st₁ // s₁h₂:st =[ c ]=> st₂ // s₂⊢ st₁ = st₂ ∧ s₁ = s₂
solution!
induction h₁ generalizing st₂ s₂ with (try (inversion h₂ whileFalse c:Comst:Statest₁:States₁:Resultb✝:Bexpst✝:Statec✝:Comhb✝¹:Bexp.eval st✝ b✝ = falsehb✝:Bexp.eval st✝ b✝ = false⊢ st✝ = st✝ ∧ sContinue = sContinuewhileContinue c:Comst:Statest₁:States₁:Resultb✝:Bexpst✝:Statec✝:Comhb✝¹:Bexp.eval st✝ b✝ = falsest₂:Statest'✝:Statehb✝:Bexp.eval st✝ b✝ = truehc✝:st✝ =[ c✝ ]=> st'✝ // sContinuehloop✝:st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // sContinue⊢ st✝ = st₂ ∧ sContinue = sContinuewhileBreak c:Comst:Statest₁:States₁:Resultb✝:Bexpst✝:Statec✝:Comhb✝¹:Bexp.eval st✝ b✝ = falsest₂:Statehb✝:Bexp.eval st✝ b✝ = truehc✝:st✝ =[ c✝ ]=> st₂ // sBreak⊢ st✝ = st₂ ∧ sContinue = sContinue <;> whileFalse c:Comst:Statest₁:States₁:Resultb✝:Bexpst✝:Statec✝:Comhb✝¹:Bexp.eval st✝ b✝ = falsehb✝:Bexp.eval st✝ b✝ = false⊢ st✝ = st✝ ∧ sContinue = sContinuewhileContinue c:Comst:Statest₁:States₁:Resultb✝:Bexpst✝:Statec✝:Comhb✝¹:Bexp.eval st✝ b✝ = falsest₂:Statest'✝:Statehb✝:Bexp.eval st✝ b✝ = truehc✝:st✝ =[ c✝ ]=> st'✝ // sContinuehloop✝:st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // sContinue⊢ st✝ = st₂ ∧ sContinue = sContinuewhileBreak c:Comst:Statest₁:States₁:Resultb✝:Bexpst✝:Statec✝:Comhb✝¹:Bexp.eval st✝ b✝ = falsest₂:Statehb✝:Bexp.eval st✝ b✝ = truehc✝:st✝ =[ c✝ ]=> st₂ // sBreak⊢ st✝ = st₂ ∧ sContinue = sContinue lia All goals completed! 🐙))
| seqContinue h₁' h₂' ih₁ ih₂ => seqContinue c:Comst:Statest₁:States₁:Resultc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:States✝:Resulth₁':st✝ =[ c₁✝ ]=> st'✝ // sContinueh₂':st'✝ =[ c₂✝ ]=> st''✝ // s✝ih₁:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c₁✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sContinue = s₂ih₂:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ c₂✝ ]=> st₂ // s₂ → st''✝ = st₂ ∧ s✝ = s₂st₂:States₂:Resulth₂:st✝ =[ imp {~c₁✝; ~c₂✝} ]=> st₂ // s₂⊢ st''✝ = st₂ ∧ s✝ = s₂
inversion h₂ with
| seqContinue h₁ h₂ =>
obtain ⟨eq₁, _⟩ := ih₁ h₁ seqContinue c:Comst:Statest₁:States₁:Resultc₁✝:Comc₂✝:Comst✝:Statest'✝¹:Statest''✝:States✝:Resulth₁':st✝ =[ c₁✝ ]=> st'✝ // sContinueh₂':st'✝ =[ c₂✝ ]=> st''✝ // s✝ih₁:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c₁✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sContinue = s₂ih₂:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ c₂✝ ]=> st₂ // s₂ → st''✝ = st₂ ∧ s✝ = s₂st₂:States₂:Resultst'✝:Stateh₁:st✝ =[ c₁✝ ]=> st'✝ // sContinueh₂:st'✝ =[ c₂✝ ]=> st₂ // s₂eq₁:st'✝¹ = st'✝right✝:sContinue = sContinue⊢ st''✝ = st₂ ∧ s✝ = s₂
inversion eq₁ refl c:Comst:Statest₁:States₁:Resultc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:States✝:Resulth₁':st✝ =[ c₁✝ ]=> st'✝ // sContinueh₂':st'✝ =[ c₂✝ ]=> st''✝ // s✝ih₁:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c₁✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sContinue = s₂ih₂:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ c₂✝ ]=> st₂ // s₂ → st''✝ = st₂ ∧ s✝ = s₂st₂:States₂:Resultright✝:sContinue = sContinueh₁:st✝ =[ c₁✝ ]=> st'✝ // sContinueh₂:st'✝ =[ c₂✝ ]=> st₂ // s₂⊢ st''✝ = st₂ ∧ s✝ = s₂
apply ih₂ refl c:Comst:Statest₁:States₁:Resultc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:States✝:Resulth₁':st✝ =[ c₁✝ ]=> st'✝ // sContinueh₂':st'✝ =[ c₂✝ ]=> st''✝ // s✝ih₁:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c₁✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sContinue = s₂ih₂:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ c₂✝ ]=> st₂ // s₂ → st''✝ = st₂ ∧ s✝ = s₂st₂:States₂:Resultright✝:sContinue = sContinueh₁:st✝ =[ c₁✝ ]=> st'✝ // sContinueh₂:st'✝ =[ c₂✝ ]=> st₂ // s₂⊢ st'✝ =[ c₂✝ ]=> st₂ // s₂
assumption All goals completed! 🐙
| seqBreak h =>
specialize ih₁ h seqBreak c:Comst:Statest₁:States₁:Resultc₁✝:Comc₂✝:Comst✝:Statest'✝:Statest''✝:States✝:Resulth₁':st✝ =[ c₁✝ ]=> st'✝ // sContinueh₂':st'✝ =[ c₂✝ ]=> st''✝ // s✝ih₂:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ c₂✝ ]=> st₂ // s₂ → st''✝ = st₂ ∧ s✝ = s₂st₂:Stateih₁:st'✝ = st₂ ∧ sContinue = sBreakh:st✝ =[ c₁✝ ]=> st₂ // sBreak⊢ st''✝ = st₂ ∧ s✝ = sBreak
lia All goals completed! 🐙
| seqBreak _ ih => seqBreak c:Comst:Statest₁:States₁:Resultc₁✝:Comc₂✝:Comst✝:Statest'✝:Stateh✝:st✝ =[ c₁✝ ]=> st'✝ // sBreakih:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c₁✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sBreak = s₂st₂:States₂:Resulth₂:st✝ =[ imp {~c₁✝; ~c₂✝} ]=> st₂ // s₂⊢ st'✝ = st₂ ∧ sBreak = s₂
inversion h₂ with
| seqContinue h₁ _ =>
specialize ih h₁ seqContinue c:Comst:Statest₁:States₁:Resultc₁✝:Comc₂✝:Comst✝:Statest'✝¹:Stateh✝:st✝ =[ c₁✝ ]=> st'✝ // sBreakst₂:States₂:Resultst'✝:Stateih:st'✝¹ = st'✝ ∧ sBreak = sContinueh₁:st✝ =[ c₁✝ ]=> st'✝ // sContinueh₂✝:st'✝ =[ c₂✝ ]=> st₂ // s₂⊢ st'✝ = st₂ ∧ sBreak = s₂
lia All goals completed! 🐙
| seqBreak =>
apply ih seqBreak c:Comst:Statest₁:States₁:Resultc₁✝:Comc₂✝:Comst✝:Statest'✝:Stateh✝¹:st✝ =[ c₁✝ ]=> st'✝ // sBreakih:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c₁✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sBreak = s₂st₂:Stateh✝:st✝ =[ c₁✝ ]=> st₂ // sBreak⊢ st✝ =[ c₁✝ ]=> st₂ // sBreak
assumption All goals completed! 🐙
| ifTrue _ _ ih => ifTrue c:Comst:Statest₁:States₁:Resultst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Coms✝:Resulthb✝:Bexp.eval st✝ b✝ = truehc✝:st✝ =[ c₁✝ ]=> st'✝ // s✝ih:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c₁✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ s✝ = s₂st₂:States₂:Resulth₂:st✝ =[ imp {if (~b✝) {~c₁✝} else {~c₂✝}} ]=> st₂ // s₂⊢ st'✝ = st₂ ∧ s✝ = s₂
inversion h₂ with
| ifTrue _ hc' => exact ih hc' All goals completed! 🐙
| ifFalse => lia All goals completed! 🐙
| ifFalse _ _ ih => ifFalse c:Comst:Statest₁:States₁:Resultst✝:Statest'✝:Stateb✝:Bexpc₁✝:Comc₂✝:Coms✝:Resulthb✝:Bexp.eval st✝ b✝ = falsehc✝:st✝ =[ c₂✝ ]=> st'✝ // s✝ih:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c₂✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ s✝ = s₂st₂:States₂:Resulth₂:st✝ =[ imp {if (~b✝) {~c₁✝} else {~c₂✝}} ]=> st₂ // s₂⊢ st'✝ = st₂ ∧ s✝ = s₂
inversion h₂ with
| ifTrue => lia All goals completed! 🐙
| ifFalse _ hc' => exact ih hc' All goals completed! 🐙
| whileContinue hb hc hloop ihc ihloop => whileContinue c:Comst:Statest₁:States₁:Resultst✝:Statest'✝:Statest''✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:st✝ =[ c✝ ]=> st'✝ // sContinuehloop:st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st''✝ // sContinueihc:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sContinue = s₂ihloop:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // s₂ → st''✝ = st₂ ∧ sContinue = s₂st₂:States₂:Resulth₂:st✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // s₂⊢ st''✝ = st₂ ∧ sContinue = s₂
inversion h₂ with
| whileFalse => lia All goals completed! 🐙
| whileBreak hb' hc' =>
specialize ihc hc' whileBreak c:Comst:Statest₁:States₁:Resultst✝:Statest'✝:Statest''✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:st✝ =[ c✝ ]=> st'✝ // sContinuehloop:st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st''✝ // sContinueihloop:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // s₂ → st''✝ = st₂ ∧ sContinue = s₂st₂:Stateihc:st'✝ = st₂ ∧ sContinue = sBreakhb':Bexp.eval st✝ b✝ = truehc':st✝ =[ c✝ ]=> st₂ // sBreak⊢ st''✝ = st₂ ∧ sContinue = sContinue
lia All goals completed! 🐙
| whileContinue hb' hc' hloop' =>
obtain ⟨eq₁, _⟩ := ihc hc' whileContinue c:Comst:Statest₁:States₁:Resultst✝:Statest'✝¹:Statest''✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:st✝ =[ c✝ ]=> st'✝ // sContinuehloop:st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st''✝ // sContinueihc:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sContinue = s₂ihloop:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // s₂ → st''✝ = st₂ ∧ sContinue = s₂st₂:Statest'✝:Statehb':Bexp.eval st✝ b✝ = truehc':st✝ =[ c✝ ]=> st'✝ // sContinuehloop':st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // sContinueeq₁:st'✝¹ = st'✝right✝:sContinue = sContinue⊢ st''✝ = st₂ ∧ sContinue = sContinue
inversion eq₁ refl c:Comst:Statest₁:States₁:Resultst✝:Statest'✝:Statest''✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:st✝ =[ c✝ ]=> st'✝ // sContinuehloop:st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st''✝ // sContinueihc:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sContinue = s₂ihloop:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // s₂ → st''✝ = st₂ ∧ sContinue = s₂st₂:Statehb':Bexp.eval st✝ b✝ = trueright✝:sContinue = sContinuehc':st✝ =[ c✝ ]=> st'✝ // sContinuehloop':st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // sContinue⊢ st''✝ = st₂ ∧ sContinue = sContinue
apply ihloop refl c:Comst:Statest₁:States₁:Resultst✝:Statest'✝:Statest''✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:st✝ =[ c✝ ]=> st'✝ // sContinuehloop:st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st''✝ // sContinueihc:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sContinue = s₂ihloop:∀ {st₂ : State} {s₂ : Result}, st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // s₂ → st''✝ = st₂ ∧ sContinue = s₂st₂:Statehb':Bexp.eval st✝ b✝ = trueright✝:sContinue = sContinuehc':st✝ =[ c✝ ]=> st'✝ // sContinuehloop':st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // sContinue⊢ st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // sContinue
assumption All goals completed! 🐙
| whileBreak hb hc ih => whileBreak c:Comst:Statest₁:States₁:Resultst✝:Statest'✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:st✝ =[ c✝ ]=> st'✝ // sBreakih:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sBreak = s₂st₂:States₂:Resulth₂:st✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // s₂⊢ st'✝ = st₂ ∧ sContinue = s₂
inversion h₂ with
| whileFalse => lia All goals completed! 🐙
| whileBreak hb' hc' =>
obtain ⟨eq₁, _⟩ := ih hc' whileBreak c:Comst:Statest₁:States₁:Resultst✝:Statest'✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:st✝ =[ c✝ ]=> st'✝ // sBreakih:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sBreak = s₂st₂:Statehb':Bexp.eval st✝ b✝ = truehc':st✝ =[ c✝ ]=> st₂ // sBreakeq₁:st'✝ = st₂right✝:sBreak = sBreak⊢ st'✝ = st₂ ∧ sContinue = sContinue
inversion eq₁ refl c:Comst:Statest₁:States₁:Resultst✝:Statest'✝:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:st✝ =[ c✝ ]=> st'✝ // sBreakih:∀ {st₂ : State} {s₂ : Result}, st✝ =[ c✝ ]=> st₂ // s₂ → st'✝ = st₂ ∧ sBreak = s₂hb':Bexp.eval st✝ b✝ = trueright✝:sBreak = sBreakhc':st✝ =[ c✝ ]=> st'✝ // sBreak⊢ st'✝ = st'✝ ∧ sContinue = sContinue
lia All goals completed! 🐙
| whileContinue hb' hc' hloop' =>
specialize ih hc' whileContinue c:Comst:Statest₁:States₁:Resultst✝:Statest'✝¹:Stateb✝:Bexpc✝:Comhb:Bexp.eval st✝ b✝ = truehc:st✝ =[ c✝ ]=> st'✝ // sBreakst₂:Statest'✝:Stateih:st'✝¹ = st'✝ ∧ sBreak = sContinuehb':Bexp.eval st✝ b✝ = truehc':st✝ =[ c✝ ]=> st'✝ // sContinuehloop':st'✝ =[ imp {while (~b✝) {~c✝}} ]=> st₂ // sContinue⊢ st'✝ = st₂ ∧ sContinue = sContinue
lia All goals completed! 🐙
end Imp.Break
Add C-style for loops to the language of commands, update the
Com.EvalR definition to define the semantics of for loops, and add
cases for for loops as needed so that all the proofs in this
file are accepted by Lean.
A for loop should be parameterized by (a) a statement executed
initially, (b) a test that is run on each iteration of the loop to
determine whether the loop should continue, (c) a statement
executed at the end of each loop iteration, and (d) a statement
that makes up the body of the loop. (You don't need to worry
about making up a concrete Notation for for loops, but feel free
to play with this too if you like.)