Commit 253b4a7b authored by Léon Gondelman's avatar Léon Gondelman

mini-compiler:bisect

parent 13585337
(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below *)
Require Import BuiltIn.
Require BuiltIn.
Require int.Int.
Require int.Abs.
Require int.EuclideanDivision.
Require list.List.
Require list.Length.
Require list.Mem.
Require map.Map.
Require bool.Bool.
Require list.Append.
Axiom map : forall (a:Type) (b:Type), Type.
Parameter map_WhyType : forall (a:Type) {a_WT:WhyType a}
(b:Type) {b_WT:WhyType b}, WhyType (map a b).
Existing Instance map_WhyType.
Parameter get: forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
(map a b) -> a -> b.
Parameter set: forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
(map a b) -> a -> b -> (map a b).
Parameter const: forall {a:Type} {a_WT:WhyType a} {b:Type} {b_WT:WhyType b},
b -> (map a b).
(* Why3 assumption *)
Inductive id :=
| Id : Z -> id.
Axiom id_WhyType : WhyType id.
Existing Instance id_WhyType.
(* Why3 assumption *)
Inductive aexpr :=
| Anum : Z -> aexpr
| Avar : id -> aexpr
| Aadd : aexpr -> aexpr -> aexpr
| Asub : aexpr -> aexpr -> aexpr
| Amul : aexpr -> aexpr -> aexpr.
Axiom aexpr_WhyType : WhyType aexpr.
Existing Instance aexpr_WhyType.
(* Why3 assumption *)
Inductive bexpr :=
| Btrue : bexpr
| Bfalse : bexpr
| Band : bexpr -> bexpr -> bexpr
| Bnot : bexpr -> bexpr
| Beq : aexpr -> aexpr -> bexpr
| Ble : aexpr -> aexpr -> bexpr.
Axiom bexpr_WhyType : WhyType bexpr.
Existing Instance bexpr_WhyType.
(* Why3 assumption *)
Inductive com :=
| Cskip : com
| Cassign : id -> aexpr -> com
| Cseq : com -> com -> com
| Cif : bexpr -> com -> com -> com
| Cwhile : bexpr -> com -> com.
Axiom com_WhyType : WhyType com.
Existing Instance com_WhyType.
(* Why3 assumption *)
Fixpoint aeval (st:(map id Z)) (e:aexpr) {struct e}: Z :=
match e with
| (Anum n) => n
| (Avar x) => (get st x)
| (Aadd e1 e2) => ((aeval st e1) + (aeval st e2))%Z
| (Asub e1 e2) => ((aeval st e1) - (aeval st e2))%Z
| (Amul e1 e2) => ((aeval st e1) * (aeval st e2))%Z
end.
Parameter beval: (map id Z) -> bexpr -> bool.
Axiom beval_def : forall (st:(map id Z)) (b:bexpr),
match b with
| Btrue => ((beval st b) = true)
| Bfalse => ((beval st b) = false)
| (Bnot b') => ((beval st b) = (Init.Datatypes.negb (beval st b')))
| (Band b1 b2) => ((beval st b) = (Init.Datatypes.andb (beval st
b1) (beval st b2)))
| (Beq a1 a2) => (((aeval st a1) = (aeval st a2)) -> ((beval st
b) = true)) /\ ((~ ((aeval st a1) = (aeval st a2))) -> ((beval st
b) = false))
| (Ble a1 a2) => (((aeval st a1) <= (aeval st a2))%Z -> ((beval st
b) = true)) /\ ((~ ((aeval st a1) <= (aeval st a2))%Z) -> ((beval st
b) = false))
end.
(* Why3 assumption *)
Inductive ceval: (map id Z) -> com -> (map id Z) -> Prop :=
| E_Skip : forall (m:(map id Z)), (ceval m Cskip m)
| E_Ass : forall (m:(map id Z)) (a:aexpr) (n:Z) (x:id), ((aeval m
a) = n) -> (ceval m (Cassign x a) (set m x n))
| E_Seq : forall (cmd1:com) (cmd2:com) (m0:(map id Z)) (m1:(map id Z))
(m2:(map id Z)), (ceval m0 cmd1 m1) -> ((ceval m1 cmd2 m2) -> (ceval m0
(Cseq cmd1 cmd2) m2))
| E_IfTrue : forall (m0:(map id Z)) (m1:(map id Z)) (cond:bexpr) (cmd1:com)
(cmd2:com), ((beval m0 cond) = true) -> ((ceval m0 cmd1 m1) -> (ceval
m0 (Cif cond cmd1 cmd2) m1))
| E_IfFalse : forall (m0:(map id Z)) (m1:(map id Z)) (cond:bexpr)
(cmd1:com) (cmd2:com), ((beval m0 cond) = false) -> ((ceval m0 cmd2
m1) -> (ceval m0 (Cif cond cmd1 cmd2) m1))
| E_WhileEnd : forall (cond:bexpr) (m:(map id Z)) (body:com), ((beval m
cond) = false) -> (ceval m (Cwhile cond body) m)
| E_WhileLoop : forall (mi:(map id Z)) (mj:(map id Z)) (mf:(map id Z))
(cond:bexpr) (body:com), ((beval mi cond) = true) -> ((ceval mi body
mj) -> ((ceval mj (Cwhile cond body) mf) -> (ceval mi (Cwhile cond
body) mf))).
Axiom ceval_deterministic : forall (c:com) (mi:(map id Z)) (mf1:(map id Z))
(mf2:(map id Z)), (ceval mi c mf1) -> ((ceval mi c mf2) -> (mf1 = mf2)).
(* Why3 assumption *)
Inductive machine_state :=
| VMS : Z -> (list Z) -> (map id Z) -> machine_state.
Axiom machine_state_WhyType : WhyType machine_state.
Existing Instance machine_state_WhyType.
(* Why3 assumption *)
Inductive instr :=
| Iconst : Z -> instr
| Ivar : id -> instr
| Isetvar : id -> instr
| Ibranch : Z -> instr
| Iadd : instr
| Isub : instr
| Imul : instr
| Ibeq : Z -> instr
| Ibne : Z -> instr
| Ible : Z -> instr
| Ibgt : Z -> instr
| Ihalt : instr.
Axiom instr_WhyType : WhyType instr.
Existing Instance instr_WhyType.
(* Why3 assumption *)
Inductive codeseq_at: (list instr) -> Z -> (list instr) -> Prop :=
| codeseq_at_intro : forall (c1:(list instr)) (c2:(list instr))
(c3:(list instr)) (pc:Z), (pc = (list.Length.length c1)) -> (codeseq_at
(Init.Datatypes.app (Init.Datatypes.app c1 c2) c3) pc c2).
Parameter transition_star: (list instr) -> machine_state -> machine_state ->
Prop.
Axiom func : forall (a:Type) (b:Type), Type.
Parameter func_WhyType : forall (a:Type) {a_WT:WhyType a}
(b:Type) {b_WT:WhyType b}, WhyType (func a b).
Existing Instance func_WhyType.
Parameter infix_at: forall {a:Type} {a_WT:WhyType a}
{b:Type} {b_WT:WhyType b}, (func a b) -> a -> b.
(* Why3 assumption *)
Inductive hl
(a:Type) :=
| mk_hl : (list instr) -> (func a (func Z (func machine_state bool))) ->
(func a (func Z (func machine_state (func machine_state bool)))) -> hl
a.
Axiom hl_WhyType : forall (a:Type) {a_WT:WhyType a}, WhyType (hl a).
Existing Instance hl_WhyType.
Implicit Arguments mk_hl [[a]].
(* Why3 assumption *)
Definition post {a:Type} {a_WT:WhyType a} (v:(hl a)): (func a (func Z (func
machine_state (func machine_state bool)))) :=
match v with
| (mk_hl x x1 x2) => x2
end.
(* Why3 assumption *)
Definition pre {a:Type} {a_WT:WhyType a} (v:(hl a)): (func a (func Z (func
machine_state bool))) := match v with
| (mk_hl x x1 x2) => x1
end.
(* Why3 assumption *)
Definition code {a:Type} {a_WT:WhyType a} (v:(hl a)): (list instr) :=
match v with
| (mk_hl x x1 x2) => x
end.
(* Why3 assumption *)
Definition contextual_irrelevance (c:(list instr)) (p:Z) (ms1:machine_state)
(ms2:machine_state): Prop := forall (c_global:(list instr)), (codeseq_at
c_global p c) -> (transition_star c_global ms1 ms2).
(* Why3 assumption *)
Definition hl_correctness {a:Type} {a_WT:WhyType a} (cs:(hl a)): Prop :=
forall (x:a) (p:Z) (ms:machine_state),
((infix_at (infix_at (infix_at (pre cs) x) p) ms) = true) ->
exists ms':machine_state,
((infix_at (infix_at (infix_at (infix_at (post cs) x) p) ms)
ms') = true) /\ (contextual_irrelevance (code cs) p ms ms').
Parameter com_pre: forall {a:Type} {a_WT:WhyType a}, com -> (func a (func Z
(func machine_state bool))).
Axiom com_pre_def : forall {a:Type} {a_WT:WhyType a}, forall (cmd:com) (x:a)
(p:Z) (ms:machine_state),
((infix_at (infix_at (infix_at (com_pre cmd: (func a (func Z (func
machine_state bool)))) x) p) ms) = true) <->
match ms with
| (VMS p' _ m) => (p = p') /\ exists m':(map id Z), (ceval m cmd m')
end.
Parameter com_post: forall {a:Type} {a_WT:WhyType a}, com -> Z -> (func a
(func Z (func machine_state (func machine_state bool)))).
Axiom com_post_def : forall {a:Type} {a_WT:WhyType a}, forall (cmd:com)
(len:Z) (x:a) (p:Z) (ms:machine_state) (ms':machine_state),
((infix_at (infix_at (infix_at (infix_at (com_post cmd len: (func a (func Z
(func machine_state (func machine_state bool))))) x) p) ms)
ms') = true) <-> match (ms,
ms') with
| ((VMS p1 s m), (VMS p' s' m')) => (p' = (p1 + len)%Z) /\ ((s' = s) /\
(ceval m cmd m'))
end.
(* Why3 goal *)
Theorem WP_parameter_compile_com_natural : forall (com1:com),
forall (res:(list instr)) (res1:(func unit (func Z (func machine_state
bool)))) (res2:(func unit (func Z (func machine_state (func machine_state
bool))))), ((res1 = (com_pre com1: (func unit (func Z (func machine_state
bool))))) /\ ((res2 = (com_post com1 (list.Length.length res): (func unit
(func Z (func machine_state (func machine_state bool)))))) /\
(hl_correctness (mk_hl res res1 res2)))) -> ((forall (p:Z) (s:(list Z))
(m:(map id Z)) (m':(map id Z)), (ceval m com1 m') ->
((infix_at (infix_at (infix_at res1 tt) p) (VMS p s m)) = true)) ->
forall (c:(list instr)) (p:Z) (s:(list Z)) (m:(map id Z)) (m':(map id Z)),
(ceval m com1 m') -> ((codeseq_at c p res) -> (transition_star c (VMS p s
m) (VMS (p + (list.Length.length res))%Z s m')))).
(* Why3 intros com1 res res1 res2 (h1,(h2,h3)) h4 c p s m m' h5 h6. *)
intros com1 res res1 res2 (h1,(h2,h3)) h4 c p s m m' h5 h6.
unfold hl_correctness in *.
remember h5 as h7 eqn:eqn;clear eqn.
apply (h4 p s) in h5.
apply h3 in h5.
Require Import Why3.
simpl in *.
subst.
destruct h5.
rewrite com_post_def in H.
why3 "Alt-Ergo,0.95.2,".
Qed.
......@@ -1126,13 +1126,1268 @@
</goal>
</transf>
</goal>
<goal name="WP_parameter compile_com_natural" expl="VC for compile_com_natural">
<transf name="split_goal_wp">
<goal name="WP_parameter compile_com_natural" expl="VC for compile_com_natural" expanded="true">
<transf name="split_goal_wp" expanded="true">
<goal name="WP_parameter compile_com_natural.1" expl="1. assertion">
<proof prover="3"><result status="valid" time="0.08"/></proof>
</goal>
<goal name="WP_parameter compile_com_natural.2" expl="2. postcondition">
<goal name="WP_parameter compile_com_natural.2" expl="2. postcondition" expanded="true">
<proof prover="1" edited="compiler_Compile_com_WP_parameter_compile_com_natural_1.v"><result status="valid" time="1.94"/></proof>
<metas
expanded="true">
<ts_pos name="real" arity="0" id="2"
ip_theory="BuiltIn">
<ip_library name="why3"/>
<ip_library name="BuiltIn"/>
<ip_qualid name="real"/>
</ts_pos>
<ts_pos name="pred" arity="1" id="8"
ip_theory="HighOrd">
<ip_library name="why3"/>
<ip_library name="HighOrd"/>
<ip_qualid name="pred"/>
</ts_pos>
<ts_pos name="unit" arity="0" id="21"
ip_theory="Unit">
<ip_library name="why3"/>
<ip_library name="Unit"/>
<ip_qualid name="unit"/>
</ts_pos>
<ts_pos name="&apos;mark" arity="0" id="54"
ip_theory="Mark">
<ip_library name="why3"/>
<ip_library name="Mark"/>
<ip_qualid name="&apos;mark"/>
</ts_pos>
<ts_pos name="state" arity="0" id="5044"
ip_theory="State">
<ip_library name="state"/>
<ip_qualid name="state"/>
</ts_pos>
<ts_pos name="pos" arity="0" id="5444"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="pos"/>
</ts_pos>
<ts_pos name="stack" arity="0" id="5445"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="stack"/>
</ts_pos>
<ts_pos name="code" arity="0" id="5461"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="code"/>
</ts_pos>
<ts_pos name="trans" arity="0" id="5760"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="trans"/>
</ts_pos>
<ts_pos name="pred" arity="0" id="5900"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="pred"/>
</ts_pos>
<ts_pos name="post" arity="0" id="5901"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="post"/>
</ts_pos>
<ts_pos name="wp" arity="1" id="5908"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="wp"/>
</ts_pos>
<ts_pos name="binop" arity="0" id="6463"
ip_theory="VM_arith_instr_spec">
<ip_library name="specs"/>
<ip_qualid name="binop"/>
</ts_pos>
<ts_pos name="cond" arity="0" id="6800"
ip_theory="VM_bool_instr_spec">
<ip_library name="specs"/>
<ip_qualid name="cond"/>
</ts_pos>
<ls_pos name="infix =" id="10"
ip_theory="BuiltIn">
<ip_library name="why3"/>
<ip_library name="BuiltIn"/>
<ip_qualid name="infix ="/>
</ls_pos>
<ls_pos name="infix @" id="15"
ip_theory="HighOrd">
<ip_library name="why3"/>
<ip_library name="HighOrd"/>
<ip_qualid name="infix @"/>
</ls_pos>
<ls_pos name="zero" id="786"
ip_theory="Int">
<ip_library name="int"/>
<ip_qualid name="zero"/>
</ls_pos>
<ls_pos name="one" id="787"
ip_theory="Int">
<ip_library name="int"/>
<ip_qualid name="one"/>
</ls_pos>
<ls_pos name="infix &lt;" id="788"
ip_theory="Int">
<ip_library name="int"/>
<ip_qualid name="infix &lt;"/>
</ls_pos>
<ls_pos name="infix &gt;" id="791"
ip_theory="Int">
<ip_library name="int"/>
<ip_qualid name="infix &gt;"/>
</ls_pos>
<ls_pos name="infix +" id="1957"
ip_theory="Int">
<ip_library name="int"/>
<ip_qualid name="infix +"/>
</ls_pos>
<ls_pos name="prefix -" id="1958"
ip_theory="Int">
<ip_library name="int"/>
<ip_qualid name="prefix -"/>
</ls_pos>
<ls_pos name="infix *" id="1959"
ip_theory="Int">
<ip_library name="int"/>
<ip_qualid name="infix *"/>
</ls_pos>
<ls_pos name="infix &gt;=" id="2027"
ip_theory="Int">
<ip_library name="int"/>
<ip_qualid name="infix &gt;="/>
</ls_pos>
<ls_pos name="abs" id="2072"
ip_theory="Abs">
<ip_library name="int"/>
<ip_qualid name="abs"/>
</ls_pos>
<ls_pos name="div" id="2197"
ip_theory="EuclideanDivision">
<ip_library name="int"/>
<ip_qualid name="div"/>
</ls_pos>
<ls_pos name="mod" id="2200"
ip_theory="EuclideanDivision">
<ip_library name="int"/>
<ip_qualid name="mod"/>
</ls_pos>
<ls_pos name="mem" id="2857"
ip_theory="Mem">
<ip_library name="list"/>
<ip_qualid name="mem"/>
</ls_pos>
<ls_pos name="orb" id="3746"
ip_theory="Bool">
<ip_library name="bool"/>
<ip_qualid name="orb"/>
</ls_pos>
<ls_pos name="xorb" id="3755"
ip_theory="Bool">
<ip_library name="bool"/>
<ip_qualid name="xorb"/>
</ls_pos>
<ls_pos name="implb" id="3769"
ip_theory="Bool">
<ip_library name="bool"/>
<ip_qualid name="implb"/>
</ls_pos>
<ls_pos name="get" id="5000"
ip_theory="State">
<ip_library name="state"/>
<ip_qualid name="get"/>
</ls_pos>
<ls_pos name="set" id="5001"
ip_theory="State">
<ip_library name="state"/>
<ip_qualid name="set"/>
</ls_pos>
<ls_pos name="const" id="5038"
ip_theory="State">
<ip_library name="state"/>
<ip_qualid name="const"/>
</ls_pos>
<ls_pos name="push" id="5494"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="push"/>
</ls_pos>
<ls_pos name="iconst" id="5503"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="iconst"/>
</ls_pos>
<ls_pos name="ivar" id="5508"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="ivar"/>
</ls_pos>
<ls_pos name="isetvar" id="5513"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="isetvar"/>
</ls_pos>
<ls_pos name="iadd" id="5518"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="iadd"/>
</ls_pos>
<ls_pos name="isub" id="5519"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="isub"/>
</ls_pos>
<ls_pos name="imul" id="5520"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="imul"/>
</ls_pos>
<ls_pos name="ibeq" id="5521"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="ibeq"/>
</ls_pos>
<ls_pos name="ible" id="5526"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="ible"/>
</ls_pos>
<ls_pos name="ibne" id="5531"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="ibne"/>
</ls_pos>
<ls_pos name="ibgt" id="5536"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="ibgt"/>
</ls_pos>
<ls_pos name="ibranch" id="5541"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="ibranch"/>
</ls_pos>
<ls_pos name="ihalt" id="5546"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="ihalt"/>
</ls_pos>
<ls_pos name="transition" id="5547"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="transition"/>
</ls_pos>
<ls_pos name="transition_star_proof" id="5769"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="transition_star_proof"/>
</ls_pos>
<ls_pos name="transition_star" id="5794"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="transition_star"/>
</ls_pos>
<ls_pos name="vm_terminates" id="5845"
ip_theory="Vm">
<ip_library name="vm"/>
<ip_qualid name="vm_terminates"/>
</ls_pos>
<ls_pos name="fst" id="5865"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="fst"/>
</ls_pos>
<ls_pos name="snd" id="5884"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="snd"/>
</ls_pos>
<ls_pos name="wp_correctness" id="5960"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="wp_correctness"/>
</ls_pos>
<ls_pos name="seq_wp" id="5986"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="seq_wp"/>
</ls_pos>
<ls_pos name="fork_wp" id="6064"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="fork_wp"/>
</ls_pos>
<ls_pos name="towp_wp" id="6125"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="towp_wp"/>
</ls_pos>
<ls_pos name="trivial_pre" id="6199"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="trivial_pre"/>
</ls_pos>
<ls_pos name="acc" id="6249"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="acc"/>
</ls_pos>
<ls_pos name="loop_preservation" id="6263"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="loop_preservation"/>
</ls_pos>
<ls_pos name="forget_old" id="6299"
ip_theory="Compiler_logic">
<ip_library name="logic"/>
<ip_qualid name="forget_old"/>
</ls_pos>
<ls_pos name="iconst_post" id="6339"
ip_theory="VM_arith_instr_spec">
<ip_library name="specs"/>
<ip_qualid name="iconst_post"/>
</ls_pos>
<ls_pos name="ivar_post" id="6401"
ip_theory="VM_arith_instr_spec">
<ip_library name="specs"/>
<ip_qualid name="ivar_post"/>
</ls_pos>
<ls_pos name="ibinop_pre" id="6464"
ip_theory="VM_arith_instr_spec">
<ip_library name="specs"/>
<ip_qualid name="ibinop_pre"/>
</ls_pos>
<ls_pos name="ibinop_post" id="6519"
ip_theory="VM_arith_instr_spec">
<ip_library name="specs"/>
<ip_qualid name="ibinop_post"/>
</ls_pos>
<ls_pos name="plus" id="6633"
ip_theory="VM_arith_instr_spec">
<ip_library name="specs"/>
<ip_qualid name="plus"/>
</ls_pos>
<ls_pos name="sub" id="6646"
ip_theory="VM_arith_instr_spec">
<ip_library name="specs"/>
<ip_qualid name="sub"/>
</ls_pos>
<ls_pos name="mul" id="6659"
ip_theory="VM_arith_instr_spec">
<ip_library name="specs"/>
<ip_qualid name="mul"/>
</ls_pos>
<ls_pos name="inil_post" id="6706"