399 lines
9.5 KiB
Coq
399 lines
9.5 KiB
Coq
(*
|
||
https://github.com/coq-community/semantics/blob/master/little.v
|
||
*)
|
||
Require Import List String.
|
||
Import ListNotations.
|
||
|
||
(*
|
||
ρ: env
|
||
e: expr
|
||
b: bool
|
||
i: instr
|
||
|
||
ρ := (var, val)::ρ | ∅
|
||
e := var | val | e+e (only addition possible)
|
||
b := e < e (only < possible. But what about true,false??
|
||
i := skip (empty program. Does nothing. noop)
|
||
| x:=e (assignment to var)
|
||
| i;i
|
||
| while b do i done (loop)
|
||
|
||
All values are nat
|
||
*)
|
||
|
||
Require Import String.
|
||
|
||
Inductive aexpr : Type :=
|
||
| Anum : nat -> aexpr
|
||
| Avar : string -> aexpr
|
||
| Aplus : aexpr -> aexpr -> aexpr.
|
||
|
||
Inductive bexpr : Type :=
|
||
| Lt : aexpr -> aexpr -> bexpr.
|
||
|
||
Inductive instr : Type :=
|
||
| Skip : instr
|
||
| Let : string -> aexpr -> instr
|
||
| Seq : instr -> instr -> instr
|
||
| While : bexpr -> instr -> instr.
|
||
|
||
Definition env : Type := list (string * nat).
|
||
|
||
Inductive aeval : env -> aexpr -> nat -> Prop :=
|
||
(* ρ ⊢ n → n *)
|
||
| AEnum : forall (en:env) (n:nat),
|
||
aeval en (Anum n) n
|
||
(* ((var, val)::ρ) ⊢ (var → val) *)
|
||
| AEvar : forall (en:env) (val:nat) (var:string),
|
||
aeval ((var,val)::en)%list (Avar var) val (* Found! *)
|
||
(* var1 ≠ var2
|
||
→ (ρ ⊢ (var1 → val1))
|
||
→ (((var2,val2)::ρ) ⊢ (var2 → val2))
|
||
*)
|
||
| AEvarOther : forall (en:env) (val1 val2:nat) (var1 var2:string),
|
||
var1 <> var2
|
||
-> aeval en (Avar var1) val1
|
||
-> aeval ((var2,val2)::en)%list (Avar var1) val1 (* Even if we had another variable added to the env. *)
|
||
(*
|
||
(ρ ⊢ (e1 → val1))
|
||
→ (ρ ⊢ (e2 → val2))
|
||
→ (ρ ⊢ (e1 + e2) → (val1 + val2))
|
||
*)
|
||
| AEplus : forall (en:env) (e1 e2 : aexpr) (val1 val2 : nat),
|
||
aeval en e1 val1
|
||
-> aeval en e2 val2
|
||
-> aeval en (Aplus e1 e2) (val1 + val2).
|
||
|
||
Inductive beval : env -> bexpr -> bool -> Prop :=
|
||
(*
|
||
val1 < val2
|
||
→ (ρ ⊢ (e1 → val1))
|
||
→ (ρ ⊢ (e2 → val2))
|
||
→ (ρ ⊢ ((e1 < e2) → true))
|
||
*)
|
||
| BEltLeft : forall (en:env) (val1 val2 : nat) (e1 e2 : aexpr),
|
||
(val1 < val2)
|
||
-> aeval en e1 val1
|
||
-> aeval en e2 val2
|
||
-> beval en (Lt e1 e2) true
|
||
(*
|
||
¬(val1 < val2)
|
||
→ (ρ ⊢ (e1 → val1))
|
||
→ (ρ ⊢ (e2 → val2))
|
||
→ (ρ ⊢ ((e1 < e2) → false))
|
||
*)
|
||
| BEltRight : forall (en:env) (val1 val2 : nat) (e1 e2 : aexpr),
|
||
(val2 >= val2)
|
||
-> aeval en e1 val1
|
||
-> aeval en e2 val2
|
||
-> beval en (Lt e1 e2) false.
|
||
|
||
Inductive envupdate : env -> string -> nat -> env -> Prop :=
|
||
(* Update a variable *)
|
||
| EnvUpdNew : forall (en:env) (var:string) (val:nat),
|
||
envupdate en var val ((var,val)::en)
|
||
(* New variable *)
|
||
| EnvUpdOld : forall (en1 en2:env) (var1 var2:string) (val1 val2:nat),
|
||
envupdate en1 var1 val1 en2
|
||
-> var1 <> var2
|
||
(* en2 already has var1 *)
|
||
-> envupdate ((var2,val2)::en1) var1 val1 ((var2,val2)::en2).
|
||
|
||
Inductive instrevalBS : env -> instr -> env -> Prop :=
|
||
| IEBSSkip : forall (en:env), instrevalBS en Skip en
|
||
| IEBSLet : forall (en en':env) (var:string) (val:nat) (ae:aexpr),
|
||
aeval en ae val
|
||
-> envupdate en var val en'
|
||
-> instrevalBS en (Let var ae) en'
|
||
(*
|
||
-> envupdate en var val en'
|
||
-> instrevalBS en (Let var ae) en'
|
||
*)
|
||
| IEBSSeq : forall (en en1 en2:env) (i1 i2:instr),
|
||
(instrevalBS en i1 en1)
|
||
-> (instrevalBS en1 i2 en2)
|
||
-> instrevalBS en (Seq i1 i2) en2
|
||
| IEBSWhileT : forall (en eni enw:env) (i:instr) (be:bexpr),
|
||
beval en be true
|
||
-> instrevalBS en i eni
|
||
-> instrevalBS eni (While be i) enw
|
||
-> instrevalBS en (While be i) enw
|
||
| IEBSWhileF : forall (en eni enw:env) (i:instr) (be:bexpr),
|
||
beval en be false
|
||
-> instrevalBS en (While be i) en.
|
||
|
||
|
||
Inductive instrevalSS : env -> instr -> instr -> env -> Prop :=
|
||
| IESSLet : forall (en en':env) (var:string) (val:nat) (ae:aexpr),
|
||
aeval en ae val
|
||
-> envupdate en var val en'
|
||
-> instrevalSS en (Let var ae) Skip en'
|
||
| IESSSeqOne : forall (en:env) (i:instr),
|
||
instrevalSS en (Seq Skip i) i en
|
||
(* i1 reduces to i1' and i1' to i2. Then i1 reduces to i2 *)
|
||
(* both i1 and i1' result it en'
|
||
then both i1;i2 and i1';i2 result in en'
|
||
*)
|
||
| IESSSeqMany : forall (en en':env) (i1 i1' i2:instr),
|
||
instrevalSS en i1 i1' en'
|
||
-> instrevalSS en (Seq i1 i2) (Seq i1' i2) en'
|
||
(* XXX: Only aexpr can be bound to vars, okay. But how can we say that env doesn't change after a while loop??? *)
|
||
| IESSWhileT : forall (en:env) (i:instr) (be:bexpr),
|
||
beval en be true
|
||
-> instrevalSS en (While be i) (Seq i (While be i)) en
|
||
| IESSWhileF : forall (en:env) (i:instr) (be:bexpr),
|
||
beval en be false
|
||
(* Says that 'give me (While be i), I'll give you skip' *)
|
||
-> instrevalSS en (While be i) Skip en.
|
||
|
||
Fixpoint lookup (en:env) (var:string) : option nat :=
|
||
match en with
|
||
| []%list => None
|
||
| (x::xs)%list =>
|
||
let '(var', val') := x in
|
||
if (String.eqb var' var) then
|
||
Some val'
|
||
else
|
||
lookup xs var
|
||
end.
|
||
|
||
Definition bind (A B:Type) (x:option A) (f:A->option B) : option B :=
|
||
match x with
|
||
| None => None
|
||
| Some x' => f x'
|
||
end.
|
||
Arguments bind {A B}.
|
||
|
||
(* XXX: Evaluate aexpr ?? *)
|
||
Fixpoint af (en:env) (ae:aexpr) : option nat :=
|
||
match ae with
|
||
| Avar var => lookup en var
|
||
| Anum n => Some n
|
||
| Aplus e1 e2 =>
|
||
bind (af en e1)
|
||
(fun x =>
|
||
bind (af en e2) (fun y => Some(x+y)))
|
||
end.
|
||
|
||
Example en1 : env := [("x"%string, 2)]%list.
|
||
Example en2 : env := [("x"%string, 2); ("y"%string, 3)]%list.
|
||
Example ae1 : aexpr := (Aplus (Avar "x"%string) (Avar "y"%string)).
|
||
|
||
Compute (lookup en1 "x"%string). (* Some 2 *)
|
||
Compute (lookup en1 "a"%string). (* None *)
|
||
Compute (af en1 (Anum 3)).
|
||
Compute (af en2 ae1).
|
||
|
||
Definition bf (en:env) (b:bexpr) : option bool :=
|
||
match b with
|
||
| Lt e1 e2 =>
|
||
bind (af en e1) (fun x =>
|
||
bind (af en e2) (fun y => Some (Nat.ltb x y)))
|
||
end.
|
||
|
||
(* Only update existing vars. Won't add new vars to env *)
|
||
Fixpoint updatefn (en:env) (var:string) (val:nat) : option env :=
|
||
match en with
|
||
| []%list => None
|
||
| ((var',val')::ens)%list =>
|
||
if (string_dec var var') then
|
||
Some ((var, val)::ens)%list
|
||
else
|
||
bind (updatefn ens var val)
|
||
(fun x => Some ((var',val')::x)%list)
|
||
(*
|
||
match (String.eqb var var') with
|
||
| true => Some ((var, val)::ens)%list
|
||
| false =>
|
||
bind (updatefn ens var val)
|
||
(fun x => Some ((var',val')::x)%list)
|
||
end
|
||
*)
|
||
end.
|
||
Compute en2.
|
||
Compute updatefn en2 "y"%string 5.
|
||
|
||
Check list nat -> Prop.
|
||
Check (list nat) -> Prop.
|
||
Check list (nat -> Prop).
|
||
|
||
Inductive assert : Type :=
|
||
| AssertBool (b:bexpr)
|
||
| AssertNot (a:assert)
|
||
| AssertConj (a1 a2:assert)
|
||
| AssertPred (s:string) (n:nat).
|
||
|
||
Inductive condition : Type :=
|
||
| Condition (a1 a2 : assert).
|
||
|
||
Definition eq_O (n:nat) : {n=O}+{n<>O}.
|
||
Proof.
|
||
case n.
|
||
- left.
|
||
reflexivity.
|
||
- right.
|
||
discriminate.
|
||
Restart.
|
||
case n.
|
||
auto.
|
||
right.
|
||
discriminate.
|
||
Qed.
|
||
|
||
|
||
Definition eq_skip (i:instr) : {i=Skip}+{i<>Skip}.
|
||
Proof.
|
||
case i.
|
||
- left.
|
||
reflexivity.
|
||
- intros.
|
||
right.
|
||
discriminate.
|
||
- intros.
|
||
right.
|
||
discriminate.
|
||
- intros.
|
||
right.
|
||
discriminate.
|
||
Restart.
|
||
(* [auto] takes care of the simple goal which needed [left] tactic *)
|
||
case i; auto; right; discriminate.
|
||
Qed.
|
||
|
||
Inductive integer : Set :=
|
||
| Int (n:nat) : integer.
|
||
|
||
(*
|
||
Goal
|
||
forall (var varname:nat),
|
||
Int var = Int varname.
|
||
Proof.
|
||
intros.
|
||
discriminate.
|
||
*)
|
||
|
||
Goal
|
||
forall (n1 n2:nat),
|
||
Int n1 = Int n2 -> n1 = n2.
|
||
Proof.
|
||
intros.
|
||
induction n1.
|
||
- .
|
||
discriminate.
|
||
|
||
Lemma aeval_lookup :
|
||
forall (en:env) (e:aexpr) (n:nat) (var:string),
|
||
aeval en e n
|
||
-> e = (Avar var)
|
||
-> lookup en var = Some n.
|
||
Proof.
|
||
intros en e n varname H.
|
||
induction H.
|
||
- intro H1.
|
||
induction en.
|
||
+ discriminate.
|
||
+ rewrite <- IHen.
|
||
discriminate.
|
||
- intro H1.
|
||
induction en.
|
||
+
|
||
|
||
|
||
(*
|
||
|
||
Fixpoint aeval (en:env) (e:aexpr) : option nat :=
|
||
match e with
|
||
| Avar var => lookup en var
|
||
| Anum n => Some n
|
||
| Aplus e1 e2 =>
|
||
match (aeval en e1) with
|
||
| None => None
|
||
| Some val1 =>
|
||
match (aeval en e2) with
|
||
| None => None
|
||
| Some val2 => Some (val1 + val2)
|
||
end
|
||
end
|
||
end.
|
||
|
||
Definition beval (en:env) (e:bexpr) : option bool :=
|
||
match e with
|
||
| Lt ae1 ae2 =>
|
||
match (aeval en ae1) with
|
||
| None => None
|
||
| Some val1 =>
|
||
match (aeval en ae2) with
|
||
| None => None
|
||
| Some val2 => Some (Nat.ltb val1 val2)
|
||
end
|
||
end
|
||
end.
|
||
|
||
Check (lookup []%list "a"%string = Some 3).
|
||
Print eq.
|
||
Check eq_refl.
|
||
|
||
Lemma lookup_aeval : forall (en:env) (var:string) (val:nat),
|
||
(lookup en var = Some val) -> aeval en (Avar var) val.
|
||
Proof.
|
||
intros.
|
||
apply (AEvar en H).
|
||
|
||
(match H with
|
||
| eqrefl val' => val'
|
||
| None => None
|
||
end)
|
||
).
|
||
Qed.
|
||
|
||
Fixpoint instreval (en:env) (i:instr) : env :=
|
||
match i with
|
||
| Let var ae =>
|
||
let res := (aeval en ae) in
|
||
match res with
|
||
| None => en
|
||
| Some val => ((var,val)::en)%list
|
||
end
|
||
| Seq i1 i2 =>
|
||
let en' := (instreval en i1) in
|
||
(instreval en' i2)
|
||
| While be i' =>
|
||
match (beval en be) with
|
||
| None => en
|
||
| Some true => instreval en (Seq i' (While be i'))
|
||
| Some false => en
|
||
end
|
||
end.
|
||
*)
|
||
|
||
(*
|
||
Inductive var : Set := string.
|
||
Inductive val : Set := nat.
|
||
|
||
Inductive expr : Set :=
|
||
| Var : var -> expr
|
||
| Val : val -> expr
|
||
| Add : expr -> expr -> expr.
|
||
|
||
Inductive boolean : Set :=
|
||
| Lt : expr -> expr -> boolean.
|
||
|
||
Inductive instr : Set :=
|
||
| Skip : instr
|
||
| Let : var -> expr -> instr
|
||
| Seq : instr -> instr -> instr
|
||
| While : bool -> instr -> instr.
|
||
|
||
Inductive env : Set :=
|
||
| Empty : env
|
||
| NewVar : var * val -> env.
|
||
|
||
(*
|
||
ρ ⊢ n → n
|
||
(var, val)::ρ ⊢ var → val
|
||
*)
|
||
|
||
Inductive eval : env -> expr -> val -> Prop :=
|
||
| ValEval : forall (en:env) (n:expr),
|
||
*)
|