diff options
225 files changed, 11709 insertions, 11709 deletions
@@ -92,7 +92,7 @@ Notation "'RA'" := IR14 (only parsing). reference manuals for more details. Some instructions, described below, are pseudo-instructions: they expand to canned instruction sequences during the printing of the assembly - code. Most instructions are common to Thumb2 and ARM classic. + code. Most instructions are common to Thumb2 and ARM classic. We use a few Thumb2-specific instructions when available, and avoid to use ARM classic features that are not in Thumb2. *) @@ -228,8 +228,8 @@ Inductive instruction : Type := | Pstr_p: ireg -> ireg -> shift_op -> instruction (**r int32 store with post increment *) | Pstrb_p: ireg -> ireg -> shift_op -> instruction (**r unsigned int8 store with post increment *) | Pstrh_p: ireg -> ireg -> shift_op -> instruction. (**r unsigned int16 store with post increment *) - - + + (** The pseudo-instructions are the following: @@ -290,7 +290,7 @@ Definition program := AST.program fundef unit. the convention that integer registers are mapped to values of type [Tint], float registers to values of type [Tfloat], and condition bits to either [Vzero] or [Vone]. *) - + Definition regset := Pregmap.t val. Definition genv := Genv.t fundef unit. @@ -405,7 +405,7 @@ Definition eval_shift_op (so: shift_op) (rs: regset) := (** Auxiliaries for memory accesses *) -Definition exec_load (chunk: memory_chunk) (addr: val) (r: preg) +Definition exec_load (chunk: memory_chunk) (addr: val) (r: preg) (rs: regset) (m: mem) := match Mem.loadv chunk m addr with | None => Stuck @@ -549,74 +549,74 @@ Definition eval_testcond (c: testcond) (rs: regset) : option bool := Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : outcome := match i with - | Padd r1 r2 so => + | Padd r1 r2 so => Next (nextinstr_nf (rs#r1 <- (Val.add rs#r2 (eval_shift_op so rs)))) m - | Pand r1 r2 so => + | Pand r1 r2 so => Next (nextinstr_nf (rs#r1 <- (Val.and rs#r2 (eval_shift_op so rs)))) m | Pasr r1 r2 r3 => Next (nextinstr_nf (rs#r1 <- (Val.shr rs#r2 rs#r3))) m - | Pb lbl => + | Pb lbl => goto_label f lbl rs m - | Pbc cond lbl => + | Pbc cond lbl => match eval_testcond cond rs with | Some true => goto_label f lbl rs m | Some false => Next (nextinstr rs) m | None => Stuck end - | Pbsymb id sg => + | Pbsymb id sg => Next (rs#PC <- (Genv.symbol_address ge id Int.zero)) m - | Pbreg r sg => + | Pbreg r sg => Next (rs#PC <- (rs#r)) m - | Pblsymb id sg => + | Pblsymb id sg => Next (rs#IR14 <- (Val.add rs#PC Vone) #PC <- (Genv.symbol_address ge id Int.zero)) m - | Pblreg r sg => + | Pblreg r sg => Next (rs#IR14 <- (Val.add rs#PC Vone) #PC <- (rs#r)) m - | Pbic r1 r2 so => + | Pbic r1 r2 so => Next (nextinstr_nf (rs#r1 <- (Val.and rs#r2 (Val.notint (eval_shift_op so rs))))) m - | Pcmp r1 so => + | Pcmp r1 so => Next (nextinstr (compare_int rs rs#r1 (eval_shift_op so rs) m)) m - | Peor r1 r2 so => + | Peor r1 r2 so => Next (nextinstr_nf (rs#r1 <- (Val.xor rs#r2 (eval_shift_op so rs)))) m - | Pldr r1 r2 sa => + | Pldr r1 r2 sa => exec_load Mint32 (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m - | Pldr_a r1 r2 sa => + | Pldr_a r1 r2 sa => exec_load Many32 (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m - | Pldrb r1 r2 sa => + | Pldrb r1 r2 sa => exec_load Mint8unsigned (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m - | Pldrh r1 r2 sa => + | Pldrh r1 r2 sa => exec_load Mint16unsigned (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m - | Pldrsb r1 r2 sa => + | Pldrsb r1 r2 sa => exec_load Mint8signed (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m - | Pldrsh r1 r2 sa => + | Pldrsh r1 r2 sa => exec_load Mint16signed (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m | Plsl r1 r2 r3 => Next (nextinstr_nf (rs#r1 <- (Val.shl rs#r2 rs#r3))) m | Plsr r1 r2 r3 => Next (nextinstr_nf (rs#r1 <- (Val.shru rs#r2 rs#r3))) m - | Pmla r1 r2 r3 r4 => + | Pmla r1 r2 r3 r4 => Next (nextinstr (rs#r1 <- (Val.add (Val.mul rs#r2 rs#r3) rs#r4))) m - | Pmov r1 so => + | Pmov r1 so => Next (nextinstr_nf (rs#r1 <- (eval_shift_op so rs))) m | Pmovw r n => Next (nextinstr (rs#r <- (Vint n))) m | Pmovt r n => Next (nextinstr (rs#r <- (Val.or (Val.and rs#r (Vint (Int.repr 65535))) (Vint (Int.shl n (Int.repr 16)))))) m - | Pmul r1 r2 r3 => + | Pmul r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.mul rs#r2 rs#r3))) m - | Pmvn r1 so => + | Pmvn r1 so => Next (nextinstr_nf (rs#r1 <- (Val.notint (eval_shift_op so rs)))) m - | Porr r1 r2 so => + | Porr r1 r2 so => Next (nextinstr_nf (rs#r1 <- (Val.or rs#r2 (eval_shift_op so rs)))) m - | Prsb r1 r2 so => + | Prsb r1 r2 so => Next (nextinstr_nf (rs#r1 <- (Val.sub (eval_shift_op so rs) rs#r2))) m - | Pstr r1 r2 sa => + | Pstr r1 r2 sa => exec_store Mint32 (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m - | Pstr_a r1 r2 sa => + | Pstr_a r1 r2 sa => exec_store Many32 (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m - | Pstrb r1 r2 sa => + | Pstrb r1 r2 sa => exec_store Mint8unsigned (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m - | Pstrh r1 r2 sa => + | Pstrh r1 r2 sa => exec_store Mint16unsigned (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m | Psdiv => match Val.divs rs#IR0 rs#IR1 with @@ -630,7 +630,7 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out | Psmull rdl rdh r1 r2 => Next (nextinstr (rs#rdl <- (Val.mul rs#r1 rs#r2) #rdh <- (Val.mulhs rs#r1 rs#r2))) m - | Psub r1 r2 so => + | Psub r1 r2 so => Next (nextinstr_nf (rs#r1 <- (Val.sub rs#r2 (eval_shift_op so rs)))) m | Pudiv => match Val.divu rs#IR0 rs#IR1 with @@ -645,23 +645,23 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out (* Floating-point coprocessor instructions *) | Pfcpyd r1 r2 => Next (nextinstr (rs#r1 <- (rs#r2))) m - | Pfabsd r1 r2 => + | Pfabsd r1 r2 => Next (nextinstr (rs#r1 <- (Val.absf rs#r2))) m - | Pfnegd r1 r2 => + | Pfnegd r1 r2 => Next (nextinstr (rs#r1 <- (Val.negf rs#r2))) m - | Pfaddd r1 r2 r3 => + | Pfaddd r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.addf rs#r2 rs#r3))) m - | Pfdivd r1 r2 r3 => + | Pfdivd r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.divf rs#r2 rs#r3))) m - | Pfmuld r1 r2 r3 => + | Pfmuld r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.mulf rs#r2 rs#r3))) m - | Pfsubd r1 r2 r3 => + | Pfsubd r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.subf rs#r2 rs#r3))) m - | Pflid r1 f => + | Pflid r1 f => Next (nextinstr (rs#r1 <- (Vfloat f))) m - | Pfcmpd r1 r2 => + | Pfcmpd r1 r2 => Next (nextinstr (compare_float rs rs#r1 rs#r2)) m - | Pfcmpzd r1 => + | Pfcmpzd r1 => Next (nextinstr (compare_float rs rs#r1 (Vfloat Float.zero))) m | Pfsitod r1 r2 => Next (nextinstr (rs#r1 <- (Val.maketotal (Val.floatofint rs#r2)))) m @@ -671,23 +671,23 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out Next (nextinstr (rs #FR6 <- Vundef #r1 <- (Val.maketotal (Val.intoffloat rs#r2)))) m | Pftouizd r1 r2 => Next (nextinstr (rs #FR6 <- Vundef #r1 <- (Val.maketotal (Val.intuoffloat rs#r2)))) m - | Pfabss r1 r2 => + | Pfabss r1 r2 => Next (nextinstr (rs#r1 <- (Val.absfs rs#r2))) m - | Pfnegs r1 r2 => + | Pfnegs r1 r2 => Next (nextinstr (rs#r1 <- (Val.negfs rs#r2))) m - | Pfadds r1 r2 r3 => + | Pfadds r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.addfs rs#r2 rs#r3))) m - | Pfdivs r1 r2 r3 => + | Pfdivs r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.divfs rs#r2 rs#r3))) m - | Pfmuls r1 r2 r3 => + | Pfmuls r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.mulfs rs#r2 rs#r3))) m - | Pfsubs r1 r2 r3 => + | Pfsubs r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.subfs rs#r2 rs#r3))) m - | Pflis r1 f => + | Pflis r1 f => Next (nextinstr (rs#r1 <- (Vsingle f))) m - | Pfcmps r1 r2 => + | Pfcmps r1 r2 => Next (nextinstr (compare_float32 rs rs#r1 rs#r2)) m - | Pfcmpzs r1 => + | Pfcmpzs r1 => Next (nextinstr (compare_float32 rs rs#r1 (Vsingle Float32.zero))) m | Pfsitos r1 r2 => Next (nextinstr (rs#r1 <- (Val.maketotal (Val.singleofint rs#r2)))) m @@ -707,14 +707,14 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out exec_load Many64 (Val.add rs#r2 (Vint n)) r1 rs m | Pflds r1 r2 n => exec_load Mfloat32 (Val.add rs#r2 (Vint n)) r1 rs m - | Pfstd r1 r2 n => + | Pfstd r1 r2 n => exec_store Mfloat64 (Val.add rs#r2 (Vint n)) r1 rs m - | Pfstd_a r1 r2 n => + | Pfstd_a r1 r2 n => exec_store Many64 (Val.add rs#r2 (Vint n)) r1 rs m | Pfsts r1 r2 n => exec_store Mfloat32 (Val.add rs#r2 (Vint n)) r1 rs m (* Pseudo-instructions *) - | Pallocframe sz pos => + | Pallocframe sz pos => let (m1, stk) := Mem.alloc m 0 sz in let sp := (Vptr stk Int.zero) in match Mem.storev Mint32 m1 (Val.add sp (Vint pos)) rs#IR13 with @@ -748,7 +748,7 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out Next (nextinstr (rs#r1 <- v)) m | Pbtbl r tbl => match rs#r with - | Vint n => + | Vint n => match list_nth_z tbl (Int.unsigned n) with | None => Stuck | Some lbl => goto_label f lbl (rs#IR14 <- Vundef) m @@ -873,7 +873,7 @@ Inductive final_state: state -> int -> Prop := rs#PC = Vzero -> rs#IR0 = Vint r -> final_state (State rs m) r. - + Definition semantics (p: program) := Semantics step (initial_state p) final_state (Genv.globalenv p). @@ -888,9 +888,9 @@ Proof. forall vl2, list_forall2 (extcall_arg rs m) ll vl2 -> vl1 = vl2). induction 1; intros vl2 EA; inv EA. auto. - f_equal; auto. + f_equal; auto. inv H; inv H3; congruence. - intros. red in H0; red in H1. eauto. + intros. red in H0; red in H1. eauto. Qed. Lemma semantics_determinate: forall p, determinate (semantics p). diff --git a/arm/Asmexpand.ml b/arm/Asmexpand.ml index fad13c9f..2b19cbe8 100644 --- a/arm/Asmexpand.ml +++ b/arm/Asmexpand.ml @@ -106,7 +106,7 @@ let memcpy_small_arg sz arg tmp = assert false let expand_builtin_memcpy_small sz al src dst = - let (tsrc, tdst) = + let (tsrc, tdst) = if dst <> BA (IR IR2) then (IR2, IR3) else (IR3, IR2) in let (rsrc, osrc) = memcpy_small_arg sz src tsrc in let (rdst, odst) = memcpy_small_arg sz dst tdst in @@ -142,7 +142,7 @@ let memcpy_big_arg arg tmp = let expand_builtin_memcpy_big sz al src dst = assert (sz >= al); assert (sz mod al = 0); - let (s, d) = + let (s, d) = if dst <> BA (IR IR2) then (IR2, IR3) else (IR3, IR2) in memcpy_big_arg src s; memcpy_big_arg dst d; diff --git a/arm/Asmgen.v b/arm/Asmgen.v index 2365d1d2..7b3f2fdc 100644 --- a/arm/Asmgen.v +++ b/arm/Asmgen.v @@ -198,7 +198,7 @@ Definition rsubimm (r1 r2: ireg) (n: int) (k: code) := iterate_op (Prsb r1 r2) (Padd r1 r1) (decompose_int n) k. Definition andimm (r1 r2: ireg) (n: int) (k: code) := - if is_immed_arith n + if is_immed_arith n then Pand r1 r2 (SOimm n) :: k else iterate_op (Pbic r1 r2) (Pbic r1 r1) (decompose_int (Int.not n)) k. @@ -402,7 +402,7 @@ Definition transl_op do r <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2; OK (Pmul r r1 r2 :: k) | Omla, a1 :: a2 :: a3 :: nil => - do r <- ireg_of res; do r1 <- ireg_of a1; + do r <- ireg_of res; do r1 <- ireg_of a1; do r2 <- ireg_of a2; do r3 <- ireg_of a3; OK (Pmla r r1 r2 r3 :: k) | Omulhs, a1 :: a2 :: nil => diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v index 93c50bfb..7a29e4a5 100644 --- a/arm/Asmgenproof.v +++ b/arm/Asmgenproof.v @@ -45,17 +45,17 @@ Let tge := Genv.globalenv tprog. Lemma symbols_preserved: forall id, Genv.find_symbol tge id = Genv.find_symbol ge id. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.find_symbol_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma public_preserved: forall id, Genv.public_symbol tge id = Genv.public_symbol ge id. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.public_symbol_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma functions_translated: @@ -71,7 +71,7 @@ Lemma functions_transl: transf_function f = OK tf -> Genv.find_funct_ptr tge b = Some (Internal tf). Proof. - intros. + intros. destruct (functions_translated _ _ H) as [tf' [A B]]. rewrite A. monadInv B. f_equal. congruence. Qed. @@ -79,9 +79,9 @@ Qed. Lemma varinfo_preserved: forall b, Genv.find_var_info tge b = Genv.find_var_info ge b. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.find_var_info_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. (** * Properties of control flow *) @@ -102,7 +102,7 @@ Proof. intros. inv H. eapply exec_straight_steps_1; eauto. eapply transf_function_no_overflow; eauto. - eapply functions_transl; eauto. + eapply functions_transl; eauto. Qed. Lemma exec_straight_at: @@ -112,8 +112,8 @@ Lemma exec_straight_at: exec_straight tge tf tc rs m tc' rs' m' -> transl_code_at_pc ge (rs' PC) fb f c' ep' tf tc'. Proof. - intros. inv H. - exploit exec_straight_steps_2; eauto. + intros. inv H. + exploit exec_straight_steps_2; eauto. eapply transf_function_no_overflow; eauto. eapply functions_transl; eauto. intros [ofs' [PC' CT']]. @@ -134,22 +134,22 @@ Lemma label_pos_code_tail: forall lbl c pos c', find_label lbl c = Some c' -> exists pos', - label_pos lbl pos c = Some pos' + label_pos lbl pos c = Some pos' /\ code_tail (pos' - pos) c c' /\ pos < pos' <= pos + list_length_z c. Proof. - induction c. + induction c. simpl; intros. discriminate. simpl; intros until c'. case (is_label lbl a). intro EQ; injection EQ; intro; subst c'. exists (pos + 1). split. auto. split. - replace (pos + 1 - pos) with (0 + 1) by omega. constructor. constructor. - rewrite list_length_z_cons. generalize (list_length_z_pos c). omega. + replace (pos + 1 - pos) with (0 + 1) by omega. constructor. constructor. + rewrite list_length_z_cons. generalize (list_length_z_pos c). omega. intros. generalize (IHc (pos + 1) c' H). intros [pos' [A [B C]]]. exists pos'. split. auto. split. replace (pos' - pos) with ((pos' - (pos + 1)) + 1) by omega. - constructor. auto. + constructor. auto. rewrite list_length_z_cons. omega. Qed. @@ -242,7 +242,7 @@ Remark indexed_memory_access_label: (forall r n, nolabel (mk_instr r n)) -> tail_nolabel k (indexed_memory_access mk_instr mk_immed base ofs k). Proof. - intros. unfold indexed_memory_access. + intros. unfold indexed_memory_access. destruct (Int.eq ofs (mk_immed ofs)). TailNoLabel. eapply tail_nolabel_trans; TailNoLabel. @@ -310,18 +310,18 @@ Proof. eapply loadind_label; eauto. eapply storeind_label; eauto. destruct ep. eapply loadind_label; eauto. - eapply tail_nolabel_trans. 2: eapply loadind_label; eauto. unfold loadind_int; TailNoLabel. + eapply tail_nolabel_trans. 2: eapply loadind_label; eauto. unfold loadind_int; TailNoLabel. eapply transl_op_label; eauto. - unfold transl_load, transl_memory_access_int, transl_memory_access_float in H. - destruct m; monadInv H; eapply transl_memory_access_label; eauto; simpl; auto. - unfold transl_store, transl_memory_access_int, transl_memory_access_float in H. - destruct m; monadInv H; eapply transl_memory_access_label; eauto; simpl; auto. + unfold transl_load, transl_memory_access_int, transl_memory_access_float in H. + destruct m; monadInv H; eapply transl_memory_access_label; eauto; simpl; auto. + unfold transl_store, transl_memory_access_int, transl_memory_access_float in H. + destruct m; monadInv H; eapply transl_memory_access_label; eauto; simpl; auto. destruct s0; monadInv H; TailNoLabel. destruct s0; monadInv H; unfold loadind_int; eapply tail_nolabel_trans. eapply indexed_memory_access_label; auto with labels. TailNoLabel. eapply indexed_memory_access_label; auto with labels. TailNoLabel. eapply tail_nolabel_trans. eapply transl_cond_label; eauto. TailNoLabel. - eapply tail_nolabel_trans. unfold loadind_int. eapply indexed_memory_access_label; auto with labels. TailNoLabel. + eapply tail_nolabel_trans. unfold loadind_int. eapply indexed_memory_access_label; auto with labels. TailNoLabel. Qed. Lemma transl_instr_label': @@ -330,7 +330,7 @@ Lemma transl_instr_label': find_label lbl c = if Mach.is_label lbl i then Some k else find_label lbl k. Proof. intros. exploit transl_instr_label; eauto. - destruct i; try (intros [A B]; apply B). + destruct i; try (intros [A B]; apply B). intros. subst c. simpl. auto. Qed. @@ -345,7 +345,7 @@ Proof. induction c; simpl; intros. inv H. auto. monadInv H. rewrite (transl_instr_label' lbl _ _ _ _ _ EQ0). - generalize (Mach.is_label_correct lbl a). + generalize (Mach.is_label_correct lbl a). destruct (Mach.is_label lbl a); intros. subst a. simpl in EQ. exists x; auto. eapply IHc; eauto. @@ -361,7 +361,7 @@ Lemma transl_find_label: Proof. intros. monadInv H. destruct (zlt Int.max_unsigned (list_length_z (fn_code x))); inv EQ0. monadInv EQ. simpl. - eapply transl_code_label; eauto. + eapply transl_code_label; eauto. Qed. End TRANSL_LABEL. @@ -376,17 +376,17 @@ Lemma find_label_goto_label: rs PC = Vptr b ofs -> Mach.find_label lbl f.(Mach.fn_code) = Some c' -> exists tc', exists rs', - goto_label tf lbl rs m = Next rs' m + goto_label tf lbl rs m = Next rs' m /\ transl_code_at_pc ge (rs' PC) b f c' false tf tc' /\ forall r, r <> PC -> rs'#r = rs#r. Proof. - intros. exploit (transl_find_label lbl f tf); eauto. rewrite H2. + intros. exploit (transl_find_label lbl f tf); eauto. rewrite H2. intros [tc [A B]]. exploit label_pos_code_tail; eauto. instantiate (1 := 0). intros [pos' [P [Q R]]]. exists tc; exists (rs#PC <- (Vptr b (Int.repr pos'))). split. unfold goto_label. rewrite P. rewrite H1. auto. - split. rewrite Pregmap.gss. constructor; auto. + split. rewrite Pregmap.gss. constructor; auto. rewrite Int.unsigned_repr. replace (pos' - 0) with pos' in Q. auto. omega. generalize (transf_function_no_overflow _ _ H0). omega. @@ -399,10 +399,10 @@ Lemma return_address_exists: forall f sg ros c, is_tail (Mcall sg ros :: c) f.(Mach.fn_code) -> exists ra, return_address_offset f c ra. Proof. - intros. eapply Asmgenproof0.return_address_exists; eauto. -- intros. exploit transl_instr_label; eauto. + intros. eapply Asmgenproof0.return_address_exists; eauto. +- intros. exploit transl_instr_label; eauto. destruct i; try (intros [A B]; apply A). intros. subst c0. repeat constructor. -- intros. monadInv H0. +- intros. monadInv H0. destruct (zlt Int.max_unsigned (list_length_z (fn_code x))); inv EQ0. monadInv EQ. exists x; exists true; split; auto. repeat constructor. - exact transf_function_no_overflow. @@ -470,10 +470,10 @@ Lemma exec_straight_steps: plus step tge (State rs1 m1') E0 st' /\ match_states (Mach.State s fb sp c ms2 m2) st'. Proof. - intros. inversion H2. subst. monadInv H7. - exploit H3; eauto. intros [rs2 [A [B C]]]. + intros. inversion H2. subst. monadInv H7. + exploit H3; eauto. intros [rs2 [A [B C]]]. exists (State rs2 m2'); split. - eapply exec_straight_exec; eauto. + eapply exec_straight_exec; eauto. econstructor; eauto. eapply exec_straight_at; eauto. Qed. @@ -498,15 +498,15 @@ Proof. exploit H5; eauto. intros [jmp [k' [rs2 [A [B C]]]]]. generalize (functions_transl _ _ _ H7 H8); intro FN. generalize (transf_function_no_overflow _ _ H8); intro NOOV. - exploit exec_straight_steps_2; eauto. + exploit exec_straight_steps_2; eauto. intros [ofs' [PC2 CT2]]. - exploit find_label_goto_label; eauto. + exploit find_label_goto_label; eauto. intros [tc' [rs3 [GOTO [AT' OTH]]]]. exists (State rs3 m2'); split. eapply plus_right'. - eapply exec_straight_steps_1; eauto. + eapply exec_straight_steps_1; eauto. econstructor; eauto. - eapply find_instr_tail. eauto. + eapply find_instr_tail. eauto. rewrite C. eexact GOTO. traceEq. econstructor; eauto. @@ -531,8 +531,8 @@ Definition measure (s: Mach.state) : nat := Remark preg_of_not_R12: forall r, negb (mreg_eq r R12) = true -> IR IR12 <> preg_of r. Proof. - intros. change (IR IR12) with (preg_of R12). red; intros. - exploit preg_of_injective; eauto. intros; subst r. + intros. change (IR IR12) with (preg_of R12). red; intros. + exploit preg_of_injective; eauto. intros; subst r. unfold proj_sumbool in H; rewrite dec_eq_true in H; discriminate. Qed. @@ -547,8 +547,8 @@ Proof. induction 1; intros; inv MS. - (* Mlabel *) - left; eapply exec_straight_steps; eauto; intros. - monadInv TR. econstructor; split. apply exec_straight_one. simpl; eauto. auto. + left; eapply exec_straight_steps; eauto; intros. + monadInv TR. econstructor; split. apply exec_straight_one. simpl; eauto. auto. split. apply agree_nextinstr; auto. simpl; congruence. - (* Mgetstack *) @@ -564,7 +564,7 @@ Proof. - (* Msetstack *) unfold store_stack in H. assert (Val.lessdef (rs src) (rs0 (preg_of src))). eapply preg_val; eauto. - exploit Mem.storev_extends; eauto. intros [m2' [A B]]. + exploit Mem.storev_extends; eauto. intros [m2' [A B]]. left; eapply exec_straight_steps; eauto. rewrite (sp_val _ _ _ AG) in A. intros. simpl in TR. exploit storeind_correct; eauto with asmgen. intros [rs' [P Q]]. @@ -574,11 +574,11 @@ Proof. - (* Mgetparam *) assert (f0 = f) by congruence; subst f0. - unfold load_stack in *. - exploit Mem.loadv_extends. eauto. eexact H0. auto. + unfold load_stack in *. + exploit Mem.loadv_extends. eauto. eexact H0. auto. intros [parent' [A B]]. rewrite (sp_val _ _ _ AG) in A. exploit lessdef_parent_sp; eauto. clear B; intros B; subst parent'. - exploit Mem.loadv_extends. eauto. eexact H1. auto. + exploit Mem.loadv_extends. eauto. eexact H1. auto. intros [v' [C D]]. Opaque loadind. left; eapply exec_straight_steps; eauto; intros. @@ -587,63 +587,63 @@ Opaque loadind. exploit loadind_correct. eexact EQ. instantiate (2 := rs0). rewrite DXP; eauto. intros [rs1 [P [Q R]]]. - exists rs1; split. eauto. + exists rs1; split. eauto. split. eapply agree_set_mreg. eapply agree_set_mreg; eauto. congruence. auto with asmgen. - simpl; intros. rewrite R; auto with asmgen. + simpl; intros. rewrite R; auto with asmgen. apply preg_of_not_R12; auto. (* GPR11 does not contain parent *) exploit loadind_int_correct. eexact A. instantiate (1 := IR12). intros [rs1 [P [Q R]]]. - exploit loadind_correct. eexact EQ. instantiate (2 := rs1). rewrite Q. eauto. intros [rs2 [S [T U]]]. + exploit loadind_correct. eexact EQ. instantiate (2 := rs1). rewrite Q. eauto. intros [rs2 [S [T U]]]. exists rs2; split. eapply exec_straight_trans; eauto. split. eapply agree_set_mreg. eapply agree_set_mreg. eauto. eauto. instantiate (1 := rs1#IR12 <- (rs2#IR12)). intros. rewrite Pregmap.gso; auto with asmgen. - congruence. intros. unfold Pregmap.set. destruct (PregEq.eq r' IR12). congruence. auto with asmgen. - simpl; intros. rewrite U; auto with asmgen. + congruence. intros. unfold Pregmap.set. destruct (PregEq.eq r' IR12). congruence. auto with asmgen. + simpl; intros. rewrite U; auto with asmgen. apply preg_of_not_R12; auto. - (* Mop *) - assert (eval_operation tge sp op rs##args m = Some v). + assert (eval_operation tge sp op rs##args m = Some v). rewrite <- H. apply eval_operation_preserved. exact symbols_preserved. exploit eval_operation_lessdef. eapply preg_vals; eauto. eauto. eexact H0. - intros [v' [A B]]. rewrite (sp_val _ _ _ AG) in A. + intros [v' [A B]]. rewrite (sp_val _ _ _ AG) in A. left; eapply exec_straight_steps; eauto; intros. simpl in TR. exploit transl_op_correct; eauto. intros [rs2 [P [Q R]]]. assert (S: Val.lessdef v (rs2 (preg_of res))) by (eapply Val.lessdef_trans; eauto). exists rs2; split. eauto. split. eapply agree_set_undef_mreg; eauto with asmgen. - simpl. destruct op; try congruence. destruct ep; simpl; try congruence. intros. + simpl. destruct op; try congruence. destruct ep; simpl; try congruence. intros. rewrite R; auto. apply preg_of_not_R12; auto. exact I. - (* Mload *) - assert (eval_addressing tge sp addr rs##args = Some a). + assert (eval_addressing tge sp addr rs##args = Some a). rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1. intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A. exploit Mem.loadv_extends; eauto. intros [v' [C D]]. left; eapply exec_straight_steps; eauto; intros. simpl in TR. - exploit transl_load_correct; eauto. intros [rs2 [P [Q R]]]. + exploit transl_load_correct; eauto. intros [rs2 [P [Q R]]]. exists rs2; split. eauto. split. eapply agree_set_undef_mreg; eauto. congruence. simpl; congruence. - (* Mstore *) - assert (eval_addressing tge sp addr rs##args = Some a). + assert (eval_addressing tge sp addr rs##args = Some a). rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1. intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A. assert (Val.lessdef (rs src) (rs0 (preg_of src))). eapply preg_val; eauto. exploit Mem.storev_extends; eauto. intros [m2' [C D]]. left; eapply exec_straight_steps; eauto. - intros. simpl in TR. + intros. simpl in TR. exploit transl_store_correct; eauto. intros [rs2 [P Q]]. exists rs2; split. eauto. - split. eapply agree_undef_regs; eauto. + split. eapply agree_undef_regs; eauto. simpl; congruence. - (* Mcall *) assert (f0 = f) by congruence. subst f0. - inv AT. + inv AT. assert (NOOV: list_length_z (fn_code tf) <= Int.max_unsigned). eapply transf_function_no_overflow; eauto. destruct ros as [rf|fid]; simpl in H; monadInv H5. @@ -659,23 +659,23 @@ Opaque loadind. exploit return_address_offset_correct; eauto. intros; subst ra. left; econstructor; split. apply plus_one. eapply exec_step_internal. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. eauto. - econstructor; eauto. + econstructor; eauto. econstructor; eauto. eapply agree_sp_def; eauto. - simpl. eapply agree_exten; eauto. intros. Simpl. + simpl. eapply agree_exten; eauto. intros. Simpl. Simpl. rewrite <- H2. auto. + (* Direct call *) generalize (code_tail_next_int _ _ _ _ NOOV H6). intro CT1. assert (TCA: transl_code_at_pc ge (Vptr fb (Int.add ofs Int.one)) fb f c false tf x). - econstructor; eauto. + econstructor; eauto. exploit return_address_offset_correct; eauto. intros; subst ra. left; econstructor; split. apply plus_one. eapply exec_step_internal. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. eauto. - econstructor; eauto. + econstructor; eauto. econstructor; eauto. eapply agree_sp_def; eauto. simpl. eapply agree_exten; eauto. intros. Simpl. @@ -692,7 +692,7 @@ Opaque loadind. unfold chunk_of_type. rewrite (sp_val _ _ _ AG). intros [ra' [C D]]. exploit lessdef_parent_sp; eauto. intros. subst parent'. clear B. exploit lessdef_parent_ra; eauto. intros. subst ra'. clear D. - exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. + exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. assert (X: forall k, exists rs2, exec_straight tge tf (loadind_int IR13 (fn_retaddr_ofs f) IR14 @@ -702,13 +702,13 @@ Opaque loadind. /\ rs2#RA = parent_ra s /\ forall r, if_preg r = true -> r <> SP -> r <> IR14 -> rs2#r = rs0#r). { - intros. - exploit loadind_int_correct. eexact C. intros [rs1 [P [Q R]]]. + intros. + exploit loadind_int_correct. eexact C. intros [rs1 [P [Q R]]]. econstructor; split. - eapply exec_straight_trans. eexact P. apply exec_straight_one. - simpl. rewrite R; auto with asmgen. unfold chunk_of_type in A. rewrite A. - rewrite <- (sp_val _ _ _ AG). rewrite E. eauto. auto. - split. Simpl. split. Simpl. intros. Simpl. + eapply exec_straight_trans. eexact P. apply exec_straight_one. + simpl. rewrite R; auto with asmgen. unfold chunk_of_type in A. rewrite A. + rewrite <- (sp_val _ _ _ AG). rewrite E. eauto. auto. + split. Simpl. split. Simpl. intros. Simpl. } destruct ros as [rf|fid]; simpl in H; monadInv H7. + (* Indirect call *) @@ -718,45 +718,45 @@ Opaque loadind. assert (rs0 x0 = Vptr f' Int.zero). exploit ireg_val; eauto. rewrite H7; intros LD; inv LD; auto. destruct (X (Pbreg x0 sig :: x)) as [rs2 [P [Q [R S]]]]. - exploit exec_straight_steps_2. eexact P. eauto. eauto. eapply functions_transl; eauto. eauto. + exploit exec_straight_steps_2. eexact P. eauto. eauto. eapply functions_transl; eauto. eauto. intros [ofs' [Y Z]]. left; econstructor; split. - eapply plus_right'. eapply exec_straight_exec; eauto. - econstructor. eauto. eapply functions_transl; eauto. - eapply find_instr_tail; eauto. - simpl. reflexivity. + eapply plus_right'. eapply exec_straight_exec; eauto. + econstructor. eauto. eapply functions_transl; eauto. + eapply find_instr_tail; eauto. + simpl. reflexivity. traceEq. - econstructor; eauto. - split. Simpl. eapply parent_sp_def; eauto. - intros. Simpl. rewrite S; auto with asmgen. eapply preg_val; eauto. + econstructor; eauto. + split. Simpl. eapply parent_sp_def; eauto. + intros. Simpl. rewrite S; auto with asmgen. eapply preg_val; eauto. Simpl. rewrite S; auto with asmgen. rewrite <- (ireg_of_eq _ _ EQ1); auto with asmgen. rewrite <- (ireg_of_eq _ _ EQ1); auto with asmgen. + (* Direct call *) destruct (X (Pbsymb fid sig :: x)) as [rs2 [P [Q [R S]]]]. - exploit exec_straight_steps_2. eexact P. eauto. eauto. eapply functions_transl; eauto. eauto. + exploit exec_straight_steps_2. eexact P. eauto. eauto. eapply functions_transl; eauto. eauto. intros [ofs' [Y Z]]. left; econstructor; split. - eapply plus_right'. eapply exec_straight_exec; eauto. - econstructor. eauto. eapply functions_transl; eauto. - eapply find_instr_tail; eauto. - simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. reflexivity. + eapply plus_right'. eapply exec_straight_exec; eauto. + econstructor. eauto. eapply functions_transl; eauto. + eapply find_instr_tail; eauto. + simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. reflexivity. traceEq. econstructor; eauto. - split. Simpl. eapply parent_sp_def; eauto. - intros. Simpl. rewrite S; auto with asmgen. eapply preg_val; eauto. + split. Simpl. eapply parent_sp_def; eauto. + intros. Simpl. rewrite S; auto with asmgen. eapply preg_val; eauto. - (* Mbuiltin *) - inv AT. monadInv H4. + inv AT. monadInv H4. exploit functions_transl; eauto. intro FN. generalize (transf_function_no_overflow _ _ H3); intro NOOV. - exploit builtin_args_match; eauto. intros [vargs' [P Q]]. + exploit builtin_args_match; eauto. intros [vargs' [P Q]]. exploit external_call_mem_extends; eauto. intros [vres' [m2' [A [B [C D]]]]]. - left. econstructor; split. apply plus_one. + left. econstructor; split. apply plus_one. eapply exec_step_builtin. eauto. eauto. eapply find_instr_tail; eauto. - erewrite <- sp_val by eauto. + erewrite <- sp_val by eauto. eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. @@ -770,12 +770,12 @@ Opaque loadind. rewrite preg_notin_charact. intros. auto with asmgen. auto with asmgen. apply agree_nextinstr. eapply agree_set_res; auto. - eapply agree_undef_regs; eauto. intros; apply undef_regs_other_2; auto. + eapply agree_undef_regs; eauto. intros; apply undef_regs_other_2; auto. congruence. - (* Mgoto *) assert (f0 = f) by congruence. subst f0. - inv AT. monadInv H4. + inv AT. monadInv H4. exploit find_label_goto_label; eauto. intros [tc' [rs' [GOTO [AT2 INV]]]]. left; exists (State rs' m'); split. apply plus_one. econstructor; eauto. @@ -793,9 +793,9 @@ Opaque loadind. intros. simpl in TR. destruct (transl_cond_correct tge tf cond args _ rs0 m' _ TR) as [rs' [A [B C]]]. rewrite EC in B. destruct B as [Bpos Bneg]. - econstructor; econstructor; econstructor; split. eexact A. + econstructor; econstructor; econstructor; split. eexact A. split. eapply agree_undef_regs; eauto with asmgen. - simpl. rewrite Bpos. reflexivity. + simpl. rewrite Bpos. reflexivity. - (* Mcond false *) exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros EC. @@ -803,7 +803,7 @@ Opaque loadind. destruct (transl_cond_correct tge tf cond args _ rs0 m' _ TR) as [rs' [A [B C]]]. rewrite EC in B. destruct B as [Bpos Bneg]. econstructor; split. - eapply exec_straight_trans. eexact A. + eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl. rewrite Bpos. reflexivity. auto. split. eapply agree_undef_regs; eauto with asmgen. intros; Simpl. @@ -811,32 +811,32 @@ Opaque loadind. - (* Mjumptable *) assert (f0 = f) by congruence. subst f0. - inv AT. monadInv H6. + inv AT. monadInv H6. exploit functions_transl; eauto. intro FN. generalize (transf_function_no_overflow _ _ H5); intro NOOV. exploit find_label_goto_label. eauto. eauto. - instantiate (2 := rs0#IR14 <- Vundef). + instantiate (2 := rs0#IR14 <- Vundef). Simpl. eauto. - eauto. + eauto. intros [tc' [rs' [A [B C]]]]. exploit ireg_val; eauto. rewrite H. intros LD; inv LD. left; econstructor; split. - apply plus_one. econstructor; eauto. - eapply find_instr_tail; eauto. + apply plus_one. econstructor; eauto. + eapply find_instr_tail; eauto. simpl. rewrite <- H9. unfold Mach.label in H0; unfold label; rewrite H0. eexact A. - econstructor; eauto. - eapply agree_undef_regs; eauto. intros. rewrite C; auto with asmgen. Simpl. + econstructor; eauto. + eapply agree_undef_regs; eauto. intros. rewrite C; auto with asmgen. Simpl. congruence. - (* Mreturn *) assert (f0 = f) by congruence. subst f0. - inversion AT; subst. + inversion AT; subst. assert (NOOV: list_length_z (fn_code tf) <= Int.max_unsigned). eapply transf_function_no_overflow; eauto. rewrite (sp_val _ _ _ AG) in *. unfold load_stack in *. - exploit Mem.loadv_extends. eauto. eexact H0. auto. simpl. intros [parent' [A B]]. + exploit Mem.loadv_extends. eauto. eexact H0. auto. simpl. intros [parent' [A B]]. exploit lessdef_parent_sp; eauto. intros. subst parent'. clear B. - exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [ra' [C D]]. + exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [ra' [C D]]. exploit lessdef_parent_ra; eauto. intros. subst ra'. clear D. exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. monadInv H6. @@ -849,40 +849,40 @@ Opaque loadind. /\ rs2#RA = parent_ra s /\ forall r, if_preg r = true -> r <> SP -> r <> IR14 -> rs2#r = rs0#r). { - intros. - exploit loadind_int_correct. eexact C. intros [rs1 [P [Q R]]]. + intros. + exploit loadind_int_correct. eexact C. intros [rs1 [P [Q R]]]. econstructor; split. - eapply exec_straight_trans. eexact P. apply exec_straight_one. - simpl. rewrite R; auto with asmgen. rewrite A. - rewrite <- (sp_val _ _ _ AG). rewrite E. eauto. auto. + eapply exec_straight_trans. eexact P. apply exec_straight_one. + simpl. rewrite R; auto with asmgen. rewrite A. + rewrite <- (sp_val _ _ _ AG). rewrite E. eauto. auto. split. Simpl. split. Simpl. - intros. Simpl. + intros. Simpl. } destruct (X (Pbreg IR14 (Mach.fn_sig f) :: x)) as [rs2 [P [Q [R S]]]]. - exploit exec_straight_steps_2. eexact P. eauto. eauto. eapply functions_transl; eauto. eauto. + exploit exec_straight_steps_2. eexact P. eauto. eauto. eapply functions_transl; eauto. eauto. intros [ofs' [Y Z]]. left; econstructor; split. - eapply plus_right'. eapply exec_straight_exec; eauto. - econstructor. eauto. eapply functions_transl; eauto. - eapply find_instr_tail; eauto. + eapply plus_right'. eapply exec_straight_exec; eauto. + econstructor. eauto. eapply functions_transl; eauto. + eapply find_instr_tail; eauto. simpl. reflexivity. traceEq. - econstructor; eauto. + econstructor; eauto. split. Simpl. eapply parent_sp_def; eauto. intros. Simpl. rewrite S; auto with asmgen. eapply preg_val; eauto. - (* internal function *) exploit functions_translated; eauto. intros [tf [A B]]. monadInv B. - generalize EQ; intros EQ'. monadInv EQ'. + generalize EQ; intros EQ'. monadInv EQ'. destruct (zlt Int.max_unsigned (list_length_z (fn_code x0))); inversion EQ1. clear EQ1. - monadInv EQ0. - unfold store_stack in *. - exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. + monadInv EQ0. + unfold store_stack in *. + exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. intros [m1' [C D]]. - exploit Mem.storev_extends. eexact D. eexact H1. eauto. eauto. + exploit Mem.storev_extends. eexact D. eexact H1. eauto. eauto. intros [m2' [F G]]. - exploit Mem.storev_extends. eexact G. eexact H2. eauto. eauto. + exploit Mem.storev_extends. eexact G. eexact H2. eauto. eauto. intros [m3' [P Q]]. (* Execution of function prologue *) set (rs2 := nextinstr (rs0#IR12 <- (parent_sp s) #IR13 <- (Vptr stk Int.zero))). @@ -894,34 +894,34 @@ Opaque loadind. rewrite <- H5 at 2; unfold fn_code. apply exec_straight_two with rs2 m2'. unfold exec_instr. rewrite C. fold sp. - rewrite <- (sp_val _ _ _ AG). unfold chunk_of_type in F. rewrite F. auto. + rewrite <- (sp_val _ _ _ AG). unfold chunk_of_type in F. rewrite F. auto. simpl. auto. - simpl. unfold exec_store. change (rs2 IR14) with (rs0 IR14). + simpl. unfold exec_store. change (rs2 IR14) with (rs0 IR14). rewrite Int.add_zero_l. simpl. unfold chunk_of_type in P. simpl in P. - rewrite Int.add_zero_l in P. rewrite ATLR. rewrite P. auto. auto. auto. + rewrite Int.add_zero_l in P. rewrite ATLR. rewrite P. auto. auto. auto. left; exists (State rs3 m3'); split. - eapply exec_straight_steps_1; eauto. omega. constructor. - econstructor; eauto. + eapply exec_straight_steps_1; eauto. omega. constructor. + econstructor; eauto. change (rs3 PC) with (Val.add (Val.add (rs0 PC) Vone) Vone). rewrite ATPC. simpl. constructor; eauto. - subst x. eapply code_tail_next_int. omega. - eapply code_tail_next_int. omega. constructor. + subst x. eapply code_tail_next_int. omega. + eapply code_tail_next_int. omega. constructor. unfold rs3, rs2. apply agree_nextinstr. apply agree_nextinstr. - eapply agree_change_sp. + eapply agree_change_sp. apply agree_undef_regs with rs0; eauto. intros. Simpl. congruence. - (* external function *) exploit functions_translated; eauto. intros [tf [A B]]. simpl in B. inv B. - exploit extcall_arguments_match; eauto. + exploit extcall_arguments_match; eauto. intros [args' [C D]]. exploit external_call_mem_extends'; eauto. intros [res' [m2' [P [Q [R S]]]]]. left; econstructor; split. - apply plus_one. eapply exec_step_external; eauto. - eapply external_call_symbols_preserved'; eauto. + apply plus_one. eapply exec_step_external; eauto. + eapply external_call_symbols_preserved'; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. econstructor; eauto. apply agree_set_other; auto with asmgen. @@ -946,20 +946,20 @@ Proof. econstructor; eauto. constructor. apply Mem.extends_refl. - split. auto. simpl. unfold Vzero; congruence. intros. rewrite Regmap.gi. auto. - unfold Genv.symbol_address. + split. auto. simpl. unfold Vzero; congruence. intros. rewrite Regmap.gi. auto. + unfold Genv.symbol_address. rewrite (transform_partial_program_main _ _ TRANSF). - rewrite symbols_preserved. + rewrite symbols_preserved. unfold ge; rewrite H1. auto. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> Mach.final_state st1 r -> Asm.final_state st2 r. Proof. intros. inv H0. inv H. inv STACKS. constructor. - auto. - compute in H1. inv H1. + auto. + compute in H1. inv H1. generalize (preg_val _ _ _ R0 AG). rewrite H2. intros LD; inv LD. auto. Qed. diff --git a/arm/Asmgenproof1.v b/arm/Asmgenproof1.v index f0a698eb..3e222ba4 100644 --- a/arm/Asmgenproof1.v +++ b/arm/Asmgenproof1.v @@ -51,7 +51,7 @@ Hint Resolve ireg_of_not_R14': asmgen. Lemma nextinstr_nf_pc: forall rs, (nextinstr_nf rs)#PC = Val.add rs#PC Vone. Proof. - intros. reflexivity. + intros. reflexivity. Qed. Definition if_preg (r: preg) : bool := @@ -83,7 +83,7 @@ Qed. Lemma nextinstr_nf_inv1: forall r rs, data_preg r = true -> (nextinstr_nf rs)#r = rs#r. Proof. - intros. destruct r; reflexivity || discriminate. + intros. destruct r; reflexivity || discriminate. Qed. (** Useful simplification tactic *) @@ -143,14 +143,14 @@ Proof. auto. predSpec Int.eq Int.eq_spec (Int.and n (Int.shl (Int.repr 3) p)) Int.zero. auto. - simpl. rewrite IHN. rewrite Int.add_assoc. decEq. rewrite Int.add_and. + simpl. rewrite IHN. rewrite Int.add_assoc. decEq. rewrite Int.add_and. rewrite Int.or_not_self. apply Int.and_mone. apply Int.and_not_self. Qed. Remark decompose_int_arm_nil: forall N n p, decompose_int_arm N n p = nil -> n = Int.zero. Proof. - intros. generalize (decompose_int_arm_or N n p Int.zero). rewrite H. simpl. + intros. generalize (decompose_int_arm_or N n p Int.zero). rewrite H. simpl. rewrite Int.or_commut; rewrite Int.or_zero; auto. Qed. @@ -189,14 +189,14 @@ Proof. auto. predSpec Int.eq Int.eq_spec (Int.and n (Int.shl Int.one p)) Int.zero. auto. - simpl. rewrite IHN. rewrite Int.add_assoc. decEq. rewrite Int.add_and. + simpl. rewrite IHN. rewrite Int.add_assoc. decEq. rewrite Int.add_and. rewrite Int.or_not_self. apply Int.and_mone. apply Int.and_not_self. Qed. Remark decompose_int_thumb_nil: forall N n p, decompose_int_thumb N n p = nil -> n = Int.zero. Proof. - intros. generalize (decompose_int_thumb_or N n p Int.zero). rewrite H. simpl. + intros. generalize (decompose_int_thumb_or N n p Int.zero). rewrite H. simpl. rewrite Int.or_commut; rewrite Int.or_zero; auto. Qed. @@ -219,16 +219,16 @@ Proof. rewrite IHl. rewrite DISTR. decEq. decEq. auto. intros. unfold decompose_int, decompose_int_base. destruct (thumb tt); [destruct (is_immed_arith_thumb_special n)|]. -- reflexivity. +- reflexivity. - destruct (decompose_int_thumb 24%nat n Int.zero) eqn:DB. + simpl. exploit decompose_int_thumb_nil; eauto. congruence. + simpl. rewrite B. decEq. - generalize (DECOMP2 24%nat n Int.zero Int.zero). + generalize (DECOMP2 24%nat n Int.zero Int.zero). rewrite DB; simpl. rewrite ! ZERO. auto. - destruct (decompose_int_arm 12%nat n Int.zero) eqn:DB. + simpl. exploit decompose_int_arm_nil; eauto. congruence. + simpl. rewrite B. decEq. - generalize (DECOMP1 12%nat n Int.zero Int.zero). + generalize (DECOMP1 12%nat n Int.zero Int.zero). rewrite DB; simpl. rewrite ! ZERO. auto. Qed. @@ -240,7 +240,7 @@ Proof. intros. rewrite Val.or_assoc. auto. apply Int.or_assoc. intros. rewrite Int.or_commut. apply Int.or_zero. - apply decompose_int_arm_or. apply decompose_int_thumb_or. + apply decompose_int_arm_or. apply decompose_int_thumb_or. Qed. Lemma decompose_int_bic: @@ -259,7 +259,7 @@ Lemma decompose_int_xor: List.fold_left (fun v i => Val.xor v (Vint i)) (decompose_int n) v = Val.xor v (Vint n). Proof. intros. apply decompose_int_general with (f := fun v n => Val.xor v (Vint n)) (g := Int.xor). - intros. rewrite Val.xor_assoc. auto. + intros. rewrite Val.xor_assoc. auto. apply Int.xor_assoc. intros. rewrite Int.xor_commut. apply Int.xor_zero. apply decompose_int_arm_xor. apply decompose_int_thumb_xor. @@ -270,10 +270,10 @@ Lemma decompose_int_add: List.fold_left (fun v i => Val.add v (Vint i)) (decompose_int n) v = Val.add v (Vint n). Proof. intros. apply decompose_int_general with (f := fun v n => Val.add v (Vint n)) (g := Int.add). - intros. rewrite Val.add_assoc. auto. + intros. rewrite Val.add_assoc. auto. apply Int.add_assoc. intros. rewrite Int.add_commut. apply Int.add_zero. - apply decompose_int_arm_add. apply decompose_int_thumb_add. + apply decompose_int_arm_add. apply decompose_int_thumb_add. Qed. Lemma decompose_int_sub: @@ -281,11 +281,11 @@ Lemma decompose_int_sub: List.fold_left (fun v i => Val.sub v (Vint i)) (decompose_int n) v = Val.sub v (Vint n). Proof. intros. apply decompose_int_general with (f := fun v n => Val.sub v (Vint n)) (g := Int.add). - intros. repeat rewrite Val.sub_add_opp. rewrite Val.add_assoc. decEq. simpl. decEq. + intros. repeat rewrite Val.sub_add_opp. rewrite Val.add_assoc. decEq. simpl. decEq. rewrite Int.neg_add_distr; auto. apply Int.add_assoc. intros. rewrite Int.add_commut. apply Int.add_zero. - apply decompose_int_arm_add. apply decompose_int_thumb_add. + apply decompose_int_arm_add. apply decompose_int_thumb_add. Qed. Lemma iterate_op_correct: @@ -311,16 +311,16 @@ Proof. split. apply exec_straight_one. rewrite SEM1. reflexivity. reflexivity. intuition Simpl. (* inductive case *) - intros. - rewrite List.map_app. simpl. rewrite app_ass. simpl. + intros. + rewrite List.map_app. simpl. rewrite app_ass. simpl. destruct (H (op2 (SOimm x) :: k)) as [rs' [A [B C]]]. econstructor. split. eapply exec_straight_trans. eexact A. apply exec_straight_one. rewrite SEM2. reflexivity. reflexivity. - split. rewrite fold_left_app; simpl. Simpl. rewrite B. auto. + split. rewrite fold_left_app; simpl. Simpl. rewrite B. auto. intros; Simpl. Qed. - + (** Loading a constant. *) Lemma loadimm_correct: @@ -335,28 +335,28 @@ Proof. set (l2 := length (decompose_int (Int.not n))). destruct (NPeano.leb l1 1%nat). { (* single mov *) - econstructor; split. apply exec_straight_one. simpl; reflexivity. auto. + econstructor; split. apply exec_straight_one. simpl; reflexivity. auto. split; intros; Simpl. } destruct (NPeano.leb l2 1%nat). { (* single movn *) econstructor; split. apply exec_straight_one. - simpl. rewrite Int.not_involutive. reflexivity. auto. + simpl. rewrite Int.not_involutive. reflexivity. auto. split; intros; Simpl. } destruct (thumb tt). { (* movw / movt *) unfold loadimm_thumb. destruct (Int.eq (Int.shru n (Int.repr 16)) Int.zero). econstructor; split. - apply exec_straight_one. simpl; eauto. auto. split; intros; Simpl. + apply exec_straight_one. simpl; eauto. auto. split; intros; Simpl. econstructor; split. eapply exec_straight_two. simpl; reflexivity. simpl; reflexivity. auto. auto. - split; intros; Simpl. simpl. f_equal. rewrite Int.zero_ext_and by omega. + split; intros; Simpl. simpl. f_equal. rewrite Int.zero_ext_and by omega. rewrite Int.and_assoc. change 65535 with (two_p 16 - 1). rewrite Int.and_idem. - apply Int.same_bits_eq; intros. + apply Int.same_bits_eq; intros. rewrite Int.bits_or, Int.bits_and, Int.bits_shl, Int.testbit_repr by auto. rewrite Int.Ztestbit_two_p_m1 by omega. change (Int.unsigned (Int.repr 16)) with 16. destruct (zlt i 16). rewrite andb_true_r, orb_false_r; auto. - rewrite andb_false_r; simpl. rewrite Int.bits_shru by omega. + rewrite andb_false_r; simpl. rewrite Int.bits_shru by omega. change (Int.unsigned (Int.repr 16)) with 16. rewrite zlt_true by omega. f_equal; omega. } destruct (NPeano.leb l1 l2). @@ -388,8 +388,8 @@ Proof. intros. unfold addimm. destruct (Int.ltu (Int.repr (-256)) n). (* sub *) - econstructor; split. apply exec_straight_one; simpl; auto. - split; intros; Simpl. apply Val.sub_opp_add. + econstructor; split. apply exec_straight_one; simpl; auto. + split; intros; Simpl. apply Val.sub_opp_add. destruct (NPeano.leb (length (decompose_int n)) (length (decompose_int (Int.neg n)))). (* add - add* *) replace (Val.add (rs r2) (Vint n)) @@ -445,7 +445,7 @@ Proof. auto. intros. simpl. destruct (rs r2); auto. simpl. rewrite Int.sub_add_opp. rewrite Int.add_commut; auto. - rewrite decompose_int_add. + rewrite decompose_int_add. destruct (rs r2); simpl; auto. rewrite Int.sub_add_opp. rewrite Int.add_commut; auto. Qed. @@ -497,14 +497,14 @@ Lemma indexed_memory_access_correct: (forall (r: preg), if_preg r = true -> r <> IR14 -> rs1 r = rs r) -> exists rs', exec_straight ge fn (mk_instr r1 n1 :: k) rs1 m k rs' m' /\ P rs') -> - exists rs', + exists rs', exec_straight ge fn (indexed_memory_access mk_instr mk_immed base n k) rs m k rs' m' /\ P rs'. Proof. intros until m'; intros SEM. - unfold indexed_memory_access. + unfold indexed_memory_access. destruct (Int.eq n (mk_immed n)). - apply SEM; auto. - destruct (addimm_correct IR14 base (Int.sub n (mk_immed n)) (mk_instr IR14 (mk_immed n) :: k) rs m) @@ -512,10 +512,10 @@ Proof. destruct (SEM IR14 rs1 (mk_immed n) k) as (rs2 & D & E). rewrite B. rewrite Val.add_assoc. f_equal. simpl. rewrite Int.sub_add_opp. rewrite Int.add_assoc. - rewrite (Int.add_commut (Int.neg (mk_immed n))). + rewrite (Int.add_commut (Int.neg (mk_immed n))). rewrite Int.add_neg_zero. rewrite Int.add_zero. auto. - auto with asmgen. - exists rs2; split; auto. eapply exec_straight_trans; eauto. + auto with asmgen. + exists rs2; split; auto. eapply exec_straight_trans; eauto. Qed. Lemma loadind_int_correct: @@ -527,7 +527,7 @@ Lemma loadind_int_correct: /\ forall r, if_preg r = true -> r <> IR14 -> r <> dst -> rs'#r = rs#r. Proof. intros; unfold loadind_int. apply indexed_memory_access_correct; intros. - econstructor; split. + econstructor; split. apply exec_straight_one. simpl. unfold exec_load. rewrite H0; rewrite H; eauto. auto. split; intros; Simpl. Qed. @@ -543,26 +543,26 @@ Lemma loadind_correct: Proof. unfold loadind; intros. destruct ty; destruct (preg_of dst); inv H; simpl in H0. - (* int *) - apply loadind_int_correct; auto. + apply loadind_int_correct; auto. - (* float *) apply indexed_memory_access_correct; intros. - econstructor; split. - apply exec_straight_one. simpl. unfold exec_load. rewrite H. rewrite H0. eauto. auto. + econstructor; split. + apply exec_straight_one. simpl. unfold exec_load. rewrite H. rewrite H0. eauto. auto. split; intros; Simpl. - (* single *) apply indexed_memory_access_correct; intros. - econstructor; split. - apply exec_straight_one. simpl. unfold exec_load. rewrite H. rewrite H0. eauto. auto. + econstructor; split. + apply exec_straight_one. simpl. unfold exec_load. rewrite H. rewrite H0. eauto. auto. split; intros; Simpl. - (* any32 *) apply indexed_memory_access_correct; intros. - econstructor; split. - apply exec_straight_one. simpl. unfold exec_load. rewrite H. rewrite H0. eauto. auto. + econstructor; split. + apply exec_straight_one. simpl. unfold exec_load. rewrite H. rewrite H0. eauto. auto. split; intros; Simpl. - (* any64 *) apply indexed_memory_access_correct; intros. - econstructor; split. - apply exec_straight_one. simpl. unfold exec_load. rewrite H. rewrite H0. eauto. auto. + econstructor; split. + apply exec_straight_one. simpl. unfold exec_load. rewrite H. rewrite H0. eauto. auto. split; intros; Simpl. Qed. @@ -581,32 +581,32 @@ Proof. destruct ty; destruct (preg_of src); inv H; simpl in H0. - (* int *) apply indexed_memory_access_correct; intros. - econstructor; split. - apply exec_straight_one. simpl. unfold exec_store. + econstructor; split. + apply exec_straight_one. simpl. unfold exec_store. rewrite H. rewrite H1; auto with asmgen. rewrite H0; eauto. auto. intros; Simpl. - (* float *) apply indexed_memory_access_correct; intros. - econstructor; split. - apply exec_straight_one. simpl. unfold exec_store. + econstructor; split. + apply exec_straight_one. simpl. unfold exec_store. rewrite H. rewrite H1; auto with asmgen. rewrite H0; eauto. auto. intros; Simpl. - (* single *) apply indexed_memory_access_correct; intros. - econstructor; split. - apply exec_straight_one. simpl. unfold exec_store. + econstructor; split. + apply exec_straight_one. simpl. unfold exec_store. rewrite H. rewrite H1; auto with asmgen. rewrite H0; eauto. auto. intros; Simpl. - (* any32 *) apply indexed_memory_access_correct; intros. - econstructor; split. - apply exec_straight_one. simpl. unfold exec_store. + econstructor; split. + apply exec_straight_one. simpl. unfold exec_store. rewrite H. rewrite H1; auto with asmgen. rewrite H0; eauto. auto. intros; Simpl. - (* any64 *) apply indexed_memory_access_correct; intros. - econstructor; split. - apply exec_straight_one. simpl. unfold exec_store. + econstructor; split. + apply exec_straight_one. simpl. unfold exec_store. rewrite H. rewrite H1; auto with asmgen. rewrite H0; eauto. auto. intros; Simpl. Qed. @@ -639,19 +639,19 @@ Lemma compare_int_inv: forall r', data_preg r' = true -> rs1#r' = rs#r'. Proof. intros. unfold rs1, compare_int. - repeat Simplif. + repeat Simplif. Qed. Lemma int_signed_eq: forall x y, Int.eq x y = zeq (Int.signed x) (Int.signed y). Proof. - intros. unfold Int.eq. unfold proj_sumbool. + intros. unfold Int.eq. unfold proj_sumbool. destruct (zeq (Int.unsigned x) (Int.unsigned y)); destruct (zeq (Int.signed x) (Int.signed y)); auto. elim n. unfold Int.signed. rewrite e; auto. - elim n. apply Int.eqm_small_eq; auto with ints. + elim n. apply Int.eqm_small_eq; auto with ints. eapply Int.eqm_trans. apply Int.eqm_sym. apply Int.eqm_signed_unsigned. - rewrite e. apply Int.eqm_signed_unsigned. + rewrite e. apply Int.eqm_signed_unsigned. Qed. Lemma int_not_lt: @@ -660,8 +660,8 @@ Proof. intros. unfold Int.lt. rewrite int_signed_eq. unfold proj_sumbool. destruct (zlt (Int.signed y) (Int.signed x)). rewrite zlt_false. rewrite zeq_false. auto. omega. omega. - destruct (zeq (Int.signed x) (Int.signed y)). - rewrite zlt_false. auto. omega. + destruct (zeq (Int.signed x) (Int.signed y)). + rewrite zlt_false. auto. omega. rewrite zlt_true. auto. omega. Qed. @@ -677,8 +677,8 @@ Proof. intros. unfold Int.ltu, Int.eq. destruct (zlt (Int.unsigned y) (Int.unsigned x)). rewrite zlt_false. rewrite zeq_false. auto. omega. omega. - destruct (zeq (Int.unsigned x) (Int.unsigned y)). - rewrite zlt_false. auto. omega. + destruct (zeq (Int.unsigned x) (Int.unsigned y)). + rewrite zlt_false. auto. omega. rewrite zlt_true. auto. omega. Qed. @@ -733,16 +733,16 @@ Proof. destruct (Int.eq i Int.zero && (Mem.valid_pointer m b0 (Int.unsigned i0) || Mem.valid_pointer m b0 (Int.unsigned i0 - 1))) eqn:?; try discriminate. destruct c; simpl in *; inv H1. - rewrite Heqb1; reflexivity. + rewrite Heqb1; reflexivity. rewrite Heqb1; reflexivity. (* ptr int *) destruct (Int.eq i0 Int.zero && (Mem.valid_pointer m b0 (Int.unsigned i) || Mem.valid_pointer m b0 (Int.unsigned i - 1))) eqn:?; try discriminate. destruct c; simpl in *; inv H1. - rewrite Heqb1; reflexivity. + rewrite Heqb1; reflexivity. rewrite Heqb1; reflexivity. (* ptr ptr *) - simpl. + simpl. fold (Mem.weak_valid_pointer m b0 (Int.unsigned i)) in *. fold (Mem.weak_valid_pointer m b1 (Int.unsigned i0)) in *. destruct (eq_block b0 b1). @@ -780,7 +780,7 @@ Proof. assert (nextinstr (rs#CN <- Vundef #CZ <- Vundef #CC <- Vundef #CV <- Vundef) r' = rs r'). { repeat Simplif. } destruct v1; destruct v2; auto. - repeat Simplif. + repeat Simplif. Qed. Lemma compare_float_nextpc: @@ -797,7 +797,7 @@ Lemma cond_for_float_cmp_correct: Some(Float.cmp c n1 n2). Proof. intros. - generalize (compare_float_spec rs n1 n2). + generalize (compare_float_spec rs n1 n2). set (rs' := nextinstr (compare_float rs (Vfloat n1) (Vfloat n2))). intros [A [B [C D]]]. unfold eval_testcond. rewrite A; rewrite B; rewrite C; rewrite D. @@ -809,7 +809,7 @@ Proof. (* lt *) destruct (Float.cmp Clt n1 n2); auto. (* le *) - rewrite Float.cmp_le_lt_eq. + rewrite Float.cmp_le_lt_eq. destruct (Float.cmp Clt n1 n2); destruct (Float.cmp Ceq n1 n2); auto. (* gt *) destruct (Float.cmp Ceq n1 n2) eqn:EQ; @@ -819,7 +819,7 @@ Proof. exfalso; eapply Float.cmp_gt_eq_false; eauto. exfalso; eapply Float.cmp_lt_gt_false; eauto. (* ge *) - rewrite Float.cmp_ge_gt_eq. + rewrite Float.cmp_ge_gt_eq. destruct (Float.cmp Ceq n1 n2) eqn:EQ; destruct (Float.cmp Clt n1 n2) eqn:LT; destruct (Float.cmp Cgt n1 n2) eqn:GT; auto. @@ -847,7 +847,7 @@ Proof. (* lt *) destruct (Float.cmp Clt n1 n2); auto. (* le *) - rewrite Float.cmp_le_lt_eq. + rewrite Float.cmp_le_lt_eq. destruct (Float.cmp Clt n1 n2) eqn:LT; destruct (Float.cmp Ceq n1 n2) eqn:EQ; auto. (* gt *) destruct (Float.cmp Ceq n1 n2) eqn:EQ; @@ -857,7 +857,7 @@ Proof. exfalso; eapply Float.cmp_gt_eq_false; eauto. exfalso; eapply Float.cmp_lt_gt_false; eauto. (* ge *) - rewrite Float.cmp_ge_gt_eq. + rewrite Float.cmp_ge_gt_eq. destruct (Float.cmp Ceq n1 n2) eqn:EQ; destruct (Float.cmp Clt n1 n2) eqn:LT; destruct (Float.cmp Cgt n1 n2) eqn:GT; auto. @@ -886,7 +886,7 @@ Proof. assert (nextinstr (rs#CN <- Vundef #CZ <- Vundef #CC <- Vundef #CV <- Vundef) r' = rs r'). { repeat Simplif. } destruct v1; destruct v2; auto. - repeat Simplif. + repeat Simplif. Qed. Lemma compare_float32_nextpc: @@ -903,7 +903,7 @@ Lemma cond_for_float32_cmp_correct: Some(Float32.cmp c n1 n2). Proof. intros. - generalize (compare_float32_spec rs n1 n2). + generalize (compare_float32_spec rs n1 n2). set (rs' := nextinstr (compare_float32 rs (Vsingle n1) (Vsingle n2))). intros [A [B [C D]]]. unfold eval_testcond. rewrite A; rewrite B; rewrite C; rewrite D. @@ -915,7 +915,7 @@ Proof. (* lt *) destruct (Float32.cmp Clt n1 n2); auto. (* le *) - rewrite Float32.cmp_le_lt_eq. + rewrite Float32.cmp_le_lt_eq. destruct (Float32.cmp Clt n1 n2); destruct (Float32.cmp Ceq n1 n2); auto. (* gt *) destruct (Float32.cmp Ceq n1 n2) eqn:EQ; @@ -925,7 +925,7 @@ Proof. exfalso; eapply Float32.cmp_gt_eq_false; eauto. exfalso; eapply Float32.cmp_lt_gt_false; eauto. (* ge *) - rewrite Float32.cmp_ge_gt_eq. + rewrite Float32.cmp_ge_gt_eq. destruct (Float32.cmp Ceq n1 n2) eqn:EQ; destruct (Float32.cmp Clt n1 n2) eqn:LT; destruct (Float32.cmp Cgt n1 n2) eqn:GT; auto. @@ -953,7 +953,7 @@ Proof. (* lt *) destruct (Float32.cmp Clt n1 n2); auto. (* le *) - rewrite Float32.cmp_le_lt_eq. + rewrite Float32.cmp_le_lt_eq. destruct (Float32.cmp Clt n1 n2) eqn:LT; destruct (Float32.cmp Ceq n1 n2) eqn:EQ; auto. (* gt *) destruct (Float32.cmp Ceq n1 n2) eqn:EQ; @@ -963,7 +963,7 @@ Proof. exfalso; eapply Float32.cmp_gt_eq_false; eauto. exfalso; eapply Float32.cmp_lt_gt_false; eauto. (* ge *) - rewrite Float32.cmp_ge_gt_eq. + rewrite Float32.cmp_ge_gt_eq. destruct (Float32.cmp Ceq n1 n2) eqn:EQ; destruct (Float32.cmp Clt n1 n2) eqn:LT; destruct (Float32.cmp Cgt n1 n2) eqn:GT; auto. @@ -998,14 +998,14 @@ Lemma transl_cond_correct: end /\ forall r, data_preg r = true -> rs'#r = rs r. Proof. - intros until c; intros TR. + intros until c; intros TR. unfold transl_cond in TR; destruct cond; ArgsInv. - (* Ccomp *) econstructor. split. apply exec_straight_one. simpl. eauto. auto. split. destruct (Val.cmp_bool c0 (rs x) (rs x0)) eqn:CMP; auto. split; apply cond_for_signed_cmp_correct; auto. rewrite Val.negate_cmp_bool, CMP; auto. - apply compare_int_inv. + apply compare_int_inv. - (* Ccompu *) econstructor. split. apply exec_straight_one. simpl. eauto. auto. @@ -1030,17 +1030,17 @@ Proof. destruct (is_immed_arith i). econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. destruct (Val.cmp_bool c0 (rs x) (Vint i)) eqn:CMP; auto. + split. destruct (Val.cmp_bool c0 (rs x) (Vint i)) eqn:CMP; auto. split; apply cond_for_signed_cmp_correct; auto. rewrite Val.negate_cmp_bool, CMP; auto. apply compare_int_inv. exploit (loadimm_correct IR14). intros [rs' [P [Q R]]]. econstructor. split. eapply exec_straight_trans. eexact P. apply exec_straight_one. simpl. rewrite Q. rewrite R; eauto with asmgen. auto. - split. rewrite <- R by (eauto with asmgen). + split. rewrite <- R by (eauto with asmgen). destruct (Val.cmp_bool c0 (rs' x) (Vint i)) eqn:CMP; auto. split; apply cond_for_signed_cmp_correct; auto. rewrite Val.negate_cmp_bool, CMP; auto. - intros. rewrite compare_int_inv by auto. auto with asmgen. + intros. rewrite compare_int_inv by auto. auto with asmgen. - (* Ccompuimm *) destruct (is_immed_arith i). econstructor. @@ -1052,17 +1052,17 @@ Proof. econstructor. split. eapply exec_straight_trans. eexact P. apply exec_straight_one. simpl. rewrite Q. rewrite R; eauto with asmgen. auto. - split. rewrite <- R by (eauto with asmgen). + split. rewrite <- R by (eauto with asmgen). destruct (Val.cmpu_bool (Mem.valid_pointer m) c0 (rs' x) (Vint i)) eqn:CMP; auto. split; apply cond_for_unsigned_cmp_correct; auto. rewrite Val.negate_cmpu_bool, CMP; auto. - intros. rewrite compare_int_inv by auto. auto with asmgen. + intros. rewrite compare_int_inv by auto. auto with asmgen. - (* Ccompf *) econstructor. split. apply exec_straight_one. simpl. eauto. apply compare_float_nextpc. split. destruct (Val.cmpf_bool c0 (rs x) (rs x0)) eqn:CMP; auto. destruct (rs x); try discriminate. destruct (rs x0); try discriminate. simpl in CMP. inv CMP. - split. apply cond_for_float_cmp_correct. apply cond_for_float_not_cmp_correct. + split. apply cond_for_float_cmp_correct. apply cond_for_float_not_cmp_correct. apply compare_float_inv. - (* Cnotcompf *) econstructor. @@ -1080,7 +1080,7 @@ Local Opaque compare_float. simpl. split. destruct (Val.cmpf_bool c0 (rs x) (Vfloat Float.zero)) eqn:CMP; auto. destruct (rs x); try discriminate. simpl in CMP. inv CMP. - split. apply cond_for_float_cmp_correct. apply cond_for_float_not_cmp_correct. + split. apply cond_for_float_cmp_correct. apply cond_for_float_not_cmp_correct. apply compare_float_inv. - (* Cnotcompfzero *) econstructor. @@ -1096,7 +1096,7 @@ Local Opaque compare_float. simpl. split. apply exec_straight_one. simpl. eauto. apply compare_float32_nextpc. split. destruct (Val.cmpfs_bool c0 (rs x) (rs x0)) eqn:CMP; auto. destruct (rs x); try discriminate. destruct (rs x0); try discriminate. - simpl in CMP. inv CMP. + simpl in CMP. inv CMP. split. apply cond_for_float32_cmp_correct. apply cond_for_float32_not_cmp_correct. apply compare_float32_inv. - (* Cnotcompfs *) @@ -1144,7 +1144,7 @@ Lemma transl_op_correct_same: /\ rs'#(preg_of res) = v /\ forall r, data_preg r = true -> r <> preg_of res -> preg_notin r (destroyed_by_op op) -> rs'#r = rs#r. Proof. - intros until v; intros TR EV NOCMP. + intros until v; intros TR EV NOCMP. unfold transl_op in TR; destruct op; ArgsInv; simpl in EV; inv EV; try (TranslOpSimpl; fail). (* Omove *) destruct (preg_of res) eqn:RES; try discriminate; @@ -1152,12 +1152,12 @@ Proof. econstructor; split. apply exec_straight_one; simpl; eauto. intuition Simpl. econstructor; split. apply exec_straight_one; simpl; eauto. intuition Simpl. (* Ointconst *) - generalize (loadimm_correct x i k rs m). intros [rs' [A [B C]]]. - exists rs'; auto with asmgen. + generalize (loadimm_correct x i k rs m). intros [rs' [A [B C]]]. + exists rs'; auto with asmgen. (* Oaddrstack *) - generalize (addimm_correct x IR13 i k rs m). + generalize (addimm_correct x IR13 i k rs m). intros [rs' [EX [RES OTH]]]. - exists rs'; auto with asmgen. + exists rs'; auto with asmgen. (* Ocast8signed *) destruct (thumb tt). econstructor; split. apply exec_straight_one; simpl; eauto. intuition Simpl. @@ -1165,12 +1165,12 @@ Proof. set (rs1 := nextinstr_nf (rs#x <- (Val.shl rs#x0 (Vint (Int.repr 24))))). set (rs2 := nextinstr_nf (rs1#x <- (Val.shr rs1#x (Vint (Int.repr 24))))). exists rs2. - split. apply exec_straight_two with rs1 m; auto. + split. apply exec_straight_two with rs1 m; auto. split. unfold rs2; Simpl. unfold rs1; Simpl. - unfold Val.shr, Val.shl; destruct (rs x0); auto. + unfold Val.shr, Val.shl; destruct (rs x0); auto. change (Int.ltu (Int.repr 24) Int.iwordsize) with true; simpl. f_equal. symmetry. apply (Int.sign_ext_shr_shl 8). compute; auto. - intros. unfold rs2, rs1; Simpl. + intros. unfold rs2, rs1; Simpl. (* Ocast16signed *) destruct (thumb tt). econstructor; split. apply exec_straight_one; simpl; eauto. intuition Simpl. @@ -1178,15 +1178,15 @@ Proof. set (rs1 := nextinstr_nf (rs#x <- (Val.shl rs#x0 (Vint (Int.repr 16))))). set (rs2 := nextinstr_nf (rs1#x <- (Val.shr rs1#x (Vint (Int.repr 16))))). exists rs2. - split. apply exec_straight_two with rs1 m; auto. + split. apply exec_straight_two with rs1 m; auto. split. unfold rs2; Simpl. unfold rs1; Simpl. - unfold Val.shr, Val.shl; destruct (rs x0); auto. + unfold Val.shr, Val.shl; destruct (rs x0); auto. change (Int.ltu (Int.repr 16) Int.iwordsize) with true; simpl. f_equal. symmetry. apply (Int.sign_ext_shr_shl 16). compute; auto. - intros. unfold rs2, rs1; Simpl. + intros. unfold rs2, rs1; Simpl. (* Oaddimm *) generalize (addimm_correct x x0 i k rs m). - intros [rs' [A [B C]]]. + intros [rs' [A [B C]]]. exists rs'; auto with asmgen. (* Orsbimm *) generalize (rsubimm_correct x x0 i k rs m). @@ -1195,44 +1195,44 @@ Proof. (* divs *) Local Transparent destroyed_by_op. econstructor. split. apply exec_straight_one. simpl. rewrite H0. reflexivity. auto. - split. Simpl. simpl; intros. intuition Simpl. + split. Simpl. simpl; intros. intuition Simpl. (* divu *) econstructor. split. apply exec_straight_one. simpl. rewrite H0. reflexivity. auto. - split. Simpl. simpl; intros. intuition Simpl. + split. Simpl. simpl; intros. intuition Simpl. (* Oandimm *) - generalize (andimm_correct x x0 i k rs m). - intros [rs' [A [B C]]]. + generalize (andimm_correct x x0 i k rs m). + intros [rs' [A [B C]]]. exists rs'; auto with asmgen. (* Oorimm *) generalize (orimm_correct x x0 i k rs m). - intros [rs' [A [B C]]]. + intros [rs' [A [B C]]]. exists rs'; auto with asmgen. (* Oxorimm *) generalize (xorimm_correct x x0 i k rs m). - intros [rs' [A [B C]]]. + intros [rs' [A [B C]]]. exists rs'; auto with asmgen. (* Oshrximm *) - destruct (rs x0) eqn: X0; simpl in H0; try discriminate. - destruct (Int.ltu i (Int.repr 31)) eqn: LTU; inv H0. - revert EQ2. predSpec Int.eq Int.eq_spec i Int.zero; intros EQ2. + destruct (rs x0) eqn: X0; simpl in H0; try discriminate. + destruct (Int.ltu i (Int.repr 31)) eqn: LTU; inv H0. + revert EQ2. predSpec Int.eq Int.eq_spec i Int.zero; intros EQ2. (* i = 0 *) - inv EQ2. econstructor. - split. apply exec_straight_one. simpl. reflexivity. auto. - split. Simpl. unfold Int.shrx. rewrite Int.shl_zero. unfold Int.divs. + inv EQ2. econstructor. + split. apply exec_straight_one. simpl. reflexivity. auto. + split. Simpl. unfold Int.shrx. rewrite Int.shl_zero. unfold Int.divs. change (Int.signed Int.one) with 1. rewrite Z.quot_1_r. rewrite Int.repr_signed. auto. - intros. Simpl. + intros. Simpl. (* i <> 0 *) inv EQ2. assert (LTU': Int.ltu (Int.sub Int.iwordsize i) Int.iwordsize = true). { generalize (Int.ltu_inv _ _ LTU). intros. - unfold Int.sub, Int.ltu. rewrite Int.unsigned_repr_wordsize. + unfold Int.sub, Int.ltu. rewrite Int.unsigned_repr_wordsize. rewrite Int.unsigned_repr. apply zlt_true. - assert (Int.unsigned i <> 0). + assert (Int.unsigned i <> 0). { red; intros; elim H. rewrite <- (Int.repr_unsigned i). rewrite H1; reflexivity. } - omega. + omega. change (Int.unsigned (Int.repr 31)) with (Int.zwordsize - 1) in H0. - generalize Int.wordsize_max_unsigned; omega. + generalize Int.wordsize_max_unsigned; omega. } assert (LTU'': Int.ltu i Int.iwordsize = true). { @@ -1250,16 +1250,16 @@ Local Transparent destroyed_by_op. simpl. rewrite X0; reflexivity. simpl. f_equal. Simpl. replace (rs1 x0) with (rs x0). rewrite X0; reflexivity. unfold rs1; Simpl. - reflexivity. + reflexivity. auto. auto. auto. - split. unfold rs3; Simpl. unfold rs2; Simpl. unfold rs1; Simpl. - simpl. change (Int.ltu (Int.repr 31) Int.iwordsize) with true. simpl. - rewrite LTU'; simpl. rewrite LTU''; simpl. - f_equal. symmetry. apply Int.shrx_shr_2. assumption. - intros. unfold rs3; Simpl. unfold rs2; Simpl. unfold rs1; Simpl. + split. unfold rs3; Simpl. unfold rs2; Simpl. unfold rs1; Simpl. + simpl. change (Int.ltu (Int.repr 31) Int.iwordsize) with true. simpl. + rewrite LTU'; simpl. rewrite LTU''; simpl. + f_equal. symmetry. apply Int.shrx_shr_2. assumption. + intros. unfold rs3; Simpl. unfold rs2; Simpl. unfold rs1; Simpl. (* intoffloat *) econstructor; split. apply exec_straight_one; simpl. rewrite H0; simpl. eauto. auto. -Transparent destroyed_by_op. +Transparent destroyed_by_op. simpl. intuition Simpl. (* intuoffloat *) econstructor; split. apply exec_straight_one; simpl. rewrite H0; simpl. eauto. auto. @@ -1295,21 +1295,21 @@ Lemma transl_op_correct: /\ Val.lessdef v rs'#(preg_of res) /\ forall r, data_preg r = true -> r <> preg_of res -> preg_notin r (destroyed_by_op op) -> rs'#r = rs#r. Proof. - intros. + intros. assert (EITHER: match op with Ocmp _ => False | _ => True end \/ exists cmp, op = Ocmp cmp). destruct op; auto. right; exists c0; auto. - destruct EITHER as [A | [cmp A]]. + destruct EITHER as [A | [cmp A]]. exploit transl_op_correct_same; eauto. intros [rs' [P [Q R]]]. - subst v. exists rs'; eauto. + subst v. exists rs'; eauto. (* Ocmp *) - subst op. simpl in H. monadInv H. simpl in H0. inv H0. + subst op. simpl in H. monadInv H. simpl in H0. inv H0. rewrite (ireg_of_eq _ _ EQ). exploit transl_cond_correct; eauto. instantiate (1 := rs). instantiate (1 := m). intros [rs1 [A [B C]]]. econstructor; split. eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto. split; intros; Simpl. destruct (eval_condition cmp rs ## (preg_of ## args) m) as [b|]; simpl; auto. - destruct B as [B1 B2]; rewrite B1. destruct b; auto. + destruct B as [B1 B2]; rewrite B1. destruct b; auto. Qed. (** Translation of loads and stores. *) @@ -1352,7 +1352,7 @@ Proof. simpl. erewrite ! ireg_of_eq; eauto. (* Aindexed2shift *) destruct mk_instr_gen as [mk | ]; monadInv TR. apply MK2. - erewrite ! ireg_of_eq; eauto. rewrite transl_shift_correct. auto. + erewrite ! ireg_of_eq; eauto. rewrite transl_shift_correct. auto. (* Ainstack *) inv TR. apply indexed_memory_access_correct. exact MK1. Qed. @@ -1370,13 +1370,13 @@ Lemma transl_load_int_correct: /\ rs'#(preg_of dst) = v /\ forall r, data_preg r = true -> r <> preg_of dst -> rs'#r = rs#r. Proof. - intros. monadInv H. erewrite ireg_of_eq by eauto. + intros. monadInv H. erewrite ireg_of_eq by eauto. eapply transl_memory_access_correct; eauto. - intros; simpl. econstructor; split. apply exec_straight_one. + intros; simpl. econstructor; split. apply exec_straight_one. rewrite H2. unfold exec_load. simpl eval_shift_op. rewrite H. rewrite H1. eauto. auto. - split. Simpl. intros; Simpl. - simpl; intros. - econstructor; split. apply exec_straight_one. + split. Simpl. intros; Simpl. + simpl; intros. + econstructor; split. apply exec_straight_one. rewrite H2. unfold exec_load. rewrite H. rewrite H1. eauto. auto. split. Simpl. intros; Simpl. Qed. @@ -1394,9 +1394,9 @@ Lemma transl_load_float_correct: /\ rs'#(preg_of dst) = v /\ forall r, data_preg r = true -> r <> preg_of dst -> rs'#r = rs#r. Proof. - intros. monadInv H. erewrite freg_of_eq by eauto. + intros. monadInv H. erewrite freg_of_eq by eauto. eapply transl_memory_access_correct; eauto. - intros; simpl. econstructor; split. apply exec_straight_one. + intros; simpl. econstructor; split. apply exec_straight_one. rewrite H2. unfold exec_load. rewrite H. rewrite H1. eauto. auto. split. Simpl. intros; Simpl. simpl; auto. @@ -1415,14 +1415,14 @@ Lemma transl_store_int_correct: /\ forall r, data_preg r = true -> preg_notin r mr -> rs'#r = rs#r. Proof. intros. assert (DR: data_preg (preg_of src) = true) by eauto with asmgen. - monadInv H. erewrite ireg_of_eq in * by eauto. + monadInv H. erewrite ireg_of_eq in * by eauto. eapply transl_memory_access_correct; eauto. - intros; simpl. econstructor; split. apply exec_straight_one. - rewrite H2. unfold exec_store. simpl eval_shift_op. rewrite H. rewrite H3; eauto with asmgen. + intros; simpl. econstructor; split. apply exec_straight_one. + rewrite H2. unfold exec_store. simpl eval_shift_op. rewrite H. rewrite H3; eauto with asmgen. rewrite H1. eauto. auto. intros; Simpl. - simpl; intros. - econstructor; split. apply exec_straight_one. + simpl; intros. + econstructor; split. apply exec_straight_one. rewrite H2. unfold exec_store. rewrite H. rewrite H1. eauto. auto. intros; Simpl. Qed. @@ -1440,9 +1440,9 @@ Lemma transl_store_float_correct: /\ forall r, data_preg r = true -> preg_notin r mr -> rs'#r = rs#r. Proof. intros. assert (DR: data_preg (preg_of src) = true) by eauto with asmgen. - monadInv H. erewrite freg_of_eq in * by eauto. + monadInv H. erewrite freg_of_eq in * by eauto. eapply transl_memory_access_correct; eauto. - intros; simpl. econstructor; split. apply exec_straight_one. + intros; simpl. econstructor; split. apply exec_straight_one. rewrite H2. unfold exec_store. rewrite H. rewrite H3; auto with asmgen. rewrite H1. eauto. auto. intros; Simpl. simpl; auto. diff --git a/arm/CombineOp.v b/arm/CombineOp.v index 8da6e3a2..1bcdba22 100644 --- a/arm/CombineOp.v +++ b/arm/CombineOp.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Recognition of combined operations, addressing modes and conditions +(** Recognition of combined operations, addressing modes and conditions during the [CSE] phase. *) Require Import Coqlib. @@ -98,7 +98,7 @@ Function combine_op (op: operation) (args: list valnum) : option(operation * lis end | Oandimm n, x :: nil => match get x with - | Some(Op (Oandimm m) ys) => + | Some(Op (Oandimm m) ys) => Some(let p := Int.and m n in if Int.eq p m then (Omove, x :: nil) else (Oandimm p, ys)) | _ => None diff --git a/arm/CombineOpproof.v b/arm/CombineOpproof.v index 485857b9..cb30e956 100644 --- a/arm/CombineOpproof.v +++ b/arm/CombineOpproof.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Recognition of combined operations, addressing modes and conditions +(** Recognition of combined operations, addressing modes and conditions during the [CSE] phase. *) Require Import Coqlib. @@ -36,7 +36,7 @@ Hypothesis get_sound: forall v rhs, get v = Some rhs -> rhs_eval_to valu ge sp m Lemma get_op_sound: forall v op vl, get v = Some (Op op vl) -> eval_operation ge sp op (map valu vl) m = Some (valu v). Proof. - intros. exploit get_sound; eauto. intros REV; inv REV; auto. + intros. exploit get_sound; eauto. intros REV; inv REV; auto. Qed. Ltac UseGetSound := @@ -44,7 +44,7 @@ Ltac UseGetSound := | [ H: get _ = Some _ |- _ ] => let x := fresh "EQ" in (generalize (get_op_sound _ _ _ H); intros x; simpl in x; FuncInv) end. - + Lemma combine_compimm_ne_0_sound: forall x cond args, combine_compimm_ne_0 get x = Some(cond, args) -> @@ -53,7 +53,7 @@ Lemma combine_compimm_ne_0_sound: Proof. intros until args. functional induction (combine_compimm_ne_0 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. + UseGetSound. rewrite <- H. destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto. Qed. @@ -65,8 +65,8 @@ Lemma combine_compimm_eq_0_sound: Proof. intros until args. functional induction (combine_compimm_eq_0 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. - rewrite eval_negate_condition. + UseGetSound. rewrite <- H. + rewrite eval_negate_condition. destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto. Qed. @@ -78,7 +78,7 @@ Lemma combine_compimm_eq_1_sound: Proof. intros until args. functional induction (combine_compimm_eq_1 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. + UseGetSound. rewrite <- H. destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto. Qed. @@ -90,7 +90,7 @@ Lemma combine_compimm_ne_1_sound: Proof. intros until args. functional induction (combine_compimm_ne_1 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. + UseGetSound. rewrite <- H. rewrite eval_negate_condition. destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto. Qed. @@ -126,7 +126,7 @@ Theorem combine_addr_sound: Proof. intros. functional inversion H; subst. (* indexed - addimm *) - UseGetSound. simpl. rewrite <- H0. rewrite Val.add_assoc. auto. + UseGetSound. simpl. rewrite <- H0. rewrite Val.add_assoc. auto. Qed. Theorem combine_op_sound: @@ -149,10 +149,10 @@ Transparent Val.sub. destruct v; simpl; auto. repeat rewrite Int.sub_add_opp. rewrite Int.add_assoc. rewrite Int.neg_add_distr. decEq. decEq. decEq. apply Int.add_commut. (* andimm - andimm *) - UseGetSound; simpl. - generalize (Int.eq_spec p m0); rewrite H7; intros. + UseGetSound; simpl. + generalize (Int.eq_spec p m0); rewrite H7; intros. rewrite <- H0. rewrite Val.and_assoc. simpl. fold p. rewrite H1. auto. - UseGetSound; simpl. + UseGetSound; simpl. rewrite <- H0. rewrite Val.and_assoc. auto. (* orimm - orimm *) UseGetSound. simpl. rewrite <- H0. rewrite Val.or_assoc. auto. diff --git a/arm/ConstpropOpproof.v b/arm/ConstpropOpproof.v index fa20d17e..6f6afa8a 100644 --- a/arm/ConstpropOpproof.v +++ b/arm/ConstpropOpproof.v @@ -51,7 +51,7 @@ Lemma match_G: forall r id ofs, AE.get r ae = Ptr(Gl id ofs) -> Val.lessdef rs#r (Genv.symbol_address ge id ofs). Proof. - intros. apply vmatch_ptr_gl with bc; auto. rewrite <- H. apply MATCH. + intros. apply vmatch_ptr_gl with bc; auto. rewrite <- H. apply MATCH. Qed. Lemma match_S: @@ -63,9 +63,9 @@ Qed. Ltac InvApproxRegs := match goal with - | [ H: _ :: _ = _ :: _ |- _ ] => + | [ H: _ :: _ = _ :: _ |- _ ] => injection H; clear H; intros; InvApproxRegs - | [ H: ?v = AE.get ?r ae |- _ ] => + | [ H: ?v = AE.get ?r ae |- _ ] => generalize (MATCH r); rewrite <- H; clear H; intro; InvApproxRegs | _ => idtac end. @@ -86,11 +86,11 @@ Ltac SimplVM := rewrite E in *; clear H; SimplVM | [ H: vmatch _ ?v (Ptr(Gl ?id ?ofs)) |- _ ] => let E := fresh in - assert (E: Val.lessdef v (Genv.symbol_address ge id ofs)) by (eapply vmatch_ptr_gl; eauto); + assert (E: Val.lessdef v (Genv.symbol_address ge id ofs)) by (eapply vmatch_ptr_gl; eauto); clear H; SimplVM | [ H: vmatch _ ?v (Ptr(Stk ?ofs)) |- _ ] => let E := fresh in - assert (E: Val.lessdef v (Vptr sp ofs)) by (eapply vmatch_ptr_stk; eauto); + assert (E: Val.lessdef v (Vptr sp ofs)) by (eapply vmatch_ptr_stk; eauto); clear H; SimplVM | _ => idtac end. @@ -114,31 +114,31 @@ Proof. - apply Val.swap_cmpu_bool. - auto. - rewrite eval_static_shift_correct. auto. -- rewrite eval_static_shift_correct. auto. +- rewrite eval_static_shift_correct. auto. - destruct (Float.eq_dec n1 Float.zero). subst n1. simpl. destruct (rs#r2); simpl; auto. rewrite Float.cmp_swap. auto. - simpl. rewrite H1; auto. + simpl. rewrite H1; auto. - destruct (Float.eq_dec n2 Float.zero). subst n2. simpl. auto. simpl. rewrite H1; auto. - destruct (Float.eq_dec n1 Float.zero). subst n1. simpl. destruct (rs#r2); simpl; auto. rewrite Float.cmp_swap. auto. - simpl. rewrite H1; auto. + simpl. rewrite H1; auto. - destruct (Float.eq_dec n2 Float.zero); simpl; auto. subst n2; auto. - rewrite H1; auto. + rewrite H1; auto. - destruct (Float32.eq_dec n1 Float32.zero). subst n1. simpl. destruct (rs#r2); simpl; auto. rewrite Float32.cmp_swap. auto. - simpl. rewrite H1; auto. + simpl. rewrite H1; auto. - destruct (Float32.eq_dec n2 Float32.zero). subst n2. simpl. auto. simpl. rewrite H1; auto. - destruct (Float32.eq_dec n1 Float32.zero). subst n1. simpl. destruct (rs#r2); simpl; auto. rewrite Float32.cmp_swap. auto. - simpl. rewrite H1; auto. + simpl. rewrite H1; auto. - destruct (Float32.eq_dec n2 Float32.zero); simpl; auto. subst n2; auto. - rewrite H1; auto. + rewrite H1; auto. - auto. Qed. @@ -146,20 +146,20 @@ Lemma make_cmp_base_correct: forall c args vl, vl = map (fun r => AE.get r ae) args -> let (op', args') := make_cmp_base c args vl in - exists v, eval_operation ge (Vptr sp Int.zero) op' rs##args' m = Some v + exists v, eval_operation ge (Vptr sp Int.zero) op' rs##args' m = Some v /\ Val.lessdef (Val.of_optbool (eval_condition c rs##args m)) v. Proof. - intros. unfold make_cmp_base. - generalize (cond_strength_reduction_correct c args vl H). + intros. unfold make_cmp_base. + generalize (cond_strength_reduction_correct c args vl H). destruct (cond_strength_reduction c args vl) as [c' args']. intros EQ. - econstructor; split. simpl; eauto. rewrite EQ. auto. + econstructor; split. simpl; eauto. rewrite EQ. auto. Qed. Lemma make_cmp_correct: forall c args vl, vl = map (fun r => AE.get r ae) args -> let (op', args') := make_cmp c args vl in - exists v, eval_operation ge (Vptr sp Int.zero) op' rs##args' m = Some v + exists v, eval_operation ge (Vptr sp Int.zero) op' rs##args' m = Some v /\ Val.lessdef (Val.of_optbool (eval_condition c rs##args m)) v. Proof. intros c args vl. @@ -168,20 +168,20 @@ Proof. { intros. apply vmatch_Uns_1 with bc Ptop. eapply vmatch_ge. eapply vincl_ge; eauto. apply MATCH. } unfold make_cmp. case (make_cmp_match c args vl); intros. - destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (rs#r1); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (Val.xor rs#r1 (Vint Int.one)); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. apply make_cmp_base_correct; auto. - destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (rs#r1); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (Val.xor rs#r1 (Vint Int.one)); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. apply make_cmp_base_correct; auto. @@ -194,7 +194,7 @@ Lemma make_addimm_correct: exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.add rs#r (Vint n)) v. Proof. intros. unfold make_addimm. - predSpec Int.eq Int.eq_spec n Int.zero; intros. + predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (rs#r); split; auto. destruct (rs#r); simpl; auto; rewrite Int.add_zero; auto. exists (Val.add rs#r (Vint n)); auto. Qed. @@ -210,7 +210,7 @@ Proof. predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shl_zero. auto. destruct (Int.ltu n Int.iwordsize) eqn:?; intros. - econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. + econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. econstructor; split; eauto. simpl. congruence. Qed. @@ -224,7 +224,7 @@ Proof. predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shr_zero. auto. destruct (Int.ltu n Int.iwordsize) eqn:?; intros. - econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. + econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. econstructor; split; eauto. simpl. congruence. Qed. @@ -238,7 +238,7 @@ Proof. predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shru_zero. auto. destruct (Int.ltu n Int.iwordsize) eqn:?; intros. - econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. + econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. econstructor; split; eauto. simpl. congruence. Qed. @@ -255,7 +255,7 @@ Proof. exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.mul_one; auto. destruct (Int.is_power2 n) eqn:?; intros. exploit Int.is_power2_range; eauto. intros R. - econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. + econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. rewrite (Val.mul_pow2 rs#r1 _ _ Heqo). auto. econstructor; split; eauto. simpl. congruence. Qed. @@ -270,7 +270,7 @@ Proof. intros; unfold make_divimm. destruct (Int.is_power2 n) eqn:?. destruct (Int.ltu i (Int.repr 31)) eqn:?. - exists v; split; auto. simpl. eapply Val.divs_pow2; eauto. congruence. + exists v; split; auto. simpl. eapply Val.divs_pow2; eauto. congruence. exists v; auto. exists v; auto. Qed. @@ -284,8 +284,8 @@ Lemma make_divuimm_correct: Proof. intros; unfold make_divuimm. destruct (Int.is_power2 n) eqn:?. - replace v with (Val.shru rs#r1 (Vint i)). - econstructor; split. simpl. rewrite mk_shift_amount_eq. eauto. + replace v with (Val.shru rs#r1 (Vint i)). + econstructor; split. simpl. rewrite mk_shift_amount_eq. eauto. eapply Int.is_power2_range; eauto. auto. eapply Val.divu_pow2; eauto. congruence. exists v; auto. @@ -304,17 +304,17 @@ Proof. subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.and_mone; auto. destruct (match x with Uns _ k => Int.eq (Int.zero_ext k (Int.not n)) Int.zero | _ => false end) eqn:UNS. - destruct x; try congruence. + destruct x; try congruence. exists (rs#r); split; auto. inv H; auto. simpl. replace (Int.and i n) with i; auto. generalize (Int.eq_spec (Int.zero_ext n0 (Int.not n)) Int.zero); rewrite UNS; intro EQ. Int.bit_solve. destruct (zlt i0 n0). replace (Int.testbit n i0) with (negb (Int.testbit Int.zero i0)). - rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. - rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. - rewrite Int.bits_not by auto. apply negb_involutive. - rewrite H6 by auto. auto. - econstructor; split; eauto. auto. + rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. + rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. + rewrite Int.bits_not by auto. apply negb_involutive. + rewrite H6 by auto. auto. + econstructor; split; eauto. auto. Qed. Lemma make_orimm_correct: @@ -327,7 +327,7 @@ Proof. subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.or_zero; auto. predSpec Int.eq Int.eq_spec n Int.mone; intros. subst n. exists (Vint Int.mone); split; auto. destruct (rs#r); simpl; auto. rewrite Int.or_mone; auto. - econstructor; split; eauto. auto. + econstructor; split; eauto. auto. Qed. Lemma make_xorimm_correct: @@ -340,8 +340,8 @@ Proof. subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.xor_zero; auto. predSpec Int.eq Int.eq_spec n Int.mone; intros. subst n. exists (Val.notint (rs#r)); split. auto. - destruct (rs#r); simpl; auto. - econstructor; split; eauto. auto. + destruct (rs#r); simpl; auto. + econstructor; split; eauto. auto. Qed. Lemma make_mulfimm_correct: @@ -350,11 +350,11 @@ Lemma make_mulfimm_correct: let (op, args) := make_mulfimm n r1 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.mulf rs#r1 rs#r2) v. Proof. - intros; unfold make_mulfimm. - destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. + intros; unfold make_mulfimm. + destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (rs#r1); simpl; auto. rewrite Float.mul2_add; auto. - simpl. econstructor; split; eauto. + destruct (rs#r1); simpl; auto. rewrite Float.mul2_add; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_mulfimm_correct_2: @@ -363,12 +363,12 @@ Lemma make_mulfimm_correct_2: let (op, args) := make_mulfimm n r2 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.mulf rs#r1 rs#r2) v. Proof. - intros; unfold make_mulfimm. - destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. + intros; unfold make_mulfimm. + destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (rs#r2); simpl; auto. rewrite Float.mul2_add; auto. - rewrite Float.mul_commut; auto. - simpl. econstructor; split; eauto. + destruct (rs#r2); simpl; auto. rewrite Float.mul2_add; auto. + rewrite Float.mul_commut; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_mulfsimm_correct: @@ -377,11 +377,11 @@ Lemma make_mulfsimm_correct: let (op, args) := make_mulfsimm n r1 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.mulfs rs#r1 rs#r2) v. Proof. - intros; unfold make_mulfsimm. - destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. + intros; unfold make_mulfsimm. + destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (rs#r1); simpl; auto. rewrite Float32.mul2_add; auto. - simpl. econstructor; split; eauto. + destruct (rs#r1); simpl; auto. rewrite Float32.mul2_add; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_mulfsimm_correct_2: @@ -390,12 +390,12 @@ Lemma make_mulfsimm_correct_2: let (op, args) := make_mulfsimm n r2 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.mulfs rs#r1 rs#r2) v. Proof. - intros; unfold make_mulfsimm. - destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. + intros; unfold make_mulfsimm. + destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (rs#r2); simpl; auto. rewrite Float32.mul2_add; auto. - rewrite Float32.mul_commut; auto. - simpl. econstructor; split; eauto. + destruct (rs#r2); simpl; auto. rewrite Float32.mul2_add; auto. + rewrite Float32.mul_commut; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_cast8signed_correct: @@ -404,8 +404,8 @@ Lemma make_cast8signed_correct: let (op, args) := make_cast8signed r x in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.sign_ext 8 rs#r) v. Proof. - intros; unfold make_cast8signed. destruct (vincl x (Sgn Ptop 8)) eqn:INCL. - exists rs#r; split; auto. + intros; unfold make_cast8signed. destruct (vincl x (Sgn Ptop 8)) eqn:INCL. + exists rs#r; split; auto. assert (V: vmatch bc rs#r (Sgn Ptop 8)). { eapply vmatch_ge; eauto. apply vincl_ge; auto. } inv V; simpl; auto. rewrite is_sgn_sign_ext in H4 by auto. rewrite H4; auto. @@ -418,8 +418,8 @@ Lemma make_cast16signed_correct: let (op, args) := make_cast16signed r x in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.sign_ext 16 rs#r) v. Proof. - intros; unfold make_cast16signed. destruct (vincl x (Sgn Ptop 16)) eqn:INCL. - exists rs#r; split; auto. + intros; unfold make_cast16signed. destruct (vincl x (Sgn Ptop 16)) eqn:INCL. + exists rs#r; split; auto. assert (V: vmatch bc rs#r (Sgn Ptop 16)). { eapply vmatch_ge; eauto. apply vincl_ge; auto. } inv V; simpl; auto. rewrite is_sgn_sign_ext in H4 by auto. rewrite H4; auto. @@ -440,13 +440,13 @@ Proof. (* cast8signed *) InvApproxRegs; SimplVM; inv H0. apply make_cast16signed_correct; auto. (* add *) - InvApproxRegs; SimplVM. inv H0. + InvApproxRegs; SimplVM. inv H0. fold (Val.add (Vint n1) rs#r2). rewrite Val.add_commut. apply make_addimm_correct. InvApproxRegs; SimplVM. inv H0. apply make_addimm_correct. (* addshift *) InvApproxRegs; SimplVM. inv H0. rewrite eval_static_shift_correct. apply make_addimm_correct. (* sub *) - InvApproxRegs; SimplVM. inv H0. econstructor; split; eauto. + InvApproxRegs; SimplVM. inv H0. econstructor; split; eauto. InvApproxRegs; SimplVM. inv H0. rewrite Val.sub_add_opp. apply make_addimm_correct. (* subshift *) InvApproxRegs; SimplVM. inv H0. rewrite eval_static_shift_correct. rewrite Val.sub_add_opp. apply make_addimm_correct. @@ -511,7 +511,7 @@ Proof. intros until res. unfold addr_strength_reduction. destruct (addr_strength_reduction_match addr args vl); simpl; intros VL EA; InvApproxRegs; SimplVM; try (inv EA). -- rewrite Int.add_zero_l. +- rewrite Int.add_zero_l. change (Vptr sp (Int.add n1 n2)) with (Val.add (Vptr sp n1) (Vint n2)). econstructor; split; eauto. apply Val.add_lessdef; auto. - fold (Val.add (Vint n1) rs#r2). rewrite Int.add_zero_l. rewrite Int.add_commut. @@ -520,12 +520,12 @@ Proof. - fold (Val.add (Vint n1) rs#r2). rewrite Val.add_commut. econstructor; split; eauto. - econstructor; split; eauto. -- rewrite eval_static_shift_correct. rewrite Int.add_zero_l. +- rewrite eval_static_shift_correct. rewrite Int.add_zero_l. change (Vptr sp (Int.add n1 (eval_static_shift s n2))) with (Val.add (Vptr sp n1) (Vint (eval_static_shift s n2))). econstructor; split; eauto. apply Val.add_lessdef; auto. -- rewrite eval_static_shift_correct. econstructor; split; eauto. -- rewrite Int.add_zero_l. change (Vptr sp (Int.add n1 n)) with (Val.add (Vptr sp n1) (Vint n)). +- rewrite eval_static_shift_correct. econstructor; split; eauto. +- rewrite Int.add_zero_l. change (Vptr sp (Int.add n1 n)) with (Val.add (Vptr sp n1) (Vint n)). econstructor; split; eauto. apply Val.add_lessdef; auto. - exists res; auto. Qed. diff --git a/arm/Conventions1.v b/arm/Conventions1.v index ffa441bc..e27a9293 100644 --- a/arm/Conventions1.v +++ b/arm/Conventions1.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Function calling conventions and other conventions regarding the use of +(** Function calling conventions and other conventions regarding the use of machine registers and stack slots. *) Require Import Coqlib. @@ -121,25 +121,25 @@ Proof. Qed. Lemma index_int_callee_save_inj: - forall r1 r2, + forall r1 r2, In r1 int_callee_save_regs -> In r2 int_callee_save_regs -> r1 <> r2 -> index_int_callee_save r1 <> index_int_callee_save r2. Proof. - intros r1 r2. + intros r1 r2. simpl; ElimOrEq; ElimOrEq; unfold index_int_callee_save; intros; congruence. Qed. Lemma index_float_callee_save_inj: - forall r1 r2, + forall r1 r2, In r1 float_callee_save_regs -> In r2 float_callee_save_regs -> r1 <> r2 -> index_float_callee_save r1 <> index_float_callee_save r2. Proof. - intros r1 r2. + intros r1 r2. simpl; ElimOrEq; ElimOrEq; unfold index_float_callee_save; intros; congruence. Qed. @@ -155,10 +155,10 @@ Proof. Qed. Lemma register_classification: - forall r, + forall r, In r destroyed_at_call \/ In r int_callee_save_regs \/ In r float_callee_save_regs. Proof. - destruct r; + destruct r; try (left; simpl; OrEq); try (right; left; simpl; OrEq); try (right; right; simpl; OrEq). @@ -166,14 +166,14 @@ Qed. Lemma int_callee_save_not_destroyed: - forall r, + forall r, In r destroyed_at_call -> In r int_callee_save_regs -> False. Proof. intros. revert H0 H. simpl. ElimOrEq; NotOrEq. Qed. Lemma float_callee_save_not_destroyed: - forall r, + forall r, In r destroyed_at_call -> In r float_callee_save_regs -> False. Proof. intros. revert H0 H. simpl. ElimOrEq; NotOrEq. @@ -216,9 +216,9 @@ Qed. (** The functions in this section determine the locations (machine registers and stack slots) used to communicate arguments and results between the caller and the callee during function calls. These locations are functions - of the signature of the function and of the call instruction. + of the signature of the function and of the call instruction. Agreement between the caller and the callee on the locations to use - is guaranteed by our dynamic semantics for Cminor and RTL, which demand + is guaranteed by our dynamic semantics for Cminor and RTL, which demand that the signature of the call instruction is identical to that of the called function. @@ -259,7 +259,7 @@ Qed. (** The result locations are caller-save registers *) Lemma loc_result_caller_save: - forall (s: signature) (r: mreg), + forall (s: signature) (r: mreg), In r (loc_result s) -> In r destroyed_at_call. Proof. intros. @@ -420,7 +420,7 @@ Definition size_arguments (s: signature) : Z := else size_arguments_hf s.(sig_args) 0 0 0 end. -(** Argument locations are either non-temporary registers or [Outgoing] +(** Argument locations are either non-temporary registers or [Outgoing] stack slots at nonnegative offsets. *) Definition loc_argument_acceptable (l: loc) : Prop := @@ -432,17 +432,17 @@ Definition loc_argument_acceptable (l: loc) : Prop := Remark ireg_param_in_params: forall n, In (ireg_param n) int_param_regs. Proof. - unfold ireg_param; intros. + unfold ireg_param; intros. destruct (list_nth_z int_param_regs n) as [r|] eqn:NTH. - eapply list_nth_z_in; eauto. + eapply list_nth_z_in; eauto. simpl; auto. Qed. Remark freg_param_in_params: forall n, In (freg_param n) float_param_regs. Proof. - unfold freg_param; intros. + unfold freg_param; intros. destruct (list_nth_z float_param_regs n) as [r|] eqn:NTH. - eapply list_nth_z_in; eauto. + eapply list_nth_z_in; eauto. simpl; auto. Qed. @@ -488,7 +488,7 @@ Proof. apply Zle_trans with (align ofs 2). apply align_le; omega. omega. - (* long *) set (ir' := align ir 2) in *. - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; omega). destruct (zlt ir' 4). destruct H. subst l; left; apply ireg_param_in_params. destruct H. subst l; left; apply ireg_param_in_params. @@ -545,8 +545,8 @@ Proof. elim H. destruct a. - (* int *) - destruct H. - destruct (zlt ofs 0); subst l. + destruct H. + destruct (zlt ofs 0); subst l. left; apply ireg_param_in_params. split. xomega. congruence. eapply INCR. eapply IHtyl; eauto. omega. @@ -571,14 +571,14 @@ Proof. split. xomega. congruence. eapply INCR. eapply IHtyl; eauto. omega. - (* single *) - destruct H. - destruct (zlt ofs 0); subst l. + destruct H. + destruct (zlt ofs 0); subst l. right; apply freg_param_in_params. split. xomega. congruence. eapply INCR. eapply IHtyl; eauto. omega. - (* any32 *) - destruct H. - destruct (zlt ofs 0); subst l. + destruct H. + destruct (zlt ofs 0); subst l. left; apply ireg_param_in_params. split. xomega. congruence. eapply INCR. eapply IHtyl; eauto. omega. @@ -624,7 +624,7 @@ Proof. apply Zle_trans with (align ofs0 2). apply align_le; omega. apply Zle_trans with (align ofs0 2 + 2); auto; omega. set (ir' := align ir 2). - destruct (zlt ir' 4); eauto. + destruct (zlt ir' 4); eauto. apply Zle_trans with (align ofs0 2). apply align_le; omega. apply Zle_trans with (align ofs0 2 + 2); auto; omega. destruct (zlt fr 8); eauto. @@ -641,7 +641,7 @@ Remark size_arguments_sf_above: Proof. induction tyl; simpl; intros. omega. - destruct a; (eapply Zle_trans; [idtac|eauto]). + destruct a; (eapply Zle_trans; [idtac|eauto]). xomega. assert (ofs0 <= align ofs0 2) by (apply align_le; omega). xomega. assert (ofs0 <= align ofs0 2) by (apply align_le; omega). xomega. @@ -673,17 +673,17 @@ Proof. destruct (zlt ir 4); destruct H. discriminate. eauto. - inv H. apply size_arguments_hf_above. + inv H. apply size_arguments_hf_above. eauto. - (* float *) destruct (zlt fr 8); destruct H. discriminate. - eauto. - inv H. apply size_arguments_hf_above. + eauto. + inv H. apply size_arguments_hf_above. eauto. - (* long *) destruct (zlt (align ir 2) 4). - destruct H. discriminate. destruct H. discriminate. eauto. + destruct H. discriminate. destruct H. discriminate. eauto. destruct H. inv H. rewrite <- Zplus_assoc. simpl. apply size_arguments_hf_above. destruct H. inv H. @@ -699,13 +699,13 @@ Proof. destruct (zlt ir 4); destruct H. discriminate. eauto. - inv H. apply size_arguments_hf_above. + inv H. apply size_arguments_hf_above. eauto. - (* any64 *) destruct (zlt fr 8); destruct H. discriminate. - eauto. - inv H. apply size_arguments_hf_above. + eauto. + inv H. apply size_arguments_hf_above. eauto. Qed. @@ -718,28 +718,28 @@ Proof. elim H. destruct a. - (* int *) - destruct H. - destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above. + destruct H. + destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above. eauto. - (* float *) destruct H. destruct (zlt (align ofs0 2) 0); inv H. apply size_arguments_sf_above. eauto. - (* long *) - destruct H. + destruct H. destruct (zlt (align ofs0 2) 0); inv H. rewrite <- Zplus_assoc. simpl. apply size_arguments_sf_above. - destruct H. + destruct H. destruct (zlt (align ofs0 2) 0); inv H. eapply Zle_trans. 2: apply size_arguments_sf_above. simpl; xomega. eauto. - (* float *) - destruct H. - destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above. + destruct H. + destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above. eauto. - (* any32 *) - destruct H. - destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above. + destruct H. + destruct (zlt ofs0 0); inv H. apply size_arguments_sf_above. eauto. - (* any64 *) destruct H. @@ -765,6 +765,6 @@ Qed. Lemma loc_arguments_main: loc_arguments signature_main = nil. Proof. - unfold loc_arguments. + unfold loc_arguments. destruct Archi.abi; reflexivity. Qed. diff --git a/arm/Machregs.v b/arm/Machregs.v index f4bd4613..211d2791 100644 --- a/arm/Machregs.v +++ b/arm/Machregs.v @@ -21,7 +21,7 @@ Require Import Op. (** The following type defines the machine registers that can be referenced as locations. These include: - Integer registers that can be allocated to RTL pseudo-registers ([Rxx]). -- Floating-point registers that can be allocated to RTL pseudo-registers +- Floating-point registers that can be allocated to RTL pseudo-registers ([Fxx]). The type [mreg] does not include reserved machine registers @@ -45,9 +45,9 @@ Global Opaque mreg_eq. Definition mreg_type (r: mreg): typ := match r with - | R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 + | R0 | R1 | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | R11 | R12 => Tany32 - | F0 | F1 | F2 | F3 | F4 | F5 | F6 | F7 + | F0 | F1 | F2 | F3 | F4 | F5 | F6 | F7 | F8 | F9 | F10 | F11 | F12 | F13 | F14 | F15 => Tany64 end. diff --git a/arm/NeedOp.v b/arm/NeedOp.v index e91ea64d..41b80941 100644 --- a/arm/NeedOp.v +++ b/arm/NeedOp.v @@ -120,7 +120,7 @@ Lemma needs_of_condition_sound: vagree_list args args' (needs_of_condition cond) -> eval_condition cond args' m' = Some b. Proof. - intros. unfold needs_of_condition in H0. + intros. unfold needs_of_condition in H0. eapply default_needs_of_condition_sound; eauto. Qed. @@ -129,10 +129,10 @@ Lemma needs_of_shift_sound: vagree v v' (needs_of_shift s nv) -> vagree (eval_shift s v) (eval_shift s v') nv. Proof. - intros. destruct s; simpl in *. + intros. destruct s; simpl in *. apply shlimm_sound; auto. apply shruimm_sound; auto. - apply shrimm_sound; auto. + apply shrimm_sound; auto. apply ror_sound; auto. Qed. @@ -157,32 +157,32 @@ Proof. - apply sign_ext_sound; auto. compute; auto. - apply sign_ext_sound; auto. compute; auto. - apply add_sound; auto. -- apply add_sound; auto. apply needs_of_shift_sound; auto. +- apply add_sound; auto. apply needs_of_shift_sound; auto. - apply add_sound; auto with na. -- replace (default nv) with All in *. - apply vagree_lessdef. apply val_sub_lessdef; auto with na. +- replace (default nv) with All in *. + apply vagree_lessdef. apply val_sub_lessdef; auto with na. apply lessdef_vagree. apply needs_of_shift_sound; auto with na. destruct nv; simpl; congruence. -- replace (default nv) with All in *. - apply vagree_lessdef. apply val_sub_lessdef; auto with na. +- replace (default nv) with All in *. + apply vagree_lessdef. apply val_sub_lessdef; auto with na. apply lessdef_vagree. apply needs_of_shift_sound; auto with na. destruct nv; simpl; congruence. -- apply mul_sound; auto. -- apply add_sound; auto. apply mul_sound; auto. +- apply mul_sound; auto. +- apply add_sound; auto. apply mul_sound; auto. - apply and_sound; auto. -- apply and_sound; auto. apply needs_of_shift_sound; auto. +- apply and_sound; auto. apply needs_of_shift_sound; auto. - apply andimm_sound; auto. - apply or_sound; auto. -- apply or_sound; auto. apply needs_of_shift_sound; auto. +- apply or_sound; auto. apply needs_of_shift_sound; auto. - apply orimm_sound; auto. - apply xor_sound; auto. -- apply xor_sound; auto. apply needs_of_shift_sound; auto. +- apply xor_sound; auto. apply needs_of_shift_sound; auto. - apply xor_sound; auto with na. -- apply and_sound; auto. apply notint_sound; auto. -- apply and_sound; auto. apply notint_sound. apply needs_of_shift_sound; auto. -- apply notint_sound; auto. +- apply and_sound; auto. apply notint_sound; auto. +- apply and_sound; auto. apply notint_sound. apply needs_of_shift_sound; auto. +- apply notint_sound; auto. - apply notint_sound. apply needs_of_shift_sound; auto. -- apply needs_of_shift_sound; auto. +- apply needs_of_shift_sound; auto. Qed. Lemma operation_is_redundant_sound: @@ -195,7 +195,7 @@ Proof. intros. destruct op; simpl in *; try discriminate; inv H1; FuncInv; subst. - apply sign_ext_redundant_sound; auto. omega. - apply sign_ext_redundant_sound; auto. omega. -- apply andimm_redundant_sound; auto. +- apply andimm_redundant_sound; auto. - apply orimm_redundant_sound; auto. Qed. @@ -17,7 +17,7 @@ - [operation]: arithmetic and logical operations; - [addressing]: addressing modes for load and store operations. - These types are processor-specific and correspond roughly to what the + These types are processor-specific and correspond roughly to what the processor can compute in one instruction. In other terms, these types reflect the state of the program after instruction selection. For a processor-independent set of operations, see the abstract @@ -36,7 +36,7 @@ Require Import Events. Set Implicit Arguments. -Record shift_amount: Type := +Record shift_amount: Type := { s_amount: int; s_range: Int.ltu s_amount Int.iwordsize = true }. @@ -141,7 +141,7 @@ Inductive operation : Type := (*c Boolean tests: *) | Ocmp: condition -> operation. (**r [rd = 1] if condition holds, [rd = 0] otherwise. *) -(** Addressing modes. [r1], [r2], etc, are the arguments to the +(** Addressing modes. [r1], [r2], etc, are the arguments to the addressing. *) Inductive addressing: Type := @@ -510,15 +510,15 @@ Program Definition mk_shift_amount (n: int) : shift_amount := {| s_amount := Int.modu n Int.iwordsize; s_range := _ |}. Next Obligation. assert (0 <= Zmod (Int.unsigned n) 32 < 32). apply Z_mod_lt. omega. - unfold Int.ltu, Int.modu. change (Int.unsigned Int.iwordsize) with 32. - rewrite Int.unsigned_repr. apply zlt_true. omega. + unfold Int.ltu, Int.modu. change (Int.unsigned Int.iwordsize) with 32. + rewrite Int.unsigned_repr. apply zlt_true. omega. assert (32 < Int.max_unsigned). compute; auto. omega. Qed. Lemma mk_shift_amount_eq: forall n, Int.ltu n Int.iwordsize = true -> s_amount (mk_shift_amount n) = n. Proof. - intros; simpl. unfold Int.modu. transitivity (Int.repr (Int.unsigned n)). + intros; simpl. unfold Int.modu. transitivity (Int.repr (Int.unsigned n)). decEq. apply Zmod_small. apply Int.ltu_inv; auto. apply Int.repr_unsigned. Qed. @@ -540,7 +540,7 @@ Proof. intros until a. unfold is_move_operation; destruct op; try (intros; discriminate). destruct args. intros; discriminate. - destruct args. intros. intuition congruence. + destruct args. intros. intuition congruence. intros; discriminate. Qed. @@ -576,13 +576,13 @@ Proof. repeat (destruct vl; auto). apply Val.negate_cmpu_bool. repeat (destruct vl; auto). apply Val.negate_cmp_bool. repeat (destruct vl; auto). apply Val.negate_cmpu_bool. - repeat (destruct vl; auto). + repeat (destruct vl; auto). repeat (destruct vl; auto). destruct (Val.cmpf_bool c v v0); auto. destruct b; auto. - repeat (destruct vl; auto). + repeat (destruct vl; auto). repeat (destruct vl; auto). destruct (Val.cmpf_bool c v (Vfloat Float.zero)); auto. destruct b; auto. - repeat (destruct vl; auto). + repeat (destruct vl; auto). repeat (destruct vl; auto). destruct (Val.cmpfs_bool c v v0); auto. destruct b; auto. - repeat (destruct vl; auto). + repeat (destruct vl; auto). repeat (destruct vl; auto). destruct (Val.cmpfs_bool c v (Vsingle Float32.zero)); auto. destruct b; auto. Qed. @@ -603,7 +603,7 @@ Definition shift_stack_operation (delta: int) (op: operation) := Lemma type_shift_stack_addressing: forall delta addr, type_of_addressing (shift_stack_addressing delta addr) = type_of_addressing addr. Proof. - intros. destruct addr; auto. + intros. destruct addr; auto. Qed. Lemma type_shift_stack_operation: @@ -650,7 +650,7 @@ Lemma eval_offset_addressing: Proof. intros. destruct addr; simpl in H; inv H; simpl in *; FuncInv; subst. rewrite Val.add_assoc; auto. - rewrite Val.add_assoc. auto. + rewrite Val.add_assoc. auto. Qed. (** Transformation of addressing modes with two operands or more @@ -750,7 +750,7 @@ Lemma eval_operation_preserved: eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m. Proof. intros. - unfold eval_operation; destruct op; auto. + unfold eval_operation; destruct op; auto. unfold Genv.symbol_address. rewrite agree_on_symbols; auto. Qed. @@ -826,7 +826,7 @@ Ltac InvInject := Remark eval_shift_inj: forall s v v', Val.inject f v v' -> Val.inject f (eval_shift s v) (eval_shift s v'). Proof. - intros. inv H; destruct s; simpl; auto; rewrite s_range; auto. + intros. inv H; destruct s; simpl; auto; rewrite s_range; auto. Qed. Lemma eval_condition_inj: @@ -887,9 +887,9 @@ Proof. apply Values.Val.add_inject; auto. inv H4; inv H2; simpl; auto. inv H4; inv H2; simpl; auto. inv H4; inv H2; simpl; auto. - inv H4; inv H3; simpl in H1; inv H1. simpl. + inv H4; inv H3; simpl in H1; inv H1. simpl. destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2. TrivialExists. - inv H4; inv H3; simpl in H1; inv H1. simpl. + inv H4; inv H3; simpl in H1; inv H1. simpl. destruct (Int.eq i0 Int.zero); inv H2. TrivialExists. inv H4; inv H2; simpl; auto. @@ -987,7 +987,7 @@ Remark valid_pointer_extends: Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true -> Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true. Proof. - intros. inv H0. rewrite Int.add_zero. eapply Mem.valid_pointer_extends; eauto. + intros. inv H0. rewrite Int.add_zero. eapply Mem.valid_pointer_extends; eauto. Qed. Remark weak_valid_pointer_extends: @@ -1055,8 +1055,8 @@ Proof. apply valid_different_pointers_extends; auto. intros. rewrite <- val_inject_lessdef; auto. rewrite <- val_inject_lessdef; auto. - eauto. auto. - destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. + eauto. auto. + destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. Qed. Lemma eval_addressing_lessdef: @@ -1070,10 +1070,10 @@ Proof. eval_addressing genv sp addr vl2 = Some v2 /\ Val.inject (fun b => Some(b, 0)) v1 v2). eapply eval_addressing_inj with (sp1 := sp). - intros. rewrite <- val_inject_lessdef; auto. - rewrite <- val_inject_lessdef; auto. - eauto. auto. - destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. + intros. rewrite <- val_inject_lessdef; auto. + rewrite <- val_inject_lessdef; auto. + eauto. auto. + destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. Qed. End EVAL_LESSDEF. @@ -1095,7 +1095,7 @@ Remark symbol_address_inject: forall id ofs, Val.inject f (Genv.symbol_address genv id ofs) (Genv.symbol_address genv id ofs). Proof. intros. unfold Genv.symbol_address. destruct (Genv.find_symbol genv id) eqn:?; auto. - exploit (proj1 globals); eauto. intros. + exploit (proj1 globals); eauto. intros. econstructor; eauto. rewrite Int.add_zero; auto. Qed. @@ -1117,11 +1117,11 @@ Lemma eval_addressing_inject: forall addr vl1 vl2 v1, Val.inject_list f vl1 vl2 -> eval_addressing genv (Vptr sp1 Int.zero) addr vl1 = Some v1 -> - exists v2, + exists v2, eval_addressing genv (Vptr sp2 Int.zero) (shift_stack_addressing (Int.repr delta) addr) vl2 = Some v2 /\ Val.inject f v1 v2. Proof. - intros. + intros. rewrite eval_shift_stack_addressing. simpl. eapply eval_addressing_inj with (sp1 := Vptr sp1 Int.zero); eauto. intros; apply symbol_address_inject. @@ -1136,7 +1136,7 @@ Lemma eval_operation_inject: eval_operation genv (Vptr sp2 Int.zero) (shift_stack_operation (Int.repr delta) op) vl2 m2 = Some v2 /\ Val.inject f v1 v2. Proof. - intros. + intros. rewrite eval_shift_stack_operation. simpl. eapply eval_operation_inj with (sp1 := Vptr sp1 Int.zero) (m1 := m1); eauto. intros; eapply Mem.valid_pointer_inject_val; eauto. diff --git a/arm/SelectOpproof.v b/arm/SelectOpproof.v index 5f41e754..297e1f64 100644 --- a/arm/SelectOpproof.v +++ b/arm/SelectOpproof.v @@ -31,7 +31,7 @@ Open Local Scope cminorsel_scope. (** The following are trivial lemmas and custom tactics that help perform backward (inversion) and forward reasoning over the evaluation - of operator applications. *) + of operator applications. *) Ltac EvalOp := eapply eval_Eop; eauto with evalexpr. @@ -116,8 +116,8 @@ Theorem eval_addrsymbol: forall le id ofs, exists v, eval_expr ge sp e m le (addrsymbol id ofs) v /\ Val.lessdef (Genv.symbol_address ge id ofs) v. Proof. - intros. unfold addrsymbol. econstructor; split. - EvalOp. simpl; eauto. + intros. unfold addrsymbol. econstructor; split. + EvalOp. simpl; eauto. auto. Qed. @@ -126,7 +126,7 @@ Theorem eval_addrstack: exists v, eval_expr ge sp e m le (addrstack ofs) v /\ Val.lessdef (Val.add sp (Vint ofs)) v. Proof. intros. unfold addrstack. econstructor; split. - EvalOp. simpl; eauto. + EvalOp. simpl; eauto. auto. Qed. @@ -146,14 +146,14 @@ Theorem eval_addimm: Proof. red; unfold addimm; intros until x. predSpec Int.eq Int.eq_spec n Int.zero. - subst n. intros. exists x; split; auto. + subst n. intros. exists x; split; auto. destruct x; simpl; auto. rewrite Int.add_zero. auto. rewrite Int.add_zero. auto. case (addimm_match a); intros; InvEval; simpl; TrivialExists; simpl. rewrite Int.add_commut. auto. unfold Genv.symbol_address. destruct (Genv.find_symbol ge s); simpl; auto. rewrite Int.add_commut; auto. rewrite Val.add_assoc. rewrite Int.add_commut. auto. subst x. rewrite Val.add_assoc. rewrite Int.add_commut. auto. -Qed. +Qed. Theorem eval_add: binary_constructor_sound add Val.add. Proof. @@ -161,12 +161,12 @@ Proof. unfold add; case (add_match a b); intros; InvEval. rewrite Val.add_commut. apply eval_addimm; auto. apply eval_addimm; auto. - subst. + subst. replace (Val.add (Val.add v1 (Vint n1)) (Val.add v0 (Vint n2))) with (Val.add (Val.add v1 v0) (Val.add (Vint n1) (Vint n2))). apply eval_addimm. EvalOp. repeat rewrite Val.add_assoc. decEq. apply Val.add_permut. - subst. + subst. replace (Val.add (Val.add v1 (Vint n1)) y) with (Val.add (Val.add v1 y) (Vint n1)). apply eval_addimm. EvalOp. @@ -174,7 +174,7 @@ Proof. subst. rewrite <- Val.add_assoc. apply eval_addimm. EvalOp. subst. rewrite Val.add_commut. TrivialExists. subst. TrivialExists. - subst. TrivialExists. + subst. TrivialExists. subst. rewrite Val.add_commut. TrivialExists. TrivialExists. Qed. @@ -184,7 +184,7 @@ Proof. red; intros until x. unfold rsubimm; case (rsubimm_match a); intros. InvEval. TrivialExists. InvEval. subst x. econstructor; split. EvalOp. unfold eval_operation; eauto. - destruct v1; simpl; auto. rewrite Int.sub_add_r. rewrite <- Int.sub_add_opp. + destruct v1; simpl; auto. rewrite Int.sub_add_r. rewrite <- Int.sub_add_opp. auto. InvEval. subst x. econstructor; split. EvalOp. simpl; eauto. fold (Val.sub (Vint m0) v1). destruct v1; simpl; auto. @@ -198,7 +198,7 @@ Proof. red; intros until y. unfold sub; case (sub_match a b); intros; InvEval. rewrite Val.sub_add_opp. apply eval_addimm; auto. - subst. rewrite Val.sub_add_l. rewrite Val.sub_add_r. + subst. rewrite Val.sub_add_l. rewrite Val.sub_add_r. rewrite Val.add_assoc. simpl. rewrite Int.add_commut. rewrite <- Int.sub_add_opp. apply eval_addimm; EvalOp. subst. rewrite Val.sub_add_l. apply eval_addimm; EvalOp. @@ -211,7 +211,7 @@ Qed. Theorem eval_negint: unary_constructor_sound negint (fun v => Val.sub Vzero v). Proof. - red; intros. unfold negint. apply eval_rsubimm; auto. + red; intros. unfold negint. apply eval_rsubimm; auto. Qed. Theorem eval_shlimm: @@ -227,11 +227,11 @@ Opaque mk_shift_amount. InvEval. simpl; rewrite Heqb. TrivialExists. destruct (Int.ltu (Int.add n n1) Int.iwordsize) eqn:?. InvEval. subst x. exists (Val.shl v1 (Vint (Int.add n n1))); split. EvalOp. - simpl. rewrite mk_shift_amount_eq; auto. + simpl. rewrite mk_shift_amount_eq; auto. destruct v1; simpl; auto. rewrite s_range. simpl. rewrite Heqb. rewrite Heqb0. rewrite Int.add_commut. rewrite Int.shl_shl; auto. apply s_range. rewrite Int.add_commut; auto. - TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. - TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. intros; TrivialExists. simpl. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. auto. Qed. @@ -247,11 +247,11 @@ Proof. InvEval. simpl; rewrite Heqb. TrivialExists. destruct (Int.ltu (Int.add n n1) Int.iwordsize) eqn:?. InvEval. subst x. exists (Val.shr v1 (Vint (Int.add n n1))); split. EvalOp. - simpl. rewrite mk_shift_amount_eq; auto. + simpl. rewrite mk_shift_amount_eq; auto. destruct v1; simpl; auto. rewrite s_range. simpl. rewrite Heqb. rewrite Heqb0. rewrite Int.add_commut. rewrite Int.shr_shr; auto. apply s_range. rewrite Int.add_commut; auto. - TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. - TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. intros; TrivialExists. simpl. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. auto. Qed. @@ -267,11 +267,11 @@ Proof. InvEval. simpl; rewrite Heqb. TrivialExists. destruct (Int.ltu (Int.add n n1) Int.iwordsize) eqn:?. InvEval. subst x. exists (Val.shru v1 (Vint (Int.add n n1))); split. EvalOp. - simpl. rewrite mk_shift_amount_eq; auto. + simpl. rewrite mk_shift_amount_eq; auto. destruct v1; simpl; auto. destruct (Int.ltu n1 Int.iwordsize) eqn:?; simpl; auto. rewrite Heqb; rewrite Heqb0. rewrite Int.add_commut. rewrite Int.shru_shru; auto. rewrite Int.add_commut; auto. - TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. - TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. intros; TrivialExists. simpl. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. auto. Qed. @@ -282,12 +282,12 @@ Proof. assert (DFL: exists v, eval_expr ge sp e m le (Eop Omul (Eop (Ointconst n) Enil ::: a ::: Enil)) v /\ Val.lessdef (Val.mul x (Vint n)) v). TrivialExists. econstructor. EvalOp. simpl; eauto. econstructor. eauto. constructor. rewrite Val.mul_commut. auto. - generalize (Int.one_bits_decomp n). + generalize (Int.one_bits_decomp n). generalize (Int.one_bits_range n). destruct (Int.one_bits n). intros. auto. destruct l. - intros. rewrite H1. simpl. + intros. rewrite H1. simpl. rewrite Int.add_zero. replace (Vint (Int.shl Int.one i)) with (Val.shl Vone (Vint i)). rewrite Val.shl_mul. apply eval_shlimm. auto. simpl. rewrite H0; auto with coqlib. @@ -296,13 +296,13 @@ Proof. exploit (eval_shlimm i (x :: le) (Eletvar 0) x). constructor; auto. intros [v1 [A1 B1]]. exploit (eval_shlimm i0 (x :: le) (Eletvar 0) x). constructor; auto. intros [v2 [A2 B2]]. exploit (eval_add (x :: le)). eexact A1. eexact A2. intros [v [A B]]. - exists v; split. econstructor; eauto. + exists v; split. econstructor; eauto. rewrite Int.add_zero. replace (Vint (Int.add (Int.shl Int.one i) (Int.shl Int.one i0))) with (Val.add (Val.shl Vone (Vint i)) (Val.shl Vone (Vint i0))). rewrite Val.mul_add_distr_r. repeat rewrite Val.shl_mul. eapply Val.lessdef_trans. 2: eauto. apply Val.add_lessdef; auto. - simpl. repeat rewrite H0; auto with coqlib. + simpl. repeat rewrite H0; auto with coqlib. intros. auto. Qed. @@ -311,18 +311,18 @@ Theorem eval_mulimm: forall n, unary_constructor_sound (mulimm n) (fun x => Val.mul x (Vint n)). Proof. intros; red; intros until x; unfold mulimm. - predSpec Int.eq Int.eq_spec n Int.zero. - intros. exists (Vint Int.zero); split. EvalOp. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists (Vint Int.zero); split. EvalOp. destruct x; simpl; auto. subst n. rewrite Int.mul_zero. auto. predSpec Int.eq Int.eq_spec n Int.one. intros. exists x; split; auto. destruct x; simpl; auto. subst n. rewrite Int.mul_one. auto. case (mulimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.mul_commut; auto. - subst. rewrite Val.mul_add_distr_l. + subst. rewrite Val.mul_add_distr_l. exploit eval_mulimm_base; eauto. instantiate (1 := n). intros [v' [A1 B1]]. exploit (eval_addimm (Int.mul n n2) le (mulimm_base n t2) v'). auto. intros [v'' [A2 B2]]. - exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.add_lessdef; eauto. + exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.add_lessdef; eauto. rewrite Val.mul_commut; auto. apply eval_mulimm_base; auto. Qed. @@ -331,7 +331,7 @@ Theorem eval_mul: binary_constructor_sound mul Val.mul. Proof. red; intros until y. unfold mul; case (mul_match a b); intros; InvEval. - rewrite Val.mul_commut. apply eval_mulimm. auto. + rewrite Val.mul_commut. apply eval_mulimm. auto. apply eval_mulimm. auto. TrivialExists. Qed. @@ -340,15 +340,15 @@ Theorem eval_andimm: forall n, unary_constructor_sound (andimm n) (fun x => Val.and x (Vint n)). Proof. intros; red; intros until x. unfold andimm. - predSpec Int.eq Int.eq_spec n Int.zero. - intros. exists (Vint Int.zero); split. EvalOp. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists (Vint Int.zero); split. EvalOp. destruct x; simpl; auto. subst n. rewrite Int.and_zero. auto. predSpec Int.eq Int.eq_spec n Int.mone. - intros. exists x; split; auto. + intros. exists x; split; auto. subst. destruct x; simpl; auto. rewrite Int.and_mone; auto. case (andimm_match a); intros. InvEval. TrivialExists. simpl. rewrite Int.and_commut; auto. - InvEval. subst. rewrite Val.and_assoc. simpl. rewrite Int.and_commut. TrivialExists. + InvEval. subst. rewrite Val.and_assoc. simpl. rewrite Int.and_commut. TrivialExists. TrivialExists. Qed. @@ -374,11 +374,11 @@ Proof. intros. subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.or_zero; auto. predSpec Int.eq Int.eq_spec n Int.mone. - intros. exists (Vint Int.mone); split. EvalOp. + intros. exists (Vint Int.mone); split. EvalOp. destruct x; simpl; auto. subst n. rewrite Int.or_mone. auto. destruct (orimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.or_commut; auto. - subst. rewrite Val.or_assoc. simpl. rewrite Int.or_commut. TrivialExists. + subst. rewrite Val.or_assoc. simpl. rewrite Int.or_commut. TrivialExists. TrivialExists. Qed. @@ -390,10 +390,10 @@ Remark eval_same_expr: a1 = a2 /\ v1 = v2. Proof. intros until v2. - destruct a1; simpl; try (intros; discriminate). + destruct a1; simpl; try (intros; discriminate). destruct a2; simpl; try (intros; discriminate). case (ident_eq i i0); intros. - subst i0. inversion H0. inversion H1. split. auto. congruence. + subst i0. inversion H0. inversion H1. split. auto. congruence. discriminate. Qed. @@ -406,9 +406,9 @@ Proof. destruct (Int.eq (Int.add n1 n2) Int.iwordsize && same_expr_pure t1 t2) eqn:?. destruct (andb_prop _ _ Heqb0). generalize (Int.eq_spec (Int.add n1 n2) Int.iwordsize); rewrite H1; intros. - exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst. + exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst. exists (Val.ror v0 (Vint n2)); split. EvalOp. - destruct v0; simpl; auto. + destruct v0; simpl; auto. destruct (Int.ltu n1 Int.iwordsize) eqn:?; auto. destruct (Int.ltu n2 Int.iwordsize) eqn:?; auto. simpl. rewrite <- Int.or_ror; auto. @@ -419,9 +419,9 @@ Proof. destruct (Int.eq (Int.add n2 n1) Int.iwordsize && same_expr_pure t1 t2) eqn:?. destruct (andb_prop _ _ Heqb0). generalize (Int.eq_spec (Int.add n2 n1) Int.iwordsize); rewrite H1; intros. - exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst. + exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst. exists (Val.ror v0 (Vint n1)); split. EvalOp. - destruct v0; simpl; auto. + destruct v0; simpl; auto. destruct (Int.ltu n1 Int.iwordsize) eqn:?; auto. destruct (Int.ltu n2 Int.iwordsize) eqn:?; auto. simpl. rewrite Int.or_commut. rewrite <- Int.or_ror; auto. @@ -439,15 +439,15 @@ Theorem eval_xorimm: forall n, unary_constructor_sound (xorimm n) (fun x => Val.xor x (Vint n)). Proof. intros; red; intros until x. unfold xorimm. - predSpec Int.eq Int.eq_spec n Int.zero. - intros. exists x; split. auto. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists x; split. auto. destruct x; simpl; auto. subst n. rewrite Int.xor_zero. auto. predSpec Int.eq Int.eq_spec n Int.mone. intros. subst n. rewrite <- Val.not_xor. apply eval_notint; auto. intros. destruct (xorimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.xor_commut; auto. subst. rewrite Val.xor_assoc. simpl. rewrite Int.xor_commut. TrivialExists. - subst x. rewrite Val.not_xor. rewrite Val.xor_assoc. + subst x. rewrite Val.not_xor. rewrite Val.xor_assoc. rewrite (Val.xor_commut (Vint Int.mone)). TrivialExists. TrivialExists. Qed. @@ -472,19 +472,19 @@ Lemma eval_mod_aux: eval_expr ge sp e m le (mod_aux divop a b) (Val.sub x (Val.mul z y)). Proof. intros; unfold mod_aux. - eapply eval_Elet. eexact H0. eapply eval_Elet. + eapply eval_Elet. eexact H0. eapply eval_Elet. apply eval_lift. eexact H1. - eapply eval_Eop. eapply eval_Econs. + eapply eval_Eop. eapply eval_Econs. eapply eval_Eletvar. simpl; reflexivity. - eapply eval_Econs. eapply eval_Eop. + eapply eval_Econs. eapply eval_Eop. eapply eval_Econs. eapply eval_Eop. eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity. eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity. - apply eval_Enil. + apply eval_Enil. rewrite H. eauto. eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity. - apply eval_Enil. - simpl; reflexivity. apply eval_Enil. + apply eval_Enil. + simpl; reflexivity. apply eval_Enil. reflexivity. Qed. @@ -505,7 +505,7 @@ Theorem eval_mods_base: Val.mods x y = Some z -> exists v, eval_expr ge sp e m le (mods_base a b) v /\ Val.lessdef z v. Proof. - intros; unfold mods_base. + intros; unfold mods_base. exploit Val.mods_divs; eauto. intros [v [A B]]. subst. econstructor; split; eauto. apply eval_mod_aux with (semdivop := Val.divs); auto. @@ -528,7 +528,7 @@ Theorem eval_modu_base: Val.modu x y = Some z -> exists v, eval_expr ge sp e m le (modu_base a b) v /\ Val.lessdef z v. Proof. - intros; unfold modu_base. + intros; unfold modu_base. exploit Val.modu_divu; eauto. intros [v [A B]]. subst. econstructor; split; eauto. apply eval_mod_aux with (semdivop := Val.divu); auto. @@ -540,13 +540,13 @@ Theorem eval_shrximm: Val.shrx x (Vint n) = Some z -> exists v, eval_expr ge sp e m le (shrximm a n) v /\ Val.lessdef z v. Proof. - intros. unfold shrximm. + intros. unfold shrximm. predSpec Int.eq Int.eq_spec n Int.zero. - subst n. exists x; split; auto. + subst n. exists x; split; auto. destruct x; simpl in H0; try discriminate. destruct (Int.ltu Int.zero (Int.repr 31)); inv H0. - replace (Int.shrx i Int.zero) with i. auto. - unfold Int.shrx, Int.divs. rewrite Int.shl_zero. + replace (Int.shrx i Int.zero) with i. auto. + unfold Int.shrx, Int.divs. rewrite Int.shl_zero. change (Int.signed Int.one) with 1. rewrite Z.quot_1_r. rewrite Int.repr_signed; auto. econstructor; split. EvalOp. auto. Qed. @@ -555,39 +555,39 @@ Theorem eval_shl: binary_constructor_sound shl Val.shl. Proof. red; intros until y; unfold shl; case (shl_match b); intros. InvEval. apply eval_shlimm; auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_shr: binary_constructor_sound shr Val.shr. Proof. red; intros until y; unfold shr; case (shr_match b); intros. InvEval. apply eval_shrimm; auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_shru: binary_constructor_sound shru Val.shru. Proof. red; intros until y; unfold shru; case (shru_match b); intros. InvEval. apply eval_shruimm; auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_negf: unary_constructor_sound negf Val.negf. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_absf: unary_constructor_sound absf Val.absf. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_addf: binary_constructor_sound addf Val.addf. Proof. red; intros; TrivialExists. Qed. - + Theorem eval_subf: binary_constructor_sound subf Val.subf. Proof. red; intros; TrivialExists. @@ -600,19 +600,19 @@ Qed. Theorem eval_negfs: unary_constructor_sound negfs Val.negfs. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_absfs: unary_constructor_sound absfs Val.absfs. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_addfs: binary_constructor_sound addfs Val.addfs. Proof. red; intros; TrivialExists. Qed. - + Theorem eval_subfs: binary_constructor_sound subfs Val.subfs. Proof. red; intros; TrivialExists. @@ -646,8 +646,8 @@ Proof. (* constant *) InvEval. rewrite sem_int. TrivialExists. simpl. destruct (intsem c0 n1 n2); auto. (* eq cmp *) - InvEval. inv H. simpl in H5. inv H5. - destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. + InvEval. inv H. simpl in H5. inv H5. + destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. simpl. rewrite eval_negate_condition. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_eq; auto. @@ -656,13 +656,13 @@ Proof. simpl. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_eq; auto. rewrite sem_undef; auto. - exists (Vint Int.zero); split. EvalOp. + exists (Vint Int.zero); split. EvalOp. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; rewrite sem_eq; rewrite Int.eq_false; auto. rewrite sem_undef; auto. (* ne cmp *) - InvEval. inv H. simpl in H5. inv H5. - destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. + InvEval. inv H. simpl in H5. inv H5. + destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. simpl. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_ne; auto. rewrite sem_undef; auto. @@ -670,7 +670,7 @@ Proof. simpl. rewrite eval_negate_condition. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_ne; auto. rewrite sem_undef; auto. - exists (Vint Int.one); split. EvalOp. + exists (Vint Int.one); split. EvalOp. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; rewrite sem_ne; rewrite Int.eq_false; auto. rewrite sem_undef; auto. @@ -687,7 +687,7 @@ Lemma eval_compimm_swap: exists v, eval_expr ge sp e m le (compimm default intsem (swap_comparison c) a n2) v /\ Val.lessdef (sem c (Vint n2) x) v. Proof. - intros. rewrite <- sem_swap. eapply eval_compimm; eauto. + intros. rewrite <- sem_swap. eapply eval_compimm; eauto. Qed. End COMP_IMM. @@ -696,9 +696,9 @@ Theorem eval_comp: forall c, binary_constructor_sound (comp c) (Val.cmp c). Proof. intros; red; intros until y. unfold comp; case (comp_match a b); intros; InvEval. - eapply eval_compimm_swap; eauto. + eapply eval_compimm_swap; eauto. intros. unfold Val.cmp. rewrite Val.swap_cmp_bool; auto. - eapply eval_compimm; eauto. + eapply eval_compimm; eauto. TrivialExists. Qed. @@ -706,9 +706,9 @@ Theorem eval_compu: forall c, binary_constructor_sound (compu c) (Val.cmpu (Mem.valid_pointer m) c). Proof. intros; red; intros until y. unfold compu; case (compu_match a b); intros; InvEval. - eapply eval_compimm_swap; eauto. + eapply eval_compimm_swap; eauto. intros. unfold Val.cmpu. rewrite Val.swap_cmpu_bool; auto. - eapply eval_compimm; eauto. + eapply eval_compimm; eauto. TrivialExists. Qed. @@ -766,7 +766,7 @@ Theorem eval_intoffloat: Val.intoffloat x = Some y -> exists v, eval_expr ge sp e m le (intoffloat a) v /\ Val.lessdef y v. Proof. - intros; unfold intoffloat. TrivialExists. + intros; unfold intoffloat. TrivialExists. Qed. Theorem eval_floatofint: @@ -776,8 +776,8 @@ Theorem eval_floatofint: exists v, eval_expr ge sp e m le (floatofint a) v /\ Val.lessdef y v. Proof. intros until y; unfold floatofint. case (floatofint_match a); intros. - InvEval. simpl in H0. TrivialExists. - TrivialExists. + InvEval. simpl in H0. TrivialExists. + TrivialExists. Qed. Theorem eval_intuoffloat: @@ -786,7 +786,7 @@ Theorem eval_intuoffloat: Val.intuoffloat x = Some y -> exists v, eval_expr ge sp e m le (intuoffloat a) v /\ Val.lessdef y v. Proof. - intros; unfold intuoffloat. TrivialExists. + intros; unfold intuoffloat. TrivialExists. Qed. Theorem eval_floatofintu: @@ -796,7 +796,7 @@ Theorem eval_floatofintu: exists v, eval_expr ge sp e m le (floatofintu a) v /\ Val.lessdef y v. Proof. intros until y; unfold floatofintu. case (floatofintu_match a); intros. - InvEval. simpl in H0. TrivialExists. + InvEval. simpl in H0. TrivialExists. TrivialExists. Qed. @@ -806,7 +806,7 @@ Theorem eval_intofsingle: Val.intofsingle x = Some y -> exists v, eval_expr ge sp e m le (intofsingle a) v /\ Val.lessdef y v. Proof. - intros; unfold intofsingle. TrivialExists. + intros; unfold intofsingle. TrivialExists. Qed. Theorem eval_singleofint: @@ -816,8 +816,8 @@ Theorem eval_singleofint: exists v, eval_expr ge sp e m le (singleofint a) v /\ Val.lessdef y v. Proof. intros until y; unfold singleofint. case (singleofint_match a); intros. - InvEval. simpl in H0. TrivialExists. - TrivialExists. + InvEval. simpl in H0. TrivialExists. + TrivialExists. Qed. Theorem eval_intuofsingle: @@ -826,7 +826,7 @@ Theorem eval_intuofsingle: Val.intuofsingle x = Some y -> exists v, eval_expr ge sp e m le (intuofsingle a) v /\ Val.lessdef y v. Proof. - intros; unfold intuofsingle. TrivialExists. + intros; unfold intuofsingle. TrivialExists. Qed. Theorem eval_singleofintu: @@ -836,7 +836,7 @@ Theorem eval_singleofintu: exists v, eval_expr ge sp e m le (singleofintu a) v /\ Val.lessdef y v. Proof. intros until y; unfold singleofintu. case (singleofintu_match a); intros. - InvEval. simpl in H0. TrivialExists. + InvEval. simpl in H0. TrivialExists. TrivialExists. Qed. @@ -846,7 +846,7 @@ Theorem eval_addressing: v = Vptr b ofs -> match addressing chunk a with (mode, args) => exists vl, - eval_exprlist ge sp e m le args vl /\ + eval_exprlist ge sp e m le args vl /\ eval_addressing ge sp mode vl = Some v end. Proof. @@ -872,12 +872,12 @@ Proof. intros until v. unfold builtin_arg; case (builtin_arg_match a); intros; InvEval. - constructor. - constructor. -- constructor. +- constructor. - simpl in H5. inv H5. constructor. - subst v. constructor; auto. - inv H. InvEval. simpl in H6; inv H6. constructor; auto. - inv H. InvEval. simpl in H6. rewrite <- Genv.shift_symbol_address in H6. - inv H6. constructor; auto. + inv H6. constructor; auto. - constructor; auto. Qed. diff --git a/arm/Stacklayout.v b/arm/Stacklayout.v index 7694dcfe..82d11727 100644 --- a/arm/Stacklayout.v +++ b/arm/Stacklayout.v @@ -112,7 +112,7 @@ Proof. set (x1 := 4 * bound_outgoing b). assert (4 | x1). unfold x1; exists (bound_outgoing b); ring. set (x2 := align x1 8). - assert (8 | x2). apply align_divides. omega. + assert (8 | x2). apply align_divides. omega. set (x3 := x2 + 4 * bound_local b). assert (4 | x3). apply Zdivide_plus_r. apply Zdivides_trans with 8; auto. exists 2; auto. exists (bound_local b); ring. @@ -121,10 +121,10 @@ Proof. set (x5 := x4 + 8 * bound_float_callee_save b). assert (8 | x5). apply Zdivide_plus_r; auto. exists (bound_float_callee_save b); ring. assert (4 | x5). apply Zdivides_trans with 8; auto. exists 2; auto. - set (x6 := x5 + 4). + set (x6 := x5 + 4). assert (4 | x6). apply Zdivide_plus_r; auto. exists 1; auto. set (x7 := x6 + 4). - assert (8 | x7). unfold x7, x6. replace (x5 + 4 + 4) with (x5 + 8) by omega. + assert (8 | x7). unfold x7, x6. replace (x5 + 4 + 4) with (x5 + 8) by omega. apply Zdivide_plus_r; auto. exists 1; auto. set (x8 := align (x7 + bound_stack_data b) 8). assert (8 | x8). apply align_divides. omega. diff --git a/arm/TargetPrinter.ml b/arm/TargetPrinter.ml index 04226900..a938725a 100644 --- a/arm/TargetPrinter.ml +++ b/arm/TargetPrinter.ml @@ -40,13 +40,13 @@ module type PRINTER_OPTIONS = module Target (Opt: PRINTER_OPTIONS) : TARGET = struct (* Code generation options. *) - + let literals_in_code = ref true (* to be turned into a proper option *) - + (* Basic printing functions *) - + let print_label oc lbl = elf_label oc (transl_label lbl) - + let comment = "@" let symbol = elf_symbol @@ -61,34 +61,34 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = | IR4 -> "r4" | IR5 -> "r5" | IR6 -> "r6" | IR7 -> "r7" | IR8 -> "r8" | IR9 -> "r9" | IR10 -> "r10" | IR11 -> "r11" | IR12 -> "r12" | IR13 -> "sp" | IR14 -> "lr" - + let float_reg_name = function | FR0 -> "d0" | FR1 -> "d1" | FR2 -> "d2" | FR3 -> "d3" | FR4 -> "d4" | FR5 -> "d5" | FR6 -> "d6" | FR7 -> "d7" | FR8 -> "d8" | FR9 -> "d9" | FR10 -> "d10" | FR11 -> "d11" | FR12 -> "d12" | FR13 -> "d13" | FR14 -> "d14" | FR15 -> "d15" - + let single_float_reg_index = function | FR0 -> 0 | FR1 -> 2 | FR2 -> 4 | FR3 -> 6 | FR4 -> 8 | FR5 -> 10 | FR6 -> 12 | FR7 -> 14 | FR8 -> 16 | FR9 -> 18 | FR10 -> 20 | FR11 -> 22 | FR12 -> 24 | FR13 -> 26 | FR14 -> 28 | FR15 -> 30 - + let single_float_reg_name = function | FR0 -> "s0" | FR1 -> "s2" | FR2 -> "s4" | FR3 -> "s6" | FR4 -> "s8" | FR5 -> "s10" | FR6 -> "s12" | FR7 -> "s14" | FR8 -> "s16" | FR9 -> "s18" | FR10 -> "s20" | FR11 -> "s22" | FR12 -> "s24" | FR13 -> "s26" | FR14 -> "s28" | FR15 -> "s30" - + let ireg oc r = output_string oc (int_reg_name r) let freg oc r = output_string oc (float_reg_name r) let freg_single oc r = output_string oc (single_float_reg_name r) - + let preg oc = function | IR r -> ireg oc r | FR r -> freg oc r | _ -> assert false - + let condition_name = function | TCeq -> "eq" | TCne -> "ne" @@ -102,7 +102,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = | TClt -> "lt" | TCgt -> "gt" | TCle -> "le" - + let neg_condition_name = function | TCeq -> "ne" | TCne -> "eq" @@ -116,7 +116,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = | TClt -> "ge" | TCgt -> "le" | TCle -> "gt" - + (* In Thumb2 mode, some arithmetic instructions have shorter encodings if they carry the "S" flag (update condition flags): add (but not sp + imm) @@ -158,27 +158,27 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = | Section_debug_abbrev -> ".section .debug_abbrev,\"\",%progbits" | Section_debug_line _ -> ".section .debug_line,\"\",%progbits" - + let section oc sec = fprintf oc " %s\n" (name_of_section sec) - + (* Record current code position and latest position at which to emit float and symbol constants. *) - + let currpos = ref 0 let size_constants = ref 0 let max_pos_constants = ref max_int - + let distance_to_emit_constants () = if !literals_in_code then !max_pos_constants - (!currpos + !size_constants) else max_int - + (* Associate labels to floating-point constants and to symbols *) - + let float_labels = (Hashtbl.create 39 : (int64, int) Hashtbl.t) let float32_labels = (Hashtbl.create 39 : (int32, int) Hashtbl.t) - + let label_float bf = try Hashtbl.find float_labels bf @@ -188,7 +188,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = size_constants := !size_constants + 8; max_pos_constants := min !max_pos_constants (!currpos + 1024); lbl' - + let label_float32 bf = try Hashtbl.find float32_labels bf @@ -198,10 +198,10 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = size_constants := !size_constants + 4; max_pos_constants := min !max_pos_constants (!currpos + 1024); lbl' - + let symbol_labels = (Hashtbl.create 39 : (ident * Integers.Int.int, int) Hashtbl.t) - + let label_symbol id ofs = try Hashtbl.find symbol_labels (id, ofs) @@ -211,14 +211,14 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = size_constants := !size_constants + 4; max_pos_constants := min !max_pos_constants (!currpos + 4096); lbl' - + let reset_constants () = Hashtbl.clear float_labels; Hashtbl.clear float32_labels; Hashtbl.clear symbol_labels; size_constants := 0; max_pos_constants := max_int - + let emit_constants oc = fprintf oc " .balign 4\n"; Hashtbl.iter @@ -238,9 +238,9 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = lbl symbol_offset (id, ofs)) symbol_labels; reset_constants () - + (* Generate code to load the address of id + ofs in register r *) - + let loadsymbol oc r id ofs = if !Clflags.option_mthumb then begin fprintf oc " movw %a, #:lower16:%a\n" @@ -249,13 +249,13 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = ireg r symbol_offset (id, ofs); 2 end else begin let lbl = label_symbol id ofs in - fprintf oc " ldr %a, .L%d @ %a\n" + fprintf oc " ldr %a, .L%d @ %a\n" ireg r lbl symbol_offset (id, ofs); 1 end - + (* Emit instruction sequences that set or offset a register by a constant. *) (* No S suffix because they are applied to SP most of the time. *) - + let movimm oc dst n = match Asmgen.decompose_int n with | [] -> assert false @@ -265,7 +265,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = (fun n -> fprintf oc " orr %s, %s, #%a\n" dst dst coqint n) tl; List.length l - + let addimm oc dst src n = match Asmgen.decompose_int n with | [] -> assert false @@ -275,7 +275,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = (fun n -> fprintf oc " add %s, %s, #%a\n" dst dst coqint n) tl; List.length l - + let subimm oc dst src n = match Asmgen.decompose_int n with | [] -> assert false @@ -285,27 +285,27 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = (fun n -> fprintf oc " sub %s, %s, #%a\n" dst dst coqint n) tl; List.length l - + (* Recognition of float constants appropriate for VMOV. a normalized binary floating point encoding with 1 sign bit, 4 bits of fraction and a 3-bit exponent *) - + let is_immediate_float64 bits = let exp = (Int64.(to_int (shift_right_logical bits 52)) land 0x7FF) - 1023 in let mant = Int64.logand bits 0xF_FFFF_FFFF_FFFFL in exp >= -3 && exp <= 4 && Int64.logand mant 0xF_0000_0000_0000L = mant - + let is_immediate_float32 bits = let exp = (Int32.(to_int (shift_right_logical bits 23)) land 0xFF) - 127 in let mant = Int32.logand bits 0x7F_FFFFl in exp >= -3 && exp <= 4 && Int32.logand mant 0x78_0000l = mant - + (* Emit .file / .loc debugging directives *) - + let print_file_line oc file line = print_file_line oc comment file line - + let print_location oc loc = if loc <> Cutil.no_loc then print_file_line oc (fst loc) (snd loc) @@ -456,7 +456,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = match Opt.float_abi with | Soft -> (FixupEABI.fixup_arguments, FixupEABI.fixup_result) | Hard -> (FixupHF.fixup_arguments, FixupHF.fixup_result) - + (* Printing of instructions *) let shift_op oc = function @@ -494,7 +494,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = fprintf oc " b %a\n" symbol id; n + 1 | Pbreg(r, sg) -> - let n = + let n = if r = IR14 then fixup_result oc Outgoing sg else fixup_arguments oc Outgoing sg in @@ -886,7 +886,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = fprintf oc " .space %s\n" (Z.to_string n) | Init_addrof(symb, ofs) -> fprintf oc " .word %a\n" symbol_offset (symb, ofs) - + let print_prologue oc = fprintf oc " .syntax unified\n"; fprintf oc " .arch %s\n" @@ -908,7 +908,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = end - let print_epilogue oc = + let print_epilogue oc = if !Clflags.option_g then begin let high_pc = new_label () in Debug.add_compilation_section_end ".text" high_pc; @@ -919,22 +919,22 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET = let default_falignment = 4 - + let label = elf_label - + let new_label = new_label end -let sel_target () = +let sel_target () = let module S : PRINTER_OPTIONS = struct - + let vfpv3 = Configuration.model >= "armv7" - + let float_abi = match Configuration.abi with | "eabi" -> Soft | "hardfloat" -> Hard | _ -> assert false - + let hardware_idiv = match Configuration.model with | "armv7r" | "armv7m" -> !Clflags.option_mthumb diff --git a/arm/ValueAOp.v b/arm/ValueAOp.v index b388bf12..64a34329 100644 --- a/arm/ValueAOp.v +++ b/arm/ValueAOp.v @@ -189,7 +189,7 @@ Theorem eval_static_addressing_sound: Proof. unfold eval_addressing, eval_static_addressing; intros; destruct addr; InvHyps; eauto with va. - rewrite Int.add_zero_l; auto with va. + rewrite Int.add_zero_l; auto with va. Qed. Theorem eval_static_operation_sound: @@ -204,7 +204,7 @@ Proof. destruct (propagate_float_constants tt); constructor. rewrite Int.add_zero_l; eauto with va. fold (Val.sub (Vint i) a1). auto with va. - apply of_optbool_sound. eapply eval_static_condition_sound; eauto. + apply of_optbool_sound. eapply eval_static_condition_sound; eauto. Qed. End SOUNDNESS. diff --git a/backend/Allocation.v b/backend/Allocation.v index 196a4075..7534e23f 100644 --- a/backend/Allocation.v +++ b/backend/Allocation.v @@ -34,7 +34,7 @@ Require Import RTLtyping. Require Import LTL. (** The validation algorithm used here is described in - "Validating register allocation and spilling", + "Validating register allocation and spilling", by Silvain Rideau and Xavier Leroy, in Compiler Construction (CC 2010), LNCS 6011, Springer, 2010. *) @@ -157,7 +157,7 @@ Definition classify_operation (op: operation) (args: list reg) : operation_kind | op, args => operation_other op args end. -(** Check RTL instruction [i] against LTL basic block [b]. +(** Check RTL instruction [i] against LTL basic block [b]. On success, return [Some] with a [block_shape] describing the correspondence. On error, return [None]. *) @@ -372,7 +372,7 @@ Module OrderedEquation <: OrderedType. (OrderedLoc.lt (eloc x) (eloc y) \/ (eloc x = eloc y /\ OrderedEqKind.lt (ekind x) (ekind y)))). Lemma eq_refl : forall x : t, eq x x. - Proof (@refl_equal t). + Proof (@refl_equal t). Lemma eq_sym : forall x y : t, eq x y -> eq y x. Proof (@sym_equal t). Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. @@ -380,13 +380,13 @@ Module OrderedEquation <: OrderedType. Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. unfold lt; intros. - destruct H. + destruct H. destruct H0. left; eapply Plt_trans; eauto. destruct H0. rewrite <- H0. auto. - destruct H. rewrite H. - destruct H0. auto. + destruct H. rewrite H. + destruct H0. auto. destruct H0. right; split; auto. - intuition. + intuition. left; eapply OrderedLoc.lt_trans; eauto. left; congruence. left; congruence. @@ -405,10 +405,10 @@ Module OrderedEquation <: OrderedType. destruct (OrderedPositive.compare (ereg x) (ereg y)). - apply LT. red; auto. - destruct (OrderedLoc.compare (eloc x) (eloc y)). - + apply LT. red; auto. + + apply LT. red; auto. + destruct (OrderedEqKind.compare (ekind x) (ekind y)). * apply LT. red; auto. - * apply EQ. red in e; red in e0; red in e1; red. + * apply EQ. red in e; red in e0; red in e1; red. destruct x; destruct y; simpl in *; congruence. * apply GT. red; auto. + apply GT. red; auto. @@ -416,7 +416,7 @@ Module OrderedEquation <: OrderedType. Defined. Definition eq_dec (x y: t) : {x = y} + {x <> y}. Proof. - intros. decide equality. + intros. decide equality. apply Loc.eq. apply peq. apply IndexedEqKind.eq. @@ -434,7 +434,7 @@ Module OrderedEquation' <: OrderedType. (Plt (ereg x) (ereg y) \/ (ereg x = ereg y /\ OrderedEqKind.lt (ekind x) (ekind y)))). Lemma eq_refl : forall x : t, eq x x. - Proof (@refl_equal t). + Proof (@refl_equal t). Lemma eq_sym : forall x y : t, eq x y -> eq y x. Proof (@sym_equal t). Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. @@ -442,14 +442,14 @@ Module OrderedEquation' <: OrderedType. Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. unfold lt; intros. - destruct H. - destruct H0. left; eapply OrderedLoc.lt_trans; eauto. + destruct H. + destruct H0. left; eapply OrderedLoc.lt_trans; eauto. destruct H0. rewrite <- H0. auto. - destruct H. rewrite H. - destruct H0. auto. + destruct H. rewrite H. + destruct H0. auto. destruct H0. right; split; auto. - intuition. - left; eapply Plt_trans; eauto. + intuition. + left; eapply Plt_trans; eauto. left; congruence. left; congruence. right; split. congruence. eapply OrderedEqKind.lt_trans; eauto. @@ -467,10 +467,10 @@ Module OrderedEquation' <: OrderedType. destruct (OrderedLoc.compare (eloc x) (eloc y)). - apply LT. red; auto. - destruct (OrderedPositive.compare (ereg x) (ereg y)). - + apply LT. red; auto. + + apply LT. red; auto. + destruct (OrderedEqKind.compare (ekind x) (ekind y)). * apply LT. red; auto. - * apply EQ. red in e; red in e0; red in e1; red. + * apply EQ. red in e; red in e0; red in e1; red. destruct x; destruct y; simpl in *; congruence. * apply GT. red; auto. + apply GT. red; auto. @@ -510,10 +510,10 @@ Program Definition add_equation (q: equation) (e: eqs) := mkeqs (EqSet.add q (eqs1 e)) (EqSet2.add q (eqs2 e)) _. Next Obligation. split; intros. - destruct (OrderedEquation'.eq_dec q q0). + destruct (OrderedEquation'.eq_dec q q0). apply EqSet.add_1; auto. apply EqSet.add_2. apply (eqs_same e). apply EqSet2.add_3 with q; auto. - destruct (OrderedEquation.eq_dec q q0). + destruct (OrderedEquation.eq_dec q q0). apply EqSet2.add_1; auto. apply EqSet2.add_2. apply (eqs_same e). apply EqSet.add_3 with q; auto. Qed. @@ -522,10 +522,10 @@ Program Definition remove_equation (q: equation) (e: eqs) := mkeqs (EqSet.remove q (eqs1 e)) (EqSet2.remove q (eqs2 e)) _. Next Obligation. split; intros. - destruct (OrderedEquation'.eq_dec q q0). + destruct (OrderedEquation'.eq_dec q q0). eelim EqSet2.remove_1; eauto. apply EqSet.remove_2; auto. apply (eqs_same e). apply EqSet2.remove_3 with q; auto. - destruct (OrderedEquation.eq_dec q q0). + destruct (OrderedEquation.eq_dec q q0). eelim EqSet.remove_1; eauto. apply EqSet2.remove_2; auto. apply (eqs_same e). apply EqSet.remove_3 with q; auto. Qed. @@ -585,7 +585,7 @@ Definition subst_reg_kind (r1: reg) (k1: equation_kind) (r2: reg) (k2: equation_ (** [subst_loc l1 l2 e] simulates the effect of assigning [l2] to [l1] on [e]. All equations of the form [r = l1 [kind]] are replaced by [r = l2 [kind]]. Return [None] if [e] contains an equation of the form [r = l] with [l] - partially overlapping [l1]. + partially overlapping [l1]. *) Definition subst_loc (l1 l2: loc) (e: eqs) : option eqs := @@ -784,7 +784,7 @@ Fixpoint can_undef (ml: list mreg) (e: eqs) : bool := Fixpoint can_undef_except (l: loc) (ml: list mreg) (e: eqs) : bool := match ml with | nil => true - | m1 :: ml => + | m1 :: ml => (Loc.eq l (R m1) || loc_unconstrained (R m1) e) && can_undef_except l ml e end. @@ -967,11 +967,11 @@ Definition transfer_aux (f: RTL.function) (env: regenv) track_moves env mv e1 | BSstore2 addr addr' args src mv1 args1' src1' mv2 args2' src2' s => assertion (can_undef (destroyed_by_store Mint32 addr') e); - do e1 <- add_equations args args2' + do e1 <- add_equations args args2' (add_equation (Eq kind_second_word src (R src2')) e); do e2 <- track_moves env mv2 e1; assertion (can_undef (destroyed_by_store Mint32 addr) e2); - do e3 <- add_equations args args1' + do e3 <- add_equations args args1' (add_equation (Eq kind_first_word src (R src1')) e2); track_moves env mv1 e3 | BScall sg ros args res mv1 ros' mv2 s => @@ -1059,22 +1059,22 @@ Module LEq <: SEMILATTICE. Lemma eq_refl: forall x, eq x x. Proof. - intros; destruct x; simpl; auto. red; tauto. + intros; destruct x; simpl; auto. red; tauto. Qed. Lemma eq_sym: forall x y, eq x y -> eq y x. Proof. - unfold eq; intros; destruct x; destruct y; auto. + unfold eq; intros; destruct x; destruct y; auto. red in H; red; intros. rewrite H; tauto. - Qed. + Qed. Lemma eq_trans: forall x y z, eq x y -> eq y z -> eq x z. Proof. unfold eq; intros. destruct x; destruct y; try contradiction; destruct z; auto. - red in H; red in H0; red; intros. rewrite H. auto. + red in H; red in H0; red; intros. rewrite H. auto. Qed. - Definition beq (x y: t) := + Definition beq (x y: t) := match x, y with | OK a, OK b => EqSet.equal a b | Error _, Error _ => true @@ -1083,14 +1083,14 @@ Module LEq <: SEMILATTICE. Lemma beq_correct: forall x y, beq x y = true -> eq x y. Proof. - unfold beq, eq; intros. destruct x; destruct y. + unfold beq, eq; intros. destruct x; destruct y. apply EqSet.equal_2. auto. discriminate. discriminate. auto. Qed. - Definition ge (x y: t) := + Definition ge (x y: t) := match x, y with | OK a, OK b => EqSet.Subset b a | Error _, _ => True @@ -1099,18 +1099,18 @@ Module LEq <: SEMILATTICE. Lemma ge_refl: forall x y, eq x y -> ge x y. Proof. - unfold eq, ge, EqSet.Equal, EqSet.Subset; intros. + unfold eq, ge, EqSet.Equal, EqSet.Subset; intros. destruct x; destruct y; auto. intros; rewrite H; auto. Qed. Lemma ge_trans: forall x y z, ge x y -> ge y z -> ge x z. Proof. unfold ge, EqSet.Subset; intros. destruct x; auto; destruct y; try contradiction. - destruct z; eauto. + destruct z; eauto. Qed. Definition bot: t := OK empty_eqs. - + Lemma ge_bot: forall x, ge x bot. Proof. unfold ge, bot, EqSet.Subset; simpl; intros. @@ -1126,25 +1126,25 @@ Module LEq <: SEMILATTICE. | Error _, _ => x end. Next Obligation. - split; intros. - apply EqSet2.union_1 in H. destruct H; rewrite eqs_same in H. + split; intros. + apply EqSet2.union_1 in H. destruct H; rewrite eqs_same in H. apply EqSet.union_2; auto. apply EqSet.union_3; auto. - apply EqSet.union_1 in H. destruct H; rewrite <- eqs_same in H. + apply EqSet.union_1 in H. destruct H; rewrite <- eqs_same in H. apply EqSet2.union_2; auto. apply EqSet2.union_3; auto. Qed. Lemma ge_lub_left: forall x y, ge (lub x y) x. Proof. - unfold lub, ge, EqSet.Subset; intros. - destruct x; destruct y; auto. - intros; apply EqSet.union_2; auto. + unfold lub, ge, EqSet.Subset; intros. + destruct x; destruct y; auto. + intros; apply EqSet.union_2; auto. Qed. Lemma ge_lub_right: forall x y, ge (lub x y) y. Proof. - unfold lub, ge, EqSet.Subset; intros. - destruct x; destruct y; auto. - intros; apply EqSet.union_3; auto. + unfold lub, ge, EqSet.Subset; intros. + destruct x; destruct y; auto. + intros; apply EqSet.union_3; auto. Qed. End LEq. diff --git a/backend/Allocproof.v b/backend/Allocproof.v index 57adf102..2bcc038c 100644 --- a/backend/Allocproof.v +++ b/backend/Allocproof.v @@ -110,7 +110,7 @@ Inductive expand_block_shape: block_shape -> RTL.instruction -> LTL.bblock -> Pr (expand_moves mv1 (Lload Mint32 addr args1' dst1' :: expand_moves mv2 - (Lload Mint32 addr2 args2' dst2' :: + (Lload Mint32 addr2 args2' dst2' :: expand_moves mv3 (Lbranch s :: k)))) | ebs_load2_1: forall addr args dst mv1 args' dst' mv2 s k, wf_moves mv1 -> wf_moves mv2 -> @@ -219,7 +219,7 @@ Proof. extract_moves accu b = (mv, b') -> wf_moves accu -> wf_moves mv /\ expand_moves (List.rev accu) b = expand_moves mv b'). - induction b; simpl; intros. + induction b; simpl; intros. inv H. auto. destruct a; try (inv H; apply BASE; auto; fail). destruct (is_move_operation op args) as [arg|] eqn:E. @@ -228,30 +228,30 @@ Proof. exploit IHb; eauto. red; intros. destruct H1; auto. subst sd; exact I. intros [P Q]. - split; auto. rewrite <- Q. simpl. unfold expand_moves. rewrite map_app. + split; auto. rewrite <- Q. simpl. unfold expand_moves. rewrite map_app. rewrite app_ass. simpl. auto. inv H; apply BASE; auto. (* stack-reg move *) exploit IHb; eauto. red; intros. destruct H1; auto. subst sd; exact I. intros [P Q]. - split; auto. rewrite <- Q. simpl. unfold expand_moves. rewrite map_app. + split; auto. rewrite <- Q. simpl. unfold expand_moves. rewrite map_app. rewrite app_ass. simpl. auto. (* reg-stack move *) exploit IHb; eauto. red; intros. destruct H1; auto. subst sd; exact I. intros [P Q]. - split; auto. rewrite <- Q. simpl. unfold expand_moves. rewrite map_app. + split; auto. rewrite <- Q. simpl. unfold expand_moves. rewrite map_app. rewrite app_ass. simpl. auto. - intros. exploit IND; eauto. red; intros. elim H0. + intros. exploit IND; eauto. red; intros. elim H0. Qed. Lemma check_succ_sound: forall s b, check_succ s b = true -> exists k, b = Lbranch s :: k. Proof. - intros. destruct b; simpl in H; try discriminate. - destruct i; try discriminate. + intros. destruct b; simpl in H; try discriminate. + destruct i; try discriminate. destruct (peq s s0); simpl in H; inv H. exists b; auto. Qed. @@ -273,9 +273,9 @@ Proof. (* nop *) econstructor; eauto. (* op *) - destruct (classify_operation o l). + destruct (classify_operation o l). (* move *) - MonadInv; UseParsingLemmas. econstructor; eauto. + MonadInv; UseParsingLemmas. econstructor; eauto. (* makelong *) MonadInv; UseParsingLemmas. econstructor; eauto. (* lowlong *) @@ -285,7 +285,7 @@ Proof. (* other ops *) MonadInv. destruct b0. MonadInv; UseParsingLemmas. - destruct i; MonadInv; UseParsingLemmas. + destruct i; MonadInv; UseParsingLemmas. eapply ebs_op; eauto. inv H0. eapply ebs_op_dead; eauto. (* load *) @@ -293,8 +293,8 @@ Proof. MonadInv; UseParsingLemmas. destruct i; MonadInv; UseParsingLemmas. destruct (chunk_eq m Mint64). - MonadInv; UseParsingLemmas. - destruct b; MonadInv; UseParsingLemmas. destruct i; MonadInv; UseParsingLemmas. + MonadInv; UseParsingLemmas. + destruct b; MonadInv; UseParsingLemmas. destruct i; MonadInv; UseParsingLemmas. eapply ebs_load2; eauto. destruct (eq_addressing a addr). MonadInv. inv H2. eapply ebs_load2_1; eauto. @@ -310,10 +310,10 @@ Proof. MonadInv; UseParsingLemmas. eapply ebs_store; eauto. (* call *) - destruct b0; MonadInv. destruct i; MonadInv; UseParsingLemmas. econstructor; eauto. + destruct b0; MonadInv. destruct i; MonadInv; UseParsingLemmas. econstructor; eauto. (* tailcall *) destruct b0; MonadInv. destruct i; MonadInv; UseParsingLemmas. econstructor; eauto. -(* builtin *) +(* builtin *) destruct b1; MonadInv. destruct i; MonadInv; UseParsingLemmas. econstructor; eauto. (* cond *) @@ -331,8 +331,8 @@ Lemma matching_instr_block: exists b, (LTL.fn_code f2)!pc = Some b /\ expand_block_shape bsh i b. Proof. intros. unfold pair_codes in H. rewrite PTree.gcombine in H; auto. rewrite H0 in H. - destruct (LTL.fn_code f2)!pc as [b|]. - exists b; split; auto. apply pair_instr_block_sound; auto. + destruct (LTL.fn_code f2)!pc as [b|]. + exists b; split; auto. apply pair_instr_block_sound; auto. discriminate. Qed. @@ -367,7 +367,7 @@ Lemma satisf_incr: forall rs ls (e1 e2: eqs), satisf rs ls e2 -> EqSet.Subset e1 e2 -> satisf rs ls e1. Proof. - unfold satisf; intros. apply H. ESD.fsetdec. + unfold satisf; intros. apply H. ESD.fsetdec. Qed. Lemma satisf_undef_reg: @@ -383,14 +383,14 @@ Lemma add_equation_lessdef: forall rs ls q e, satisf rs ls (add_equation q e) -> Val.lessdef (sel_val (ekind q) rs#(ereg q)) (ls (eloc q)). Proof. - intros. apply H. unfold add_equation. simpl. apply EqSet.add_1. auto. + intros. apply H. unfold add_equation. simpl. apply EqSet.add_1. auto. Qed. Lemma add_equation_satisf: forall rs ls q e, satisf rs ls (add_equation q e) -> satisf rs ls e. Proof. - intros. eapply satisf_incr; eauto. unfold add_equation. simpl. ESD.fsetdec. + intros. eapply satisf_incr; eauto. unfold add_equation. simpl. ESD.fsetdec. Qed. Lemma add_equations_satisf: @@ -400,7 +400,7 @@ Lemma add_equations_satisf: Proof. induction rl; destruct ml; simpl; intros; MonadInv. auto. - eapply add_equation_satisf; eauto. + eapply add_equation_satisf; eauto. Qed. Lemma add_equations_lessdef: @@ -422,8 +422,8 @@ Lemma add_equations_args_satisf: satisf rs ls e' -> satisf rs ls e. Proof. intros until e'. functional induction (add_equations_args rl tyl ll e); intros. - inv H; auto. - eapply add_equation_satisf. eapply add_equation_satisf. eauto. + inv H; auto. + eapply add_equation_satisf. eapply add_equation_satisf. eauto. eapply add_equation_satisf. eauto. eapply add_equation_satisf. eauto. eapply add_equation_satisf. eauto. @@ -449,17 +449,17 @@ Lemma add_equations_args_lessdef: Proof. intros until e'. functional induction (add_equations_args rl tyl ll e); simpl; intros. - inv H; auto. -- destruct H1. constructor; auto. - rewrite <- (val_longofwords_eq (rs#r1)); auto. apply Val.longofwords_lessdef. - eapply add_equation_lessdef with (q := Eq High r1 l1). - eapply add_equation_satisf. eapply add_equations_args_satisf; eauto. - eapply add_equation_lessdef with (q := Eq Low r1 l2). +- destruct H1. constructor; auto. + rewrite <- (val_longofwords_eq (rs#r1)); auto. apply Val.longofwords_lessdef. + eapply add_equation_lessdef with (q := Eq High r1 l1). + eapply add_equation_satisf. eapply add_equations_args_satisf; eauto. + eapply add_equation_lessdef with (q := Eq Low r1 l2). eapply add_equations_args_satisf; eauto. -- destruct H1. constructor; auto. +- destruct H1. constructor; auto. eapply add_equation_lessdef with (q := Eq Full r1 l1). eapply add_equations_args_satisf; eauto. -- destruct H1. constructor; auto. +- destruct H1. constructor; auto. eapply add_equation_lessdef with (q := Eq Full r1 l1). eapply add_equations_args_satisf; eauto. -- destruct H1. constructor; auto. +- destruct H1. constructor; auto. eapply add_equation_lessdef with (q := Eq Full r1 l1). eapply add_equations_args_satisf; eauto. - discriminate. Qed. @@ -478,7 +478,7 @@ Lemma remove_equation_satisf: forall rs ls q e, satisf rs ls e -> satisf rs ls (remove_equation q e). Proof. - intros. eapply satisf_incr; eauto. unfold remove_equation; simpl. ESD.fsetdec. + intros. eapply satisf_incr; eauto. unfold remove_equation; simpl. ESD.fsetdec. Qed. Lemma remove_equation_res_satisf: @@ -486,7 +486,7 @@ Lemma remove_equation_res_satisf: remove_equations_res r oty ll e = Some e' -> satisf rs ls e -> satisf rs ls e'. Proof. - intros. functional inversion H. + intros. functional inversion H. apply remove_equation_satisf. apply remove_equation_satisf; auto. apply remove_equation_satisf; auto. Qed. @@ -498,7 +498,7 @@ Remark select_reg_l_monotone: Proof. unfold select_reg_l; intros. destruct H. red in H. congruence. - rewrite Pos.leb_le in *. red in H. destruct H as [A | [A B]]. + rewrite Pos.leb_le in *. red in H. destruct H as [A | [A B]]. red in A. zify; omega. rewrite <- A; auto. Qed. @@ -510,7 +510,7 @@ Remark select_reg_h_monotone: Proof. unfold select_reg_h; intros. destruct H. red in H. congruence. - rewrite Pos.leb_le in *. red in H. destruct H as [A | [A B]]. + rewrite Pos.leb_le in *. red in H. destruct H as [A | [A B]]. red in A. zify; omega. rewrite A; auto. Qed. @@ -520,7 +520,7 @@ Remark select_reg_charact: Proof. unfold select_reg_l, select_reg_h; intros; split. rewrite ! Pos.leb_le. unfold reg; zify; omega. - intros. rewrite H. rewrite ! Pos.leb_refl; auto. + intros. rewrite H. rewrite ! Pos.leb_refl; auto. Qed. Lemma reg_unconstrained_sound: @@ -530,7 +530,7 @@ Lemma reg_unconstrained_sound: ereg q <> r. Proof. unfold reg_unconstrained; intros. red; intros. - apply select_reg_charact in H1. + apply select_reg_charact in H1. assert (EqSet.mem_between (select_reg_l r) (select_reg_h r) e = true). { apply EqSet.mem_between_2 with q; auto. @@ -548,7 +548,7 @@ Lemma reg_unconstrained_satisf: satisf rs ls e -> satisf (rs#r <- v) ls e. Proof. - red; intros. rewrite PMap.gso. auto. eapply reg_unconstrained_sound; eauto. + red; intros. rewrite PMap.gso. auto. eapply reg_unconstrained_sound; eauto. Qed. Remark select_loc_l_monotone: @@ -558,13 +558,13 @@ Remark select_loc_l_monotone: Proof. unfold select_loc_l; intros. set (lb := OrderedLoc.diff_low_bound l) in *. destruct H. - red in H. subst q2; auto. + red in H. subst q2; auto. assert (eloc q1 = eloc q2 \/ OrderedLoc.lt (eloc q1) (eloc q2)). - red in H. tauto. - destruct H1. rewrite <- H1; auto. - destruct (OrderedLoc.compare (eloc q2) lb); auto. - assert (OrderedLoc.lt (eloc q1) lb) by (eapply OrderedLoc.lt_trans; eauto). - destruct (OrderedLoc.compare (eloc q1) lb). + red in H. tauto. + destruct H1. rewrite <- H1; auto. + destruct (OrderedLoc.compare (eloc q2) lb); auto. + assert (OrderedLoc.lt (eloc q1) lb) by (eapply OrderedLoc.lt_trans; eauto). + destruct (OrderedLoc.compare (eloc q1) lb). auto. eelim OrderedLoc.lt_not_eq; eauto. eelim OrderedLoc.lt_not_eq. eapply OrderedLoc.lt_trans. eexact l1. eexact H2. red; auto. @@ -577,13 +577,13 @@ Remark select_loc_h_monotone: Proof. unfold select_loc_h; intros. set (lb := OrderedLoc.diff_high_bound l) in *. destruct H. - red in H. subst q2; auto. + red in H. subst q2; auto. assert (eloc q2 = eloc q1 \/ OrderedLoc.lt (eloc q2) (eloc q1)). - red in H. tauto. - destruct H1. rewrite H1; auto. - destruct (OrderedLoc.compare (eloc q2) lb); auto. - assert (OrderedLoc.lt lb (eloc q1)) by (eapply OrderedLoc.lt_trans; eauto). - destruct (OrderedLoc.compare (eloc q1) lb). + red in H. tauto. + destruct H1. rewrite H1; auto. + destruct (OrderedLoc.compare (eloc q2) lb); auto. + assert (OrderedLoc.lt lb (eloc q1)) by (eapply OrderedLoc.lt_trans; eauto). + destruct (OrderedLoc.compare (eloc q1) lb). eelim OrderedLoc.lt_not_eq. eapply OrderedLoc.lt_trans. eexact l1. eexact H2. red; auto. eelim OrderedLoc.lt_not_eq. eexact H2. apply OrderedLoc.eq_sym; auto. auto. @@ -594,19 +594,19 @@ Remark select_loc_charact: select_loc_l l q = false \/ select_loc_h l q = false <-> Loc.diff l (eloc q). Proof. unfold select_loc_l, select_loc_h; intros; split; intros. - apply OrderedLoc.outside_interval_diff. + apply OrderedLoc.outside_interval_diff. destruct H. left. destruct (OrderedLoc.compare (eloc q) (OrderedLoc.diff_low_bound l)); assumption || discriminate. right. destruct (OrderedLoc.compare (eloc q) (OrderedLoc.diff_high_bound l)); assumption || discriminate. - exploit OrderedLoc.diff_outside_interval. eauto. + exploit OrderedLoc.diff_outside_interval. eauto. intros [A | A]. left. destruct (OrderedLoc.compare (eloc q) (OrderedLoc.diff_low_bound l)). auto. - eelim OrderedLoc.lt_not_eq; eauto. + eelim OrderedLoc.lt_not_eq; eauto. eelim OrderedLoc.lt_not_eq. eapply OrderedLoc.lt_trans; eauto. red; auto. right. destruct (OrderedLoc.compare (eloc q) (OrderedLoc.diff_high_bound l)). eelim OrderedLoc.lt_not_eq. eapply OrderedLoc.lt_trans; eauto. red; auto. - eelim OrderedLoc.lt_not_eq; eauto. apply OrderedLoc.eq_sym; auto. + eelim OrderedLoc.lt_not_eq; eauto. apply OrderedLoc.eq_sym; auto. auto. Qed. @@ -616,7 +616,7 @@ Lemma loc_unconstrained_sound: EqSet.In q e -> Loc.diff l (eloc q). Proof. - unfold loc_unconstrained; intros. + unfold loc_unconstrained; intros. destruct (select_loc_l l q) eqn:SL. destruct (select_loc_h l q) eqn:SH. assert (EqSet2.mem_between (select_loc_l l) (select_loc_h l) (eqs2 e) = true). @@ -624,7 +624,7 @@ Proof. apply EqSet2.mem_between_2 with q; auto. exact (select_loc_l_monotone l). exact (select_loc_h_monotone l). - apply eqs_same. auto. + apply eqs_same. auto. } rewrite H1 in H; discriminate. apply select_loc_charact; auto. @@ -639,12 +639,12 @@ Lemma loc_unconstrained_satisf: Val.lessdef (sel_val k rs#r) v -> satisf rs (Locmap.set l v ls) e. Proof. - intros; red; intros. - destruct (OrderedEquation.eq_dec q (Eq k r l)). + intros; red; intros. + destruct (OrderedEquation.eq_dec q (Eq k r l)). subst q; simpl. unfold l; rewrite Locmap.gss. auto. assert (EqSet.In q (remove_equation (Eq k r l) e)). - simpl. ESD.fsetdec. - rewrite Locmap.gso. apply H; auto. eapply loc_unconstrained_sound; eauto. + simpl. ESD.fsetdec. + rewrite Locmap.gso. apply H; auto. eapply loc_unconstrained_sound; eauto. Qed. Lemma reg_loc_unconstrained_sound: @@ -653,7 +653,7 @@ Lemma reg_loc_unconstrained_sound: EqSet.In q e -> ereg q <> r /\ Loc.diff l (eloc q). Proof. - intros. destruct (andb_prop _ _ H). + intros. destruct (andb_prop _ _ H). split. eapply reg_unconstrained_sound; eauto. eapply loc_unconstrained_sound; eauto. Qed. @@ -671,7 +671,7 @@ Proof. assert (EqSet.In q (remove_equation {| ekind := k; ereg := r; eloc := l |} e)). simpl. ESD.fsetdec. exploit reg_loc_unconstrained_sound; eauto. intros [A B]. - rewrite Regmap.gso; auto. rewrite Locmap.gso; auto. + rewrite Regmap.gso; auto. rewrite Locmap.gso; auto. Qed. Lemma parallel_assignment_satisf_2: @@ -689,20 +689,20 @@ Proof. { unfold res'; intros. exploit list_in_map_inv; eauto. intros [mr [A B]]. exists mr; auto. } functional inversion H. - (* Two 32-bit halves *) - subst. + subst. set (e' := remove_equation {| ekind := Low; ereg := res; eloc := l2 |} (remove_equation {| ekind := High; ereg := res; eloc := l1 |} e)) in *. rewrite <- H5 in H2. simpl in H2. InvBooleans. simpl. destruct (OrderedEquation.eq_dec q (Eq Low res l2)). subst q; simpl. rewrite Regmap.gss. destruct (ISREG l2) as [r2 EQ]. rewrite <- H5; auto with coqlib. rewrite EQ. rewrite Locmap.gss. - apply Val.loword_lessdef; auto. + apply Val.loword_lessdef; auto. destruct (OrderedEquation.eq_dec q (Eq High res l1)). subst q; simpl. rewrite Regmap.gss. rewrite Locmap.gso by auto. destruct (ISREG l1) as [r1 EQ]. rewrite <- H5; auto with coqlib. rewrite EQ. rewrite Locmap.gss. apply Val.hiword_lessdef; auto. - assert (EqSet.In q e'). unfold e', remove_equation; simpl; ESD.fsetdec. - rewrite Regmap.gso. rewrite ! Locmap.gso. auto. + assert (EqSet.In q e'). unfold e', remove_equation; simpl; ESD.fsetdec. + rewrite Regmap.gso. rewrite ! Locmap.gso. auto. eapply loc_unconstrained_sound; eauto. eapply loc_unconstrained_sound; eauto. eapply reg_unconstrained_sound; eauto. @@ -710,11 +710,11 @@ Proof. subst. rewrite <- H5 in H2. simpl in H2. InvBooleans. replace (encode_long oty v') with (v' :: nil). set (e' := remove_equation {| ekind := Full; ereg := res; eloc := l1 |} e) in *. - destruct (OrderedEquation.eq_dec q (Eq Full res l1)). + destruct (OrderedEquation.eq_dec q (Eq Full res l1)). subst q; simpl. rewrite Regmap.gss. destruct (ISREG l1) as [r1 EQ]. rewrite <- H5; auto with coqlib. rewrite EQ. rewrite Locmap.gss. auto. - assert (EqSet.In q e'). unfold e', remove_equation; simpl. ESD.fsetdec. + assert (EqSet.In q e'). unfold e', remove_equation; simpl. ESD.fsetdec. simpl. rewrite Regmap.gso. rewrite Locmap.gso. auto. eapply loc_unconstrained_sound; eauto. eapply reg_unconstrained_sound; eauto. @@ -733,7 +733,7 @@ Proof. assert (IN_ELT: forall q, EqSet.In q elt <-> EqSet.In q e0 /\ ereg q = r1). { intros. unfold elt. rewrite EqSet.elements_between_iff. - rewrite select_reg_charact. tauto. + rewrite select_reg_charact. tauto. exact (select_reg_l_monotone r1). exact (select_reg_h_monotone r1). } @@ -744,11 +744,11 @@ Proof. { apply ESP.fold_rec; unfold P; intros. - ESD.fsetdec. - - simpl. red in H1. apply H1 in H3. destruct H3. - + subst x. ESD.fsetdec. - + rewrite ESF.add_iff. rewrite ESF.remove_iff. + - simpl. red in H1. apply H1 in H3. destruct H3. + + subst x. ESD.fsetdec. + + rewrite ESF.add_iff. rewrite ESF.remove_iff. destruct (OrderedEquation.eq_dec x {| ekind := ekind q; ereg := r2; eloc := eloc q |}); auto. - left. subst x; auto. + left. subst x; auto. } set (Q := fun e1 e2 => ~EqSet.In q e1 -> @@ -759,11 +759,11 @@ Proof. - auto. - simpl. red in H2. rewrite H2 in H4. rewrite ESF.add_iff. rewrite ESF.remove_iff. - right. split. apply H3. tauto. tauto. + right. split. apply H3. tauto. tauto. } destruct (ESP.In_dec q elt). left. split. apply IN_ELT. auto. apply H. auto. - right. split. red; intros. elim n. rewrite IN_ELT. auto. apply H0. auto. + right. split. red; intros. elim n. rewrite IN_ELT. auto. apply H0. auto. Qed. Lemma subst_reg_satisf: @@ -792,7 +792,7 @@ Proof. assert (IN_ELT: forall q, EqSet.In q elt <-> EqSet.In q e0 /\ ereg q = r1). { intros. unfold elt. rewrite EqSet.elements_between_iff. - rewrite select_reg_charact. tauto. + rewrite select_reg_charact. tauto. exact (select_reg_l_monotone r1). exact (select_reg_h_monotone r1). } @@ -803,14 +803,14 @@ Proof. { intros; apply ESP.fold_rec; unfold P; intros. - ESD.fsetdec. - - simpl. red in H1. apply H1 in H3. destruct H3. + - simpl. red in H1. apply H1 in H3. destruct H3. + subst x. unfold f. destruct (IndexedEqKind.eq (ekind q) k1). simpl. ESD.fsetdec. contradiction. + unfold f. destruct (IndexedEqKind.eq (ekind x) k1). - simpl. rewrite ESF.add_iff. rewrite ESF.remove_iff. + simpl. rewrite ESF.add_iff. rewrite ESF.remove_iff. destruct (OrderedEquation.eq_dec x {| ekind := k2; ereg := r2; eloc := eloc q |}); auto. left. subst x; auto. - auto. + auto. } set (Q := fun e1 e2 => ~EqSet.In q e1 \/ ekind q <> k1 -> @@ -822,8 +822,8 @@ Proof. - unfold f. red in H2. rewrite H2 in H4. destruct (IndexedEqKind.eq (ekind x) k1). simpl. rewrite ESF.add_iff. rewrite ESF.remove_iff. - right. split. apply H3. tauto. intuition congruence. - apply H3. intuition. + right. split. apply H3. tauto. intuition congruence. + apply H3. intuition. } destruct (ESP.In_dec q elt). destruct (IndexedEqKind.eq (ekind q) k1). @@ -845,17 +845,17 @@ Proof. destruct (in_subst_reg_kind dst Low src2 Full _ e1 B) as [[C D] | D]; fold e2 in D. simpl in C; simpl in D. inv C. inversion A. rewrite H3; rewrite H4. rewrite Regmap.gss. - apply Val.lessdef_trans with (rs#src1). - simpl. destruct (rs#src1); simpl; auto. destruct (rs#src2); simpl; auto. + apply Val.lessdef_trans with (rs#src1). + simpl. destruct (rs#src1); simpl; auto. destruct (rs#src2); simpl; auto. rewrite Int64.hi_ofwords. auto. - exploit H0. eexact D. simpl. auto. + exploit H0. eexact D. simpl. auto. destruct (in_subst_reg_kind dst Low src2 Full q e1 B) as [[C D] | D]; fold e2 in D. - inversion C. rewrite H3; rewrite H4. rewrite Regmap.gss. - apply Val.lessdef_trans with (rs#src2). - simpl. destruct (rs#src1); simpl; auto. destruct (rs#src2); simpl; auto. + inversion C. rewrite H3; rewrite H4. rewrite Regmap.gss. + apply Val.lessdef_trans with (rs#src2). + simpl. destruct (rs#src1); simpl; auto. destruct (rs#src2); simpl; auto. rewrite Int64.lo_ofwords. auto. exploit H0. eexact D. simpl. auto. - rewrite Regmap.gso. apply H0; auto. eapply reg_unconstrained_sound; eauto. + rewrite Regmap.gso. apply H0; auto. eapply reg_unconstrained_sound; eauto. Qed. Lemma subst_reg_kind_satisf_lowlong: @@ -867,8 +867,8 @@ Lemma subst_reg_kind_satisf_lowlong: Proof. intros; red; intros. destruct (in_subst_reg_kind dst Full src Low q e H1) as [[A B] | B]; fold e1 in B. - inversion A. rewrite H3; rewrite H4. simpl. rewrite Regmap.gss. - exploit H0. eexact B. simpl. auto. + inversion A. rewrite H3; rewrite H4. simpl. rewrite Regmap.gss. + exploit H0. eexact B. simpl. auto. rewrite Regmap.gso. apply H0; auto. eapply reg_unconstrained_sound; eauto. Qed. @@ -881,8 +881,8 @@ Lemma subst_reg_kind_satisf_highlong: Proof. intros; red; intros. destruct (in_subst_reg_kind dst Full src High q e H1) as [[A B] | B]; fold e1 in B. - inversion A. rewrite H3; rewrite H4. simpl. rewrite Regmap.gss. - exploit H0. eexact B. simpl. auto. + inversion A. rewrite H3; rewrite H4. simpl. rewrite Regmap.gss. + exploit H0. eexact B. simpl. auto. rewrite Regmap.gso. apply H0; auto. eapply reg_unconstrained_sound; eauto. Qed. @@ -897,7 +897,7 @@ Lemma in_subst_loc: (eloc q = l1 /\ EqSet.In (Eq (ekind q) (ereg q) l2) e') \/ (Loc.diff l1 (eloc q) /\ EqSet.In q e'). Proof. intros l1 l2 q e0 e0'. - unfold subst_loc. + unfold subst_loc. set (f := fun (q0 : EqSet2.elt) (opte : option eqs) => match opte with | Some e => @@ -921,17 +921,17 @@ Proof. assert (P elt (EqSet2.fold f elt (Some e0))). { apply ESP2.fold_rec; unfold P; intros. - - ESD2.fsetdec. - - destruct a as [e2|]; simpl; auto. + - ESD2.fsetdec. + - destruct a as [e2|]; simpl; auto. destruct (Loc.eq l1 (eloc x)); auto. unfold add_equation, remove_equation; simpl. - red in H1. rewrite H1. intros [A|A]. + red in H1. rewrite H1. intros [A|A]. + subst x. split. auto. ESD.fsetdec. + exploit H2; eauto. intros [B C]. split. auto. - rewrite ESF.add_iff. rewrite ESF.remove_iff. + rewrite ESF.add_iff. rewrite ESF.remove_iff. destruct (OrderedEquation.eq_dec x {| ekind := ekind q; ereg := ereg q; eloc := l2 |}). - left. rewrite e1; auto. - right; auto. + left. rewrite e1; auto. + right; auto. } set (Q := fun e1 (opte: option eqs) => match opte with @@ -941,25 +941,25 @@ Proof. assert (Q elt (EqSet2.fold f elt (Some e0))). { apply ESP2.fold_rec; unfold Q; intros. - - auto. - - destruct a as [e2|]; simpl; auto. - destruct (Loc.eq l1 (eloc x)); auto. - red in H2. rewrite H2; intros. + - auto. + - destruct a as [e2|]; simpl; auto. + destruct (Loc.eq l1 (eloc x)); auto. + red in H2. rewrite H2; intros. unfold add_equation, remove_equation; simpl. rewrite ESF.add_iff. rewrite ESF.remove_iff. right; split. apply H3. tauto. tauto. } - rewrite SUBST in H; rewrite SUBST in H0; simpl in *. - destruct (ESP2.In_dec q elt). + rewrite SUBST in H; rewrite SUBST in H0; simpl in *. + destruct (ESP2.In_dec q elt). left. apply H; auto. - right. split; auto. + right. split; auto. rewrite <- select_loc_charact. destruct (select_loc_l l1 q) eqn: LL; auto. destruct (select_loc_h l1 q) eqn: LH; auto. - elim n. eapply EqSet2.elements_between_iff. + elim n. eapply EqSet2.elements_between_iff. exact (select_loc_l_monotone l1). exact (select_loc_h_monotone l1). - split. apply eqs_same; auto. auto. + split. apply eqs_same; auto. auto. Qed. Lemma loc_type_compat_charact: @@ -968,12 +968,12 @@ Lemma loc_type_compat_charact: EqSet.In q e -> subtype (sel_type (ekind q) (env (ereg q))) (Loc.type l) = true \/ Loc.diff l (eloc q). Proof. - unfold loc_type_compat; intros. + unfold loc_type_compat; intros. rewrite EqSet2.for_all_between_iff in H. destruct (select_loc_l l q) eqn: LL. destruct (select_loc_h l q) eqn: LH. - left; apply H; auto. apply eqs_same; auto. - right. apply select_loc_charact. auto. + left; apply H; auto. apply eqs_same; auto. + right. apply select_loc_charact. auto. right. apply select_loc_charact. auto. intros; subst; auto. exact (select_loc_l_monotone l). @@ -990,11 +990,11 @@ Lemma well_typed_move_charact: | S sl ofs ty => Val.has_type (sel_val k rs#r) ty end. Proof. - unfold well_typed_move; intros. - destruct l as [mr | sl ofs ty]. + unfold well_typed_move; intros. + destruct l as [mr | sl ofs ty]. auto. exploit loc_type_compat_charact; eauto. intros [A | A]. - simpl in A. eapply Val.has_subtype; eauto. + simpl in A. eapply Val.has_subtype; eauto. generalize (H1 r). destruct k; simpl; intros. auto. destruct (rs#r); exact I. @@ -1007,7 +1007,7 @@ Remark val_lessdef_normalize: Val.has_type v ty -> Val.lessdef v v' -> Val.lessdef v (Val.load_result (chunk_of_type ty) v'). Proof. - intros. inv H0. rewrite Val.load_result_same; auto. auto. + intros. inv H0. rewrite Val.load_result_same; auto. auto. Qed. Lemma subst_loc_satisf: @@ -1024,8 +1024,8 @@ Proof. destruct q as [k r l]; simpl in *. exploit well_typed_move_charact; eauto. destruct l as [mr | sl ofs ty]; intros. - apply (H2 _ B). - apply val_lessdef_normalize; auto. apply (H2 _ B). + apply (H2 _ B). + apply val_lessdef_normalize; auto. apply (H2 _ B). rewrite Locmap.gso; auto. Qed. @@ -1036,7 +1036,7 @@ Proof. induction ml; simpl; intros. tauto. InvBooleans. split. - apply Loc.diff_sym. eapply loc_unconstrained_sound; eauto. + apply Loc.diff_sym. eapply loc_unconstrained_sound; eauto. eauto. Qed. @@ -1045,7 +1045,7 @@ Lemma undef_regs_outside: Loc.notin l (map R ml) -> undef_regs ml ls l = ls l. Proof. induction ml; simpl; intros. auto. - rewrite Locmap.gso. apply IHml. tauto. apply Loc.diff_sym. tauto. + rewrite Locmap.gso. apply IHml. tauto. apply Loc.diff_sym. tauto. Qed. Lemma can_undef_satisf: @@ -1065,9 +1065,9 @@ Proof. induction ml; simpl; intros. tauto. InvBooleans. split. - destruct (orb_true_elim _ _ H2). + destruct (orb_true_elim _ _ H2). apply proj_sumbool_true in e0. congruence. - apply Loc.diff_sym. eapply loc_unconstrained_sound; eauto. + apply Loc.diff_sym. eapply loc_unconstrained_sound; eauto. eapply IHml; eauto. Qed. @@ -1086,9 +1086,9 @@ Proof. destruct q as [k r l]; simpl in *. exploit well_typed_move_charact; eauto. destruct l as [mr | sl ofs ty]; intros. - apply (H3 _ B). - apply val_lessdef_normalize; auto. apply (H3 _ B). - rewrite Locmap.gso; auto. rewrite undef_regs_outside. eauto. + apply (H3 _ B). + apply val_lessdef_normalize; auto. apply (H3 _ B). + rewrite Locmap.gso; auto. rewrite undef_regs_outside. eauto. eapply can_undef_except_sound; eauto. apply Loc.diff_sym; auto. Qed. @@ -1100,11 +1100,11 @@ Lemma transfer_use_def_satisf: (forall v v', Val.lessdef v v' -> satisf (rs#res <- v) (Locmap.set (R res') v' (undef_regs und ls)) e). Proof. - unfold transfer_use_def; intros. MonadInv. + unfold transfer_use_def; intros. MonadInv. split. eapply add_equations_lessdef; eauto. - intros. eapply parallel_assignment_satisf; eauto. assumption. - eapply can_undef_satisf; eauto. - eapply add_equations_satisf; eauto. + intros. eapply parallel_assignment_satisf; eauto. assumption. + eapply can_undef_satisf; eauto. + eapply add_equations_satisf; eauto. Qed. Lemma add_equations_res_lessdef: @@ -1114,9 +1114,9 @@ Lemma add_equations_res_lessdef: Val.lessdef_list (encode_long oty rs#r) (map ls ll). Proof. intros. functional inversion H. -- subst. simpl. constructor. +- subst. simpl. constructor. eapply add_equation_lessdef with (q := Eq High r l1). - eapply add_equation_satisf. eauto. + eapply add_equation_satisf. eauto. constructor. eapply add_equation_lessdef with (q := Eq Low r l2). eauto. constructor. @@ -1138,10 +1138,10 @@ Lemma return_regs_agree_callee_save: forall caller callee, agree_callee_save caller (return_regs caller callee). Proof. - intros; red; intros. unfold return_regs. red in H. + intros; red; intros. unfold return_regs. red in H. destruct l. - rewrite pred_dec_false; auto. - destruct sl; auto || congruence. + rewrite pred_dec_false; auto. + destruct sl; auto || congruence. Qed. Lemma no_caller_saves_sound: @@ -1153,7 +1153,7 @@ Proof. unfold no_caller_saves, callee_save_loc; intros. exploit EqSet.for_all_2; eauto. hnf. intros. simpl in H1. rewrite H1. auto. - lazy beta. destruct (eloc q). + lazy beta. destruct (eloc q). intros; red; intros. destruct (orb_true_elim _ _ H1); InvBooleans. eapply int_callee_save_not_destroyed; eauto. apply index_int_callee_save_pos2. omega. @@ -1175,8 +1175,8 @@ Lemma function_return_satisf: Proof. intros; red; intros. functional inversion H0. -- subst. rewrite <- H11 in *. unfold encode_long in H4. rewrite <- H7 in H4. - simpl in H4. inv H4. inv H14. +- subst. rewrite <- H11 in *. unfold encode_long in H4. rewrite <- H7 in H4. + simpl in H4. inv H4. inv H14. set (e' := remove_equation {| ekind := Low; ereg := res; eloc := l2 |} (remove_equation {| ekind := High; ereg := res; eloc := l1 |} e)) in *. simpl in H2. InvBooleans. @@ -1184,20 +1184,20 @@ Proof. subst q; simpl. rewrite Regmap.gss. auto. destruct (OrderedEquation.eq_dec q (Eq High res l1)). subst q; simpl. rewrite Regmap.gss. auto. - assert (EqSet.In q e'). unfold e', remove_equation; simpl; ESD.fsetdec. + assert (EqSet.In q e'). unfold e', remove_equation; simpl; ESD.fsetdec. exploit reg_loc_unconstrained_sound. eexact H. eauto. intros [A B]. exploit reg_loc_unconstrained_sound. eexact H2. eauto. intros [C D]. rewrite Regmap.gso; auto. exploit no_caller_saves_sound; eauto. intros. - red in H5. rewrite <- H5; auto. + red in H5. rewrite <- H5; auto. - subst. rewrite <- H11 in *. replace (encode_long (sig_res sg) v) with (v :: nil) in H4. simpl in H4. inv H4. simpl in H2. InvBooleans. set (e' := remove_equation {| ekind := Full; ereg := res; eloc := l1 |} e) in *. - destruct (OrderedEquation.eq_dec q (Eq Full res l1)). - subst q; simpl. rewrite Regmap.gss; auto. - assert (EqSet.In q e'). unfold e', remove_equation; simpl. ESD.fsetdec. + destruct (OrderedEquation.eq_dec q (Eq Full res l1)). + subst q; simpl. rewrite Regmap.gss; auto. + assert (EqSet.In q e'). unfold e', remove_equation; simpl. ESD.fsetdec. exploit reg_loc_unconstrained_sound; eauto. intros [A B]. rewrite Regmap.gso; auto. exploit no_caller_saves_sound; eauto. intros. @@ -1210,11 +1210,11 @@ Lemma compat_left_sound: compat_left r l e = true -> EqSet.In q e -> ereg q = r -> ekind q = Full /\ eloc q = l. Proof. unfold compat_left; intros. - rewrite EqSet.for_all_between_iff in H. - apply select_reg_charact in H1. destruct H1. - exploit H; eauto. intros. - destruct (ekind q); try discriminate. - destruct (Loc.eq l (eloc q)); try discriminate. + rewrite EqSet.for_all_between_iff in H. + apply select_reg_charact in H1. destruct H1. + exploit H; eauto. intros. + destruct (ekind q); try discriminate. + destruct (Loc.eq l (eloc q)); try discriminate. auto. intros. subst x2. auto. exact (select_reg_l_monotone r). @@ -1227,10 +1227,10 @@ Lemma compat_left2_sound: (ekind q = High /\ eloc q = l1) \/ (ekind q = Low /\ eloc q = l2). Proof. unfold compat_left2; intros. - rewrite EqSet.for_all_between_iff in H. - apply select_reg_charact in H1. destruct H1. - exploit H; eauto. intros. - destruct (ekind q); try discriminate. + rewrite EqSet.for_all_between_iff in H. + apply select_reg_charact in H1. destruct H1. + exploit H; eauto. intros. + destruct (ekind q); try discriminate. InvBooleans. auto. InvBooleans. auto. intros. subst x2. auto. @@ -1259,12 +1259,12 @@ Lemma compat_entry_satisf: Val.lessdef_list vl (decode_longs tyl (map ls ll)) -> satisf (init_regs vl rl) ls e. Proof. - intros until e. functional induction (compat_entry rl tyl ll e); intros. + intros until e. functional induction (compat_entry rl tyl ll e); intros. - (* no params *) simpl. red; intros. rewrite Regmap.gi. destruct (ekind q); simpl; auto. - (* a param of type Tlong *) InvBooleans. simpl in H0. inv H0. simpl. - red; intros. rewrite Regmap.gsspec. destruct (peq (ereg q) r1). + red; intros. rewrite Regmap.gsspec. destruct (peq (ereg q) r1). exploit compat_left2_sound; eauto. intros [[A B] | [A B]]; rewrite A; rewrite B; simpl. apply Val.lessdef_trans with (Val.hiword (Val.longofwords (ls l1) (ls l2))). @@ -1274,17 +1274,17 @@ Proof. eapply IHb; eauto. - (* a param of type Tint *) InvBooleans. simpl in H0. inv H0. simpl. - red; intros. rewrite Regmap.gsspec. destruct (peq (ereg q) r1). + red; intros. rewrite Regmap.gsspec. destruct (peq (ereg q) r1). exploit compat_left_sound; eauto. intros [A B]. rewrite A; rewrite B; auto. eapply IHb; eauto. - (* a param of type Tfloat *) InvBooleans. simpl in H0. inv H0. simpl. - red; intros. rewrite Regmap.gsspec. destruct (peq (ereg q) r1). + red; intros. rewrite Regmap.gsspec. destruct (peq (ereg q) r1). exploit compat_left_sound; eauto. intros [A B]. rewrite A; rewrite B; auto. eapply IHb; eauto. - (* a param of type Tsingle *) InvBooleans. simpl in H0. inv H0. simpl. - red; intros. rewrite Regmap.gsspec. destruct (peq (ereg q) r1). + red; intros. rewrite Regmap.gsspec. destruct (peq (ereg q) r1). exploit compat_left_sound; eauto. intros [A B]. rewrite A; rewrite B; auto. eapply IHb; eauto. - (* error case *) @@ -1295,10 +1295,10 @@ Lemma call_regs_param_values: forall sg ls, map (call_regs ls) (loc_parameters sg) = map ls (loc_arguments sg). Proof. - intros. unfold loc_parameters. rewrite list_map_compose. + intros. unfold loc_parameters. rewrite list_map_compose. apply list_map_exten; intros. unfold call_regs, parameter_of_argument. - exploit loc_arguments_acceptable; eauto. unfold loc_argument_acceptable. - destruct x; auto. destruct sl; tauto. + exploit loc_arguments_acceptable; eauto. unfold loc_argument_acceptable. + destruct x; auto. destruct sl; tauto. Qed. Lemma return_regs_arg_values: @@ -1306,12 +1306,12 @@ Lemma return_regs_arg_values: tailcall_is_possible sg = true -> map (return_regs ls1 ls2) (loc_arguments sg) = map ls2 (loc_arguments sg). Proof. - intros. apply list_map_exten; intros. + intros. apply list_map_exten; intros. exploit loc_arguments_acceptable; eauto. - exploit tailcall_is_possible_correct; eauto. + exploit tailcall_is_possible_correct; eauto. unfold loc_argument_acceptable, return_regs. destruct x; intros. - rewrite pred_dec_true; auto. + rewrite pred_dec_true; auto. contradiction. Qed. @@ -1320,7 +1320,7 @@ Lemma find_function_tailcall: ros_compatible_tailcall ros = true -> find_function tge ros (return_regs ls1 ls2) = find_function tge ros ls2. Proof. - unfold ros_compatible_tailcall, find_function; intros. + unfold ros_compatible_tailcall, find_function; intros. destruct ros as [r|id]; auto. unfold return_regs. destruct (in_dec mreg_eq r destroyed_at_call); simpl in H. auto. congruence. @@ -1336,9 +1336,9 @@ Lemma loadv_int64_split: /\ Val.lessdef (Val.loword v) v2. Proof. intros. exploit Mem.loadv_int64_split; eauto. intros (v1 & v2 & A & B & C). - exists v1, v2. split; auto. split; auto. - inv C; auto. destruct v1, v2; simpl; auto. - rewrite Int64.hi_ofwords, Int64.lo_ofwords; auto. + exists v1, v2. split; auto. split; auto. + inv C; auto. destruct v1, v2; simpl; auto. + rewrite Int64.hi_ofwords, Int64.lo_ofwords; auto. Qed. Lemma add_equations_builtin_arg_satisf: @@ -1363,12 +1363,12 @@ Proof. induction 1; simpl; intros e e' arg' AE SAT WT; destruct arg'; MonadInv. - exploit add_equation_lessdef; eauto. simpl; intros. exists (ls x0); auto with barg. -- destruct arg'1; MonadInv. destruct arg'2; MonadInv. +- destruct arg'1; MonadInv. destruct arg'2; MonadInv. exploit add_equation_lessdef. eauto. simpl; intros LD1. exploit add_equation_lessdef. eapply add_equation_satisf. eauto. simpl; intros LD2. - exists (Val.longofwords (ls x0) (ls x1)); split; auto with barg. + exists (Val.longofwords (ls x0) (ls x1)); split; auto with barg. rewrite <- (val_longofwords_eq rs#x). apply Val.longofwords_lessdef; auto. - rewrite <- e0; apply WT. + rewrite <- e0; apply WT. - econstructor; eauto with barg. - econstructor; eauto with barg. - econstructor; eauto with barg. @@ -1377,7 +1377,7 @@ Proof. - econstructor; eauto with barg. - econstructor; eauto with barg. - econstructor; eauto with barg. -- exploit IHeval_builtin_arg1; eauto. eapply add_equations_builtin_arg_satisf; eauto. +- exploit IHeval_builtin_arg1; eauto. eapply add_equations_builtin_arg_satisf; eauto. intros (v1 & A & B). exploit IHeval_builtin_arg2; eauto. intros (v2 & C & D). exists (Val.longofwords v1 v2); split; auto with barg. apply Val.longofwords_lessdef; auto. @@ -1404,10 +1404,10 @@ Proof. induction 1; simpl; intros; destruct arg'; MonadInv. - exists (@nil val); split; constructor. - exploit IHlist_forall2; eauto. intros (vl' & A & B). - exploit add_equations_builtin_arg_lessdef; eauto. + exploit add_equations_builtin_arg_lessdef; eauto. eapply add_equations_builtin_args_satisf; eauto. intros (v1' & C & D). exploit (@eval_builtin_arg_lessdef _ ge ls ls); eauto. intros (v1'' & E & F). - exists (v1'' :: vl'); split; constructor; auto. eapply Val.lessdef_trans; eauto. + exists (v1'' :: vl'); split; constructor; auto. eapply Val.lessdef_trans; eauto. Qed. Lemma add_equations_debug_args_satisf: @@ -1435,7 +1435,7 @@ Proof. - exists (@nil val); constructor. - destruct (add_equations_builtin_arg env a1 b e) as [e1|] eqn:A. + exploit IHlist_forall2; eauto. intros (vl' & B). - exploit add_equations_builtin_arg_lessdef; eauto. + exploit add_equations_builtin_arg_lessdef; eauto. eapply add_equations_debug_args_satisf; eauto. intros (v1' & C & D). exploit (@eval_builtin_arg_lessdef _ ge ls ls); eauto. intros (v1'' & E & F). exists (v1'' :: vl'); constructor; auto. @@ -1460,7 +1460,7 @@ Lemma add_equations_builtin_eval: /\ Val.lessdef vres vres' /\ Mem.extends m2 m2'. Proof. - intros. + intros. assert (DEFAULT: add_equations_builtin_args env args args' e1 = Some e2 -> satisf rs ls e1 /\ exists vargs' vres' m2', @@ -1469,19 +1469,19 @@ Proof. /\ Val.lessdef vres vres' /\ Mem.extends m2 m2'). { - intros. split. eapply add_equations_builtin_args_satisf; eauto. + intros. split. eapply add_equations_builtin_args_satisf; eauto. exploit add_equations_builtin_args_lessdef; eauto. intros (vargs' & A & B). exploit external_call_mem_extends; eauto. intros (vres' & m2' & C & D & E & F). exists vargs', vres', m2'; auto. } - destruct ef; auto. - split. eapply add_equations_debug_args_satisf; eauto. + destruct ef; auto. + split. eapply add_equations_debug_args_satisf; eauto. exploit add_equations_debug_args_eval; eauto. intros (vargs' & A). simpl in H4; inv H4. - exists vargs', Vundef, m1'. intuition auto. simpl. constructor. + exists vargs', Vundef, m1'. intuition auto. simpl. constructor. Qed. Lemma parallel_set_builtin_res_satisf: @@ -1501,7 +1501,7 @@ Proof. rename x0 into hi; rename x1 into lo. MonadInv. destruct (mreg_eq hi lo); inv H5. set (e' := remove_equation {| ekind := High; ereg := x; eloc := R hi |} e0) in *. set (e'' := remove_equation {| ekind := Low; ereg := x; eloc := R lo |} e') in *. - simpl in *. red; intros. + simpl in *. red; intros. destruct (OrderedEquation.eq_dec q (Eq Low x (R lo))). subst q; simpl. rewrite Regmap.gss. rewrite Locmap.gss. apply Val.loword_lessdef; auto. destruct (OrderedEquation.eq_dec q (Eq High x (R hi))). @@ -1509,7 +1509,7 @@ Proof. rewrite Locmap.gss. apply Val.hiword_lessdef; auto. assert (EqSet.In q e''). { unfold e'', e', remove_equation; simpl; ESD.fsetdec. } - rewrite Regmap.gso. rewrite ! Locmap.gso. auto. + rewrite Regmap.gso. rewrite ! Locmap.gso. auto. eapply loc_unconstrained_sound; eauto. eapply loc_unconstrained_sound; eauto. eapply reg_unconstrained_sound; eauto. @@ -1528,7 +1528,7 @@ Lemma analyze_successors: Proof. unfold analyze; intros. exploit DS.fixpoint_allnodes_solution; eauto. rewrite H2. unfold DS.L.ge. destruct (transfer f env bsh s an#s); intros. - exists e0; auto. + exists e0; auto. contradiction. Qed. @@ -1541,14 +1541,14 @@ Lemma satisf_successors: satisf rs ls e -> exists e', transfer f env bsh s an!!s = OK e' /\ satisf rs ls e'. Proof. - intros. exploit analyze_successors; eauto. intros [e' [A B]]. + intros. exploit analyze_successors; eauto. intros [e' [A B]]. exists e'; split; auto. eapply satisf_incr; eauto. Qed. (** Inversion on [transf_function] *) Inductive transf_function_spec (f: RTL.function) (tf: LTL.function) : Prop := - | transf_function_spec_intro: + | transf_function_spec_intro: forall env an mv k e1 e2, wt_function f env -> analyze f env (pair_codes f tf) = Some an -> @@ -1571,14 +1571,14 @@ Proof. destruct (type_function f) as [env|] eqn:TY; try discriminate. destruct (regalloc f); try discriminate. destruct (check_function f f0 env) as [] eqn:?; inv H. - unfold check_function in Heqr. + unfold check_function in Heqr. destruct (analyze f env (pair_codes f tf)) as [an|] eqn:?; try discriminate. - monadInv Heqr. + monadInv Heqr. destruct (check_entrypoints_aux f tf env x) as [y|] eqn:?; try discriminate. unfold check_entrypoints_aux, pair_entrypoints in Heqo0. MonadInv. exploit extract_moves_sound; eauto. intros [A B]. subst b. exploit check_succ_sound; eauto. intros [k EQ1]. subst b0. - econstructor; eauto. eapply type_function_correct; eauto. congruence. + econstructor; eauto. eapply type_function_correct; eauto. congruence. Qed. Lemma invert_code: @@ -1587,7 +1587,7 @@ Lemma invert_code: (RTL.fn_code f)!pc = Some i -> transfer f env (pair_codes f tf) pc opte = OK e -> exists eafter, exists bsh, exists bb, - opte = OK eafter /\ + opte = OK eafter /\ (pair_codes f tf)!pc = Some bsh /\ (LTL.fn_code tf)!pc = Some bb /\ expand_block_shape bsh i bb /\ @@ -1595,11 +1595,11 @@ Lemma invert_code: wt_instr f env i. Proof. intros. destruct opte as [eafter|]; simpl in H1; try discriminate. exists eafter. - destruct (pair_codes f tf)!pc as [bsh|] eqn:?; try discriminate. exists bsh. + destruct (pair_codes f tf)!pc as [bsh|] eqn:?; try discriminate. exists bsh. exploit matching_instr_block; eauto. intros [bb [A B]]. - destruct (transfer_aux f env bsh eafter) as [e1|] eqn:?; inv H1. + destruct (transfer_aux f env bsh eafter) as [e1|] eqn:?; inv H1. exists bb. exploit wt_instr_at; eauto. - tauto. + tauto. Qed. (** * Semantic preservation *) @@ -1676,7 +1676,7 @@ Proof. eapply functions_translated; eauto. rewrite <- H2 in H. simpl in H. congruence. (* two symbols *) - rewrite symbols_preserved. rewrite Heqo. + rewrite symbols_preserved. rewrite Heqo. eapply function_ptr_translated; eauto. Qed. @@ -1696,22 +1696,22 @@ Opaque destroyed_by_op. (* base *) - unfold expand_moves; simpl. inv H. exists ls; split. apply star_refl. auto. (* step *) -- destruct a as [src dst]. unfold expand_moves. simpl. +- destruct a as [src dst]. unfold expand_moves. simpl. destruct (track_moves env mv e) as [e1|] eqn:?; MonadInv. - assert (wf_moves mv). red; intros. apply H0; auto with coqlib. + assert (wf_moves mv). red; intros. apply H0; auto with coqlib. destruct src as [rsrc | ssrc]; destruct dst as [rdst | sdst]. (* reg-reg *) -+ exploit IHmv; eauto. eapply subst_loc_undef_satisf; eauto. - intros [ls' [A B]]. exists ls'; split; auto. eapply star_left; eauto. ++ exploit IHmv; eauto. eapply subst_loc_undef_satisf; eauto. + intros [ls' [A B]]. exists ls'; split; auto. eapply star_left; eauto. econstructor. simpl. eauto. auto. auto. (* reg->stack *) -+ exploit IHmv; eauto. eapply subst_loc_undef_satisf; eauto. - intros [ls' [A B]]. exists ls'; split; auto. eapply star_left; eauto. ++ exploit IHmv; eauto. eapply subst_loc_undef_satisf; eauto. + intros [ls' [A B]]. exists ls'; split; auto. eapply star_left; eauto. econstructor. simpl. eauto. auto. (* stack->reg *) -+ simpl in Heqb. exploit IHmv; eauto. eapply subst_loc_undef_satisf; eauto. - intros [ls' [A B]]. exists ls'; split; auto. eapply star_left; eauto. - econstructor. auto. auto. ++ simpl in Heqb. exploit IHmv; eauto. eapply subst_loc_undef_satisf; eauto. + intros [ls' [A B]]. exists ls'; split; auto. eapply star_left; eauto. + econstructor. auto. auto. (* stack->stack *) + exploit H0; auto with coqlib. unfold wf_move. tauto. Qed. @@ -1783,17 +1783,17 @@ Lemma match_stackframes_change_sig: sg'.(sig_res) = sg.(sig_res) -> match_stackframes s ts sg'. Proof. - intros. inv H. + intros. inv H. constructor. congruence. econstructor; eauto. - unfold proj_sig_res in *. rewrite H0; auto. - intros. unfold loc_result in H; rewrite H0 in H; eauto. + unfold proj_sig_res in *. rewrite H0; auto. + intros. unfold loc_result in H; rewrite H0 in H; eauto. Qed. Ltac UseShape := match goal with | [ WT: wt_function _ _, CODE: (RTL.fn_code _)!_ = Some _, EQ: transfer _ _ _ _ _ = OK _ |- _ ] => - destruct (invert_code _ _ _ _ _ _ _ WT CODE EQ) as (eafter & bsh & bb & AFTER & BSH & TCODE & EBS & TR & WTI); + destruct (invert_code _ _ _ _ _ _ _ WT CODE EQ) as (eafter & bsh & bb & AFTER & BSH & TCODE & EBS & TR & WTI); inv EBS; unfold transfer_aux in TR; MonadInv end. @@ -1802,7 +1802,7 @@ Remark addressing_not_long: wt_instr f env (Iload Mint64 addr args dst s) -> In r args -> r <> dst. Proof. - intros. + intros. assert (forall ty, In ty (type_of_addressing addr) -> ty = Tint). { intros. destruct addr; simpl in H1; intuition. } inv H. @@ -1810,9 +1810,9 @@ Proof. { generalize args (type_of_addressing addr) H0 H1 H5. induction args0; simpl; intros. contradiction. - destruct l. discriminate. inv H4. - destruct H2. subst a. apply H3; auto with coqlib. - eauto with coqlib. + destruct l. discriminate. inv H4. + destruct H2. subst a. apply H3; auto with coqlib. + eauto with coqlib. } red; intros; subst r. rewrite H in H8; discriminate. Qed. @@ -1828,108 +1828,108 @@ Proof. induction 1; intros WT S1' MS; inv MS; try UseShape. (* nop *) - exploit exec_moves; eauto. intros [ls1 [X Y]]. + exploit exec_moves; eauto. intros [ls1 [X Y]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_right. eexact X. econstructor; eauto. + eapply plus_left. econstructor; eauto. + eapply star_right. eexact X. econstructor; eauto. eauto. traceEq. - exploit satisf_successors; eauto. simpl; eauto. intros [enext [U V]]. - econstructor; eauto. + exploit satisf_successors; eauto. simpl; eauto. intros [enext [U V]]. + econstructor; eauto. (* op move *) - generalize (wt_exec_Iop _ _ _ _ _ _ _ _ _ _ _ WTI H0 WTRS). intros WTRS'. - simpl in H0. inv H0. - exploit (exec_moves mv); eauto. intros [ls1 [X Y]]. + simpl in H0. inv H0. + exploit (exec_moves mv); eauto. intros [ls1 [X Y]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_right. eexact X. econstructor; eauto. + eapply plus_left. econstructor; eauto. + eapply star_right. eexact X. econstructor; eauto. eauto. traceEq. - exploit satisf_successors; eauto. simpl; eauto. eapply subst_reg_satisf; eauto. - intros [enext [U V]]. + exploit satisf_successors; eauto. simpl; eauto. eapply subst_reg_satisf; eauto. + intros [enext [U V]]. econstructor; eauto. (* op makelong *) - generalize (wt_exec_Iop _ _ _ _ _ _ _ _ _ _ _ WTI H0 WTRS). intros WTRS'. - simpl in H0. inv H0. - exploit (exec_moves mv); eauto. intros [ls1 [X Y]]. + simpl in H0. inv H0. + exploit (exec_moves mv); eauto. intros [ls1 [X Y]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_right. eexact X. econstructor; eauto. + eapply plus_left. econstructor; eauto. + eapply star_right. eexact X. econstructor; eauto. eauto. traceEq. exploit satisf_successors; eauto. simpl; eauto. - eapply subst_reg_kind_satisf_makelong. eauto. eauto. - intros [enext [U V]]. + eapply subst_reg_kind_satisf_makelong. eauto. eauto. + intros [enext [U V]]. econstructor; eauto. (* op lowlong *) - generalize (wt_exec_Iop _ _ _ _ _ _ _ _ _ _ _ WTI H0 WTRS). intros WTRS'. - simpl in H0. inv H0. - exploit (exec_moves mv); eauto. intros [ls1 [X Y]]. + simpl in H0. inv H0. + exploit (exec_moves mv); eauto. intros [ls1 [X Y]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_right. eexact X. econstructor; eauto. + eapply plus_left. econstructor; eauto. + eapply star_right. eexact X. econstructor; eauto. eauto. traceEq. exploit satisf_successors; eauto. simpl; eauto. - eapply subst_reg_kind_satisf_lowlong. eauto. eauto. - intros [enext [U V]]. + eapply subst_reg_kind_satisf_lowlong. eauto. eauto. + intros [enext [U V]]. econstructor; eauto. (* op highlong *) - generalize (wt_exec_Iop _ _ _ _ _ _ _ _ _ _ _ WTI H0 WTRS). intros WTRS'. - simpl in H0. inv H0. - exploit (exec_moves mv); eauto. intros [ls1 [X Y]]. + simpl in H0. inv H0. + exploit (exec_moves mv); eauto. intros [ls1 [X Y]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_right. eexact X. econstructor; eauto. + eapply plus_left. econstructor; eauto. + eapply star_right. eexact X. econstructor; eauto. eauto. traceEq. exploit satisf_successors; eauto. simpl; eauto. - eapply subst_reg_kind_satisf_highlong. eauto. eauto. - intros [enext [U V]]. + eapply subst_reg_kind_satisf_highlong. eauto. eauto. + intros [enext [U V]]. econstructor; eauto. (* op regular *) - generalize (wt_exec_Iop _ _ _ _ _ _ _ _ _ _ _ WTI H0 WTRS). intros WTRS'. - exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. + exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. exploit transfer_use_def_satisf; eauto. intros [X Y]. - exploit eval_operation_lessdef; eauto. intros [v' [F G]]. + exploit eval_operation_lessdef; eauto. intros [v' [F G]]. exploit (exec_moves mv2); eauto. intros [ls2 [A2 B2]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_trans. eexact A1. - eapply star_left. econstructor. instantiate (1 := v'). rewrite <- F. + eapply plus_left. econstructor; eauto. + eapply star_trans. eexact A1. + eapply star_left. econstructor. instantiate (1 := v'). rewrite <- F. apply eval_operation_preserved. exact symbols_preserved. - eauto. eapply star_right. eexact A2. constructor. + eauto. eapply star_right. eexact A2. constructor. eauto. eauto. eauto. traceEq. - exploit satisf_successors; eauto. simpl; eauto. intros [enext [U V]]. + exploit satisf_successors; eauto. simpl; eauto. intros [enext [U V]]. econstructor; eauto. (* op dead *) -- exploit exec_moves; eauto. intros [ls1 [X Y]]. +- exploit exec_moves; eauto. intros [ls1 [X Y]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_right. eexact X. econstructor; eauto. + eapply plus_left. econstructor; eauto. + eapply star_right. eexact X. econstructor; eauto. eauto. traceEq. - exploit satisf_successors. eauto. eauto. simpl; eauto. eauto. - eapply reg_unconstrained_satisf; eauto. - intros [enext [U V]]. + exploit satisf_successors. eauto. eauto. simpl; eauto. eauto. + eapply reg_unconstrained_satisf; eauto. + intros [enext [U V]]. econstructor; eauto. - eapply wt_exec_Iop; eauto. + eapply wt_exec_Iop; eauto. (* load regular *) - generalize (wt_exec_Iload _ _ _ _ _ _ _ _ _ _ _ WTI H1 WTRS). intros WTRS'. - exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. + exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. exploit transfer_use_def_satisf; eauto. intros [X Y]. exploit eval_addressing_lessdef; eauto. intros [a' [F G]]. - exploit Mem.loadv_extends; eauto. intros [v' [P Q]]. + exploit Mem.loadv_extends; eauto. intros [v' [P Q]]. exploit (exec_moves mv2); eauto. intros [ls2 [A2 B2]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_trans. eexact A1. - eapply star_left. econstructor. instantiate (1 := a'). rewrite <- F. + eapply plus_left. econstructor; eauto. + eapply star_trans. eexact A1. + eapply star_left. econstructor. instantiate (1 := a'). rewrite <- F. apply eval_addressing_preserved. exact symbols_preserved. eauto. eauto. - eapply star_right. eexact A2. constructor. + eapply star_right. eexact A2. constructor. eauto. eauto. eauto. traceEq. - exploit satisf_successors; eauto. simpl; eauto. intros [enext [U V]]. + exploit satisf_successors; eauto. simpl; eauto. intros [enext [U V]]. econstructor; eauto. (* load pair *) @@ -1937,49 +1937,49 @@ Proof. exploit loadv_int64_split; eauto. intros (v1 & v2 & LOAD1 & LOAD2 & V1 & V2). set (v2' := if Archi.big_endian then v2 else v1) in *. set (v1' := if Archi.big_endian then v1 else v2) in *. - exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. + exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. assert (LD1: Val.lessdef_list rs##args (reglist ls1 args1')). { eapply add_equations_lessdef; eauto. } exploit eval_addressing_lessdef. eexact LD1. eauto. intros [a1' [F1 G1]]. exploit Mem.loadv_extends. eauto. eexact LOAD1. eexact G1. intros (v1'' & LOAD1' & LD2). set (ls2 := Locmap.set (R dst1') v1'' (undef_regs (destroyed_by_load Mint32 addr) ls1)). assert (SAT2: satisf (rs#dst <- v) ls2 e2). - { eapply loc_unconstrained_satisf. eapply can_undef_satisf; eauto. - eapply reg_unconstrained_satisf. eauto. + { eapply loc_unconstrained_satisf. eapply can_undef_satisf; eauto. + eapply reg_unconstrained_satisf. eauto. eapply add_equations_satisf; eauto. assumption. - rewrite Regmap.gss. apply Val.lessdef_trans with v1'; auto. + rewrite Regmap.gss. apply Val.lessdef_trans with v1'; auto. } - exploit (exec_moves mv2); eauto. intros [ls3 [A3 B3]]. + exploit (exec_moves mv2); eauto. intros [ls3 [A3 B3]]. assert (LD3: Val.lessdef_list rs##args (reglist ls3 args2')). - { replace (rs##args) with ((rs#dst<-v)##args). - eapply add_equations_lessdef; eauto. + { replace (rs##args) with ((rs#dst<-v)##args). + eapply add_equations_lessdef; eauto. apply list_map_exten; intros. rewrite Regmap.gso; auto. - eapply addressing_not_long; eauto. + eapply addressing_not_long; eauto. } exploit eval_addressing_lessdef. eexact LD3. eapply eval_offset_addressing; eauto. intros [a2' [F2 G2]]. exploit Mem.loadv_extends. eauto. eexact LOAD2. eexact G2. intros (v2'' & LOAD2' & LD4). set (ls4 := Locmap.set (R dst2') v2'' (undef_regs (destroyed_by_load Mint32 addr2) ls3)). assert (SAT4: satisf (rs#dst <- v) ls4 e0). - { eapply loc_unconstrained_satisf. eapply can_undef_satisf; eauto. + { eapply loc_unconstrained_satisf. eapply can_undef_satisf; eauto. eapply add_equations_satisf; eauto. assumption. rewrite Regmap.gss. apply Val.lessdef_trans with v2'; auto. } exploit (exec_moves mv3); eauto. intros [ls5 [A5 B5]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_trans. eexact A1. - eapply star_left. econstructor. + eapply plus_left. econstructor; eauto. + eapply star_trans. eexact A1. + eapply star_left. econstructor. instantiate (1 := a1'). rewrite <- F1. apply eval_addressing_preserved. exact symbols_preserved. - eexact LOAD1'. instantiate (1 := ls2); auto. + eexact LOAD1'. instantiate (1 := ls2); auto. eapply star_trans. eexact A3. eapply star_left. econstructor. instantiate (1 := a2'). rewrite <- F2. apply eval_addressing_preserved. exact symbols_preserved. eexact LOAD2'. instantiate (1 := ls4); auto. eapply star_right. eexact A5. - constructor. + constructor. eauto. eauto. eauto. eauto. eauto. traceEq. - exploit satisf_successors; eauto. simpl; eauto. intros [enext [W Z]]. + exploit satisf_successors; eauto. simpl; eauto. intros [enext [W Z]]. econstructor; eauto. (* load first word of a pair *) @@ -1987,7 +1987,7 @@ Proof. exploit loadv_int64_split; eauto. intros (v1 & v2 & LOAD1 & LOAD2 & V1 & V2). set (v2' := if Archi.big_endian then v2 else v1) in *. set (v1' := if Archi.big_endian then v1 else v2) in *. - exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. + exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. assert (LD1: Val.lessdef_list rs##args (reglist ls1 args')). { eapply add_equations_lessdef; eauto. } exploit eval_addressing_lessdef. eexact LD1. eauto. intros [a1' [F1 G1]]. @@ -1995,20 +1995,20 @@ Proof. set (ls2 := Locmap.set (R dst') v1'' (undef_regs (destroyed_by_load Mint32 addr) ls1)). assert (SAT2: satisf (rs#dst <- v) ls2 e0). { eapply parallel_assignment_satisf; eauto. - apply Val.lessdef_trans with v1'; auto. + apply Val.lessdef_trans with v1'; auto. eapply can_undef_satisf. eauto. eapply add_equations_satisf; eauto. } - exploit (exec_moves mv2); eauto. intros [ls3 [A3 B3]]. + exploit (exec_moves mv2); eauto. intros [ls3 [A3 B3]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_trans. eexact A1. - eapply star_left. econstructor. + eapply plus_left. econstructor; eauto. + eapply star_trans. eexact A1. + eapply star_left. econstructor. instantiate (1 := a1'). rewrite <- F1. apply eval_addressing_preserved. exact symbols_preserved. - eexact LOAD1'. instantiate (1 := ls2); auto. + eexact LOAD1'. instantiate (1 := ls2); auto. eapply star_right. eexact A3. - constructor. + constructor. eauto. eauto. eauto. traceEq. - exploit satisf_successors; eauto. simpl; eauto. intros [enext [W Z]]. + exploit satisf_successors; eauto. simpl; eauto. intros [enext [W Z]]. econstructor; eauto. (* load second word of a pair *) @@ -2016,7 +2016,7 @@ Proof. exploit loadv_int64_split; eauto. intros (v1 & v2 & LOAD1 & LOAD2 & V1 & V2). set (v2' := if Archi.big_endian then v2 else v1) in *. set (v1' := if Archi.big_endian then v1 else v2) in *. - exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. + exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. assert (LD1: Val.lessdef_list rs##args (reglist ls1 args')). { eapply add_equations_lessdef; eauto. } exploit eval_addressing_lessdef. eexact LD1. @@ -2025,51 +2025,51 @@ Proof. set (ls2 := Locmap.set (R dst') v2'' (undef_regs (destroyed_by_load Mint32 addr2) ls1)). assert (SAT2: satisf (rs#dst <- v) ls2 e0). { eapply parallel_assignment_satisf; eauto. - apply Val.lessdef_trans with v2'; auto. + apply Val.lessdef_trans with v2'; auto. eapply can_undef_satisf. eauto. eapply add_equations_satisf; eauto. } - exploit (exec_moves mv2); eauto. intros [ls3 [A3 B3]]. + exploit (exec_moves mv2); eauto. intros [ls3 [A3 B3]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_trans. eexact A1. - eapply star_left. econstructor. + eapply plus_left. econstructor; eauto. + eapply star_trans. eexact A1. + eapply star_left. econstructor. instantiate (1 := a1'). rewrite <- F1. apply eval_addressing_preserved. exact symbols_preserved. - eexact LOAD2'. instantiate (1 := ls2); auto. + eexact LOAD2'. instantiate (1 := ls2); auto. eapply star_right. eexact A3. - constructor. + constructor. eauto. eauto. eauto. traceEq. - exploit satisf_successors; eauto. simpl; eauto. intros [enext [W Z]]. + exploit satisf_successors; eauto. simpl; eauto. intros [enext [W Z]]. econstructor; eauto. (* load dead *) -- exploit exec_moves; eauto. intros [ls1 [X Y]]. +- exploit exec_moves; eauto. intros [ls1 [X Y]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_right. eexact X. econstructor; eauto. + eapply plus_left. econstructor; eauto. + eapply star_right. eexact X. econstructor; eauto. eauto. traceEq. - exploit satisf_successors. eauto. eauto. simpl; eauto. eauto. - eapply reg_unconstrained_satisf; eauto. - intros [enext [U V]]. + exploit satisf_successors. eauto. eauto. simpl; eauto. eauto. + eapply reg_unconstrained_satisf; eauto. + intros [enext [U V]]. econstructor; eauto. eapply wt_exec_Iload; eauto. (* store *) - exploit exec_moves; eauto. intros [ls1 [X Y]]. - exploit add_equations_lessdef; eauto. intros LD. simpl in LD. inv LD. + exploit add_equations_lessdef; eauto. intros LD. simpl in LD. inv LD. exploit eval_addressing_lessdef; eauto. intros [a' [F G]]. exploit Mem.storev_extends; eauto. intros [m'' [P Q]]. econstructor; split. - eapply plus_left. econstructor; eauto. + eapply plus_left. econstructor; eauto. eapply star_trans. eexact X. - eapply star_two. econstructor. instantiate (1 := a'). rewrite <- F. + eapply star_two. econstructor. instantiate (1 := a'). rewrite <- F. apply eval_addressing_preserved. exact symbols_preserved. eauto. eauto. constructor. eauto. eauto. traceEq. exploit satisf_successors; eauto. simpl; eauto. - eapply can_undef_satisf; eauto. eapply add_equations_satisf; eauto. intros [enext [U V]]. + eapply can_undef_satisf; eauto. eapply add_equations_satisf; eauto. intros [enext [U V]]. econstructor; eauto. (* store 2 *) -- exploit Mem.storev_int64_split; eauto. +- exploit Mem.storev_int64_split; eauto. replace (if Archi.big_endian then Val.hiword rs#src else Val.loword rs#src) with (sel_val kind_first_word rs#src) by (unfold kind_first_word; destruct Archi.big_endian; reflexivity). @@ -2079,16 +2079,16 @@ Proof. intros [m1 [STORE1 STORE2]]. exploit (exec_moves mv1); eauto. intros [ls1 [X Y]]. exploit add_equations_lessdef. eexact Heqo1. eexact Y. intros LD1. - exploit add_equation_lessdef. eapply add_equations_satisf. eexact Heqo1. eexact Y. + exploit add_equation_lessdef. eapply add_equations_satisf. eexact Heqo1. eexact Y. simpl. intros LD2. set (ls2 := undef_regs (destroyed_by_store Mint32 addr) ls1). assert (SAT2: satisf rs ls2 e1). - eapply can_undef_satisf. eauto. + eapply can_undef_satisf. eauto. eapply add_equation_satisf. eapply add_equations_satisf; eauto. exploit eval_addressing_lessdef. eexact LD1. eauto. intros [a1' [F1 G1]]. assert (F1': eval_addressing tge sp addr (reglist ls1 args1') = Some a1'). rewrite <- F1. apply eval_addressing_preserved. exact symbols_preserved. - exploit Mem.storev_extends. eauto. eexact STORE1. eexact G1. eauto. + exploit Mem.storev_extends. eauto. eexact STORE1. eexact G1. eauto. intros [m1' [STORE1' EXT1]]. exploit (exec_moves mv2); eauto. intros [ls3 [U V]]. exploit add_equations_lessdef. eexact Heqo. eexact V. intros LD3. @@ -2098,67 +2098,67 @@ Proof. assert (F2': eval_addressing tge sp addr (reglist ls3 args2') = Some a2'). rewrite <- F2. apply eval_addressing_preserved. exact symbols_preserved. exploit eval_offset_addressing. eauto. eexact F2'. intros F2''. - exploit Mem.storev_extends. eexact EXT1. eexact STORE2. - apply Val.add_lessdef. eexact G2. eauto. eauto. + exploit Mem.storev_extends. eexact EXT1. eexact STORE2. + apply Val.add_lessdef. eexact G2. eauto. eauto. intros [m2' [STORE2' EXT2]]. econstructor; split. - eapply plus_left. econstructor; eauto. + eapply plus_left. econstructor; eauto. eapply star_trans. eexact X. - eapply star_left. + eapply star_left. econstructor. eexact F1'. eexact STORE1'. instantiate (1 := ls2). auto. eapply star_trans. eexact U. eapply star_two. - econstructor. eexact F2''. eexact STORE2'. eauto. + econstructor. eexact F2''. eexact STORE2'. eauto. constructor. eauto. eauto. eauto. eauto. traceEq. exploit satisf_successors; eauto. simpl; eauto. eapply can_undef_satisf. eauto. eapply add_equation_satisf. eapply add_equations_satisf; eauto. - intros [enext [P Q]]. + intros [enext [P Q]]. econstructor; eauto. (* call *) - set (sg := RTL.funsig fd) in *. set (args' := loc_arguments sg) in *. set (res' := map R (loc_result sg)) in *. - exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. - exploit find_function_translated. eauto. eauto. eapply add_equations_args_satisf; eauto. + exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. + exploit find_function_translated. eauto. eauto. eapply add_equations_args_satisf; eauto. intros [tfd [E F]]. assert (SIG: funsig tfd = sg). eapply sig_function_translated; eauto. econstructor; split. - eapply plus_left. econstructor; eauto. + eapply plus_left. econstructor; eauto. eapply star_right. eexact A1. econstructor; eauto. eauto. traceEq. exploit analyze_successors; eauto. simpl. left; eauto. intros [enext [U V]]. econstructor; eauto. econstructor; eauto. inv WTI. congruence. - intros. exploit (exec_moves mv2). eauto. eauto. + intros. exploit (exec_moves mv2). eauto. eauto. eapply function_return_satisf with (v := v) (ls_before := ls1) (ls_after := ls0); eauto. - eapply add_equation_ros_satisf; eauto. - eapply add_equations_args_satisf; eauto. + eapply add_equation_ros_satisf; eauto. + eapply add_equations_args_satisf; eauto. congruence. - apply wt_regset_assign; auto. + apply wt_regset_assign; auto. intros [ls2 [A2 B2]]. - exists ls2; split. + exists ls2; split. eapply star_right. eexact A2. constructor. traceEq. - apply satisf_incr with eafter; auto. + apply satisf_incr with eafter; auto. rewrite SIG. eapply add_equations_args_lessdef; eauto. - inv WTI. rewrite <- H7. apply wt_regset_list; auto. - simpl. red; auto. - inv WTI. rewrite SIG. rewrite <- H7. apply wt_regset_list; auto. + inv WTI. rewrite <- H7. apply wt_regset_list; auto. + simpl. red; auto. + inv WTI. rewrite SIG. rewrite <- H7. apply wt_regset_list; auto. (* tailcall *) - set (sg := RTL.funsig fd) in *. set (args' := loc_arguments sg) in *. - exploit Mem.free_parallel_extends; eauto. intros [m'' [P Q]]. - exploit (exec_moves mv); eauto. intros [ls1 [A1 B1]]. - exploit find_function_translated. eauto. eauto. eapply add_equations_args_satisf; eauto. + exploit Mem.free_parallel_extends; eauto. intros [m'' [P Q]]. + exploit (exec_moves mv); eauto. intros [ls1 [A1 B1]]. + exploit find_function_translated. eauto. eauto. eapply add_equations_args_satisf; eauto. intros [tfd [E F]]. assert (SIG: funsig tfd = sg). eapply sig_function_translated; eauto. econstructor; split. - eapply plus_left. econstructor; eauto. + eapply plus_left. econstructor; eauto. eapply star_right. eexact A1. econstructor; eauto. - rewrite <- E. apply find_function_tailcall; auto. + rewrite <- E. apply find_function_tailcall; auto. replace (fn_stacksize tf) with (RTL.fn_stacksize f); eauto. destruct (transf_function_inv _ _ FUN); auto. eauto. traceEq. @@ -2166,71 +2166,71 @@ Proof. eapply match_stackframes_change_sig; eauto. rewrite SIG. rewrite e0. decEq. destruct (transf_function_inv _ _ FUN); auto. rewrite SIG. rewrite return_regs_arg_values; auto. eapply add_equations_args_lessdef; eauto. - inv WTI. rewrite <- H6. apply wt_regset_list; auto. + inv WTI. rewrite <- H6. apply wt_regset_list; auto. apply return_regs_agree_callee_save. - rewrite SIG. inv WTI. rewrite <- H6. apply wt_regset_list; auto. + rewrite SIG. inv WTI. rewrite <- H6. apply wt_regset_list; auto. (* builtin *) - exploit (exec_moves mv1); eauto. intros [ls1 [A1 B1]]. - exploit add_equations_builtin_eval; eauto. + exploit add_equations_builtin_eval; eauto. intros (C & vargs' & vres' & m'' & D & E & F & G). assert (WTRS': wt_regset env (regmap_setres res vres rs)) by (eapply wt_exec_Ibuiltin; eauto). set (ls2 := Locmap.setres res' vres' (undef_regs (destroyed_by_builtin ef) ls1)). assert (satisf (regmap_setres res vres rs) ls2 e0). - { eapply parallel_set_builtin_res_satisf; eauto. + { eapply parallel_set_builtin_res_satisf; eauto. eapply can_undef_satisf; eauto. } exploit (exec_moves mv2); eauto. intros [ls3 [A3 B3]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_trans. eexact A1. + eapply plus_left. econstructor; eauto. + eapply star_trans. eexact A1. eapply star_left. econstructor. eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. - eapply external_call_symbols_preserved. eauto. + eapply external_call_symbols_preserved. eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. - instantiate (1 := ls2); auto. + instantiate (1 := ls2); auto. eapply star_right. eexact A3. - econstructor. - reflexivity. reflexivity. reflexivity. traceEq. + econstructor. + reflexivity. reflexivity. reflexivity. traceEq. exploit satisf_successors; eauto. simpl; eauto. - intros [enext [U V]]. + intros [enext [U V]]. econstructor; eauto. (* cond *) - exploit (exec_moves mv); eauto. intros [ls1 [A1 B1]]. econstructor; split. - eapply plus_left. econstructor; eauto. + eapply plus_left. econstructor; eauto. eapply star_right. eexact A1. - econstructor. eapply eval_condition_lessdef; eauto. eapply add_equations_lessdef; eauto. - eauto. eauto. eauto. traceEq. + econstructor. eapply eval_condition_lessdef; eauto. eapply add_equations_lessdef; eauto. + eauto. eauto. eauto. traceEq. exploit satisf_successors; eauto. instantiate (1 := if b then ifso else ifnot). simpl. destruct b; auto. eapply can_undef_satisf. eauto. eapply add_equations_satisf; eauto. - intros [enext [U V]]. + intros [enext [U V]]. econstructor; eauto. (* jumptable *) - exploit (exec_moves mv); eauto. intros [ls1 [A1 B1]]. assert (Val.lessdef (Vint n) (ls1 (R arg'))). rewrite <- H0. eapply add_equation_lessdef with (q := Eq Full arg (R arg')); eauto. - inv H2. + inv H2. econstructor; split. - eapply plus_left. econstructor; eauto. + eapply plus_left. econstructor; eauto. eapply star_right. eexact A1. - econstructor. eauto. eauto. eauto. eauto. traceEq. + econstructor. eauto. eauto. eauto. eauto. traceEq. exploit satisf_successors; eauto. - instantiate (1 := pc'). simpl. eapply list_nth_z_in; eauto. + instantiate (1 := pc'). simpl. eapply list_nth_z_in; eauto. eapply can_undef_satisf. eauto. eapply add_equation_satisf; eauto. - intros [enext [U V]]. + intros [enext [U V]]. econstructor; eauto. (* return *) -- destruct (transf_function_inv _ _ FUN). +- destruct (transf_function_inv _ _ FUN). exploit Mem.free_parallel_extends; eauto. rewrite H10. intros [m'' [P Q]]. inv WTI; MonadInv. + (* without an argument *) exploit (exec_moves mv); eauto. intros [ls1 [A1 B1]]. econstructor; split. - eapply plus_left. econstructor; eauto. + eapply plus_left. econstructor; eauto. eapply star_right. eexact A1. econstructor. eauto. eauto. traceEq. simpl. econstructor; eauto. @@ -2240,7 +2240,7 @@ Proof. + (* with an argument *) exploit (exec_moves mv); eauto. intros [ls1 [A1 B1]]. econstructor; split. - eapply plus_left. econstructor; eauto. + eapply plus_left. econstructor; eauto. eapply star_right. eexact A1. econstructor. eauto. eauto. traceEq. simpl. econstructor; eauto. rewrite <- H11. @@ -2250,25 +2250,25 @@ Proof. rewrite !list_map_compose. apply list_map_exten; intros. unfold return_regs. apply pred_dec_true. eapply loc_result_caller_save; eauto. apply return_regs_agree_callee_save. - unfold proj_sig_res. rewrite <- H11; rewrite H13. apply WTRS. + unfold proj_sig_res. rewrite <- H11; rewrite H13. apply WTRS. (* internal function *) - monadInv FUN. simpl in *. - destruct (transf_function_inv _ _ EQ). - exploit Mem.alloc_extends; eauto. apply Zle_refl. rewrite H8; apply Zle_refl. + destruct (transf_function_inv _ _ EQ). + exploit Mem.alloc_extends; eauto. apply Zle_refl. rewrite H8; apply Zle_refl. intros [m'' [U V]]. assert (WTRS: wt_regset env (init_regs args (fn_params f))). { apply wt_init_regs. inv H0. rewrite wt_params. rewrite H9. auto. } exploit (exec_moves mv). eauto. eauto. - eapply can_undef_satisf; eauto. eapply compat_entry_satisf; eauto. + eapply can_undef_satisf; eauto. eapply compat_entry_satisf; eauto. rewrite call_regs_param_values. rewrite H9. eexact ARGS. exact WTRS. intros [ls1 [A B]]. econstructor; split. - eapply plus_left. econstructor; eauto. - eapply star_left. econstructor; eauto. - eapply star_right. eexact A. - econstructor; eauto. + eapply plus_left. econstructor; eauto. + eapply star_left. econstructor; eauto. + eapply star_right. eexact A. + econstructor; eauto. eauto. eauto. traceEq. econstructor; eauto. @@ -2276,9 +2276,9 @@ Proof. - exploit external_call_mem_extends; eauto. intros [v' [m'' [F [G [J K]]]]]. simpl in FUN; inv FUN. econstructor; split. - apply plus_one. econstructor; eauto. - eapply external_call_symbols_preserved' with (ge1 := ge). - econstructor; eauto. + apply plus_one. econstructor; eauto. + eapply external_call_symbols_preserved' with (ge1 := ge). + econstructor; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. econstructor; eauto. simpl. replace (map @@ -2290,11 +2290,11 @@ Proof. unfold encode_long, loc_result. destruct (sig_res (ef_sig ef)) as [[]|]; simpl; symmetry; f_equal; auto. red; intros. rewrite Locmap.gsetlisto. apply AG; auto. - apply Loc.notin_iff. intros. - exploit list_in_map_inv; eauto. intros [r [A B]]; subst l'. + apply Loc.notin_iff. intros. + exploit list_in_map_inv; eauto. intros [r [A B]]; subst l'. destruct l; simpl; auto. red; intros; subst r0; elim H0. eapply loc_result_caller_save; eauto. - simpl. eapply external_call_well_typed; eauto. + simpl. eapply external_call_well_typed; eauto. (* return *) - inv STACKS. @@ -2314,12 +2314,12 @@ Proof. exploit sig_function_translated; eauto. intros SIG. exists (LTL.Callstate nil tf (Locmap.init Vundef) m0); split. econstructor; eauto. - eapply Genv.init_mem_transf_partial; eauto. - rewrite symbols_preserved. + eapply Genv.init_mem_transf_partial; eauto. + rewrite symbols_preserved. rewrite (transform_partial_program_main _ _ TRANSF). auto. congruence. constructor; auto. - constructor. rewrite SIG; rewrite H3; auto. + constructor. rewrite SIG; rewrite H3; auto. rewrite SIG; rewrite H3; simpl; auto. red; auto. apply Mem.extends_refl. @@ -2327,18 +2327,18 @@ Proof. Qed. Lemma final_states_simulation: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> RTL.final_state st1 r -> LTL.final_state st2 r. Proof. intros. inv H0. inv H. inv STACKS. - econstructor. simpl; reflexivity. - unfold loc_result in RES; rewrite H in RES. simpl in RES. inv RES. inv H3; auto. + econstructor. simpl; reflexivity. + unfold loc_result in RES; rewrite H in RES. simpl in RES. inv RES. inv H3; auto. Qed. Lemma wt_prog: wt_program prog. Proof. - red; intros. exploit transform_partial_program_succeeds; eauto. - intros [tfd TF]. destruct f; simpl in *. + red; intros. exploit transform_partial_program_succeeds; eauto. + intros [tfd TF]. destruct f; simpl in *. - monadInv TF. unfold transf_function in EQ. destruct (type_function f) as [env|] eqn:TF; try discriminate. econstructor. eapply type_function_correct; eauto. @@ -2349,16 +2349,16 @@ Theorem transf_program_correct: forward_simulation (RTL.semantics prog) (LTL.semantics tprog). Proof. set (ms := fun s s' => wt_state s /\ match_states s s'). - eapply forward_simulation_plus with (match_states := ms). + eapply forward_simulation_plus with (match_states := ms). - exact public_preserved. -- intros. exploit initial_states_simulation; eauto. intros [st2 [A B]]. +- intros. exploit initial_states_simulation; eauto. intros [st2 [A B]]. exists st2; split; auto. split; auto. - apply wt_initial_state with (p := prog); auto. exact wt_prog. -- intros. destruct H. eapply final_states_simulation; eauto. -- intros. destruct H0. + apply wt_initial_state with (p := prog); auto. exact wt_prog. +- intros. destruct H. eapply final_states_simulation; eauto. +- intros. destruct H0. exploit step_simulation; eauto. intros [s2' [A B]]. exists s2'; split. exact A. split. - eapply subject_reduction; eauto. eexact wt_prog. eexact H. + eapply subject_reduction; eauto. eexact wt_prog. eexact H. auto. Qed. diff --git a/backend/Asmexpandaux.ml b/backend/Asmexpandaux.ml index 25be9be3..7b8cc8c2 100644 --- a/backend/Asmexpandaux.ml +++ b/backend/Asmexpandaux.ml @@ -11,13 +11,13 @@ (* *) (* *********************************************************************) -(* Util functions used for the expansion of built-ins and some +(* Util functions used for the expansion of built-ins and some pseudo-instructions *) open Asm open AST open Camlcoq - + (* Buffering the expanded code *) let current_code = ref ([]: instruction list) @@ -25,7 +25,7 @@ let current_code = ref ([]: instruction list) let emit i = current_code := i :: !current_code (* Generation of fresh labels *) - + let dummy_function = { fn_code = []; fn_sig = signature_main } let current_function = ref dummy_function let next_label = ref (None: label option) @@ -46,7 +46,7 @@ let new_label () = next_label := Some (P.succ lbl); lbl - + let set_current_function f = current_function := f; next_label := None; current_code := [] @@ -64,7 +64,7 @@ let expand_scope id lbl oldscopes newscopes = List.iter (fun i -> Debug.open_scope id i lbl) opening; List.iter (fun i -> Debug.close_scope id i lbl) closing -let translate_annot sp preg_to_dwarf annot = +let translate_annot sp preg_to_dwarf annot = let rec aux = function | BA x -> Some (sp,BA (preg_to_dwarf x)) | BA_int _ @@ -75,7 +75,7 @@ let translate_annot sp preg_to_dwarf annot = | BA_addrglobal _ | BA_loadstack _ -> None | BA_addrstack ofs -> Some (sp,BA_addrstack ofs) - | BA_splitlong (hi,lo) -> + | BA_splitlong (hi,lo) -> begin match (aux hi,aux lo) with | Some (_,hi) ,Some (_,lo) -> Some (sp,BA_splitlong (hi,lo)) @@ -84,11 +84,11 @@ let translate_annot sp preg_to_dwarf annot = (match annot with | [] -> None | a::_ -> aux a) - + let expand_debug id sp preg simple l = let get_lbl = function - | None -> + | None -> let lbl = new_label () in emit (Plabel lbl); lbl @@ -100,12 +100,12 @@ let expand_debug id sp preg simple l = let kind = (P.to_int kind) in begin match kind with - | 1-> + | 1-> emit i;aux lbl scopes rest | 2 -> aux lbl scopes rest | 3 -> - begin + begin match translate_annot sp preg args with | Some a -> let lbl = get_lbl lbl in diff --git a/backend/Asmgenproof0.v b/backend/Asmgenproof0.v index 0533d561..cc27bd55 100644 --- a/backend/Asmgenproof0.v +++ b/backend/Asmgenproof0.v @@ -69,7 +69,7 @@ Hint Resolve data_diff: asmgen. Lemma preg_of_not_SP: forall r, preg_of r <> SP. Proof. - intros. unfold preg_of; destruct r; simpl; congruence. + intros. unfold preg_of; destruct r; simpl; congruence. Qed. Lemma preg_of_not_PC: @@ -83,7 +83,7 @@ Hint Resolve preg_of_not_SP preg_of_not_PC: asmgen. Lemma nextinstr_pc: forall rs, (nextinstr rs)#PC = Val.add rs#PC Vone. Proof. - intros. apply Pregmap.gss. + intros. apply Pregmap.gss. Qed. Lemma nextinstr_inv: @@ -102,16 +102,16 @@ Lemma nextinstr_set_preg: forall rs m v, (nextinstr (rs#(preg_of m) <- v))#PC = Val.add rs#PC Vone. Proof. - intros. unfold nextinstr. rewrite Pregmap.gss. - rewrite Pregmap.gso. auto. apply sym_not_eq. apply preg_of_not_PC. + intros. unfold nextinstr. rewrite Pregmap.gss. + rewrite Pregmap.gso. auto. apply sym_not_eq. apply preg_of_not_PC. Qed. Lemma undef_regs_other: - forall r rl rs, + forall r rl rs, (forall r', In r' rl -> r <> r') -> undef_regs rl rs r = rs r. Proof. - induction rl; simpl; intros. auto. + induction rl; simpl; intros. auto. rewrite IHrl by auto. rewrite Pregmap.gso; auto. Qed. @@ -129,9 +129,9 @@ Proof. induction rl; simpl; intros. tauto. destruct rl. - simpl. split. intros. intuition congruence. auto. - rewrite IHrl. split. - intros [A B]. intros. destruct H. congruence. auto. + simpl. split. intros. intuition congruence. auto. + rewrite IHrl. split. + intros [A B]. intros. destruct H. congruence. auto. auto. Qed. @@ -140,7 +140,7 @@ Lemma undef_regs_other_2: preg_notin r rl -> undef_regs (map preg_of rl) rs r = rs r. Proof. - intros. apply undef_regs_other. intros. + intros. apply undef_regs_other. intros. exploit list_in_map_inv; eauto. intros [mr [A B]]. subst. rewrite preg_notin_charact in H. auto. Qed. @@ -150,12 +150,12 @@ Lemma set_pregs_other_2: preg_notin r rl -> set_regs (map preg_of rl) vl rs r = rs r. Proof. - induction rl; simpl; intros. + induction rl; simpl; intros. auto. destruct vl; auto. assert (r <> preg_of a) by (destruct rl; tauto). assert (preg_notin r rl) by (destruct rl; simpl; tauto). - rewrite IHrl by auto. apply Pregmap.gso; auto. + rewrite IHrl by auto. apply Pregmap.gso; auto. Qed. (** * Agreement between Mach registers and processor registers *) @@ -225,7 +225,7 @@ Lemma agree_set_mreg: Proof. intros. destruct H. split; auto. rewrite H1; auto. apply sym_not_equal. apply preg_of_not_SP. - intros. unfold Regmap.set. destruct (RegEq.eq r0 r). congruence. + intros. unfold Regmap.set. destruct (RegEq.eq r0 r). congruence. rewrite H1. auto. apply preg_of_data. red; intros; elim n. eapply preg_of_injective; eauto. Qed. @@ -253,12 +253,12 @@ Lemma agree_set_mregs: Val.lessdef_list vl vl' -> agree (Mach.set_regs rl vl ms) sp (set_regs (map preg_of rl) vl' rs). Proof. - induction rl; simpl; intros. + induction rl; simpl; intros. auto. - inv H0. auto. apply IHrl; auto. - eapply agree_set_mreg. eexact H. + inv H0. auto. apply IHrl; auto. + eapply agree_set_mreg. eexact H. rewrite Pregmap.gss. auto. - intros. apply Pregmap.gso; auto. + intros. apply Pregmap.gso; auto. Qed. Lemma agree_undef_nondata_regs: @@ -281,13 +281,13 @@ Lemma agree_undef_regs: agree (Mach.undef_regs rl ms) sp rs'. Proof. intros. destruct H. split; auto. - rewrite <- agree_sp0. apply H0; auto. - rewrite preg_notin_charact. intros. apply not_eq_sym. apply preg_of_not_SP. + rewrite <- agree_sp0. apply H0; auto. + rewrite preg_notin_charact. intros. apply not_eq_sym. apply preg_of_not_SP. intros. destruct (In_dec mreg_eq r rl). rewrite Mach.undef_regs_same; auto. - rewrite Mach.undef_regs_other; auto. rewrite H0; auto. + rewrite Mach.undef_regs_other; auto. rewrite H0; auto. apply preg_of_data. - rewrite preg_notin_charact. intros; red; intros. elim n. + rewrite preg_notin_charact. intros; red; intros. elim n. exploit preg_of_injective; eauto. congruence. Qed. @@ -299,10 +299,10 @@ Lemma agree_set_undef_mreg: agree (Regmap.set r v (Mach.undef_regs rl ms)) sp rs'. Proof. intros. apply agree_set_mreg with (rs'#(preg_of r) <- (rs#(preg_of r))); auto. - apply agree_undef_regs with rs; auto. - intros. unfold Pregmap.set. destruct (PregEq.eq r' (preg_of r)). - congruence. auto. - intros. rewrite Pregmap.gso; auto. + apply agree_undef_regs with rs; auto. + intros. unfold Pregmap.set. destruct (PregEq.eq r' (preg_of r)). + congruence. auto. + intros. rewrite Pregmap.gso; auto. Qed. Lemma agree_change_sp: @@ -330,7 +330,7 @@ Proof. exploit Mem.loadv_extends; eauto. intros [v' [A B]]. rewrite (sp_val _ _ _ H) in A. exists v'; split; auto. - econstructor. eauto. assumption. + econstructor. eauto. assumption. Qed. Lemma extcall_args_match: @@ -339,7 +339,7 @@ Lemma extcall_args_match: list_forall2 (Mach.extcall_arg ms m sp) ll vl -> exists vl', list_forall2 (Asm.extcall_arg rs m') ll vl' /\ Val.lessdef_list vl vl'. Proof. - induction 3; intros. + induction 3; intros. exists (@nil val); split. constructor. constructor. exploit extcall_arg_match; eauto. intros [v1' [A B]]. destruct IHlist_forall2 as [vl' [C D]]. @@ -374,11 +374,11 @@ Lemma builtin_args_match: Proof. induction 3; intros; simpl. exists (@nil val); split; constructor. - exploit (@eval_builtin_arg_lessdef _ ge ms (fun r => rs (preg_of r))); eauto. + exploit (@eval_builtin_arg_lessdef _ ge ms (fun r => rs (preg_of r))); eauto. intros; eapply preg_val; eauto. intros (v1' & A & B). destruct IHlist_forall2 as [vl' [C D]]. - exists (v1' :: vl'); split; constructor; auto. apply builtin_arg_match; auto. + exists (v1' :: vl'); split; constructor; auto. apply builtin_arg_match; auto. Qed. Lemma agree_set_res: @@ -391,7 +391,7 @@ Proof. - eapply agree_set_mreg; eauto. rewrite Pregmap.gss. auto. intros. apply Pregmap.gso; auto. - auto. -- apply IHres2. apply IHres1. auto. +- apply IHres2. apply IHres1. auto. apply Val.hiword_lessdef; auto. apply Val.loword_lessdef; auto. Qed. @@ -452,7 +452,7 @@ Remark code_tail_bounds_1: code_tail ofs fn c -> 0 <= ofs <= list_length_z fn. Proof. induction 1; intros; simpl. - generalize (list_length_z_pos c). omega. + generalize (list_length_z_pos c). omega. rewrite list_length_z_cons. omega. Qed. @@ -462,7 +462,7 @@ Remark code_tail_bounds_2: Proof. assert (forall ofs fn c, code_tail ofs fn c -> forall i c', c = i :: c' -> 0 <= ofs < list_length_z fn). - induction 1; intros; simpl. + induction 1; intros; simpl. rewrite H. rewrite list_length_z_cons. generalize (list_length_z_pos c'). omega. rewrite list_length_z_cons. generalize (IHcode_tail _ _ H0). omega. eauto. @@ -490,7 +490,7 @@ Proof. intros. rewrite Int.add_unsigned. change (Int.unsigned Int.one) with 1. rewrite Int.unsigned_repr. apply code_tail_next with i; auto. - generalize (code_tail_bounds_2 _ _ _ _ H0). omega. + generalize (code_tail_bounds_2 _ _ _ _ H0). omega. Qed. (** [transl_code_at_pc pc fb f c ep tf tc] holds if the code pointer [pc] points @@ -526,8 +526,8 @@ Lemma transl_code'_transl_code: forall f il ep, transl_code' f il ep = transl_code f il ep. Proof. - intros. unfold transl_code'. rewrite transl_code_rec_transl_code. - destruct (transl_code f il ep); auto. + intros. unfold transl_code'. rewrite transl_code_rec_transl_code. + destruct (transl_code f il ep); auto. Qed. (** Predictor for return addresses in generated Asm code. @@ -584,7 +584,7 @@ Hypothesis transf_function_inv: Hypothesis transf_function_len: forall f tf, transf_function f = OK tf -> list_length_z (fn_code tf) <= Int.max_unsigned. -Lemma transl_code_tail: +Lemma transl_code_tail: forall f c1 c2, is_tail c1 c2 -> forall tc2 ep2, transl_code f c2 ep2 = OK tc2 -> exists tc1, exists ep1, transl_code f c1 ep1 = OK tc1 /\ is_tail tc1 tc2. @@ -592,7 +592,7 @@ Proof. induction 1; simpl; intros. exists tc2; exists ep2; split; auto with coqlib. monadInv H0. exploit IHis_tail; eauto. intros [tc1 [ep1 [A B]]]. - exists tc1; exists ep1; split. auto. + exists tc1; exists ep1; split. auto. apply is_tail_trans with x. auto. eapply transl_instr_tail; eauto. Qed. @@ -604,17 +604,17 @@ Proof. + exploit transf_function_inv; eauto. intros (tc1 & ep1 & TR1 & TL1). exploit transl_code_tail; eauto. intros (tc2 & ep2 & TR2 & TL2). Opaque transl_instr. - monadInv TR2. + monadInv TR2. assert (TL3: is_tail x (fn_code tf)). - { apply is_tail_trans with tc1; auto. + { apply is_tail_trans with tc1; auto. apply is_tail_trans with tc2; auto. eapply transl_instr_tail; eauto. } exploit is_tail_code_tail. eexact TL3. intros [ofs CT]. - exists (Int.repr ofs). red; intros. - rewrite Int.unsigned_repr. congruence. + exists (Int.repr ofs). red; intros. + rewrite Int.unsigned_repr. congruence. exploit code_tail_bounds_1; eauto. - apply transf_function_len in TF. omega. -+ exists Int.zero; red; intros. congruence. + apply transf_function_len in TF. omega. ++ exists Int.zero; red; intros. congruence. Qed. End RETADDR_EXISTS. @@ -641,9 +641,9 @@ Lemma return_address_offset_correct: return_address_offset f c ofs' -> ofs' = ofs. Proof. - intros. inv H. red in H0. + intros. inv H. red in H0. exploit code_tail_unique. eexact H12. eapply H0; eauto. intro. - rewrite <- (Int.repr_unsigned ofs). + rewrite <- (Int.repr_unsigned ofs). rewrite <- (Int.repr_unsigned ofs'). congruence. Qed. @@ -662,26 +662,26 @@ Lemma label_pos_code_tail: forall lbl c pos c', find_label lbl c = Some c' -> exists pos', - label_pos lbl pos c = Some pos' + label_pos lbl pos c = Some pos' /\ code_tail (pos' - pos) c c' /\ pos < pos' <= pos + list_length_z c. Proof. - induction c. + induction c. simpl; intros. discriminate. simpl; intros until c'. case (is_label lbl a). intro EQ; injection EQ; intro; subst c'. exists (pos + 1). split. auto. split. - replace (pos + 1 - pos) with (0 + 1) by omega. constructor. constructor. - rewrite list_length_z_cons. generalize (list_length_z_pos c). omega. + replace (pos + 1 - pos) with (0 + 1) by omega. constructor. constructor. + rewrite list_length_z_cons. generalize (list_length_z_pos c). omega. intros. generalize (IHc (pos + 1) c' H). intros [pos' [A [B C]]]. exists pos'. split. auto. split. replace (pos' - pos) with ((pos' - (pos + 1)) + 1) by omega. - constructor. auto. + constructor. auto. rewrite list_length_z_cons. omega. Qed. -(** Helper lemmas to reason about +(** Helper lemmas to reason about - the "code is tail of" property - correct translation of labels. *) @@ -697,7 +697,7 @@ Qed. Lemma tail_nolabel_trans: forall c1 c2 c3, tail_nolabel c2 c3 -> tail_nolabel c1 c2 -> tail_nolabel c1 c3. Proof. - intros. destruct H; destruct H0; split. + intros. destruct H; destruct H0; split. eapply is_tail_trans; eauto. intros. rewrite H1; auto. Qed. @@ -711,7 +711,7 @@ Lemma tail_nolabel_cons: forall i c k, nolabel i -> tail_nolabel k c -> tail_nolabel k (i :: c). Proof. - intros. destruct H0. split. + intros. destruct H0. split. constructor; auto. intros. simpl. rewrite <- H1. destruct i; reflexivity || contradiction. Qed. @@ -745,7 +745,7 @@ Variable fn: function. Instructions are taken from the first list instead of being fetched from memory. *) -Inductive exec_straight: code -> regset -> mem -> +Inductive exec_straight: code -> regset -> mem -> code -> regset -> mem -> Prop := | exec_straight_one: forall i1 c rs1 m1 rs2 m2, @@ -811,18 +811,18 @@ Lemma exec_straight_steps_1: Proof. induction 1; intros. apply plus_one. - econstructor; eauto. + econstructor; eauto. eapply find_instr_tail. eauto. eapply plus_left'. - econstructor; eauto. + econstructor; eauto. eapply find_instr_tail. eauto. - apply IHexec_straight with b (Int.add ofs Int.one). + apply IHexec_straight with b (Int.add ofs Int.one). auto. rewrite H0. rewrite H3. reflexivity. - auto. + auto. apply code_tail_next_int with i; auto. traceEq. Qed. - + Lemma exec_straight_steps_2: forall c rs m c' rs' m', exec_straight c rs m c' rs' m' -> @@ -840,7 +840,7 @@ Proof. rewrite H0. rewrite H2. auto. apply code_tail_next_int with i1; auto. apply IHexec_straight with (Int.add ofs Int.one). - auto. rewrite H0. rewrite H3. reflexivity. auto. + auto. rewrite H0. rewrite H3. reflexivity. auto. apply code_tail_next_int with i; auto. Qed. diff --git a/backend/Bounds.v b/backend/Bounds.v index beb29965..2a63b1d5 100644 --- a/backend/Bounds.v +++ b/backend/Bounds.v @@ -161,7 +161,7 @@ Proof. intros until valu. unfold max_over_list. assert (forall l z, fold_left (fun x y => Zmax x (valu y)) l z >= z). induction l; simpl; intros. - omega. apply Zge_trans with (Zmax z (valu a)). + omega. apply Zge_trans with (Zmax z (valu a)). auto. apply Zle_ge. apply Zmax1. auto. Qed. @@ -193,7 +193,7 @@ Program Definition function_bounds := _ _. Next Obligation. apply Zle_ge. eapply Zle_trans. 2: apply Zmax2. - apply Zge_le. apply max_over_slots_of_funct_pos. + apply Zge_le. apply max_over_slots_of_funct_pos. Qed. Next Obligation. apply Zle_ge. apply Zmax2. @@ -211,10 +211,10 @@ Proof. z <= f /\ (In x c -> valu x <= f)). induction c; simpl; intros. split. omega. tauto. - elim (IHc (Zmax z (valu a))); intros. - split. apply Zle_trans with (Zmax z (valu a)). apply Zmax1. auto. - intro H1; elim H1; intro. - subst a. apply Zle_trans with (Zmax z (valu x)). + elim (IHc (Zmax z (valu a))); intros. + split. apply Zle_trans with (Zmax z (valu a)). apply Zmax1. auto. + intro H1; elim H1; intro. + subst a. apply Zle_trans with (Zmax z (valu x)). apply Zmax2. auto. auto. intro. elim (H l 0); intros. auto. Qed. @@ -231,7 +231,7 @@ Lemma max_over_regs_of_funct_bound: In i f.(fn_code) -> In r (regs_of_instr i) -> valu r <= max_over_regs_of_funct valu. Proof. - intros. unfold max_over_regs_of_funct. + intros. unfold max_over_regs_of_funct. apply Zle_trans with (max_over_regs_of_instr valu i). unfold max_over_regs_of_instr. apply max_over_list_bound. auto. apply max_over_instrs_bound. auto. @@ -242,7 +242,7 @@ Lemma max_over_slots_of_funct_bound: In i f.(fn_code) -> In s (slots_of_instr i) -> valu s <= max_over_slots_of_funct valu. Proof. - intros. unfold max_over_slots_of_funct. + intros. unfold max_over_slots_of_funct. apply Zle_trans with (max_over_slots_of_instr valu i). unfold max_over_slots_of_instr. apply max_over_list_bound. auto. apply max_over_instrs_bound. auto. @@ -255,7 +255,7 @@ Lemma int_callee_save_bound: Proof. intros. apply Zlt_le_trans with (int_callee_save r). unfold int_callee_save. omega. - unfold function_bounds, bound_int_callee_save. + unfold function_bounds, bound_int_callee_save. eapply max_over_regs_of_funct_bound; eauto. Qed. @@ -266,7 +266,7 @@ Lemma float_callee_save_bound: Proof. intros. apply Zlt_le_trans with (float_callee_save r). unfold float_callee_save. omega. - unfold function_bounds, bound_float_callee_save. + unfold function_bounds, bound_float_callee_save. eapply max_over_regs_of_funct_bound; eauto. Qed. @@ -315,11 +315,11 @@ Proof. Qed. Lemma slot_is_within_bounds: - forall i, In i f.(fn_code) -> + forall i, In i f.(fn_code) -> forall sl ty ofs, In (sl, ofs, ty) (slots_of_instr i) -> slot_within_bounds function_bounds sl ofs ty. Proof. - intros. unfold slot_within_bounds. + intros. unfold slot_within_bounds. destruct sl. eapply local_slot_bound; eauto. auto. @@ -329,12 +329,12 @@ Qed. Lemma slots_of_locs_charact: forall sl ofs ty l, In (sl, ofs, ty) (slots_of_locs l) <-> In (S sl ofs ty) l. Proof. - induction l; simpl; intros. + induction l; simpl; intros. tauto. destruct a; simpl; intuition congruence. Qed. -(** It follows that every instruction in the function is within bounds, +(** It follows that every instruction in the function is within bounds, in the sense of the [instr_within_bounds] predicate. *) Lemma instr_is_within_bounds: @@ -342,16 +342,16 @@ Lemma instr_is_within_bounds: In i f.(fn_code) -> instr_within_bounds function_bounds i. Proof. - intros; + intros; destruct i; - generalize (mreg_is_within_bounds _ H); generalize (slot_is_within_bounds _ H); + generalize (mreg_is_within_bounds _ H); generalize (slot_is_within_bounds _ H); simpl; intros; auto. (* call *) eapply size_arguments_bound; eauto. (* builtin *) split; intros. apply H1. apply in_or_app; auto. - apply H0. rewrite slots_of_locs_charact; auto. + apply H0. rewrite slots_of_locs_charact; auto. Qed. Lemma function_is_within_bounds: diff --git a/backend/CMlexer.mll b/backend/CMlexer.mll index 7ed5b4ab..6695b6b7 100644 --- a/backend/CMlexer.mll +++ b/backend/CMlexer.mll @@ -21,8 +21,8 @@ exception Error of string } let blank = [' ' '\009' '\012' '\010' '\013'] -let floatlit = - ("-"? (['0'-'9'] ['0'-'9' '_']* +let floatlit = + ("-"? (['0'-'9'] ['0'-'9' '_']* ('.' ['0'-'9' '_']* )? (['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']*)? )) | "inf" | "nan" let ident = ['A'-'Z' 'a'-'z' '_'] ['A'-'Z' 'a'-'z' '_' '$' '0'-'9']* @@ -69,7 +69,7 @@ rule token = parse | "floatofintu" { FLOATOFINTU } | "floatoflong" { FLOATOFLONG } | "floatoflongu" { FLOATOFLONGU } - | "goto" { GOTO } + | "goto" { GOTO } | ">" { GREATER } | ">f" { GREATERF } | ">l" { GREATERL } diff --git a/backend/CMparser.mly b/backend/CMparser.mly index 41bd35a1..5f189e7b 100644 --- a/backend/CMparser.mly +++ b/backend/CMparser.mly @@ -13,7 +13,7 @@ /* */ /* *********************************************************************/ -/* Note that this compiles a superset of the language defined by the AST, +/* Note that this compiles a superset of the language defined by the AST, including function calls in expressions, matches, while statements, etc. */ %{ @@ -123,7 +123,7 @@ let mkeval e = let c1 = convert_rexpr e1 in let cl = convert_rexpr_list el in prepend_seq !convert_accu (Scall(None, sg, c1, cl)) - | Rbuiltin(sg, pef, el) -> + | Rbuiltin(sg, pef, el) -> let ef = mkef sg pef in let cl = convert_rexpr_list el in prepend_seq !convert_accu (Sbuiltin(None, ef, cl)) @@ -322,9 +322,9 @@ let mkmatch expr cases = %token LESSLESSL %token LONG %token <int64> LONGLIT -%token LONGOFINT +%token LONGOFINT %token LONGOFINTU -%token LONGOFFLOAT +%token LONGOFFLOAT %token LONGUOFFLOAT %token LOOP %token LPAREN @@ -375,7 +375,7 @@ let mkmatch expr cases = %left CARET CARETL %left AMPERSAND AMPERSANDL %left EQUALEQUAL BANGEQUAL LESS LESSEQUAL GREATER GREATEREQUAL EQUALEQUALU BANGEQUALU LESSU LESSEQUALU GREATERU GREATEREQUALU EQUALEQUALF BANGEQUALF LESSF LESSEQUALF GREATERF GREATEREQUALF EQUALEQUALL BANGEQUALL LESSL LESSEQUALL GREATERL GREATEREQUALL EQUALEQUALLU BANGEQUALLU LESSLU LESSEQUALLU GREATERLU GREATEREQUALLU -%left LESSLESS GREATERGREATER GREATERGREATERU LESSLESSL GREATERGREATERL GREATERGREATERLU +%left LESSLESS GREATERGREATER GREATERGREATERU LESSLESSL GREATERGREATERL GREATERGREATERLU %left PLUS PLUSF PLUSL MINUS MINUSF MINUSL %left STAR SLASH PERCENT STARF SLASHF SLASHU PERCENTU STARL SLASHL SLASHLU PERCENTL PERCENTLU %nonassoc BANG TILDE TILDEL p_uminus ABSF INTOFFLOAT INTUOFFLOAT FLOATOFINT FLOATOFINTU INT8S INT8U INT16S INT16U FLOAT32 INTOFLONG LONGOFINT LONGOFINTU LONGOFFLOAT LONGUOFFLOAT FLOATOFLONG FLOATOFLONGU @@ -432,12 +432,12 @@ init_data_list: /* empty */ { [] } | init_data_list_1 { $1 } ; - + init_data_list_1: init_data { [$1] } | init_data_list_1 COMMA init_data { $3 :: $1 } ; - + init_data: INT8 INTLIT { Init_int8 (coqint_of_camlint $2) } | INT16 INTLIT { Init_int16 (coqint_of_camlint $2) } @@ -453,7 +453,7 @@ init_data: | LBRACKET INTLIT RBRACKET { Init_space (Z.of_sint32 $2) } | INTLIT LPAREN STRINGLIT RPAREN { Init_addrof (intern_string $3, coqint_of_camlint $1) } ; - + /* Procedures */ proc: @@ -472,14 +472,14 @@ proc: fn_vars = List.rev (tmp @ $9); fn_stackspace = $8; fn_body = $10 })) } - | EXTERN STRINGLIT COLON signature + | EXTERN STRINGLIT COLON signature { (intern_string $2, Gfun(External(EF_external(coqstring_of_camlstring $2,$4)))) } | EXTERN STRINGLIT EQUAL eftoks COLON signature { (intern_string $2, Gfun(External(mkef $6 $4))) } ; signature: - type_ + type_ { {sig_args = []; sig_res = Some $1; sig_cc = cc_default} } | VOID { {sig_args = []; sig_res = None; sig_cc = cc_default} } diff --git a/backend/CMtypecheck.ml b/backend/CMtypecheck.ml index aacbf86f..72bf9cb4 100644 --- a/backend/CMtypecheck.ml +++ b/backend/CMtypecheck.ml @@ -323,7 +323,7 @@ let rec type_stmt env blk ret s = | Sreturn (Some e) -> begin match ret with | None -> raise (Error "return with argument") - | Some tret -> + | Some tret -> begin try unify (type_expr env [] e) (ty_of_typ tret) with Error s -> diff --git a/backend/CSE.v b/backend/CSE.v index ebeb921e..63dadbc7 100644 --- a/backend/CSE.v +++ b/backend/CSE.v @@ -181,7 +181,7 @@ Definition add_rhs (n: numbering) (rd: reg) (rh: rhs) : numbering := (** [add_op n rd op rs] specializes [add_rhs] for the case of an arithmetic operation. The right-hand side corresponding to [op] and the value numbers for the argument registers [rs] is built - and added to [n] as described in [add_rhs]. + and added to [n] as described in [add_rhs]. If [op] is a move instruction, we simply assign the value number of the source register to the destination register, since we know that @@ -190,7 +190,7 @@ Definition add_rhs (n: numbering) (rd: reg) (rh: rhs) : numbering := << z = add(x, y); u = x; v = add(u, y); >> - Since [u] and [x] have the same value number, the second [add] + Since [u] and [x] have the same value number, the second [add] is recognized as computing the same result as the first [add], and therefore [u] and [z] have the same value number. *) @@ -212,13 +212,13 @@ Definition add_op (n: numbering) (rd: reg) (op: operation) (rs: list reg) := and the value numbers for the argument registers [rs] is built and added to [n] as described in [add_rhs]. *) -Definition add_load (n: numbering) (rd: reg) +Definition add_load (n: numbering) (rd: reg) (chunk: memory_chunk) (addr: addressing) (rs: list reg) := let (n1, vs) := valnum_regs n rs in add_rhs n1 rd (Load chunk addr vs). -(** [set_unknown n rd] returns a numbering where [rd] is mapped to +(** [set_unknown n rd] returns a numbering where [rd] is mapped to no value number, and no equations are added. This is useful to model instructions with unpredictable results such as [Ibuiltin]. *) @@ -323,7 +323,7 @@ Definition kill_loads_after_storebytes (app: VA.t) (n: numbering) (dst: aptr) (sz: Z) := kill_equations (filter_after_store app n dst sz) n. -(** [add_memcpy app n1 n2 rsrc rdst sz] adds equations to [n2] that +(** [add_memcpy app n1 n2 rsrc rdst sz] adds equations to [n2] that represent the effect of a [memcpy] block copy operation of [sz] bytes from the address denoted by [rsrc] to the address denoted by [rdst]. [n2] is the numbering returned by [kill_loads_after_storebytes] @@ -415,7 +415,7 @@ End REDUCE. Module Numbering. Definition t := numbering. Definition ge (n1 n2: numbering) : Prop := - forall valu ge sp rs m, + forall valu ge sp rs m, numbering_holds valu ge sp rs m n2 -> numbering_holds valu ge sp rs m n1. Definition top := empty_numbering. @@ -443,7 +443,7 @@ Module Solver := BBlock_solver(Numbering). then add an equation for loads from the same location stored to. For [Icall] instructions, we could simply associate a fresh, unconstrained by equations value number to the result register. However, it is often undesirable to eliminate - common subexpressions across a function call (there is a risk of + common subexpressions across a function call (there is a risk of increasing too much the register pressure across the call), so we just forget all equations and start afresh with an empty numbering. Finally, for instructions that modify neither registers nor diff --git a/backend/CSEdomain.v b/backend/CSEdomain.v index 6a75d511..9b1243c8 100644 --- a/backend/CSEdomain.v +++ b/backend/CSEdomain.v @@ -78,7 +78,7 @@ Definition valnums_rhs (r: rhs): list valnum := end. Definition wf_rhs (next: valnum) (r: rhs) : Prop := -forall v, In v (valnums_rhs r) -> Plt v next. +forall v, In v (valnums_rhs r) -> Plt v next. Definition wf_equation (next: valnum) (e: equation) : Prop := match e with Eq l str r => Plt l next /\ wf_rhs next r end. diff --git a/backend/CSEproof.v b/backend/CSEproof.v index 70f9bfc7..07c7008d 100644 --- a/backend/CSEproof.v +++ b/backend/CSEproof.v @@ -100,9 +100,9 @@ Lemma numbering_holds_exten: Proof. intros. destruct H. constructor; intros. - auto. -- apply equation_holds_exten. auto. - eapply wf_equation_incr; eauto with cse. -- rewrite AGREE. eauto. eapply Plt_le_trans; eauto. eapply wf_num_reg; eauto. +- apply equation_holds_exten. auto. + eapply wf_equation_incr; eauto with cse. +- rewrite AGREE. eauto. eapply Plt_le_trans; eauto. eapply wf_num_reg; eauto. Qed. End EXTEN. @@ -136,16 +136,16 @@ Proof. + constructor; simpl; intros. * constructor; simpl; intros. apply wf_equation_incr with (num_next n). eauto with cse. xomega. - rewrite PTree.gsspec in H0. destruct (peq r0 r). + rewrite PTree.gsspec in H0. destruct (peq r0 r). inv H0; xomega. apply Plt_trans_succ; eauto with cse. rewrite PMap.gsspec in H0. destruct (peq v (num_next n)). replace r0 with r by (simpl in H0; intuition). rewrite PTree.gss. subst; auto. - exploit wf_num_val; eauto with cse. intro. + exploit wf_num_val; eauto with cse. intro. rewrite PTree.gso by congruence. auto. * eapply equation_holds_exten; eauto with cse. * unfold valu2. rewrite PTree.gsspec in H0. destruct (peq r0 r). - inv H0. rewrite peq_true; auto. + inv H0. rewrite peq_true; auto. rewrite peq_false. eauto with cse. apply Plt_ne; eauto with cse. + unfold valu2. rewrite peq_true; auto. + auto. @@ -169,9 +169,9 @@ Proof. - destruct (valnum_reg n a) as [n1 v1] eqn:V1. destruct (valnum_regs n1 rl) as [n2 vs] eqn:V2. inv H0. - exploit valnum_reg_holds; eauto. + exploit valnum_reg_holds; eauto. intros (valu2 & A & B & C & D & E). - exploit (IHrl valu2); eauto. + exploit (IHrl valu2); eauto. intros (valu3 & P & Q & R & S & T). exists valu3; splitall. + auto. @@ -187,7 +187,7 @@ Lemma find_valnum_rhs_charact: Proof. induction eqs; simpl; intros. - inv H. -- destruct a. destruct (strict && eq_rhs rh r) eqn:T. +- destruct a. destruct (strict && eq_rhs rh r) eqn:T. + InvBooleans. inv H. left; auto. + right; eauto. Qed. @@ -198,9 +198,9 @@ Lemma find_valnum_rhs'_charact: Proof. induction eqs; simpl; intros. - inv H. -- destruct a. destruct (eq_rhs rh r) eqn:T. +- destruct a. destruct (eq_rhs rh r) eqn:T. + inv H. exists strict; auto. - + exploit IHeqs; eauto. intros [s IN]. exists s; auto. + + exploit IHeqs; eauto. intros [s IN]. exists s; auto. Qed. Lemma find_valnum_num_charact: @@ -208,8 +208,8 @@ Lemma find_valnum_num_charact: Proof. induction eqs; simpl; intros. - inv H. -- destruct a. destruct (strict && peq v v0) eqn:T. - + InvBooleans. inv H. auto. +- destruct a. destruct (strict && peq v v0) eqn:T. + + InvBooleans. inv H. auto. + eauto. Qed. @@ -220,7 +220,7 @@ Lemma reg_valnum_sound: rs#r = valu v. Proof. unfold reg_valnum; intros. destruct (num_val n)#v as [ | r1 rl] eqn:E; inv H. - eapply num_holds_reg; eauto. eapply wf_num_val; eauto with cse. + eapply num_holds_reg; eauto. eapply wf_num_val; eauto with cse. rewrite E; auto with coqlib. Qed. @@ -235,7 +235,7 @@ Proof. - inv H0; auto. - destruct (reg_valnum n a) as [r1|] eqn:RV1; try discriminate. destruct (regs_valnums n vl) as [rl1|] eqn:RVL; inv H0. - simpl; f_equal. eapply reg_valnum_sound; eauto. eauto. + simpl; f_equal. eapply reg_valnum_sound; eauto. eauto. Qed. Lemma find_rhs_sound: @@ -256,10 +256,10 @@ Remark in_remove: forall (A: Type) (eq: forall (x y: A), {x=y}+{x<>y}) x y l, In y (List.remove eq x l) <-> x <> y /\ In y l. Proof. - induction l; simpl. + induction l; simpl. tauto. - destruct (eq x a). - subst a. rewrite IHl. tauto. + destruct (eq x a). + subst a. rewrite IHl. tauto. simpl. rewrite IHl. intuition congruence. Qed. @@ -274,7 +274,7 @@ Proof. + subst v. rewrite in_remove in H0. intuition. + split; auto. exploit wf_num_val; eauto. congruence. - split; auto. exploit wf_num_val; eauto. congruence. -Qed. +Qed. Lemma update_reg_charact: forall n rd vd r v, @@ -285,7 +285,7 @@ Proof. unfold update_reg; intros. rewrite PMap.gsspec in H0. destruct (peq v vd). -- subst v. destruct H0. +- subst v. destruct H0. + subst r. apply PTree.gss. + exploit forget_reg_charact; eauto. intros [A B]. rewrite PTree.gso by auto. eapply wf_num_val; eauto. @@ -324,7 +324,7 @@ Proof. eauto with cse. * eapply update_reg_charact; eauto with cse. + eauto with cse. -+ rewrite PTree.gsspec in H5. destruct (peq r rd). ++ rewrite PTree.gsspec in H5. destruct (peq r rd). congruence. rewrite H2 by auto. eauto with cse. @@ -334,17 +334,17 @@ Proof. { red; intros. unfold valu2. apply peq_false. apply Plt_ne; auto. } exists valu2; constructor; simpl; intros. + constructor; simpl; intros. - * destruct H3. inv H3. simpl; split. xomega. - red; intros. apply Plt_trans_succ; eauto. - apply wf_equation_incr with (num_next n). eauto with cse. xomega. + * destruct H3. inv H3. simpl; split. xomega. + red; intros. apply Plt_trans_succ; eauto. + apply wf_equation_incr with (num_next n). eauto with cse. xomega. * rewrite PTree.gsspec in H3. destruct (peq r rd). inv H3. xomega. apply Plt_trans_succ; eauto with cse. * apply update_reg_charact; eauto with cse. + destruct H3. inv H3. - constructor. unfold valu2 at 2; rewrite peq_true. - eapply rhs_eval_to_exten; eauto. - eapply equation_holds_exten; eauto with cse. + constructor. unfold valu2 at 2; rewrite peq_true. + eapply rhs_eval_to_exten; eauto. + eapply equation_holds_exten; eauto with cse. + rewrite PTree.gsspec in H3. unfold valu2. destruct (peq r rd). inv H3. rewrite peq_true; auto. rewrite peq_false. rewrite H2 by auto. eauto with cse. @@ -363,7 +363,7 @@ Proof. exploit is_move_operation_correct; eauto. intros [A B]; subst op args. simpl in H0. inv H0. destruct (valnum_reg n src) as [n1 vsrc] eqn:VN. - exploit valnum_reg_holds; eauto. + exploit valnum_reg_holds; eauto. intros (valu2 & A & B & C & D & E). exists valu2; constructor; simpl; intros. + constructor; simpl; intros; eauto with cse. @@ -372,15 +372,15 @@ Proof. eauto with cse. * eapply update_reg_charact; eauto with cse. + eauto with cse. -+ rewrite PTree.gsspec in H0. rewrite Regmap.gsspec. ++ rewrite PTree.gsspec in H0. rewrite Regmap.gsspec. destruct (peq r dst). congruence. eauto with cse. - (* general case *) destruct (valnum_regs n args) as [n1 vl] eqn:VN. - exploit valnum_regs_holds; eauto. + exploit valnum_regs_holds; eauto. intros (valu2 & A & B & C & D & E). - eapply add_rhs_holds; eauto. -+ constructor. rewrite Regmap.gss. congruence. + eapply add_rhs_holds; eauto. ++ constructor. rewrite Regmap.gss. congruence. + intros. apply Regmap.gso; auto. Qed. @@ -393,10 +393,10 @@ Lemma add_load_holds: Proof. unfold add_load; intros. destruct (valnum_regs n args) as [n1 vl] eqn:VN. - exploit valnum_regs_holds; eauto. + exploit valnum_regs_holds; eauto. intros (valu2 & A & B & C & D & E). - eapply add_rhs_holds; eauto. -+ econstructor. rewrite <- B; eauto. rewrite Regmap.gss; auto. + eapply add_rhs_holds; eauto. ++ econstructor. rewrite <- B; eauto. rewrite Regmap.gss; auto. + intros. apply Regmap.gso; auto. Qed. @@ -408,13 +408,13 @@ Proof. intros; constructor; simpl; intros. - constructor; simpl; intros. + eauto with cse. - + rewrite PTree.grspec in H0. destruct (PTree.elt_eq r0 r). - discriminate. + + rewrite PTree.grspec in H0. destruct (PTree.elt_eq r0 r). + discriminate. eauto with cse. - + exploit forget_reg_charact; eauto with cse. intros [A B]. + + exploit forget_reg_charact; eauto with cse. intros [A B]. rewrite PTree.gro; eauto with cse. - eauto with cse. -- rewrite PTree.grspec in H0. destruct (PTree.elt_eq r0 r). +- rewrite PTree.grspec in H0. destruct (PTree.elt_eq r0 r). discriminate. rewrite Regmap.gso; eauto with cse. Qed. @@ -429,7 +429,7 @@ Qed. Lemma kill_eqs_charact: forall pred l strict r eqs, - In (Eq l strict r) (kill_eqs pred eqs) -> + In (Eq l strict r) (kill_eqs pred eqs) -> pred r = false /\ In (Eq l strict r) eqs. Proof. induction eqs; simpl; intros. @@ -451,7 +451,7 @@ Proof. intros; constructor; simpl; intros. - constructor; simpl; intros; eauto with cse. destruct e. exploit kill_eqs_charact; eauto. intros [A B]. eauto with cse. -- destruct eq. exploit kill_eqs_charact; eauto. intros [A B]. +- destruct eq. exploit kill_eqs_charact; eauto. intros [A B]. exploit num_holds_eq; eauto. intro EH; inv EH; econstructor; eauto. - eauto with cse. Qed. @@ -461,7 +461,7 @@ Lemma kill_all_loads_hold: numbering_holds valu ge sp rs m n -> numbering_holds valu ge sp rs m' (kill_all_loads n). Proof. - intros. eapply kill_equations_hold; eauto. + intros. eapply kill_equations_hold; eauto. unfold filter_loads; intros. inv H1. constructor. rewrite <- H2. apply op_depends_on_memory_correct; auto. discriminate. @@ -486,11 +486,11 @@ Proof. econstructor; eauto. rewrite <- H9. destruct a; simpl in H1; try discriminate. destruct a0; simpl in H9; try discriminate. - simpl. + simpl. rewrite negb_false_iff in H6. unfold aaddressing in H6. eapply Mem.load_store_other. eauto. - eapply pdisjoint_sound. eauto. - apply match_aptr_of_aval. eapply eval_static_addressing_sound; eauto. + eapply pdisjoint_sound. eauto. + apply match_aptr_of_aval. eapply eval_static_addressing_sound; eauto. erewrite <- regs_valnums_sound by eauto. eauto with va. apply match_aptr_of_aval. eapply eval_static_addressing_sound; eauto with va. Qed. @@ -516,22 +516,22 @@ Lemma add_store_result_hold: approx = VA.State ae am -> exists valu2, numbering_holds valu2 ge sp rs m' (add_store_result approx n chunk addr args src). Proof. - unfold add_store_result; intros. - unfold avalue; rewrite H3. + unfold add_store_result; intros. + unfold avalue; rewrite H3. destruct (vincl (AE.get src ae) (store_normalized_range chunk)) eqn:INCL. - destruct (valnum_reg n src) as [n1 vsrc] eqn:VR1. destruct (valnum_regs n1 args) as [n2 vargs] eqn:VR2. - exploit valnum_reg_holds; eauto. intros (valu2 & A & B & C & D & E). + exploit valnum_reg_holds; eauto. intros (valu2 & A & B & C & D & E). exploit valnum_regs_holds; eauto. intros (valu3 & P & Q & R & S & T). exists valu3. constructor; simpl; intros. + constructor; simpl; intros; eauto with cse. - destruct H4; eauto with cse. subst e. split. - eapply Plt_le_trans; eauto. + destruct H4; eauto with cse. subst e. split. + eapply Plt_le_trans; eauto. red; simpl; intros. auto. + destruct H4; eauto with cse. subst eq. apply eq_holds_lessdef with (Val.load_result chunk rs#src). apply load_eval_to with a. rewrite <- Q; auto. destruct a; try discriminate. simpl. eapply Mem.load_store_same; eauto. - rewrite B. rewrite R by auto. apply store_normalized_range_sound with bc. + rewrite B. rewrite R by auto. apply store_normalized_range_sound with bc. rewrite <- B. eapply vmatch_ge. apply vincl_ge; eauto. apply H2. + eauto with cse. @@ -557,12 +557,12 @@ Proof. - destruct (regs_valnums n vl) as [rl|] eqn:RV; try discriminate. econstructor; eauto. rewrite <- H11. destruct a; simpl in H10; try discriminate. - simpl. + simpl. rewrite negb_false_iff in H8. eapply Mem.load_storebytes_other. eauto. - rewrite H6. rewrite nat_of_Z_eq by auto. - eapply pdisjoint_sound. eauto. - unfold aaddressing. apply match_aptr_of_aval. eapply eval_static_addressing_sound; eauto. + rewrite H6. rewrite nat_of_Z_eq by auto. + eapply pdisjoint_sound. eauto. + unfold aaddressing. apply match_aptr_of_aval. eapply eval_static_addressing_sound; eauto. erewrite <- regs_valnums_sound by eauto. eauto with va. auto. Qed. @@ -576,14 +576,14 @@ Lemma load_memcpy: (align_chunk chunk | ofs2 - ofs1) -> Mem.load chunk m' b2 (i + (ofs2 - ofs1)) = Some v. Proof. - intros. + intros. generalize (size_chunk_pos chunk); intros SPOS. set (n1 := i - ofs1). set (n2 := size_chunk chunk). set (n3 := sz - (n1 + n2)). replace sz with (n1 + (n2 + n3)) in H by (unfold n3, n2, n1; omega). - exploit Mem.loadbytes_split; eauto. - unfold n1; omega. + exploit Mem.loadbytes_split; eauto. + unfold n1; omega. unfold n3, n2, n1; omega. intros (bytes1 & bytes23 & LB1 & LB23 & EQ). clear H. @@ -591,7 +591,7 @@ Proof. unfold n2; omega. unfold n3, n2, n1; omega. intros (bytes2 & bytes3 & LB2 & LB3 & EQ'). - subst bytes23; subst bytes. + subst bytes23; subst bytes. exploit Mem.load_loadbytes; eauto. intros (bytes2' & A & B). assert (bytes2' = bytes2). { replace (ofs1 + n1) with i in LB2 by (unfold n1; omega). unfold n2 in LB2. congruence. } @@ -604,17 +604,17 @@ Proof. { erewrite Mem.loadbytes_length by eauto. apply nat_of_Z_eq. unfold n1; omega. } assert (L2: Z.of_nat (length bytes2) = n2). { erewrite Mem.loadbytes_length by eauto. apply nat_of_Z_eq. unfold n2; omega. } - rewrite L1 in *. rewrite L2 in *. + rewrite L1 in *. rewrite L2 in *. assert (LB': Mem.loadbytes m2 b2 (ofs2 + n1) n2 = Some bytes2). { rewrite <- L2. eapply Mem.loadbytes_storebytes_same; eauto. } assert (LB'': Mem.loadbytes m' b2 (ofs2 + n1) n2 = Some bytes2). - { rewrite <- LB'. eapply Mem.loadbytes_storebytes_other; eauto. - unfold n2; omega. + { rewrite <- LB'. eapply Mem.loadbytes_storebytes_other; eauto. + unfold n2; omega. right; left; omega. } - exploit Mem.load_valid_access; eauto. intros [P Q]. + exploit Mem.load_valid_access; eauto. intros [P Q]. rewrite B. apply Mem.loadbytes_load. - replace (i + (ofs2 - ofs1)) with (ofs2 + n1) by (unfold n1; omega). - exact LB''. + replace (i + (ofs2 - ofs1)) with (ofs2 + n1) by (unfold n1; omega). + exact LB''. apply Z.divide_add_r; auto. Qed. @@ -625,7 +625,7 @@ Lemma shift_memcpy_eq_wf: wf_equation next e'. Proof with (try discriminate). unfold shift_memcpy_eq; intros. - destruct e. destruct r... destruct a... + destruct e. destruct r... destruct a... destruct (zle src (Int.unsigned i) && zle (Int.unsigned i + size_chunk m) (src + sz) && zeq (delta mod align_chunk m) 0 && zle 0 (Int.unsigned i + delta) && @@ -642,7 +642,7 @@ Lemma shift_memcpy_eq_holds: equation_holds valu ge (Vptr sp Int.zero) m' e'. Proof with (try discriminate). intros. set (delta := dst - src) in *. unfold shift_memcpy_eq in H. - destruct e as [l strict rhs] eqn:E. + destruct e as [l strict rhs] eqn:E. destruct rhs as [op vl | chunk addr vl]... destruct addr... set (i1 := Int.unsigned i) in *. set (j := i1 + delta) in *. @@ -656,16 +656,16 @@ Proof with (try discriminate). Mem.loadv chunk m (Vptr sp i) = Some v -> Mem.loadv chunk m' (Vptr sp (Int.repr j)) = Some v). { - simpl; intros. rewrite Int.unsigned_repr by omega. - unfold j, delta. eapply load_memcpy; eauto. + simpl; intros. rewrite Int.unsigned_repr by omega. + unfold j, delta. eapply load_memcpy; eauto. apply Zmod_divide; auto. generalize (align_chunk_pos chunk); omega. } inv H2. + inv H3. destruct vl... simpl in H6. rewrite Int.add_zero_l in H6. inv H6. - apply eq_holds_strict. econstructor. simpl. rewrite Int.add_zero_l. eauto. + apply eq_holds_strict. econstructor. simpl. rewrite Int.add_zero_l. eauto. apply LD; auto. + inv H4. destruct vl... simpl in H7. rewrite Int.add_zero_l in H7. inv H7. - apply eq_holds_lessdef with v; auto. + apply eq_holds_lessdef with v; auto. econstructor. simpl. rewrite Int.add_zero_l. eauto. apply LD; auto. Qed. @@ -677,7 +677,7 @@ Proof. induction eqs1; simpl; intros. - auto. - destruct (shift_memcpy_eq src sz delta a) as [e''|] eqn:SHIFT. - + destruct H. subst e''. right; exists a; auto. + + destruct H. subst e''. right; exists a; auto. destruct IHeqs1 as [A | [e [A B]]]; auto. right; exists e; auto. + destruct IHeqs1 as [A | [e [A B]]]; auto. right; exists e; auto. Qed. @@ -695,7 +695,7 @@ Lemma add_memcpy_holds: numbering_holds valu ge (Vptr sp Int.zero) rs m' (add_memcpy n1 n2 asrc adst sz). Proof. intros. unfold add_memcpy. - destruct asrc; auto; destruct adst; auto. + destruct asrc; auto; destruct adst; auto. assert (A: forall b o i, pmatch bc b o (Stk i) -> b = sp /\ i = o). { intros. inv H7. split; auto. eapply bc_stack; eauto. @@ -703,11 +703,11 @@ Proof. apply A in H3; destruct H3. subst bsrc ofs. apply A in H4; destruct H4. subst bdst ofs0. constructor; simpl; intros; eauto with cse. -- constructor; simpl; eauto with cse. +- constructor; simpl; eauto with cse. intros. exploit add_memcpy_eqs_charact; eauto. intros [X | (e0 & X & Y)]. eauto with cse. - apply wf_equation_incr with (num_next n1); auto. - eapply shift_memcpy_eq_wf; eauto with cse. + apply wf_equation_incr with (num_next n1); auto. + eapply shift_memcpy_eq_wf; eauto with cse. - exploit add_memcpy_eqs_charact; eauto. intros [X | (e0 & X & Y)]. eauto with cse. eapply shift_memcpy_eq_holds; eauto with cse. @@ -747,7 +747,7 @@ Proof. assert (sem op1 (map valu args1) = Some res). rewrite <- H0. eapply f_sound; eauto. simpl; intros. - exploit num_holds_eq; eauto. + exploit num_holds_eq; eauto. eapply find_valnum_num_charact; eauto with cse. intros EH; inv EH; auto. destruct (reduce_rec A f n niter op1 args1) as [[op2 rl2] | ] eqn:?. @@ -765,7 +765,7 @@ Lemma reduce_sound: sem op rs##rl = Some res -> sem op' rs##rl' = Some res. Proof. - unfold reduce; intros. + unfold reduce; intros. destruct (reduce_rec A f n 4%nat op vl) as [[op1 rl1] | ] eqn:?; inv H. eapply reduce_rec_sound; eauto. congruence. auto. @@ -775,8 +775,8 @@ End REDUCE. (** The numberings associated to each instruction by the static analysis are inductively satisfiable, in the following sense: the numbering - at the function entry point is satisfiable, and for any RTL execution - from [pc] to [pc'], satisfiability at [pc] implies + at the function entry point is satisfiable, and for any RTL execution + from [pc] to [pc'], satisfiability at [pc] implies satisfiability at [pc']. *) Theorem analysis_correct_1: @@ -797,7 +797,7 @@ Theorem analysis_correct_entry: analyze f vapprox = Some approx -> exists valu, numbering_holds valu ge sp rs m approx!!(f.(fn_entrypoint)). Proof. - intros. + intros. replace (approx!!(f.(fn_entrypoint))) with Solver.L.top. exists (fun v => Vundef). apply empty_numbering_holds. symmetry. eapply Solver.fixpoint_entry; eauto. @@ -843,7 +843,7 @@ Lemma sig_preserved: Proof. unfold transf_fundef; intros. destruct f; monadInv H; auto. unfold transf_function in EQ. - destruct (analyze f (vanalyze rm f)); try discriminate. inv EQ; auto. + destruct (analyze f (vanalyze rm f)); try discriminate. inv EQ; auto. Qed. Definition transf_function' (f: function) (approxs: PMap.t numbering) : function := @@ -868,7 +868,7 @@ Lemma set_reg_lessdef: forall r v1 v2 rs1 rs2, Val.lessdef v1 v2 -> regs_lessdef rs1 rs2 -> regs_lessdef (rs1#r <- v1) (rs2#r <- v2). Proof. - intros; red; intros. repeat rewrite Regmap.gsspec. + intros; red; intros. repeat rewrite Regmap.gsspec. destruct (peq r0 r); auto. Qed. @@ -958,7 +958,7 @@ Ltac TransfInstr := | H1: (PTree.get ?pc ?c = Some ?instr), f: function, approx: PMap.t numbering |- _ => cut ((transf_function' f approx).(fn_code)!pc = Some(transf_instr approx!!pc instr)); [ simpl transf_instr - | unfold transf_function', transf_code; simpl; rewrite PTree.gmap; + | unfold transf_function', transf_code; simpl; rewrite PTree.gmap; unfold option_map; rewrite H1; reflexivity ] end. @@ -975,8 +975,8 @@ Proof. (* Inop *) - econstructor; split. eapply exec_Inop; eauto. - econstructor; eauto. - eapply analysis_correct_1; eauto. simpl; auto. + econstructor; eauto. + eapply analysis_correct_1; eauto. simpl; auto. unfold transfer; rewrite H; auto. (* Iop *) @@ -987,9 +987,9 @@ Proof. econstructor; split. eapply exec_Iop with (v := v'); eauto. rewrite <- A. apply eval_operation_preserved. exact symbols_preserved. - econstructor; eauto. + econstructor; eauto. eapply analysis_correct_1; eauto. simpl; auto. - unfold transfer; rewrite H. + unfold transfer; rewrite H. destruct SAT as [valu NH]. eapply add_op_holds; eauto. apply set_reg_lessdef; auto. + (* possibly optimized *) @@ -998,31 +998,31 @@ Proof. exploit valnum_regs_holds; eauto. intros (valu2 & NH2 & EQ & AG & P & Q). destruct (find_rhs n1 (Op op vl)) as [r|] eqn:?. * (* replaced by move *) - exploit find_rhs_sound; eauto. intros (v' & EV & LD). + exploit find_rhs_sound; eauto. intros (v' & EV & LD). assert (v' = v) by (inv EV; congruence). subst v'. econstructor; split. eapply exec_Iop; eauto. simpl; eauto. - econstructor; eauto. + econstructor; eauto. eapply analysis_correct_1; eauto. simpl; auto. - unfold transfer; rewrite H. - eapply add_op_holds; eauto. + unfold transfer; rewrite H. + eapply add_op_holds; eauto. apply set_reg_lessdef; auto. eapply Val.lessdef_trans; eauto. * (* possibly simplified *) destruct (reduce operation combine_op n1 op args vl) as [op' args'] eqn:?. assert (RES: eval_operation ge sp op' rs##args' m = Some v). - eapply reduce_sound with (sem := fun op vl => eval_operation ge sp op vl m); eauto. + eapply reduce_sound with (sem := fun op vl => eval_operation ge sp op vl m); eauto. intros; eapply combine_op_sound; eauto. exploit eval_operation_lessdef. eapply regs_lessdef_regs; eauto. eauto. eauto. intros [v' [A B]]. econstructor; split. - eapply exec_Iop with (v := v'); eauto. + eapply exec_Iop with (v := v'); eauto. rewrite <- A. apply eval_operation_preserved. exact symbols_preserved. econstructor; eauto. eapply analysis_correct_1; eauto. simpl; auto. - unfold transfer; rewrite H. - eapply add_op_holds; eauto. - apply set_reg_lessdef; auto. + unfold transfer; rewrite H. + eapply add_op_holds; eauto. + apply set_reg_lessdef; auto. - (* Iload *) destruct (valnum_regs approx!!pc args) as [n1 vl] eqn:?. @@ -1030,31 +1030,31 @@ Proof. exploit valnum_regs_holds; eauto. intros (valu2 & NH2 & EQ & AG & P & Q). destruct (find_rhs n1 (Load chunk addr vl)) as [r|] eqn:?. + (* replaced by move *) - exploit find_rhs_sound; eauto. intros (v' & EV & LD). + exploit find_rhs_sound; eauto. intros (v' & EV & LD). assert (v' = v) by (inv EV; congruence). subst v'. econstructor; split. eapply exec_Iop; eauto. simpl; eauto. - econstructor; eauto. + econstructor; eauto. eapply analysis_correct_1; eauto. simpl; auto. - unfold transfer; rewrite H. - eapply add_load_holds; eauto. + unfold transfer; rewrite H. + eapply add_load_holds; eauto. apply set_reg_lessdef; auto. eapply Val.lessdef_trans; eauto. + (* load is preserved, but addressing is possibly simplified *) destruct (reduce addressing combine_addr n1 addr args vl) as [addr' args'] eqn:?. assert (ADDR: eval_addressing ge sp addr' rs##args' = Some a). - { eapply reduce_sound with (sem := fun addr vl => eval_addressing ge sp addr vl); eauto. + { eapply reduce_sound with (sem := fun addr vl => eval_addressing ge sp addr vl); eauto. intros; eapply combine_addr_sound; eauto. } exploit eval_addressing_lessdef. apply regs_lessdef_regs; eauto. eexact ADDR. intros [a' [A B]]. assert (ADDR': eval_addressing tge sp addr' rs'##args' = Some a'). { rewrite <- A. apply eval_addressing_preserved. exact symbols_preserved. } - exploit Mem.loadv_extends; eauto. + exploit Mem.loadv_extends; eauto. intros [v' [X Y]]. econstructor; split. eapply exec_Iload; eauto. econstructor; eauto. - eapply analysis_correct_1; eauto. simpl; auto. - unfold transfer; rewrite H. + eapply analysis_correct_1; eauto. simpl; auto. + unfold transfer; rewrite H. eapply add_load_holds; eauto. apply set_reg_lessdef; auto. @@ -1064,7 +1064,7 @@ Proof. exploit valnum_regs_holds; eauto. intros (valu2 & NH2 & EQ & AG & P & Q). destruct (reduce addressing combine_addr n1 addr args vl) as [addr' args'] eqn:?. assert (ADDR: eval_addressing ge sp addr' rs##args' = Some a). - { eapply reduce_sound with (sem := fun addr vl => eval_addressing ge sp addr vl); eauto. + { eapply reduce_sound with (sem := fun addr vl => eval_addressing ge sp addr vl); eauto. intros; eapply combine_addr_sound; eauto. } exploit eval_addressing_lessdef. apply regs_lessdef_regs; eauto. eexact ADDR. intros [a' [A B]]. @@ -1074,35 +1074,35 @@ Proof. econstructor; split. eapply exec_Istore; eauto. econstructor; eauto. - eapply analysis_correct_1; eauto. simpl; auto. + eapply analysis_correct_1; eauto. simpl; auto. unfold transfer; rewrite H. inv SOUND. - eapply add_store_result_hold; eauto. + eapply add_store_result_hold; eauto. eapply kill_loads_after_store_holds; eauto. - (* Icall *) - exploit find_function_translated; eauto. intros [tf [FIND' TRANSF']]. + exploit find_function_translated; eauto. intros [tf [FIND' TRANSF']]. econstructor; split. eapply exec_Icall; eauto. apply sig_preserved; auto. - econstructor; eauto. - econstructor; eauto. - intros. eapply analysis_correct_1; eauto. simpl; auto. - unfold transfer; rewrite H. + econstructor; eauto. + econstructor; eauto. + intros. eapply analysis_correct_1; eauto. simpl; auto. + unfold transfer; rewrite H. exists (fun _ => Vundef); apply empty_numbering_holds. apply regs_lessdef_regs; auto. - (* Itailcall *) - exploit find_function_translated; eauto. intros [tf [FIND' TRANSF']]. + exploit find_function_translated; eauto. intros [tf [FIND' TRANSF']]. exploit Mem.free_parallel_extends; eauto. intros [m'' [A B]]. econstructor; split. eapply exec_Itailcall; eauto. apply sig_preserved; auto. - econstructor; eauto. + econstructor; eauto. apply regs_lessdef_regs; auto. - (* Ibuiltin *) - exploit (@eval_builtin_args_lessdef _ ge (fun r => rs#r) (fun r => rs'#r)); eauto. + exploit (@eval_builtin_args_lessdef _ ge (fun r => rs#r) (fun r => rs'#r)); eauto. intros (vargs' & A & B). exploit external_call_mem_extends; eauto. intros (v' & m1' & P & Q & R & S). @@ -1124,7 +1124,7 @@ Proof. { exists valu. apply set_res_unknown_holds. eapply kill_all_loads_hold; eauto. } destruct ef. + apply CASE1. - + apply CASE3. + + apply CASE3. + apply CASE2; inv H1; auto. + apply CASE3. + apply CASE1. @@ -1133,15 +1133,15 @@ Proof. simpl in H1. inv H1. exists valu. apply set_res_unknown_holds. - inv SOUND. unfold vanalyze, rm; rewrite AN. + inv SOUND. unfold vanalyze, rm; rewrite AN. assert (pmatch bc bsrc osrc (aaddr_arg (VA.State ae am) a0)) - by (eapply aaddr_arg_sound_1; eauto). + by (eapply aaddr_arg_sound_1; eauto). assert (pmatch bc bdst odst (aaddr_arg (VA.State ae am) a1)) - by (eapply aaddr_arg_sound_1; eauto). - eapply add_memcpy_holds; eauto. - eapply kill_loads_after_storebytes_holds; eauto. - eapply Mem.loadbytes_length; eauto. - simpl. apply Ple_refl. + by (eapply aaddr_arg_sound_1; eauto). + eapply add_memcpy_holds; eauto. + eapply kill_loads_after_storebytes_holds; eauto. + eapply Mem.loadbytes_length; eauto. + simpl. apply Ple_refl. + apply CASE2; inv H1; auto. + apply CASE2; inv H1; auto. + apply CASE1. @@ -1154,10 +1154,10 @@ Proof. exploit valnum_regs_holds; eauto. intros (valu2 & NH2 & EQ & AG & P & Q). destruct (reduce condition combine_cond n1 cond args vl) as [cond' args'] eqn:?. assert (RES: eval_condition cond' rs##args' m = Some b). - { eapply reduce_sound with (sem := fun cond vl => eval_condition cond vl m); eauto. + { eapply reduce_sound with (sem := fun cond vl => eval_condition cond vl m); eauto. intros; eapply combine_cond_sound; eauto. } econstructor; split. - eapply exec_Icond; eauto. + eapply exec_Icond; eauto. eapply eval_condition_lessdef; eauto. apply regs_lessdef_regs; auto. econstructor; eauto. destruct b; eapply analysis_correct_1; eauto; simpl; auto; @@ -1166,7 +1166,7 @@ Proof. - (* Ijumptable *) generalize (RLD arg); rewrite H0; intro LD; inv LD. econstructor; split. - eapply exec_Ijumptable; eauto. + eapply exec_Ijumptable; eauto. econstructor; eauto. eapply analysis_correct_1; eauto. simpl. eapply list_nth_z_in; eauto. unfold transfer; rewrite H; auto. @@ -1176,21 +1176,21 @@ Proof. econstructor; split. eapply exec_Ireturn; eauto. econstructor; eauto. - destruct or; simpl; auto. + destruct or; simpl; auto. - (* internal function *) - monadInv H6. unfold transf_function in EQ. - destruct (analyze f (vanalyze rm f)) as [approx|] eqn:?; inv EQ. - exploit Mem.alloc_extends; eauto. apply Zle_refl. apply Zle_refl. + monadInv H6. unfold transf_function in EQ. + destruct (analyze f (vanalyze rm f)) as [approx|] eqn:?; inv EQ. + exploit Mem.alloc_extends; eauto. apply Zle_refl. apply Zle_refl. intros (m'' & A & B). econstructor; split. - eapply exec_function_internal; simpl; eauto. + eapply exec_function_internal; simpl; eauto. simpl. econstructor; eauto. eapply analysis_correct_entry; eauto. apply init_regs_lessdef; auto. - (* external function *) - monadInv H6. + monadInv H6. exploit external_call_mem_extends; eauto. intros (v' & m1' & P & Q & R & S). econstructor; split. @@ -1211,7 +1211,7 @@ Lemma transf_initial_states: forall st1, initial_state prog st1 -> exists st2, initial_state tprog st2 /\ match_states st1 st2. Proof. - intros. inversion H. + intros. inversion H. exploit funct_ptr_translated; eauto. intros [tf [A B]]. exists (Callstate nil tf nil m0); split. econstructor; eauto. @@ -1224,10 +1224,10 @@ Proof. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> final_state st1 r -> final_state st2 r. Proof. - intros. inv H0. inv H. inv H5. inv H3. constructor. + intros. inv H0. inv H. inv H5. inv H3. constructor. Qed. Theorem transf_program_correct: @@ -1236,10 +1236,10 @@ Proof. eapply forward_simulation_step with (match_states := fun s1 s2 => sound_state prog s1 /\ match_states s1 s2). - eexact public_preserved. -- intros. exploit transf_initial_states; eauto. intros [s2 [A B]]. +- intros. exploit transf_initial_states; eauto. intros [s2 [A B]]. exists s2. split. auto. split. apply sound_initial; auto. auto. - intros. destruct H. eapply transf_final_states; eauto. -- intros. destruct H0. exploit transf_step_correct; eauto. +- intros. destruct H0. exploit transf_step_correct; eauto. intros [s2' [A B]]. exists s2'; split. auto. split. eapply sound_step; eauto. auto. Qed. diff --git a/backend/CleanupLabels.v b/backend/CleanupLabels.v index 5eaa81e6..759201b2 100644 --- a/backend/CleanupLabels.v +++ b/backend/CleanupLabels.v @@ -11,12 +11,12 @@ (* *********************************************************************) (** Removal of useless labels introduced by the linearization pass. - - The linearization pass introduces one label for each node of the + + The linearization pass introduces one label for each node of the control-flow graph. Many of these labels are never branched to, which can complicate further optimizations over linearized code. (There are no such optimizations yet.) In preparation for these - further optimizations, and to make the generated Linear code + further optimizations, and to make the generated Linear code better-looking, the present pass removes labels that cannot be branched to. *) diff --git a/backend/CleanupLabelsproof.v b/backend/CleanupLabelsproof.v index 1e93dd7a..6f33c9c2 100644 --- a/backend/CleanupLabelsproof.v +++ b/backend/CleanupLabelsproof.v @@ -39,21 +39,21 @@ Let tge := Genv.globalenv tprog. Lemma symbols_preserved: forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s. Proof. - intros; unfold ge, tge, tprog, transf_program. + intros; unfold ge, tge, tprog, transf_program. apply Genv.find_symbol_transf. Qed. Lemma public_preserved: forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s. Proof. - intros; unfold ge, tge, tprog, transf_program. + intros; unfold ge, tge, tprog, transf_program. apply Genv.public_symbol_transf. Qed. Lemma varinfo_preserved: forall b, Genv.find_var_info tge b = Genv.find_var_info ge b. Proof. - intros; unfold ge, tge, tprog, transf_program. + intros; unfold ge, tge, tprog, transf_program. apply Genv.find_var_info_transf. Qed. @@ -61,7 +61,7 @@ Lemma functions_translated: forall (v: val) (f: fundef), Genv.find_funct ge v = Some f -> Genv.find_funct tge v = Some (transf_fundef f). -Proof. +Proof. intros. exact (Genv.find_funct_transf transf_fundef _ _ H). Qed. @@ -70,8 +70,8 @@ Lemma function_ptr_translated: forall (b: block) (f: fundef), Genv.find_funct_ptr ge b = Some f -> Genv.find_funct_ptr tge b = Some (transf_fundef f). -Proof. - intros. +Proof. + intros. exact (Genv.find_funct_ptr_transf transf_fundef _ _ H). Qed. @@ -121,7 +121,7 @@ Proof. destruct i; simpl; intros; try contradiction. apply Labelset.add_1; auto. apply Labelset.add_1; auto. - revert H. induction l; simpl; intros. + revert H. induction l; simpl; intros. contradiction. destruct H. apply Labelset.add_1; auto. apply Labelset.add_2; auto. Qed. @@ -141,8 +141,8 @@ Proof. In i c' -> Labelset.In lbl (fold_left add_label_branched_to c' bto)). induction c'; simpl; intros. contradiction. - destruct H2. - subst a. apply H1. apply add_label_branched_to_contains; auto. + destruct H2. + subst a. apply H1. apply add_label_branched_to_contains; auto. apply IHc'; auto. unfold labels_branched_to. auto. @@ -152,7 +152,7 @@ Qed. Lemma remove_unused_labels_cons: forall bto i c, - remove_unused_labels bto (i :: c) = + remove_unused_labels bto (i :: c) = match i with | Llabel lbl => if Labelset.mem lbl bto then i :: remove_unused_labels bto c else remove_unused_labels bto c @@ -160,7 +160,7 @@ Lemma remove_unused_labels_cons: i :: remove_unused_labels bto c end. Proof. - unfold remove_unused_labels; intros. rewrite list_fold_right_eq. auto. + unfold remove_unused_labels; intros. rewrite list_fold_right_eq. auto. Qed. @@ -176,9 +176,9 @@ Proof. rewrite remove_unused_labels_cons. unfold is_label in H0. destruct a; simpl; auto. destruct (peq lbl l). subst l. inv H0. - rewrite Labelset.mem_1; auto. + rewrite Labelset.mem_1; auto. simpl. rewrite peq_true. auto. - destruct (Labelset.mem l bto); auto. simpl. rewrite peq_false; auto. + destruct (Labelset.mem l bto); auto. simpl. rewrite peq_false; auto. Qed. Corollary find_label_translated: @@ -189,8 +189,8 @@ Corollary find_label_translated: find_label lbl (fn_code (transf_function f)) = Some (remove_unused_labels (labels_branched_to (fn_code f)) c). Proof. - intros. unfold transf_function; unfold cleanup_labels; simpl. - apply find_label_commut. eapply labels_branched_to_correct; eauto. + intros. unfold transf_function; unfold cleanup_labels; simpl. + apply find_label_commut. eapply labels_branched_to_correct; eauto. apply H; auto with coqlib. auto. Qed. @@ -211,7 +211,7 @@ Inductive match_stackframes: stackframe -> stackframe -> Prop := incl c f.(fn_code) -> match_stackframes (Stackframe f sp ls c) - (Stackframe (transf_function f) sp ls + (Stackframe (transf_function f) sp ls (remove_unused_labels (labels_branched_to f.(fn_code)) c)). Inductive match_states: state -> state -> Prop := @@ -252,14 +252,14 @@ Theorem transf_step_correct: (exists s2', step tge s1' t s2' /\ match_states s2 s2') \/ (measure s2 < measure s1 /\ t = E0 /\ match_states s2 s1')%nat. Proof. - induction 1; intros; inv MS; try rewrite remove_unused_labels_cons. + induction 1; intros; inv MS; try rewrite remove_unused_labels_cons. (* Lgetstack *) left; econstructor; split. - econstructor; eauto. + econstructor; eauto. econstructor; eauto with coqlib. (* Lsetstack *) left; econstructor; split. - econstructor; eauto. + econstructor; eauto. econstructor; eauto with coqlib. (* Lop *) left; econstructor; split. @@ -270,7 +270,7 @@ Proof. assert (eval_addressing tge sp addr (LTL.reglist rs args) = Some a). rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. left; econstructor; split. - econstructor; eauto. + econstructor; eauto. econstructor; eauto with coqlib. (* Lstore *) assert (eval_addressing tge sp addr (LTL.reglist rs args) = Some a). @@ -280,14 +280,14 @@ Proof. econstructor; eauto with coqlib. (* Lcall *) left; econstructor; split. - econstructor. eapply find_function_translated; eauto. + econstructor. eapply find_function_translated; eauto. symmetry; apply sig_function_translated. econstructor; eauto. constructor; auto. constructor; eauto with coqlib. (* Ltailcall *) left; econstructor; split. - econstructor. erewrite match_parent_locset; eauto. eapply find_function_translated; eauto. + econstructor. erewrite match_parent_locset; eauto. eapply find_function_translated; eauto. symmetry; apply sig_function_translated. - simpl. eauto. + simpl. eauto. econstructor; eauto. (* Lbuiltin *) left; econstructor; split. @@ -307,11 +307,11 @@ Proof. right. split. simpl. omega. split. auto. econstructor; eauto with coqlib. (* Lgoto *) left; econstructor; split. - econstructor. eapply find_label_translated; eauto. red; auto. + econstructor. eapply find_label_translated; eauto. red; auto. econstructor; eauto. eapply find_label_incl; eauto. (* Lcond taken *) left; econstructor; split. - econstructor. auto. eauto. eapply find_label_translated; eauto. red; auto. + econstructor. auto. eauto. eapply find_label_translated; eauto. red; auto. econstructor; eauto. eapply find_label_incl; eauto. (* Lcond not taken *) left; econstructor; split. @@ -319,8 +319,8 @@ Proof. econstructor; eauto with coqlib. (* Ljumptable *) left; econstructor; split. - econstructor. eauto. eauto. eapply find_label_translated; eauto. - red. eapply list_nth_z_in; eauto. eauto. + econstructor. eauto. eauto. eapply find_label_translated; eauto. + red. eapply list_nth_z_in; eauto. eauto. econstructor; eauto. eapply find_label_incl; eauto. (* Lreturn *) left; econstructor; split. @@ -329,7 +329,7 @@ Proof. econstructor; eauto with coqlib. (* internal function *) left; econstructor; split. - econstructor; simpl; eauto. + econstructor; simpl; eauto. econstructor; eauto with coqlib. (* external function *) left; econstructor; split. @@ -338,7 +338,7 @@ Proof. econstructor; eauto with coqlib. (* return *) inv H3. inv H1. left; econstructor; split. - econstructor; eauto. + econstructor; eauto. econstructor; eauto. Qed. @@ -349,7 +349,7 @@ Proof. intros. inv H. econstructor; split. eapply initial_state_intro with (f := transf_fundef f). - eapply Genv.init_mem_transf; eauto. + eapply Genv.init_mem_transf; eauto. rewrite symbols_preserved; eauto. apply function_ptr_translated; auto. rewrite sig_function_translated. auto. @@ -357,7 +357,7 @@ Proof. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> final_state st1 r -> final_state st2 r. Proof. intros. inv H0. inv H. inv H6. econstructor; eauto. diff --git a/backend/Cminor.v b/backend/Cminor.v index 7ac23bfa..0d959531 100644 --- a/backend/Cminor.v +++ b/backend/Cminor.v @@ -241,7 +241,7 @@ Inductive state: Type := (k: cont) (**r what to do next *) (m: mem), (**r memory state *) state. - + Section RELSEM. Variable ge: genv. @@ -378,7 +378,7 @@ Inductive eval_expr: expr -> val -> Prop := eval_expr (Ebinop op a1 a2) v | eval_Eload: forall chunk addr vaddr v, eval_expr addr vaddr -> - Mem.loadv chunk m vaddr = Some v -> + Mem.loadv chunk m vaddr = Some v -> eval_expr (Eload chunk addr) v. Inductive eval_exprlist: list expr -> list val -> Prop := @@ -406,10 +406,10 @@ Definition is_call_cont (k: cont) : Prop := | _ => False end. -(** Find the statement and manufacture the continuation +(** Find the statement and manufacture the continuation corresponding to a label *) -Fixpoint find_label (lbl: label) (s: stmt) (k: cont) +Fixpoint find_label (lbl: label) (s: stmt) (k: cont) {struct s}: option (stmt * cont) := match s with | Sseq s1 s2 => @@ -543,7 +543,7 @@ Inductive step: state -> trace -> state -> Prop := | step_external_function: forall ef vargs k m t vres m', external_call ef ge vargs m t vres m' -> step (Callstate (External ef) vargs k m) - t (Returnstate vres k m') + t (Returnstate vres k m') | step_return: forall v optid f sp e k m, step (Returnstate v (Kcall optid f sp e k) m) @@ -586,9 +586,9 @@ Proof. assert (t1 = E0 -> exists s2, step (Genv.globalenv p) s t2 s2). intros. subst. inv H0. exists s1; auto. inversion H; subst; auto. - exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. - exists (State f Sskip k sp (set_optvar optid vres2 e) m2). econstructor; eauto. - exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. + exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. + exists (State f Sskip k sp (set_optvar optid vres2 e) m2). econstructor; eauto. + exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. exists (Returnstate vres2 k m2). econstructor; eauto. (* trace length *) red; intros; inv H; simpl; try omega; eapply external_call_trace_length; eauto. @@ -598,7 +598,7 @@ Qed. (** We now define another semantics for Cminor without [goto] that follows the ``big-step'' style of semantics, also known as natural semantics. - In this style, just like expressions evaluate to values, + In this style, just like expressions evaluate to values, statements evaluate to``outcomes'' indicating how execution should proceed afterwards. *) @@ -758,7 +758,7 @@ with exec_stmt: Scheme eval_funcall_ind2 := Minimality for eval_funcall Sort Prop with exec_stmt_ind2 := Minimality for exec_stmt Sort Prop. -Combined Scheme eval_funcall_exec_stmt_ind2 +Combined Scheme eval_funcall_exec_stmt_ind2 from eval_funcall_ind2, exec_stmt_ind2. (** Coinductive semantics for divergence. @@ -871,22 +871,22 @@ Inductive outcome_state_match (sp: val) (e: env) (m: mem) (f: function) (k: cont): outcome -> state -> Prop := | osm_normal: - outcome_state_match sp e m f k + outcome_state_match sp e m f k Out_normal (State f Sskip k sp e m) | osm_exit: forall n, - outcome_state_match sp e m f k + outcome_state_match sp e m f k (Out_exit n) (State f (Sexit n) k sp e m) | osm_return_none: forall k', call_cont k' = call_cont k -> - outcome_state_match sp e m f k + outcome_state_match sp e m f k (Out_return None) (State f (Sreturn None) k' sp e m) | osm_return_some: forall k' a v, call_cont k' = call_cont k -> eval_expr ge sp e m a v -> - outcome_state_match sp e m f k + outcome_state_match sp e m f k (Out_return (Some v)) (State f (Sreturn (Some a)) k' sp e m) | osm_tail: forall v, @@ -925,11 +925,11 @@ Proof. (* funcall internal *) destruct (H2 k) as [S [A B]]. assert (call_cont k = k) by (apply call_cont_is_call_cont; auto). - eapply star_left. econstructor; eauto. + eapply star_left. econstructor; eauto. eapply star_trans. eexact A. inversion B; clear B; subst out; simpl in H3; simpl; try contradiction. (* Out normal *) - subst vres. apply star_one. apply step_skip_call; auto. + subst vres. apply star_one. apply step_skip_call; auto. (* Out_return None *) subst vres. replace k with (call_cont k') by congruence. apply star_one. apply step_return_0; auto. @@ -943,11 +943,11 @@ Proof. reflexivity. traceEq. (* funcall external *) - apply star_one. constructor; auto. + apply star_one. constructor; auto. (* skip *) econstructor; split. - apply star_refl. + apply star_refl. constructor. (* assign *) @@ -962,14 +962,14 @@ Proof. (* call *) econstructor; split. - eapply star_left. econstructor; eauto. - eapply star_right. apply H4. red; auto. + eapply star_left. econstructor; eauto. + eapply star_right. apply H4. red; auto. constructor. reflexivity. traceEq. subst e'. constructor. (* builtin *) econstructor; split. - apply star_one. econstructor; eauto. + apply star_one. econstructor; eauto. subst e'. constructor. (* ifthenelse *) @@ -985,8 +985,8 @@ Proof. destruct (H2 k) as [S2 [A2 B2]]. inv B1. exists S2; split. - eapply star_left. constructor. - eapply star_trans. eexact A1. + eapply star_left. constructor. + eapply star_trans. eexact A1. eapply star_left. constructor. eexact A2. reflexivity. reflexivity. traceEq. auto. @@ -1010,8 +1010,8 @@ Proof. destruct (H2 k) as [S2 [A2 B2]]. inv B1. exists S2; split. - eapply star_left. constructor. - eapply star_trans. eexact A1. + eapply star_left. constructor. + eapply star_trans. eexact A1. eapply star_left. constructor. eexact A2. reflexivity. reflexivity. traceEq. auto. @@ -1063,9 +1063,9 @@ Proof. (* tailcall *) econstructor; split. - eapply star_left. econstructor; eauto. + eapply star_left. econstructor; eauto. apply H5. apply is_call_cont_call_cont. traceEq. - econstructor. + econstructor. Qed. Lemma eval_funcall_steps: @@ -1100,12 +1100,12 @@ Proof. (* call *) eapply forever_plus_intro. - apply plus_one. econstructor; eauto. + apply plus_one. econstructor; eauto. apply CIH_FUN. eauto. traceEq. (* ifthenelse *) eapply forever_plus_intro with (s2 := State f (if b then s1 else s2) k sp e m). - apply plus_one. econstructor; eauto. + apply plus_one. econstructor; eauto. apply CIH_STMT. eauto. traceEq. (* seq 1 *) @@ -1118,9 +1118,9 @@ Proof. as [S [A B]]. inv B. eapply forever_plus_intro. eapply plus_left. constructor. - eapply star_right. eexact A. constructor. + eapply star_right. eexact A. constructor. reflexivity. reflexivity. - apply CIH_STMT. eauto. traceEq. + apply CIH_STMT. eauto. traceEq. (* loop body *) eapply forever_plus_intro. @@ -1132,7 +1132,7 @@ Proof. as [S [A B]]. inv B. eapply forever_plus_intro. eapply plus_left. constructor. - eapply star_right. eexact A. constructor. + eapply star_right. eexact A. constructor. reflexivity. reflexivity. apply CIH_STMT. eauto. traceEq. @@ -1143,14 +1143,14 @@ Proof. (* tailcall *) eapply forever_plus_intro. - apply plus_one. econstructor; eauto. + apply plus_one. econstructor; eauto. apply CIH_FUN. eauto. traceEq. (* function call *) intros. inv H0. eapply forever_plus_intro. apply plus_one. econstructor; eauto. - apply H. eauto. + apply H. eauto. traceEq. Qed. @@ -1160,12 +1160,12 @@ Proof. constructor; intros. (* termination *) inv H. econstructor; econstructor. - split. econstructor; eauto. - split. apply eval_funcall_steps. eauto. red; auto. + split. econstructor; eauto. + split. apply eval_funcall_steps. eauto. red; auto. econstructor. (* divergence *) inv H. econstructor. - split. econstructor; eauto. + split. econstructor; eauto. eapply forever_plus_forever. eapply evalinf_funcall_forever; eauto. Qed. diff --git a/backend/CminorSel.v b/backend/CminorSel.v index 6a43eccd..d654502b 100644 --- a/backend/CminorSel.v +++ b/backend/CminorSel.v @@ -174,7 +174,7 @@ Inductive eval_expr: letenv -> expr -> val -> Prop := | eval_Eload: forall le chunk addr al vl vaddr v, eval_exprlist le al vl -> eval_addressing ge sp addr vl = Some vaddr -> - Mem.loadv chunk m vaddr = Some v -> + Mem.loadv chunk m vaddr = Some v -> eval_expr le (Eload chunk addr al) v | eval_Econdition: forall le a b c va v, eval_condexpr le a va -> @@ -300,10 +300,10 @@ Definition is_call_cont (k: cont) : Prop := | _ => False end. -(** Find the statement and manufacture the continuation +(** Find the statement and manufacture the continuation corresponding to a label *) -Fixpoint find_label (lbl: label) (s: stmt) (k: cont) +Fixpoint find_label (lbl: label) (s: stmt) (k: cont) {struct s}: option (stmt * cont) := match s with | Sseq s1 s2 => @@ -436,7 +436,7 @@ Inductive step: state -> trace -> state -> Prop := | step_external_function: forall ef vargs k m t vres m', external_call ef ge vargs m t vres m' -> step (Callstate (External ef) vargs k m) - t (Returnstate vres k m') + t (Returnstate vres k m') | step_return: forall v optid f sp e k m, step (Returnstate v (Kcall optid f sp e k) m) @@ -519,7 +519,7 @@ Lemma insert_lenv_lookup1: Proof. induction 1; intros. omegaContradiction. - destruct n; simpl; simpl in H0. auto. + destruct n; simpl; simpl in H0. auto. apply IHinsert_lenv. auto. omega. Qed. @@ -532,7 +532,7 @@ Lemma insert_lenv_lookup2: Proof. induction 1; intros. simpl. assumption. - simpl. destruct n. omegaContradiction. + simpl. destruct n. omegaContradiction. apply IHinsert_lenv. exact H0. omega. Qed. @@ -559,7 +559,7 @@ Proof. eapply eval_Elet. eauto. apply H2. apply insert_lenv_S; auto. - case (le_gt_dec p n); intro. + case (le_gt_dec p n); intro. apply eval_Eletvar. eapply insert_lenv_lookup2; eauto. apply eval_Eletvar. eapply insert_lenv_lookup1; eauto. @@ -573,7 +573,7 @@ Lemma eval_lift: eval_expr ge sp e m (w::le) (lift a) v. Proof. intros. unfold lift. eapply eval_lift_expr. - eexact H. apply insert_lenv_0. + eexact H. apply insert_lenv_0. Qed. Hint Resolve eval_lift: evalexpr. diff --git a/backend/Constprop.v b/backend/Constprop.v index 8f4cb76d..5ca69183 100644 --- a/backend/Constprop.v +++ b/backend/Constprop.v @@ -183,12 +183,12 @@ Definition transf_instr (f: function) (an: PMap.t VA.t) (rm: romem) Iop cop nil dst s | None => let (addr', args') := addr_strength_reduction addr args aargs in - Iload chunk addr' args' dst s + Iload chunk addr' args' dst s end | Istore chunk addr args src s => let aargs := aregs ae args in let (addr', args') := addr_strength_reduction addr args aargs in - Istore chunk addr' args' src s + Istore chunk addr' args' src s | Icall sig ros args res s => Icall sig (transf_ros ae ros) args res s | Itailcall sig ros args => diff --git a/backend/Constpropproof.v b/backend/Constpropproof.v index eafefed5..ad9068ab 100644 --- a/backend/Constpropproof.v +++ b/backend/Constpropproof.v @@ -50,21 +50,21 @@ Let rm := romem_for_program prog. Lemma symbols_preserved: forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s. Proof. - intros; unfold ge, tge, tprog, transf_program. + intros; unfold ge, tge, tprog, transf_program. apply Genv.find_symbol_transf. Qed. Lemma public_preserved: forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s. Proof. - intros; unfold ge, tge, tprog, transf_program. + intros; unfold ge, tge, tprog, transf_program. apply Genv.public_symbol_transf. Qed. Lemma varinfo_preserved: forall b, Genv.find_var_info tge b = Genv.find_var_info ge b. Proof. - intros; unfold ge, tge, tprog, transf_program. + intros; unfold ge, tge, tprog, transf_program. apply Genv.find_var_info_transf. Qed. @@ -72,7 +72,7 @@ Lemma functions_translated: forall (v: val) (f: fundef), Genv.find_funct ge v = Some f -> Genv.find_funct tge v = Some (transf_fundef rm f). -Proof. +Proof. intros. exact (Genv.find_funct_transf (transf_fundef rm) _ _ H). Qed. @@ -81,8 +81,8 @@ Lemma function_ptr_translated: forall (b: block) (f: fundef), Genv.find_funct_ptr ge b = Some f -> Genv.find_funct_ptr tge b = Some (transf_fundef rm f). -Proof. - intros. +Proof. + intros. exact (Genv.find_funct_ptr_transf (transf_fundef rm) _ _ H). Qed. @@ -117,19 +117,19 @@ Proof. generalize (EM r); fold (areg ae r); intro VM. generalize (RLD r); intro LD. assert (DEFAULT: find_function tge (inl _ r) rs' = Some (transf_fundef rm f)). { - simpl. inv LD. apply functions_translated; auto. rewrite <- H0 in FF; discriminate. + simpl. inv LD. apply functions_translated; auto. rewrite <- H0 in FF; discriminate. } - destruct (areg ae r); auto. destruct p; auto. - predSpec Int.eq Int.eq_spec ofs Int.zero; intros; auto. + destruct (areg ae r); auto. destruct p; auto. + predSpec Int.eq Int.eq_spec ofs Int.zero; intros; auto. subst ofs. exploit vmatch_ptr_gl; eauto. intros LD'. inv LD'; try discriminate. - rewrite H1 in FF. unfold Genv.symbol_address in FF. + rewrite H1 in FF. unfold Genv.symbol_address in FF. simpl. rewrite symbols_preserved. destruct (Genv.find_symbol ge id) as [b|]; try discriminate. simpl in FF. rewrite dec_eq_true in FF. apply function_ptr_translated; auto. rewrite <- H0 in FF; discriminate. - (* function symbol *) - rewrite symbols_preserved. + rewrite symbols_preserved. destruct (Genv.find_symbol ge i) as [b|]; try discriminate. apply function_ptr_translated; auto. Qed. @@ -155,11 +155,11 @@ Proof. + (* global *) inv H. exists (Genv.symbol_address ge id ofs); split. unfold Genv.symbol_address. rewrite <- symbols_preserved. reflexivity. - eapply vmatch_ptr_gl; eauto. + eapply vmatch_ptr_gl; eauto. + (* stack *) - inv H. exists (Vptr sp ofs); split. - simpl; rewrite Int.add_zero_l; auto. - eapply vmatch_ptr_stk; eauto. + inv H. exists (Vptr sp ofs); split. + simpl; rewrite Int.add_zero_l; auto. + eapply vmatch_ptr_stk; eauto. Qed. Inductive match_pc (f: function) (ae: AE.t): nat -> node -> node -> Prop := @@ -200,14 +200,14 @@ Lemma builtin_arg_reduction_correct: eval_builtin_arg ge (fun r => rs#r) sp m (builtin_arg_reduction ae a) v. Proof. induction 2; simpl; eauto with barg. -- specialize (H x). unfold areg. destruct (AE.get x ae); try constructor. +- specialize (H x). unfold areg. destruct (AE.get x ae); try constructor. + inv H. constructor. + inv H. constructor. + destruct (Compopts.generate_float_constants tt); [inv H|idtac]; constructor. + destruct (Compopts.generate_float_constants tt); [inv H|idtac]; constructor. - destruct (builtin_arg_reduction ae hi); auto with barg. destruct (builtin_arg_reduction ae lo); auto with barg. - inv IHeval_builtin_arg1; inv IHeval_builtin_arg2. constructor. + inv IHeval_builtin_arg1; inv IHeval_builtin_arg2. constructor. Qed. Lemma builtin_arg_strength_reduction_correct: @@ -216,7 +216,7 @@ Lemma builtin_arg_strength_reduction_correct: eval_builtin_arg ge (fun r => rs#r) sp m a v -> eval_builtin_arg ge (fun r => rs#r) sp m (builtin_arg_strength_reduction ae a c) v. Proof. - intros. unfold builtin_arg_strength_reduction. + intros. unfold builtin_arg_strength_reduction. destruct (builtin_arg_ok (builtin_arg_reduction ae a) c). eapply builtin_arg_reduction_correct; eauto. auto. @@ -231,7 +231,7 @@ Lemma builtin_args_strength_reduction_correct: Proof. induction 2; simpl; constructor. eapply builtin_arg_strength_reduction_correct; eauto. - apply IHlist_forall2. + apply IHlist_forall2. Qed. Lemma debug_strength_reduction_correct: @@ -247,7 +247,7 @@ Proof. (a1 :: debug_strength_reduction ae al) (b1 :: vl')) by (constructor; eauto). destruct a1; try (econstructor; eassumption). - destruct (builtin_arg_reduction ae (BA x)); repeat (eauto; econstructor). + destruct (builtin_arg_reduction ae (BA x)); repeat (eauto; econstructor). Qed. Lemma builtin_strength_reduction_correct: @@ -259,7 +259,7 @@ Lemma builtin_strength_reduction_correct: eval_builtin_args ge (fun r => rs#r) sp m (builtin_strength_reduction ae ef args) vargs' /\ external_call ef ge vargs' m t vres m'. Proof. - intros. + intros. assert (DEFAULT: forall cl, exists vargs', eval_builtin_args ge (fun r => rs#r) sp m (builtin_args_strength_reduction ae args cl) vargs' @@ -267,8 +267,8 @@ Proof. { exists vargs; split; auto. eapply builtin_args_strength_reduction_correct; eauto. } unfold builtin_strength_reduction. destruct ef; auto. - exploit debug_strength_reduction_correct; eauto. intros (vargs' & P). - exists vargs'; split; auto. + exploit debug_strength_reduction_correct; eauto. intros (vargs' & P). + exists vargs'; split; auto. inv H1; constructor. Qed. @@ -341,8 +341,8 @@ Lemma match_states_succ: match_states O (State s f sp pc rs m) (State s' (transf_function rm f) sp pc rs' m'). Proof. - intros. inv H. - apply match_states_intro with (bc := bc) (ae := ae); auto. + intros. inv H. + apply match_states_intro with (bc := bc) (ae := ae); auto. constructor. Qed. @@ -351,7 +351,7 @@ Lemma transf_instr_at: f.(fn_code)!pc = Some i -> (transf_function rm f).(fn_code)!pc = Some(transf_instr f (analyze rm f) rm pc i). Proof. - intros. simpl. rewrite PTree.gmap. rewrite H. auto. + intros. simpl. rewrite PTree.gmap. rewrite H. auto. Qed. Ltac TransfInstr := @@ -374,7 +374,7 @@ Proof. induction 1; intros; inv SS1; inv MS; try (inv PC; try congruence). (* Inop, preserved *) - rename pc'0 into pc. TransfInstr; intros. + rename pc'0 into pc. TransfInstr; intros. left; econstructor; econstructor; split. eapply exec_Inop; eauto. eapply match_states_succ; eauto. @@ -389,14 +389,14 @@ Proof. set (a := eval_static_operation op (aregs ae args)). set (ae' := AE.set res a ae). assert (VMATCH: vmatch bc v a) by (eapply eval_static_operation_sound; eauto with va). - assert (MATCH': ematch bc (rs#res <- v) ae') by (eapply ematch_update; eauto). + assert (MATCH': ematch bc (rs#res <- v) ae') by (eapply ematch_update; eauto). destruct (const_for_result a) as [cop|] eqn:?; intros. (* constant is propagated *) exploit const_for_result_correct; eauto. intros (v' & A & B). left; econstructor; econstructor; split. - eapply exec_Iop; eauto. + eapply exec_Iop; eauto. apply match_states_intro with bc ae'; auto. - apply match_successor. + apply match_successor. apply set_reg_lessdef; auto. (* operator is strength-reduced *) assert(OP: @@ -421,8 +421,8 @@ Proof. rename pc'0 into pc. TransfInstr. set (aa := eval_static_addressing addr (aregs ae args)). assert (VM1: vmatch bc a aa) by (eapply eval_static_addressing_sound; eauto with va). - set (av := loadv chunk rm am aa). - assert (VM2: vmatch bc v av) by (eapply loadv_sound; eauto). + set (av := loadv chunk rm am aa). + assert (VM2: vmatch bc v av) by (eapply loadv_sound; eauto). destruct (const_for_result av) as [cop|] eqn:?; intros. (* constant-propagated *) exploit const_for_result_correct; eauto. intros (v' & A & B). @@ -439,7 +439,7 @@ Proof. { eapply addr_strength_reduction_correct with (ae := ae); eauto with va. } destruct (addr_strength_reduction addr args (aregs ae args)) as [addr' args']. destruct ADDR as (a' & P & Q). - exploit eval_addressing_lessdef. eapply regs_lessdef_regs; eauto. eexact P. + exploit eval_addressing_lessdef. eapply regs_lessdef_regs; eauto. eexact P. intros (a'' & U & V). assert (W: eval_addressing tge (Vptr sp0 Int.zero) addr' rs'##args' = Some a''). { rewrite <- U. apply eval_addressing_preserved. exact symbols_preserved. } @@ -459,11 +459,11 @@ Proof. { eapply addr_strength_reduction_correct with (ae := ae); eauto with va. } destruct (addr_strength_reduction addr args (aregs ae args)) as [addr' args']. destruct ADDR as (a' & P & Q). - exploit eval_addressing_lessdef. eapply regs_lessdef_regs; eauto. eexact P. + exploit eval_addressing_lessdef. eapply regs_lessdef_regs; eauto. eexact P. intros (a'' & U & V). assert (W: eval_addressing tge (Vptr sp0 Int.zero) addr' rs'##args' = Some a''). { rewrite <- U. apply eval_addressing_preserved. exact symbols_preserved. } - exploit Mem.storev_extends. eauto. eauto. apply Val.lessdef_trans with a'; eauto. apply REGS. + exploit Mem.storev_extends. eauto. eauto. apply Val.lessdef_trans with a'; eauto. apply REGS. intros (m2' & X & Y). left; econstructor; econstructor; split. eapply exec_Istore; eauto. @@ -477,7 +477,7 @@ Proof. eapply exec_Icall; eauto. apply sig_function_translated; auto. constructor; auto. constructor; auto. econstructor; eauto. - apply regs_lessdef_regs; auto. + apply regs_lessdef_regs; auto. (* Itailcall *) exploit Mem.free_parallel_extends; eauto. intros [m2' [A B]]. @@ -485,20 +485,20 @@ Proof. TransfInstr; intro. left; econstructor; econstructor; split. eapply exec_Itailcall; eauto. apply sig_function_translated; auto. - constructor; auto. - apply regs_lessdef_regs; auto. + constructor; auto. + apply regs_lessdef_regs; auto. (* Ibuiltin *) rename pc'0 into pc. clear MATCH. TransfInstr; intros. Opaque builtin_strength_reduction. exploit builtin_strength_reduction_correct; eauto. intros (vargs' & P & Q). - exploit (@eval_builtin_args_lessdef _ ge (fun r => rs#r) (fun r => rs'#r)). + exploit (@eval_builtin_args_lessdef _ ge (fun r => rs#r) (fun r => rs'#r)). apply REGS. eauto. eexact P. intros (vargs'' & U & V). exploit external_call_mem_extends; eauto. intros [v' [m2' [A [B [C D]]]]]. left; econstructor; econstructor; split. - eapply exec_Ibuiltin; eauto. + eapply exec_Ibuiltin; eauto. eapply eval_builtin_args_preserved. eexact symbols_preserved. eauto. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. @@ -511,24 +511,24 @@ Opaque builtin_strength_reduction. assert (C: cmatch (eval_condition cond rs ## args m) ac) by (eapply eval_static_condition_sound; eauto with va). rewrite H0 in C. - generalize (cond_strength_reduction_correct bc ae rs m EM cond args (aregs ae args) (refl_equal _)). + generalize (cond_strength_reduction_correct bc ae rs m EM cond args (aregs ae args) (refl_equal _)). destruct (cond_strength_reduction cond args (aregs ae args)) as [cond' args']. intros EV1 TCODE. - left; exists O; exists (State s' (transf_function rm f) (Vptr sp0 Int.zero) (if b then ifso else ifnot) rs' m'); split. - destruct (resolve_branch ac) eqn: RB. - assert (b0 = b) by (eapply resolve_branch_sound; eauto). subst b0. - destruct b; eapply exec_Inop; eauto. + left; exists O; exists (State s' (transf_function rm f) (Vptr sp0 Int.zero) (if b then ifso else ifnot) rs' m'); split. + destruct (resolve_branch ac) eqn: RB. + assert (b0 = b) by (eapply resolve_branch_sound; eauto). subst b0. + destruct b; eapply exec_Inop; eauto. eapply exec_Icond; eauto. eapply eval_condition_lessdef with (vl1 := rs##args'); eauto. eapply regs_lessdef_regs; eauto. congruence. - eapply match_states_succ; eauto. + eapply match_states_succ; eauto. (* Icond, skipped over *) - rewrite H1 in H; inv H. + rewrite H1 in H; inv H. set (ac := eval_static_condition cond (aregs ae0 args)) in *. assert (C: cmatch (eval_condition cond rs ## args m) ac) by (eapply eval_static_condition_sound; eauto with va). rewrite H0 in C. - assert (b0 = b) by (eapply resolve_branch_sound; eauto). subst b0. + assert (b0 = b) by (eapply resolve_branch_sound; eauto). subst b0. right; exists n; split. omega. split. auto. econstructor; eauto. @@ -537,11 +537,11 @@ Opaque builtin_strength_reduction. assert (A: (fn_code (transf_function rm f))!pc = Some(Ijumptable arg tbl) \/ (fn_code (transf_function rm f))!pc = Some(Inop pc')). { TransfInstr. - destruct (areg ae arg) eqn:A; auto. - generalize (EM arg). fold (areg ae arg); rewrite A. - intros V; inv V. replace n0 with n by congruence. + destruct (areg ae arg) eqn:A; auto. + generalize (EM arg). fold (areg ae arg); rewrite A. + intros V; inv V. replace n0 with n by congruence. rewrite H1. auto. } - assert (rs'#arg = Vint n). + assert (rs'#arg = Vint n). { generalize (REGS arg). rewrite H0. intros LD; inv LD; auto. } left; exists O; exists (State s' (transf_function rm f) (Vptr sp0 Int.zero) pc' rs' m'); split. destruct A. eapply exec_Ijumptable; eauto. eapply exec_Inop; eauto. @@ -552,7 +552,7 @@ Opaque builtin_strength_reduction. left; exists O; exists (Returnstate s' (regmap_optget or Vundef rs') m2'); split. eapply exec_Ireturn; eauto. TransfInstr; auto. constructor; auto. - destruct or; simpl; auto. + destruct or; simpl; auto. (* internal function *) exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. @@ -564,11 +564,11 @@ Opaque builtin_strength_reduction. left; exists O; econstructor; split. eapply exec_function_internal; simpl; eauto. simpl. econstructor; eauto. - constructor. + constructor. apply init_regs_lessdef; auto. (* external function *) - exploit external_call_mem_extends; eauto. + exploit external_call_mem_extends; eauto. intros [v' [m2' [A [B [C D]]]]]. simpl. left; econstructor; econstructor; split. eapply exec_function_external; eauto. @@ -580,10 +580,10 @@ Opaque builtin_strength_reduction. assert (X: exists bc ae, ematch bc (rs#res <- vres) ae). { inv SS2. exists bc0; exists ae; auto. } destruct X as (bc1 & ae1 & MATCH). - inv H4. inv H1. + inv H4. inv H1. left; exists O; econstructor; split. - eapply exec_return; eauto. - econstructor; eauto. constructor. apply set_reg_lessdef; auto. + eapply exec_return; eauto. + econstructor; eauto. constructor. apply set_reg_lessdef; auto. Qed. Lemma transf_initial_states: @@ -603,10 +603,10 @@ Proof. Qed. Lemma transf_final_states: - forall n st1 st2 r, + forall n st1 st2 r, match_states n st1 st2 -> final_state st1 r -> final_state st2 r. Proof. - intros. inv H0. inv H. inv STACKS. inv RES. constructor. + intros. inv H0. inv H. inv STACKS. inv RES. constructor. Qed. (** The preservation of the observable behavior of the program then @@ -620,15 +620,15 @@ Proof. (fsim_match_states := fun n s1 s2 => sound_state prog s1 /\ match_states n s1 s2). - apply lt_wf. - simpl; intros. exploit transf_initial_states; eauto. intros (n & st2 & A & B). - exists n, st2; intuition. eapply sound_initial; eauto. -- simpl; intros. destruct H. eapply transf_final_states; eauto. + exists n, st2; intuition. eapply sound_initial; eauto. +- simpl; intros. destruct H. eapply transf_final_states; eauto. - simpl; intros. destruct H0. assert (sound_state prog s1') by (eapply sound_step; eauto). fold ge; fold tge. - exploit transf_step_correct; eauto. + exploit transf_step_correct; eauto. intros [ [n2 [s2' [A B]]] | [n2 [A [B C]]]]. exists n2; exists s2'; split; auto. left; apply plus_one; auto. - exists n2; exists s2; split; auto. right; split; auto. subst t; apply star_refl. + exists n2; exists s2; split; auto. right; split; auto. subst t; apply star_refl. - eexact public_preserved. Qed. diff --git a/backend/Conventions.v b/backend/Conventions.v index abfe4eee..69cdd07d 100644 --- a/backend/Conventions.v +++ b/backend/Conventions.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Function calling conventions and other conventions regarding the use of +(** Function calling conventions and other conventions regarding the use of machine registers and stack slots. *) Require Import Coqlib. @@ -44,14 +44,14 @@ Lemma incoming_slot_in_parameters: In (S Outgoing ofs ty) (loc_arguments sg). Proof. intros. - unfold loc_parameters in H. + unfold loc_parameters in H. change (S Incoming ofs ty) with (parameter_of_argument (S Outgoing ofs ty)) in H. exploit list_in_map_inv. eexact H. intros [x [A B]]. simpl in A. exploit loc_arguments_acceptable; eauto. unfold loc_argument_acceptable; intros. destruct x; simpl in A; try discriminate. - destruct sl; try contradiction. + destruct sl; try contradiction. inv A. auto. -Qed. +Qed. (** * Tail calls *) @@ -82,16 +82,16 @@ Proof. intro s. unfold tailcall_is_possible, tailcall_possible. generalize (loc_arguments s). induction l; simpl; intros. elim H0. - destruct a. + destruct a. destruct H0. subst l0. auto. apply IHl. auto. auto. discriminate. Qed. Lemma zero_size_arguments_tailcall_possible: forall sg, size_arguments sg = 0 -> tailcall_possible sg. Proof. - intros; red; intros. exploit loc_arguments_acceptable; eauto. - unfold loc_argument_acceptable. - destruct l; intros. auto. destruct sl; try contradiction. destruct H1. + intros; red; intros. exploit loc_arguments_acceptable; eauto. + unfold loc_argument_acceptable. + destruct l; intros. auto. destruct sl; try contradiction. destruct H1. generalize (loc_arguments_bounded _ _ _ H0). - generalize (typesize_pos ty). omega. + generalize (typesize_pos ty). omega. Qed. diff --git a/backend/Deadcode.v b/backend/Deadcode.v index 9bf17d1d..fa99915d 100644 --- a/backend/Deadcode.v +++ b/backend/Deadcode.v @@ -168,7 +168,7 @@ Definition analyze (approx: PMap.t VA.t) (f: function): option (PMap.t NA.t) := (** * Part 2: the code transformation *) -Definition transf_instr (approx: PMap.t VA.t) (an: PMap.t NA.t) +Definition transf_instr (approx: PMap.t VA.t) (an: PMap.t NA.t) (pc: node) (instr: instruction) := match instr with | Iop op args res s => @@ -177,7 +177,7 @@ Definition transf_instr (approx: PMap.t VA.t) (an: PMap.t NA.t) Inop s else if is_int_zero nres then Iop (Ointconst Int.zero) nil res s - else if operation_is_redundant op nres then + else if operation_is_redundant op nres then match args with | arg :: _ => Iop Omove (arg :: nil) res s | nil => instr diff --git a/backend/Deadcodeproof.v b/backend/Deadcodeproof.v index a45869d7..6bbf0ae7 100644 --- a/backend/Deadcodeproof.v +++ b/backend/Deadcodeproof.v @@ -73,8 +73,8 @@ Lemma mextends_agree: Proof. intros. destruct H. destruct mext_inj. constructor; intros. - replace ofs with (ofs + 0) by omega. eapply mi_perm; eauto. auto. -- exploit mi_memval; eauto. unfold inject_id; eauto. - rewrite Zplus_0_r. auto. +- exploit mi_memval; eauto. unfold inject_id; eauto. + rewrite Zplus_0_r. auto. - auto. Qed. @@ -84,8 +84,8 @@ Lemma magree_extends: magree m1 m2 P -> Mem.extends m1 m2. Proof. intros. destruct H0. constructor; auto. constructor; unfold inject_id; intros. -- inv H0. rewrite Zplus_0_r. eauto. -- inv H0. apply Zdivide_0. +- inv H0. rewrite Zplus_0_r. eauto. +- inv H0. apply Zdivide_0. - inv H0. rewrite Zplus_0_r. eapply ma_memval0; eauto. Qed. @@ -100,20 +100,20 @@ Proof. (forall i, ofs <= i < ofs + Z.of_nat n -> memval_lessdef (ZMap.get i c1) (ZMap.get i c2)) -> list_forall2 memval_lessdef (Mem.getN n ofs c1) (Mem.getN n ofs c2)). { - induction n; intros; simpl. + induction n; intros; simpl. constructor. rewrite inj_S in H. constructor. - apply H. omega. + apply H. omega. apply IHn. intros; apply H; omega. } Local Transparent Mem.loadbytes. - unfold Mem.loadbytes; intros. destruct H. + unfold Mem.loadbytes; intros. destruct H. destruct (Mem.range_perm_dec m1 b ofs (ofs + n) Cur Readable); inv H0. rewrite pred_dec_true. econstructor; split; eauto. apply GETN. intros. rewrite nat_of_Z_max in H. - assert (ofs <= i < ofs + n) by xomega. + assert (ofs <= i < ofs + n) by xomega. apply ma_memval0; auto. - red; intros; eauto. + red; intros; eauto. Qed. Lemma magree_load: @@ -123,12 +123,12 @@ Lemma magree_load: (forall i, ofs <= i < ofs + size_chunk chunk -> P b i) -> exists v', Mem.load chunk m2 b ofs = Some v' /\ Val.lessdef v v'. Proof. - intros. exploit Mem.load_valid_access; eauto. intros [A B]. + intros. exploit Mem.load_valid_access; eauto. intros [A B]. exploit Mem.load_loadbytes; eauto. intros [bytes [C D]]. exploit magree_loadbytes; eauto. intros [bytes' [E F]]. - exists (decode_val chunk bytes'); split. - apply Mem.loadbytes_load; auto. - apply val_inject_id. subst v. apply decode_val_inject; auto. + exists (decode_val chunk bytes'); split. + apply Mem.loadbytes_load; auto. + apply val_inject_id. subst v. apply decode_val_inject; auto. Qed. Lemma magree_storebytes_parallel: @@ -151,20 +151,20 @@ Proof. { induction 1; intros; simpl. - apply H; auto. simpl. omega. - - simpl length in H1; rewrite inj_S in H1. - apply IHlist_forall2; auto. - intros. rewrite ! ZMap.gsspec. destruct (ZIndexed.eq i p). auto. - apply H1; auto. unfold ZIndexed.t in *; omega. + - simpl length in H1; rewrite inj_S in H1. + apply IHlist_forall2; auto. + intros. rewrite ! ZMap.gsspec. destruct (ZIndexed.eq i p). auto. + apply H1; auto. unfold ZIndexed.t in *; omega. } - intros. + intros. destruct (Mem.range_perm_storebytes m2 b ofs bytes2) as [m2' ST2]. { erewrite <- list_forall2_length by eauto. red; intros. - eapply ma_perm; eauto. + eapply ma_perm; eauto. eapply Mem.storebytes_range_perm; eauto. } - exists m2'; split; auto. + exists m2'; split; auto. constructor; intros. - eapply Mem.perm_storebytes_1; eauto. eapply ma_perm; eauto. - eapply Mem.perm_storebytes_2; eauto. + eapply Mem.perm_storebytes_2; eauto. - rewrite (Mem.storebytes_mem_contents _ _ _ _ _ H0). rewrite (Mem.storebytes_mem_contents _ _ _ _ _ ST2). rewrite ! PMap.gsspec. destruct (peq b0 b). @@ -175,7 +175,7 @@ Proof. + eapply ma_memval; eauto. eapply Mem.perm_storebytes_2; eauto. apply H1; auto. - rewrite (Mem.nextblock_storebytes _ _ _ _ _ H0). rewrite (Mem.nextblock_storebytes _ _ _ _ _ ST2). - eapply ma_nextblock; eauto. + eapply ma_nextblock; eauto. Qed. Lemma magree_store_parallel: @@ -188,16 +188,16 @@ Lemma magree_store_parallel: P b' i) -> exists m2', Mem.store chunk m2 b ofs v2 = Some m2' /\ magree m1' m2' Q. Proof. - intros. - exploit Mem.store_valid_access_3; eauto. intros [A B]. + intros. + exploit Mem.store_valid_access_3; eauto. intros [A B]. exploit Mem.store_storebytes; eauto. intros SB1. - exploit magree_storebytes_parallel. eauto. eauto. + exploit magree_storebytes_parallel. eauto. eauto. instantiate (1 := Q). intros. rewrite encode_val_length in H4. - rewrite <- size_chunk_conv in H4. apply H2; auto. - eapply store_argument_sound; eauto. - intros [m2' [SB2 AG]]. + rewrite <- size_chunk_conv in H4. apply H2; auto. + eapply store_argument_sound; eauto. + intros [m2' [SB2 AG]]. exists m2'; split; auto. - apply Mem.storebytes_store; auto. + apply Mem.storebytes_store; auto. Qed. Lemma magree_storebytes_left: @@ -208,15 +208,15 @@ Lemma magree_storebytes_left: magree m1' m2 P. Proof. intros. constructor; intros. -- eapply ma_perm; eauto. eapply Mem.perm_storebytes_2; eauto. +- eapply ma_perm; eauto. eapply Mem.perm_storebytes_2; eauto. - rewrite (Mem.storebytes_mem_contents _ _ _ _ _ H0). rewrite PMap.gsspec. destruct (peq b0 b). + subst b0. rewrite Mem.setN_outside. eapply ma_memval; eauto. eapply Mem.perm_storebytes_2; eauto. destruct (zlt ofs0 ofs); auto. destruct (zle (ofs + Z.of_nat (length bytes1)) ofs0); try omega. - elim (H1 ofs0). omega. auto. + elim (H1 ofs0). omega. auto. + eapply ma_memval; eauto. eapply Mem.perm_storebytes_2; eauto. - rewrite (Mem.nextblock_storebytes _ _ _ _ _ H0). - eapply ma_nextblock; eauto. + eapply ma_nextblock; eauto. Qed. Lemma magree_store_left: @@ -227,9 +227,9 @@ Lemma magree_store_left: magree m1' m2 P. Proof. intros. eapply magree_storebytes_left; eauto. - eapply Mem.store_storebytes; eauto. + eapply Mem.store_storebytes; eauto. intros. rewrite encode_val_length in H2. - rewrite <- size_chunk_conv in H2. apply H1; auto. + rewrite <- size_chunk_conv in H2. apply H1; auto. Qed. Lemma magree_free: @@ -241,21 +241,21 @@ Lemma magree_free: P b' i) -> exists m2', Mem.free m2 b lo hi = Some m2' /\ magree m1' m2' Q. Proof. - intros. + intros. destruct (Mem.range_perm_free m2 b lo hi) as [m2' FREE]. - red; intros. eapply ma_perm; eauto. eapply Mem.free_range_perm; eauto. + red; intros. eapply ma_perm; eauto. eapply Mem.free_range_perm; eauto. exists m2'; split; auto. constructor; intros. - (* permissions *) assert (Mem.perm m2 b0 ofs k p). { eapply ma_perm; eauto. eapply Mem.perm_free_3; eauto. } exploit Mem.perm_free_inv; eauto. intros [[A B] | A]; auto. - subst b0. eelim Mem.perm_free_2. eexact H0. eauto. eauto. + subst b0. eelim Mem.perm_free_2. eexact H0. eauto. eauto. - (* contents *) rewrite (Mem.free_result _ _ _ _ _ H0). - rewrite (Mem.free_result _ _ _ _ _ FREE). + rewrite (Mem.free_result _ _ _ _ _ FREE). simpl. eapply ma_memval; eauto. eapply Mem.perm_free_3; eauto. apply H1; auto. destruct (eq_block b0 b); auto. - subst b0. right. red; intros. eelim Mem.perm_free_2. eexact H0. eauto. eauto. + subst b0. right. red; intros. eelim Mem.perm_free_2. eexact H0. eauto. eauto. - (* nextblock *) rewrite (Mem.free_result _ _ _ _ _ H0). rewrite (Mem.free_result _ _ _ _ _ FREE). @@ -268,9 +268,9 @@ Lemma magree_valid_access: Mem.valid_access m1 chunk b ofs p -> Mem.valid_access m2 chunk b ofs p. Proof. - intros. destruct H0; split; auto. + intros. destruct H0; split; auto. red; intros. eapply ma_perm; eauto. -Qed. +Qed. (** * Properties of the need environment *) @@ -278,15 +278,15 @@ Lemma add_need_all_eagree: forall e e' r ne, eagree e e' (add_need_all r ne) -> eagree e e' ne. Proof. - intros; red; intros. generalize (H r0). unfold add_need_all. - rewrite NE.gsspec. destruct (peq r0 r); auto with na. + intros; red; intros. generalize (H r0). unfold add_need_all. + rewrite NE.gsspec. destruct (peq r0 r); auto with na. Qed. Lemma add_need_all_lessdef: forall e e' r ne, eagree e e' (add_need_all r ne) -> Val.lessdef e#r e'#r. Proof. - intros. generalize (H r); unfold add_need_all. + intros. generalize (H r); unfold add_need_all. rewrite NE.gsspec, peq_true. auto with na. Qed. @@ -313,17 +313,17 @@ Lemma add_needs_all_eagree: Proof. induction rl; simpl; intros. auto. - apply IHrl. eapply add_need_all_eagree; eauto. + apply IHrl. eapply add_need_all_eagree; eauto. Qed. Lemma add_needs_all_lessdef: forall rl e e' ne, eagree e e' (add_needs_all rl ne) -> Val.lessdef_list e##rl e'##rl. Proof. - induction rl; simpl; intros. + induction rl; simpl; intros. constructor. - constructor. eapply add_need_all_lessdef; eauto. - eapply IHrl. eapply add_need_all_eagree; eauto. + constructor. eapply add_need_all_lessdef; eauto. + eapply IHrl. eapply add_need_all_eagree; eauto. Qed. Lemma add_needs_eagree: @@ -333,7 +333,7 @@ Proof. induction rl; simpl; intros. auto. destruct nvl. apply add_needs_all_eagree with (a :: rl); auto. - eapply IHrl. eapply add_need_eagree; eauto. + eapply IHrl. eapply add_need_eagree; eauto. Qed. Lemma add_needs_vagree: @@ -344,14 +344,14 @@ Proof. constructor. destruct nvl. apply vagree_lessdef_list. eapply add_needs_all_lessdef with (rl := a :: rl); eauto. - constructor. eapply add_need_vagree; eauto. - eapply IHrl. eapply add_need_eagree; eauto. + constructor. eapply add_need_vagree; eauto. + eapply IHrl. eapply add_need_eagree; eauto. Qed. Lemma add_ros_need_eagree: forall e e' ros ne, eagree e e' (add_ros_need_all ros ne) -> eagree e e' ne. Proof. - intros. destruct ros; simpl in *. eapply add_need_all_eagree; eauto. auto. + intros. destruct ros; simpl in *. eapply add_need_all_eagree; eauto. auto. Qed. Hint Resolve add_need_all_eagree add_need_all_lessdef @@ -362,13 +362,13 @@ Hint Resolve add_need_all_eagree add_need_all_lessdef Lemma eagree_init_regs: forall rl vl1 vl2 ne, - Val.lessdef_list vl1 vl2 -> + Val.lessdef_list vl1 vl2 -> eagree (init_regs vl1 rl) (init_regs vl2 rl) ne. Proof. induction rl; intros until ne; intros LD; simpl. - red; auto with na. -- inv LD. - + red; auto with na. +- inv LD. + + red; auto with na. + apply eagree_update; auto with na. Qed. @@ -427,8 +427,8 @@ Lemma sig_function_translated: funsig tf = funsig f. Proof. intros; destruct f; monadInv H. - unfold transf_function in EQ. - destruct (analyze (vanalyze rm f) f); inv EQ; auto. + unfold transf_function in EQ. + destruct (analyze (vanalyze rm f) f); inv EQ; auto. auto. Qed. @@ -446,14 +446,14 @@ Lemma transf_function_at: f.(fn_code)!pc = Some instr -> tf.(fn_code)!pc = Some(transf_instr (vanalyze rm f) an pc instr). Proof. - intros. unfold transf_function in H. rewrite H0 in H. inv H; simpl. - rewrite PTree.gmap. rewrite H1; auto. + intros. unfold transf_function in H. rewrite H0 in H. inv H; simpl. + rewrite PTree.gmap. rewrite H1; auto. Qed. Lemma is_dead_sound_1: forall nv, is_dead nv = true -> nv = Nothing. Proof. - destruct nv; simpl; congruence. + destruct nv; simpl; congruence. Qed. Lemma is_dead_sound_2: @@ -469,7 +469,7 @@ Lemma is_int_zero_sound: Proof. unfold is_int_zero; destruct nv; try discriminate. predSpec Int.eq Int.eq_spec m Int.zero; congruence. -Qed. +Qed. Lemma find_function_translated: forall ros rs fd trs ne, @@ -551,10 +551,10 @@ Lemma match_succ_states: match_states (State s f (Vptr sp Int.zero) pc' e m) (State ts tf (Vptr sp Int.zero) pc' te tm). Proof. - intros. exploit analyze_successors; eauto. rewrite ANPC; simpl. intros [A B]. - econstructor; eauto. - eapply eagree_ge; eauto. - eapply magree_monotone; eauto. intros; apply B; auto. + intros. exploit analyze_successors; eauto. rewrite ANPC; simpl. intros [A B]. + econstructor; eauto. + eapply eagree_ge; eauto. + eapply magree_monotone; eauto. intros; apply B; auto. Qed. (** Builtin arguments and results *) @@ -565,7 +565,7 @@ Lemma eagree_set_res: eagree e1 e2 (kill_builtin_res res ne) -> eagree (regmap_setres res v1 e1) (regmap_setres res v2 e2) ne. Proof. - intros. destruct res; simpl in *; auto. + intros. destruct res; simpl in *; auto. apply eagree_update; eauto. apply vagree_lessdef; auto. Qed. @@ -590,19 +590,19 @@ Proof. - exists (Vlong n); intuition auto. constructor. apply vagree_same. - exists (Vfloat n); intuition auto. constructor. apply vagree_same. - exists (Vsingle n); intuition auto. constructor. apply vagree_same. -- simpl in H. exploit magree_load; eauto. +- simpl in H. exploit magree_load; eauto. intros. eapply nlive_add; eauto with va. rewrite Int.add_zero_l in H0; auto. intros (v' & A & B). exists v'; intuition auto. constructor; auto. apply vagree_lessdef; auto. - eapply magree_monotone; eauto. intros; eapply incl_nmem_add; eauto. -- exists (Vptr sp (Int.add Int.zero ofs)); intuition auto with na. constructor. -- unfold Senv.symbol_address in H; simpl in H. + eapply magree_monotone; eauto. intros; eapply incl_nmem_add; eauto. +- exists (Vptr sp (Int.add Int.zero ofs)); intuition auto with na. constructor. +- unfold Senv.symbol_address in H; simpl in H. destruct (Genv.find_symbol ge id) as [b|] eqn:FS; simpl in H; try discriminate. exploit magree_load; eauto. - intros. eapply nlive_add; eauto. constructor. apply GM; auto. + intros. eapply nlive_add; eauto. constructor. apply GM; auto. intros (v' & A & B). exists v'; intuition auto. - constructor. simpl. unfold Senv.symbol_address; simpl; rewrite FS; auto. + constructor. simpl. unfold Senv.symbol_address; simpl; rewrite FS; auto. apply vagree_lessdef; auto. eapply magree_monotone; eauto. intros; eapply incl_nmem_add; eauto. - exists (Senv.symbol_address ge id ofs); intuition auto with na. constructor. @@ -635,8 +635,8 @@ Local Opaque transfer_builtin_arg. - inv H. exists (@nil val); intuition auto. constructor. - destruct (transfer_builtin_arg All (ne1, nm1) a1) as [ne' nm'] eqn:TR. exploit IHlist_forall2; eauto. intros (vs' & A1 & B1 & C1 & D1). - exploit transfer_builtin_arg_sound; eauto. intros (v1' & A2 & B2 & C2 & D2). - exists (v1' :: vs'); intuition auto. constructor; auto. + exploit transfer_builtin_arg_sound; eauto. intros (v1' & A2 & B2 & C2 & D2). + exists (v1' :: vs'); intuition auto. constructor; auto. Qed. Lemma can_eval_builtin_arg: @@ -651,13 +651,13 @@ Proof. Mem.loadv chunk m addr = Some v -> exists v', Mem.loadv chunk m' addr = Some v'). { - intros. destruct addr; simpl in H; try discriminate. - eapply Mem.valid_access_load. eapply magree_valid_access; eauto. + intros. destruct addr; simpl in H; try discriminate. + eapply Mem.valid_access_load. eapply magree_valid_access; eauto. eapply Mem.load_valid_access; eauto. } induction 1; try (econstructor; now constructor). - exploit LD; eauto. intros (v' & A). exists v'; constructor; auto. - exploit LD; eauto. intros (v' & A). exists v'; constructor. - unfold Senv.symbol_address, Senv.find_symbol. rewrite symbols_preserved. assumption. + unfold Senv.symbol_address, Senv.find_symbol. rewrite symbols_preserved. assumption. - destruct IHeval_builtin_arg1 as (v1' & A1). destruct IHeval_builtin_arg2 as (v2' & A2). exists (Val.longofwords v1' v2'); constructor; auto. @@ -692,11 +692,11 @@ Proof. intros. inv H. split; auto. inv H0. inv H9. - (* volatile *) - exists tm; split; auto. econstructor. econstructor; eauto. + exists tm; split; auto. econstructor. econstructor; eauto. eapply eventval_match_lessdef; eauto. apply store_argument_load_result; auto. - (* not volatile *) exploit magree_store_parallel. eauto. eauto. eauto. - instantiate (1 := nlive ge sp nm). auto. + instantiate (1 := nlive ge sp nm). auto. intros (tm' & P & Q). exists tm'; split. econstructor. econstructor; eauto. auto. Qed. @@ -740,7 +740,7 @@ Ltac UseTransfer := - (* nop *) TransfInstr; UseTransfer. econstructor; split. - eapply exec_Inop; eauto. + eapply exec_Inop; eauto. eapply match_succ_states; eauto. simpl; auto. - (* op *) @@ -750,26 +750,26 @@ Ltac UseTransfer := [idtac|destruct (operation_is_redundant op (nreg ne res)) eqn:REDUNDANT]]. + (* dead instruction, turned into a nop *) econstructor; split. - eapply exec_Inop; eauto. + eapply exec_Inop; eauto. eapply match_succ_states; eauto. simpl; auto. - apply eagree_update_dead; auto with na. + apply eagree_update_dead; auto with na. + (* instruction with needs = [I Int.zero], turned into a load immediate of zero. *) econstructor; split. - eapply exec_Iop with (v := Vint Int.zero); eauto. + eapply exec_Iop with (v := Vint Int.zero); eauto. eapply match_succ_states; eauto. simpl; auto. - apply eagree_update; auto. + apply eagree_update; auto. rewrite is_int_zero_sound by auto. destruct v; simpl; auto. apply iagree_zero. + (* redundant operation *) destruct args. * (* kept as is because no arguments -- should never happen *) - simpl in *. - exploit needs_of_operation_sound. eapply ma_perm; eauto. + simpl in *. + exploit needs_of_operation_sound. eapply ma_perm; eauto. eauto. instantiate (1 := nreg ne res). eauto with na. eauto with na. intros [tv [A B]]. - econstructor; split. + econstructor; split. eapply exec_Iop with (v := tv); eauto. rewrite <- A. apply eval_operation_preserved. exact symbols_preserved. - eapply match_succ_states; eauto. simpl; auto. + eapply match_succ_states; eauto. simpl; auto. apply eagree_update; auto. * (* turned into a move *) unfold fst in ENV. unfold snd in MEM. simpl in H0. @@ -777,17 +777,17 @@ Ltac UseTransfer := { eapply operation_is_redundant_sound with (arg1' := te#r) (args' := te##args). eauto. eauto. exploit add_needs_vagree; eauto. } econstructor; split. - eapply exec_Iop; eauto. simpl; reflexivity. - eapply match_succ_states; eauto. simpl; auto. - eapply eagree_update; eauto 2 with na. + eapply exec_Iop; eauto. simpl; reflexivity. + eapply match_succ_states; eauto. simpl; auto. + eapply eagree_update; eauto 2 with na. + (* preserved operation *) simpl in *. exploit needs_of_operation_sound. eapply ma_perm; eauto. eauto. eauto 2 with na. eauto with na. intros [tv [A B]]. - econstructor; split. + econstructor; split. eapply exec_Iop with (v := tv); eauto. rewrite <- A. apply eval_operation_preserved. exact symbols_preserved. - eapply match_succ_states; eauto. simpl; auto. + eapply match_succ_states; eauto. simpl; auto. apply eagree_update; eauto 2 with na. - (* load *) @@ -797,87 +797,87 @@ Ltac UseTransfer := simpl in *. + (* dead instruction, turned into a nop *) econstructor; split. - eapply exec_Inop; eauto. + eapply exec_Inop; eauto. eapply match_succ_states; eauto. simpl; auto. - apply eagree_update_dead; auto with na. + apply eagree_update_dead; auto with na. + (* instruction with needs = [I Int.zero], turned into a load immediate of zero. *) econstructor; split. - eapply exec_Iop with (v := Vint Int.zero); eauto. + eapply exec_Iop with (v := Vint Int.zero); eauto. eapply match_succ_states; eauto. simpl; auto. - apply eagree_update; auto. + apply eagree_update; auto. rewrite is_int_zero_sound by auto. destruct v; simpl; auto. apply iagree_zero. + (* preserved *) - exploit eval_addressing_lessdef. eapply add_needs_all_lessdef; eauto. eauto. + exploit eval_addressing_lessdef. eapply add_needs_all_lessdef; eauto. eauto. intros (ta & U & V). inv V; try discriminate. destruct ta; simpl in H1; try discriminate. - exploit magree_load; eauto. + exploit magree_load; eauto. exploit aaddressing_sound; eauto. intros (bc & A & B & C). - intros. apply nlive_add with bc i; assumption. + intros. apply nlive_add with bc i; assumption. intros (tv & P & Q). econstructor; split. - eapply exec_Iload with (a := Vptr b i). eauto. + eapply exec_Iload with (a := Vptr b i). eauto. rewrite <- U. apply eval_addressing_preserved. exact symbols_preserved. - eauto. + eauto. eapply match_succ_states; eauto. simpl; auto. - apply eagree_update; eauto 2 with na. - eapply magree_monotone; eauto. intros. apply incl_nmem_add; auto. + apply eagree_update; eauto 2 with na. + eapply magree_monotone; eauto. intros. apply incl_nmem_add; auto. - (* store *) TransfInstr; UseTransfer. destruct (nmem_contains nm (aaddressing (vanalyze rm f) # pc addr args) (size_chunk chunk)) eqn:CONTAINS. + (* preserved *) - simpl in *. - exploit eval_addressing_lessdef. eapply add_needs_all_lessdef; eauto. eauto. + simpl in *. + exploit eval_addressing_lessdef. eapply add_needs_all_lessdef; eauto. eauto. intros (ta & U & V). inv V; try discriminate. destruct ta; simpl in H1; try discriminate. exploit magree_store_parallel. eauto. eauto. instantiate (1 := te#src). eauto with na. - instantiate (1 := nlive ge sp0 nm). + instantiate (1 := nlive ge sp0 nm). exploit aaddressing_sound; eauto. intros (bc & A & B & C). - intros. apply nlive_remove with bc b i; assumption. + intros. apply nlive_remove with bc b i; assumption. intros (tm' & P & Q). econstructor; split. - eapply exec_Istore with (a := Vptr b i). eauto. + eapply exec_Istore with (a := Vptr b i). eauto. rewrite <- U. apply eval_addressing_preserved. exact symbols_preserved. eauto. eapply match_succ_states; eauto. simpl; auto. - eauto 3 with na. + eauto 3 with na. + (* dead instruction, turned into a nop *) destruct a; simpl in H1; try discriminate. econstructor; split. - eapply exec_Inop; eauto. + eapply exec_Inop; eauto. eapply match_succ_states; eauto. simpl; auto. eapply magree_store_left; eauto. exploit aaddressing_sound; eauto. intros (bc & A & B & C). - intros. eapply nlive_contains; eauto. + intros. eapply nlive_contains; eauto. - (* call *) TransfInstr; UseTransfer. exploit find_function_translated; eauto 2 with na. intros (tfd & A & B). econstructor; split. - eapply exec_Icall; eauto. apply sig_function_translated; auto. - constructor. - constructor; auto. econstructor; eauto. + eapply exec_Icall; eauto. apply sig_function_translated; auto. + constructor. + constructor; auto. econstructor; eauto. intros. - edestruct analyze_successors; eauto. simpl; eauto. - eapply eagree_ge; eauto. rewrite ANPC. simpl. + edestruct analyze_successors; eauto. simpl; eauto. + eapply eagree_ge; eauto. rewrite ANPC. simpl. apply eagree_update; eauto with na. - auto. eauto 2 with na. eapply magree_extends; eauto. apply nlive_all. + auto. eauto 2 with na. eapply magree_extends; eauto. apply nlive_all. - (* tailcall *) TransfInstr; UseTransfer. exploit find_function_translated; eauto 2 with na. intros (tfd & A & B). - exploit magree_free. eauto. eauto. instantiate (1 := nlive ge stk nmem_all). - intros; eapply nlive_dead_stack; eauto. - intros (tm' & C & D). + exploit magree_free. eauto. eauto. instantiate (1 := nlive ge stk nmem_all). + intros; eapply nlive_dead_stack; eauto. + intros (tm' & C & D). econstructor; split. - eapply exec_Itailcall; eauto. apply sig_function_translated; auto. + eapply exec_Itailcall; eauto. apply sig_function_translated; auto. erewrite stacksize_translated by eauto. eexact C. constructor; eauto 2 with na. eapply magree_extends; eauto. apply nlive_all. - (* builtin *) - TransfInstr; UseTransfer. revert ENV MEM TI. + TransfInstr; UseTransfer. revert ENV MEM TI. functional induction (transfer_builtin (vanalyze rm f)#pc ef args res ne nm); simpl in *; intros. + (* volatile load *) @@ -886,18 +886,18 @@ Ltac UseTransfer := (kill_builtin_res res ne, nmem_add nm (aaddr_arg (vanalyze rm f) # pc a1) (size_chunk chunk)) a1) as (ne1, nm1) eqn: TR. - inversion SS; subst. exploit transfer_builtin_arg_sound; eauto. - intros (tv1 & A & B & C & D). - inv H1. simpl in B. inv B. + inversion SS; subst. exploit transfer_builtin_arg_sound; eauto. + intros (tv1 & A & B & C & D). + inv H1. simpl in B. inv B. assert (X: exists tvres, volatile_load ge chunk tm b ofs t tvres /\ Val.lessdef vres tvres). { - inv H2. - * exists (Val.load_result chunk v); split; auto. constructor; auto. - * exploit magree_load; eauto. - exploit aaddr_arg_sound_1; eauto. rewrite <- AN. intros. - intros. eapply nlive_add; eassumption. - intros (tv & P & Q). - exists tv; split; auto. constructor; auto. + inv H2. + * exists (Val.load_result chunk v); split; auto. constructor; auto. + * exploit magree_load; eauto. + exploit aaddr_arg_sound_1; eauto. rewrite <- AN. intros. + intros. eapply nlive_add; eassumption. + intros (tv & P & Q). + exists tv; split; auto. constructor; auto. } destruct X as (tvres & P & Q). econstructor; split. @@ -905,31 +905,31 @@ Ltac UseTransfer := apply eval_builtin_args_preserved with (ge1 := ge). exact symbols_preserved. constructor. eauto. constructor. eapply external_call_symbols_preserved. - constructor. simpl. eauto. + constructor. simpl. eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. eapply match_succ_states; eauto. simpl; auto. apply eagree_set_res; auto. - eapply magree_monotone; eauto. intros. apply incl_nmem_add; auto. + eapply magree_monotone; eauto. intros. apply incl_nmem_add; auto. + (* volatile store *) inv H0. inv H6. inv H7. rename b1 into v1. rename b0 into v2. destruct (transfer_builtin_arg (store_argument chunk) (kill_builtin_res res ne, nm) a2) as (ne2, nm2) eqn: TR2. destruct (transfer_builtin_arg All (ne2, nm2) a1) as (ne1, nm1) eqn: TR1. - inversion SS; subst. + inversion SS; subst. exploit transfer_builtin_arg_sound. eexact H4. eauto. eauto. eauto. eauto. eauto. intros (tv1 & A1 & B1 & C1 & D1). exploit transfer_builtin_arg_sound. eexact H3. eauto. eauto. eauto. eauto. eauto. intros (tv2 & A2 & B2 & C2 & D2). exploit transf_volatile_store; eauto. - intros (EQ & tm' & P & Q). subst vres. + intros (EQ & tm' & P & Q). subst vres. econstructor; split. eapply exec_Ibuiltin; eauto. apply eval_builtin_args_preserved with (ge1 := ge). exact symbols_preserved. constructor. eauto. constructor. eauto. constructor. - eapply external_call_symbols_preserved. simpl; eauto. + eapply external_call_symbols_preserved. simpl; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. eapply match_succ_states; eauto. simpl; auto. - apply eagree_set_res; auto. + apply eagree_set_res; auto. + (* memcpy *) rewrite e1 in TI. inv H0. inv H6. inv H7. rename b1 into v1. rename b0 into v2. @@ -947,27 +947,27 @@ Ltac UseTransfer := intros (tv2 & A2 & B2 & C2 & D2). inv H1. exploit magree_loadbytes. eauto. eauto. - intros. eapply nlive_add; eauto. + intros. eapply nlive_add; eauto. unfold asrc, vanalyze, rm; rewrite AN; eapply aaddr_arg_sound_1; eauto. intros (tbytes & P & Q). exploit magree_storebytes_parallel. - eapply magree_monotone. eexact D2. + eapply magree_monotone. eexact D2. instantiate (1 := nlive ge sp0 (nmem_remove nm adst sz)). intros. apply incl_nmem_add; auto. - eauto. + eauto. instantiate (1 := nlive ge sp0 nm). - intros. eapply nlive_remove; eauto. + intros. eapply nlive_remove; eauto. unfold adst, vanalyze, rm; rewrite AN; eapply aaddr_arg_sound_1; eauto. - erewrite Mem.loadbytes_length in H1 by eauto. + erewrite Mem.loadbytes_length in H1 by eauto. rewrite nat_of_Z_eq in H1 by omega. auto. - eauto. + eauto. intros (tm' & A & B). econstructor; split. eapply exec_Ibuiltin; eauto. apply eval_builtin_args_preserved with (ge1 := ge). exact symbols_preserved. constructor. eauto. constructor. eauto. constructor. eapply external_call_symbols_preserved. simpl. - simpl in B1; inv B1. simpl in B2; inv B2. econstructor; eauto. + simpl in B1; inv B1. simpl in B2; inv B2. econstructor; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. eapply match_succ_states; eauto. simpl; auto. apply eagree_set_res; auto. @@ -978,24 +978,24 @@ Ltac UseTransfer := set (asrc := aaddr_arg (vanalyze rm f) # pc src) in *. inv H1. econstructor; split. - eapply exec_Inop; eauto. + eapply exec_Inop; eauto. eapply match_succ_states; eauto. simpl; auto. destruct res; auto. apply eagree_set_undef; auto. eapply magree_storebytes_left; eauto. - exploit aaddr_arg_sound. eauto. eauto. + exploit aaddr_arg_sound. eauto. eauto. intros (bc & A & B & C). intros. eapply nlive_contains; eauto. - erewrite Mem.loadbytes_length in H0 by eauto. + erewrite Mem.loadbytes_length in H0 by eauto. rewrite nat_of_Z_eq in H0 by omega. auto. + (* annot *) destruct (transfer_builtin_args (kill_builtin_res res ne, nm) _x1) as (ne1, nm1) eqn:TR. inversion SS; subst. exploit transfer_builtin_args_sound; eauto. intros (tvl & A & B & C & D). inv H1. - econstructor; split. + econstructor; split. eapply exec_Ibuiltin; eauto. apply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. - eapply external_call_symbols_preserved. simpl; constructor. + eapply external_call_symbols_preserved. simpl; constructor. eapply eventval_list_match_lessdef; eauto 2 with na. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. eapply match_succ_states; eauto. simpl; auto. @@ -1005,10 +1005,10 @@ Ltac UseTransfer := inversion SS; subst. exploit transfer_builtin_args_sound; eauto. intros (tvl & A & B & C & D). inv H1. inv B. inv H6. - econstructor; split. - eapply exec_Ibuiltin; eauto. + econstructor; split. + eapply exec_Ibuiltin; eauto. apply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. - eapply external_call_symbols_preserved. simpl; constructor. + eapply external_call_symbols_preserved. simpl; constructor. eapply eventval_match_lessdef; eauto 2 with na. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. eapply match_succ_states; eauto. simpl; auto. @@ -1023,15 +1023,15 @@ Ltac UseTransfer := + (* all other builtins *) assert ((fn_code tf)!pc = Some(Ibuiltin _x _x0 res pc')). { - destruct _x; auto. destruct _x0; auto. destruct _x0; auto. destruct _x0; auto. contradiction. + destruct _x; auto. destruct _x0; auto. destruct _x0; auto. destruct _x0; auto. contradiction. } clear y TI. destruct (transfer_builtin_args (kill_builtin_res res ne, nmem_all) _x0) as (ne1, nm1) eqn:TR. inversion SS; subst. exploit transfer_builtin_args_sound; eauto. intros (tvl & A & B & C & D). - exploit external_call_mem_extends; eauto 2 with na. - eapply magree_extends; eauto. intros. apply nlive_all. - intros (v' & tm' & P & Q & R & S & T). + exploit external_call_mem_extends; eauto 2 with na. + eapply magree_extends; eauto. intros. apply nlive_all. + intros (v' & tm' & P & Q & R & S & T). econstructor; split. eapply exec_Ibuiltin; eauto. apply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. @@ -1039,33 +1039,33 @@ Ltac UseTransfer := exact symbols_preserved. exact public_preserved. exact varinfo_preserved. eapply match_succ_states; eauto. simpl; auto. apply eagree_set_res; auto. - eapply mextends_agree; eauto. + eapply mextends_agree; eauto. - (* conditional *) TransfInstr; UseTransfer. econstructor; split. - eapply exec_Icond; eauto. - eapply needs_of_condition_sound. eapply ma_perm; eauto. eauto. eauto with na. - eapply match_succ_states; eauto 2 with na. - simpl; destruct b; auto. + eapply exec_Icond; eauto. + eapply needs_of_condition_sound. eapply ma_perm; eauto. eauto. eauto with na. + eapply match_succ_states; eauto 2 with na. + simpl; destruct b; auto. - (* jumptable *) TransfInstr; UseTransfer. - assert (LD: Val.lessdef rs#arg te#arg) by eauto 2 with na. - rewrite H0 in LD. inv LD. + assert (LD: Val.lessdef rs#arg te#arg) by eauto 2 with na. + rewrite H0 in LD. inv LD. econstructor; split. - eapply exec_Ijumptable; eauto. - eapply match_succ_states; eauto 2 with na. - simpl. eapply list_nth_z_in; eauto. + eapply exec_Ijumptable; eauto. + eapply match_succ_states; eauto 2 with na. + simpl. eapply list_nth_z_in; eauto. - (* return *) TransfInstr; UseTransfer. - exploit magree_free. eauto. eauto. instantiate (1 := nlive ge stk nmem_all). - intros; eapply nlive_dead_stack; eauto. - intros (tm' & A & B). + exploit magree_free. eauto. eauto. instantiate (1 := nlive ge stk nmem_all). + intros; eapply nlive_dead_stack; eauto. + intros (tm' & A & B). econstructor; split. - eapply exec_Ireturn; eauto. - erewrite stacksize_translated by eauto. eexact A. + eapply exec_Ireturn; eauto. + erewrite stacksize_translated by eauto. eexact A. constructor; auto. destruct or; simpl; eauto 2 with na. eapply magree_extends; eauto. apply nlive_all. @@ -1074,28 +1074,28 @@ Ltac UseTransfer := monadInv FUN. generalize EQ. unfold transf_function. intros EQ'. destruct (analyze (vanalyze rm f) f) as [an|] eqn:AN; inv EQ'. exploit Mem.alloc_extends; eauto. apply Zle_refl. apply Zle_refl. - intros (tm' & A & B). + intros (tm' & A & B). econstructor; split. - econstructor; simpl; eauto. - simpl. econstructor; eauto. - apply eagree_init_regs; auto. - apply mextends_agree; auto. + econstructor; simpl; eauto. + simpl. econstructor; eauto. + apply eagree_init_regs; auto. + apply mextends_agree; auto. - (* external function *) exploit external_call_mem_extends; eauto. - intros (res' & tm' & A & B & C & D & E). + intros (res' & tm' & A & B & C & D & E). simpl in FUN. inv FUN. econstructor; split. econstructor; eauto. - eapply external_call_symbols_preserved; eauto. + eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. - econstructor; eauto. + econstructor; eauto. - (* return *) - inv STACKS. inv H1. + inv STACKS. inv H1. econstructor; split. - constructor. - econstructor; eauto. apply mextends_agree; auto. + constructor. + econstructor; eauto. apply mextends_agree; auto. Qed. Lemma transf_initial_states: @@ -1114,10 +1114,10 @@ Proof. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> final_state st1 r -> final_state st2 r. Proof. - intros. inv H0. inv H. inv STACKS. inv RES. constructor. + intros. inv H0. inv H. inv STACKS. inv RES. constructor. Qed. (** * Semantic preservation *) @@ -1130,12 +1130,12 @@ Proof. (match_states := fun s1 s2 => sound_state prog s1 /\ match_states s1 s2). - exact public_preserved. - simpl; intros. exploit transf_initial_states; eauto. intros [st2 [A B]]. - exists st2; intuition. eapply sound_initial; eauto. -- simpl; intros. destruct H. eapply transf_final_states; eauto. + exists st2; intuition. eapply sound_initial; eauto. +- simpl; intros. destruct H. eapply transf_final_states; eauto. - simpl; intros. destruct H0. assert (sound_state prog s1') by (eapply sound_step; eauto). fold ge; fold tge. exploit step_simulation; eauto. intros [st2' [A B]]. - exists st2'; auto. + exists st2'; auto. Qed. End PRESERVATION. diff --git a/backend/Debugvar.v b/backend/Debugvar.v index 314f43fd..dcc4327a 100644 --- a/backend/Debugvar.v +++ b/backend/Debugvar.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Computation of live ranges for local variables that carry +(** Computation of live ranges for local variables that carry debugging information. *) Require Import Coqlib. @@ -154,7 +154,7 @@ Definition eq_debuginfo (i1 i2: debuginfo) : {i1=i2} + {i1 <> i2}. Proof. destruct (eq_arg (proj1_sig i1) (proj1_sig i2)). left. destruct i1, i2; simpl in *. subst x0. f_equal. apply proof_irr. - right. congruence. + right. congruence. Defined. Global Opaque eq_debuginfo. @@ -177,7 +177,7 @@ Fixpoint join (s1: avail) (s2: avail) {struct s1} : avail := Definition eq_state (s1 s2: avail) : {s1=s2} + {s1<>s2}. Proof. - apply list_eq_dec. decide equality. apply eq_debuginfo. apply ident_eq. + apply list_eq_dec. decide equality. apply eq_debuginfo. apply ident_eq. Defined. Global Opaque eq_state. @@ -273,7 +273,7 @@ Definition transfer (lm: labelmap) (before: option avail) (i: instruction): end end. -(** One pass of forward analysis over the code [c]. +(** One pass of forward analysis over the code [c]. Return an updated label map. *) Fixpoint ana_code (lm: labelmap) (before: option avail) (c: code) : labelmap := diff --git a/backend/Debugvarproof.v b/backend/Debugvarproof.v index 6f0b8cda..73e32103 100644 --- a/backend/Debugvarproof.v +++ b/backend/Debugvarproof.v @@ -58,18 +58,18 @@ Qed. Lemma transf_code_match: forall lm c before, match_code c (transf_code lm before c). Proof. - intros lm. fix REC 1. destruct c; intros before; simpl. + intros lm. fix REC 1. destruct c; intros before; simpl. - constructor. - assert (DEFAULT: forall before after, match_code (i :: c) (i :: add_delta_ranges before after (transf_code lm after c))). { intros. constructor. apply REC. } - destruct i; auto. destruct c; auto. destruct i; auto. + destruct i; auto. destruct c; auto. destruct i; auto. set (after := get_label l0 lm). set (c1 := Llabel l0 :: add_delta_ranges before after (transf_code lm after c)). replace c1 with (add_delta_ranges before before c1). constructor. constructor. apply REC. - unfold add_delta_ranges. rewrite delta_state_same. auto. + unfold add_delta_ranges. rewrite delta_state_same. auto. Qed. Inductive match_function: function -> function -> Prop := @@ -80,15 +80,15 @@ Inductive match_function: function -> function -> Prop := Lemma transf_function_match: forall f tf, transf_function f = OK tf -> match_function f tf. Proof. - unfold transf_function; intros. - destruct (ana_function f) as [lm|]; inv H. - constructor. apply transf_code_match. + unfold transf_function; intros. + destruct (ana_function f) as [lm|]; inv H. + constructor. apply transf_code_match. Qed. Remark find_label_add_delta_ranges: forall lbl c before after, find_label lbl (add_delta_ranges before after c) = find_label lbl c. Proof. - intros. unfold add_delta_ranges. + intros. unfold add_delta_ranges. destruct (delta_state before after) as [killed born]. induction killed as [ | [v i] l]; simpl; auto. induction born as [ | [v i] l]; simpl; auto. @@ -104,7 +104,7 @@ Proof. - discriminate. - destruct (is_label lbl i). inv H0. econstructor; econstructor; econstructor; eauto. - rewrite find_label_add_delta_ranges. auto. + rewrite find_label_add_delta_ranges. auto. Qed. Lemma find_label_match: @@ -113,7 +113,7 @@ Lemma find_label_match: find_label lbl f.(fn_code) = Some c -> exists before after tc, find_label lbl tf.(fn_code) = Some (add_delta_ranges before after tc) /\ match_code c tc. Proof. - intros. inv H. eapply find_label_match_rec; eauto. + intros. inv H. eapply find_label_match_rec; eauto. Qed. (** * Properties of availability sets *) @@ -135,9 +135,9 @@ Inductive wf_avail: avail -> Prop := Lemma set_state_1: forall v i s, In (v, i) (set_state v i s). Proof. - induction s as [ | [v' i'] s]; simpl. + induction s as [ | [v' i'] s]; simpl. - auto. -- destruct (Pos.compare v v'); simpl; auto. +- destruct (Pos.compare v v'); simpl; auto. Qed. Lemma set_state_2: @@ -153,7 +153,7 @@ Proof. Qed. Lemma set_state_3: - forall v i v' i' s, + forall v i v' i' s, wf_avail s -> In (v', i') (set_state v i s) -> (v' = v /\ i' = i) \/ (v' <> v /\ In (v', i') s). @@ -162,7 +162,7 @@ Proof. - intuition congruence. - destruct (Pos.compare_spec v v0); simpl in H1. + subst v0. destruct H1. inv H1; auto. right; split. - apply sym_not_equal. apply Plt_ne. eapply H; eauto. + apply sym_not_equal. apply Plt_ne. eapply H; eauto. auto. + destruct H1. inv H1; auto. destruct H1. inv H1. right; split; auto. apply sym_not_equal. apply Plt_ne. auto. @@ -177,12 +177,12 @@ Proof. induction 1; simpl. - constructor. red; simpl; tauto. constructor. - destruct (Pos.compare_spec v v0). -+ subst v0. constructor; auto. -+ constructor. - red; simpl; intros. destruct H2. - inv H2. auto. apply Plt_trans with v0; eauto. ++ subst v0. constructor; auto. ++ constructor. + red; simpl; intros. destruct H2. + inv H2. auto. apply Plt_trans with v0; eauto. constructor; auto. -+ constructor. ++ constructor. red; intros. exploit set_state_3. eexact H0. eauto. intros [[A B] | [A B]]; subst; eauto. auto. Qed. @@ -194,8 +194,8 @@ Proof. - auto. - destruct (Pos.compare_spec v v0); simpl in *. + subst v0. elim (Plt_strict v); eauto. -+ destruct H1. inv H1. elim (Plt_strict v); eauto. - elim (Plt_strict v). apply Plt_trans with v0; eauto. ++ destruct H1. inv H1. elim (Plt_strict v); eauto. + elim (Plt_strict v). apply Plt_trans with v0; eauto. + destruct H1. inv H1. elim (Plt_strict v); eauto. tauto. Qed. @@ -219,7 +219,7 @@ Proof. + subst v0. split; auto. apply sym_not_equal; apply Plt_ne; eauto. + destruct H1. inv H1. split; auto. apply sym_not_equal; apply Plt_ne; eauto. split; auto. apply sym_not_equal; apply Plt_ne. apply Plt_trans with v0; eauto. -+ destruct H1. inv H1. split; auto. apply Plt_ne; auto. ++ destruct H1. inv H1. split; auto. apply Plt_ne; auto. destruct IHwf_avail as [A B] ; auto. Qed. @@ -240,9 +240,9 @@ Lemma wf_filter: Proof. induction 1; simpl. - constructor. -- destruct (pred (v, i)) eqn:P; auto. - constructor; auto. - red; intros. apply filter_In in H1. destruct H1. eauto. +- destruct (pred (v, i)) eqn:P; auto. + constructor; auto. + red; intros. apply filter_In in H1. destruct H1. eauto. Qed. Lemma join_1: @@ -252,12 +252,12 @@ Proof. induction 1; simpl; try tauto; induction 1; simpl; intros I1 I2; auto. destruct I1, I2. - inv H3; inv H4. rewrite Pos.compare_refl. rewrite dec_eq_true; auto with coqlib. -- inv H3. - assert (L: Plt v1 v) by eauto. apply Pos.compare_gt_iff in L. rewrite L. auto. +- inv H3. + assert (L: Plt v1 v) by eauto. apply Pos.compare_gt_iff in L. rewrite L. auto. - inv H4. assert (L: Plt v0 v) by eauto. apply Pos.compare_lt_iff in L. rewrite L. apply IHwf_avail. constructor; auto. auto. auto with coqlib. - destruct (Pos.compare v0 v1). -+ destruct (eq_debuginfo i0 i1); auto with coqlib. ++ destruct (eq_debuginfo i0 i1); auto with coqlib. + apply IHwf_avail; auto with coqlib. constructor; auto. + eauto. Qed. @@ -266,12 +266,12 @@ Lemma join_2: forall v i s1, wf_avail s1 -> forall s2, wf_avail s2 -> In (v, i) (join s1 s2) -> In (v, i) s1 /\ In (v, i) s2. Proof. - induction 1; simpl; try tauto; induction 1; simpl; intros I; try tauto. + induction 1; simpl; try tauto; induction 1; simpl; intros I; try tauto. destruct (Pos.compare_spec v0 v1). - subst v1. destruct (eq_debuginfo i0 i1). + subst i1. destruct I. auto. exploit IHwf_avail; eauto. tauto. + exploit IHwf_avail; eauto. tauto. -- exploit (IHwf_avail ((v1, i1) :: s0)); eauto. constructor; auto. +- exploit (IHwf_avail ((v1, i1) :: s0)); eauto. constructor; auto. simpl. tauto. - exploit IHwf_avail0; eauto. tauto. Qed. @@ -281,10 +281,10 @@ Lemma wf_join: Proof. induction 1; simpl; induction 1; simpl; try constructor. destruct (Pos.compare_spec v v0). -- subst v0. destruct (eq_debuginfo i i0); auto. constructor; auto. +- subst v0. destruct (eq_debuginfo i i0); auto. constructor; auto. red; intros. apply join_2 in H3; auto. destruct H3. eauto. -- apply IHwf_avail. constructor; auto. -- apply IHwf_avail0. +- apply IHwf_avail. constructor; auto. +- apply IHwf_avail0. Qed. (** * Semantic preservation *) @@ -334,7 +334,7 @@ Lemma sig_preserved: Proof. unfold transf_fundef, transf_partial_fundef; intros. destruct f. monadInv H. - exploit transf_function_match; eauto. intros M; inv M; auto. + exploit transf_function_match; eauto. intros M; inv M; auto. inv H. reflexivity. Qed. @@ -360,7 +360,7 @@ Proof. induction a; simpl; intros; try contradiction; try (econstructor; now eauto with barg). destruct H as [S1 S2]. - destruct (IHa1 S1) as [v1 E1]. destruct (IHa2 S2) as [v2 E2]. + destruct (IHa1 S1) as [v1 E1]. destruct (IHa2 S2) as [v2 E2]. exists (Val.longofwords v1 v2); auto with barg. Qed. @@ -369,24 +369,24 @@ Lemma eval_add_delta_ranges: star step tge (State s f sp (add_delta_ranges before after c) rs m) E0 (State s f sp c rs m). Proof. - intros. unfold add_delta_ranges. + intros. unfold add_delta_ranges. destruct (delta_state before after) as [killed born]. induction killed as [ | [v i] l]; simpl. - induction born as [ | [v i] l]; simpl. + apply star_refl. -+ destruct i as [a SAFE]; simpl. - exploit can_eval_safe_arg; eauto. intros [v1 E1]. - eapply star_step; eauto. - econstructor. ++ destruct i as [a SAFE]; simpl. + exploit can_eval_safe_arg; eauto. intros [v1 E1]. + eapply star_step; eauto. + econstructor. constructor. eexact E1. constructor. simpl; constructor. - simpl; auto. + simpl; auto. traceEq. -- eapply star_step; eauto. - econstructor. +- eapply star_step; eauto. + econstructor. constructor. simpl; constructor. - simpl; auto. + simpl; auto. traceEq. Qed. @@ -426,7 +426,7 @@ Lemma parent_locset_match: list_forall2 match_stackframes s ts -> parent_locset ts = parent_locset s. Proof. - induction 1; simpl. auto. inv H; auto. + induction 1; simpl. auto. inv H; auto. Qed. (** The simulation diagram. *) @@ -455,9 +455,9 @@ Proof. - (* load *) econstructor; split. eapply plus_left. - eapply exec_Lload with (a := a). + eapply exec_Lload with (a := a). rewrite <- H; apply eval_addressing_preserved; exact symbols_preserved. - eauto. eauto. + eauto. eauto. apply eval_add_delta_ranges. traceEq. constructor; auto. - (* store *) @@ -465,7 +465,7 @@ Proof. eapply plus_left. eapply exec_Lstore with (a := a). rewrite <- H; apply eval_addressing_preserved; exact symbols_preserved. - eauto. eauto. + eauto. eauto. apply eval_add_delta_ranges. traceEq. constructor; auto. - (* call *) @@ -473,16 +473,16 @@ Proof. econstructor; split. apply plus_one. econstructor. eexact A. symmetry; apply sig_preserved; auto. traceEq. - constructor; auto. constructor; auto. constructor; auto. + constructor; auto. constructor; auto. constructor; auto. - (* tailcall *) exploit find_function_translated; eauto. intros (tf' & A & B). exploit parent_locset_match; eauto. intros PLS. econstructor; split. - apply plus_one. - econstructor. eauto. rewrite PLS. eexact A. + apply plus_one. + econstructor. eauto. rewrite PLS. eexact A. symmetry; apply sig_preserved; auto. inv TRF; eauto. traceEq. - rewrite PLS. constructor; auto. + rewrite PLS. constructor; auto. - (* builtin *) econstructor; split. eapply plus_left. @@ -513,28 +513,28 @@ Proof. - (* jumptable *) exploit find_label_match; eauto. intros (before' & after' & tc' & A & B). econstructor; split. - eapply plus_left. econstructor; eauto. + eapply plus_left. econstructor; eauto. apply eval_add_delta_ranges. reflexivity. traceEq. constructor; auto. - (* return *) econstructor; split. apply plus_one. constructor. inv TRF; eauto. traceEq. - rewrite (parent_locset_match _ _ STACKS). constructor; auto. + rewrite (parent_locset_match _ _ STACKS). constructor; auto. - (* internal function *) - monadInv H7. rename x into tf. + monadInv H7. rename x into tf. assert (MF: match_function f tf) by (apply transf_function_match; auto). inversion MF; subst. econstructor; split. - apply plus_one. constructor. simpl; eauto. reflexivity. - constructor; auto. + apply plus_one. constructor. simpl; eauto. reflexivity. + constructor; auto. - (* external function *) monadInv H8. econstructor; split. - apply plus_one. econstructor; eauto. + apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved'. eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. constructor; auto. - (* return *) - inv H3. inv H1. + inv H3. inv H1. econstructor; split. eapply plus_left. econstructor. apply eval_add_delta_ranges. traceEq. constructor; auto. @@ -545,18 +545,18 @@ Lemma transf_initial_states: exists st2, initial_state tprog st2 /\ match_states st1 st2. Proof. intros. inversion H. - exploit function_ptr_translated; eauto. intros [tf [A B]]. + exploit function_ptr_translated; eauto. intros [tf [A B]]. exists (Callstate nil tf (Locmap.init Vundef) m0); split. - econstructor; eauto. eapply Genv.init_mem_transf_partial; eauto. + econstructor; eauto. eapply Genv.init_mem_transf_partial; eauto. replace (prog_main tprog) with (prog_main prog). rewrite symbols_preserved. eauto. - symmetry. apply (transform_partial_program_main transf_fundef _ TRANSF). + symmetry. apply (transform_partial_program_main transf_fundef _ TRANSF). rewrite <- H3. apply sig_preserved. auto. constructor. constructor. auto. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> final_state st1 r -> final_state st2 r. Proof. intros. inv H0. inv H. inv H6. econstructor; eauto. diff --git a/backend/IRC.ml b/backend/IRC.ml index dcd8624a..eb677069 100644 --- a/backend/IRC.ml +++ b/backend/IRC.ml @@ -163,7 +163,7 @@ module DLinkMove = struct type t = move let make state = let rec empty = - { src = DLinkNode.dummy; dst = DLinkNode.dummy; + { src = DLinkNode.dummy; dst = DLinkNode.dummy; mstate = state; mprev = empty; mnext = empty } in empty let dummy = make CoalescedMoves @@ -301,7 +301,7 @@ let init costs = worklistMoves = DLinkMove.make WorklistMoves; activeMoves = DLinkMove.make ActiveMoves } - + (* Create nodes corresponding to XTL variables *) let weightedSpillCost st = @@ -312,7 +312,7 @@ let weightedSpillCost st = let newNodeOfReg g r ty = let st = g.stats_of_reg r in g.nextIdent <- g.nextIdent + 1; - { ident = g.nextIdent; typ = ty; + { ident = g.nextIdent; typ = ty; var = V(r, ty); regclass = if st.cost >= 0 then class_of_type ty else no_spill_class; accesses = st.usedefs; @@ -328,7 +328,7 @@ let newNodeOfReg g r ty = let newNodeOfLoc g l = let ty = Loc.coq_type l in g.nextIdent <- g.nextIdent + 1; - { ident = g.nextIdent; typ = ty; + { ident = g.nextIdent; typ = ty; var = L l; regclass = class_of_type ty; accesses = 0; spillcost = 0.0; adjlist = []; degree = 0; movelist = []; extra_adj = []; extra_pref = []; @@ -608,9 +608,9 @@ let canCoalesceGeorge g u v = - If [u] is precolored, use George's criterion. - If [u] is not precolored, use Briggs's criterion. - As noted by Hailperin, for non-precolored nodes, George's criterion + As noted by Hailperin, for non-precolored nodes, George's criterion is incomparable with Briggs's: there are cases where G says yes - and B says no. Typically, [u] is a long-lived variable with many + and B says no. Typically, [u] is a long-lived variable with many interferences, and [v] is a short-lived temporary copy of [u] that has no more interferences than [u]. Coalescing [u] and [v] is "weakly safe" in Hailperin's terminology: [u] is no harder to color, @@ -690,7 +690,7 @@ let coalesce g = combine g u v; addWorkList g u end else begin - DLinkMove.insert m g.activeMoves + DLinkMove.insert m g.activeMoves end (* Freeze moves associated with node [u] *) diff --git a/backend/Inlining.v b/backend/Inlining.v index 08f2bfc4..566ab27c 100644 --- a/backend/Inlining.v +++ b/backend/Inlining.v @@ -107,7 +107,7 @@ Definition initstate := mkstate 1%positive 1%positive (PTree.empty instruction) 0. Program Definition set_instr (pc: node) (i: instruction): mon unit := - fun s => + fun s => R tt (mkstate s.(st_nextreg) s.(st_nextnode) (PTree.set pc i s.(st_code)) s.(st_stksize)) _. @@ -144,7 +144,7 @@ Next Obligation. Qed. Program Definition request_stack (sz: Z): mon unit := - fun s => + fun s => R tt (mkstate s.(st_nextreg) s.(st_nextnode) s.(st_code) (Zmax s.(st_stksize) sz)) _. @@ -154,14 +154,14 @@ Qed. Program Definition ptree_mfold {A: Type} (f: positive -> A -> mon unit) (t: PTree.t A): mon unit := fun s => - R tt + R tt (PTree.fold (fun s1 k v => match f k v s1 return _ with R _ s2 _ => s2 end) t s) _. Next Obligation. apply PTree_Properties.fold_rec. auto. apply sincr_refl. - intros. destruct (f k v a). eapply sincr_trans; eauto. + intros. destruct (f k v a). eapply sincr_trans; eauto. Qed. (** ** Inlining contexts *) @@ -280,7 +280,7 @@ Section EXPAND_CFG. Variable fenv: funenv. -(** The [rec] parameter is the recursor: [rec fenv' P ctx f] copies +(** The [rec] parameter is the recursor: [rec fenv' P ctx f] copies the body of function [f], with inline expansion within, as governed by context [ctx]. It can only be called for function environments [fenv'] strictly smaller than the current environment [fenv]. *) @@ -311,7 +311,7 @@ Definition inline_function (ctx: context) (id: ident) (f: function) let nreg := max_reg_function f in do dpc <- reserve_nodes npc; do dreg <- reserve_regs nreg; - let ctx' := callcontext ctx dpc dreg nreg f.(fn_stacksize) retpc retreg in + let ctx' := callcontext ctx dpc dreg nreg f.(fn_stacksize) retpc retreg in do x <- rec (PTree.remove id fenv) (PTree_Properties.cardinal_remove P) ctx' f; add_moves (sregs ctx args) (sregs ctx' f.(fn_params)) (spc ctx' f.(fn_entrypoint)). @@ -325,7 +325,7 @@ Definition inline_tail_function (ctx: context) (id: ident) (f: function) let nreg := max_reg_function f in do dpc <- reserve_nodes npc; do dreg <- reserve_regs nreg; - let ctx' := tailcontext ctx dpc dreg nreg f.(fn_stacksize) in + let ctx' := tailcontext ctx dpc dreg nreg f.(fn_stacksize) in do x <- rec (PTree.remove id fenv) (PTree_Properties.cardinal_remove P) ctx' f; add_moves (sregs ctx args) (sregs ctx' f.(fn_params)) (spc ctx' f.(fn_entrypoint)). @@ -341,7 +341,7 @@ Definition inline_return (ctx: context) (or: option reg) (retinfo: node * reg) : (** Expansion and copying of an instruction. For most instructions, its registers and successor PC are shifted as per the context [ctx], then the instruction is inserted in the final CFG at its final position - [spc ctx pc]. + [spc ctx pc]. [Icall] instructions are either replaced by a "goto" to the expansion of the called function, or shifted as described above. @@ -393,7 +393,7 @@ Definition expand_instr (ctx: context) (pc: node) (i: instruction): mon unit := | Can_inline id f P Q => do n <- inline_tail_function ctx id f Q args; set_instr (spc ctx pc) (Inop n) - end + end | Ibuiltin ef args res s => set_instr (spc ctx pc) (Ibuiltin ef (map (sbuiltinarg ctx) args) (sbuiltinres ctx res) (spc ctx s)) @@ -434,7 +434,7 @@ Definition expand_function (fenv: funenv) (f: function): mon context := let nreg := max_reg_function f in do dpc <- reserve_nodes npc; do dreg <- reserve_regs nreg; - let ctx := initcontext dpc dreg nreg f.(fn_stacksize) in + let ctx := initcontext dpc dreg nreg f.(fn_stacksize) in do x <- expand_cfg fenv ctx f; ret ctx. @@ -450,7 +450,7 @@ Local Open Scope string_scope. Definition transf_function (fenv: funenv) (f: function) : Errors.res function := let '(R ctx s _) := expand_function fenv f initstate in if zlt s.(st_stksize) Int.max_unsigned then - OK (mkfunction f.(fn_sig) + OK (mkfunction f.(fn_sig) (sregs ctx f.(fn_params)) s.(st_stksize) s.(st_code) diff --git a/backend/Inliningproof.v b/backend/Inliningproof.v index c7cc8d8a..ad861543 100644 --- a/backend/Inliningproof.v +++ b/backend/Inliningproof.v @@ -71,7 +71,7 @@ Lemma sig_function_translated: forall f f', transf_fundef fenv f = OK f' -> funsig f' = funsig f. Proof. intros. destruct f; Errors.monadInv H. - exploit transf_function_spec; eauto. intros SP; inv SP. auto. + exploit transf_function_spec; eauto. intros SP; inv SP. auto. auto. Qed. @@ -80,7 +80,7 @@ Qed. Remark sreg_below_diff: forall ctx r r', Plt r' ctx.(dreg) -> sreg ctx r <> r'. Proof. - intros. zify. unfold sreg; rewrite shiftpos_eq. xomega. + intros. zify. unfold sreg; rewrite shiftpos_eq. xomega. Qed. Remark context_below_diff: @@ -93,7 +93,7 @@ Qed. Remark context_below_lt: forall ctx1 ctx2 r, context_below ctx1 ctx2 -> Ple r ctx1.(mreg) -> Plt (sreg ctx1 r) ctx2.(dreg). Proof. - intros. red in H. unfold Plt; zify. unfold sreg; rewrite shiftpos_eq. + intros. red in H. unfold Plt; zify. unfold sreg; rewrite shiftpos_eq. xomega. Qed. @@ -101,7 +101,7 @@ Qed. Remark context_below_le: forall ctx1 ctx2 r, context_below ctx1 ctx2 -> Ple r ctx1.(mreg) -> Ple (sreg ctx1 r) ctx2.(dreg). Proof. - intros. red in H. unfold Ple; zify. unfold sreg; rewrite shiftpos_eq. + intros. red in H. unfold Ple; zify. unfold sreg; rewrite shiftpos_eq. xomega. Qed. *) @@ -125,8 +125,8 @@ Lemma agree_val_reg_gen: forall F ctx rs rs' r, agree_regs F ctx rs rs' -> val_reg_charact F ctx rs' rs#r r. Proof. intros. destruct H as [A B]. - destruct (Plt_Ple_dec (mreg ctx) r). - left. rewrite B; auto. + destruct (Plt_Ple_dec (mreg ctx) r). + left. rewrite B; auto. right. auto. Qed. @@ -159,10 +159,10 @@ Lemma agree_set_reg: agree_regs F ctx (rs#r <- v) (rs'#(sreg ctx r) <- v'). Proof. unfold agree_regs; intros. destruct H. split; intros. - repeat rewrite Regmap.gsspec. + repeat rewrite Regmap.gsspec. destruct (peq r0 r). subst r0. rewrite peq_true. auto. - rewrite peq_false. auto. apply shiftpos_diff; auto. - rewrite Regmap.gso. auto. xomega. + rewrite peq_false. auto. apply shiftpos_diff; auto. + rewrite Regmap.gso. auto. xomega. Qed. Lemma agree_set_reg_undef: @@ -171,10 +171,10 @@ Lemma agree_set_reg_undef: agree_regs F ctx (rs#r <- Vundef) (rs'#(sreg ctx r) <- v'). Proof. unfold agree_regs; intros. destruct H. split; intros. - repeat rewrite Regmap.gsspec. + repeat rewrite Regmap.gsspec. destruct (peq r0 r). subst r0. rewrite peq_true. auto. - rewrite peq_false. auto. apply shiftpos_diff; auto. - rewrite Regmap.gsspec. destruct (peq r0 r); auto. + rewrite peq_false. auto. apply shiftpos_diff; auto. + rewrite Regmap.gsspec. destruct (peq r0 r); auto. Qed. Lemma agree_set_reg_undef': @@ -183,9 +183,9 @@ Lemma agree_set_reg_undef': agree_regs F ctx (rs#r <- Vundef) rs'. Proof. unfold agree_regs; intros. destruct H. split; intros. - rewrite Regmap.gsspec. + rewrite Regmap.gsspec. destruct (peq r0 r). subst r0. auto. auto. - rewrite Regmap.gsspec. destruct (peq r0 r); auto. + rewrite Regmap.gsspec. destruct (peq r0 r); auto. Qed. Lemma agree_regs_invariant: @@ -195,7 +195,7 @@ Lemma agree_regs_invariant: agree_regs F ctx rs rs2. Proof. unfold agree_regs; intros. destruct H. split; intros. - rewrite H0. auto. + rewrite H0. auto. apply shiftpos_above. eapply Plt_le_trans. apply shiftpos_below. xomega. apply H1; auto. @@ -207,13 +207,13 @@ Lemma agree_regs_incr: inject_incr F F' -> agree_regs F' ctx rs1 rs2. Proof. - intros. destruct H. split; intros. eauto. auto. + intros. destruct H. split; intros. eauto. auto. Qed. Remark agree_regs_init: forall F ctx rs, agree_regs F ctx (Regmap.init Vundef) rs. Proof. - intros; split; intros. rewrite Regmap.gi; auto. rewrite Regmap.gi; auto. + intros; split; intros. rewrite Regmap.gi; auto. rewrite Regmap.gi; auto. Qed. Lemma agree_regs_init_regs: @@ -225,7 +225,7 @@ Proof. induction rl; simpl; intros. apply agree_regs_init. inv H. apply agree_regs_init. - apply agree_set_reg; auto. + apply agree_set_reg; auto. Qed. (** ** Executing sequences of moves *) @@ -246,7 +246,7 @@ Proof. (* rdsts = nil *) inv H0. exists rs1; split. apply star_refl. split. apply agree_regs_init. auto. (* rdsts = a :: rdsts *) - inv H2. inv H0. + inv H2. inv H0. exists rs1; split. apply star_refl. split. apply agree_regs_init. auto. simpl in H0. inv H0. exploit IHrdsts; eauto. intros [rs2 [A [B C]]]. @@ -285,7 +285,7 @@ Lemma range_private_invariant: range_private F1 m1 m1' sp lo hi. Proof. intros; red; intros. exploit H; eauto. intros [A B]. split; auto. - intros; red; intros. exploit H0; eauto. omega. intros [P Q]. + intros; red; intros. exploit H0; eauto. omega. intros [P Q]. eelim B; eauto. Qed. @@ -305,14 +305,14 @@ Lemma range_private_alloc_left: (forall b, b <> sp -> F1 b = F b) -> range_private F1 m1 m' sp' (base + Zmax sz 0) hi. Proof. - intros; red; intros. + intros; red; intros. exploit (H ofs). generalize (Zmax2 sz 0). omega. intros [A B]. split; auto. intros; red; intros. exploit Mem.perm_alloc_inv; eauto. destruct (eq_block b sp); intros. - subst b. rewrite H1 in H4; inv H4. + subst b. rewrite H1 in H4; inv H4. rewrite Zmax_spec in H3. destruct (zlt 0 sz); omega. - rewrite H2 in H4; auto. eelim B; eauto. + rewrite H2 in H4; auto. eelim B; eauto. Qed. Lemma range_private_free_left: @@ -323,22 +323,22 @@ Lemma range_private_free_left: Mem.inject F m m' -> range_private F m1 m' sp base hi. Proof. - intros; red; intros. + intros; red; intros. destruct (zlt ofs (base + Zmax sz 0)) as [z|z]. - red; split. + red; split. replace ofs with ((ofs - base) + base) by omega. eapply Mem.perm_inject; eauto. eapply Mem.free_range_perm; eauto. - rewrite Zmax_spec in z. destruct (zlt 0 sz); omega. + rewrite Zmax_spec in z. destruct (zlt 0 sz); omega. intros; red; intros. destruct (eq_block b b0). subst b0. rewrite H1 in H4; inv H4. eelim Mem.perm_free_2; eauto. rewrite Zmax_spec in z. destruct (zlt 0 sz); omega. - exploit Mem.mi_no_overlap; eauto. + exploit Mem.mi_no_overlap; eauto. apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. - eapply Mem.free_range_perm. eauto. + eapply Mem.free_range_perm. eauto. instantiate (1 := ofs - base). rewrite Zmax_spec in z. destruct (zlt 0 sz); omega. - eapply Mem.perm_free_3; eauto. - intros [A | A]. congruence. omega. + eapply Mem.perm_free_3; eauto. + intros [A | A]. congruence. omega. exploit (H ofs). omega. intros [A B]. split. auto. intros; red; intros. eelim B; eauto. eapply Mem.perm_free_3; eauto. @@ -358,13 +358,13 @@ Lemma range_private_extcall: Proof. intros until hi; intros RP PERM UNCH INJ INCR SEP VB. red; intros. exploit RP; eauto. intros [A B]. - split. eapply Mem.perm_unchanged_on; eauto. + split. eapply Mem.perm_unchanged_on; eauto. intros. red in SEP. destruct (F b) as [[sp1 delta1] |] eqn:?. - exploit INCR; eauto. intros EQ; rewrite H0 in EQ; inv EQ. - red; intros; eelim B; eauto. eapply PERM; eauto. - red. destruct (plt b (Mem.nextblock m1)); auto. + exploit INCR; eauto. intros EQ; rewrite H0 in EQ; inv EQ. + red; intros; eelim B; eauto. eapply PERM; eauto. + red. destruct (plt b (Mem.nextblock m1)); auto. exploit Mem.mi_freeblocks; eauto. congruence. - exploit SEP; eauto. tauto. + exploit SEP; eauto. tauto. Qed. (** ** Relating global environments *) @@ -392,7 +392,7 @@ Proof. assert (A: Val.inject F rs#r rs'#(sreg ctx r)). eapply agree_val_reg; eauto. rewrite EQ in A; inv A. inv H1. rewrite DOMAIN in H5. inv H5. auto. - apply FUNCTIONS with fd. + apply FUNCTIONS with fd. rewrite EQ in H; rewrite Genv.find_funct_find_funct_ptr in H. auto. rewrite H2. eapply functions_translated; eauto. (* symbol *) @@ -419,24 +419,24 @@ Proof. - econstructor; eauto with barg. - econstructor; eauto with barg. - econstructor; eauto with barg. -- exploit Mem.loadv_inject; eauto. - instantiate (1 := Vptr sp' (Int.add ofs (Int.repr (dstk ctx)))). +- exploit Mem.loadv_inject; eauto. + instantiate (1 := Vptr sp' (Int.add ofs (Int.repr (dstk ctx)))). simpl. econstructor; eauto. rewrite Int.add_zero_l; auto. - intros (v' & A & B). exists v'; split; auto. constructor. simpl. rewrite Int.add_zero_l; auto. + intros (v' & A & B). exists v'; split; auto. constructor. simpl. rewrite Int.add_zero_l; auto. - econstructor; split. constructor. simpl. econstructor; eauto. rewrite ! Int.add_zero_l; auto. - assert (Val.inject F (Senv.symbol_address ge id ofs) (Senv.symbol_address tge id ofs)). - { unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. + { unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. rewrite symbols_preserved. destruct (Genv.find_symbol ge id) as [b|] eqn:FS; auto. inv MG. econstructor. eauto. rewrite Int.add_zero; auto. } exploit Mem.loadv_inject; eauto. intros (v' & A & B). - exists v'; eauto with barg. -- econstructor; split. constructor. - unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. + exists v'; eauto with barg. +- econstructor; split. constructor. + unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. rewrite symbols_preserved. destruct (Genv.find_symbol ge id) as [b|] eqn:FS; auto. inv MG. econstructor. eauto. rewrite Int.add_zero; auto. - destruct IHeval_builtin_arg1 as (v1 & A1 & B1). destruct IHeval_builtin_arg2 as (v2 & A2 & B2). - econstructor; split. eauto with barg. apply Val.longofwords_inject; auto. + econstructor; split. eauto with barg. apply Val.longofwords_inject; auto. Qed. Lemma tr_builtin_args: @@ -522,7 +522,7 @@ Lemma match_stacks_globalenvs: forall stk stk' bound, match_stacks F m m' stk stk' bound -> exists b, match_globalenvs F b with match_stacks_inside_globalenvs: - forall stk stk' f ctx sp rs', + forall stk stk' f ctx sp rs', match_stacks_inside F m m' stk stk' f ctx sp rs' -> exists b, match_globalenvs F b. Proof. induction 1; eauto. @@ -534,13 +534,13 @@ Lemma match_globalenvs_preserves_globals: Proof. intros. inv H. red. split. eauto. split. eauto. intros. symmetry. eapply IMAGE; eauto. -Qed. +Qed. Lemma match_stacks_inside_globals: - forall stk stk' f ctx sp rs', + forall stk stk' f ctx sp rs', match_stacks_inside F m m' stk stk' f ctx sp rs' -> meminj_preserves_globals ge F. Proof. - intros. exploit match_stacks_inside_globalenvs; eauto. intros [b A]. + intros. exploit match_stacks_inside_globalenvs; eauto. intros [b A]. eapply match_globalenvs_preserves_globals; eauto. Qed. @@ -551,10 +551,10 @@ Lemma match_stacks_bound: match_stacks F m m' stk stk' bound1. Proof. intros. inv H. - apply match_stacks_nil with bound0. auto. eapply Ple_trans; eauto. - eapply match_stacks_cons; eauto. eapply Plt_le_trans; eauto. - eapply match_stacks_untailcall; eauto. eapply Plt_le_trans; eauto. -Qed. + apply match_stacks_nil with bound0. auto. eapply Ple_trans; eauto. + eapply match_stacks_cons; eauto. eapply Plt_le_trans; eauto. + eapply match_stacks_untailcall; eauto. eapply Plt_le_trans; eauto. +Qed. Variable F1: meminj. Variables m1 m1': mem. @@ -562,7 +562,7 @@ Hypothesis INCR: inject_incr F F1. Lemma match_stacks_invariant: forall stk stk' bound, match_stacks F m m' stk stk' bound -> - forall (INJ: forall b1 b2 delta, + forall (INJ: forall b1 b2 delta, F1 b1 = Some(b2, delta) -> Plt b2 bound -> F b1 = Some(b2, delta)) (PERM1: forall b1 b2 delta ofs, F1 b1 = Some(b2, delta) -> Plt b2 bound -> @@ -574,11 +574,11 @@ Lemma match_stacks_invariant: match_stacks F1 m1 m1' stk stk' bound with match_stacks_inside_invariant: - forall stk stk' f' ctx sp' rs1, + forall stk stk' f' ctx sp' rs1, match_stacks_inside F m m' stk stk' f' ctx sp' rs1 -> forall rs2 (RS: forall r, Plt r ctx.(dreg) -> rs2#r = rs1#r) - (INJ: forall b1 b2 delta, + (INJ: forall b1 b2 delta, F1 b1 = Some(b2, delta) -> Ple b2 sp' -> F b1 = Some(b2, delta)) (PERM1: forall b1 b2 delta ofs, F1 b1 = Some(b2, delta) -> Ple b2 sp' -> @@ -593,42 +593,42 @@ Proof. induction 1; intros. (* nil *) apply match_stacks_nil with (bound1 := bound1). - inv MG. constructor; auto. + inv MG. constructor; auto. intros. apply IMAGE with delta. eapply INJ; eauto. eapply Plt_le_trans; eauto. auto. auto. (* cons *) apply match_stacks_cons with (ctx := ctx); auto. eapply match_stacks_inside_invariant; eauto. - intros; eapply INJ; eauto; xomega. + intros; eapply INJ; eauto; xomega. intros; eapply PERM1; eauto; xomega. intros; eapply PERM2; eauto; xomega. intros; eapply PERM3; eauto; xomega. eapply agree_regs_incr; eauto. - eapply range_private_invariant; eauto. + eapply range_private_invariant; eauto. (* untailcall *) - apply match_stacks_untailcall with (ctx := ctx); auto. + apply match_stacks_untailcall with (ctx := ctx); auto. eapply match_stacks_inside_invariant; eauto. intros; eapply INJ; eauto; xomega. intros; eapply PERM1; eauto; xomega. intros; eapply PERM2; eauto; xomega. intros; eapply PERM3; eauto; xomega. - eapply range_private_invariant; eauto. + eapply range_private_invariant; eauto. induction 1; intros. (* base *) eapply match_stacks_inside_base; eauto. - eapply match_stacks_invariant; eauto. + eapply match_stacks_invariant; eauto. intros; eapply INJ; eauto; xomega. intros; eapply PERM1; eauto; xomega. intros; eapply PERM2; eauto; xomega. intros; eapply PERM3; eauto; xomega. (* inlined *) - apply match_stacks_inside_inlined with (ctx' := ctx'); auto. + apply match_stacks_inside_inlined with (ctx' := ctx'); auto. apply IHmatch_stacks_inside; auto. - intros. apply RS. red in BELOW. xomega. - apply agree_regs_incr with F; auto. - apply agree_regs_invariant with rs'; auto. - intros. apply RS. red in BELOW. xomega. + intros. apply RS. red in BELOW. xomega. + apply agree_regs_incr with F; auto. + apply agree_regs_invariant with rs'; auto. + intros. apply RS. red in BELOW. xomega. eapply range_private_invariant; eauto. intros. split. eapply INJ; eauto. xomega. eapply PERM1; eauto. xomega. intros. eapply PERM2; eauto. xomega. @@ -655,33 +655,33 @@ End MATCH_STACKS. (** Preservation by assignment to a register *) Lemma match_stacks_inside_set_reg: - forall F m m' stk stk' f' ctx sp' rs' r v, + forall F m m' stk stk' f' ctx sp' rs' r v, match_stacks_inside F m m' stk stk' f' ctx sp' rs' -> match_stacks_inside F m m' stk stk' f' ctx sp' (rs'#(sreg ctx r) <- v). Proof. - intros. eapply match_stacks_inside_invariant; eauto. + intros. eapply match_stacks_inside_invariant; eauto. intros. apply Regmap.gso. zify. unfold sreg; rewrite shiftpos_eq. xomega. Qed. Lemma match_stacks_inside_set_res: - forall F m m' stk stk' f' ctx sp' rs' res v, + forall F m m' stk stk' f' ctx sp' rs' res v, match_stacks_inside F m m' stk stk' f' ctx sp' rs' -> match_stacks_inside F m m' stk stk' f' ctx sp' (regmap_setres (sbuiltinres ctx res) v rs'). Proof. - intros. destruct res; simpl; auto. + intros. destruct res; simpl; auto. apply match_stacks_inside_set_reg; auto. Qed. (** Preservation by a memory store *) Lemma match_stacks_inside_store: - forall F m m' stk stk' f' ctx sp' rs' chunk b ofs v m1 chunk' b' ofs' v' m1', + forall F m m' stk stk' f' ctx sp' rs' chunk b ofs v m1 chunk' b' ofs' v' m1', match_stacks_inside F m m' stk stk' f' ctx sp' rs' -> Mem.store chunk m b ofs v = Some m1 -> Mem.store chunk' m' b' ofs' v' = Some m1' -> match_stacks_inside F m1 m1' stk stk' f' ctx sp' rs'. Proof. - intros. + intros. eapply match_stacks_inside_invariant; eauto with mem. Qed. @@ -700,21 +700,21 @@ Lemma match_stacks_inside_alloc_left: Proof. induction 1; intros. (* base *) - eapply match_stacks_inside_base; eauto. + eapply match_stacks_inside_base; eauto. eapply match_stacks_invariant; eauto. intros. destruct (eq_block b1 b). - subst b1. rewrite H1 in H4; inv H4. eelim Plt_strict; eauto. - rewrite H2 in H4; auto. + subst b1. rewrite H1 in H4; inv H4. eelim Plt_strict; eauto. + rewrite H2 in H4; auto. intros. exploit Mem.perm_alloc_inv; eauto. destruct (eq_block b1 b); intros; auto. - subst b1. rewrite H1 in H4. inv H4. eelim Plt_strict; eauto. + subst b1. rewrite H1 in H4. inv H4. eelim Plt_strict; eauto. (* inlined *) - eapply match_stacks_inside_inlined; eauto. - eapply IHmatch_stacks_inside; eauto. destruct SBELOW. omega. + eapply match_stacks_inside_inlined; eauto. + eapply IHmatch_stacks_inside; eauto. destruct SBELOW. omega. eapply agree_regs_incr; eauto. - eapply range_private_invariant; eauto. + eapply range_private_invariant; eauto. intros. exploit Mem.perm_alloc_inv; eauto. destruct (eq_block b0 b); intros. - subst b0. rewrite H2 in H5; inv H5. elimtype False; xomega. - rewrite H3 in H5; auto. + subst b0. rewrite H2 in H5; inv H5. elimtype False; xomega. + rewrite H3 in H5; auto. Qed. (** Preservation by freeing *) @@ -726,7 +726,7 @@ Lemma match_stacks_free_left: match_stacks F m1 m' stk stk' sp. Proof. intros. eapply match_stacks_invariant; eauto. - intros. eapply Mem.perm_free_3; eauto. + intros. eapply Mem.perm_free_3; eauto. Qed. Lemma match_stacks_free_right: @@ -735,18 +735,18 @@ Lemma match_stacks_free_right: Mem.free m' sp lo hi = Some m1' -> match_stacks F m m1' stk stk' sp. Proof. - intros. eapply match_stacks_invariant; eauto. - intros. eapply Mem.perm_free_1; eauto. + intros. eapply match_stacks_invariant; eauto. + intros. eapply Mem.perm_free_1; eauto. intros. eapply Mem.perm_free_3; eauto. Qed. Lemma min_alignment_sound: forall sz n, (min_alignment sz | n) -> Mem.inj_offset_aligned n sz. Proof. - intros; red; intros. unfold min_alignment in H. + intros; red; intros. unfold min_alignment in H. assert (2 <= sz -> (2 | n)). intros. destruct (zle sz 1). omegaContradiction. - destruct (zle sz 2). auto. + destruct (zle sz 2). auto. destruct (zle sz 4). apply Zdivides_trans with 4; auto. exists 2; auto. apply Zdivides_trans with 8; auto. exists 4; auto. assert (4 <= sz -> (4 | n)). intros. @@ -780,7 +780,7 @@ Hypothesis INCR: inject_incr F1 F2. Hypothesis SEP: inject_separated F1 F2 m1 m1'. Lemma match_stacks_extcall: - forall stk stk' bound, + forall stk stk' bound, match_stacks F1 m1 m1' stk stk' bound -> Ple bound (Mem.nextblock m1') -> match_stacks F2 m2 m2' stk stk' bound @@ -791,25 +791,25 @@ with match_stacks_inside_extcall: match_stacks_inside F2 m2 m2' stk stk' f' ctx sp' rs'. Proof. induction 1; intros. - apply match_stacks_nil with bound1; auto. - inv MG. constructor; intros; eauto. + apply match_stacks_nil with bound1; auto. + inv MG. constructor; intros; eauto. destruct (F1 b1) as [[b2' delta']|] eqn:?. - exploit INCR; eauto. intros EQ; rewrite H0 in EQ; inv EQ. eapply IMAGE; eauto. - exploit SEP; eauto. intros [A B]. elim B. red. xomega. - eapply match_stacks_cons; eauto. - eapply match_stacks_inside_extcall; eauto. xomega. - eapply agree_regs_incr; eauto. - eapply range_private_extcall; eauto. red; xomega. + exploit INCR; eauto. intros EQ; rewrite H0 in EQ; inv EQ. eapply IMAGE; eauto. + exploit SEP; eauto. intros [A B]. elim B. red. xomega. + eapply match_stacks_cons; eauto. + eapply match_stacks_inside_extcall; eauto. xomega. + eapply agree_regs_incr; eauto. + eapply range_private_extcall; eauto. red; xomega. intros. apply SSZ2; auto. apply MAXPERM'; auto. red; xomega. - eapply match_stacks_untailcall; eauto. - eapply match_stacks_inside_extcall; eauto. xomega. - eapply range_private_extcall; eauto. red; xomega. + eapply match_stacks_untailcall; eauto. + eapply match_stacks_inside_extcall; eauto. xomega. + eapply range_private_extcall; eauto. red; xomega. intros. apply SSZ2; auto. apply MAXPERM'; auto. red; xomega. induction 1; intros. eapply match_stacks_inside_base; eauto. - eapply match_stacks_extcall; eauto. xomega. - eapply match_stacks_inside_inlined; eauto. - eapply agree_regs_incr; eauto. + eapply match_stacks_extcall; eauto. xomega. + eapply match_stacks_inside_inlined; eauto. + eapply agree_regs_incr; eauto. eapply range_private_extcall; eauto. Qed. @@ -820,7 +820,7 @@ End EXTCALL. Lemma align_unchanged: forall n amount, amount > 0 -> (amount | n) -> align n amount = n. Proof. - intros. destruct H0 as [p EQ]. subst n. unfold align. decEq. + intros. destruct H0 as [p EQ]. subst n. unfold align. decEq. apply Zdiv_unique with (b := amount - 1). omega. omega. Qed. @@ -836,15 +836,15 @@ Lemma match_stacks_inside_inlined_tailcall: Proof. intros. inv H. (* base *) - eapply match_stacks_inside_base; eauto. congruence. + eapply match_stacks_inside_base; eauto. congruence. rewrite H1. rewrite DSTK. apply align_unchanged. apply min_alignment_pos. apply Zdivide_0. (* inlined *) assert (dstk ctx <= dstk ctx'). rewrite H1. apply align_le. apply min_alignment_pos. - eapply match_stacks_inside_inlined; eauto. - red; intros. destruct (zlt ofs (dstk ctx)). apply PAD; omega. apply H3. inv H4. xomega. - congruence. + eapply match_stacks_inside_inlined; eauto. + red; intros. destruct (zlt ofs (dstk ctx)). apply PAD; omega. apply H3. inv H4. xomega. + congruence. unfold context_below in *. xomega. - unfold context_stack_call in *. omega. + unfold context_stack_call in *. omega. Qed. (** ** Relating states *) @@ -915,7 +915,7 @@ Lemma tr_funbody_inv: forall sz cts f c pc i, tr_funbody fenv sz cts f c -> f.(fn_code)!pc = Some i -> tr_instr fenv sz cts pc i c. Proof. - intros. inv H. eauto. + intros. inv H. eauto. Qed. Theorem step_simulation: @@ -929,13 +929,13 @@ Proof. (* nop *) exploit tr_funbody_inv; eauto. intros TR; inv TR. - left; econstructor; split. + left; econstructor; split. eapply plus_one. eapply exec_Inop; eauto. econstructor; eauto. (* op *) exploit tr_funbody_inv; eauto. intros TR; inv TR. - exploit eval_operation_inject. + exploit eval_operation_inject. eapply match_stacks_inside_globals; eauto. eexact SP. instantiate (2 := rs##args). instantiate (1 := rs'##(sregs ctx args)). eapply agree_val_regs; eauto. @@ -943,14 +943,14 @@ Proof. fold (sop ctx op). intros [v' [A B]]. left; econstructor; split. eapply plus_one. eapply exec_Iop; eauto. erewrite eval_operation_preserved; eauto. - exact symbols_preserved. - econstructor; eauto. + exact symbols_preserved. + econstructor; eauto. apply match_stacks_inside_set_reg; auto. - apply agree_set_reg; auto. - + apply agree_set_reg; auto. + (* load *) exploit tr_funbody_inv; eauto. intros TR; inv TR. - exploit eval_addressing_inject. + exploit eval_addressing_inject. eapply match_stacks_inside_globals; eauto. eexact SP. instantiate (2 := rs##args). instantiate (1 := rs'##(sregs ctx args)). eapply agree_val_regs; eauto. @@ -961,19 +961,19 @@ Proof. rewrite <- P. apply eval_addressing_preserved. exact symbols_preserved. left; econstructor; split. eapply plus_one. eapply exec_Iload; eauto. - econstructor; eauto. + econstructor; eauto. apply match_stacks_inside_set_reg; auto. - apply agree_set_reg; auto. + apply agree_set_reg; auto. (* store *) exploit tr_funbody_inv; eauto. intros TR; inv TR. - exploit eval_addressing_inject. + exploit eval_addressing_inject. eapply match_stacks_inside_globals; eauto. eexact SP. instantiate (2 := rs##args). instantiate (1 := rs'##(sregs ctx args)). eapply agree_val_regs; eauto. eauto. fold saddr. intros [a' [P Q]]. - exploit Mem.storev_mapped_inject; eauto. eapply agree_val_reg; eauto. + exploit Mem.storev_mapped_inject; eauto. eapply agree_val_reg; eauto. intros [m1' [U V]]. assert (eval_addressing tge (Vptr sp' Int.zero) (saddr ctx addr) rs' ## (sregs ctx args) = Some a'). rewrite <- P. apply eval_addressing_preserved. exact symbols_preserved. @@ -998,32 +998,32 @@ Proof. eapply plus_one. eapply exec_Icall; eauto. eapply sig_function_translated; eauto. econstructor; eauto. - eapply match_stacks_cons; eauto. - eapply agree_val_regs; eauto. + eapply match_stacks_cons; eauto. + eapply agree_val_regs; eauto. (* inlined *) assert (fd = Internal f0). simpl in H0. destruct (Genv.find_symbol ge id) as [b|] eqn:?; try discriminate. - exploit (funenv_program_compat prog); eauto. intros. + exploit (funenv_program_compat prog); eauto. intros. unfold ge in H0. congruence. subst fd. - right; split. simpl; omega. split. auto. - econstructor; eauto. + right; split. simpl; omega. split. auto. + econstructor; eauto. eapply match_stacks_inside_inlined; eauto. red; intros. apply PRIV. inv H13. destruct H16. xomega. apply agree_val_regs_gen; auto. - red; intros; apply PRIV. destruct H16. omega. + red; intros; apply PRIV. destruct H16. omega. (* tailcall *) exploit match_stacks_inside_globalenvs; eauto. intros [bound G]. exploit find_function_agree; eauto. intros [fd' [A B]]. assert (PRIV': range_private F m' m'0 sp' (dstk ctx) f'.(fn_stacksize)). - eapply range_private_free_left; eauto. inv FB. rewrite <- H4. auto. + eapply range_private_free_left; eauto. inv FB. rewrite <- H4. auto. exploit tr_funbody_inv; eauto. intros TR; inv TR. (* within the original function *) inv MS0; try congruence. assert (X: { m1' | Mem.free m'0 sp' 0 (fn_stacksize f') = Some m1'}). apply Mem.range_perm_free. red; intros. - destruct (zlt ofs f.(fn_stacksize)). + destruct (zlt ofs f.(fn_stacksize)). replace ofs with (ofs + dstk ctx) by omega. eapply Mem.perm_inject; eauto. eapply Mem.free_range_perm; eauto. omega. inv FB. eapply range_private_perms; eauto. xomega. @@ -1032,17 +1032,17 @@ Proof. eapply plus_one. eapply exec_Itailcall; eauto. eapply sig_function_translated; eauto. econstructor; eauto. - eapply match_stacks_bound with (bound := sp'). + eapply match_stacks_bound with (bound := sp'). eapply match_stacks_invariant; eauto. - intros. eapply Mem.perm_free_3; eauto. - intros. eapply Mem.perm_free_1; eauto. + intros. eapply Mem.perm_free_3; eauto. + intros. eapply Mem.perm_free_1; eauto. intros. eapply Mem.perm_free_3; eauto. erewrite Mem.nextblock_free; eauto. red in VB; xomega. eapply agree_val_regs; eauto. eapply Mem.free_right_inject; eauto. eapply Mem.free_left_inject; eauto. (* show that no valid location points into the stack block being freed *) - intros. rewrite DSTK in PRIV'. exploit (PRIV' (ofs + delta)). omega. intros [P Q]. - eelim Q; eauto. replace (ofs + delta - delta) with ofs by omega. + intros. rewrite DSTK in PRIV'. exploit (PRIV' (ofs + delta)). omega. intros [P Q]. + eelim Q; eauto. replace (ofs + delta - delta) with ofs by omega. apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem. (* turned into a call *) left; econstructor; split. @@ -1050,68 +1050,68 @@ Proof. eapply sig_function_translated; eauto. econstructor; eauto. eapply match_stacks_untailcall; eauto. - eapply match_stacks_inside_invariant; eauto. + eapply match_stacks_inside_invariant; eauto. intros. eapply Mem.perm_free_3; eauto. eapply agree_val_regs; eauto. eapply Mem.free_left_inject; eauto. (* inlined *) assert (fd = Internal f0). simpl in H0. destruct (Genv.find_symbol ge id) as [b|] eqn:?; try discriminate. - exploit (funenv_program_compat prog); eauto. intros. + exploit (funenv_program_compat prog); eauto. intros. unfold ge in H0. congruence. subst fd. - right; split. simpl; omega. split. auto. + right; split. simpl; omega. split. auto. econstructor; eauto. eapply match_stacks_inside_inlined_tailcall; eauto. eapply match_stacks_inside_invariant; eauto. intros. eapply Mem.perm_free_3; eauto. apply agree_val_regs_gen; auto. eapply Mem.free_left_inject; eauto. - red; intros; apply PRIV'. + red; intros; apply PRIV'. assert (dstk ctx <= dstk ctx'). red in H14; rewrite H14. apply align_le. apply min_alignment_pos. omega. (* builtin *) exploit tr_funbody_inv; eauto. intros TR; inv TR. - exploit match_stacks_inside_globalenvs; eauto. intros [bound MG]. + exploit match_stacks_inside_globalenvs; eauto. intros [bound MG]. exploit tr_builtin_args; eauto. intros (vargs' & P & Q). - exploit external_call_mem_inject; eauto. + exploit external_call_mem_inject; eauto. eapply match_stacks_inside_globals; eauto. intros [F1 [v1 [m1' [A [B [C [D [E [J K]]]]]]]]]. left; econstructor; split. - eapply plus_one. eapply exec_Ibuiltin; eauto. - eapply external_call_symbols_preserved; eauto. + eapply plus_one. eapply exec_Ibuiltin; eauto. + eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. econstructor. - eapply match_stacks_inside_set_res. + eapply match_stacks_inside_set_res. eapply match_stacks_inside_extcall with (F1 := F) (F2 := F1) (m1 := m) (m1' := m'0); eauto. - intros; eapply external_call_max_perm; eauto. - intros; eapply external_call_max_perm; eauto. + intros; eapply external_call_max_perm; eauto. + intros; eapply external_call_max_perm; eauto. auto. destruct res; simpl; [apply agree_set_reg;auto|idtac|idtac]; eapply agree_regs_incr; eauto. auto. auto. - eapply external_call_valid_block; eauto. - eapply range_private_extcall; eauto. - intros; eapply external_call_max_perm; eauto. - auto. - intros. apply SSZ2. eapply external_call_max_perm; eauto. + eapply external_call_valid_block; eauto. + eapply range_private_extcall; eauto. + intros; eapply external_call_max_perm; eauto. + auto. + intros. apply SSZ2. eapply external_call_max_perm; eauto. (* cond *) exploit tr_funbody_inv; eauto. intros TR; inv TR. assert (eval_condition cond rs'##(sregs ctx args) m' = Some b). - eapply eval_condition_inject; eauto. eapply agree_val_regs; eauto. + eapply eval_condition_inject; eauto. eapply agree_val_regs; eauto. left; econstructor; split. - eapply plus_one. eapply exec_Icond; eauto. - destruct b; econstructor; eauto. + eapply plus_one. eapply exec_Icond; eauto. + destruct b; econstructor; eauto. (* jumptable *) exploit tr_funbody_inv; eauto. intros TR; inv TR. assert (Val.inject F rs#arg rs'#(sreg ctx arg)). eapply agree_val_reg; eauto. - rewrite H0 in H2; inv H2. + rewrite H0 in H2; inv H2. left; econstructor; split. eapply plus_one. eapply exec_Ijumptable; eauto. - rewrite list_nth_z_map. rewrite H1. simpl; reflexivity. - econstructor; eauto. + rewrite list_nth_z_map. rewrite H1. simpl; reflexivity. + econstructor; eauto. (* return *) exploit tr_funbody_inv; eauto. intros TR; inv TR. @@ -1119,19 +1119,19 @@ Proof. inv MS0; try congruence. assert (X: { m1' | Mem.free m'0 sp' 0 (fn_stacksize f') = Some m1'}). apply Mem.range_perm_free. red; intros. - destruct (zlt ofs f.(fn_stacksize)). + destruct (zlt ofs f.(fn_stacksize)). replace ofs with (ofs + dstk ctx) by omega. eapply Mem.perm_inject; eauto. eapply Mem.free_range_perm; eauto. omega. inv FB. eapply range_private_perms; eauto. generalize (Zmax_spec (fn_stacksize f) 0). destruct (zlt 0 (fn_stacksize f)); omega. destruct X as [m1' FREE]. left; econstructor; split. - eapply plus_one. eapply exec_Ireturn; eauto. + eapply plus_one. eapply exec_Ireturn; eauto. econstructor; eauto. - eapply match_stacks_bound with (bound := sp'). + eapply match_stacks_bound with (bound := sp'). eapply match_stacks_invariant; eauto. - intros. eapply Mem.perm_free_3; eauto. - intros. eapply Mem.perm_free_1; eauto. + intros. eapply Mem.perm_free_3; eauto. + intros. eapply Mem.perm_free_1; eauto. intros. eapply Mem.perm_free_3; eauto. erewrite Mem.nextblock_free; eauto. red in VB; xomega. destruct or; simpl. apply agree_val_reg; auto. auto. @@ -1139,58 +1139,58 @@ Proof. (* show that no valid location points into the stack block being freed *) intros. inversion FB; subst. assert (PRIV': range_private F m' m'0 sp' (dstk ctx) f'.(fn_stacksize)). - rewrite H8 in PRIV. eapply range_private_free_left; eauto. - rewrite DSTK in PRIV'. exploit (PRIV' (ofs + delta)). omega. intros [A B]. - eelim B; eauto. replace (ofs + delta - delta) with ofs by omega. + rewrite H8 in PRIV. eapply range_private_free_left; eauto. + rewrite DSTK in PRIV'. exploit (PRIV' (ofs + delta)). omega. intros [A B]. + eelim B; eauto. replace (ofs + delta - delta) with ofs by omega. apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem. (* inlined *) - right. split. simpl. omega. split. auto. + right. split. simpl. omega. split. auto. econstructor; eauto. - eapply match_stacks_inside_invariant; eauto. + eapply match_stacks_inside_invariant; eauto. intros. eapply Mem.perm_free_3; eauto. destruct or; simpl. apply agree_val_reg; auto. auto. eapply Mem.free_left_inject; eauto. - inv FB. rewrite H4 in PRIV. eapply range_private_free_left; eauto. + inv FB. rewrite H4 in PRIV. eapply range_private_free_left; eauto. (* internal function, not inlined *) - assert (A: exists f', tr_function fenv f f' /\ fd' = Internal f'). - Errors.monadInv FD. exists x. split; auto. eapply transf_function_spec; eauto. + assert (A: exists f', tr_function fenv f f' /\ fd' = Internal f'). + Errors.monadInv FD. exists x. split; auto. eapply transf_function_spec; eauto. destruct A as [f' [TR EQ]]. inversion TR; subst. - exploit Mem.alloc_parallel_inject. eauto. eauto. apply Zle_refl. - instantiate (1 := fn_stacksize f'). inv H0. xomega. + exploit Mem.alloc_parallel_inject. eauto. eauto. apply Zle_refl. + instantiate (1 := fn_stacksize f'). inv H0. xomega. intros [F' [m1' [sp' [A [B [C [D E]]]]]]]. left; econstructor; split. eapply plus_one. eapply exec_function_internal; eauto. rewrite H5. econstructor. instantiate (1 := F'). apply match_stacks_inside_base. assert (SP: sp' = Mem.nextblock m'0) by (eapply Mem.alloc_result; eauto). - rewrite <- SP in MS0. + rewrite <- SP in MS0. eapply match_stacks_invariant; eauto. - intros. destruct (eq_block b1 stk). - subst b1. rewrite D in H7; inv H7. subst b2. eelim Plt_strict; eauto. - rewrite E in H7; auto. - intros. exploit Mem.perm_alloc_inv. eexact H. eauto. - destruct (eq_block b1 stk); intros; auto. - subst b1. rewrite D in H7; inv H7. subst b2. eelim Plt_strict; eauto. - intros. eapply Mem.perm_alloc_1; eauto. - intros. exploit Mem.perm_alloc_inv. eexact A. eauto. + intros. destruct (eq_block b1 stk). + subst b1. rewrite D in H7; inv H7. subst b2. eelim Plt_strict; eauto. + rewrite E in H7; auto. + intros. exploit Mem.perm_alloc_inv. eexact H. eauto. + destruct (eq_block b1 stk); intros; auto. + subst b1. rewrite D in H7; inv H7. subst b2. eelim Plt_strict; eauto. + intros. eapply Mem.perm_alloc_1; eauto. + intros. exploit Mem.perm_alloc_inv. eexact A. eauto. rewrite dec_eq_false; auto. - auto. auto. auto. + auto. auto. auto. rewrite H4. apply agree_regs_init_regs. eauto. auto. inv H0; auto. congruence. auto. eapply Mem.valid_new_block; eauto. red; intros. split. eapply Mem.perm_alloc_2; eauto. inv H0; xomega. intros; red; intros. exploit Mem.perm_alloc_inv. eexact H. eauto. - destruct (eq_block b stk); intros. + destruct (eq_block b stk); intros. subst. rewrite D in H8; inv H8. inv H0; xomega. rewrite E in H8; auto. eelim Mem.fresh_block_alloc. eexact A. eapply Mem.mi_mappedblocks; eauto. auto. - intros. exploit Mem.perm_alloc_inv; eauto. rewrite dec_eq_true. omega. + intros. exploit Mem.perm_alloc_inv; eauto. rewrite dec_eq_true. omega. (* internal function, inlined *) inversion FB; subst. - exploit Mem.alloc_left_mapped_inject. + exploit Mem.alloc_left_mapped_inject. eauto. eauto. (* sp' is valid *) @@ -1212,7 +1212,7 @@ Proof. apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem. intros [F' [A [B [C D]]]]. exploit tr_moves_init_regs; eauto. intros [rs'' [P [Q R]]]. - left; econstructor; split. + left; econstructor; split. eapply plus_left. eapply exec_Inop; eauto. eexact P. traceEq. econstructor. eapply match_stacks_inside_alloc_left; eauto. @@ -1226,21 +1226,21 @@ Proof. (* external function *) exploit match_stacks_globalenvs; eauto. intros [bound MG]. - exploit external_call_mem_inject; eauto. + exploit external_call_mem_inject; eauto. eapply match_globalenvs_preserves_globals; eauto. intros [F1 [v1 [m1' [A [B [C [D [E [J K]]]]]]]]]. - simpl in FD. inv FD. + simpl in FD. inv FD. left; econstructor; split. - eapply plus_one. eapply exec_function_external; eauto. - eapply external_call_symbols_preserved; eauto. + eapply plus_one. eapply exec_function_external; eauto. + eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. econstructor. eapply match_stacks_bound with (Mem.nextblock m'0). eapply match_stacks_extcall with (F1 := F) (F2 := F1) (m1 := m) (m1' := m'0); eauto. - intros; eapply external_call_max_perm; eauto. + intros; eapply external_call_max_perm; eauto. intros; eapply external_call_max_perm; eauto. xomega. - eapply external_call_nextblock; eauto. + eapply external_call_nextblock; eauto. auto. auto. (* return fron noninlined function *) @@ -1248,8 +1248,8 @@ Proof. (* normal case *) left; econstructor; split. eapply plus_one. eapply exec_return. - econstructor; eauto. - apply match_stacks_inside_set_reg; auto. + econstructor; eauto. + apply match_stacks_inside_set_reg; auto. apply agree_set_reg; auto. (* untailcall case *) inv MS; try congruence. @@ -1261,26 +1261,26 @@ Proof. *) left; econstructor; split. eapply plus_one. eapply exec_return. - eapply match_regular_states. + eapply match_regular_states. eapply match_stacks_inside_set_reg; eauto. - auto. + auto. apply agree_set_reg; auto. auto. auto. auto. red; intros. destruct (zlt ofs (dstk ctx)). apply PAD; omega. apply PRIV; omega. - auto. auto. - + auto. auto. + (* return from inlined function *) - inv MS0; try congruence. rewrite RET0 in RET; inv RET. - unfold inline_return in AT. + inv MS0; try congruence. rewrite RET0 in RET; inv RET. + unfold inline_return in AT. assert (PRIV': range_private F m m' sp' (dstk ctx' + mstk ctx') f'.(fn_stacksize)). red; intros. destruct (zlt ofs (dstk ctx)). apply PAD. omega. apply PRIV. omega. destruct or. (* with a result *) - left; econstructor; split. - eapply plus_one. eapply exec_Iop; eauto. simpl. reflexivity. + left; econstructor; split. + eapply plus_one. eapply exec_Iop; eauto. simpl. reflexivity. econstructor; eauto. apply match_stacks_inside_set_reg; auto. apply agree_set_reg; auto. (* without a result *) - left; econstructor; split. + left; econstructor; split. eapply plus_one. eapply exec_Inop; eauto. econstructor; eauto. subst vres. apply agree_set_reg_undef'; auto. Qed. @@ -1293,29 +1293,29 @@ Proof. exists (Callstate nil tf nil m0); split. econstructor; eauto. unfold transf_program in TRANSF. eapply Genv.init_mem_transf_partial; eauto. - rewrite symbols_preserved. + rewrite symbols_preserved. rewrite (transform_partial_program_main _ _ TRANSF). auto. - rewrite <- H3. apply sig_function_translated; auto. - econstructor; eauto. - instantiate (1 := Mem.flat_inj (Mem.nextblock m0)). + rewrite <- H3. apply sig_function_translated; auto. + econstructor; eauto. + instantiate (1 := Mem.flat_inj (Mem.nextblock m0)). apply match_stacks_nil with (Mem.nextblock m0). - constructor; intros. - unfold Mem.flat_inj. apply pred_dec_true; auto. + constructor; intros. + unfold Mem.flat_inj. apply pred_dec_true; auto. unfold Mem.flat_inj in H. destruct (plt b1 (Mem.nextblock m0)); congruence. eapply Genv.find_symbol_not_fresh; eauto. eapply Genv.find_funct_ptr_not_fresh; eauto. - eapply Genv.find_var_info_not_fresh; eauto. - apply Ple_refl. + eapply Genv.find_var_info_not_fresh; eauto. + apply Ple_refl. eapply Genv.initmem_inject; eauto. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> final_state st1 r -> final_state st2 r. Proof. intros. inv H0. inv H. exploit match_stacks_empty; eauto. intros EQ; subst. inv VINJ. constructor. - exploit match_stacks_inside_empty; eauto. intros [A B]. congruence. + exploit match_stacks_inside_empty; eauto. intros [A B]. congruence. Qed. Theorem transf_program_correct: @@ -1325,7 +1325,7 @@ Proof. eexact public_preserved. eexact transf_initial_states. eexact transf_final_states. - eexact step_simulation. + eexact step_simulation. Qed. End INLINING. diff --git a/backend/Inliningspec.v b/backend/Inliningspec.v index 161e2a6e..ba62313f 100644 --- a/backend/Inliningspec.v +++ b/backend/Inliningspec.v @@ -40,24 +40,24 @@ Remark add_globdef_compat: fenv_compat (Genv.add_global ge idg) (Inlining.add_globdef fenv idg). Proof. intros. destruct idg as [id gd]. red; simpl; intros. - unfold Genv.find_symbol in H1; simpl in H1. + unfold Genv.find_symbol in H1; simpl in H1. unfold Genv.find_funct_ptr; simpl. rewrite PTree.gsspec in H1. destruct (peq id0 id). (* same *) - subst id0. inv H1. destruct gd. destruct f0. + subst id0. inv H1. destruct gd. destruct f0. destruct (should_inline id f0). rewrite PTree.gss in H0. rewrite PTree.gss. inv H0; auto. rewrite PTree.grs in H0; discriminate. rewrite PTree.grs in H0; discriminate. rewrite PTree.grs in H0; discriminate. (* different *) - destruct gd. rewrite PTree.gso. eapply H; eauto. + destruct gd. rewrite PTree.gso. eapply H; eauto. destruct f0. destruct (should_inline id f0). rewrite PTree.gso in H0; auto. rewrite PTree.gro in H0; auto. rewrite PTree.gro in H0; auto. red; intros; subst b. eelim Plt_strict. eapply Genv.genv_symb_range; eauto. - rewrite PTree.gro in H0; auto. eapply H; eauto. + rewrite PTree.gro in H0; auto. eapply H; eauto. Qed. Lemma funenv_program_compat: @@ -68,7 +68,7 @@ Proof. assert (forall gl ge fenv, fenv_compat ge fenv -> fenv_compat (Genv.add_globals ge gl) (fold_left add_globdef gl fenv)). - induction gl; simpl; intros. auto. apply IHgl. apply add_globdef_compat; auto. + induction gl; simpl; intros. auto. apply IHgl. apply add_globdef_compat; auto. apply H. red; intros. rewrite PTree.gempty in H0; discriminate. Qed. @@ -80,12 +80,12 @@ Proof. zify. omega. Qed. -Lemma shiftpos_inj: +Lemma shiftpos_inj: forall x y n, shiftpos x n = shiftpos y n -> x = y. Proof. intros. assert (Zpos (shiftpos x n) = Zpos (shiftpos y n)) by congruence. - rewrite ! shiftpos_eq in H0. + rewrite ! shiftpos_eq in H0. assert (Z.pos x = Z.pos y) by omega. congruence. Qed. @@ -99,32 +99,32 @@ Qed. Lemma shiftpos_above: forall x n, Ple n (shiftpos x n). Proof. - intros. unfold Ple; zify. rewrite shiftpos_eq. xomega. + intros. unfold Ple; zify. rewrite shiftpos_eq. xomega. Qed. Lemma shiftpos_not_below: forall x n, Plt (shiftpos x n) n -> False. Proof. - intros. generalize (shiftpos_above x n). xomega. + intros. generalize (shiftpos_above x n). xomega. Qed. Lemma shiftpos_below: forall x n, Plt (shiftpos x n) (Pplus x n). Proof. - intros. unfold Plt; zify. rewrite shiftpos_eq. omega. + intros. unfold Plt; zify. rewrite shiftpos_eq. omega. Qed. Lemma shiftpos_le: forall x y n, Ple x y -> Ple (shiftpos x n) (shiftpos y n). Proof. - intros. unfold Ple in *; zify. rewrite ! shiftpos_eq. omega. + intros. unfold Ple in *; zify. rewrite ! shiftpos_eq. omega. Qed. (** ** Working with the state monad *) Remark bind_inversion: - forall (A B: Type) (f: mon A) (g: A -> mon B) + forall (A B: Type) (f: mon A) (g: A -> mon B) (y: B) (s1 s3: state) (i: sincr s1 s3), bind f g s1 = R y s3 i -> exists x, exists s2, exists i1, exists i2, @@ -156,7 +156,7 @@ Ltac monadInv H := match type of H with | (ret _ _ = R _ _ _) => monadInv1 H | (bind ?F ?G ?S = R ?X ?S' ?I) => monadInv1 H - | (?F _ _ _ _ _ _ _ _ = R _ _ _) => + | (?F _ _ _ _ _ _ _ _ = R _ _ _) => ((progress simpl in H) || unfold F in H); monadInv1 H | (?F _ _ _ _ _ _ _ = R _ _ _) => ((progress simpl in H) || unfold F in H); monadInv1 H @@ -189,7 +189,7 @@ Proof. induction l; simpl; intros. exists (sincr_refl s); auto. destruct a as [x y]. unfold bind. simpl. destruct (f x y s) as [xx s1 i1]. - destruct (IHl s1) as [i2 EQ]. rewrite EQ. econstructor; eauto. + destruct (IHl s1) as [i2 EQ]. rewrite EQ. econstructor; eauto. Qed. Lemma ptree_mfold_spec: @@ -197,7 +197,7 @@ Lemma ptree_mfold_spec: ptree_mfold f t s = R x s' i -> exists i', mlist_iter2 f (PTree.elements t) s = R tt s' i'. Proof. - intros. + intros. destruct (mlist_iter2_fold _ _ f (PTree.elements t) s) as [i' EQ]. unfold ptree_mfold in H. inv H. rewrite PTree.fold_spec. econstructor. eexact EQ. @@ -220,12 +220,12 @@ Lemma add_moves_unchanged: Plt pc s.(st_nextnode) \/ Ple s'.(st_nextnode) pc -> s'.(st_code)!pc = s.(st_code)!pc. Proof. - induction srcs; simpl; intros. + induction srcs; simpl; intros. monadInv H. auto. destruct dsts; monadInv H. auto. - transitivity (st_code s0)!pc. eapply IHsrcs; eauto. monadInv EQ; simpl. xomega. + transitivity (st_code s0)!pc. eapply IHsrcs; eauto. monadInv EQ; simpl. xomega. monadInv EQ; simpl. apply PTree.gso. - inversion INCR0; simpl in *. xomega. + inversion INCR0; simpl in *. xomega. Qed. Lemma add_moves_spec: @@ -234,15 +234,15 @@ Lemma add_moves_spec: (forall pc, Ple s.(st_nextnode) pc -> Plt pc s'.(st_nextnode) -> c!pc = s'.(st_code)!pc) -> tr_moves c pc1 srcs dsts pc2. Proof. - induction srcs; simpl; intros. + induction srcs; simpl; intros. monadInv H. apply tr_moves_nil; auto. - destruct dsts; monadInv H. apply tr_moves_nil; auto. - apply tr_moves_cons with x. eapply IHsrcs; eauto. + destruct dsts; monadInv H. apply tr_moves_nil; auto. + apply tr_moves_cons with x. eapply IHsrcs; eauto. intros. inversion INCR. apply H0; xomega. monadInv EQ. - rewrite H0. erewrite add_moves_unchanged; eauto. - simpl. apply PTree.gss. - simpl. xomega. + rewrite H0. erewrite add_moves_unchanged; eauto. + simpl. apply PTree.gss. + simpl. xomega. xomega. inversion INCR; inversion INCR0; simpl in *; xomega. Qed. @@ -386,25 +386,25 @@ Proof. generalize set_instr_other; intros A. intros. unfold expand_instr in H; destruct instr; eauto. (* call *) - destruct (can_inline fe s1). eauto. + destruct (can_inline fe s1). eauto. monadInv H. unfold inline_function in EQ. monadInv EQ. - transitivity (s2.(st_code)!pc'). eauto. + transitivity (s2.(st_code)!pc'). eauto. transitivity (s5.(st_code)!pc'). eapply add_moves_unchanged; eauto. - left. inversion INCR5. inversion INCR3. monadInv EQ1; simpl in *. xomega. - transitivity (s4.(st_code)!pc'). eapply rec_unchanged; eauto. + left. inversion INCR5. inversion INCR3. monadInv EQ1; simpl in *. xomega. + transitivity (s4.(st_code)!pc'). eapply rec_unchanged; eauto. simpl. monadInv EQ; simpl. monadInv EQ1; simpl. xomega. - simpl. monadInv EQ1; simpl. auto. + simpl. monadInv EQ1; simpl. auto. monadInv EQ; simpl. monadInv EQ1; simpl. auto. (* tailcall *) destruct (can_inline fe s1). destruct (retinfo ctx) as [[rpc rreg]|]; eauto. monadInv H. unfold inline_tail_function in EQ. monadInv EQ. - transitivity (s2.(st_code)!pc'). eauto. + transitivity (s2.(st_code)!pc'). eauto. transitivity (s5.(st_code)!pc'). eapply add_moves_unchanged; eauto. - left. inversion INCR5. inversion INCR3. monadInv EQ1; simpl in *. xomega. - transitivity (s4.(st_code)!pc'). eapply rec_unchanged; eauto. + left. inversion INCR5. inversion INCR3. monadInv EQ1; simpl in *. xomega. + transitivity (s4.(st_code)!pc'). eapply rec_unchanged; eauto. simpl. monadInv EQ; simpl. monadInv EQ1; simpl. xomega. - simpl. monadInv EQ1; simpl. auto. + simpl. monadInv EQ1; simpl. auto. monadInv EQ; simpl. monadInv EQ1; simpl. auto. (* return *) destruct (retinfo ctx) as [[rpc rreg]|]; eauto. @@ -425,8 +425,8 @@ Proof. (* inductive case *) destruct a as [pc1 instr1]; simpl in *. monadInv H. inv H3. - transitivity ((st_code s0)!pc). - eapply IHl; eauto. destruct INCR; xomega. destruct INCR; xomega. + transitivity ((st_code s0)!pc). + eapply IHl; eauto. destruct INCR; xomega. destruct INCR; xomega. eapply expand_instr_unchanged; eauto. Qed. @@ -439,12 +439,12 @@ Lemma expand_cfg_rec_unchanged: Proof. intros. unfold expand_cfg_rec in H. monadInv H. inversion EQ. transitivity ((st_code s0)!pc). - exploit ptree_mfold_spec; eauto. intros [INCR' ITER]. - eapply iter_expand_instr_unchanged; eauto. - subst s0; auto. + exploit ptree_mfold_spec; eauto. intros [INCR' ITER]. + eapply iter_expand_instr_unchanged; eauto. + subst s0; auto. subst s0; simpl. xomega. - red; intros. exploit list_in_map_inv; eauto. intros [pc1 [A B]]. - subst pc. unfold spc in H1. eapply shiftpos_not_below; eauto. + red; intros. exploit list_in_map_inv; eauto. intros [pc1 [A B]]. + subst pc. unfold spc in H1. eapply shiftpos_not_below; eauto. apply PTree.elements_keys_norepet. subst s0; auto. Qed. @@ -456,7 +456,7 @@ Hypothesis rec_spec: Ple (ctx.(dpc) + max_pc_function f) s.(st_nextnode) -> ctx.(mreg) = max_reg_function f -> Ple (Pplus ctx.(dreg) ctx.(mreg)) s.(st_nextreg) -> - ctx.(mstk) >= 0 -> + ctx.(mstk) >= 0 -> ctx.(mstk) = Zmax (fn_stacksize f) 0 -> (min_alignment (fn_stacksize f) | ctx.(dstk)) -> ctx.(dstk) >= 0 -> @@ -496,14 +496,14 @@ Proof. (* call *) destruct (can_inline fe s1) as [|id f P Q]. (* not inlined *) - eapply tr_call; eauto. + eapply tr_call; eauto. (* inlined *) subst s1. monadInv EXP. unfold inline_function in EQ; monadInv EQ. set (ctx' := callcontext ctx x1 x2 (max_reg_function f) (fn_stacksize f) n r). - inversion EQ0; inversion EQ1; inversion EQ. inv_incr. + inversion EQ0; inversion EQ1; inversion EQ. inv_incr. apply tr_call_inlined with (pc1 := x0) (ctx' := ctx') (f := f); auto. - eapply BASE; eauto. + eapply BASE; eauto. eapply add_moves_spec; eauto. intros. rewrite S1. eapply set_instr_other; eauto. unfold node; xomega. xomega. xomega. @@ -517,24 +517,24 @@ Proof. omega. intros. simpl in H. rewrite S1. transitivity s1.(st_code)!pc0. eapply set_instr_other; eauto. unfold node in *; xomega. - eapply add_moves_unchanged; eauto. unfold node in *; xomega. xomega. - red; simpl. subst s2; simpl in *. xomega. + eapply add_moves_unchanged; eauto. unfold node in *; xomega. xomega. + red; simpl. subst s2; simpl in *. xomega. red; simpl. split. auto. apply align_le. apply min_alignment_pos. (* tailcall *) destruct (can_inline fe s1) as [|id f P Q]. (* not inlined *) - destruct (retinfo ctx) as [[rpc rreg] | ] eqn:?. + destruct (retinfo ctx) as [[rpc rreg] | ] eqn:?. (* turned into a call *) - eapply tr_tailcall_call; eauto. + eapply tr_tailcall_call; eauto. (* preserved *) - eapply tr_tailcall; eauto. + eapply tr_tailcall; eauto. (* inlined *) subst s1. monadInv EXP. unfold inline_function in EQ; monadInv EQ. set (ctx' := tailcontext ctx x1 x2 (max_reg_function f) (fn_stacksize f)) in *. - inversion EQ0; inversion EQ1; inversion EQ. inv_incr. + inversion EQ0; inversion EQ1; inversion EQ. inv_incr. apply tr_tailcall_inlined with (pc1 := x0) (ctx' := ctx') (f := f); auto. - eapply BASE; eauto. + eapply BASE; eauto. eapply add_moves_spec; eauto. intros. rewrite S1. eapply set_instr_other; eauto. unfold node; xomega. xomega. xomega. eapply rec_spec; eauto. @@ -547,18 +547,18 @@ Proof. omega. intros. simpl in H. rewrite S1. transitivity s1.(st_code)!pc0. eapply set_instr_other; eauto. unfold node in *; xomega. - eapply add_moves_unchanged; eauto. unfold node in *; xomega. xomega. - red; simpl. + eapply add_moves_unchanged; eauto. unfold node in *; xomega. xomega. + red; simpl. subst s2; simpl in *; xomega. red; auto. (* builtin *) - eapply tr_builtin; eauto. destruct b; eauto. + eapply tr_builtin; eauto. destruct b; eauto. (* return *) - destruct (retinfo ctx) as [[rpc rreg] | ] eqn:?. + destruct (retinfo ctx) as [[rpc rreg] | ] eqn:?. (* inlined *) - eapply tr_return_inlined; eauto. + eapply tr_return_inlined; eauto. (* unchanged *) - eapply tr_return; eauto. + eapply tr_return; eauto. Qed. Lemma iter_expand_instr_spec: @@ -580,29 +580,29 @@ Proof. (* inductive case *) destruct a as [pc1 instr1]; simpl in *. inv H0. monadInv H. inv_incr. assert (A: Ple ctx.(dpc) s0.(st_nextnode)). - assert (B: Plt (spc ctx pc) (st_nextnode s)) by eauto. + assert (B: Plt (spc ctx pc) (st_nextnode s)) by eauto. unfold spc in B. generalize (shiftpos_above pc (dpc ctx)). xomega. destruct H9. inv H. (* same pc *) eapply expand_instr_spec; eauto. omega. intros. - transitivity ((st_code s')!pc'). - apply H7. auto. xomega. - eapply iter_expand_instr_unchanged; eauto. - red; intros. rewrite list_map_compose in H9. exploit list_in_map_inv; eauto. - intros [[pc0 instr0] [P Q]]. simpl in P. + transitivity ((st_code s')!pc'). + apply H7. auto. xomega. + eapply iter_expand_instr_unchanged; eauto. + red; intros. rewrite list_map_compose in H9. exploit list_in_map_inv; eauto. + intros [[pc0 instr0] [P Q]]. simpl in P. assert (Plt (spc ctx pc0) (st_nextnode s)) by eauto. xomega. - transitivity ((st_code s')!(spc ctx pc)). - eapply H8; eauto. - eapply iter_expand_instr_unchanged; eauto. + transitivity ((st_code s')!(spc ctx pc)). + eapply H8; eauto. + eapply iter_expand_instr_unchanged; eauto. assert (Plt (spc ctx pc) (st_nextnode s)) by eauto. xomega. - red; intros. rewrite list_map_compose in H. exploit list_in_map_inv; eauto. + red; intros. rewrite list_map_compose in H. exploit list_in_map_inv; eauto. intros [[pc0 instr0] [P Q]]. simpl in P. assert (pc = pc0) by (eapply shiftpos_inj; eauto). subst pc0. elim H12. change pc with (fst (pc, instr0)). apply List.in_map; auto. (* older pc *) - inv_incr. eapply IHl; eauto. + inv_incr. eapply IHl; eauto. intros. eapply Plt_le_trans. eapply H2. right; eauto. xomega. intros; eapply Ple_trans; eauto. intros. apply H7; auto. xomega. @@ -614,7 +614,7 @@ Lemma expand_cfg_rec_spec: Ple (ctx.(dpc) + max_pc_function f) s.(st_nextnode) -> ctx.(mreg) = max_reg_function f -> Ple (ctx.(dreg) + ctx.(mreg)) s.(st_nextreg) -> - ctx.(mstk) >= 0 -> + ctx.(mstk) >= 0 -> ctx.(mstk) = Zmax (fn_stacksize f) 0 -> (min_alignment (fn_stacksize f) | ctx.(dstk)) -> ctx.(dstk) >= 0 -> @@ -622,13 +622,13 @@ Lemma expand_cfg_rec_spec: (forall pc', Ple ctx.(dpc) pc' -> Plt pc' s'.(st_nextnode) -> c!pc' = s'.(st_code)!pc') -> tr_funbody ctx f c. Proof. - intros. unfold expand_cfg_rec in H. monadInv H. inversion EQ. - constructor. - intros. rewrite H1. eapply max_reg_function_params; eauto. + intros. unfold expand_cfg_rec in H. monadInv H. inversion EQ. + constructor. + intros. rewrite H1. eapply max_reg_function_params; eauto. intros. exploit ptree_mfold_spec; eauto. intros [INCR' ITER]. - eapply iter_expand_instr_spec; eauto. - apply PTree.elements_keys_norepet. - intros. rewrite H1. eapply max_reg_function_def with (i := instr); eauto. + eapply iter_expand_instr_spec; eauto. + apply PTree.elements_keys_norepet. + intros. rewrite H1. eapply max_reg_function_def with (i := instr); eauto. eapply PTree.elements_complete; eauto. intros. assert (Ple pc0 (max_pc_function f)). @@ -636,10 +636,10 @@ Proof. eapply Plt_le_trans. apply shiftpos_below. subst s0; simpl; xomega. subst s0; simpl; auto. intros. apply H8; auto. subst s0; simpl in H11; xomega. - intros. apply H8. apply shiftpos_above. + intros. apply H8. apply shiftpos_above. assert (Ple pc0 (max_pc_function f)). - eapply max_pc_function_sound. eapply PTree.elements_complete; eauto. - eapply Plt_le_trans. apply shiftpos_below. inversion i; xomega. + eapply max_pc_function_sound. eapply PTree.elements_complete; eauto. + eapply Plt_le_trans. apply shiftpos_below. inversion i; xomega. apply PTree.elements_correct; auto. auto. auto. auto. inversion INCR0. subst s0; simpl in STKSIZE; xomega. @@ -657,17 +657,17 @@ Proof. intros fe0; pattern fe0. apply well_founded_ind with (R := ltof _ size_fenv). apply well_founded_ltof. intros. unfold expand_cfg in H0. rewrite unroll_Fixm in H0. - eapply expand_cfg_rec_unchanged; eauto. assumption. + eapply expand_cfg_rec_unchanged; eauto. assumption. Qed. Lemma expand_cfg_spec: forall fe ctx f s x s' i c, expand_cfg fe ctx f s = R x s' i -> - fenv_agree fe -> + fenv_agree fe -> Ple (ctx.(dpc) + max_pc_function f) s.(st_nextnode) -> ctx.(mreg) = max_reg_function f -> Ple (ctx.(dreg) + ctx.(mreg)) s.(st_nextreg) -> - ctx.(mstk) >= 0 -> + ctx.(mstk) >= 0 -> ctx.(mstk) = Zmax (fn_stacksize f) 0 -> (min_alignment (fn_stacksize f) | ctx.(dstk)) -> ctx.(dstk) >= 0 -> @@ -678,7 +678,7 @@ Proof. intros fe0; pattern fe0. apply well_founded_ind with (R := ltof _ size_fenv). apply well_founded_ltof. intros. unfold expand_cfg in H0. rewrite unroll_Fixm in H0. - eapply expand_cfg_rec_spec; eauto. + eapply expand_cfg_rec_spec; eauto. simpl. intros. eapply expand_cfg_unchanged; eauto. assumption. Qed. @@ -701,7 +701,7 @@ Lemma transf_function_spec: forall f f', transf_function fenv f = OK f' -> tr_function f f'. Proof. intros. unfold transf_function in H. - destruct (expand_function fenv f initstate) as [ctx s i] eqn:?. + destruct (expand_function fenv f initstate) as [ctx s i] eqn:?. destruct (zlt (st_stksize s) Int.max_unsigned); inv H. monadInv Heqr. set (ctx := initcontext x x0 (max_reg_function f) (fn_stacksize f)) in *. Opaque initstate. @@ -712,11 +712,11 @@ Opaque initstate. unfold ctx; rewrite <- H1; rewrite <- H2; rewrite <- H3; simpl. xomega. unfold ctx; rewrite <- H0; rewrite <- H1; simpl. xomega. simpl. xomega. - simpl. apply Zdivide_0. + simpl. apply Zdivide_0. simpl. omega. simpl. omega. - simpl. split; auto. destruct INCR2. destruct INCR1. destruct INCR0. destruct INCR. - simpl. change 0 with (st_stksize initstate). omega. + simpl. split; auto. destruct INCR2. destruct INCR1. destruct INCR0. destruct INCR. + simpl. change 0 with (st_stksize initstate). omega. Qed. End INLINING_SPEC. diff --git a/backend/Kildall.v b/backend/Kildall.v index 0d414d28..87090f5d 100644 --- a/backend/Kildall.v +++ b/backend/Kildall.v @@ -22,21 +22,21 @@ Local Unset Elimination Schemes. Local Unset Case Analysis Schemes. (** A forward dataflow problem is a set of inequations of the form -- [X(s) >= transf n X(n)] +- [X(s) >= transf n X(n)] if program point [s] is a successor of program point [n] - [X(n) >= a] if [n] is an entry point and [a] its minimal approximation. The unknowns are the [X(n)], indexed by program points (e.g. nodes in the -CFG graph of a RTL function). They range over a given ordered set that +CFG graph of a RTL function). They range over a given ordered set that represents static approximations of the program state at each point. -The [transf] function is the abstract transfer function: it computes an +The [transf] function is the abstract transfer function: it computes an approximation [transf n X(n)] of the program state after executing instruction at point [n], as a function of the approximation [X(n)] of the program state before executing that instruction. Symmetrically, a backward dataflow problem is a set of inequations of the form -- [X(n) >= transf s X(s)] +- [X(n) >= transf s X(s)] if program point [s] is a successor of program point [n] - [X(n) >= a] if [n] is an entry point and [a] its minimal approximation. @@ -155,7 +155,7 @@ Context {A: Type} (code: PTree.t A) (successors: A -> list positive). Inductive reachable: positive -> positive -> Prop := | reachable_refl: forall n, reachable n n | reachable_left: forall n1 n2 n3 i, - code!n1 = Some i -> In n2 (successors i) -> reachable n2 n3 -> + code!n1 = Some i -> In n2 (successors i) -> reachable n2 n3 -> reachable n1 n3. Scheme reachable_ind := Induction for reachable Sort Prop. @@ -163,9 +163,9 @@ Scheme reachable_ind := Induction for reachable Sort Prop. Lemma reachable_trans: forall n1 n2, reachable n1 n2 -> forall n3, reachable n2 n3 -> reachable n1 n3. Proof. - induction 1; intros. + induction 1; intros. - auto. -- econstructor; eauto. +- econstructor; eauto. Qed. Lemma reachable_right: @@ -201,7 +201,7 @@ Variable transf: positive -> L.t -> L.t. (i.e. put on the worklist at some point in the past). Only the first two components are computationally relevant. The third -is a ghost variable used only for stating and proving invariants. +is a ghost variable used only for stating and proving invariants. For this reason, [visited] is defined at sort [Prop] so that it is erased during program extraction. *) @@ -266,7 +266,7 @@ Fixpoint propagate_succ_list (s: state) (out: L.t) (succs: list positive) Definition step (s: state) : PMap.t L.t + state := match NS.pick s.(worklist) with - | None => + | None => inl _ (L.bot, s.(aval)) | Some(n, rem) => match code!n with @@ -347,7 +347,7 @@ Remark optge_abstr_value: optge st.(aval)!n st'.(aval)!n -> L.ge (abstr_value n st) (abstr_value n st'). Proof. - intros. unfold abstr_value. inv H. auto. apply L.ge_bot. + intros. unfold abstr_value. inv H. auto. apply L.ge_bot. Qed. Lemma propagate_succ_charact: @@ -369,7 +369,7 @@ Proof. - (* already there, unchanged *) repeat split; intros. + rewrite E. constructor. eapply L.ge_trans. apply L.ge_refl. apply H; auto. apply L.ge_lub_right. - + apply optge_refl. + + apply optge_refl. + right; auto. + auto. + auto. @@ -378,29 +378,29 @@ Proof. + congruence. - (* already there, updated *) simpl; repeat split; intros. - + rewrite PTree.gss. constructor. apply L.ge_lub_right. + + rewrite PTree.gss. constructor. apply L.ge_lub_right. + rewrite PTree.gso by auto. auto. - + rewrite PTree.gsspec. destruct (peq s n). + + rewrite PTree.gsspec. destruct (peq s n). subst s. rewrite E. constructor. apply L.ge_lub_left. apply optge_refl. - + rewrite NS.add_spec. auto. + + rewrite NS.add_spec. auto. + rewrite NS.add_spec. auto. + rewrite NS.add_spec in H0. intuition. + auto. - + destruct H0; auto. subst n'. rewrite NS.add_spec; auto. - + rewrite PTree.gsspec in H1. destruct (peq n' n). auto. congruence. + + destruct H0; auto. subst n'. rewrite NS.add_spec; auto. + + rewrite PTree.gsspec in H1. destruct (peq n' n). auto. congruence. - (* not previously there, updated *) simpl; repeat split; intros. - + rewrite PTree.gss. apply optge_refl. + + rewrite PTree.gss. apply optge_refl. + rewrite PTree.gso by auto. auto. - + rewrite PTree.gsspec. destruct (peq s n). + + rewrite PTree.gsspec. destruct (peq s n). subst s. rewrite E. constructor. apply optge_refl. - + rewrite NS.add_spec. auto. + + rewrite NS.add_spec. auto. + rewrite NS.add_spec. auto. + rewrite NS.add_spec in H. intuition. + auto. - + destruct H; auto. subst n'. rewrite NS.add_spec. auto. + + destruct H; auto. subst n'. rewrite NS.add_spec. auto. + rewrite PTree.gsspec in H0. destruct (peq n' n). auto. congruence. Qed. @@ -417,34 +417,34 @@ Lemma propagate_succ_list_charact: /\ (forall n', st'.(visited) n' -> NS.In n' st'.(worklist) \/ st.(visited) n') /\ (forall n', st.(aval)!n' = None -> st'.(aval)!n' <> None -> st'.(visited) n'). Proof. - induction l; simpl; intros. -- repeat split; intros. + induction l; simpl; intros. +- repeat split; intros. + contradiction. - + apply optge_refl. + + apply optge_refl. + auto. + auto. + auto. + auto. + auto. + congruence. -- generalize (propagate_succ_charact st out a). +- generalize (propagate_succ_charact st out a). set (st1 := propagate_succ st out a). intros (A1 & A2 & A3 & A4 & A5 & A6 & A7 & A8 & A9). - generalize (IHl st1). + generalize (IHl st1). set (st2 := propagate_succ_list st1 out l). intros (B1 & B2 & B3 & B4 & B5 & B6 & B7 & B8 & B9). clear IHl. repeat split; intros. - + destruct H. - * subst n. eapply optge_trans; eauto. + + destruct H. + * subst n. eapply optge_trans; eauto. * auto. + rewrite B2 by tauto. apply A2; tauto. + eapply optge_trans; eauto. + destruct (B4 n). auto. - destruct (peq n a). + destruct (peq n a). * subst n. destruct A4. left; auto. right; congruence. - * right. rewrite H. auto. + * right. rewrite H. auto. + eauto. - + exploit B6; eauto. intros [P|P]. auto. + + exploit B6; eauto. intros [P|P]. auto. exploit A6; eauto. intuition. + eauto. + specialize (B8 n'); specialize (A8 n'). intuition. @@ -470,12 +470,12 @@ Proof. eapply (PrimIter.iterate_prop _ _ step (fun st => steps start st) (fun res => exists st, steps start st /\ NS.pick (worklist st) = None /\ res = (L.bot, aval st))); eauto. - intros. destruct (step a) eqn:E. - exists a; split; auto. + intros. destruct (step a) eqn:E. + exists a; split; auto. unfold step in E. destruct (NS.pick (worklist a)) as [[n rem]|]. destruct (code!n); discriminate. - inv E. auto. - eapply steps_right; eauto. + inv E. auto. + eapply steps_right; eauto. constructor. Qed. @@ -492,10 +492,10 @@ Lemma step_incr: forall n s1 s2, step s1 = inr s2 -> optge s2.(aval)!n s1.(aval)!n /\ (s1.(visited) n -> s2.(visited) n). Proof. - unfold step; intros. + unfold step; intros. destruct (NS.pick (worklist s1)) as [[p rem] | ]; try discriminate. destruct (code!p) as [instr|]; inv H. - + generalize (propagate_succ_list_charact + + generalize (propagate_succ_list_charact (transf p (abstr_value p s1)) (successors instr) {| aval := aval s1; worklist := rem; visited := visited s1 |}). @@ -504,7 +504,7 @@ Proof. (transf p (abstr_value p s1)) (successors instr)). intros (A1 & A2 & A3 & A4 & A5 & A6 & A7 & A8 & A9). auto. - + split. apply optge_refl. auto. + + split. apply optge_refl. auto. Qed. Lemma steps_incr: @@ -514,7 +514,7 @@ Proof. induction 1. - split. apply optge_refl. auto. - destruct IHsteps. exploit (step_incr n); eauto. intros [P Q]. - split. eapply optge_trans; eauto. eauto. + split. eapply optge_trans; eauto. eauto. Qed. (** ** Correctness invariant *) @@ -567,16 +567,16 @@ Proof. + (* n was on the worklist *) rewrite PICK2 in P; destruct P. * (* node n is our node pc *) - subst n. fold out. right; intros. - assert (i = instr) by congruence. subst i. - apply A1; auto. + subst n. fold out. right; intros. + assert (i = instr) by congruence. subst i. + apply A1; auto. * (* n was already on the worklist *) left. apply A5; auto. + (* n was stable before, still is *) - right; intros. apply optge_trans with st.(aval)!s; eauto. + right; intros. apply optge_trans with st.(aval)!s; eauto. - (* defined *) - destruct st.(aval)!n as [v'|] eqn:ST. - + apply A7. eapply GOOD2; eauto. + destruct st.(aval)!n as [v'|] eqn:ST. + + apply A7. eapply GOOD2; eauto. + apply A9; auto. congruence. Qed. @@ -591,9 +591,9 @@ Proof. generalize (NS.pick_some _ _ _ PICK); intro PICK2. constructor; simpl; intros. - (* stable *) - exploit GOOD1; eauto. intros [P | P]. - + rewrite PICK2 in P. destruct P; auto. - subst n. right; intros. congruence. + exploit GOOD1; eauto. intros [P | P]. + + rewrite PICK2 in P. destruct P; auto. + subst n. right; intros. congruence. + right; exact P. - (* defined *) eapply GOOD2; eauto. @@ -603,11 +603,11 @@ Lemma steps_state_good: forall st1 st2, steps st1 st2 -> good_state st1 -> good_state st2. Proof. induction 1; intros. -- auto. +- auto. - unfold step in e. destruct (NS.pick (worklist s2)) as [[n rem] | ] eqn:PICK; try discriminate. destruct (code!n) as [instr|] eqn:CODE; inv e. - eapply step_state_good; eauto. + eapply step_state_good; eauto. eapply step_state_good_2; eauto. Qed. @@ -616,8 +616,8 @@ Qed. Lemma start_state_good: forall enode eval, good_state (start_state enode eval). Proof. - intros. unfold start_state; constructor; simpl; intros. -- subst n. rewrite NS.add_spec; auto. + intros. unfold start_state; constructor; simpl; intros. +- subst n. rewrite NS.add_spec; auto. - rewrite PTree.gsspec in H. rewrite PTree.gempty in H. destruct (peq n enode). auto. discriminate. Qed. @@ -634,7 +634,7 @@ Lemma start_state_allnodes_good: good_state start_state_allnodes. Proof. unfold start_state_allnodes; constructor; simpl; intros. -- destruct H as [instr CODE]. left. eapply NS.all_nodes_spec; eauto. +- destruct H as [instr CODE]. left. eapply NS.all_nodes_spec; eauto. - rewrite PTree.gempty in H. congruence. Qed. @@ -645,9 +645,9 @@ Lemma reachable_visited: forall p q, reachable code successors p q -> st.(visited) p -> st.(visited) q. Proof. intros st [GOOD1 GOOD2] PICK. induction 1; intros. -- auto. +- auto. - eapply IHreachable; eauto. - exploit GOOD1; eauto. intros [P | P]. + exploit GOOD1; eauto. intros [P | P]. eelim NS.pick_none; eauto. exploit P; eauto. intros OGE; inv OGE. eapply GOOD2; eauto. Qed. @@ -666,13 +666,13 @@ Theorem fixpoint_solution: (forall n, L.eq (transf n L.bot) L.bot) -> L.ge res!!s (transf n res!!n). Proof. - unfold fixpoint; intros. + unfold fixpoint; intros. exploit fixpoint_from_charact; eauto. intros (st & STEPS & PICK & RES). exploit steps_state_good; eauto. apply start_state_good. intros [GOOD1 GOOD2]. rewrite RES; unfold PMap.get; simpl. - destruct st.(aval)!n as [v|] eqn:STN. + destruct st.(aval)!n as [v|] eqn:STN. - destruct (GOOD1 n) as [P|P]; eauto. - eelim NS.pick_none; eauto. + eelim NS.pick_none; eauto. exploit P; eauto. unfold abstr_value; rewrite STN. intros OGE; inv OGE. auto. - apply L.ge_trans with L.bot. apply L.ge_bot. apply L.ge_refl. apply L.eq_sym. eauto. Qed. @@ -685,10 +685,10 @@ Theorem fixpoint_entry: fixpoint ep ev = Some res -> L.ge res!!ep ev. Proof. - unfold fixpoint; intros. + unfold fixpoint; intros. exploit fixpoint_from_charact; eauto. intros (st & STEPS & PICK & RES). - exploit (steps_incr ep); eauto. simpl. rewrite PTree.gss. intros [P Q]. - rewrite RES; unfold PMap.get; simpl. inv P; auto. + exploit (steps_incr ep); eauto. simpl. rewrite PTree.gss. intros [P Q]. + rewrite RES; unfold PMap.get; simpl. inv P; auto. Qed. (** For [fixpoint_allnodes], we show that the result is a solution @@ -701,12 +701,12 @@ Theorem fixpoint_allnodes_solution: In s (successors instr) -> L.ge res!!s (transf n res!!n). Proof. - unfold fixpoint_allnodes; intros. + unfold fixpoint_allnodes; intros. exploit fixpoint_from_charact; eauto. intros (st & STEPS & PICK & RES). exploit steps_state_good; eauto. apply start_state_allnodes_good. intros [GOOD1 GOOD2]. exploit (steps_incr n); eauto. simpl. intros [U V]. exploit (GOOD1 n). apply V. exists instr; auto. intros [P|P]. - eelim NS.pick_none; eauto. + eelim NS.pick_none; eauto. exploit P; eauto. intros OGE. rewrite RES; unfold PMap.get; simpl. inv OGE. assumption. Qed. @@ -723,15 +723,15 @@ Theorem fixpoint_nodeset_solution: In s (successors instr) -> L.ge res!!s (transf n res!!n). Proof. - unfold fixpoint_nodeset; intros. + unfold fixpoint_nodeset; intros. exploit fixpoint_from_charact; eauto. intros (st & STEPS & PICK & RES). exploit steps_state_good; eauto. apply start_state_nodeset_good. intros GOOD. - exploit (steps_incr e); eauto. simpl. intros [U V]. - assert (st.(visited) n). + exploit (steps_incr e); eauto. simpl. intros [U V]. + assert (st.(visited) n). { eapply reachable_visited; eauto. } destruct GOOD as [GOOD1 GOOD2]. exploit (GOOD1 n); eauto. intros [P|P]. - eelim NS.pick_none; eauto. + eelim NS.pick_none; eauto. exploit P; eauto. intros OGE. rewrite RES; unfold PMap.get; simpl. inv OGE. assumption. Qed. @@ -754,8 +754,8 @@ Proof. assert (inv (start_state ep ev)). { red; simpl; intros. unfold abstr_value, start_state; simpl. - rewrite PTree.gsspec. rewrite PTree.gempty. - destruct (peq x ep). auto. auto. + rewrite PTree.gsspec. rewrite PTree.gempty. + destruct (peq x ep). auto. auto. } assert (forall st v n, inv st -> P v -> inv (propagate_succ st v n)). { @@ -763,11 +763,11 @@ Proof. destruct (aval st)!n as [oldl|] eqn:E. destruct (L.beq oldl (L.lub oldl v)). auto. - unfold abstr_value. simpl. rewrite PTree.gsspec. destruct (peq x n). - apply P_lub; auto. replace oldl with (abstr_value n st). auto. - unfold abstr_value; rewrite E; auto. - apply H1. - unfold abstr_value. simpl. rewrite PTree.gsspec. destruct (peq x n). + unfold abstr_value. simpl. rewrite PTree.gsspec. destruct (peq x n). + apply P_lub; auto. replace oldl with (abstr_value n st). auto. + unfold abstr_value; rewrite E; auto. + apply H1. + unfold abstr_value. simpl. rewrite PTree.gsspec. destruct (peq x n). auto. apply H1. } @@ -782,13 +782,13 @@ Proof. auto. unfold step in e. destruct (NS.pick (worklist s2)) as [[n rem]|]; try discriminate. destruct (code!n) as [instr|] eqn:INSTR; inv e. - apply H2. apply IHsteps; auto. eapply P_transf; eauto. apply IHsteps; auto. + apply H2. apply IHsteps; auto. eapply P_transf; eauto. apply IHsteps; auto. apply IHsteps; auto. } - unfold fixpoint in H. exploit fixpoint_from_charact; eauto. - intros (st & STEPS & PICK & RES). - replace (res!!pc) with (abstr_value pc st). eapply H3; eauto. - rewrite RES; auto. + unfold fixpoint in H. exploit fixpoint_from_charact; eauto. + intros (st & STEPS & PICK & RES). + replace (res!!pc) with (abstr_value pc st). eapply H3; eauto. + rewrite RES; auto. Qed. End Kildall. @@ -825,15 +825,15 @@ Fixpoint add_successors (pred: PTree.t (list positive)) Lemma add_successors_correct: forall tolist from pred n s, - In n pred!!!s \/ (n = from /\ In s tolist) -> + In n pred!!!s \/ (n = from /\ In s tolist) -> In n (add_successors pred from tolist)!!!s. Proof. induction tolist; simpl; intros. tauto. apply IHtolist. unfold successors_list at 1. rewrite PTree.gsspec. destruct (peq s a). - subst a. destruct H. auto with coqlib. - destruct H. subst n. auto with coqlib. + subst a. destruct H. auto with coqlib. + destruct H. subst n. auto with coqlib. fold (successors_list pred s). intuition congruence. Qed. @@ -846,7 +846,7 @@ Lemma make_predecessors_correct_1: code!n = Some instr -> In s (successors instr) -> In n make_predecessors!!!s. Proof. - intros until s. + intros until s. set (P := fun m p => m!n = Some instr -> In s (successors instr) -> In n p!!!s). unfold make_predecessors. @@ -857,7 +857,7 @@ Proof. rewrite PTree.gempty in H; congruence. (* inductive case *) apply add_successors_correct. - rewrite PTree.gsspec in H2. destruct (peq n k). + rewrite PTree.gsspec in H2. destruct (peq n k). inv H2. auto. auto. Qed. @@ -867,7 +867,7 @@ Lemma make_predecessors_correct_2: code!n = Some instr -> In s (successors instr) -> exists l, make_predecessors!s = Some l /\ In n l. Proof. - intros. exploit make_predecessors_correct_1; eauto. + intros. exploit make_predecessors_correct_1; eauto. unfold successors_list. destruct (make_predecessors!s); simpl; intros. exists l; auto. contradiction. @@ -878,10 +878,10 @@ Lemma reachable_predecessors: reachable code successors p q -> reachable make_predecessors (fun l => l) q p. Proof. - induction 1. + induction 1. - constructor. -- exploit make_predecessors_correct_2; eauto. intros [l [P Q]]. - eapply reachable_right; eauto. +- exploit make_predecessors_correct_2; eauto. intros [l [P Q]]. + eapply reachable_right; eauto. Qed. End Predecessor. @@ -953,9 +953,9 @@ Variable transf: positive -> L.t -> L.t. Section Exit_points. -(** Assuming that the nodes of the CFG [code] are numbered in reverse +(** Assuming that the nodes of the CFG [code] are numbered in reverse postorder (cf. pass [Renumber]), an edge from [n] to [s] is a - normal edge if [s < n] and a back-edge otherwise. + normal edge if [s < n] and a back-edge otherwise. [sequential_node] returns [true] if the given node has at least one normal outgoing edge. It returns [false] if the given node is an exit node (no outgoing edges) or the final node of a loop body @@ -969,32 +969,32 @@ Definition sequential_node (pc: positive) (instr: A): bool := Definition exit_points : NS.t := PTree.fold - (fun ep pc instr => + (fun ep pc instr => if sequential_node pc instr then ep else NS.add pc ep) code NS.empty. Lemma exit_points_charact: - forall n, + forall n, NS.In n exit_points <-> exists i, code!n = Some i /\ sequential_node n i = false. Proof. - intros n. unfold exit_points. eapply PTree_Properties.fold_rec. + intros n. unfold exit_points. eapply PTree_Properties.fold_rec. - (* extensionality *) - intros. rewrite <- H. auto. + intros. rewrite <- H. auto. - (* base case *) - simpl. split; intros. - eelim NS.empty_spec; eauto. - destruct H as [i [P Q]]. rewrite PTree.gempty in P. congruence. + simpl. split; intros. + eelim NS.empty_spec; eauto. + destruct H as [i [P Q]]. rewrite PTree.gempty in P. congruence. - (* inductive case *) - intros. destruct (sequential_node k v) eqn:SN. - + rewrite H1. rewrite PTree.gsspec. destruct (peq n k). - subst. split; intros [i [P Q]]. congruence. inv P. congruence. + intros. destruct (sequential_node k v) eqn:SN. + + rewrite H1. rewrite PTree.gsspec. destruct (peq n k). + subst. split; intros [i [P Q]]. congruence. inv P. congruence. tauto. - + rewrite NS.add_spec. rewrite H1. rewrite PTree.gsspec. destruct (peq n k). - subst. split. intros. exists v; auto. auto. - split. intros [P | [i [P Q]]]. congruence. exists i; auto. - intros [i [P Q]]. right; exists i; auto. + + rewrite NS.add_spec. rewrite H1. rewrite PTree.gsspec. destruct (peq n k). + subst. split. intros. exists v; auto. auto. + split. intros [P | [i [P Q]]]. congruence. exists i; auto. + intros [i [P Q]]. right; exists i; auto. Qed. Lemma reachable_exit_points: @@ -1002,15 +1002,15 @@ Lemma reachable_exit_points: code!pc = Some i -> exists x, NS.In x exit_points /\ reachable code successors pc x. Proof. intros pc0. pattern pc0. apply (well_founded_ind Plt_wf). - intros pc HR i CODE. - destruct (sequential_node pc i) eqn:SN. + intros pc HR i CODE. + destruct (sequential_node pc i) eqn:SN. - (* at least one successor that decreases the pc *) - unfold sequential_node in SN. rewrite existsb_exists in SN. + unfold sequential_node in SN. rewrite existsb_exists in SN. destruct SN as [s [P Q]]. destruct (code!s) as [i'|] eqn:CS; try discriminate. InvBooleans. - exploit (HR s); eauto. intros [x [U V]]. - exists x; split; auto. eapply reachable_left; eauto. + exploit (HR s); eauto. intros [x [U V]]. + exists x; split; auto. eapply reachable_left; eauto. - (* otherwise we are an exit point *) - exists pc; split. + exists pc; split. rewrite exit_points_charact. exists i; auto. constructor. Qed. @@ -1023,7 +1023,7 @@ Lemma reachable_exit_points_predecessor: exists x, NS.In x exit_points /\ reachable (make_predecessors code successors) (fun l => l) x pc. Proof. intros. exploit reachable_exit_points; eauto. intros [x [P Q]]. - exists x; split; auto. apply reachable_predecessors. auto. + exists x; split; auto. apply reachable_predecessors. auto. Qed. End Exit_points. @@ -1067,7 +1067,7 @@ Theorem fixpoint_allnodes_solution: Proof. intros. exploit (make_predecessors_correct_2 code); eauto. intros [l [P Q]]. - unfold fixpoint_allnodes in H. + unfold fixpoint_allnodes in H. eapply DS.fixpoint_allnodes_solution; eauto. Qed. @@ -1082,7 +1082,7 @@ End Backward_Dataflow_Solver. In other terms, program points with multiple predecessors are mapped to [L.top] (the greatest, or coarsest, approximation) and the other program points are mapped to [transf p X[p]] where [p] is their unique - predecessor. + predecessor. This analysis applies to any type of approximations equipped with an ordering and a greatest element. *) @@ -1205,7 +1205,7 @@ Definition step (bb: bbmap) (st: state) : result + state := | None => inr _ (mkstate st.(aval) rem) | Some instr => - inr _ (propagate_successors + inr _ (propagate_successors bb (successors instr) (transf pc st.(aval)!!pc) (mkstate st.(aval) rem)) @@ -1214,7 +1214,7 @@ Definition step (bb: bbmap) (st: state) : result + state := (** Recognition of program points that have more than one predecessor. *) -Definition is_basic_block_head +Definition is_basic_block_head (preds: PTree.t (list positive)) (pc: positive) : bool := if peq pc entrypoint then true else match preds!!!pc with @@ -1254,16 +1254,16 @@ Lemma multiple_predecessors: n1 <> n2 -> basic_block_map s = true. Proof. - intros. + intros. assert (In n1 predecessors!!!s). eapply predecessors_correct; eauto. assert (In n2 predecessors!!!s). eapply predecessors_correct; eauto. unfold basic_block_map, is_basic_block_head. - destruct (peq s entrypoint). auto. + destruct (peq s entrypoint). auto. fold predecessors. - destruct (predecessors!!!s). + destruct (predecessors!!!s). auto. destruct l. - apply proj_sumbool_is_true. simpl in *. intuition congruence. + apply proj_sumbool_is_true. simpl in *. intuition congruence. auto. Qed. @@ -1272,12 +1272,12 @@ Lemma no_self_loop: code!n = Some instr -> In n (successors instr) -> basic_block_map n = true. Proof. intros. unfold basic_block_map, is_basic_block_head. - destruct (peq n entrypoint). auto. + destruct (peq n entrypoint). auto. fold predecessors. - exploit predecessors_correct; eauto. intros. + exploit predecessors_correct; eauto. intros. destruct (predecessors!!!n). - contradiction. - destruct l. apply proj_sumbool_is_true. simpl in H1. tauto. + contradiction. + destruct l. apply proj_sumbool_is_true. simpl in H1. tauto. auto. Qed. @@ -1285,7 +1285,7 @@ Qed. (** The invariant over the state is as follows: - Points with several predecessors are mapped to [L.top] -- Points not in the worklist satisfy their inequations +- Points not in the worklist satisfy their inequations (as in Kildall's algorithm). *) @@ -1294,7 +1294,7 @@ Definition state_invariant (st: state) : Prop := /\ (forall n, In n st.(worklist) \/ - (forall instr s, code!n = Some instr -> In s (successors instr) -> + (forall instr s, code!n = Some instr -> In s (successors instr) -> L.ge st.(aval)!!s (transf n st.(aval)!!n))). Lemma propagate_successors_charact1: @@ -1326,8 +1326,8 @@ Proof. caseEq (bb a); intro. elim (IHsuccs l st n); intros U V. split; intros. apply U; auto. - elim H0; intro. subst a. congruence. auto. - apply V. tauto. + elim H0; intro. subst a. congruence. auto. + apply V. tauto. set (st1 := mkstate (PMap.set a l (aval st)) (a :: worklist st)). elim (IHsuccs l st1 n); intros U V. split; intros. @@ -1338,16 +1338,16 @@ Proof. elim (U i H1); auto. rewrite V. unfold st1; simpl. apply PMap.gss. tauto. apply U; auto. - rewrite V. unfold st1; simpl. apply PMap.gso. + rewrite V. unfold st1; simpl. apply PMap.gso. red; intro; subst n. elim H0; intro. tauto. congruence. - tauto. + tauto. Qed. Lemma propagate_successors_invariant: forall pc instr res rem, code!pc = Some instr -> state_invariant (mkstate res (pc :: rem)) -> - state_invariant + state_invariant (propagate_successors basic_block_map (successors instr) (transf pc res!!pc) (mkstate res rem)). @@ -1360,23 +1360,23 @@ Proof. (successors instr) l (mkstate res rem)). set (st1 := propagate_successors basic_block_map (successors instr) l (mkstate res rem)). - intros U V. simpl in U. + intros U V. simpl in U. (* First part: BB entries remain at top *) split; intros. - elim (U n); intros C D. rewrite D. simpl. apply INV1. auto. tauto. + elim (U n); intros C D. rewrite D. simpl. apply INV1. auto. tauto. (* Second part: monotonicity *) (* Case 1: n = pc *) - destruct (peq pc n). subst n. + destruct (peq pc n). subst n. right; intros. assert (instr0 = instr) by congruence. subst instr0. elim (U s); intros C D. replace (st1.(aval)!!pc) with res!!pc. fold l. destruct (basic_block_map s) eqn:BB. - rewrite D. simpl. rewrite INV1. apply L.top_ge. auto. tauto. - elim (C H0 (refl_equal _)). intros X Y. rewrite Y. apply L.refl_ge. - elim (U pc); intros E F. rewrite F. reflexivity. + rewrite D. simpl. rewrite INV1. apply L.top_ge. auto. tauto. + elim (C H0 (refl_equal _)). intros X Y. rewrite Y. apply L.refl_ge. + elim (U pc); intros E F. rewrite F. reflexivity. destruct (In_dec peq pc (successors instr)). - right. eapply no_self_loop; eauto. + right. eapply no_self_loop; eauto. left; auto. (* Case 2: n <> pc *) elim (INV2 n); intro. @@ -1388,7 +1388,7 @@ Proof. they could change is if they were successors of pc as well, but that gives them two different predecessors, so they are basic block heads, and thus do not change! *) - intros. elim (U s); intros C D. rewrite D. reflexivity. + intros. elim (U s); intros C D. rewrite D. reflexivity. destruct (In_dec peq s (successors instr)). right. eapply multiple_predecessors with (n1 := pc) (n2 := n); eauto. left; auto. @@ -1396,13 +1396,13 @@ Proof. (* Case 2.2.1: n is a successor of pc. Either it is in the worklist or it did not change *) destruct (basic_block_map n) eqn:BB. - right; intros. + right; intros. elim (U n); intros C D. rewrite D. erewrite INV3; eauto. tauto. left. elim (U n); intros C D. elim (C i BB); intros. auto. (* Case 2.2.2: n is not a successor of pc. It did not change. *) right; intros. - elim (U n); intros C D. rewrite D. + elim (U n); intros C D. rewrite D. erewrite INV3; eauto. tauto. Qed. @@ -1416,7 +1416,7 @@ Proof. intros until rem. intros CODE [INV1 INV2]. simpl in INV1. simpl in INV2. split; simpl; intros. apply INV1; auto. - destruct (INV2 n) as [[U | U] | U]. + destruct (INV2 n) as [[U | U] | U]. subst n. right; intros; congruence. auto. auto. @@ -1439,12 +1439,12 @@ Proof. eapply (PrimIter.iterate_prop _ _ (step basic_block_map) state_invariant). - intros st INV. destruct st as [stin stwrk]. - unfold step. simpl. destruct stwrk as [ | pc rem ] eqn:WRK. + intros st INV. destruct st as [stin stwrk]. + unfold step. simpl. destruct stwrk as [ | pc rem ] eqn:WRK. auto. destruct (code!pc) as [instr|] eqn:CODE. - eapply propagate_successors_invariant; eauto. - eapply propagate_successors_invariant_2; eauto. + eapply propagate_successors_invariant; eauto. + eapply propagate_successors_invariant_2; eauto. eauto. apply initial_state_invariant. Qed. @@ -1457,11 +1457,11 @@ Theorem fixpoint_solution: code!n = Some instr -> In s (successors instr) -> L.ge res!!s (transf n res!!n). Proof. - intros. + intros. assert (state_invariant (mkstate res nil)). eapply analyze_invariant; eauto. - elim H2; simpl; intros. - elim (H4 n); intros. + elim H2; simpl; intros. + elim (H4 n); intros. contradiction. eauto. Qed. @@ -1471,13 +1471,13 @@ Theorem fixpoint_entry: fixpoint = Some res -> res!!entrypoint = L.top. Proof. - intros. + intros. assert (state_invariant (mkstate res nil)). - eapply analyze_invariant; eauto. - elim H0; simpl; intros. + eapply analyze_invariant; eauto. + elim H0; simpl; intros. apply H1. unfold basic_block_map, is_basic_block_head. - fold predecessors. apply peq_true. -Qed. + fold predecessors. apply peq_true. +Qed. (** ** Preservation of a property over solutions *) @@ -1493,8 +1493,8 @@ Lemma propagate_successors_P: Proof. induction succs; simpl; intros. auto. - case (bb a). auto. - apply IHsuccs. red; simpl; intros. + case (bb a). auto. + apply IHsuccs. red; simpl; intros. rewrite PMap.gsspec. case (peq pc a); intro. auto. apply H0. Qed. @@ -1502,7 +1502,7 @@ Qed. Theorem fixpoint_invariant: forall res pc, fixpoint = Some res -> P res!!pc. Proof. - unfold fixpoint; intros. pattern res. + unfold fixpoint; intros. pattern res. eapply (PrimIter.iterate_prop _ _ (step basic_block_map) Pstate). intros st PS. unfold step. destruct (st.(worklist)). @@ -1510,10 +1510,10 @@ Proof. assert (PS2: Pstate (mkstate st.(aval) l)). red; intro; simpl. apply PS. destruct (code!p) as [instr|] eqn:CODE. - apply propagate_successors_P. eauto. auto. + apply propagate_successors_P. eauto. auto. auto. - eauto. + eauto. red; intro; simpl. rewrite PMap.gi. apply Ptop. Qed. @@ -1532,7 +1532,7 @@ End BBlock_solver. the enumeration [n-1], [n-2], ..., 3, 2, 1 where [n] is the top CFG node is a reverse postorder traversal. Therefore, for forward analysis, we will use an implementation - of [NODE_SET] where the [pick] operation selects the + of [NODE_SET] where the [pick] operation selects the greatest node in the working list. For backward analysis, we will similarly pick the smallest node in the working list. *) @@ -1562,7 +1562,7 @@ Module NodeSetForward <: NODE_SET. Proof. intros. rewrite PHeap.In_insert. unfold In. intuition. Qed. - + Lemma pick_none: forall s n, pick s = None -> ~In n s. Proof. @@ -1582,14 +1582,14 @@ Module NodeSetForward <: NODE_SET. Qed. Lemma all_nodes_spec: - forall A (code: PTree.t A) n instr, + forall A (code: PTree.t A) n instr, code!n = Some instr -> In n (all_nodes code). Proof. intros A code n instr. apply PTree_Properties.fold_rec with (P := fun m set => m!n = Some instr -> In n set). (* extensionality *) - intros. apply H0. rewrite H. auto. + intros. apply H0. rewrite H. auto. (* base case *) rewrite PTree.gempty. congruence. (* inductive case *) @@ -1638,7 +1638,7 @@ Module NodeSetBackward <: NODE_SET. Qed. Lemma all_nodes_spec: - forall A (code: PTree.t A) n instr, + forall A (code: PTree.t A) n instr, code!n = Some instr -> In n (all_nodes code). Proof NodeSetForward.all_nodes_spec. End NodeSetBackward. diff --git a/backend/LTL.v b/backend/LTL.v index 67fb0197..48c5c850 100644 --- a/backend/LTL.v +++ b/backend/LTL.v @@ -77,8 +77,8 @@ Definition genv := Genv.t fundef unit. Definition locset := Locmap.t. (** Calling conventions are reflected at the level of location sets - (environments mapping locations to values) by the following two - functions. + (environments mapping locations to values) by the following two + functions. [call_regs caller] returns the location set at function entry, as a function of the location set [caller] of the calling function. @@ -87,7 +87,7 @@ Definition locset := Locmap.t. values as the corresponding outgoing stack slots (used for argument passing) in the caller. - Local and outgoing stack slots are initialized to undefined values. -*) +*) Definition call_regs (caller: locset) : locset := fun (l: loc) => diff --git a/backend/Linearize.v b/backend/Linearize.v index 78cdd743..68c2b32f 100644 --- a/backend/Linearize.v +++ b/backend/Linearize.v @@ -56,7 +56,7 @@ Open Scope error_monad_scope. The main challenge in code linearization is therefore to pick a ``good'' order for the nodes that exploits well the fall-through behavior. Many clever trace picking heuristics - have been developed for this purpose. + have been developed for this purpose. In this file, we present linearization in a way that clearly separates the heuristic part (choosing an order for the basic blocks) @@ -96,7 +96,7 @@ Definition reachable_aux (f: LTL.function) : option (PMap.t bool) := f.(fn_entrypoint) true. Definition reachable (f: LTL.function) : PMap.t bool := - match reachable_aux f with + match reachable_aux f with | None => PMap.init true | Some rs => rs end. @@ -118,7 +118,7 @@ Fixpoint nodeset_of_list (l: list node) (s: Nodeset.t) match l with | nil => OK s | hd :: tl => - if Nodeset.mem hd s + if Nodeset.mem hd s then Error (msg "Linearize: duplicates in enumeration") else nodeset_of_list tl (Nodeset.add hd s) end. diff --git a/backend/Linearizeaux.ml b/backend/Linearizeaux.ml index ef268562..71ee2e56 100644 --- a/backend/Linearizeaux.ml +++ b/backend/Linearizeaux.ml @@ -26,7 +26,7 @@ let enumerate_aux f reach = (fun pc nodes -> if PMap.get pc reach then Coq_cons (pc, nodes) - else nodes) + else nodes) f.fn_nextpc ***) @@ -100,7 +100,7 @@ let basic_blocks f joins = (* end_block: record block that we just discovered *) and end_block blk minpc = blocks := (minpc, List.rev blk) :: !blocks - in + in start_block f.fn_entrypoint; !blocks (* Flatten basic blocks in decreasing order of minpc *) diff --git a/backend/Linearizeproof.v b/backend/Linearizeproof.v index dc4d11ea..65258b2d 100644 --- a/backend/Linearizeproof.v +++ b/backend/Linearizeproof.v @@ -113,7 +113,7 @@ Proof. caseEq (reachable_aux f). unfold reachable_aux; intros reach A. assert (LBoolean.ge reach!!(f.(fn_entrypoint)) true). - eapply DS.fixpoint_entry. eexact A. auto. + eapply DS.fixpoint_entry. eexact A. auto. unfold LBoolean.ge in H. tauto. intros. apply PMap.gi. Qed. @@ -131,7 +131,7 @@ Proof. unfold reachable_aux. intro reach; intros. assert (LBoolean.ge reach!!pc' reach!!pc). change (reach!!pc) with ((fun pc r => r) pc (reach!!pc)). - eapply DS.fixpoint_solution; eauto. intros; apply DS.L.eq_refl. + eapply DS.fixpoint_solution; eauto. intros; apply DS.L.eq_refl. elim H3; intro. congruence. auto. intros. apply PMap.gi. Qed. @@ -152,13 +152,13 @@ Lemma nodeset_of_list_correct: /\ (forall pc, Nodeset.In pc s' <-> Nodeset.In pc s \/ In pc l) /\ (forall pc, In pc l -> ~Nodeset.In pc s). Proof. - induction l; simpl; intros. + induction l; simpl; intros. inv H. split. constructor. split. intro; tauto. intros; tauto. generalize H; clear H; caseEq (Nodeset.mem a s); intros. inv H0. exploit IHl; eauto. intros [A [B C]]. split. constructor; auto. red; intro. elim (C a H1). apply Nodeset.add_1. hnf. auto. - split. intros. rewrite B. rewrite NodesetFacts.add_iff. + split. intros. rewrite B. rewrite NodesetFacts.add_iff. unfold Nodeset.E.eq. unfold OrderedPositive.eq. tauto. intros. destruct H1. subst pc. rewrite NodesetFacts.not_mem_iff. auto. generalize (C pc H1). rewrite NodesetFacts.add_iff. tauto. @@ -172,7 +172,7 @@ Lemma check_reachable_correct: Nodeset.In pc s. Proof. intros f reach s. - assert (forall l ok, + assert (forall l ok, List.fold_left (fun a p => check_reachable_aux reach s a (fst p) (snd p)) l ok = true -> ok = true /\ (forall pc i, @@ -181,16 +181,16 @@ Proof. Nodeset.In pc s)). induction l; simpl; intros. split. auto. intros. destruct H0. - destruct a as [pc1 i1]. simpl in H. + destruct a as [pc1 i1]. simpl in H. exploit IHl; eauto. intros [A B]. - unfold check_reachable_aux in A. + unfold check_reachable_aux in A. split. destruct (reach!!pc1). elim (andb_prop _ _ A). auto. auto. - intros. destruct H0. inv H0. rewrite H1 in A. destruct (andb_prop _ _ A). + intros. destruct H0. inv H0. rewrite H1 in A. destruct (andb_prop _ _ A). apply Nodeset.mem_2; auto. eauto. intros pc i. unfold check_reachable. rewrite PTree.fold_spec. intros. - exploit H; eauto. intros [A B]. eapply B; eauto. + exploit H; eauto. intros [A B]. eapply B; eauto. apply PTree.elements_correct. eauto. Qed. @@ -201,9 +201,9 @@ Lemma enumerate_complete: (reachable f)!!pc = true -> In pc enum. Proof. - intros until i. unfold enumerate. + intros until i. unfold enumerate. set (reach := reachable f). - intros. monadInv H. + intros. monadInv H. generalize EQ0; clear EQ0. caseEq (check_reachable f reach x); intros; inv EQ0. exploit check_reachable_correct; eauto. intro. exploit nodeset_of_list_correct; eauto. intros [A [B C]]. @@ -215,9 +215,9 @@ Lemma enumerate_norepet: enumerate f = OK enum -> list_norepet enum. Proof. - intros until enum. unfold enumerate. + intros until enum. unfold enumerate. set (reach := reachable f). - intros. monadInv H. + intros. monadInv H. generalize EQ0; clear EQ0. caseEq (check_reachable f reach x); intros; inv EQ0. exploit nodeset_of_list_correct; eauto. intros [A [B C]]. auto. Qed. @@ -246,9 +246,9 @@ Proof. simpl; intros; discriminate. intros c3 TAIL UNIQ. simpl. generalize (is_label_correct lbl a). case (is_label lbl a); intro ISLBL. - subst a. intro. inversion TAIL. congruence. + subst a. intro. inversion TAIL. congruence. elim UNIQ; intros. elim H4. apply is_tail_in with c1; auto. - inversion TAIL. congruence. apply IHc2. auto. + inversion TAIL. congruence. apply IHc2. auto. destruct a; simpl in UNIQ; tauto. Qed. @@ -266,13 +266,13 @@ Proof. induction c1. simpl; intros; discriminate. simpl starts_with. destruct a; try (intros; discriminate). - intros. + intros. apply plus_left with E0 (State s f sp c1 ls m) E0. - simpl. constructor. + simpl. constructor. destruct (peq lbl l). subst l. replace c3 with c1. constructor. apply find_label_unique with lbl c2; auto. - apply plus_star. + apply plus_star. apply IHc1 with c2; auto. eapply is_tail_cons_left; eauto. traceEq. Qed. @@ -291,7 +291,7 @@ Lemma find_label_lin_block: find_label lbl (linearize_block b k) = find_label lbl k. Proof. intros lbl k. generalize (find_label_add_branch lbl k); intro. - induction b; simpl; auto. destruct a; simpl; auto. + induction b; simpl; auto. destruct a; simpl; auto. case (starts_with s1 k); simpl; auto. Qed. @@ -303,7 +303,7 @@ Remark linearize_body_cons: | Some b => Llabel pc :: linearize_block b (linearize_body f enum) end. Proof. - intros. unfold linearize_body. rewrite list_fold_right_eq. + intros. unfold linearize_body. rewrite list_fold_right_eq. unfold linearize_node. destruct (LTL.fn_code f)!pc; auto. Qed. @@ -315,13 +315,13 @@ Lemma find_label_lin_rec: Proof. induction enum; intros. elim H. - rewrite linearize_body_cons. + rewrite linearize_body_cons. destruct (peq a pc). subst a. exists (linearize_body f enum). rewrite H0. simpl. rewrite peq_true. auto. assert (In pc enum). simpl in H. tauto. destruct (IHenum pc b H1 H0) as [k FIND]. - exists k. destruct (LTL.fn_code f)!a. + exists k. destruct (LTL.fn_code f)!a. simpl. rewrite peq_false. rewrite find_label_lin_block. auto. auto. auto. Qed. @@ -334,7 +334,7 @@ Lemma find_label_lin: exists k, find_label pc (fn_code tf) = Some (linearize_block b k). Proof. - intros. monadInv H. simpl. + intros. monadInv H. simpl. rewrite find_label_add_branch. apply find_label_lin_rec. eapply enumerate_complete; eauto. auto. Qed. @@ -379,8 +379,8 @@ Lemma label_in_lin_rec: Proof. induction enum. simpl; auto. - rewrite linearize_body_cons. destruct (LTL.fn_code f)!a. - simpl. intros [A|B]. left; congruence. + rewrite linearize_body_cons. destruct (LTL.fn_code f)!a. + simpl. intros [A|B]. left; congruence. right. apply IHenum. eapply label_in_lin_block; eauto. intro; right; auto. Qed. @@ -389,7 +389,7 @@ Lemma unique_labels_add_branch: forall lbl k, unique_labels k -> unique_labels (add_branch lbl k). Proof. - intros; unfold add_branch. + intros; unfold add_branch. destruct (starts_with lbl k); simpl; intuition. Qed. @@ -410,9 +410,9 @@ Proof. induction enum. simpl; auto. rewrite linearize_body_cons. - intro. destruct (LTL.fn_code f)!a. + intro. destruct (LTL.fn_code f)!a. simpl. split. red. intro. inversion H. elim H3. - apply label_in_lin_rec with f. + apply label_in_lin_rec with f. apply label_in_lin_block with b. auto. apply unique_labels_lin_block. apply IHenum. inversion H; auto. apply IHenum. inversion H; auto. @@ -424,7 +424,7 @@ Lemma unique_labels_transf_function: unique_labels (fn_code tf). Proof. intros. monadInv H. simpl. - apply unique_labels_add_branch. + apply unique_labels_add_branch. apply unique_labels_lin_rec. eapply enumerate_norepet; eauto. Qed. @@ -438,7 +438,7 @@ Proof. intros; discriminate. case (is_label lbl a). intro. injection H; intro. subst c2. constructor. constructor. - intro. constructor. auto. + intro. constructor. auto. Qed. Lemma is_tail_add_branch: @@ -454,7 +454,7 @@ Lemma is_tail_lin_block: Proof. induction b; simpl; intros. auto. - destruct a; eauto with coqlib. + destruct a; eauto with coqlib. eapply is_tail_add_branch; eauto. destruct (starts_with s1 c1); eapply is_tail_add_branch; eauto with coqlib. Qed. @@ -558,7 +558,7 @@ Definition measure (S: LTL.state) : nat := Remark match_parent_locset: forall s ts, list_forall2 match_stackframes s ts -> parent_locset ts = LTL.parent_locset s. Proof. - induction 1; simpl. auto. inv H; auto. + induction 1; simpl. auto. inv H; auto. Qed. Theorem transf_step_correct: @@ -570,41 +570,41 @@ Proof. induction 1; intros; try (inv MS). (* start of block, at an [add_branch] *) - exploit find_label_lin; eauto. intros [k F]. + exploit find_label_lin; eauto. intros [k F]. left; econstructor; split. - eapply add_branch_correct; eauto. - econstructor; eauto. + eapply add_branch_correct; eauto. + econstructor; eauto. intros; eapply reachable_successors; eauto. eapply is_tail_lin_block; eauto. eapply is_tail_find_label; eauto. (* start of block, target of an [Lcond] *) - exploit find_label_lin; eauto. intros [k F]. + exploit find_label_lin; eauto. intros [k F]. left; econstructor; split. - apply plus_one. eapply exec_Lcond_true; eauto. - econstructor; eauto. + apply plus_one. eapply exec_Lcond_true; eauto. + econstructor; eauto. intros; eapply reachable_successors; eauto. eapply is_tail_lin_block; eauto. eapply is_tail_find_label; eauto. (* start of block, target of an [Ljumptable] *) - exploit find_label_lin; eauto. intros [k F]. + exploit find_label_lin; eauto. intros [k F]. left; econstructor; split. - apply plus_one. eapply exec_Ljumptable; eauto. - econstructor; eauto. + apply plus_one. eapply exec_Ljumptable; eauto. + econstructor; eauto. intros; eapply reachable_successors; eauto. eapply is_tail_lin_block; eauto. eapply is_tail_find_label; eauto. (* Lop *) left; econstructor; split. simpl. - apply plus_one. econstructor; eauto. - instantiate (1 := v); rewrite <- H; apply eval_operation_preserved. + apply plus_one. econstructor; eauto. + instantiate (1 := v); rewrite <- H; apply eval_operation_preserved. exact symbols_preserved. - econstructor; eauto. + econstructor; eauto. (* Lload *) left; econstructor; split. simpl. - apply plus_one. econstructor. - instantiate (1 := a). rewrite <- H; apply eval_addressing_preserved. - exact symbols_preserved. eauto. eauto. + apply plus_one. econstructor. + instantiate (1 := a). rewrite <- H; apply eval_addressing_preserved. + exact symbols_preserved. eauto. eauto. econstructor; eauto. (* Lgetstack *) @@ -614,14 +614,14 @@ Proof. (* Lsetstack *) left; econstructor; split. simpl. - apply plus_one. econstructor; eauto. + apply plus_one. econstructor; eauto. econstructor; eauto. (* Lstore *) left; econstructor; split. simpl. - apply plus_one. econstructor. - instantiate (1 := a). rewrite <- H; apply eval_addressing_preserved. - exact symbols_preserved. eauto. eauto. + apply plus_one. econstructor. + instantiate (1 := a). rewrite <- H; apply eval_addressing_preserved. + exact symbols_preserved. eauto. eauto. econstructor; eauto. (* Lcall *) @@ -629,7 +629,7 @@ Proof. left; econstructor; split. simpl. apply plus_one. econstructor; eauto. symmetry; eapply sig_preserved; eauto. - econstructor; eauto. constructor; auto. econstructor; eauto. + econstructor; eauto. constructor; auto. econstructor; eauto. (* Ltailcall *) exploit find_function_translated; eauto. intros [tfd [A B]]. @@ -637,7 +637,7 @@ Proof. apply plus_one. econstructor; eauto. rewrite (match_parent_locset _ _ STACKS). eauto. symmetry; eapply sig_preserved; eauto. - rewrite (stacksize_preserved _ _ TRF); eauto. + rewrite (stacksize_preserved _ _ TRF); eauto. rewrite (match_parent_locset _ _ STACKS). econstructor; eauto. @@ -664,25 +664,25 @@ Proof. destruct b. (* cond is true: no branch *) left; econstructor; split. - apply plus_one. eapply exec_Lcond_false. + apply plus_one. eapply exec_Lcond_false. rewrite eval_negate_condition. rewrite H. auto. eauto. rewrite DC. econstructor; eauto. (* cond is false: branch is taken *) - right; split. simpl; omega. split. auto. rewrite <- DC. econstructor; eauto. + right; split. simpl; omega. split. auto. rewrite <- DC. econstructor; eauto. rewrite eval_negate_condition. rewrite H. auto. (* branch if cond is true *) destruct b. (* cond is true: branch is taken *) - right; split. simpl; omega. split. auto. econstructor; eauto. + right; split. simpl; omega. split. auto. econstructor; eauto. (* cond is false: no branch *) left; econstructor; split. - apply plus_one. eapply exec_Lcond_false. eauto. eauto. + apply plus_one. eapply exec_Lcond_false. eauto. eauto. econstructor; eauto. (* Ljumptable *) assert (REACH': (reachable f)!!pc = true). - apply REACH. simpl. eapply list_nth_z_in; eauto. - right; split. simpl; omega. split. auto. econstructor; eauto. + apply REACH. simpl. eapply list_nth_z_in; eauto. + right; split. simpl; omega. split. auto. econstructor; eauto. (* Lreturn *) left; econstructor; split. @@ -695,9 +695,9 @@ Proof. apply reachable_entrypoint. monadInv H7. left; econstructor; split. - apply plus_one. eapply exec_function_internal; eauto. + apply plus_one. eapply exec_function_internal; eauto. rewrite (stacksize_preserved _ _ EQ). eauto. - generalize EQ; intro EQ'; monadInv EQ'. simpl. + generalize EQ; intro EQ'; monadInv EQ'. simpl. econstructor; eauto. simpl. eapply is_tail_add_branch. constructor. (* external function *) @@ -710,8 +710,8 @@ Proof. (* return *) inv H3. inv H1. left; econstructor; split. - apply plus_one. econstructor. - econstructor; eauto. + apply plus_one. econstructor. + econstructor; eauto. Qed. Lemma transf_initial_states: @@ -719,18 +719,18 @@ Lemma transf_initial_states: exists st2, Linear.initial_state tprog st2 /\ match_states st1 st2. Proof. intros. inversion H. - exploit function_ptr_translated; eauto. intros [tf [A B]]. + exploit function_ptr_translated; eauto. intros [tf [A B]]. exists (Callstate nil tf (Locmap.init Vundef) m0); split. - econstructor; eauto. eapply Genv.init_mem_transf_partial; eauto. + econstructor; eauto. eapply Genv.init_mem_transf_partial; eauto. replace (prog_main tprog) with (prog_main prog). rewrite symbols_preserved. eauto. - symmetry. apply (transform_partial_program_main transf_fundef _ TRANSF). + symmetry. apply (transform_partial_program_main transf_fundef _ TRANSF). rewrite <- H3. apply sig_preserved. auto. constructor. constructor. auto. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> LTL.final_state st1 r -> Linear.final_state st2 r. Proof. intros. inv H0. inv H. inv H6. econstructor; eauto. diff --git a/backend/Lineartyping.v b/backend/Lineartyping.v index 62a0c585..a52e47bb 100644 --- a/backend/Lineartyping.v +++ b/backend/Lineartyping.v @@ -72,7 +72,7 @@ Definition wt_instr (i: instruction) : bool := match is_move_operation op args with | Some arg => subtype (mreg_type arg) (mreg_type res) - | None => + | None => let (targs, tres) := type_of_operation op in subtype tres (mreg_type res) end @@ -105,7 +105,7 @@ Lemma wt_setreg: Val.has_type v (mreg_type r) -> wt_locset ls -> wt_locset (Locmap.set (R r) v ls). Proof. intros; red; intros. - unfold Locmap.set. + unfold Locmap.set. destruct (Loc.eq (R r) l). subst l; auto. destruct (Loc.diff_dec (R r) l). auto. red. auto. @@ -116,10 +116,10 @@ Lemma wt_setstack: wt_locset ls -> wt_locset (Locmap.set (S sl ofs ty) v ls). Proof. intros; red; intros. - unfold Locmap.set. + unfold Locmap.set. destruct (Loc.eq (S sl ofs ty) l). - subst l. simpl. - generalize (Val.load_result_type (chunk_of_type ty) v). + subst l. simpl. + generalize (Val.load_result_type (chunk_of_type ty) v). replace (type_of_chunk (chunk_of_type ty)) with ty. auto. destruct ty; reflexivity. destruct (Loc.diff_dec (S sl ofs ty) l). auto. red. auto. @@ -164,7 +164,7 @@ Lemma wt_setlist: Proof. induction vl; destruct rl; simpl; intros; try contradiction. auto. - destruct H. apply IHvl; auto. apply wt_setreg; auto. + destruct H. apply IHvl; auto. apply wt_setreg; auto. Qed. Lemma wt_setres: @@ -177,7 +177,7 @@ Proof. induction res; simpl; intros. - apply wt_setreg; auto. eapply Val.has_subtype; eauto. - auto. -- InvBooleans. eapply IHres2; eauto. destruct v; exact I. +- InvBooleans. eapply IHres2; eauto. destruct v; exact I. eapply IHres1; eauto. destruct v; exact I. Qed. @@ -189,7 +189,7 @@ Lemma wt_find_label: Proof. unfold wt_function; intros until c. generalize (fn_code f). induction c0; simpl; intros. discriminate. - InvBooleans. destruct (is_label lbl a). + InvBooleans. destruct (is_label lbl a). congruence. auto. Qed. @@ -250,15 +250,15 @@ Hypothesis wt_prog: Lemma wt_find_function: forall ros rs f, find_function ge ros rs = Some f -> wt_fundef f. Proof. - intros. + intros. assert (X: exists i, In (i, Gfun f) prog.(prog_defs)). { destruct ros as [r | s]; simpl in H. - eapply Genv.find_funct_inversion; eauto. + eapply Genv.find_funct_inversion; eauto. destruct (Genv.find_symbol ge s) as [b|]; try discriminate. eapply Genv.find_funct_ptr_inversion; eauto. } - destruct X as [i IN]. eapply wt_prog; eauto. + destruct X as [i IN]. eapply wt_prog; eauto. Qed. Theorem step_type_preservation: @@ -266,38 +266,38 @@ Theorem step_type_preservation: Proof. induction 1; intros WTS; inv WTS. - (* getstack *) - simpl in *; InvBooleans. + simpl in *; InvBooleans. econstructor; eauto. - eapply wt_setreg; eauto. eapply Val.has_subtype; eauto. apply WTRS. + eapply wt_setreg; eauto. eapply Val.has_subtype; eauto. apply WTRS. apply wt_undef_regs; auto. - (* setstack *) - simpl in *; InvBooleans. + simpl in *; InvBooleans. econstructor; eauto. apply wt_setstack. apply wt_undef_regs; auto. - (* op *) simpl in *. destruct (is_move_operation op args) as [src | ] eqn:ISMOVE. + (* move *) - InvBooleans. exploit is_move_operation_correct; eauto. intros [EQ1 EQ2]; subst. + InvBooleans. exploit is_move_operation_correct; eauto. intros [EQ1 EQ2]; subst. simpl in H. inv H. - econstructor; eauto. apply wt_setreg. eapply Val.has_subtype; eauto. apply WTRS. + econstructor; eauto. apply wt_setreg. eapply Val.has_subtype; eauto. apply WTRS. apply wt_undef_regs; auto. - + (* other ops *) + + (* other ops *) destruct (type_of_operation op) as [ty_args ty_res] eqn:TYOP. InvBooleans. econstructor; eauto. - apply wt_setreg; auto. eapply Val.has_subtype; eauto. - change ty_res with (snd (ty_args, ty_res)). rewrite <- TYOP. eapply type_of_operation_sound; eauto. - red; intros; subst op. simpl in ISMOVE. - destruct args; try discriminate. destruct args; discriminate. + apply wt_setreg; auto. eapply Val.has_subtype; eauto. + change ty_res with (snd (ty_args, ty_res)). rewrite <- TYOP. eapply type_of_operation_sound; eauto. + red; intros; subst op. simpl in ISMOVE. + destruct args; try discriminate. destruct args; discriminate. apply wt_undef_regs; auto. - (* load *) - simpl in *; InvBooleans. + simpl in *; InvBooleans. econstructor; eauto. - apply wt_setreg. eapply Val.has_subtype; eauto. + apply wt_setreg. eapply Val.has_subtype; eauto. destruct a; simpl in H0; try discriminate. eapply Mem.load_type; eauto. apply wt_undef_regs; auto. - (* store *) - simpl in *; InvBooleans. - econstructor. eauto. eauto. eauto. + simpl in *; InvBooleans. + econstructor. eauto. eauto. eauto. apply wt_undef_regs; auto. - (* call *) simpl in *; InvBooleans. @@ -305,35 +305,35 @@ Proof. eapply wt_find_function; eauto. - (* tailcall *) simpl in *; InvBooleans. - econstructor; eauto. + econstructor; eauto. eapply wt_find_function; eauto. - apply wt_return_regs; auto. apply wt_parent_locset; auto. + apply wt_return_regs; auto. apply wt_parent_locset; auto. - (* builtin *) simpl in *; InvBooleans. econstructor; eauto. - eapply wt_setres; eauto. eapply external_call_well_typed; eauto. + eapply wt_setres; eauto. eapply external_call_well_typed; eauto. apply wt_undef_regs; auto. - (* label *) simpl in *. econstructor; eauto. - (* goto *) - simpl in *. econstructor; eauto. eapply wt_find_label; eauto. + simpl in *. econstructor; eauto. eapply wt_find_label; eauto. - (* cond branch, taken *) simpl in *. econstructor. auto. auto. eapply wt_find_label; eauto. apply wt_undef_regs; auto. - (* cond branch, not taken *) - simpl in *. econstructor. auto. auto. auto. + simpl in *. econstructor. auto. auto. auto. apply wt_undef_regs; auto. - (* jumptable *) simpl in *. econstructor. auto. auto. eapply wt_find_label; eauto. apply wt_undef_regs; auto. - (* return *) - simpl in *. InvBooleans. + simpl in *. InvBooleans. econstructor; eauto. apply wt_return_regs; auto. apply wt_parent_locset; auto. - (* internal function *) simpl in WTFD. econstructor. eauto. eauto. eauto. - apply wt_undef_regs. apply wt_call_regs. auto. + apply wt_undef_regs. apply wt_call_regs. auto. - (* external function *) econstructor. auto. apply wt_setlist; auto. eapply Val.has_subtype_list. apply loc_result_type. eapply external_call_well_typed'; eauto. @@ -344,7 +344,7 @@ Qed. Theorem wt_initial_state: forall S, initial_state prog S -> wt_state S. Proof. - induction 1. econstructor. constructor. + induction 1. econstructor. constructor. unfold ge0 in H1. exploit Genv.find_funct_ptr_inversion; eauto. intros [id IN]. eapply wt_prog; eauto. apply wt_init. @@ -383,7 +383,7 @@ Lemma wt_state_builtin: wt_state (State s f sp (Lbuiltin ef args res :: c) rs m) -> forallb (loc_valid f) (params_of_builtin_args args) = true. Proof. - intros. inv H. simpl in WTC; InvBooleans. auto. + intros. inv H. simpl in WTC; InvBooleans. auto. Qed. Lemma wt_callstate_wt_regs: @@ -391,5 +391,5 @@ Lemma wt_callstate_wt_regs: wt_state (Callstate s f rs m) -> forall r, Val.has_type (rs (R r)) (mreg_type r). Proof. - intros. inv H. apply WTRS. + intros. inv H. apply WTRS. Qed. diff --git a/backend/Liveness.v b/backend/Liveness.v index b8a5f965..16533158 100644 --- a/backend/Liveness.v +++ b/backend/Liveness.v @@ -60,7 +60,7 @@ Fixpoint reg_list_dead an instruction is that a register is live before if either it is one of the arguments of the instruction, or it is not the result of the instruction and it is live after. - However, if the result of a side-effect-free instruction is not + However, if the result of a side-effect-free instruction is not live ``after'', the whole instruction will be removed later (since it computes a useless result), thus its arguments need not be live ``before''. *) @@ -122,11 +122,11 @@ Lemma analyze_solution: In s (successors_instr i) -> Regset.Subset (transfer f s live!!s) live!!n. Proof. - unfold analyze; intros. eapply DS.fixpoint_solution; eauto. - intros. unfold transfer; rewrite H2. apply DS.L.eq_refl. + unfold analyze; intros. eapply DS.fixpoint_solution; eauto. + intros. unfold transfer; rewrite H2. apply DS.L.eq_refl. Qed. -(** Given an RTL function, compute (for every PC) the list of +(** Given an RTL function, compute (for every PC) the list of pseudo-registers that are used for the last time in the instruction at PC. These are the registers that are used or defined by the instruction and dead afterwards. *) @@ -145,4 +145,4 @@ Definition last_uses (f: function) : PTree.t (list reg) := | Some live => PTree.map (last_uses_at live) f.(fn_code) end. - + diff --git a/backend/Locations.v b/backend/Locations.v index 439cd2dc..ea614585 100644 --- a/backend/Locations.v +++ b/backend/Locations.v @@ -35,13 +35,13 @@ Require Export Machregs. (** A slot in an activation record is designated abstractly by a kind, a type and an integer offset. Three kinds are considered: -- [Local]: these are the slots used by register allocation for +- [Local]: these are the slots used by register allocation for pseudo-registers that cannot be assigned a hardware register. - [Incoming]: used to store the parameters of the current function - that cannot reside in hardware registers, as determined by the + that cannot reside in hardware registers, as determined by the calling conventions. -- [Outgoing]: used to store arguments to called functions that - cannot reside in hardware registers, as determined by the +- [Outgoing]: used to store arguments to called functions that + cannot reside in hardware registers, as determined by the calling conventions. *) Inductive slot: Type := @@ -111,19 +111,19 @@ Module Loc. Defined. (** As mentioned previously, two locations can be different (in the sense - of the [<>] mathematical disequality), yet denote + of the [<>] mathematical disequality), yet denote overlapping memory chunks within the activation record. Given two locations, three cases are possible: - They are equal (in the sense of the [=] equality) - They are different and non-overlapping. - They are different but overlapping. - The second case (different and non-overlapping) is characterized + The second case (different and non-overlapping) is characterized by the following [Loc.diff] predicate. *) Definition diff (l1 l2: loc) : Prop := match l1, l2 with - | R r1, R r2 => + | R r1, R r2 => r1 <> r2 | S s1 d1 t1, S s2 d2 t2 => s1 <> s2 \/ d1 + typesize t1 <= d2 \/ d2 + typesize t2 <= d1 @@ -135,7 +135,7 @@ Module Loc. forall l, ~(diff l l). Proof. destruct l; unfold diff; auto. - red; intros. destruct H; auto. generalize (typesize_pos ty); omega. + red; intros. destruct H; auto. generalize (typesize_pos ty); omega. Qed. Lemma diff_not_eq: @@ -162,7 +162,7 @@ Module Loc. left; auto. destruct (zle (pos0 + typesize ty0) pos). left; auto. - right; red; intros [P | [P | P]]. congruence. omega. omega. + right; red; intros [P | [P | P]]. congruence. omega. omega. left; auto. Defined. @@ -181,9 +181,9 @@ Module Loc. Lemma notin_iff: forall l ll, notin l ll <-> (forall l', In l' ll -> Loc.diff l l'). Proof. - induction ll; simpl. + induction ll; simpl. tauto. - rewrite IHll. intuition. subst a. auto. + rewrite IHll. intuition. subst a. auto. Qed. Lemma notin_not_in: @@ -214,13 +214,13 @@ Module Loc. forall a l1 l2, disjoint (a :: l1) l2 -> disjoint l1 l2. Proof. - unfold disjoint; intros. auto with coqlib. + unfold disjoint; intros. auto with coqlib. Qed. Lemma disjoint_cons_right: forall a l1 l2, disjoint l1 (a :: l2) -> disjoint l1 l2. Proof. - unfold disjoint; intros. auto with coqlib. + unfold disjoint; intros. auto with coqlib. Qed. Lemma disjoint_sym: @@ -232,20 +232,20 @@ Module Loc. Lemma in_notin_diff: forall l1 l2 ll, notin l1 ll -> In l2 ll -> diff l1 l2. Proof. - intros. rewrite notin_iff in H. auto. + intros. rewrite notin_iff in H. auto. Qed. Lemma notin_disjoint: forall l1 l2, (forall x, In x l1 -> notin x l2) -> disjoint l1 l2. Proof. - intros; red; intros. exploit H; eauto. rewrite notin_iff; intros. auto. + intros; red; intros. exploit H; eauto. rewrite notin_iff; intros. auto. Qed. Lemma disjoint_notin: forall l1 l2 x, disjoint l1 l2 -> In x l1 -> notin x l2. Proof. - intros; rewrite notin_iff; intros. red in H. auto. + intros; rewrite notin_iff; intros. red in H. auto. Qed. (** [Loc.norepet ll] holds if the locations in list [ll] are pairwise @@ -279,7 +279,7 @@ End Loc. (** * Mappings from locations to values *) (** The [Locmap] module defines mappings from locations to values, - used as evaluation environments for the semantics of the [LTL] + used as evaluation environments for the semantics of the [LTL] and [Linear] intermediate languages. *) Set Implicit Arguments. @@ -315,7 +315,7 @@ Module Locmap. else Vundef. Lemma gss: forall l v m, - (set l v m) l = + (set l v m) l = match l with R r => v | S sl ofs ty => Val.load_result (chunk_of_type ty) v end. Proof. intros. unfold set. apply dec_eq_true. @@ -328,7 +328,7 @@ Module Locmap. Lemma gss_typed: forall l v m, Val.has_type v (Loc.type l) -> (set l v m) l = v. Proof. - intros. rewrite gss. destruct l. auto. apply Val.load_result_same; auto. + intros. rewrite gss. destruct l. auto. apply Val.load_result_same; auto. Qed. Lemma gso: forall l v m p, Loc.diff l p -> (set l v m) p = m p. @@ -348,19 +348,19 @@ Module Locmap. Lemma guo: forall ll l m, Loc.notin l ll -> (undef ll m) l = m l. Proof. - induction ll; simpl; intros. auto. - destruct H. rewrite IHll; auto. apply gso. apply Loc.diff_sym; auto. + induction ll; simpl; intros. auto. + destruct H. rewrite IHll; auto. apply gso. apply Loc.diff_sym; auto. Qed. Lemma gus: forall ll l m, In l ll -> (undef ll m) l = Vundef. Proof. assert (P: forall ll l m, m l = Vundef -> (undef ll m) l = Vundef). - induction ll; simpl; intros. auto. apply IHll. + induction ll; simpl; intros. auto. apply IHll. unfold set. destruct (Loc.eq a l). - destruct a. auto. destruct ty; reflexivity. + destruct a. auto. destruct ty; reflexivity. destruct (Loc.diff_dec a l); auto. - induction ll; simpl; intros. contradiction. - destruct H. apply P. subst a. apply gss_typed. exact I. + induction ll; simpl; intros. contradiction. + destruct H. apply P. subst a. apply gss_typed. exact I. auto. Qed. @@ -372,7 +372,7 @@ Module Locmap. Lemma gsetlisto: forall l ll vl m, Loc.notin l ll -> (setlist ll vl m) l = m l. Proof. - induction ll; simpl; intros. + induction ll; simpl; intros. auto. destruct vl; auto. destruct H. rewrite IHll; auto. apply gso; auto. apply Loc.diff_sym; auto. Qed. @@ -381,7 +381,7 @@ Module Locmap. match res with | BR r => set (R r) v m | BR_none => m - | BR_splitlong hi lo => + | BR_splitlong hi lo => setres lo (Val.loword v) (setres hi (Val.hiword v) m) end. @@ -431,53 +431,53 @@ Module OrderedLoc <: OrderedType. (ofs1 < ofs2 \/ (ofs1 = ofs2 /\ OrderedTyp.lt ty1 ty2))) end. Lemma eq_refl : forall x : t, eq x x. - Proof (@refl_equal t). + Proof (@refl_equal t). Lemma eq_sym : forall x y : t, eq x y -> eq y x. Proof (@sym_equal t). Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. Proof (@trans_equal t). Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. - unfold lt; intros. + unfold lt; intros. destruct x; destruct y; destruct z; try tauto. eapply Plt_trans; eauto. - destruct H. + destruct H. destruct H0. left; eapply OrderedSlot.lt_trans; eauto. - destruct H0. subst sl0. auto. + destruct H0. subst sl0. auto. destruct H. subst sl. destruct H0. auto. - destruct H. + destruct H. right. split. auto. intuition. - right; split. congruence. eapply OrderedTyp.lt_trans; eauto. + right; split. congruence. eapply OrderedTyp.lt_trans; eauto. Qed. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. - unfold lt, eq; intros; red; intros. subst y. - destruct x. + unfold lt, eq; intros; red; intros. subst y. + destruct x. eelim Plt_strict; eauto. - destruct H. eelim OrderedSlot.lt_not_eq; eauto. red; auto. - destruct H. destruct H0. omega. + destruct H. eelim OrderedSlot.lt_not_eq; eauto. red; auto. + destruct H. destruct H0. omega. destruct H0. eelim OrderedTyp.lt_not_eq; eauto. red; auto. Qed. Definition compare : forall x y : t, Compare lt eq x y. Proof. intros. destruct x; destruct y. - destruct (OrderedPositive.compare (IndexedMreg.index r) (IndexedMreg.index r0)). - + apply LT. red. auto. - + apply EQ. red. f_equal. apply IndexedMreg.index_inj. auto. + + apply LT. red. auto. + + apply EQ. red. f_equal. apply IndexedMreg.index_inj. auto. + apply GT. red. auto. - - apply LT. red; auto. + - apply LT. red; auto. - apply GT. red; auto. - destruct (OrderedSlot.compare sl sl0). + apply LT. red; auto. + destruct (OrderedZ.compare pos pos0). - * apply LT. red. auto. + * apply LT. red. auto. * destruct (OrderedTyp.compare ty ty0). apply LT. red; auto. - apply EQ. red; red in e; red in e0; red in e1. congruence. + apply EQ. red; red in e; red in e0; red in e1. congruence. apply GT. red; auto. - * apply GT. red. auto. + * apply GT. red. auto. + apply GT. red; auto. Defined. Definition eq_dec := Loc.eq. @@ -499,21 +499,21 @@ Module OrderedLoc <: OrderedType. Lemma outside_interval_diff: forall l l', lt l' (diff_low_bound l) \/ lt (diff_high_bound l) l' -> Loc.diff l l'. Proof. - intros. + intros. destruct l as [mr | sl ofs ty]; destruct l' as [mr' | sl' ofs' ty']; simpl in *; auto. - assert (IndexedMreg.index mr <> IndexedMreg.index mr'). { destruct H. apply sym_not_equal. apply Plt_ne; auto. apply Plt_ne; auto. } congruence. - assert (RANGE: forall ty, 1 <= typesize ty <= 2). { intros; unfold typesize. destruct ty0; omega. } - destruct H. - + destruct H. left. apply sym_not_equal. apply OrderedSlot.lt_not_eq; auto. + destruct H. + + destruct H. left. apply sym_not_equal. apply OrderedSlot.lt_not_eq; auto. destruct H. right. - destruct H0. right. generalize (RANGE ty'); omega. - destruct H0. - assert (ty' = Tint \/ ty' = Tsingle \/ ty' = Tany32). + destruct H0. right. generalize (RANGE ty'); omega. + destruct H0. + assert (ty' = Tint \/ ty' = Tsingle \/ ty' = Tany32). { unfold OrderedTyp.lt in H1. destruct ty'; auto; compute in H1; congruence. } - right. destruct H2 as [E|[E|E]]; subst ty'; simpl typesize; omega. + right. destruct H2 as [E|[E|E]]; subst ty'; simpl typesize; omega. + destruct H. left. apply OrderedSlot.lt_not_eq; auto. destruct H. right. destruct H0. left; omega. @@ -523,23 +523,23 @@ Module OrderedLoc <: OrderedType. Lemma diff_outside_interval: forall l l', Loc.diff l l' -> lt l' (diff_low_bound l) \/ lt (diff_high_bound l) l'. Proof. - intros. + intros. destruct l as [mr | sl ofs ty]; destruct l' as [mr' | sl' ofs' ty']; simpl in *; auto. - unfold Plt, Pos.lt. destruct (Pos.compare (IndexedMreg.index mr) (IndexedMreg.index mr')) eqn:C. elim H. apply IndexedMreg.index_inj. apply Pos.compare_eq_iff. auto. - auto. - rewrite Pos.compare_antisym. rewrite C. auto. + auto. + rewrite Pos.compare_antisym. rewrite C. auto. - destruct (OrderedSlot.compare sl sl'); auto. - destruct H. contradiction. + destruct H. contradiction. destruct H. - right; right; split; auto. left; omega. + right; right; split; auto. left; omega. left; right; split; auto. assert (EITHER: typesize ty' = 1 /\ OrderedTyp.lt ty' Tany64 \/ typesize ty' = 2). { destruct ty'; compute; auto. } destruct (zlt ofs' (ofs - 1)). left; auto. destruct EITHER as [[P Q] | P]. right; split; auto. omega. - left; omega. + left; omega. Qed. End OrderedLoc. diff --git a/backend/Mach.v b/backend/Mach.v index 8853d9da..739c8212 100644 --- a/backend/Mach.v +++ b/backend/Mach.v @@ -13,7 +13,7 @@ (** The Mach intermediate language: abstract syntax. Mach is the last intermediate language before generation of assembly - code. + code. *) Require Import Coqlib. @@ -34,14 +34,14 @@ Require Stacklayout. (** Like Linear, the Mach language is organized as lists of instructions operating over machine registers, with default fall-through behaviour - and explicit labels and branch instructions. + and explicit labels and branch instructions. The main difference with Linear lies in the instructions used to access the activation record. Mach has three such instructions: [Mgetstack] and [Msetstack] to read and write within the activation record for the current function, at a given word offset and with a given type; and [Mgetparam], to read within the activation record of - the caller. + the caller. These instructions implement a more concrete view of the activation record than the the [Lgetstack] and [Lsetstack] instructions of @@ -153,7 +153,7 @@ Lemma undef_regs_same: Proof. induction rl; simpl; intros. tauto. destruct H. subst a. apply Regmap.gss. - unfold Regmap.set. destruct (RegEq.eq r a); auto. + unfold Regmap.set. destruct (RegEq.eq r a); auto. Qed. Fixpoint set_regs (rl: list mreg) (vl: list val) (rs: regset) : regset := @@ -193,7 +193,7 @@ Lemma find_label_incl: forall lbl c c', find_label lbl c = Some c' -> incl c' c. Proof. induction c; simpl; intros. discriminate. - destruct (is_label lbl a). inv H. auto with coqlib. eauto with coqlib. + destruct (is_label lbl a). inv H. auto with coqlib. eauto with coqlib. Qed. Section RELSEM. diff --git a/backend/NeedDomain.v b/backend/NeedDomain.v index 770648b1..e40c1322 100644 --- a/backend/NeedDomain.v +++ b/backend/NeedDomain.v @@ -53,7 +53,7 @@ Fixpoint vagree (v w: val) (x: nval) {struct x}: Prop := match v, w with | Vint p, Vint q => iagree p q m | Vint p, _ => False - | _, _ => True + | _, _ => True end | All => Val.lessdef v w end. @@ -143,7 +143,7 @@ Lemma nge_lub_l: forall x y, nge (nlub x y) x. Proof. unfold nlub; destruct x, y; auto with na. - constructor. intros. autorewrite with ints; auto. rewrite H0; auto. + constructor. intros. autorewrite with ints; auto. rewrite H0; auto. Qed. Lemma nge_lub_r: @@ -171,13 +171,13 @@ Lemma iagree_and_eq: forall x y mask, iagree x y mask <-> Int.and x mask = Int.and y mask. Proof. - intros; split; intros. -- Int.bit_solve. specialize (H i H0). - destruct (Int.testbit mask i). - rewrite ! andb_true_r; auto. + intros; split; intros. +- Int.bit_solve. specialize (H i H0). + destruct (Int.testbit mask i). + rewrite ! andb_true_r; auto. rewrite ! andb_false_r; auto. - red; intros. exploit (eq_same_bits i); eauto; autorewrite with ints; auto. - rewrite H1. rewrite ! andb_true_r; auto. + rewrite H1. rewrite ! andb_true_r; auto. Qed. Lemma iagree_mone: @@ -203,7 +203,7 @@ Qed. Lemma iagree_not: forall x y m, iagree x y m -> iagree (Int.not x) (Int.not y) m. Proof. - intros; red; intros; autorewrite with ints; auto. f_equal; auto. + intros; red; intros; autorewrite with ints; auto. f_equal; auto. Qed. Lemma iagree_not': @@ -217,7 +217,7 @@ Lemma iagree_or: forall x y n m, iagree x y (Int.and m (Int.not n)) -> iagree (Int.or x n) (Int.or y n) m. Proof. - intros. apply iagree_not'. rewrite ! Int.not_or_and_not. apply iagree_and. + intros. apply iagree_not'. rewrite ! Int.not_or_and_not. apply iagree_and. apply iagree_not; auto. Qed. @@ -228,19 +228,19 @@ Lemma iagree_bitwise_binop: forall x1 x2 y1 y2 m, iagree x1 y1 m -> iagree x2 y2 m -> iagree (f x1 x2) (f y1 y2) m. Proof. - intros; red; intros. rewrite ! H by auto. f_equal; auto. + intros; red; intros. rewrite ! H by auto. f_equal; auto. Qed. Lemma iagree_shl: forall x y m n, iagree x y (Int.shru m n) -> iagree (Int.shl x n) (Int.shl y n) m. Proof. - intros; red; intros. autorewrite with ints; auto. + intros; red; intros. autorewrite with ints; auto. destruct (zlt i (Int.unsigned n)). - auto. -- generalize (Int.unsigned_range n); intros. - apply H. omega. rewrite Int.bits_shru by omega. - replace (i - Int.unsigned n + Int.unsigned n) with i by omega. +- generalize (Int.unsigned_range n); intros. + apply H. omega. rewrite Int.bits_shru by omega. + replace (i - Int.unsigned n + Int.unsigned n) with i by omega. rewrite zlt_true by omega. auto. Qed. @@ -248,11 +248,11 @@ Lemma iagree_shru: forall x y m n, iagree x y (Int.shl m n) -> iagree (Int.shru x n) (Int.shru y n) m. Proof. - intros; red; intros. autorewrite with ints; auto. + intros; red; intros. autorewrite with ints; auto. destruct (zlt (i + Int.unsigned n) Int.zwordsize). -- generalize (Int.unsigned_range n); intros. - apply H. omega. rewrite Int.bits_shl by omega. - replace (i + Int.unsigned n - Int.unsigned n) with i by omega. +- generalize (Int.unsigned_range n); intros. + apply H. omega. rewrite Int.bits_shl by omega. + replace (i + Int.unsigned n - Int.unsigned n) with i by omega. rewrite zlt_false by omega. auto. - auto. Qed. @@ -262,8 +262,8 @@ Lemma iagree_shr_1: Int.shru (Int.shl m n) n = m -> iagree x y (Int.shl m n) -> iagree (Int.shr x n) (Int.shr y n) m. Proof. - intros; red; intros. rewrite <- H in H2. rewrite Int.bits_shru in H2 by auto. - rewrite ! Int.bits_shr by auto. + intros; red; intros. rewrite <- H in H2. rewrite Int.bits_shru in H2 by auto. + rewrite ! Int.bits_shr by auto. destruct (zlt (i + Int.unsigned n) Int.zwordsize). - apply H0; auto. generalize (Int.unsigned_range n); omega. - discriminate. @@ -274,17 +274,17 @@ Lemma iagree_shr: iagree x y (Int.or (Int.shl m n) (Int.repr Int.min_signed)) -> iagree (Int.shr x n) (Int.shr y n) m. Proof. - intros; red; intros. rewrite ! Int.bits_shr by auto. - generalize (Int.unsigned_range n); intros. + intros; red; intros. rewrite ! Int.bits_shr by auto. + generalize (Int.unsigned_range n); intros. set (j := if zlt (i + Int.unsigned n) Int.zwordsize then i + Int.unsigned n else Int.zwordsize - 1). assert (0 <= j < Int.zwordsize). { unfold j; destruct (zlt (i + Int.unsigned n) Int.zwordsize); omega. } - apply H; auto. autorewrite with ints; auto. apply orb_true_intro. + apply H; auto. autorewrite with ints; auto. apply orb_true_intro. unfold j; destruct (zlt (i + Int.unsigned n) Int.zwordsize). -- left. rewrite zlt_false by omega. - replace (i + Int.unsigned n - Int.unsigned n) with i by omega. +- left. rewrite zlt_false by omega. + replace (i + Int.unsigned n - Int.unsigned n) with i by omega. auto. - right. reflexivity. Qed. @@ -302,14 +302,14 @@ Proof. mod Int.zwordsize) with i. auto. apply Int.eqmod_small_eq with Int.zwordsize; auto. apply Int.eqmod_trans with ((i - Int.unsigned amount) + Int.unsigned amount). - apply Int.eqmod_refl2; omega. + apply Int.eqmod_refl2; omega. eapply Int.eqmod_trans. 2: apply Int.eqmod_mod; auto. - apply Int.eqmod_add. - apply Int.eqmod_mod; auto. - apply Int.eqmod_refl. - apply Z_mod_lt; auto. + apply Int.eqmod_add. + apply Int.eqmod_mod; auto. + apply Int.eqmod_refl. apply Z_mod_lt; auto. -Qed. + apply Z_mod_lt; auto. +Qed. Lemma iagree_ror: forall p q m amount, @@ -317,9 +317,9 @@ Lemma iagree_ror: iagree (Int.ror p amount) (Int.ror q amount) m. Proof. intros. rewrite ! Int.ror_rol_neg by apply int_wordsize_divides_modulus. - apply iagree_rol. + apply iagree_rol. rewrite Int.ror_rol_neg by apply int_wordsize_divides_modulus. - rewrite Int.neg_involutive; auto. + rewrite Int.neg_involutive; auto. Qed. Lemma eqmod_iagree: @@ -327,14 +327,14 @@ Lemma eqmod_iagree: Int.eqmod (two_p (Int.size m)) x y -> iagree (Int.repr x) (Int.repr y) m. Proof. - intros. set (p := nat_of_Z (Int.size m)). + intros. set (p := nat_of_Z (Int.size m)). generalize (Int.size_range m); intros RANGE. assert (EQ: Int.size m = Z_of_nat p). { symmetry; apply nat_of_Z_eq. omega. } rewrite EQ in H; rewrite <- two_power_nat_two_p in H. red; intros. rewrite ! Int.testbit_repr by auto. - destruct (zlt i (Int.size m)). + destruct (zlt i (Int.size m)). eapply Int.same_bits_eqmod; eauto. omega. - assert (Int.testbit m i = false) by (eapply Int.bits_size_2; omega). + assert (Int.testbit m i = false) by (eapply Int.bits_size_2; omega). congruence. Qed. @@ -345,12 +345,12 @@ Lemma iagree_eqmod: iagree x y (complete_mask m) -> Int.eqmod (two_p (Int.size m)) (Int.unsigned x) (Int.unsigned y). Proof. - intros. set (p := nat_of_Z (Int.size m)). + intros. set (p := nat_of_Z (Int.size m)). generalize (Int.size_range m); intros RANGE. assert (EQ: Int.size m = Z_of_nat p). { symmetry; apply nat_of_Z_eq. omega. } - rewrite EQ; rewrite <- two_power_nat_two_p. - apply Int.eqmod_same_bits. intros. apply H. omega. - unfold complete_mask. rewrite Int.bits_zero_ext by omega. + rewrite EQ; rewrite <- two_power_nat_two_p. + apply Int.eqmod_same_bits. intros. apply H. omega. + unfold complete_mask. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by omega. rewrite Int.bits_mone by omega. auto. Qed. @@ -361,13 +361,13 @@ Proof. + subst m; reflexivity. + assert (Int.unsigned m <> 0). { red; intros; elim n. rewrite <- (Int.repr_unsigned m). rewrite H; auto. } - assert (0 < Int.size m). + assert (0 < Int.size m). { apply Int.Zsize_pos'. generalize (Int.unsigned_range m); omega. } generalize (Int.size_range m); intros. - f_equal. apply Int.bits_size_4. tauto. + f_equal. apply Int.bits_size_4. tauto. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by omega. apply Int.bits_mone; omega. - intros. rewrite Int.bits_zero_ext by omega. apply zlt_false; omega. + intros. rewrite Int.bits_zero_ext by omega. apply zlt_false; omega. Qed. (** ** Abstract operations over value needs. *) @@ -416,7 +416,7 @@ Proof. unfold orimm; intros; destruct x; simpl in *. - auto. - unfold Val.or; InvAgree. apply iagree_or; auto. -- InvAgree. simpl. apply Val.lessdef_same. f_equal. apply iagree_mone. +- InvAgree. simpl. apply Val.lessdef_same. f_equal. apply iagree_mone. apply iagree_or. rewrite Int.and_commut. rewrite Int.and_mone. auto. Qed. @@ -438,8 +438,8 @@ Lemma vagree_bitwise_binop: x. Proof. unfold bitwise; intros. destruct x; simpl in *. -- auto. -- InvAgree. +- auto. +- InvAgree. - inv H0; auto. inv H1; auto. destruct w1; auto. Qed. @@ -482,8 +482,8 @@ Lemma shlimm_sound: vagree v w (shlimm x n) -> vagree (Val.shl v (Vint n)) (Val.shl w (Vint n)) x. Proof. - unfold shlimm; intros. unfold Val.shl. - destruct (Int.ltu n Int.iwordsize). + unfold shlimm; intros. unfold Val.shl. + destruct (Int.ltu n Int.iwordsize). destruct x; simpl in *. - auto. - InvAgree. apply iagree_shl; auto. @@ -504,7 +504,7 @@ Lemma shruimm_sound: vagree (Val.shru v (Vint n)) (Val.shru w (Vint n)) x. Proof. unfold shruimm; intros. unfold Val.shru. - destruct (Int.ltu n Int.iwordsize). + destruct (Int.ltu n Int.iwordsize). destruct x; simpl in *. - auto. - InvAgree. apply iagree_shru; auto. @@ -528,10 +528,10 @@ Lemma shrimm_sound: vagree (Val.shr v (Vint n)) (Val.shr w (Vint n)) x. Proof. unfold shrimm; intros. unfold Val.shr. - destruct (Int.ltu n Int.iwordsize). + destruct (Int.ltu n Int.iwordsize). destruct x; simpl in *. - auto. -- InvAgree. +- InvAgree. destruct (Int.eq_dec (Int.shru (Int.shl m n) n) m). apply iagree_shr_1; auto. apply iagree_shr; auto. @@ -553,10 +553,10 @@ Lemma rolm_sound: Proof. unfold rolm; intros; destruct x; simpl in *. - auto. -- unfold Val.rolm; InvAgree. unfold Int.rolm. - apply iagree_and. apply iagree_rol. auto. -- unfold Val.rolm; InvAgree. apply Val.lessdef_same. f_equal. apply iagree_mone. - unfold Int.rolm. apply iagree_and. apply iagree_rol. rewrite Int.and_commut. +- unfold Val.rolm; InvAgree. unfold Int.rolm. + apply iagree_and. apply iagree_rol. auto. +- unfold Val.rolm; InvAgree. apply Val.lessdef_same. f_equal. apply iagree_mone. + unfold Int.rolm. apply iagree_and. apply iagree_rol. rewrite Int.and_commut. rewrite Int.and_mone. auto. Qed. @@ -573,15 +573,15 @@ Lemma ror_sound: vagree (Val.ror v (Vint n)) (Val.ror w (Vint n)) x. Proof. unfold ror; intros. unfold Val.ror. - destruct (Int.ltu n Int.iwordsize). + destruct (Int.ltu n Int.iwordsize). destruct x; simpl in *. - auto. -- InvAgree. apply iagree_ror; auto. +- InvAgree. apply iagree_ror; auto. - inv H; auto. - destruct v; auto with na. Qed. -(** Modular arithmetic operations: add, mul, opposite. +(** Modular arithmetic operations: add, mul, opposite. (But not subtraction because of the pointer - pointer case. *) Definition modarith (x: nval) := @@ -596,10 +596,10 @@ Lemma add_sound: vagree v1 w1 (modarith x) -> vagree v2 w2 (modarith x) -> vagree (Val.add v1 v2) (Val.add w1 w2) x. Proof. - unfold modarith; intros. destruct x; simpl in *. + unfold modarith; intros. destruct x; simpl in *. - auto. -- unfold Val.add; InvAgree. apply eqmod_iagree. apply Int.eqmod_add; apply iagree_eqmod; auto. -- inv H; auto. inv H0; auto. destruct w1; auto. +- unfold Val.add; InvAgree. apply eqmod_iagree. apply Int.eqmod_add; apply iagree_eqmod; auto. +- inv H; auto. inv H0; auto. destruct w1; auto. Qed. Remark modarith_idem: forall nv, modarith (modarith nv) = modarith nv. @@ -612,10 +612,10 @@ Lemma mul_sound: vagree v1 w1 (modarith x) -> vagree v2 w2 (modarith x) -> vagree (Val.mul v1 v2) (Val.mul w1 w2) x. Proof. - unfold mul, add; intros. destruct x; simpl in *. + unfold mul, add; intros. destruct x; simpl in *. - auto. -- unfold Val.mul; InvAgree. apply eqmod_iagree. apply Int.eqmod_mult; apply iagree_eqmod; auto. -- inv H; auto. inv H0; auto. destruct w1; auto. +- unfold Val.mul; InvAgree. apply eqmod_iagree. apply Int.eqmod_mult; apply iagree_eqmod; auto. +- inv H; auto. inv H0; auto. destruct w1; auto. Qed. Lemma neg_sound: @@ -625,8 +625,8 @@ Lemma neg_sound: Proof. intros; destruct x; simpl in *. - auto. -- unfold Val.neg; InvAgree. - apply eqmod_iagree. apply Int.eqmod_neg. apply iagree_eqmod; auto. +- unfold Val.neg; InvAgree. + apply eqmod_iagree. apply Int.eqmod_neg. apply iagree_eqmod; auto. - inv H; simpl; auto. Qed. @@ -648,12 +648,12 @@ Proof. unfold zero_ext; intros. destruct x; simpl in *. - auto. -- unfold Val.zero_ext; InvAgree. - red; intros. autorewrite with ints; try omega. +- unfold Val.zero_ext; InvAgree. + red; intros. autorewrite with ints; try omega. destruct (zlt i1 n); auto. apply H; auto. autorewrite with ints; try omega. rewrite zlt_true; auto. -- unfold Val.zero_ext; InvAgree; auto. apply Val.lessdef_same. f_equal. - Int.bit_solve; try omega. destruct (zlt i1 n); auto. apply H; auto. +- unfold Val.zero_ext; InvAgree; auto. apply Val.lessdef_same. f_equal. + Int.bit_solve; try omega. destruct (zlt i1 n); auto. apply H; auto. autorewrite with ints; try omega. apply zlt_true; auto. Qed. @@ -672,25 +672,25 @@ Lemma sign_ext_sound: Proof. unfold sign_ext; intros. destruct x; simpl in *. - auto. -- unfold Val.sign_ext; InvAgree. +- unfold Val.sign_ext; InvAgree. red; intros. autorewrite with ints; try omega. set (j := if zlt i1 n then i1 else n - 1). - assert (0 <= j < Int.zwordsize). + assert (0 <= j < Int.zwordsize). { unfold j; destruct (zlt i1 n); omega. } - apply H; auto. - autorewrite with ints; try omega. apply orb_true_intro. - unfold j; destruct (zlt i1 n). - left. rewrite zlt_true; auto. - right. rewrite Int.unsigned_repr. rewrite zlt_false by omega. - replace (n - 1 - (n - 1)) with 0 by omega. reflexivity. + apply H; auto. + autorewrite with ints; try omega. apply orb_true_intro. + unfold j; destruct (zlt i1 n). + left. rewrite zlt_true; auto. + right. rewrite Int.unsigned_repr. rewrite zlt_false by omega. + replace (n - 1 - (n - 1)) with 0 by omega. reflexivity. generalize Int.wordsize_max_unsigned; omega. -- unfold Val.sign_ext; InvAgree; auto. apply Val.lessdef_same. f_equal. +- unfold Val.sign_ext; InvAgree; auto. apply Val.lessdef_same. f_equal. Int.bit_solve; try omega. set (j := if zlt i1 n then i1 else n - 1). - assert (0 <= j < Int.zwordsize). + assert (0 <= j < Int.zwordsize). { unfold j; destruct (zlt i1 n); omega. } - apply H; auto. rewrite Int.bits_zero_ext; try omega. - rewrite zlt_true. apply Int.bits_mone; auto. + apply H; auto. rewrite Int.bits_zero_ext; try omega. + rewrite zlt_true. apply Int.bits_mone; auto. unfold j. destruct (zlt i1 n); omega. Qed. @@ -713,25 +713,25 @@ Proof. (list_repeat (size_chunk_nat chunk) Undef) (encode_val chunk w)). { - rewrite <- (encode_val_length chunk w). + rewrite <- (encode_val_length chunk w). apply repeat_Undef_inject_any. } assert (SAME: forall vl1 vl2, vl1 = vl2 -> list_forall2 memval_lessdef vl1 vl2). { - intros. subst vl2. revert vl1. induction vl1; constructor; auto. - apply memval_lessdef_refl. + intros. subst vl2. revert vl1. induction vl1; constructor; auto. + apply memval_lessdef_refl. } intros. unfold store_argument in H; destruct chunk. -- InvAgree. apply SAME. simpl; f_equal. apply encode_int_8_mod. +- InvAgree. apply SAME. simpl; f_equal. apply encode_int_8_mod. change 8 with (Int.size (Int.repr 255)). apply iagree_eqmod; auto. -- InvAgree. apply SAME. simpl; f_equal. apply encode_int_8_mod. +- InvAgree. apply SAME. simpl; f_equal. apply encode_int_8_mod. change 8 with (Int.size (Int.repr 255)). apply iagree_eqmod; auto. -- InvAgree. apply SAME. simpl; f_equal. apply encode_int_16_mod. +- InvAgree. apply SAME. simpl; f_equal. apply encode_int_16_mod. change 16 with (Int.size (Int.repr 65535)). apply iagree_eqmod; auto. -- InvAgree. apply SAME. simpl; f_equal. apply encode_int_16_mod. +- InvAgree. apply SAME. simpl; f_equal. apply encode_int_16_mod. change 16 with (Int.size (Int.repr 65535)). apply iagree_eqmod; auto. - apply encode_val_inject. rewrite val_inject_id; auto. - apply encode_val_inject. rewrite val_inject_id; auto. @@ -768,7 +768,7 @@ Lemma maskzero_sound: Val.maskzero_bool v n = Some b -> Val.maskzero_bool w n = Some b. Proof. - unfold maskzero; intros. + unfold maskzero; intros. unfold Val.maskzero_bool; InvAgree; try discriminate. inv H0. rewrite iagree_and_eq in H. rewrite H. auto. Qed. @@ -795,9 +795,9 @@ Let valid_pointer_inj: Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true -> Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true. Proof. - unfold inject_id; intros. inv H. rewrite Int.add_zero. + unfold inject_id; intros. inv H. rewrite Int.add_zero. rewrite Mem.valid_pointer_nonempty_perm in *. eauto. -Qed. +Qed. Let weak_valid_pointer_inj: forall b1 ofs b2 delta, @@ -805,7 +805,7 @@ Let weak_valid_pointer_inj: Mem.weak_valid_pointer m1 b1 (Int.unsigned ofs) = true -> Mem.weak_valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true. Proof. - unfold inject_id; intros. inv H. rewrite Int.add_zero. + unfold inject_id; intros. inv H. rewrite Int.add_zero. rewrite Mem.weak_valid_pointer_spec in *. rewrite ! Mem.valid_pointer_nonempty_perm in *. destruct H0; [left|right]; eauto. @@ -830,7 +830,7 @@ Let valid_different_pointers_inj: b1' <> b2' \/ Int.unsigned (Int.add ofs1 (Int.repr delta1)) <> Int.unsigned (Int.add ofs2 (Int.repr delta2)). Proof. - unfold inject_id; intros. left; congruence. + unfold inject_id; intros. left; congruence. Qed. Lemma default_needs_of_condition_sound: @@ -846,7 +846,7 @@ Qed. Lemma default_needs_of_operation_sound: forall op args1 v1 args2 nv, eval_operation ge (Vptr sp Int.zero) op args1 m1 = Some v1 -> - vagree_list args1 args2 nil + vagree_list args1 args2 nil \/ vagree_list args1 args2 (default nv :: nil) \/ vagree_list args1 args2 (default nv :: default nv :: nil) -> nv <> Nothing -> @@ -854,12 +854,12 @@ Lemma default_needs_of_operation_sound: eval_operation ge (Vptr sp Int.zero) op args2 m2 = Some v2 /\ vagree v1 v2 nv. Proof. - intros. assert (default nv = All) by (destruct nv; simpl; congruence). + intros. assert (default nv = All) by (destruct nv; simpl; congruence). rewrite H2 in H0. assert (Val.lessdef_list args1 args2). { - destruct H0. auto with na. - destruct H0. inv H0; constructor; auto with na. + destruct H0. auto with na. + destruct H0. inv H0; constructor; auto with na. inv H0; constructor; auto with na. inv H8; constructor; auto with na. } exploit (@eval_operation_inj _ _ _ _ ge ge inject_id). @@ -869,7 +869,7 @@ Proof. apply val_inject_list_lessdef; eauto. eauto. intros (v2 & A & B). exists v2; split; auto. - apply vagree_lessdef. apply val_inject_lessdef. auto. + apply vagree_lessdef. apply val_inject_lessdef. auto. Qed. End DEFAULT. @@ -890,12 +890,12 @@ Lemma andimm_redundant_sound: vagree (Val.and v (Vint n)) w x. Proof. unfold andimm_redundant; intros. destruct x; try discriminate. -- simpl; auto. +- simpl; auto. - InvBooleans. simpl in *; unfold Val.and; InvAgree. - red; intros. exploit (eq_same_bits i1); eauto. - autorewrite with ints; auto. rewrite H2; simpl; intros. - destruct (Int.testbit n i1) eqn:N; try discriminate. - rewrite andb_true_r. apply H0; auto. autorewrite with ints; auto. + red; intros. exploit (eq_same_bits i1); eauto. + autorewrite with ints; auto. rewrite H2; simpl; intros. + destruct (Int.testbit n i1) eqn:N; try discriminate. + rewrite andb_true_r. apply H0; auto. autorewrite with ints; auto. rewrite H2, N; auto. Qed. @@ -915,7 +915,7 @@ Proof. unfold orimm_redundant; intros. destruct x; try discriminate. - auto. - InvBooleans. simpl in *; unfold Val.or; InvAgree. - apply iagree_not'. rewrite Int.not_or_and_not. + apply iagree_not'. rewrite Int.not_or_and_not. apply (andimm_redundant_sound (Vint (Int.not i)) (Vint (Int.not i0)) (I m) (Int.not n)). simpl. rewrite Int.not_involutive. apply proj_sumbool_is_true. auto. simpl. apply iagree_not; auto. @@ -933,9 +933,9 @@ Proof. unfold rolm_redundant; intros; InvBooleans. subst amount. rewrite Val.rolm_zero. apply andimm_redundant_sound; auto. assert (forall n, Int.ror n Int.zero = n). - { intros. rewrite Int.ror_rol_neg by apply int_wordsize_divides_modulus. + { intros. rewrite Int.ror_rol_neg by apply int_wordsize_divides_modulus. rewrite Int.neg_zero. apply Int.rol_zero. } - unfold rolm, andimm in *. destruct x; auto. + unfold rolm, andimm in *. destruct x; auto. rewrite H in H0. auto. rewrite H in H0. auto. Qed. @@ -956,8 +956,8 @@ Lemma zero_ext_redundant_sound: Proof. unfold zero_ext_redundant; intros. destruct x; try discriminate. - auto. -- simpl in *; InvAgree. simpl. InvBooleans. rewrite <- H. - red; intros; autorewrite with ints; try omega. +- simpl in *; InvAgree. simpl. InvBooleans. rewrite <- H. + red; intros; autorewrite with ints; try omega. destruct (zlt i1 n). apply H0; auto. rewrite Int.bits_zero_ext in H3 by omega. rewrite zlt_false in H3 by auto. discriminate. Qed. @@ -978,10 +978,10 @@ Lemma sign_ext_redundant_sound: Proof. unfold sign_ext_redundant; intros. destruct x; try discriminate. - auto. -- simpl in *; InvAgree. simpl. InvBooleans. rewrite <- H. - red; intros; autorewrite with ints; try omega. +- simpl in *; InvAgree. simpl. InvBooleans. rewrite <- H. + red; intros; autorewrite with ints; try omega. destruct (zlt i1 n). apply H0; auto. - rewrite Int.bits_or; auto. rewrite H3; auto. + rewrite Int.bits_or; auto. rewrite H3; auto. rewrite Int.bits_zero_ext in H3 by omega. rewrite zlt_false in H3 by auto. discriminate. Qed. @@ -1014,7 +1014,7 @@ End NVal. Module NE := LPMap1(NVal). -Definition nenv := NE.t. +Definition nenv := NE.t. Definition nreg (ne: nenv) (r: reg) := NE.get r ne. @@ -1024,7 +1024,7 @@ Definition eagree (e1 e2: regset) (ne: nenv) : Prop := Lemma nreg_agree: forall rs1 rs2 ne r, eagree rs1 rs2 ne -> vagree rs1#r rs2#r (nreg ne r). Proof. - intros. apply H. + intros. apply H. Qed. Hint Resolve nreg_agree: na. @@ -1033,7 +1033,7 @@ Lemma eagree_ge: forall e1 e2 ne ne', eagree e1 e2 ne -> NE.ge ne ne' -> eagree e1 e2 ne'. Proof. - intros; red; intros. apply nge_agree with (NE.get r ne); auto. apply H0. + intros; red; intros. apply nge_agree with (NE.get r ne); auto. apply H0. Qed. Lemma eagree_bot: @@ -1045,15 +1045,15 @@ Qed. Lemma eagree_same: forall e ne, eagree e e ne. Proof. - intros; red; intros. apply vagree_same. + intros; red; intros. apply vagree_same. Qed. Lemma eagree_update_1: forall e1 e2 ne v1 v2 nv r, eagree e1 e2 ne -> vagree v1 v2 nv -> eagree (e1#r <- v1) (e2#r <- v2) (NE.set r nv ne). Proof. - intros; red; intros. rewrite NE.gsspec. rewrite ! PMap.gsspec. - destruct (peq r0 r); auto. + intros; red; intros. rewrite NE.gsspec. rewrite ! PMap.gsspec. + destruct (peq r0 r); auto. Qed. Lemma eagree_update: @@ -1062,7 +1062,7 @@ Lemma eagree_update: eagree e1 e2 (NE.set r Nothing ne) -> eagree (e1#r <- v1) (e2#r <- v2) ne. Proof. - intros; red; intros. specialize (H0 r0). rewrite NE.gsspec in H0. + intros; red; intros. specialize (H0 r0). rewrite NE.gsspec in H0. rewrite ! PMap.gsspec. destruct (peq r0 r). subst r0. auto. auto. @@ -1073,8 +1073,8 @@ Lemma eagree_update_dead: nreg ne r = Nothing -> eagree e1 e2 ne -> eagree (e1#r <- v1) e2 ne. Proof. - intros; red; intros. rewrite PMap.gsspec. - destruct (peq r0 r); auto. subst. unfold nreg in H. rewrite H. red; auto. + intros; red; intros. rewrite PMap.gsspec. + destruct (peq r0 r); auto. subst. unfold nreg in H. rewrite H. red; auto. Qed. (** * Neededness for memory locations *) @@ -1146,12 +1146,12 @@ Lemma nlive_add: Int.unsigned ofs <= i < Int.unsigned ofs + sz -> nlive (nmem_add nm p sz) b i. Proof. - intros. unfold nmem_add. destruct nm. apply nlive_all. - inv H1; try (apply nlive_all). + intros. unfold nmem_add. destruct nm. apply nlive_all. + inv H1; try (apply nlive_all). - (* Gl id ofs *) - assert (Genv.find_symbol ge id = Some b) by (eapply H; eauto). + assert (Genv.find_symbol ge id = Some b) by (eapply H; eauto). destruct gl!id as [iv|] eqn:NG. - + constructor; simpl; intros. + + constructor; simpl; intros. congruence. assert (id0 = id) by (eapply Genv.genv_vars_inj; eauto). subst id0. rewrite PTree.gss in H5. inv H5. rewrite ISet.In_remove. @@ -1161,13 +1161,13 @@ Proof. assert (id0 = id) by (eapply Genv.genv_vars_inj; eauto). subst id0. congruence. - (* Glo id *) - assert (Genv.find_symbol ge id = Some b) by (eapply H; eauto). + assert (Genv.find_symbol ge id = Some b) by (eapply H; eauto). constructor; simpl; intros. congruence. - assert (id0 = id) by (eapply Genv.genv_vars_inj; eauto). subst id0. + assert (id0 = id) by (eapply Genv.genv_vars_inj; eauto). subst id0. rewrite PTree.grs in H5. congruence. - (* Stk ofs *) - constructor; simpl; intros. + constructor; simpl; intros. rewrite ISet.In_remove. intros [A B]. elim A; auto. assert (bc b = BCglob id) by (eapply H; eauto). congruence. - (* Stack *) @@ -1183,19 +1183,19 @@ Proof. intros. inversion H; subst. unfold nmem_add; destruct p; try (apply nlive_all). - (* Gl id ofs *) destruct gl!id as [iv|] eqn:NG. - + split; simpl; intros. auto. - rewrite PTree.gsspec in H1. destruct (peq id0 id); eauto. inv H1. + + split; simpl; intros. auto. + rewrite PTree.gsspec in H1. destruct (peq id0 id); eauto. inv H1. rewrite ISet.In_remove. intros [P Q]. eelim GL; eauto. - + auto. + + auto. - (* Glo id *) - split; simpl; intros. auto. + split; simpl; intros. auto. rewrite PTree.grspec in H1. destruct (PTree.elt_eq id0 id). congruence. eauto. - (* Stk ofs *) - split; simpl; intros. + split; simpl; intros. rewrite ISet.In_remove. intros [P Q]. eelim STK; eauto. eauto. - (* Stack *) - split; simpl; intros. + split; simpl; intros. apply ISet.In_empty. eauto. Qed. @@ -1243,13 +1243,13 @@ Proof. split; simpl; auto; intros. rewrite PTree.gsspec in H6. destruct (peq id0 id). + inv H6. destruct H3. congruence. destruct gl!id as [iv0|] eqn:NG. - rewrite ISet.In_add. intros [P|P]. omega. eelim GL; eauto. - rewrite ISet.In_interval. omega. -+ eauto. + rewrite ISet.In_add. intros [P|P]. omega. eelim GL; eauto. + rewrite ISet.In_interval. omega. ++ eauto. - (* Stk ofs *) - split; simpl; auto; intros. destruct H3. - elim H3. subst b'. eapply bc_stack; eauto. - rewrite ISet.In_add. intros [P|P]. omega. eapply STK; eauto. + split; simpl; auto; intros. destruct H3. + elim H3. subst b'. eapply bc_stack; eauto. + rewrite ISet.In_add. intros [P|P]. omega. eapply STK; eauto. Qed. (** Test (conservatively) whether some locations in the range delimited @@ -1284,12 +1284,12 @@ Proof. inv H1; try discriminate. - (* Gl id ofs *) assert (Genv.find_symbol ge id = Some b) by (eapply H; eauto). - destruct gl!id as [iv|] eqn:HG; inv H2. + destruct gl!id as [iv|] eqn:HG; inv H2. destruct (ISet.contains (Int.unsigned ofs) (Int.unsigned ofs + sz) iv) eqn:IC; try discriminate. rewrite ISet.contains_spec in IC. eelim GL; eauto. -- (* Stk ofs *) +- (* Stk ofs *) destruct (ISet.contains (Int.unsigned ofs) (Int.unsigned ofs + sz) stk) eqn:IC; try discriminate. - rewrite ISet.contains_spec in IC. eelim STK; eauto. eapply bc_stack; eauto. + rewrite ISet.contains_spec in IC. eelim STK; eauto. eapply bc_stack; eauto. Qed. (** Kill all stack locations between 0 and [sz], and mark everything else @@ -1303,7 +1303,7 @@ Lemma nlive_dead_stack: forall sz b' i, b' <> sp \/ ~(0 <= i < sz) -> nlive (nmem_dead_stack sz) b' i. Proof. intros; constructor; simpl; intros. -- rewrite ISet.In_interval. intuition. +- rewrite ISet.In_interval. intuition. - rewrite PTree.gempty in H1; discriminate. Qed. @@ -1330,10 +1330,10 @@ Proof. intros. inversion H; subst. destruct nm2; simpl. auto. constructor; simpl; intros. - rewrite ISet.In_inter. intros [P Q]. eelim STK; eauto. -- rewrite PTree.gcombine in H1 by auto. +- rewrite PTree.gcombine in H1 by auto. destruct gl!id as [iv1|] eqn:NG1; try discriminate; destruct gl0!id as [iv2|] eqn:NG2; inv H1. - rewrite ISet.In_inter. intros [P Q]. eelim GL; eauto. + rewrite ISet.In_inter. intros [P Q]. eelim GL; eauto. Qed. Lemma nlive_lub_r: @@ -1342,10 +1342,10 @@ Proof. intros. inversion H; subst. destruct nm1; simpl. auto. constructor; simpl; intros. - rewrite ISet.In_inter. intros [P Q]. eelim STK; eauto. -- rewrite PTree.gcombine in H1 by auto. +- rewrite PTree.gcombine in H1 by auto. destruct gl0!id as [iv1|] eqn:NG1; try discriminate; destruct gl!id as [iv2|] eqn:NG2; inv H1. - rewrite ISet.In_inter. intros [P Q]. eelim GL; eauto. + rewrite ISet.In_inter. intros [P Q]. eelim GL; eauto. Qed. (** Boolean-valued equality test *) @@ -1362,18 +1362,18 @@ Lemma nmem_beq_sound: nmem_beq nm1 nm2 = true -> (nlive nm1 b ofs <-> nlive nm2 b ofs). Proof. - unfold nmem_beq; intros. + unfold nmem_beq; intros. destruct nm1 as [ | stk1 gl1]; destruct nm2 as [ | stk2 gl2]; try discriminate. - split; intros L; inv L. - InvBooleans. rewrite ISet.beq_spec in H0. rewrite PTree.beq_correct in H1. split; intros L; inv L; constructor; intros. -+ rewrite <- H0. eauto. ++ rewrite <- H0. eauto. + specialize (H1 id). rewrite H2 in H1. destruct gl1!id as [iv1|] eqn: NG; try contradiction. - rewrite ISet.beq_spec in H1. rewrite <- H1. eauto. -+ rewrite H0. eauto. + rewrite ISet.beq_spec in H1. rewrite <- H1. eauto. ++ rewrite H0. eauto. + specialize (H1 id). rewrite H2 in H1. destruct gl2!id as [iv2|] eqn: NG; try contradiction. rewrite ISet.beq_spec in H1. rewrite H1. eauto. -Qed. +Qed. End LOCATIONS. @@ -1390,11 +1390,11 @@ Module NA <: SEMILATTICE. Lemma eq_refl: forall x, eq x x. Proof. - unfold eq; destruct x; simpl; split. apply NE.eq_refl. tauto. + unfold eq; destruct x; simpl; split. apply NE.eq_refl. tauto. Qed. Lemma eq_sym: forall x y, eq x y -> eq y x. Proof. - unfold eq; destruct x, y; simpl. intros [A B]. + unfold eq; destruct x, y; simpl. intros [A B]. split. apply NE.eq_sym; auto. intros. rewrite B. tauto. Qed. @@ -1407,10 +1407,10 @@ Module NA <: SEMILATTICE. Definition beq (x y: t) : bool := NE.beq (fst x) (fst y) && nmem_beq (snd x) (snd y). - + Lemma beq_correct: forall x y, beq x y = true -> eq x y. Proof. - unfold beq, eq; destruct x, y; simpl; intros. InvBooleans. split. + unfold beq, eq; destruct x, y; simpl; intros. InvBooleans. split. apply NE.beq_correct; auto. intros. apply nmem_beq_sound; auto. Qed. @@ -1438,7 +1438,7 @@ Module NA <: SEMILATTICE. Proof. unfold ge, bot; destruct x; simpl. split. apply NE.ge_bot. - intros. inv H. + intros. inv H. Qed. Definition lub (x y: t) : t := @@ -1446,13 +1446,13 @@ Module NA <: SEMILATTICE. Lemma ge_lub_left: forall x y, ge (lub x y) x. Proof. - unfold ge; destruct x, y; simpl; split. + unfold ge; destruct x, y; simpl; split. apply NE.ge_lub_left. intros; apply nlive_lub_l; auto. Qed. Lemma ge_lub_right: forall x y, ge (lub x y) y. Proof. - unfold ge; destruct x, y; simpl; split. + unfold ge; destruct x, y; simpl; split. apply NE.ge_lub_right. intros; apply nlive_lub_r; auto. Qed. diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml index 594b43b7..e7c945e3 100644 --- a/backend/PrintAsm.ml +++ b/backend/PrintAsm.ml @@ -38,7 +38,7 @@ module Printer(Target:TARGET) = let print_location oc loc = if loc <> Cutil.no_loc then Target.print_file_line oc (fst loc) (snd loc) - + let print_function oc name fn = Hashtbl.clear current_function_labels; Target.reset_constants (); @@ -66,7 +66,7 @@ module Printer(Target:TARGET) = Target.print_jumptable oc jmptbl; if !Clflags.option_g then Hashtbl.iter (fun p i -> Debug.add_label name p i) current_function_labels - + let print_init_data oc name id = if Str.string_match PrintCsyntax.re_string_literal (extern_atom name) 0 && List.for_all (function Init_int8 _ -> true | _ -> false) id @@ -74,7 +74,7 @@ module Printer(Target:TARGET) = fprintf oc " .ascii \"%s\"\n" (PrintCsyntax.string_of_init id) else List.iter (Target.print_init oc) id - + let print_var oc name v = match v.gvar_init with | [] -> () @@ -101,7 +101,7 @@ module Printer(Target:TARGET) = let sz = match v.gvar_init with [Init_space sz] -> sz | _ -> assert false in Target.print_comm_symb oc sz name align - + let print_globdef oc (name,gdef) = match gdef with | Gfun (Internal code) -> print_function oc name code @@ -116,7 +116,7 @@ module Printer(Target:TARGET) = let symbol = Target.symbol end - module DebugPrinter = DwarfPrinter (DwarfTarget) + module DebugPrinter = DwarfPrinter (DwarfTarget) end let print_program oc p db = diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml index 78399c04..4a612c26 100644 --- a/backend/PrintAsmaux.ml +++ b/backend/PrintAsmaux.ml @@ -98,7 +98,7 @@ let elf_symbol_offset oc (symb, ofs) = let elf_print_fun_info oc name = fprintf oc " .type %a, @function\n" elf_symbol name; fprintf oc " .size %a, . - %a\n" elf_symbol name elf_symbol name - + let elf_print_var_info oc name = fprintf oc " .type %a, @object\n" elf_symbol name; fprintf oc " .size %a, . - %a\n" elf_symbol name elf_symbol name @@ -109,20 +109,20 @@ let cfi_startproc = (fun oc -> fprintf oc " .cfi_startproc\n") else (fun _ -> ()) - + let cfi_endproc = if Configuration.asm_supports_cfi then (fun oc -> fprintf oc " .cfi_endproc\n") else (fun _ -> ()) - - + + let cfi_adjust = if Configuration.asm_supports_cfi then (fun oc delta -> fprintf oc " .cfi_adjust_cfa_offset %ld\n" delta) else (fun _ _ -> ()) - + let cfi_rel_offset = if Configuration.asm_supports_cfi then (fun oc reg ofs -> fprintf oc " .cfi_rel_offset %s, %ld\n" reg ofs) @@ -211,7 +211,7 @@ let print_debug_info comment print_line print_preg sp_name oc kind txt args = comment print_debug_args args; | _ -> () - + (** Inline assembly *) let print_asm_argument print_preg oc modifier = function @@ -256,7 +256,7 @@ let print_inline_asm print_preg oc txt sg args res = (** Print CompCert version and command-line as asm comment *) let print_version_and_options oc comment = - let version_string = + let version_string = if Version.buildnr <> "" && Version.tag <> "" then sprintf "%s, Build: %s, Tag: %s" Version.version Version.buildnr Version.tag else diff --git a/backend/PrintCminor.ml b/backend/PrintCminor.ml index 19f4c839..9b6b1488 100644 --- a/backend/PrintCminor.ml +++ b/backend/PrintCminor.ml @@ -139,7 +139,7 @@ let rec expr p (prec, e) = if assoc = LtoR then (prec', prec' + 1) else (prec' + 1, prec') in - if prec' < prec + if prec' < prec then fprintf p "@[<hov 2>(" else fprintf p "@[<hov 2>"; begin match e with @@ -238,14 +238,14 @@ let rec print_stmt p s = print_expr_list (true, el) print_sig (ef_sig ef) | Sbuiltin(Some id, ef, el) -> - fprintf p "@[<hv 2>%s =@ builtin %s@,(@[<hov 0>%a@]) : @[<hov 0>%a@];@]" + fprintf p "@[<hv 2>%s =@ builtin %s@,(@[<hov 0>%a@]) : @[<hov 0>%a@];@]" (ident_name id) (name_of_external ef) print_expr_list (true, el) print_sig (ef_sig ef) | Sseq(s1,s2) when just_skips s1 && just_skips s2 -> () - | Sseq(s1, s2) when just_skips s1 -> + | Sseq(s1, s2) when just_skips s1 -> print_stmt p s2 | Sseq(s1, s2) when just_skips s2 -> print_stmt p s1 @@ -277,7 +277,7 @@ let rec print_stmt p s = (if long then "l" else "") print_expr e; List.iter (fun (n, x) -> - fprintf p "@ case %s%s: exit %d;" + fprintf p "@ case %s%s: exit %d;" (Z.to_string n) (if long then "LL" else "") (Nat.to_int x)) @@ -334,12 +334,12 @@ let print_init_data p = function let rec print_init_data_list p = function | [] -> () | [item] -> print_init_data p item - | item::rest -> + | item::rest -> (print_init_data p item; fprintf p ","; print_init_data_list p rest) -let print_globvar p gv = +let print_globvar p gv = if (gv.gvar_readonly) then fprintf p "readonly "; if (gv.gvar_volatile) then diff --git a/backend/PrintRTL.ml b/backend/PrintRTL.ml index 78ce1816..f2242c13 100644 --- a/backend/PrintRTL.ml +++ b/backend/PrintRTL.ml @@ -99,7 +99,7 @@ let print_function pp id f = (List.rev_map (fun (pc, i) -> (P.to_int pc, i)) (PTree.elements f.fn_code)) in - print_succ pp f.fn_entrypoint + print_succ pp f.fn_entrypoint (match instrs with (pc1, _) :: _ -> pc1 | [] -> -1); List.iter (print_instruction pp) instrs; fprintf pp "}\n\n" diff --git a/backend/PrintXTL.ml b/backend/PrintXTL.ml index bb67dc96..dd8434da 100644 --- a/backend/PrintXTL.ml +++ b/backend/PrintXTL.ml @@ -71,7 +71,7 @@ let liveset pp lv = fprintf pp "{"; VSet.iter (function V(r, ty) -> fprintf pp " x%d" (P.to_int r) | L l -> ()) - lv; + lv; fprintf pp " }" let print_succ pp s dfl = @@ -145,7 +145,7 @@ let print_function pp ?alloc ?live f = (List.map (fun (pc, i) -> (P.to_int pc, i)) (PTree.elements f.fn_code)) in - print_succ pp f.fn_entrypoint + print_succ pp f.fn_entrypoint (match instrs with (pc1, _) :: _ -> pc1 | [] -> -1); List.iter (print_block pp) instrs; fprintf pp "}\n\n"; diff --git a/backend/RTL.v b/backend/RTL.v index 3cd4335d..a39d37cb 100644 --- a/backend/RTL.v +++ b/backend/RTL.v @@ -64,7 +64,7 @@ Inductive instruction: Type := | Icall: signature -> reg + ident -> list reg -> reg -> node -> instruction (** [Icall sig fn args dest succ] invokes the function determined by [fn] (either a function pointer found in a register or a - function name), giving it the values of registers [args] + function name), giving it the values of registers [args] as arguments. It stores the return value in [dest] and branches to [succ]. *) | Itailcall: signature -> reg + ident -> list reg -> instruction @@ -127,7 +127,7 @@ Fixpoint init_regs (vl: list val) (rl: list reg) {struct rl} : regset := | _, _ => Regmap.init Vundef end. -(** The dynamic semantics of RTL is given in small-step style, as a +(** The dynamic semantics of RTL is given in small-step style, as a set of transitions between states. A state captures the current point in the execution. Three kinds of states appear in the transitions: @@ -149,7 +149,7 @@ Fixpoint init_regs (vl: list val) (rl: list reg) {struct rl} : regset := In all three kinds of states, the [cs] parameter represents the call stack. It is a list of frames [Stackframe res f sp pc rs]. Each frame represents -a function call in progress. +a function call in progress. [res] is the pseudo-register that will receive the result of the call. [f] is the calling function. [sp] is its stack pointer. @@ -355,9 +355,9 @@ Proof. assert (t1 = E0 -> exists s2, step (Genv.globalenv p) s t2 s2). intros. subst. inv H0. exists s1; auto. inversion H; subst; auto. - exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. + exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. exists (State s0 f sp pc' (regmap_setres res vres2 rs) m2). eapply exec_Ibuiltin; eauto. - exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. + exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. exists (Returnstate s0 vres2 m2). econstructor; eauto. (* trace length *) red; intros; inv H; simpl; try omega. @@ -450,15 +450,15 @@ Definition max_pc_function (f: function) := Lemma max_pc_function_sound: forall f pc i, f.(fn_code)!pc = Some i -> Ple pc (max_pc_function f). Proof. - intros until i. unfold max_pc_function. + intros until i. unfold max_pc_function. apply PTree_Properties.fold_rec with (P := fun c m => c!pc = Some i -> Ple pc m). (* extensionality *) - intros. apply H0. rewrite H; auto. + intros. apply H0. rewrite H; auto. (* base case *) rewrite PTree.gempty. congruence. (* inductive case *) - intros. rewrite PTree.gsspec in H2. destruct (peq pc k). - inv H2. xomega. + intros. rewrite PTree.gsspec in H2. destruct (peq pc k). + inv H2. xomega. apply Ple_trans with a. auto. xomega. Qed. @@ -493,9 +493,9 @@ Definition max_reg_function (f: function) := Remark max_reg_instr_ge: forall m pc i, Ple m (max_reg_instr m pc i). Proof. - intros. + intros. assert (X: forall l n, Ple m n -> Ple m (fold_left Pmax l n)). - { induction l; simpl; intros. + { induction l; simpl; intros. auto. apply IHl. xomega. } destruct i; simpl; try (destruct s0); repeat (apply X); try xomega. @@ -518,9 +518,9 @@ Qed. Remark max_reg_instr_uses: forall m pc i r, In r (instr_uses i) -> Ple r (max_reg_instr m pc i). Proof. - intros. + intros. assert (X: forall l n, In r l \/ Ple r n -> Ple r (fold_left Pmax l n)). - { induction l; simpl; intros. + { induction l; simpl; intros. tauto. apply IHl. destruct H0 as [[A|A]|A]. right; subst; xomega. auto. right; xomega. } destruct i; simpl in *; try (destruct s0); try (apply X; auto). @@ -536,36 +536,36 @@ Lemma max_reg_function_def: forall f pc i r, f.(fn_code)!pc = Some i -> instr_defs i = Some r -> Ple r (max_reg_function f). Proof. - intros. + intros. assert (Ple r (PTree.fold max_reg_instr f.(fn_code) 1%positive)). - { revert H. + { revert H. apply PTree_Properties.fold_rec with (P := fun c m => c!pc = Some i -> Ple r m). - intros. rewrite H in H1; auto. - rewrite PTree.gempty; congruence. - - intros. rewrite PTree.gsspec in H3. destruct (peq pc k). - + inv H3. eapply max_reg_instr_def; eauto. + - intros. rewrite PTree.gsspec in H3. destruct (peq pc k). + + inv H3. eapply max_reg_instr_def; eauto. + apply Ple_trans with a. auto. apply max_reg_instr_ge. } - unfold max_reg_function. xomega. + unfold max_reg_function. xomega. Qed. Lemma max_reg_function_use: forall f pc i r, f.(fn_code)!pc = Some i -> In r (instr_uses i) -> Ple r (max_reg_function f). Proof. - intros. + intros. assert (Ple r (PTree.fold max_reg_instr f.(fn_code) 1%positive)). - { revert H. + { revert H. apply PTree_Properties.fold_rec with (P := fun c m => c!pc = Some i -> Ple r m). - intros. rewrite H in H1; auto. - rewrite PTree.gempty; congruence. - - intros. rewrite PTree.gsspec in H3. destruct (peq pc k). - + inv H3. eapply max_reg_instr_uses; eauto. + - intros. rewrite PTree.gsspec in H3. destruct (peq pc k). + + inv H3. eapply max_reg_instr_uses; eauto. + apply Ple_trans with a. auto. apply max_reg_instr_ge. } - unfold max_reg_function. xomega. + unfold max_reg_function. xomega. Qed. Lemma max_reg_function_params: @@ -573,7 +573,7 @@ Lemma max_reg_function_params: Proof. intros. assert (X: forall l n, In r l \/ Ple r n -> Ple r (fold_left Pmax l n)). - { induction l; simpl; intros. + { induction l; simpl; intros. tauto. apply IHl. destruct H0 as [[A|A]|A]. right; subst; xomega. auto. right; xomega. } assert (Y: Ple r (fold_left Pmax f.(fn_params) 1%positive)). diff --git a/backend/RTLgen.v b/backend/RTLgen.v index 3da961c6..49d79fb2 100644 --- a/backend/RTLgen.v +++ b/backend/RTLgen.v @@ -27,7 +27,7 @@ Open Local Scope string_scope. (** * Translation environments and state *) -(** The translation functions are parameterized by the following +(** The translation functions are parameterized by the following compile-time environment, which maps CminorSel local variables and let-bound variables to RTL registers. The mapping for local variables is computed from the CminorSel variable declarations at the beginning of @@ -78,7 +78,7 @@ Lemma state_incr_trans: forall s1 s2 s3, state_incr s1 s2 -> state_incr s2 s3 -> state_incr s1 s3. Proof. intros. inv H; inv H0. apply state_incr_intro. - apply Ple_trans with (st_nextnode s2); assumption. + apply Ple_trans with (st_nextnode s2); assumption. apply Ple_trans with (st_nextreg s2); assumption. intros. generalize (H3 pc) (H5 pc). intuition congruence. Qed. @@ -93,7 +93,7 @@ Qed. to modify the global state. These luxuries are not available in Coq, however. Instead, we use a monadic encoding of the translation: translation functions take the current global state as argument, - and return either [Error msg] to denote an error, + and return either [Error msg] to denote an error, or [OK r s incr] to denote success. [s] is the modified state, [r] the result value of the translation function. and [incr] a proof that the final state is in the [state_incr] relation with the @@ -198,7 +198,7 @@ Definition add_instr (i: instruction) : mon node := fun s => let n := s.(st_nextnode) in OK n - (mkstate s.(st_nextreg) (Psucc n) (PTree.set n i s.(st_code)) + (mkstate s.(st_nextreg) (Psucc n) (PTree.set n i s.(st_code)) (add_instr_wf s i)) (add_instr_incr s i). @@ -306,7 +306,7 @@ Definition add_var (map: mapping) (name: ident) : mon (reg * mapping) := ret (r, mkmapping (PTree.set name r map.(map_vars)) map.(map_letvars)). -Fixpoint add_vars (map: mapping) (names: list ident) +Fixpoint add_vars (map: mapping) (names: list ident) {struct names} : mon (list reg * mapping) := match names with | nil => ret (nil, map) @@ -339,7 +339,7 @@ Definition find_letvar (map: mapping) (idx: nat) : mon reg := fresh temporary register. Exception: if [a] is a let-bound variable or a local variable, we return the RTL register associated with that variable instead. Returning a fresh temporary in all cases - would be semantically correct, but would generate less efficient + would be semantically correct, but would generate less efficient RTL code. *) Definition alloc_reg (map: mapping) (a: expr) : mon reg := diff --git a/backend/RTLgenaux.ml b/backend/RTLgenaux.ml index e3373bf9..045299d4 100644 --- a/backend/RTLgenaux.ml +++ b/backend/RTLgenaux.ml @@ -72,7 +72,7 @@ let size_eos = function let rec size_stmt = function | Sskip -> 0 | Sassign(id, a) -> size_expr a - | Sstore(chunk, addr, args, src) -> 1 + size_exprs args + size_expr src + | Sstore(chunk, addr, args, src) -> 1 + size_exprs args + size_expr src | Scall(optid, sg, eos, args) -> 3 + size_eos eos + size_exprs args + length_exprs args | Stailcall(sg, eos, args) -> @@ -91,6 +91,6 @@ let rec size_stmt = function | Slabel(lbl, s) -> size_stmt s | Sgoto lbl -> 1 -let more_likely (c: condexpr) (ifso: stmt) (ifnot: stmt) = +let more_likely (c: condexpr) (ifso: stmt) (ifnot: stmt) = size_stmt ifso > size_stmt ifnot diff --git a/backend/RTLgenproof.v b/backend/RTLgenproof.v index 19f6f1f4..f458de8b 100644 --- a/backend/RTLgenproof.v +++ b/backend/RTLgenproof.v @@ -59,25 +59,25 @@ Qed. Lemma add_var_wf: forall s1 s2 map name r map' i, - add_var map name s1 = OK (r,map') s2 i -> + add_var map name s1 = OK (r,map') s2 i -> map_wf map -> map_valid map s1 -> map_wf map'. Proof. - intros. monadInv H. + intros. monadInv H. apply mk_map_wf; simpl. intros until r0. repeat rewrite PTree.gsspec. destruct (peq id1 name); destruct (peq id2 name). congruence. - intros. inv H. elimtype False. - apply valid_fresh_absurd with r0 s1. + intros. inv H. elimtype False. + apply valid_fresh_absurd with r0 s1. apply H1. left; exists id2; auto. eauto with rtlg. - intros. inv H2. elimtype False. - apply valid_fresh_absurd with r0 s1. + intros. inv H2. elimtype False. + apply valid_fresh_absurd with r0 s1. apply H1. left; exists id1; auto. eauto with rtlg. inv H0. eauto. intros until r0. rewrite PTree.gsspec. - destruct (peq id name). + destruct (peq id name). intros. inv H. apply valid_fresh_absurd with r0 s1. apply H1. right; auto. @@ -90,7 +90,7 @@ Lemma add_vars_wf: add_vars map names s1 = OK (rl,map') s2 i -> map_wf map -> map_valid map s1 -> map_wf map'. Proof. - induction names; simpl; intros; monadInv H. + induction names; simpl; intros; monadInv H. auto. exploit add_vars_valid; eauto. intros [A B]. eapply add_var_wf; eauto. @@ -174,7 +174,7 @@ Lemma match_env_update_temp: match_env map e le (rs#r <- v). Proof. intros. apply match_env_invariant with rs; auto. - intros. case (Reg.eq r r0); intro. + intros. case (Reg.eq r r0); intro. subst r0; contradiction. apply Regmap.gso; auto. Qed. @@ -200,7 +200,7 @@ Proof. exists r'; split. auto. rewrite PMap.gso; auto. red; intros. subst r'. elim n. eauto. erewrite list_map_exten. eauto. - intros. symmetry. apply PMap.gso. red; intros. subst x. eauto. + intros. symmetry. apply PMap.gso. red; intros. subst x. eauto. Qed. (** A variant of [match_env_update_var] where a variable is optionally @@ -214,8 +214,8 @@ Lemma match_env_update_dest: match_env map e le rs -> match_env map (set_optvar dst v e) le (rs#r <- tv). Proof. - intros. inv H1; simpl. - eapply match_env_update_temp; eauto. + intros. inv H1; simpl. + eapply match_env_update_temp; eauto. eapply match_env_update_var; eauto. Qed. Hint Resolve match_env_update_dest: rtlg. @@ -253,7 +253,7 @@ Lemma match_env_unbind_letvar: match_env (add_letvar map r) e (v :: le) rs -> match_env map e le rs. Proof. - unfold add_letvar; intros. inv H. simpl in *. + unfold add_letvar; intros. inv H. simpl in *. constructor. auto. inversion me_letvars0. auto. Qed. @@ -282,13 +282,13 @@ Lemma match_set_params_init_regs: Proof. induction il; intros. - inv H. split. apply match_env_empty. auto. intros. + inv H. split. apply match_env_empty. auto. intros. simpl. apply Regmap.gi. monadInv H. simpl. exploit add_vars_valid; eauto. apply init_mapping_valid. intros [A B]. exploit add_var_valid; eauto. intros [A' B']. clear B'. - monadInv EQ1. + monadInv EQ1. destruct H0 as [ | v1 tv1 vs tvs]. (* vl = nil *) destruct (IHil _ _ _ _ nil nil _ EQ) as [ME UNDEF]. constructor. inv ME. split. @@ -306,13 +306,13 @@ Proof. intros id v. repeat rewrite PTree.gsspec. destruct (peq id a); intros. subst a. inv H. inv H1. exists x1; split. auto. rewrite Regmap.gss. constructor. inv H1. eexists; eauto. - exploit me_vars0; eauto. intros [r' [C D]]. + exploit me_vars0; eauto. intros [r' [C D]]. exists r'; split. auto. rewrite Regmap.gso. auto. apply valid_fresh_different with s. apply B. left; exists id; auto. - eauto with rtlg. + eauto with rtlg. destruct (map_letvars x0). auto. simpl in me_letvars0. inversion me_letvars0. - intros. rewrite Regmap.gso. apply UNDEF. + intros. rewrite Regmap.gso. apply UNDEF. apply reg_fresh_decr with s2; eauto with rtlg. apply sym_not_equal. apply valid_fresh_different with s2; auto. Qed. @@ -330,15 +330,15 @@ Proof. inv H2. auto. - monadInv H2. - exploit IHil; eauto. intro. + monadInv H2. + exploit IHil; eauto. intro. monadInv EQ1. constructor. - intros id v. simpl. repeat rewrite PTree.gsspec. - destruct (peq id a). subst a. intro. + intros id v. simpl. repeat rewrite PTree.gsspec. + destruct (peq id a). subst a. intro. exists x1. split. auto. inv H3. constructor. eauto with rtlg. - intros. eapply me_vars; eauto. + intros. eapply me_vars; eauto. simpl. eapply me_letvars; eauto. Qed. @@ -406,7 +406,7 @@ Lemma sig_transl_function: Proof. intros until tf. unfold transl_fundef, transf_partial_fundef. case f; intro. - unfold transl_function. + unfold transl_function. destruct (reserve_labels (fn_body f0) (PTree.empty node, init_state)) as [ngoto s0]. case (transl_fun f0 ngoto s0); simpl; intros. discriminate. @@ -429,10 +429,10 @@ Lemma tr_move_correct: rs'#r2 = rs#r1 /\ (forall r, r <> r2 -> rs'#r = rs#r). Proof. - intros. inv H. + intros. inv H. exists rs; split. constructor. auto. - exists (rs#r2 <- (rs#r1)); split. - apply star_one. eapply exec_Iop. eauto. auto. + exists (rs#r2 <- (rs#r1)); split. + apply star_one. eapply exec_Iop. eauto. auto. split. apply Regmap.gss. intros; apply Regmap.gso; auto. Qed. @@ -475,7 +475,7 @@ Variable m: mem. We formalize this simulation property by the following predicate parameterized by the CminorSel evaluation (left arrow). *) -Definition transl_expr_prop +Definition transl_expr_prop (le: letenv) (a: expr) (v: val) : Prop := forall tm cs f map pr ns nd rd rs dst (MWF: map_wf map) @@ -489,7 +489,7 @@ Definition transl_expr_prop /\ (forall r, In r pr -> rs'#r = rs#r) /\ Mem.extends m tm'. -Definition transl_exprlist_prop +Definition transl_exprlist_prop (le: letenv) (al: exprlist) (vl: list val) : Prop := forall tm cs f map pr ns nd rl rs (MWF: map_wf map) @@ -503,7 +503,7 @@ Definition transl_exprlist_prop /\ (forall r, In r pr -> rs'#r = rs#r) /\ Mem.extends m tm'. -Definition transl_condexpr_prop +Definition transl_condexpr_prop (le: letenv) (a: condexpr) (v: bool) : Prop := forall tm cs f map pr ns ntrue nfalse rs (MWF: map_wf map) @@ -531,22 +531,22 @@ Lemma transl_expr_Evar_correct: Proof. intros; red; intros. inv TE. exploit match_env_find_var; eauto. intro EQ. - exploit tr_move_correct; eauto. intros [rs' [A [B C]]]. + exploit tr_move_correct; eauto. intros [rs' [A [B C]]]. exists rs'; exists tm; split. eauto. destruct H2 as [[D E] | [D E]]. (* optimized case *) subst r dst. simpl. assert (forall r, rs'#r = rs#r). - intros. destruct (Reg.eq r rd). subst r. auto. auto. + intros. destruct (Reg.eq r rd). subst r. auto. auto. split. eapply match_env_invariant; eauto. split. congruence. split; auto. (* general case *) split. apply match_env_invariant with (rs#rd <- (rs#r)). - apply match_env_update_dest; auto. - intros. rewrite Regmap.gsspec. destruct (peq r0 rd). congruence. auto. - split. congruence. + apply match_env_update_dest; auto. + intros. rewrite Regmap.gsspec. destruct (peq r0 rd). congruence. auto. + split. congruence. split. intros. apply C. intuition congruence. auto. Qed. @@ -560,7 +560,7 @@ Lemma transl_expr_Eop_correct: transl_expr_prop le (Eop op args) v. Proof. intros; red; intros. inv TE. -(* normal case *) +(* normal case *) exploit H0; eauto. intros [rs1 [tm1 [EX1 [ME1 [RR1 [RO1 EXT1]]]]]]. edestruct eval_operation_lessdef as [v' []]; eauto. exists (rs1#rd <- v'); exists tm1. @@ -599,13 +599,13 @@ Proof. apply eval_addressing_preserved. exact symbols_preserved. auto. traceEq. (* Match-env *) - split. eauto with rtlg. + split. eauto with rtlg. (* Result *) split. rewrite Regmap.gss. auto. (* Other regs *) split. intros. rewrite Regmap.gso. auto. intuition congruence. (* Mem *) - auto. + auto. Qed. Lemma transl_expr_Econdition_correct: @@ -618,7 +618,7 @@ Lemma transl_expr_Econdition_correct: transl_expr_prop le (Econdition a ifso ifnot) v. Proof. intros; red; intros; inv TE. - exploit H0; eauto. intros [rs1 [tm1 [EX1 [ME1 [OTHER1 EXT1]]]]]. + exploit H0; eauto. intros [rs1 [tm1 [EX1 [ME1 [OTHER1 EXT1]]]]]. assert (tr_expr f.(fn_code) map pr (if va then ifso else ifnot) (if va then ntrue else nfalse) nd rd dst). destruct va; auto. exploit H2; eauto. intros [rs2 [tm2 [EX2 [ME2 [RES2 [OTHER2 EXT2]]]]]]. @@ -643,10 +643,10 @@ Lemma transl_expr_Elet_correct: transl_expr_prop (v1 :: le) a2 v2 -> transl_expr_prop le (Elet a1 a2) v2. Proof. - intros; red; intros; inv TE. + intros; red; intros; inv TE. exploit H0; eauto. intros [rs1 [tm1 [EX1 [ME1 [RES1 [OTHER1 EXT1]]]]]]. assert (map_wf (add_letvar map r)). - eapply add_letvar_wf; eauto. + eapply add_letvar_wf; eauto. exploit H2; eauto. eapply match_env_bind_letvar; eauto. intros [rs2 [tm2 [EX2 [ME3 [RES2 [OTHER2 EXT2]]]]]]. exists rs2; exists tm2. @@ -673,9 +673,9 @@ Proof. (* Exec *) split. eexact EX1. (* Match-env *) - split. + split. destruct H2 as [[A B] | [A B]]. - subst r dst; simpl. + subst r dst; simpl. apply match_env_invariant with rs. auto. intros. destruct (Reg.eq r rd). subst r. auto. auto. apply match_env_invariant with (rs#rd <- (rs#r)). @@ -684,9 +684,9 @@ Proof. intros. rewrite Regmap.gsspec. destruct (peq r0 rd); auto. congruence. (* Result *) - split. rewrite RES1. eapply match_env_find_letvar; eauto. + split. rewrite RES1. eapply match_env_find_letvar; eauto. (* Other regs *) - split. intros. + split. intros. destruct H2 as [[A B] | [A B]]. destruct (Reg.eq r0 rd); subst; auto. apply OTHER1. intuition congruence. @@ -712,7 +712,7 @@ Lemma transl_expr_Ebuiltin_correct: Proof. intros; red; intros. inv TE. exploit H0; eauto. intros [rs1 [tm1 [EX1 [ME1 [RR1 [RO1 EXT1]]]]]]. - exploit external_call_mem_extends; eauto. + exploit external_call_mem_extends; eauto. intros [v' [tm2 [A [B [C [D E]]]]]]. exists (rs1#rd <- v'); exists tm2. (* Exec *) @@ -720,7 +720,7 @@ Proof. change (rs1#rd <- v') with (regmap_setres (BR rd) v' rs1). eapply exec_Ibuiltin; eauto. eapply eval_builtin_args_trivial. - eapply external_call_symbols_preserved; eauto. + eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. reflexivity. (* Match-env *) @@ -745,9 +745,9 @@ Lemma transl_expr_Eexternal_correct: Proof. intros; red; intros. inv TE. exploit H3; eauto. intros [rs1 [tm1 [EX1 [ME1 [RR1 [RO1 EXT1]]]]]]. - exploit external_call_mem_extends; eauto. + exploit external_call_mem_extends; eauto. intros [v' [tm2 [A [B [C [D E]]]]]]. - exploit function_ptr_translated; eauto. simpl. intros [tf [P Q]]. inv Q. + exploit function_ptr_translated; eauto. simpl. intros [tf [P Q]]. inv Q. exists (rs1#rd <- v'); exists tm2. (* Exec *) split. eapply star_trans. eexact EX1. @@ -756,7 +756,7 @@ Proof. eapply star_left. eapply exec_function_external. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. - apply star_one. apply exec_return. + apply star_one. apply exec_return. reflexivity. reflexivity. reflexivity. (* Match-env *) split. eauto with rtlg. @@ -794,7 +794,7 @@ Proof. exploit H2; eauto. intros [rs2 [tm2 [EX2 [ME2 [RES2 [OTHER2 EXT2]]]]]]. exists rs2; exists tm2. (* Exec *) - split. eapply star_trans. eexact EX1. eexact EX2. auto. + split. eapply star_trans. eexact EX1. eexact EX2. auto. (* Match-env *) split. assumption. (* Results *) @@ -803,7 +803,7 @@ Proof. auto. (* Other regs *) split. intros. transitivity (rs1#r). - apply OTHER2; auto. simpl; tauto. + apply OTHER2; auto. simpl; tauto. apply OTHER1; auto. (* Mem *) auto. @@ -816,16 +816,16 @@ Lemma transl_condexpr_CEcond_correct: eval_condition cond vl m = Some vb -> transl_condexpr_prop le (CEcond cond al) vb. Proof. - intros; red; intros. inv TE. + intros; red; intros. inv TE. exploit H0; eauto. intros [rs1 [tm1 [EX1 [ME1 [RES1 [OTHER1 EXT1]]]]]]. exists rs1; exists tm1. (* Exec *) - split. eapply plus_right. eexact EX1. eapply exec_Icond. eauto. + split. eapply plus_right. eexact EX1. eapply exec_Icond. eauto. eapply eval_condition_lessdef; eauto. auto. traceEq. (* Match-env *) split. assumption. (* Other regs *) - split. assumption. + split. assumption. (* Mem *) auto. Qed. @@ -838,7 +838,7 @@ Lemma transl_condexpr_CEcondition_correct: transl_condexpr_prop le (if va then b else c) v -> transl_condexpr_prop le (CEcondition a b c) v. Proof. - intros; red; intros. inv TE. + intros; red; intros. inv TE. exploit H0; eauto. intros [rs1 [tm1 [EX1 [ME1 [OTHER1 EXT1]]]]]. assert (tr_condition (fn_code f) map pr (if va then b else c) (if va then n2 else n3) ntrue nfalse). destruct va; auto. @@ -849,7 +849,7 @@ Proof. (* Match-env *) split. assumption. (* Other regs *) - split. intros. rewrite OTHER2; auto. + split. intros. rewrite OTHER2; auto. (* Mem *) auto. Qed. @@ -862,11 +862,11 @@ Lemma transl_condexpr_CElet_correct: transl_condexpr_prop (v1 :: le) b v2 -> transl_condexpr_prop le (CElet a b) v2. Proof. - intros; red; intros. inv TE. + intros; red; intros. inv TE. exploit H0; eauto. intros [rs1 [tm1 [EX1 [ME1 [RES1 [OTHER1 EXT1]]]]]]. assert (map_wf (add_letvar map r)). - eapply add_letvar_wf; eauto. - exploit H2; eauto. eapply match_env_bind_letvar; eauto. + eapply add_letvar_wf; eauto. + exploit H2; eauto. eapply match_env_bind_letvar; eauto. intros [rs2 [tm2 [EX2 [ME3 [OTHER2 EXT2]]]]]. exists rs2; exists tm2. (* Exec *) @@ -874,7 +874,7 @@ Proof. (* Match-env *) split. eapply match_env_unbind_letvar; eauto. (* Other regs *) - split. intros. rewrite OTHER2; auto. + split. intros. rewrite OTHER2; auto. (* Mem *) auto. Qed. @@ -950,7 +950,7 @@ Proof (** Exit expressions. *) -Definition transl_exitexpr_prop +Definition transl_exitexpr_prop (le: letenv) (a: exitexpr) (x: nat) : Prop := forall tm cs f map ns nexits rs (MWF: map_wf map) @@ -981,21 +981,21 @@ Proof. auto. - (* XEcondition *) exploit transl_condexpr_correct; eauto. intros (rs1 & tm1 & EXEC1 & ME1 & RES1 & EXT1). - exploit IHeval_exitexpr; eauto. + exploit IHeval_exitexpr; eauto. instantiate (2 := if va then n2 else n3). destruct va; eauto. intros (nd & rs2 & tm2 & EXEC2 & EXIT2 & ME2 & EXT2). - exists nd, rs2, tm2. + exists nd, rs2, tm2. split. eapply star_trans. apply plus_star. eexact EXEC1. eexact EXEC2. traceEq. auto. - (* XElet *) exploit transl_expr_correct; eauto. intros (rs1 & tm1 & EXEC1 & ME1 & RES1 & PRES1 & EXT1). assert (map_wf (add_letvar map r)). - eapply add_letvar_wf; eauto. + eapply add_letvar_wf; eauto. exploit IHeval_exitexpr; eauto. eapply match_env_bind_letvar; eauto. intros (nd & rs2 & tm2 & EXEC2 & EXIT2 & ME2 & EXT2). exists nd, rs2, tm2. - split. eapply star_trans. eexact EXEC1. eexact EXEC2. traceEq. - split. auto. + split. eapply star_trans. eexact EXEC1. eexact EXEC2. traceEq. + split. auto. split. eapply match_env_unbind_letvar; eauto. auto. Qed. @@ -1010,20 +1010,20 @@ Lemma eval_exprlist_append: Proof. induction al1; simpl; intros vl1 al2 vl2 E1 E2; inv E1. - auto. -- simpl. constructor; eauto. +- simpl. constructor; eauto. Qed. Lemma invert_eval_builtin_arg: forall a v, eval_builtin_arg ge sp e m a v -> - exists vl, + exists vl, eval_exprlist ge sp e m nil (exprlist_of_expr_list (params_of_builtin_arg a)) vl /\ Events.eval_builtin_arg ge (fun v => v) sp m (fst (convert_builtin_arg a vl)) v /\ (forall vl', convert_builtin_arg a (vl ++ vl') = (fst (convert_builtin_arg a vl), vl')). Proof. induction 1; simpl; econstructor; intuition eauto with evalexpr barg. - constructor. - constructor. + constructor. + constructor. repeat constructor. Qed. @@ -1040,7 +1040,7 @@ Proof. destruct IHlist_forall2 as (vl2 & D & E). exists (vl1 ++ vl2); split. apply eval_exprlist_append; auto. - rewrite C; simpl. constructor; auto. + rewrite C; simpl. constructor; auto. Qed. Lemma transl_eval_builtin_arg: @@ -1055,18 +1055,18 @@ Proof. induction a; simpl; intros until v; intros LD EV; try (now (inv EV; econstructor; eauto with barg)). - destruct rl; simpl in LD; inv LD; inv EV; simpl. - econstructor; eauto with barg. + econstructor; eauto with barg. exists (rs#p); intuition auto. constructor. - destruct (convert_builtin_arg a1 vl) as [a1' vl1] eqn:CV1; simpl in *. destruct (convert_builtin_arg a2 vl1) as [a2' vl2] eqn:CV2; simpl in *. destruct (convert_builtin_arg a1 rl) as [a1'' rl1] eqn:CV3; simpl in *. destruct (convert_builtin_arg a2 rl1) as [a2'' rl2] eqn:CV4; simpl in *. - inv EV. - exploit IHa1; eauto. rewrite CV1; simpl; eauto. + inv EV. + exploit IHa1; eauto. rewrite CV1; simpl; eauto. rewrite CV1, CV3; simpl. intros (v1' & A1 & B1 & C1). exploit IHa2. eexact C1. rewrite CV2; simpl; eauto. rewrite CV2, CV4; simpl. intros (v2' & A2 & B2 & C2). - exists (Val.longofwords v1' v2'); split. constructor; auto. + exists (Val.longofwords v1' v2'); split. constructor; auto. split; auto. apply Val.longofwords_lessdef; auto. Qed. @@ -1081,8 +1081,8 @@ Proof. induction al; simpl; intros until vl; intros LD EV. - inv EV. exists (@nil val); split; constructor. - destruct (convert_builtin_arg a vl1) as [a1' vl2] eqn:CV1; simpl in *. - inv EV. - exploit transl_eval_builtin_arg. eauto. instantiate (2 := a). rewrite CV1; simpl; eauto. + inv EV. + exploit transl_eval_builtin_arg. eauto. instantiate (2 := a). rewrite CV1; simpl; eauto. rewrite CV1; simpl. intros (v1' & A1 & B1 & C1). exploit IHal. eexact C1. eauto. intros (vl' & A2 & B2). destruct (convert_builtin_arg a rl) as [a1'' rl2]; simpl in *. @@ -1145,10 +1145,10 @@ Lemma lt_state_wf: well_founded lt_state. Proof. unfold lt_state. apply wf_inverse_image with (f := measure_state). - apply wf_lex_ord. apply lt_wf. apply lt_wf. + apply wf_lex_ord. apply lt_wf. apply lt_wf. Qed. -(** ** Semantic preservation for the translation of statements *) +(** ** Semantic preservation for the translation of statements *) (** The simulation diagram for the translation of statements and functions is a "star" diagram of the form: @@ -1180,7 +1180,7 @@ Inductive tr_fun (tf: function) (map: mapping) (f: CminorSel.function) tf.(fn_stacksize) = f.(fn_stackspace) -> tr_fun tf map f ngoto nret rret. -Inductive tr_cont: RTL.code -> mapping -> +Inductive tr_cont: RTL.code -> mapping -> CminorSel.cont -> node -> list node -> labelmap -> node -> option reg -> list RTL.stackframe -> Prop := | tr_Kseq: forall c map s k nd nexits ngoto nret rret cs n, @@ -1269,7 +1269,7 @@ Proof. (* seq *) caseEq (find_label lbl s1 (Kseq s2 k)); intros. inv H1. inv H2. eapply IHs1; eauto. econstructor; eauto. - inv H2. eapply IHs2; eauto. + inv H2. eapply IHs2; eauto. (* ifthenelse *) caseEq (find_label lbl s1 k); intros. inv H1. inv H2. eapply IHs1; eauto. @@ -1308,22 +1308,22 @@ Proof. econstructor; eauto. constructor. (* skip return *) - inv TS. + inv TS. assert ((fn_code tf)!ncont = Some(Ireturn rret) /\ match_stacks k cs). - inv TK; simpl in H; try contradiction; auto. + inv TK; simpl in H; try contradiction; auto. destruct H1. assert (fn_stacksize tf = fn_stackspace f). - inv TF. auto. + inv TF. auto. edestruct Mem.free_parallel_extends as [tm' []]; eauto. econstructor; split. left; apply plus_one. eapply exec_Ireturn. eauto. rewrite H3. eauto. constructor; auto. - + (* assign *) inv TS. - exploit transl_expr_correct; eauto. + exploit transl_expr_correct; eauto. intros [rs' [tm' [A [B [C [D E]]]]]]. econstructor; split. right; split. eauto. Lt_state. @@ -1367,8 +1367,8 @@ Proof. exploit functions_translated; eauto. intros [tf' [P Q]]. econstructor; split. left; eapply plus_right. eexact E. - eapply exec_Icall; eauto. simpl. rewrite symbols_preserved. rewrite H4. - rewrite Genv.find_funct_find_funct_ptr in P. eauto. + eapply exec_Icall; eauto. simpl. rewrite symbols_preserved. rewrite H4. + rewrite Genv.find_funct_find_funct_ptr in P. eauto. apply sig_transl_function; auto. traceEq. constructor; auto. econstructor; eauto. @@ -1400,19 +1400,19 @@ Proof. edestruct Mem.free_parallel_extends as [tm''' []]; eauto. econstructor; split. left; eapply plus_right. eexact E. - eapply exec_Itailcall; eauto. simpl. rewrite symbols_preserved. rewrite H5. - rewrite Genv.find_funct_find_funct_ptr in P. eauto. + eapply exec_Itailcall; eauto. simpl. rewrite symbols_preserved. rewrite H5. + rewrite Genv.find_funct_find_funct_ptr in P. eauto. apply sig_transl_function; auto. rewrite H; eauto. traceEq. constructor; auto. (* builtin *) - inv TS. + inv TS. exploit invert_eval_builtin_args; eauto. intros (vparams & P & Q). exploit transl_exprlist_correct; eauto. intros [rs' [tm' [E [F [G [J K]]]]]]. - exploit transl_eval_builtin_args; eauto. + exploit transl_eval_builtin_args; eauto. intros (vargs' & U & V). exploit (@eval_builtin_args_lessdef _ ge (fun r => rs'#r) (fun r => rs'#r)); eauto. intros (vargs'' & X & Y). @@ -1421,31 +1421,31 @@ Proof. econstructor; split. left. eapply plus_right. eexact E. eapply exec_Ibuiltin. eauto. - eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. + eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. eapply external_call_symbols_preserved. eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. - traceEq. + traceEq. econstructor; eauto. constructor. eapply match_env_update_res; eauto. - + (* seq *) - inv TS. + inv TS. econstructor; split. right; split. apply star_refl. Lt_state. - econstructor; eauto. econstructor; eauto. + econstructor; eauto. econstructor; eauto. (* ifthenelse *) - inv TS. + inv TS. exploit transl_condexpr_correct; eauto. intros [rs' [tm' [A [B [C D]]]]]. econstructor; split. left. eexact A. - destruct b; econstructor; eauto. + destruct b; econstructor; eauto. (* loop *) inversion TS; subst. econstructor; split. - left. apply plus_one. eapply exec_Inop; eauto. - econstructor; eauto. + left. apply plus_one. eapply exec_Inop; eauto. + econstructor; eauto. econstructor; eauto. econstructor; eauto. @@ -1456,7 +1456,7 @@ Proof. econstructor; eauto. econstructor; eauto. (* exit seq *) - inv TS. inv TK. + inv TS. inv TK. econstructor; split. right; split. apply star_refl. Lt_state. econstructor; eauto. econstructor; eauto. @@ -1475,11 +1475,11 @@ Proof. (* switch *) inv TS. - exploit transl_exitexpr_correct; eauto. - intros (nd & rs' & tm' & A & B & C & D). + exploit transl_exitexpr_correct; eauto. + intros (nd & rs' & tm' & A & B & C & D). econstructor; split. - right; split. eexact A. Lt_state. - econstructor; eauto. constructor; auto. + right; split. eexact A. Lt_state. + econstructor; eauto. constructor; auto. (* return none *) inv TS. @@ -1511,11 +1511,11 @@ Proof. (* goto *) inv TS. inversion TF; subst. - exploit tr_find_label; eauto. eapply tr_cont_call_cont; eauto. + exploit tr_find_label; eauto. eapply tr_cont_call_cont; eauto. intros [ns2 [nd2 [nexits2 [A [B C]]]]]. econstructor; split. left; apply plus_one. eapply exec_Inop; eauto. - econstructor; eauto. + econstructor; eauto. (* internal call *) monadInv TF. exploit transl_function_charact; eauto. intro TRF. @@ -1536,19 +1536,19 @@ Proof. inversion MS; subst; econstructor; eauto. (* external call *) - monadInv TF. + monadInv TF. edestruct external_call_mem_extends as [tvres [tm' [A [B [C D]]]]]; eauto. econstructor; split. - left; apply plus_one. eapply exec_function_external; eauto. + left; apply plus_one. eapply exec_function_external; eauto. eapply external_call_symbols_preserved. eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. constructor; auto. (* return *) inv MS. - econstructor; split. - left; apply plus_one; constructor. - econstructor; eauto. constructor. + econstructor; split. + left; apply plus_one; constructor. + econstructor; eauto. constructor. eapply match_env_update_dest; eauto. Qed. @@ -1582,8 +1582,8 @@ Proof. eexact public_preserved. eexact transl_initial_states. eexact transl_final_states. - apply lt_state_wf. - exact transl_step_correct. + apply lt_state_wf. + exact transl_step_correct. Qed. End CORRECTNESS. diff --git a/backend/RTLgenspec.v b/backend/RTLgenspec.v index 1e665002..17022a7d 100644 --- a/backend/RTLgenspec.v +++ b/backend/RTLgenspec.v @@ -12,7 +12,7 @@ (** Abstract specification of RTL generation *) -(** In this module, we define inductive predicates that specify the +(** In this module, we define inductive predicates that specify the translations from Cminor to RTL performed by the functions in module [RTLgen]. We then show that these functions satisfy these relational specifications. The relational specifications will then be used @@ -43,7 +43,7 @@ Require Import RTLgen. *) Remark bind_inversion: - forall (A B: Type) (f: mon A) (g: A -> mon B) + forall (A B: Type) (f: mon A) (g: A -> mon B) (y: B) (s1 s3: state) (i: state_incr s1 s3), bind f g s1 = OK y s3 i -> exists x, exists s2, exists i1, exists i2, @@ -64,7 +64,7 @@ Remark bind2_inversion: f s1 = OK (x, y) s2 i1 /\ g x y s2 = OK z s3 i2. Proof. unfold bind2; intros. - exploit bind_inversion; eauto. + exploit bind_inversion; eauto. intros [[x y] [s2 [i1 [i2 [P Q]]]]]. simpl in Q. exists x; exists y; exists s2; exists i1; exists i2; auto. Qed. @@ -108,7 +108,7 @@ Ltac monadInv H := | (error _ _ = OK _ _ _) => monadInv1 H | (bind ?F ?G ?S = OK ?X ?S' ?I) => monadInv1 H | (bind2 ?F ?G ?S = OK ?X ?S' ?I) => monadInv1 H - | (?F _ _ _ _ _ _ _ _ = OK _ _ _) => + | (?F _ _ _ _ _ _ _ _ = OK _ _ _) => ((progress simpl in H) || unfold F in H); monadInv1 H | (?F _ _ _ _ _ _ _ = OK _ _ _) => ((progress simpl in H) || unfold F in H); monadInv1 H @@ -163,7 +163,7 @@ Ltac saturateTrans := earlier, that is, it is less than the next fresh register of the state. Otherwise, the pseudo-register is said to be fresh. *) -Definition reg_valid (r: reg) (s: state) : Prop := +Definition reg_valid (r: reg) (s: state) : Prop := Plt r s.(st_nextreg). Definition reg_fresh (r: reg) (s: state) : Prop := @@ -183,7 +183,7 @@ Proof. Qed. Hint Resolve valid_fresh_different: rtlg. -Lemma reg_valid_incr: +Lemma reg_valid_incr: forall r s1 s2, state_incr s1 s2 -> reg_valid r s1 -> reg_valid r s2. Proof. intros r s1 s2 INCR. @@ -198,7 +198,7 @@ Proof. intros r s1 s2 INCR. inversion INCR. unfold reg_fresh; unfold not; intros. apply H4. apply Plt_Ple_trans with (st_nextreg s1); auto. -Qed. +Qed. Hint Resolve reg_fresh_decr: rtlg. (** Validity of a list of registers. *) @@ -206,7 +206,7 @@ Hint Resolve reg_fresh_decr: rtlg. Definition regs_valid (rl: list reg) (s: state) : Prop := forall r, In r rl -> reg_valid r s. -Lemma regs_valid_nil: +Lemma regs_valid_nil: forall s, regs_valid nil s. Proof. intros; red; intros. elim H. @@ -224,7 +224,7 @@ Lemma regs_valid_app: forall rl1 rl2 s, regs_valid rl1 s -> regs_valid rl2 s -> regs_valid (rl1 ++ rl2) s. Proof. - intros; red; intros. apply in_app_iff in H1. destruct H1; auto. + intros; red; intros. apply in_app_iff in H1. destruct H1; auto. Qed. Lemma regs_valid_incr: @@ -273,7 +273,7 @@ Lemma update_instr_at: forall n i s1 s2 incr u, update_instr n i s1 = OK u s2 incr -> s2.(st_code)!n = Some i. Proof. - intros. unfold update_instr in H. + intros. unfold update_instr in H. destruct (plt n (st_nextnode s1)); try discriminate. destruct (check_empty_node s1 n); try discriminate. inv H. simpl. apply PTree.gss. @@ -306,7 +306,7 @@ Lemma new_reg_not_in_map: new_reg s1 = OK r s2 i -> map_valid m s1 -> ~(reg_in_map m r). Proof. unfold not; intros; eauto with rtlg. -Qed. +Qed. Hint Resolve new_reg_not_in_map: rtlg. (** * Properties of operations over compilation environments *) @@ -315,10 +315,10 @@ Lemma init_mapping_valid: forall s, map_valid init_mapping s. Proof. unfold map_valid, init_mapping. - intros s r [[id A] | B]. + intros s r [[id A] | B]. simpl in A. rewrite PTree.gempty in A; discriminate. simpl in B. tauto. -Qed. +Qed. (** Properties of [find_var]. *) @@ -363,17 +363,17 @@ Hint Resolve find_letvar_valid: rtlg. (** Properties of [add_var]. *) Lemma add_var_valid: - forall s1 s2 map1 map2 name r i, + forall s1 s2 map1 map2 name r i, add_var map1 name s1 = OK (r, map2) s2 i -> map_valid map1 s1 -> reg_valid r s2 /\ map_valid map2 s2. Proof. - intros. monadInv H. + intros. monadInv H. split. eauto with rtlg. inversion EQ. subst. red. intros r' [[id A] | B]. simpl in A. rewrite PTree.gsspec in A. destruct (peq id name). inv A. eauto with rtlg. - apply reg_valid_incr with s1. eauto with rtlg. + apply reg_valid_incr with s1. eauto with rtlg. apply H0. left; exists id; auto. simpl in B. apply reg_valid_incr with s1. eauto with rtlg. apply H0. right; auto. @@ -383,11 +383,11 @@ Lemma add_var_find: forall s1 s2 map name r map' i, add_var map name s1 = OK (r,map') s2 i -> map'.(map_vars)!name = Some r. Proof. - intros. monadInv H. simpl. apply PTree.gss. + intros. monadInv H. simpl. apply PTree.gss. Qed. Lemma add_vars_valid: - forall namel s1 s2 map1 map2 rl i, + forall namel s1 s2 map1 map2 rl i, add_vars map1 namel s1 = OK (rl, map2) s2 i -> map_valid map1 s1 -> regs_valid rl s2 /\ map_valid map2 s2. @@ -428,10 +428,10 @@ Lemma add_letvar_valid: reg_valid r s -> map_valid (add_letvar map r) s. Proof. - intros; red; intros. - destruct H1 as [[id A]|B]. + intros; red; intros. + destruct H1 as [[id A]|B]. simpl in A. apply H. left; exists id; auto. - simpl in B. elim B; intro. + simpl in B. elim B; intro. subst r0; auto. apply H. right; auto. Qed. @@ -467,7 +467,7 @@ Lemma alloc_regs_valid: Proof. induction al; simpl; intros; monadInv H0. apply regs_valid_nil. - apply regs_valid_cons. eauto with rtlg. eauto with rtlg. + apply regs_valid_cons. eauto with rtlg. eauto with rtlg. Qed. Hint Resolve alloc_regs_valid: rtlg. @@ -479,7 +479,7 @@ Lemma alloc_regs_fresh_or_in_map: Proof. induction al; simpl; intros; monadInv H0. elim H1. - elim H1; intro. + elim H1; intro. subst r. eapply alloc_reg_fresh_or_in_map; eauto. exploit IHal. 2: eauto. apply map_valid_incr with s; eauto with rtlg. eauto. @@ -502,7 +502,7 @@ Lemma alloc_optreg_fresh_or_in_map: alloc_optreg map dest s = OK r s' i -> reg_in_map map r \/ reg_fresh r s. Proof. - intros until s'. unfold alloc_optreg. destruct dest; intros. + intros until s'. unfold alloc_optreg. destruct dest; intros. left; eauto with rtlg. right; eauto with rtlg. Qed. @@ -546,8 +546,8 @@ Proof. induction 1; intros. constructor; auto. constructor; auto. - constructor; auto. red; intros. - elim (in_app_or _ _ _ H2); intro. + constructor; auto. red; intros. + elim (in_app_or _ _ _ H2); intro. generalize (H1 _ H3). tauto. tauto. Qed. @@ -559,7 +559,7 @@ Lemma target_reg_ok_cons: target_reg_ok map (r' :: pr) a r. Proof. intros. change (r' :: pr) with ((r' :: nil) ++ pr). - apply target_reg_ok_append; auto. + apply target_reg_ok_append; auto. intros r'' [A|B]. subst r''; auto. contradiction. Qed. @@ -570,7 +570,7 @@ Lemma new_reg_target_ok: new_reg s1 = OK r s2 i -> target_reg_ok map pr a r. Proof. - intros. constructor. + intros. constructor. red; intro. apply valid_fresh_absurd with r s1. eauto with rtlg. eauto with rtlg. red; intro. apply valid_fresh_absurd with r s1. @@ -604,13 +604,13 @@ Proof. induction al; intros; monadInv H1. constructor. constructor. - eapply alloc_reg_target_ok; eauto. - apply IHal with s s2 INCR1; eauto with rtlg. + eapply alloc_reg_target_ok; eauto. + apply IHal with s s2 INCR1; eauto with rtlg. apply regs_valid_cons; eauto with rtlg. Qed. -Hint Resolve new_reg_target_ok alloc_reg_target_ok - alloc_regs_target_ok: rtlg. +Hint Resolve new_reg_target_ok alloc_reg_target_ok + alloc_regs_target_ok: rtlg. (** The following predicate is a variant of [target_reg_ok] used to characterize registers that are adequate for holding the return @@ -640,7 +640,7 @@ Lemma new_reg_return_ok: return_reg_ok s2 map (ret_reg sig r). Proof. intros. unfold ret_reg. destruct (sig_res sig); constructor. - eauto with rtlg. eauto with rtlg. + eauto with rtlg. eauto with rtlg. Qed. (** * Relational specification of the translation *) @@ -693,7 +693,7 @@ Hint Resolve reg_map_ok_novar: rtlg. and moreover that they satisfy the [reg_map_ok] predicate. *) -Inductive tr_expr (c: code): +Inductive tr_expr (c: code): mapping -> list reg -> expr -> node -> node -> reg -> option ident -> Prop := | tr_Evar: forall map pr id ns nd r rd dst, map.(map_vars)!id = Some r -> @@ -742,7 +742,7 @@ Inductive tr_expr (c: code): value of the CminorSel conditional expression [a] and terminate on node [ntrue] if the condition holds and on node [nfalse] otherwise. *) -with tr_condition (c: code): +with tr_condition (c: code): mapping -> list reg -> condexpr -> node -> node -> node -> Prop := | tr_CEcond: forall map pr cond bl ns ntrue nfalse n1 rl, tr_exprlist c map pr bl ns n1 rl -> @@ -764,7 +764,7 @@ with tr_condition (c: code): of the list of CminorSel expression [exprlist] and deposit these values in registers [rds]. *) -with tr_exprlist (c: code): +with tr_exprlist (c: code): mapping -> list reg -> exprlist -> node -> node -> list reg -> Prop := | tr_Enil: forall map pr n, tr_exprlist c map pr Enil n n nil @@ -786,7 +786,7 @@ Definition tr_jumptable (nexits: list node) (tbl: list nat) (ttbl: list node) : on the node corresponding to this exit number according to the mapping [nexits]. *) -Inductive tr_exitexpr (c: code): +Inductive tr_exitexpr (c: code): mapping -> exitexpr -> node -> list node -> Prop := | tr_XEcond: forall map x n nexits, nth_error nexits x = Some n -> @@ -903,7 +903,7 @@ Inductive tr_stmt (c: code) (map: mapping): ngoto!lbl = Some ns -> tr_stmt c map (Sgoto lbl) ns nd nexits ngoto nret rret. -(** [tr_function f tf] specifies the RTL function [tf] that +(** [tr_function f tf] specifies the RTL function [tf] that [RTLgen.transl_function] returns. *) Inductive tr_function: CminorSel.function -> RTL.function -> Prop := @@ -913,7 +913,7 @@ Inductive tr_function: CminorSel.function -> RTL.function -> Prop := add_vars map1 f.(CminorSel.fn_vars) s1 = OK (rvars, map2) s2 i2 -> orret = ret_reg f.(CminorSel.fn_sig) rret -> tr_stmt code map2 f.(CminorSel.fn_body) nentry nret nil ngoto nret orret -> - code!nret = Some(Ireturn orret) -> + code!nret = Some(Ireturn orret) -> tr_function f (RTL.mkfunction f.(CminorSel.fn_sig) rparams @@ -951,22 +951,22 @@ with tr_exprlist_incr: tr_exprlist s1.(st_code) map pr al ns nd rl -> tr_exprlist s2.(st_code) map pr al ns nd rl. Proof. - intros s1 s2 EXT. + intros s1 s2 EXT. pose (AT := fun pc i => instr_at_incr s1 s2 pc i EXT). induction 1; econstructor; eauto. eapply tr_move_incr; eauto. eapply tr_move_incr; eauto. - intros s1 s2 EXT. + intros s1 s2 EXT. pose (AT := fun pc i => instr_at_incr s1 s2 pc i EXT). induction 1; econstructor; eauto. - intros s1 s2 EXT. + intros s1 s2 EXT. pose (AT := fun pc i => instr_at_incr s1 s2 pc i EXT). induction 1; econstructor; eauto. Qed. Lemma add_move_charact: forall s ns rs nd rd s' i, - add_move rs rd nd s = OK ns s' i -> + add_move rs rd nd s = OK ns s' i -> tr_move s'.(st_code) ns rs nd rd. Proof. intros. unfold add_move in H. destruct (Reg.eq rs rd). @@ -1013,23 +1013,23 @@ Proof. (* Eload *) inv OK. econstructor; eauto with rtlg. - eapply transl_exprlist_charact; eauto with rtlg. + eapply transl_exprlist_charact; eauto with rtlg. (* Econdition *) inv OK. econstructor. eauto with rtlg. - apply tr_expr_incr with s1; auto. + apply tr_expr_incr with s1; auto. eapply transl_expr_charact; eauto 2 with rtlg. constructor; auto. - apply tr_expr_incr with s0; auto. + apply tr_expr_incr with s0; auto. eapply transl_expr_charact; eauto 2 with rtlg. constructor; auto. (* Elet *) inv OK. - econstructor. eapply new_reg_not_in_map; eauto with rtlg. + econstructor. eapply new_reg_not_in_map; eauto with rtlg. eapply transl_expr_charact; eauto 3 with rtlg. apply tr_expr_incr with s1; auto. - eapply transl_expr_charact. eauto. - apply add_letvar_valid; eauto with rtlg. - constructor; auto. + eapply transl_expr_charact. eauto. + apply add_letvar_valid; eauto with rtlg. + constructor; auto. red; unfold reg_in_map. simpl. intros [[id A] | [B | C]]. elim H. left; exists id; auto. subst x. apply valid_fresh_absurd with rd s. auto. eauto with rtlg. @@ -1038,7 +1038,7 @@ Proof. (* Eletvar *) generalize EQ; unfold find_letvar. caseEq (nth_error (map_letvars map) n); intros; inv EQ0. monadInv EQ1. - econstructor; eauto with rtlg. + econstructor; eauto with rtlg. inv OK. left; split; congruence. right; eauto with rtlg. eapply add_move_charact; eauto. monadInv EQ1. @@ -1064,7 +1064,7 @@ Proof. generalize (VALID2 r (in_eq _ _)). eauto with rtlg. apply tr_exprlist_incr with s0; auto. eapply transl_exprlist_charact; eauto with rtlg. - apply regs_valid_cons. apply VALID2. auto with coqlib. auto. + apply regs_valid_cons. apply VALID2. auto with coqlib. auto. red; intros; apply VALID2; auto with coqlib. (* Conditional expressions *) @@ -1073,15 +1073,15 @@ Proof. (* CEcond *) econstructor; eauto with rtlg. eapply transl_exprlist_charact; eauto with rtlg. (* CEcondition *) - econstructor; eauto with rtlg. + econstructor; eauto with rtlg. apply tr_condition_incr with s1; eauto with rtlg. apply tr_condition_incr with s0; eauto with rtlg. (* CElet *) econstructor; eauto with rtlg. - eapply transl_expr_charact; eauto with rtlg. + eapply transl_expr_charact; eauto with rtlg. apply tr_condition_incr with s1; eauto with rtlg. eapply transl_condexpr_charact; eauto with rtlg. - apply add_letvar_valid; eauto with rtlg. + apply add_letvar_valid; eauto with rtlg. Qed. (** A variant of [transl_expr_charact], for use when the destination @@ -1100,20 +1100,20 @@ Proof. econstructor; eauto. eapply add_move_charact; eauto. (* Eop *) - econstructor; eauto with rtlg. + econstructor; eauto with rtlg. eapply transl_exprlist_charact; eauto with rtlg. (* Eload *) econstructor; eauto with rtlg. - eapply transl_exprlist_charact; eauto with rtlg. + eapply transl_exprlist_charact; eauto with rtlg. (* Econdition *) econstructor; eauto with rtlg. eapply transl_condexpr_charact; eauto with rtlg. - apply tr_expr_incr with s1; auto. - eapply IHa1; eauto 2 with rtlg. - apply tr_expr_incr with s0; auto. + apply tr_expr_incr with s1; auto. + eapply IHa1; eauto 2 with rtlg. + apply tr_expr_incr with s0; auto. eapply IHa2; eauto 2 with rtlg. (* Elet *) - econstructor. eapply new_reg_not_in_map; eauto with rtlg. + econstructor. eapply new_reg_not_in_map; eauto with rtlg. eapply transl_expr_charact; eauto 3 with rtlg. apply tr_expr_incr with s1; auto. eapply IHa2; eauto. @@ -1122,14 +1122,14 @@ Proof. (* Eletvar *) generalize EQ; unfold find_letvar. caseEq (nth_error (map_letvars map) n); intros; inv EQ0. monadInv EQ1. - econstructor; eauto with rtlg. + econstructor; eauto with rtlg. eapply add_move_charact; eauto. monadInv EQ1. (* Ebuiltin *) - econstructor; eauto with rtlg. + econstructor; eauto with rtlg. eapply transl_exprlist_charact; eauto with rtlg. (* Eexternal *) - econstructor; eauto with rtlg. + econstructor; eauto with rtlg. eapply transl_exprlist_charact; eauto with rtlg. Qed. @@ -1172,7 +1172,7 @@ Lemma transl_exit_charact: transl_exit nexits n s = OK ne s' incr -> nth_error nexits n = Some ne /\ s' = s. Proof. - intros until incr. unfold transl_exit. + intros until incr. unfold transl_exit. destruct (nth_error nexits n); intro; monadInv H. auto. Qed. @@ -1183,7 +1183,7 @@ Lemma transl_jumptable_charact: Proof. induction tbl; intros. monadInv H. split. red. simpl. intros. discriminate. auto. - monadInv H. exploit transl_exit_charact; eauto. intros [A B]. + monadInv H. exploit transl_exit_charact; eauto. intros [A B]. exploit IHtbl; eauto. intros [C D]. split. red. simpl. intros. destruct (zeq v 0). inv H. exists x; auto. auto. congruence. @@ -1198,16 +1198,16 @@ Proof. induction a; simpl; intros; try (monadInv TR); saturateTrans. - (* XEexit *) exploit transl_exit_charact; eauto. intros [A B]. - econstructor; eauto. + econstructor; eauto. - (* XEjumptable *) exploit transl_jumptable_charact; eauto. intros [A B]. - econstructor; eauto. - eapply transl_expr_charact; eauto with rtlg. + econstructor; eauto. + eapply transl_expr_charact; eauto with rtlg. eauto with rtlg. - (* XEcondition *) - econstructor. + econstructor. eapply transl_condexpr_charact; eauto with rtlg. - apply tr_exitexpr_incr with s1; eauto with rtlg. + apply tr_exitexpr_incr with s1; eauto with rtlg. apply tr_exitexpr_incr with s0; eauto with rtlg. - (* XElet *) econstructor; eauto with rtlg. @@ -1225,7 +1225,7 @@ Proof. destruct res; simpl; intros. - monadInv TR. constructor. unfold find_var in EQ. destruct (map_vars map)!x; inv EQ; auto. - destruct oty; monadInv TR. -+ constructor. eauto with rtlg. ++ constructor. eauto with rtlg. + constructor. - monadInv TR. Qed. @@ -1255,7 +1255,7 @@ Proof. (* indirect *) econstructor; eauto 4 with rtlg. eapply transl_expr_charact; eauto 3 with rtlg. - apply tr_exprlist_incr with s5. auto. + apply tr_exprlist_incr with s5. auto. eapply transl_exprlist_charact; eauto 3 with rtlg. eapply alloc_regs_target_ok with (s1 := s0); eauto 3 with rtlg. apply regs_valid_cons; eauto 3 with rtlg. @@ -1271,7 +1271,7 @@ Proof. destruct s0 as [b | id]; monadInv TR; saturateTrans. (* indirect *) assert (RV: regs_valid (x :: nil) s0). - apply regs_valid_cons; eauto 3 with rtlg. + apply regs_valid_cons; eauto 3 with rtlg. econstructor; eauto 3 with rtlg. eapply transl_expr_charact; eauto 3 with rtlg. apply tr_exprlist_incr with s4; auto. @@ -1284,47 +1284,47 @@ Proof. eapply transl_exprlist_charact; eauto 3 with rtlg. eapply convert_builtin_res_charact; eauto with rtlg. (* Sseq *) - econstructor. - apply tr_stmt_incr with s0; auto. + econstructor. + apply tr_stmt_incr with s0; auto. eapply IHstmt2; eauto with rtlg. eapply IHstmt1; eauto with rtlg. (* Sifthenelse *) destruct (more_likely c stmt1 stmt2); monadInv TR. econstructor. - apply tr_stmt_incr with s1; auto. + apply tr_stmt_incr with s1; auto. eapply IHstmt1; eauto with rtlg. apply tr_stmt_incr with s0; auto. eapply IHstmt2; eauto with rtlg. eapply transl_condexpr_charact; eauto with rtlg. econstructor. - apply tr_stmt_incr with s0; auto. + apply tr_stmt_incr with s0; auto. eapply IHstmt1; eauto with rtlg. apply tr_stmt_incr with s1; auto. eapply IHstmt2; eauto with rtlg. eapply transl_condexpr_charact; eauto with rtlg. (* Sloop *) - econstructor. - apply tr_stmt_incr with s1; auto. + econstructor. + apply tr_stmt_incr with s1; auto. eapply IHstmt; eauto with rtlg. - eauto with rtlg. eauto with rtlg. + eauto with rtlg. eauto with rtlg. (* Sblock *) - econstructor. + econstructor. eapply IHstmt; eauto with rtlg. (* Sexit *) exploit transl_exit_charact; eauto. intros [A B]. econstructor. eauto. (* Sswitch *) - econstructor. eapply transl_exitexpr_charact; eauto. + econstructor. eapply transl_exitexpr_charact; eauto. (* Sreturn *) - destruct o. - destruct rret; inv TR. inv OK. - econstructor; eauto with rtlg. + destruct o. + destruct rret; inv TR. inv OK. + econstructor; eauto with rtlg. eapply transl_expr_charact; eauto with rtlg. - constructor. auto. simpl; tauto. + constructor. auto. simpl; tauto. monadInv TR. constructor. (* Slabel *) generalize EQ0; clear EQ0. case_eq (ngoto!l); intros; monadInv EQ0. - generalize EQ1; clear EQ1. unfold handle_error. + generalize EQ1; clear EQ1. unfold handle_error. case_eq (update_instr n (Inop ns) s0); intros; inv EQ1. econstructor. eauto. eauto with rtlg. eapply tr_stmt_incr with s0; eauto with rtlg. @@ -1339,17 +1339,17 @@ Lemma transl_function_charact: tr_function f tf. Proof. intros until tf. unfold transl_function. - caseEq (reserve_labels (fn_body f) (PTree.empty node, init_state)). + caseEq (reserve_labels (fn_body f) (PTree.empty node, init_state)). intros ngoto s0 RESERVE. - caseEq (transl_fun f ngoto s0). congruence. - intros [nentry rparams] sfinal INCR TR E. inv E. + caseEq (transl_fun f ngoto s0). congruence. + intros [nentry rparams] sfinal INCR TR E. inv E. monadInv TR. exploit add_vars_valid. eexact EQ. apply init_mapping_valid. - intros [A B]. - exploit add_vars_valid. eexact EQ1. auto. + intros [A B]. + exploit add_vars_valid. eexact EQ1. auto. intros [C D]. eapply tr_function_intro; eauto with rtlg. - eapply transl_stmt_charact; eauto with rtlg. + eapply transl_stmt_charact; eauto with rtlg. unfold ret_reg. destruct (sig_res (CminorSel.fn_sig f)). constructor. eauto with rtlg. eauto with rtlg. constructor. diff --git a/backend/RTLtyping.v b/backend/RTLtyping.v index effb0c7d..57fc8b86 100644 --- a/backend/RTLtyping.v +++ b/backend/RTLtyping.v @@ -172,7 +172,7 @@ Record wt_function (f: function) (env: regenv): Prop := wt_norepet: list_norepet f.(fn_params); wt_instrs: - forall pc instr, + forall pc instr, f.(fn_code)!pc = Some instr -> wt_instr f env instr; wt_entrypoint: valid_successor f f.(fn_entrypoint) @@ -304,7 +304,7 @@ Definition type_instr (e: S.typenv) (i: instruction) : res S.typenv := | Ibuiltin ef args res s => let sig := ef_sig ef in do x <- check_successor s; - do e1 <- + do e1 <- match ef with | EF_annot _ _ | EF_debug _ _ _ => OK e | _ => type_builtin_args e args sig.(sig_args) @@ -342,7 +342,7 @@ Definition type_code (e: S.typenv): res S.typenv := (** Solve remaining constraints *) -Definition check_params_norepet (params: list reg): res unit := +Definition check_params_norepet (params: list reg): res unit := if list_norepet_dec Reg.eq params then OK tt else Error(msg "duplicate parameters"). @@ -369,7 +369,7 @@ Lemma type_ros_sound: forall e ros e' te, type_ros e ros = OK e' -> S.satisf te e' -> match ros with inl r => te r = Tint | inr s => True end. Proof. - unfold type_ros; intros. destruct ros. + unfold type_ros; intros. destruct ros. eapply S.set_sound; eauto. auto. Qed. @@ -377,7 +377,7 @@ Qed. Lemma check_successor_sound: forall s x, check_successor s = OK x -> valid_successor f s. Proof. - unfold check_successor, valid_successor; intros. + unfold check_successor, valid_successor; intros. destruct (fn_code f)!s; inv H. exists i; auto. Qed. @@ -386,9 +386,9 @@ Hint Resolve check_successor_sound: ty. Lemma check_successors_sound: forall sl x, check_successors sl = OK x -> forall s, In s sl -> valid_successor f s. Proof. - induction sl; simpl; intros. + induction sl; simpl; intros. contradiction. - monadInv H. destruct H0. subst a; eauto with ty. eauto. + monadInv H. destruct H0. subst a; eauto with ty. eauto. Qed. Remark type_expect_incr: @@ -416,7 +416,7 @@ Lemma type_builtin_args_incr: Proof. induction a; destruct ty; simpl; intros; try discriminate. inv H; auto. - monadInv H. eapply type_builtin_arg_incr; eauto. + monadInv H. eapply type_builtin_arg_incr; eauto. Qed. Lemma type_builtin_res_incr: @@ -450,7 +450,7 @@ Lemma type_builtin_res_sound: forall e a ty e' te, type_builtin_res e a ty = OK e' -> S.satisf te e' -> type_of_builtin_res te a = ty. Proof. - intros. destruct a; simpl in *. + intros. destruct a; simpl in *. eapply S.set_sound; eauto. symmetry; eapply type_expect_sound; eauto. symmetry; eapply type_expect_sound; eauto. @@ -495,7 +495,7 @@ Proof. destruct l; try discriminate. destruct l; monadInv EQ0. constructor. eapply S.move_sound; eauto. eauto with ty. + destruct (type_of_operation o) as [targs tres] eqn:TYOP. monadInv EQ0. - apply wt_Iop. + apply wt_Iop. unfold is_move in ISMOVE; destruct o; congruence. rewrite TYOP. eapply S.set_list_sound; eauto with ty. rewrite TYOP. eapply S.set_sound; eauto with ty. @@ -511,7 +511,7 @@ Proof. eapply S.set_sound; eauto with ty. eauto with ty. - (* call *) - constructor. + constructor. eapply type_ros_sound; eauto with ty. eapply S.set_list_sound; eauto with ty. eapply S.set_sound; eauto with ty. @@ -520,7 +520,7 @@ Proof. destruct (opt_typ_eq (sig_res s) (sig_res (fn_sig f))); try discriminate. destruct (tailcall_is_possible s) eqn:TCIP; inv EQ2. constructor. - eapply type_ros_sound; eauto with ty. + eapply type_ros_sound; eauto with ty. eapply S.set_list_sound; eauto with ty. auto. apply tailcall_is_possible_correct; auto. @@ -538,12 +538,12 @@ Proof. destruct (zle (list_length_z l * 4) Int.max_unsigned); inv EQ2. constructor. eapply S.set_sound; eauto. - eapply check_successors_sound; eauto. + eapply check_successors_sound; eauto. auto. - (* return *) simpl in H. destruct o as [r|] eqn: RET; destruct (sig_res (fn_sig f)) as [t|] eqn: RES; try discriminate. econstructor. eauto. eapply S.set_sound; eauto with ty. - inv H. constructor. auto. + inv H. constructor. auto. Qed. Lemma type_code_sound: @@ -558,16 +558,16 @@ Proof. | OK e' => c!pc = Some i -> S.satisf te e' -> wt_instr f te i end). change (P f.(fn_code) (OK e1)). - rewrite <- TCODE. unfold type_code. apply PTree_Properties.fold_rec; unfold P; intros. + rewrite <- TCODE. unfold type_code. apply PTree_Properties.fold_rec; unfold P; intros. - (* extensionality *) - destruct a; auto; intros. rewrite <- H in H1. eapply H0; eauto. + destruct a; auto; intros. rewrite <- H in H1. eapply H0; eauto. - (* base case *) rewrite PTree.gempty in H; discriminate. - (* inductive case *) - destruct a as [e|?]; auto. + destruct a as [e|?]; auto. destruct (type_instr e v) as [e'|?] eqn:TYINSTR; auto. - intros. rewrite PTree.gsspec in H2. destruct (peq pc k). - inv H2. eapply type_instr_sound; eauto. + intros. rewrite PTree.gsspec in H2. destruct (peq pc k). + inv H2. eapply type_instr_sound; eauto. eapply H1; eauto. eapply type_instr_incr; eauto. Qed. @@ -581,12 +581,12 @@ Proof. - (* type of parameters *) eapply S.set_list_sound; eauto. - (* parameters are unique *) - unfold check_params_norepet in EQ2. - destruct (list_norepet_dec Reg.eq (fn_params f)); inv EQ2; auto. + unfold check_params_norepet in EQ2. + destruct (list_norepet_dec Reg.eq (fn_params f)); inv EQ2; auto. - (* instructions are well typed *) - intros. eapply type_code_sound; eauto. + intros. eapply type_code_sound; eauto. - (* entry point is valid *) - eauto with ty. + eauto with ty. Qed. (** ** Completeness proof *) @@ -597,7 +597,7 @@ Lemma type_ros_complete: match ros with inl r => te r = Tint | inr s => True end -> exists e', type_ros e ros = OK e' /\ S.satisf te e'. Proof. - intros; destruct ros; simpl. + intros; destruct ros; simpl. eapply S.set_complete; eauto. exists e; auto. Qed. @@ -605,14 +605,14 @@ Qed. Lemma check_successor_complete: forall s, valid_successor f s -> check_successor s = OK tt. Proof. - unfold valid_successor, check_successor; intros. + unfold valid_successor, check_successor; intros. destruct H as [i EQ]; rewrite EQ; auto. Qed. Lemma type_expect_complete: forall e ty, type_expect e ty ty = OK e. Proof. - unfold type_expect; intros. rewrite dec_eq_true; auto. + unfold type_expect; intros. rewrite dec_eq_true; auto. Qed. Lemma type_builtin_arg_complete: @@ -620,7 +620,7 @@ Lemma type_builtin_arg_complete: S.satisf te e -> exists e', type_builtin_arg e a (type_of_builtin_arg te a) = OK e' /\ S.satisf te e'. Proof. - intros. destruct a; simpl; try (exists e; split; [apply type_expect_complete|assumption]). + intros. destruct a; simpl; try (exists e; split; [apply type_expect_complete|assumption]). apply S.set_complete; auto. Qed. @@ -629,11 +629,11 @@ Lemma type_builtin_args_complete: S.satisf te e -> exists e', type_builtin_args e al (List.map (type_of_builtin_arg te) al) = OK e' /\ S.satisf te e'. Proof. - induction al; simpl; intros. + induction al; simpl; intros. - exists e; auto. -- destruct (type_builtin_arg_complete te a e) as (e1 & A & B); auto. +- destruct (type_builtin_arg_complete te a e) as (e1 & A & B); auto. destruct (IHal e1) as (e2 & C & D); auto. - exists e2; split; auto. rewrite A. auto. + exists e2; split; auto. rewrite A. auto. Qed. Lemma type_builtin_res_complete: @@ -641,7 +641,7 @@ Lemma type_builtin_res_complete: S.satisf te e -> exists e', type_builtin_res e a (type_of_builtin_res te a) = OK e' /\ S.satisf te e'. Proof. - intros. destruct a; simpl. + intros. destruct a; simpl. apply S.set_complete; auto. exists e; auto. exists e; auto. @@ -664,60 +664,60 @@ Proof. exploit S.set_list_complete. eauto. eauto. intros [e1 [A B]]. exploit S.set_complete. eexact B. eauto. intros [e2 [C D]]. exists e2; split; auto. - rewrite check_successor_complete by auto; simpl. + rewrite check_successor_complete by auto; simpl. replace (is_move op) with false. rewrite A; simpl; rewrite C; auto. destruct op; reflexivity || congruence. - (* load *) exploit S.set_list_complete. eauto. eauto. intros [e1 [A B]]. exploit S.set_complete. eexact B. eauto. intros [e2 [C D]]. exists e2; split; auto. - rewrite check_successor_complete by auto; simpl. + rewrite check_successor_complete by auto; simpl. rewrite A; simpl; rewrite C; auto. - (* store *) exploit S.set_list_complete. eauto. eauto. intros [e1 [A B]]. exploit S.set_complete. eexact B. eauto. intros [e2 [C D]]. exists e2; split; auto. - rewrite check_successor_complete by auto; simpl. + rewrite check_successor_complete by auto; simpl. rewrite A; simpl; rewrite C; auto. - (* call *) exploit type_ros_complete. eauto. eauto. intros [e1 [A B]]. exploit S.set_list_complete. eauto. eauto. intros [e2 [C D]]. exploit S.set_complete. eexact D. eauto. intros [e3 [E F]]. - exists e3; split; auto. - rewrite check_successor_complete by auto; simpl. + exists e3; split; auto. + rewrite check_successor_complete by auto; simpl. rewrite A; simpl; rewrite C; simpl; rewrite E; auto. - (* tailcall *) exploit type_ros_complete. eauto. eauto. intros [e1 [A B]]. exploit S.set_list_complete. eauto. eauto. intros [e2 [C D]]. - exists e2; split; auto. - rewrite A; simpl; rewrite C; simpl. - rewrite H2; rewrite dec_eq_true. - replace (tailcall_is_possible sig) with true; auto. - revert H3. unfold tailcall_possible, tailcall_is_possible. generalize (loc_arguments sig). + exists e2; split; auto. + rewrite A; simpl; rewrite C; simpl. + rewrite H2; rewrite dec_eq_true. + replace (tailcall_is_possible sig) with true; auto. + revert H3. unfold tailcall_possible, tailcall_is_possible. generalize (loc_arguments sig). induction l; simpl; intros. auto. exploit (H3 a); auto. intros. destruct a; try contradiction. apply IHl. - intros; apply H3; auto. + intros; apply H3; auto. - (* builtin *) exploit type_builtin_args_complete; eauto. instantiate (1 := args). intros [e1 [A B]]. exploit type_builtin_res_complete; eauto. instantiate (1 := res). intros [e2 [C D]]. exploit type_builtin_res_complete. eexact H. instantiate (1 := res). intros [e3 [E F]]. rewrite check_successor_complete by auto. simpl. exists (match ef with EF_annot _ _ | EF_debug _ _ _ => e3 | _ => e2 end); split. - rewrite H1 in C, E. + rewrite H1 in C, E. destruct ef; try (rewrite <- H0; rewrite A); simpl; auto. destruct ef; auto. - (* cond *) exploit S.set_list_complete. eauto. eauto. intros [e1 [A B]]. exists e1; split; auto. - rewrite check_successor_complete by auto; simpl. + rewrite check_successor_complete by auto; simpl. rewrite check_successor_complete by auto; simpl. auto. - (* jumptbl *) exploit S.set_complete. eauto. eauto. intros [e1 [A B]]. exists e1; split; auto. - replace (check_successors tbl) with (OK tt). simpl. - rewrite A; simpl. apply zle_true; auto. - revert H1. generalize tbl. induction tbl0; simpl; intros. auto. + replace (check_successors tbl) with (OK tt). simpl. + rewrite A; simpl. apply zle_true; auto. + revert H1. generalize tbl. induction tbl0; simpl; intros. auto. rewrite check_successor_complete by auto; simpl. apply IHtbl0; intros; auto. - (* return none *) @@ -739,14 +739,14 @@ Proof. assert (P f.(fn_code) (type_code e0)). { unfold type_code. apply PTree_Properties.fold_rec; unfold P; intros. - - apply H0. intros. apply H1 with pc. rewrite <- H; auto. - - exists e0; auto. - - destruct H1 as [e [A B]]. + - apply H0. intros. apply H1 with pc. rewrite <- H; auto. + - exists e0; auto. + - destruct H1 as [e [A B]]. intros. apply H2 with pc. rewrite PTree.gso; auto. congruence. - subst a. + subst a. destruct (type_instr_complete te e v) as [e' [C D]]. - auto. apply H2 with k. apply PTree.gss. - exists e'; split; auto. rewrite C; auto. + auto. apply H2 with k. apply PTree.gss. + exists e'; split; auto. rewrite C; auto. } apply H; auto. Qed. @@ -754,15 +754,15 @@ Qed. Theorem type_function_complete: forall te, wt_function f te -> exists te, type_function = OK te. Proof. - intros. destruct H. + intros. destruct H. destruct (type_code_complete te S.initial) as (e1 & A & B). - auto. apply S.satisf_initial. + auto. apply S.satisf_initial. destruct (S.set_list_complete te f.(fn_params) f.(fn_sig).(sig_args) e1) as (e2 & C & D); auto. destruct (S.solve_complete te e2) as (te' & E); auto. exists te'; unfold type_function. - rewrite A; simpl. rewrite C; simpl. rewrite E; simpl. - unfold check_params_norepet. rewrite pred_dec_true; auto. simpl. - rewrite check_successor_complete by auto. auto. + rewrite A; simpl. rewrite C; simpl. rewrite E; simpl. + unfold check_params_norepet. rewrite pred_dec_true; auto. simpl. + rewrite check_successor_complete by auto. auto. Qed. End INFERENCE. @@ -790,7 +790,7 @@ Lemma wt_regset_assign: Val.has_type v (env r) -> wt_regset env (rs#r <- v). Proof. - intros; red; intros. + intros; red; intros. rewrite Regmap.gsspec. case (peq r0 r); intro. subst r0. assumption. @@ -805,7 +805,7 @@ Proof. induction rl; simpl. auto. split. apply H. apply IHrl. -Qed. +Qed. Lemma wt_regset_setres: forall env rs v res, @@ -813,8 +813,8 @@ Lemma wt_regset_setres: Val.has_type v (type_of_builtin_res env res) -> wt_regset env (regmap_setres res v rs). Proof. - intros. destruct res; simpl in *; auto. apply wt_regset_assign; auto. -Qed. + intros. destruct res; simpl in *; auto. apply wt_regset_assign; auto. +Qed. Lemma wt_init_regs: forall env rl args, @@ -822,7 +822,7 @@ Lemma wt_init_regs: wt_regset env (init_regs args rl). Proof. induction rl; destruct args; simpl; intuition. - red; intros. rewrite Regmap.gi. simpl; auto. + red; intros. rewrite Regmap.gi. simpl; auto. apply wt_regset_assign; auto. Qed. @@ -833,7 +833,7 @@ Lemma wt_exec_Iop: wt_regset env rs -> wt_regset env (rs#res <- v). Proof. - intros. inv H. + intros. inv H. simpl in H0. inv H0. apply wt_regset_assign; auto. rewrite H4; auto. eapply wt_regset_assign; auto. @@ -858,7 +858,7 @@ Lemma wt_exec_Ibuiltin: wt_regset env rs -> wt_regset env (regmap_setres res vres rs). Proof. - intros. inv H. + intros. inv H. eapply wt_regset_setres; eauto. rewrite H7. eapply external_call_well_typed; eauto. Qed. @@ -867,7 +867,7 @@ Lemma wt_instr_at: forall f env pc i, wt_function f env -> f.(fn_code)!pc = Some i -> wt_instr f env i. Proof. - intros. inv H. eauto. + intros. inv H. eauto. Qed. Inductive wt_stackframes: list stackframe -> signature -> Prop := @@ -905,9 +905,9 @@ Remark wt_stackframes_change_sig: forall s sg1 sg2, sg1.(sig_res) = sg2.(sig_res) -> wt_stackframes s sg1 -> wt_stackframes s sg2. Proof. - intros. inv H0. + intros. inv H0. - constructor; congruence. -- econstructor; eauto. rewrite H3. unfold proj_sig_res. rewrite H. auto. +- econstructor; eauto. rewrite H3. unfold proj_sig_res. rewrite H. auto. Qed. Section SUBJECT_REDUCTION. @@ -936,19 +936,19 @@ Proof. assert (wt_fundef fd). destruct ros; simpl in H0. pattern fd. apply Genv.find_funct_prop with fundef unit p (rs#r). - exact wt_p. exact H0. + exact wt_p. exact H0. caseEq (Genv.find_symbol ge i); intros; rewrite H1 in H0. pattern fd. apply Genv.find_funct_ptr_prop with fundef unit p b. exact wt_p. exact H0. discriminate. econstructor; eauto. - econstructor; eauto. inv WTI; auto. + econstructor; eauto. inv WTI; auto. inv WTI. rewrite <- H8. apply wt_regset_list. auto. (* Itailcall *) assert (wt_fundef fd). destruct ros; simpl in H0. pattern fd. apply Genv.find_funct_prop with fundef unit p (rs#r). - exact wt_p. exact H0. + exact wt_p. exact H0. caseEq (Genv.find_symbol ge i); intros; rewrite H1 in H0. pattern fd. apply Genv.find_funct_ptr_prop with fundef unit p b. exact wt_p. exact H0. @@ -963,24 +963,24 @@ Proof. (* Ijumptable *) econstructor; eauto. (* Ireturn *) - econstructor; eauto. - inv WTI; simpl. auto. unfold proj_sig_res; rewrite H2. auto. + econstructor; eauto. + inv WTI; simpl. auto. unfold proj_sig_res; rewrite H2. auto. (* internal function *) simpl in *. inv H5. econstructor; eauto. - inv H1. apply wt_init_regs; auto. rewrite wt_params0. auto. + inv H1. apply wt_init_regs; auto. rewrite wt_params0. auto. (* external function *) - econstructor; eauto. simpl. + econstructor; eauto. simpl. eapply external_call_well_typed; eauto. (* return *) inv H1. econstructor; eauto. - apply wt_regset_assign; auto. rewrite H10; auto. + apply wt_regset_assign; auto. rewrite H10; auto. Qed. Lemma wt_initial_state: forall S, initial_state p S -> wt_state S. Proof. - intros. inv H. constructor. constructor. rewrite H3; auto. + intros. inv H. constructor. constructor. rewrite H3; auto. pattern f. apply Genv.find_funct_ptr_prop with fundef unit p b. exact wt_p. exact H2. rewrite H3. constructor. @@ -992,10 +992,10 @@ Lemma wt_instr_inv: f.(fn_code)!pc = Some i -> exists env, wt_instr f env i /\ wt_regset env rs. Proof. - intros. inv H. exists env; split; auto. - inv WT_FN. eauto. + intros. inv H. exists env; split; auto. + inv WT_FN. eauto. Qed. End SUBJECT_REDUCTION. - + diff --git a/backend/Regalloc.ml b/backend/Regalloc.ml index 76288fb5..a5fa8cd7 100644 --- a/backend/Regalloc.ml +++ b/backend/Regalloc.ml @@ -234,7 +234,7 @@ let block_of_RTL_instr funsig tyenv = function and res' = vmregs (loc_result sg) in xparmove (expand_regs tyenv args) args' (Xcall(sg, sum_left_map (vreg tyenv) ros, args', res') :: - xparmove res' (expand_regs tyenv [res]) + xparmove res' (expand_regs tyenv [res]) [Xbranch s]) | RTL.Itailcall(sg, ros, args) -> let args' = vlocs (loc_arguments sg) in @@ -273,7 +273,7 @@ let function_of_RTL_function f tyenv = let xc = PTree.map1 (block_of_RTL_instr f.RTL.fn_sig tyenv) f.RTL.fn_code in (* Add moves for function parameters *) let pc_entrypoint = next_pc f in - let b_entrypoint = + let b_entrypoint = xparmove (vlocs (loc_parameters f.RTL.fn_sig)) (expand_regs tyenv f.RTL.fn_params) [Xbranch f.RTL.fn_entrypoint] in @@ -465,7 +465,7 @@ let spill_costs f = let c1 = st.cost + amount in let c2 = if c1 >= 0 then c1 else max_int (* overflow *) in st.cost <- c2 - end; + end; st.usedefs <- st.usedefs + uses in let charge_list amount uses vl = @@ -624,7 +624,7 @@ let add_interfs_instr g instr live = add_interfs_destroyed g (VSet.remove res live) (destroyed_by_op op) | Xload(chunk, addr, args, dst) -> add_interfs_def g dst live; - add_interfs_destroyed g (VSet.remove dst live) + add_interfs_destroyed g (VSet.remove dst live) (destroyed_by_load chunk addr) | Xstore(chunk, addr, args, src) -> add_interfs_destroyed g live (destroyed_by_store chunk addr) @@ -655,7 +655,7 @@ let add_interfs_instr g instr live = | Some mr -> add_interfs_list_mreg g vargs mr; add_interfs_list_mreg g vres mr) - clob + clob | _ -> () end | Xbranch s -> @@ -776,7 +776,7 @@ let add v t eqs = (v, t, 0) :: eqs let kill x eqs = List.filter (fun (v, t, date) -> v <> x && t <> x) eqs - + let reload_var tospill eqs v = if not (VSet.mem v tospill) then (v, [], eqs) @@ -845,7 +845,7 @@ let rec trim count eqs = if count <= 0 then [] else match eqs with | [] -> [] - | (v, t, date) :: eqs' -> + | (v, t, date) :: eqs' -> if date <= !max_age then (v, t, date + 1) :: trim (count - 1) eqs' else [] @@ -882,7 +882,7 @@ let spill_instr tospill eqs instr = | true, false -> let tmp = new_temp (typeof res) in let (argl', c1, eqs1) = reload_vars tospill eqs argl in - (c1 @ [Xmove(arg1, tmp); Xop(op, tmp :: argl', tmp); Xspill(tmp, res)], + (c1 @ [Xmove(arg1, tmp); Xop(op, tmp :: argl', tmp); Xspill(tmp, res)], add res tmp (kill res eqs1)) | false, true -> let eqs1 = add arg1 res (kill res eqs) in @@ -890,13 +890,13 @@ let spill_instr tospill eqs instr = (Xreload(arg1, res) :: c1 @ [Xop(op, res :: argl', res)], kill res eqs2) | true, true -> - let tmp = new_temp (typeof res) in + let tmp = new_temp (typeof res) in let eqs1 = add arg1 tmp eqs in let (argl', c1, eqs2) = reload_vars tospill eqs1 argl in (Xreload(arg1, tmp) :: c1 @ [Xop(op, tmp :: argl', tmp); Xspill(tmp, res)], add res tmp (kill tmp (kill res eqs2))) end - end + end | Xload(chunk, addr, args, dst) -> let (args', c1, eqs1) = reload_vars tospill eqs args in let (dst', c2, eqs2) = save_var tospill eqs1 dst in @@ -1047,7 +1047,7 @@ let transl_instr alloc instr k = if rarg1 = rres then LTL.Lop(op, rargs, rres) :: k else - LTL.Lop(Omove, [rarg1], rres) :: + LTL.Lop(Omove, [rarg1], rres) :: LTL.Lop(op, rres :: rargl, rres) :: k end | Xload(chunk, addr, args, dst) -> @@ -1079,7 +1079,7 @@ let transl_function fn alloc = { LTL.fn_sig = fn.fn_sig; LTL.fn_stacksize = fn.fn_stacksize; LTL.fn_entrypoint = fn.fn_entrypoint; - LTL.fn_code = PTree.map1 (transl_block alloc) fn.fn_code + LTL.fn_code = PTree.map1 (transl_block alloc) fn.fn_code } @@ -1113,7 +1113,7 @@ and more_rounds f ts count = fprintf !pp "--- Remain to be spilled:\n"; VSet.iter (fun v -> fprintf !pp "%a " PrintXTL.var v) ts'; fprintf !pp "\n\n" - end; + end; more_rounds f (VSet.union ts ts') (count + 1) end @@ -1148,7 +1148,7 @@ let regalloc f = | Timeout -> Error(msg (coqstring_of_camlstring "Spilling fails to converge")) | Type_error_at pc -> - Error [MSG(coqstring_of_camlstring "Ill-typed XTL code at PC "); + Error [MSG(coqstring_of_camlstring "Ill-typed XTL code at PC "); POS pc] | Bad_LTL -> Error(msg (coqstring_of_camlstring "Bad LTL after spilling")) diff --git a/backend/Registers.v b/backend/Registers.v index 20532e8c..cfe8427b 100644 --- a/backend/Registers.v +++ b/backend/Registers.v @@ -81,7 +81,7 @@ Lemma set_reg_lessdef: forall r v1 v2 rs1 rs2, Val.lessdef v1 v2 -> regs_lessdef rs1 rs2 -> regs_lessdef (rs1#r <- v1) (rs2#r <- v2). Proof. - intros; red; intros. repeat rewrite Regmap.gsspec. + intros; red; intros. repeat rewrite Regmap.gsspec. destruct (peq r0 r); auto. Qed. diff --git a/backend/Renumber.v b/backend/Renumber.v index 0a2c2f12..10f58251 100644 --- a/backend/Renumber.v +++ b/backend/Renumber.v @@ -22,7 +22,7 @@ Require Import RTL. enumeration of the nodes of the control-flow graph. This property can be guaranteed when generating the CFG (module [RTLgen]), but is, however, invalidated by further RTL optimization passes such as - [Inlining]. + [Inlining]. In this module, we renumber the nodes of RTL control-flow graphs to restore the postorder property given above. In passing, diff --git a/backend/Renumberproof.v b/backend/Renumberproof.v index 33d6aafa..f4d9cca3 100644 --- a/backend/Renumberproof.v +++ b/backend/Renumberproof.v @@ -67,7 +67,7 @@ Lemma find_function_translated: find_function ge ros rs = Some fd -> find_function tge ros rs = Some (transf_fundef fd). Proof. - unfold find_function; intros. destruct ros as [r|id]. + unfold find_function; intros. destruct ros as [r|id]. eapply functions_translated; eauto. rewrite symbols_preserved. destruct (Genv.find_symbol ge id); try congruence. eapply function_ptr_translated; eauto. @@ -87,18 +87,18 @@ Lemma renum_cfg_nodes: Proof. set (P := fun (c c': code) => forall x y i, c!x = Some i -> f!x = Some y -> c'!y = Some(renum_instr f i)). - intros c0. change (P c0 (renum_cfg f c0)). unfold renum_cfg. + intros c0. change (P c0 (renum_cfg f c0)). unfold renum_cfg. apply PTree_Properties.fold_rec; unfold P; intros. (* extensionality *) - eapply H0; eauto. rewrite H; auto. + eapply H0; eauto. rewrite H; auto. (* base *) rewrite PTree.gempty in H; congruence. (* induction *) - rewrite PTree.gsspec in H2. unfold renum_node. destruct (peq x k). - inv H2. rewrite H3. apply PTree.gss. - destruct f!k as [y'|] eqn:?. - rewrite PTree.gso. eauto. red; intros; subst y'. elim n. eapply f_inj; eauto. - eauto. + rewrite PTree.gsspec in H2. unfold renum_node. destruct (peq x k). + inv H2. rewrite H3. apply PTree.gss. + destruct f!k as [y'|] eqn:?. + rewrite PTree.gso. eauto. red; intros; subst y'. elim n. eapply f_inj; eauto. + eauto. Qed. End RENUMBER. @@ -113,9 +113,9 @@ Lemma transf_function_at: reach f pc -> (transf_function f).(fn_code)!(renum_pc (pnum f) pc) = Some(renum_instr (pnum f) i). Proof. - intros. + intros. destruct (postorder_correct (successors_map f) f.(fn_entrypoint)) as [A B]. - fold (pnum f) in *. + fold (pnum f) in *. unfold renum_pc. destruct (pnum f)! pc as [pc'|] eqn:?. simpl. eapply renum_cfg_nodes; eauto. elim (B pc); auto. unfold successors_map. rewrite PTree.gmap1. rewrite H. simpl. congruence. @@ -132,10 +132,10 @@ Lemma reach_succ: f.(fn_code)!pc = Some i -> In s (successors_instr i) -> reach f pc -> reach f s. Proof. - unfold reach; intros. econstructor; eauto. - unfold successors_map. rewrite PTree.gmap1. rewrite H. auto. + unfold reach; intros. econstructor; eauto. + unfold successors_map. rewrite PTree.gmap1. rewrite H. auto. Qed. - + Inductive match_frames: RTL.stackframe -> RTL.stackframe -> Prop := | match_frames_intro: forall res f sp pc rs (REACH: reach f pc), @@ -164,23 +164,23 @@ Lemma step_simulation: Proof. induction 1; intros S1' MS; inv MS; try TR_AT. (* nop *) - econstructor; split. eapply exec_Inop; eauto. - constructor; auto. eapply reach_succ; eauto. simpl; auto. + econstructor; split. eapply exec_Inop; eauto. + constructor; auto. eapply reach_succ; eauto. simpl; auto. (* op *) econstructor; split. eapply exec_Iop; eauto. - instantiate (1 := v). rewrite <- H0. apply eval_operation_preserved. exact symbols_preserved. + instantiate (1 := v). rewrite <- H0. apply eval_operation_preserved. exact symbols_preserved. constructor; auto. eapply reach_succ; eauto. simpl; auto. (* load *) econstructor; split. assert (eval_addressing tge sp addr rs ## args = Some a). - rewrite <- H0. apply eval_addressing_preserved. exact symbols_preserved. + rewrite <- H0. apply eval_addressing_preserved. exact symbols_preserved. eapply exec_Iload; eauto. constructor; auto. eapply reach_succ; eauto. simpl; auto. (* store *) econstructor; split. assert (eval_addressing tge sp addr rs ## args = Some a). - rewrite <- H0. apply eval_addressing_preserved. exact symbols_preserved. + rewrite <- H0. apply eval_addressing_preserved. exact symbols_preserved. eapply exec_Istore; eauto. constructor; auto. eapply reach_succ; eauto. simpl; auto. (* call *) @@ -204,23 +204,23 @@ Proof. constructor; auto. eapply reach_succ; eauto. simpl; auto. (* cond *) econstructor; split. - eapply exec_Icond; eauto. + eapply exec_Icond; eauto. replace (if b then renum_pc (pnum f) ifso else renum_pc (pnum f) ifnot) with (renum_pc (pnum f) (if b then ifso else ifnot)). - constructor; auto. eapply reach_succ; eauto. simpl. destruct b; auto. + constructor; auto. eapply reach_succ; eauto. simpl. destruct b; auto. destruct b; auto. (* jumptbl *) econstructor; split. - eapply exec_Ijumptable; eauto. rewrite list_nth_z_map. rewrite H1. simpl; eauto. - constructor; auto. eapply reach_succ; eauto. simpl. eapply list_nth_z_in; eauto. + eapply exec_Ijumptable; eauto. rewrite list_nth_z_map. rewrite H1. simpl; eauto. + constructor; auto. eapply reach_succ; eauto. simpl. eapply list_nth_z_in; eauto. (* return *) econstructor; split. - eapply exec_Ireturn; eauto. + eapply exec_Ireturn; eauto. constructor; auto. (* internal function *) simpl. econstructor; split. - eapply exec_function_internal; eauto. - constructor; auto. unfold reach. constructor. + eapply exec_function_internal; eauto. + constructor; auto. unfold reach. constructor. (* external function *) econstructor; split. eapply exec_function_external; eauto. @@ -229,8 +229,8 @@ Proof. constructor; auto. (* return *) inv STACKS. inv H1. - econstructor; split. - eapply exec_return; eauto. + econstructor; split. + eapply exec_return; eauto. constructor; auto. Qed. @@ -239,10 +239,10 @@ Lemma transf_initial_states: exists S2, RTL.initial_state tprog S2 /\ match_states S1 S2. Proof. intros. inv H. econstructor; split. - econstructor. - eapply Genv.init_mem_transf; eauto. - simpl. rewrite symbols_preserved. eauto. - eapply function_ptr_translated; eauto. + econstructor. + eapply Genv.init_mem_transf; eauto. + simpl. rewrite symbols_preserved. eauto. + eapply function_ptr_translated; eauto. rewrite <- H3; apply sig_preserved. constructor. constructor. Qed. @@ -260,14 +260,14 @@ Proof. eexact public_preserved. eexact transf_initial_states. eexact transf_final_states. - exact step_simulation. + exact step_simulation. Qed. End PRESERVATION. - - + + diff --git a/backend/SelectDivproof.v b/backend/SelectDivproof.v index d4bd4f5c..ffe607e4 100644 --- a/backend/SelectDivproof.v +++ b/backend/SelectDivproof.v @@ -50,17 +50,17 @@ Lemma Zdiv_mul_pos: Zdiv n d = Zdiv (m * n) (two_p (N + l)). Proof. intros m l l_pos [LO HI] n RANGE. - exploit (Z_div_mod_eq n d). auto. + exploit (Z_div_mod_eq n d). auto. set (q := n / d). set (r := n mod d). intro EUCL. assert (0 <= r <= d - 1). unfold r. generalize (Z_mod_lt n d d_pos). omega. - assert (0 <= m). + assert (0 <= m). apply Zmult_le_0_reg_r with d. auto. - exploit (two_p_gt_ZERO (N + l)). omega. omega. + exploit (two_p_gt_ZERO (N + l)). omega. omega. set (k := m * d - two_p (N + l)). - assert (0 <= k <= two_p l). + assert (0 <= k <= two_p l). unfold k; omega. assert ((m * n - two_p (N + l) * q) * d = k * n + two_p (N + l) * r). unfold k. rewrite EUCL. ring. @@ -70,14 +70,14 @@ Proof. apply Zle_trans with (two_p l * n). apply Zmult_le_compat_r. omega. omega. replace (N + l) with (l + N) by omega. - rewrite two_p_is_exp. + rewrite two_p_is_exp. replace (two_p l * two_p N - two_p l) with (two_p l * (two_p N - 1)) by ring. apply Zmult_le_compat_l. omega. exploit (two_p_gt_ZERO l). omega. omega. omega. omega. assert (0 <= two_p (N + l) * r). - apply Zmult_le_0_compat. + apply Zmult_le_0_compat. exploit (two_p_gt_ZERO (N + l)). omega. omega. omega. assert (two_p (N + l) * r <= two_p (N + l) * d - two_p (N + l)). @@ -87,23 +87,23 @@ Proof. omega. exploit (two_p_gt_ZERO (N + l)). omega. omega. assert (0 <= m * n - two_p (N + l) * q). - apply Zmult_le_reg_r with d. auto. - replace (0 * d) with 0 by ring. rewrite H2. omega. + apply Zmult_le_reg_r with d. auto. + replace (0 * d) with 0 by ring. rewrite H2. omega. assert (m * n - two_p (N + l) * q < two_p (N + l)). apply Zmult_lt_reg_r with d. omega. - rewrite H2. + rewrite H2. apply Zle_lt_trans with (two_p (N + l) * d - two_p l). - omega. + omega. exploit (two_p_gt_ZERO l). omega. omega. - symmetry. apply Zdiv_unique with (m * n - two_p (N + l) * q). + symmetry. apply Zdiv_unique with (m * n - two_p (N + l) * q). ring. omega. Qed. Lemma Zdiv_unique_2: forall x y q, y > 0 -> 0 < y * q - x <= y -> Zdiv x y = q - 1. Proof. - intros. apply Zdiv_unique with (x - (q - 1) * y). ring. - replace ((q - 1) * y) with (y * q - y) by ring. omega. + intros. apply Zdiv_unique with (x - (q - 1) * y). ring. + replace ((q - 1) * y) with (y * q - y) by ring. omega. Qed. Lemma Zdiv_mul_opp: @@ -116,29 +116,29 @@ Lemma Zdiv_mul_opp: Proof. intros m l l_pos [LO HI] n RANGE. replace (m * (-n)) with (- (m * n)) by ring. - exploit (Z_div_mod_eq n d). auto. + exploit (Z_div_mod_eq n d). auto. set (q := n / d). set (r := n mod d). intro EUCL. assert (0 <= r <= d - 1). unfold r. generalize (Z_mod_lt n d d_pos). omega. - assert (0 <= m). + assert (0 <= m). apply Zmult_le_0_reg_r with d. auto. exploit (two_p_gt_ZERO (N + l)). omega. omega. cut (Zdiv (- (m * n)) (two_p (N + l)) = -q - 1). omega. - apply Zdiv_unique_2. + apply Zdiv_unique_2. apply two_p_gt_ZERO. omega. replace (two_p (N + l) * - q - - (m * n)) with (m * n - two_p (N + l) * q) by ring. set (k := m * d - two_p (N + l)). - assert (0 < k <= two_p l). + assert (0 < k <= two_p l). unfold k; omega. assert ((m * n - two_p (N + l) * q) * d = k * n + two_p (N + l) * r). unfold k. rewrite EUCL. ring. split. - apply Zmult_lt_reg_r with d. omega. + apply Zmult_lt_reg_r with d. omega. replace (0 * d) with 0 by omega. rewrite H2. assert (0 < k * n). apply Zmult_lt_0_compat; omega. @@ -146,10 +146,10 @@ Proof. apply Zmult_le_0_compat. exploit (two_p_gt_ZERO (N + l)); omega. omega. omega. apply Zmult_le_reg_r with d. omega. - rewrite H2. + rewrite H2. assert (k * n <= two_p (N + l)). - rewrite Zplus_comm. rewrite two_p_is_exp; try omega. - apply Zle_trans with (two_p l * n). apply Zmult_le_compat_r. omega. omega. + rewrite Zplus_comm. rewrite two_p_is_exp; try omega. + apply Zle_trans with (two_p l * n). apply Zmult_le_compat_r. omega. omega. apply Zmult_le_compat_l. omega. exploit (two_p_gt_ZERO l). omega. omega. assert (two_p (N + l) * r <= two_p (N + l) * d - two_p (N + l)). replace (two_p (N + l) * d - two_p (N + l)) @@ -170,12 +170,12 @@ Lemma Zquot_mul: Z.quot n d = Zdiv (m * n) (two_p (N + l)) + (if zlt n 0 then 1 else 0). Proof. intros. destruct (zlt n 0). - exploit (Zdiv_mul_opp m l H H0 (-n)). omega. + exploit (Zdiv_mul_opp m l H H0 (-n)). omega. replace (- - n) with n by ring. replace (Z.quot n d) with (- Z.quot (-n) d). rewrite Zquot_Zdiv_pos by omega. omega. rewrite Z.quot_opp_l by omega. ring. - rewrite Zplus_0_r. rewrite Zquot_Zdiv_pos by omega. + rewrite Zplus_0_r. rewrite Zquot_Zdiv_pos by omega. apply Zdiv_mul_pos; omega. Qed. @@ -202,13 +202,13 @@ Proof with (try discriminate). destruct (zlt m Int.modulus)... destruct (zle 0 p)... destruct (zlt p 32)... - simpl in EQ. inv EQ. - split. auto. split. auto. intros. - replace (32 + p') with (31 + (p' + 1)) by omega. + simpl in EQ. inv EQ. + split. auto. split. auto. intros. + replace (32 + p') with (31 + (p' + 1)) by omega. apply Zquot_mul; try omega. replace (31 + (p' + 1)) with (32 + p') by omega. omega. - change (Int.min_signed <= n < Int.half_modulus). - unfold Int.max_signed in H. omega. + change (Int.min_signed <= n < Int.half_modulus). + unfold Int.max_signed in H. omega. Qed. Lemma divu_mul_params_sound: @@ -230,7 +230,7 @@ Proof with (try discriminate). destruct (zlt m Int.modulus)... destruct (zle 0 p)... destruct (zlt p 32)... - simpl in EQ. inv EQ. + simpl in EQ. inv EQ. split. auto. split. auto. intros. apply Zdiv_mul_pos; try omega. assumption. Qed. @@ -245,23 +245,23 @@ Proof. intros. set (n := Int.signed x). set (d := Int.signed y) in *. exploit divs_mul_params_sound; eauto. intros (A & B & C). split. auto. split. auto. - unfold Int.divs. fold n; fold d. rewrite C by (apply Int.signed_range). - rewrite two_p_is_exp by omega. rewrite <- Zdiv_Zdiv. + unfold Int.divs. fold n; fold d. rewrite C by (apply Int.signed_range). + rewrite two_p_is_exp by omega. rewrite <- Zdiv_Zdiv. rewrite Int.shru_lt_zero. unfold Int.add. apply Int.eqm_samerepr. apply Int.eqm_add. - rewrite Int.shr_div_two_p. apply Int.eqm_unsigned_repr_r. apply Int.eqm_refl2. + rewrite Int.shr_div_two_p. apply Int.eqm_unsigned_repr_r. apply Int.eqm_refl2. rewrite Int.unsigned_repr. f_equal. rewrite Int.signed_repr. rewrite Int.modulus_power. f_equal. ring. - cut (Int.min_signed <= n * m / Int.modulus < Int.half_modulus). - unfold Int.max_signed; omega. - apply Zdiv_interval_1. generalize Int.min_signed_neg; omega. apply Int.half_modulus_pos. + cut (Int.min_signed <= n * m / Int.modulus < Int.half_modulus). + unfold Int.max_signed; omega. + apply Zdiv_interval_1. generalize Int.min_signed_neg; omega. apply Int.half_modulus_pos. apply Int.modulus_pos. split. apply Zle_trans with (Int.min_signed * m). apply Zmult_le_compat_l_neg. omega. generalize Int.min_signed_neg; omega. apply Zmult_le_compat_r. unfold n; generalize (Int.signed_range x); tauto. tauto. - apply Zle_lt_trans with (Int.half_modulus * m). + apply Zle_lt_trans with (Int.half_modulus * m). apply Zmult_le_compat_r. generalize (Int.signed_range x); unfold n, Int.max_signed; omega. tauto. - apply Zmult_lt_compat_l. generalize Int.half_modulus_pos; omega. tauto. + apply Zmult_lt_compat_l. generalize Int.half_modulus_pos; omega. tauto. assert (32 < Int.max_unsigned) by (compute; auto). omega. - unfold Int.lt; fold n. rewrite Int.signed_zero. destruct (zlt n 0); apply Int.eqm_unsigned_repr. + unfold Int.lt; fold n. rewrite Int.signed_zero. destruct (zlt n 0); apply Int.eqm_unsigned_repr. apply two_p_gt_ZERO. omega. apply two_p_gt_ZERO. omega. Qed. @@ -274,8 +274,8 @@ Theorem divs_mul_shift_1: Int.divs x y = Int.add (Int.shr (Int.mulhs x (Int.repr m)) (Int.repr p)) (Int.shru x (Int.repr 31)). Proof. - intros. exploit divs_mul_shift_gen; eauto. instantiate (1 := x). - intros (A & B & C). split. auto. rewrite C. + intros. exploit divs_mul_shift_gen; eauto. instantiate (1 := x). + intros (A & B & C). split. auto. rewrite C. unfold Int.mulhs. rewrite Int.signed_repr. auto. generalize Int.min_signed_neg; unfold Int.max_signed; omega. Qed. @@ -288,17 +288,17 @@ Theorem divs_mul_shift_2: Int.divs x y = Int.add (Int.shr (Int.add (Int.mulhs x (Int.repr m)) x) (Int.repr p)) (Int.shru x (Int.repr 31)). Proof. - intros. exploit divs_mul_shift_gen; eauto. instantiate (1 := x). + intros. exploit divs_mul_shift_gen; eauto. instantiate (1 := x). intros (A & B & C). split. auto. rewrite C. f_equal. f_equal. rewrite Int.add_signed. unfold Int.mulhs. set (n := Int.signed x). transitivity (Int.repr (n * (m - Int.modulus) / Int.modulus + n)). - f_equal. + f_equal. replace (n * (m - Int.modulus)) with (n * m + (-n) * Int.modulus) by ring. - rewrite Z_div_plus. ring. apply Int.modulus_pos. - apply Int.eqm_samerepr. apply Int.eqm_add; auto with ints. - apply Int.eqm_sym. eapply Int.eqm_trans. apply Int.eqm_signed_unsigned. - apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl2. f_equal. f_equal. - rewrite Int.signed_repr_eq. rewrite Zmod_small by assumption. + rewrite Z_div_plus. ring. apply Int.modulus_pos. + apply Int.eqm_samerepr. apply Int.eqm_add; auto with ints. + apply Int.eqm_sym. eapply Int.eqm_trans. apply Int.eqm_signed_unsigned. + apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl2. f_equal. f_equal. + rewrite Int.signed_repr_eq. rewrite Zmod_small by assumption. apply zlt_false. omega. Qed. @@ -309,19 +309,19 @@ Theorem divu_mul_shift: Int.divu x y = Int.shru (Int.mulhu x (Int.repr m)) (Int.repr p). Proof. intros. exploit divu_mul_params_sound; eauto. intros (A & B & C). - split. auto. - rewrite Int.shru_div_two_p. rewrite Int.unsigned_repr. + split. auto. + rewrite Int.shru_div_two_p. rewrite Int.unsigned_repr. unfold Int.divu, Int.mulhu. f_equal. rewrite C by apply Int.unsigned_range. rewrite two_p_is_exp by omega. rewrite <- Zdiv_Zdiv by (apply two_p_gt_ZERO; omega). - f_equal. rewrite (Int.unsigned_repr m). + f_equal. rewrite (Int.unsigned_repr m). rewrite Int.unsigned_repr. f_equal. ring. cut (0 <= Int.unsigned x * m / Int.modulus < Int.modulus). unfold Int.max_unsigned; omega. apply Zdiv_interval_1. omega. compute; auto. compute; auto. - split. simpl. apply Z.mul_nonneg_nonneg. generalize (Int.unsigned_range x); omega. omega. + split. simpl. apply Z.mul_nonneg_nonneg. generalize (Int.unsigned_range x); omega. omega. apply Zle_lt_trans with (Int.modulus * m). - apply Zmult_le_compat_r. generalize (Int.unsigned_range x); omega. omega. - apply Zmult_lt_compat_l. compute; auto. omega. + apply Zmult_le_compat_r. generalize (Int.unsigned_range x); omega. omega. + apply Zmult_lt_compat_l. compute; auto. omega. unfold Int.max_unsigned; omega. assert (32 < Int.max_unsigned) by (compute; auto). omega. Qed. @@ -347,10 +347,10 @@ Proof. (Vint (Int.mulhu x (Int.repr M)))). { EvalOp. econstructor. econstructor; eauto. econstructor. EvalOp. simpl; reflexivity. constructor. auto. } - exploit eval_shruimm. eexact H1. instantiate (1 := Int.repr p). - intros [v [P Q]]. simpl in Q. - replace (Int.ltu (Int.repr p) Int.iwordsize) with true in Q. - inv Q. rewrite B. auto. + exploit eval_shruimm. eexact H1. instantiate (1 := Int.repr p). + intros [v [P Q]]. simpl in Q. + replace (Int.ltu (Int.repr p) Int.iwordsize) with true in Q. + inv Q. rewrite B. auto. unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true; auto. tauto. assert (32 < Int.max_unsigned) by (compute; auto). omega. Qed. @@ -363,17 +363,17 @@ Theorem eval_divuimm: Proof. unfold divuimm; intros. generalize H0; intros DIV. destruct x; simpl in DIV; try discriminate. - destruct (Int.eq n2 Int.zero) eqn:Z2; inv DIV. + destruct (Int.eq n2 Int.zero) eqn:Z2; inv DIV. destruct (Int.is_power2 n2) as [l | ] eqn:P2. -- erewrite Int.divu_pow2 by eauto. - replace (Vint (Int.shru i l)) with (Val.shru (Vint i) (Vint l)). +- erewrite Int.divu_pow2 by eauto. + replace (Vint (Int.shru i l)) with (Val.shru (Vint i) (Vint l)). apply eval_shruimm; auto. - simpl. erewrite Int.is_power2_range; eauto. + simpl. erewrite Int.is_power2_range; eauto. - destruct (Compopts.optim_for_size tt). + eapply eval_divu_base; eauto. EvalOp. + destruct (divu_mul_params (Int.unsigned n2)) as [[p M] | ] eqn:PARAMS. * exists (Vint (Int.divu i n2)); split; auto. - econstructor; eauto. eapply eval_divu_mul; eauto. + econstructor; eauto. eapply eval_divu_mul; eauto. * eapply eval_divu_base; eauto. EvalOp. Qed. @@ -386,7 +386,7 @@ Theorem eval_divu: Proof. unfold divu; intros until b. destruct (divu_match b); intros. - inv H0. inv H5. simpl in H7. inv H7. eapply eval_divuimm; eauto. -- eapply eval_divu_base; eauto. +- eapply eval_divu_base; eauto. Qed. Lemma eval_mod_from_div: @@ -395,8 +395,8 @@ Lemma eval_mod_from_div: nth_error le O = Some (Vint x) -> eval_expr ge sp e m le (mod_from_div a n) (Vint (Int.sub x (Int.mul y n))). Proof. - unfold mod_from_div; intros. - exploit eval_mulimm; eauto. instantiate (1 := n). intros [v [A B]]. + unfold mod_from_div; intros. + exploit eval_mulimm; eauto. instantiate (1 := n). intros [v [A B]]. simpl in B. inv B. EvalOp. Qed. @@ -408,7 +408,7 @@ Theorem eval_moduimm: Proof. unfold moduimm; intros. generalize H0; intros MOD. destruct x; simpl in MOD; try discriminate. - destruct (Int.eq n2 Int.zero) eqn:Z2; inv MOD. + destruct (Int.eq n2 Int.zero) eqn:Z2; inv MOD. destruct (Int.is_power2 n2) as [l | ] eqn:P2. - erewrite Int.modu_and by eauto. change (Vint (Int.and i (Int.sub n2 Int.one))) @@ -417,10 +417,10 @@ Proof. - destruct (Compopts.optim_for_size tt). + eapply eval_modu_base; eauto. EvalOp. + destruct (divu_mul_params (Int.unsigned n2)) as [[p M] | ] eqn:PARAMS. - * econstructor; split. - econstructor; eauto. eapply eval_mod_from_div. - eapply eval_divu_mul; eauto. simpl; eauto. simpl; eauto. - rewrite Int.modu_divu. auto. + * econstructor; split. + econstructor; eauto. eapply eval_mod_from_div. + eapply eval_divu_mul; eauto. simpl; eauto. simpl; eauto. + rewrite Int.modu_divu. auto. red; intros; subst n2; discriminate. * eapply eval_modu_base; eauto. EvalOp. Qed. @@ -434,7 +434,7 @@ Theorem eval_modu: Proof. unfold modu; intros until b. destruct (modu_match b); intros. - inv H0. inv H5. simpl in H7. inv H7. eapply eval_moduimm; eauto. -- eapply eval_modu_base; eauto. +- eapply eval_modu_base; eauto. Qed. Lemma eval_divs_mul: @@ -451,10 +451,10 @@ Proof. (Vint (Int.mulhs x (Int.repr M)))). { EvalOp. econstructor. eauto. econstructor. EvalOp. simpl; reflexivity. constructor. auto. } - exploit eval_shruimm. eexact V. instantiate (1 := Int.repr (Int.zwordsize - 1)). - intros [v1 [Y LD]]. simpl in LD. - change (Int.ltu (Int.repr 31) Int.iwordsize) with true in LD. - simpl in LD. inv LD. + exploit eval_shruimm. eexact V. instantiate (1 := Int.repr (Int.zwordsize - 1)). + intros [v1 [Y LD]]. simpl in LD. + change (Int.ltu (Int.repr 31) Int.iwordsize) with true in LD. + simpl in LD. inv LD. assert (RANGE: 0 <= p < 32 -> Int.ltu (Int.repr p) Int.iwordsize = true). { intros. unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true by tauto. auto. assert (32 < Int.max_unsigned) by (compute; auto). omega. } @@ -463,15 +463,15 @@ Proof. exploit eval_shrimm. eexact X. instantiate (1 := Int.repr p). intros [v1 [Z LD]]. simpl in LD. rewrite RANGE in LD by auto. inv LD. exploit eval_add. eexact Z. eexact Y. intros [v1 [W LD]]. - simpl in LD. inv LD. + simpl in LD. inv LD. rewrite B. exact W. - exploit (divs_mul_shift_2 x); eauto. intros [A B]. - exploit eval_add. eexact X. eexact V. intros [v1 [Z LD]]. - simpl in LD. inv LD. + exploit eval_add. eexact X. eexact V. intros [v1 [Z LD]]. + simpl in LD. inv LD. exploit eval_shrimm. eexact Z. instantiate (1 := Int.repr p). intros [v1 [U LD]]. simpl in LD. rewrite RANGE in LD by auto. inv LD. exploit eval_add. eexact U. eexact Y. intros [v1 [W LD]]. - simpl in LD. inv LD. + simpl in LD. inv LD. rewrite B. exact W. Qed. @@ -484,7 +484,7 @@ Proof. unfold divsimm; intros. generalize H0; intros DIV. destruct x; simpl in DIV; try discriminate. destruct (Int.eq n2 Int.zero - || Int.eq i (Int.repr Int.min_signed) && Int.eq n2 Int.mone) eqn:Z2; inv DIV. + || Int.eq i (Int.repr Int.min_signed) && Int.eq n2 Int.mone) eqn:Z2; inv DIV. destruct (Int.is_power2 n2) as [l | ] eqn:P2. - destruct (Int.ltu l (Int.repr 31)) eqn:LT31. + eapply eval_shrximm; eauto. eapply Val.divs_pow2; eauto. @@ -493,7 +493,7 @@ Proof. + eapply eval_divs_base; eauto. EvalOp. + destruct (divs_mul_params (Int.signed n2)) as [[p M] | ] eqn:PARAMS. * exists (Vint (Int.divs i n2)); split; auto. - econstructor; eauto. eapply eval_divs_mul; eauto. + econstructor; eauto. eapply eval_divs_mul; eauto. * eapply eval_divs_base; eauto. EvalOp. Qed. @@ -506,7 +506,7 @@ Theorem eval_divs: Proof. unfold divs; intros until b. destruct (divs_match b); intros. - inv H0. inv H5. simpl in H7. inv H7. eapply eval_divsimm; eauto. -- eapply eval_divs_base; eauto. +- eapply eval_divs_base; eauto. Qed. Theorem eval_modsimm: @@ -515,25 +515,25 @@ Theorem eval_modsimm: Val.mods x (Vint n2) = Some z -> exists v, eval_expr ge sp e m le (modsimm e1 n2) v /\ Val.lessdef z v. Proof. - unfold modsimm; intros. + unfold modsimm; intros. exploit Val.mods_divs; eauto. intros [y [A B]]. generalize A; intros DIV. destruct x; simpl in DIV; try discriminate. destruct (Int.eq n2 Int.zero - || Int.eq i (Int.repr Int.min_signed) && Int.eq n2 Int.mone) eqn:Z2; inv DIV. + || Int.eq i (Int.repr Int.min_signed) && Int.eq n2 Int.mone) eqn:Z2; inv DIV. destruct (Int.is_power2 n2) as [l | ] eqn:P2. - destruct (Int.ltu l (Int.repr 31)) eqn:LT31. + exploit (eval_shrximm ge sp e m (Vint i :: le) (Eletvar O)). - constructor. simpl; eauto. eapply Val.divs_pow2; eauto. - intros [v1 [X LD]]. inv LD. - econstructor; split. econstructor. eauto. - apply eval_mod_from_div. eexact X. simpl; eauto. + constructor. simpl; eauto. eapply Val.divs_pow2; eauto. + intros [v1 [X LD]]. inv LD. + econstructor; split. econstructor. eauto. + apply eval_mod_from_div. eexact X. simpl; eauto. simpl. auto. + eapply eval_mods_base; eauto. EvalOp. - destruct (Compopts.optim_for_size tt). + eapply eval_mods_base; eauto. EvalOp. + destruct (divs_mul_params (Int.signed n2)) as [[p M] | ] eqn:PARAMS. - * econstructor; split. + * econstructor; split. econstructor. eauto. apply eval_mod_from_div with (x := i); auto. eapply eval_divs_mul with (x := i); eauto. simpl. auto. @@ -549,7 +549,7 @@ Theorem eval_mods: Proof. unfold mods; intros until b. destruct (mods_match b); intros. - inv H0. inv H5. simpl in H7. inv H7. eapply eval_modsimm; eauto. -- eapply eval_mods_base; eauto. +- eapply eval_mods_base; eauto. Qed. (** * Floating-point division *) @@ -563,10 +563,10 @@ Proof. intros until y. unfold divf. destruct (divf_match b); intros. - unfold divfimm. destruct (Float.exact_inverse n2) as [n2' | ] eqn:EINV. + inv H0. inv H4. simpl in H6. inv H6. econstructor; split. - EvalOp. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. - simpl; eauto. - destruct x; simpl; auto. erewrite Float.div_mul_inverse; eauto. - + TrivialExists. + EvalOp. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. + simpl; eauto. + destruct x; simpl; auto. erewrite Float.div_mul_inverse; eauto. + + TrivialExists. - TrivialExists. Qed. @@ -579,10 +579,10 @@ Proof. intros until y. unfold divfs. destruct (divfs_match b); intros. - unfold divfsimm. destruct (Float32.exact_inverse n2) as [n2' | ] eqn:EINV. + inv H0. inv H4. simpl in H6. inv H6. econstructor; split. - EvalOp. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. - simpl; eauto. - destruct x; simpl; auto. erewrite Float32.div_mul_inverse; eauto. - + TrivialExists. + EvalOp. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. + simpl; eauto. + destruct x; simpl; auto. erewrite Float32.div_mul_inverse; eauto. + + TrivialExists. - TrivialExists. Qed. diff --git a/backend/SelectLongproof.v b/backend/SelectLongproof.v index cdfb1107..35d53215 100644 --- a/backend/SelectLongproof.v +++ b/backend/SelectLongproof.v @@ -131,7 +131,7 @@ Remark eval_builtin_1: builtin_implements id sg (varg1::nil) vres -> eval_expr ge sp e m le (Ebuiltin (EF_builtin id sg) (arg1 ::: Enil)) vres. Proof. - intros. econstructor. econstructor. eauto. constructor. apply H0. + intros. econstructor. econstructor. eauto. constructor. apply H0. Qed. Remark eval_builtin_2: @@ -181,10 +181,10 @@ Proof. intros until sem; intros EXEC UNDEF. unfold splitlong. case (splitlong_match a); intros. - InvEval. subst v. - exploit EXEC. eexact H2. eexact H3. intros [v' [A B]]. + exploit EXEC. eexact H2. eexact H3. intros [v' [A B]]. exists v'; split. auto. - destruct v1; simpl in *; try (rewrite UNDEF; auto). - destruct v0; simpl in *; try (rewrite UNDEF; auto). + destruct v1; simpl in *; try (rewrite UNDEF; auto). + destruct v0; simpl in *; try (rewrite UNDEF; auto). erewrite B; eauto. - exploit (EXEC (v :: le) (Eop Ohighlong (Eletvar 0 ::: Enil)) (Eop Olowlong (Eletvar 0 ::: Enil))). EvalOp. EvalOp. @@ -202,9 +202,9 @@ Lemma eval_splitlong_strict: eval_expr ge sp e m le (f a1 a2) v) -> eval_expr ge sp e m le (splitlong a f) v. Proof. - intros until v. + intros until v. unfold splitlong. case (splitlong_match a); intros. -- InvEval. destruct v1; simpl in H; try discriminate. destruct v0; inv H. +- InvEval. destruct v1; simpl in H; try discriminate. destruct v0; inv H. apply H0. rewrite Int64.hi_ofwords; auto. rewrite Int64.lo_ofwords; auto. - EvalOp. apply H0; EvalOp. Qed. @@ -236,10 +236,10 @@ Proof. destruct v2; simpl in *; try (rewrite UNDEF; auto). destruct v3; try (rewrite UNDEF; auto). erewrite B; eauto. -- InvEval. subst va. - exploit (EXEC (vb :: le) (lift h1) (lift l1) +- InvEval. subst va. + exploit (EXEC (vb :: le) (lift h1) (lift l1) (Eop Ohighlong (Eletvar 0 ::: Enil)) (Eop Olowlong (Eletvar 0 ::: Enil))). - EvalOp. EvalOp. EvalOp. EvalOp. + EvalOp. EvalOp. EvalOp. EvalOp. intros [v [A B]]. exists v; split. econstructor; eauto. @@ -247,7 +247,7 @@ Proof. destruct v0; try (rewrite UNDEF; auto). destruct vb; try (rewrite UNDEF; auto). erewrite B; simpl; eauto. rewrite Int64.ofwords_recompose. auto. -- InvEval. subst vb. +- InvEval. subst vb. exploit (EXEC (va :: le) (Eop Ohighlong (Eletvar 0 ::: Enil)) (Eop Olowlong (Eletvar 0 ::: Enil)) (lift h2) (lift l2)). @@ -256,15 +256,15 @@ Proof. exists v; split. econstructor; eauto. destruct va; try (rewrite UNDEF; auto). - destruct v1; simpl in *; try (rewrite UNDEF; auto). + destruct v1; simpl in *; try (rewrite UNDEF; auto). destruct v0; try (rewrite UNDEF; auto). - erewrite B; simpl; eauto. rewrite Int64.ofwords_recompose. auto. + erewrite B; simpl; eauto. rewrite Int64.ofwords_recompose. auto. - exploit (EXEC (vb :: va :: le) (Eop Ohighlong (Eletvar 1 ::: Enil)) (Eop Olowlong (Eletvar 1 ::: Enil)) (Eop Ohighlong (Eletvar 0 ::: Enil)) (Eop Olowlong (Eletvar 0 ::: Enil))). EvalOp. EvalOp. EvalOp. EvalOp. intros [v [A B]]. - exists v; split. EvalOp. + exists v; split. EvalOp. destruct va; try (rewrite UNDEF; auto); destruct vb; try (rewrite UNDEF; auto). erewrite B; simpl; eauto. rewrite ! Int64.ofwords_recompose; auto. Qed. @@ -287,13 +287,13 @@ Proof. intros. destruct v1; simpl in H; try discriminate. destruct v2; inv H. rewrite Int64.hi_ofwords; rewrite Int64.lo_ofwords; auto. } - intros until v. + intros until v. unfold splitlong2. case (splitlong2_match a b); intros. -- InvEval. exploit INV. eexact H. intros [EQ1 EQ2]. exploit INV. eexact H0. intros [EQ3 EQ4]. +- InvEval. exploit INV. eexact H. intros [EQ1 EQ2]. exploit INV. eexact H0. intros [EQ3 EQ4]. subst. auto. -- InvEval. exploit INV; eauto. intros [EQ1 EQ2]. subst. - econstructor. eauto. apply H1; EvalOp. -- InvEval. exploit INV; eauto. intros [EQ1 EQ2]. subst. +- InvEval. exploit INV; eauto. intros [EQ1 EQ2]. subst. + econstructor. eauto. apply H1; EvalOp. +- InvEval. exploit INV; eauto. intros [EQ1 EQ2]. subst. econstructor. eauto. apply H1; EvalOp. - EvalOp. apply H1; EvalOp. Qed. @@ -304,9 +304,9 @@ Lemma is_longconst_sound: eval_expr ge sp e m le a x -> x = Vlong n. Proof. - unfold is_longconst; intros until n; intros LC. + unfold is_longconst; intros until n; intros LC. destruct (is_longconst_match a); intros. - inv LC. InvEval. simpl in H5. inv H5. auto. + inv LC. InvEval. simpl in H5. inv H5. auto. discriminate. Qed. @@ -316,35 +316,35 @@ Lemma is_longconst_zero_sound: eval_expr ge sp e m le a x -> x = Vlong Int64.zero. Proof. - unfold is_longconst_zero; intros. + unfold is_longconst_zero; intros. destruct (is_longconst a) as [n|] eqn:E; try discriminate. revert H. predSpec Int64.eq Int64.eq_spec n Int64.zero. - intros. subst. eapply is_longconst_sound; eauto. + intros. subst. eapply is_longconst_sound; eauto. congruence. Qed. Lemma eval_lowlong: unary_constructor_sound lowlong Val.loword. Proof. unfold lowlong; red. intros until x. destruct (lowlong_match a); intros. - InvEval. subst x. exists v0; split; auto. - destruct v1; simpl; auto. destruct v0; simpl; auto. - rewrite Int64.lo_ofwords. auto. - exists (Val.loword x); split; auto. EvalOp. + InvEval. subst x. exists v0; split; auto. + destruct v1; simpl; auto. destruct v0; simpl; auto. + rewrite Int64.lo_ofwords. auto. + exists (Val.loword x); split; auto. EvalOp. Qed. Lemma eval_highlong: unary_constructor_sound highlong Val.hiword. Proof. unfold highlong; red. intros until x. destruct (highlong_match a); intros. - InvEval. subst x. exists v1; split; auto. - destruct v1; simpl; auto. destruct v0; simpl; auto. - rewrite Int64.hi_ofwords. auto. - exists (Val.hiword x); split; auto. EvalOp. + InvEval. subst x. exists v1; split; auto. + destruct v1; simpl; auto. destruct v0; simpl; auto. + rewrite Int64.hi_ofwords. auto. + exists (Val.hiword x); split; auto. EvalOp. Qed. -Lemma eval_longconst: +Lemma eval_longconst: forall le n, eval_expr ge sp e m le (longconst n) (Vlong n). Proof. - intros. EvalOp. rewrite Int64.ofwords_recompose; auto. + intros. EvalOp. rewrite Int64.ofwords_recompose; auto. Qed. Theorem eval_intoflong: unary_constructor_sound intoflong Val.loword. @@ -352,10 +352,10 @@ Proof eval_lowlong. Theorem eval_longofintu: unary_constructor_sound longofintu Val.longofintu. Proof. - red; intros. unfold longofintu. econstructor; split. EvalOp. - unfold Val.longofintu. destruct x; auto. + red; intros. unfold longofintu. econstructor; split. EvalOp. + unfold Val.longofintu. destruct x; auto. replace (Int64.repr (Int.unsigned i)) with (Int64.ofwords Int.zero i); auto. - apply Int64.same_bits_eq; intros. + apply Int64.same_bits_eq; intros. rewrite Int64.testbit_repr by auto. rewrite Int64.bits_ofwords by auto. fold (Int.testbit i i0). @@ -370,17 +370,17 @@ Proof. exploit (eval_shrimm ge sp e m (Int.repr 31) (x :: le) (Eletvar 0)). EvalOp. intros [v1 [A B]]. econstructor; split. EvalOp. - destruct x; simpl; auto. - simpl in B. inv B. simpl. + destruct x; simpl; auto. + simpl in B. inv B. simpl. replace (Int64.repr (Int.signed i)) with (Int64.ofwords (Int.shr i (Int.repr 31)) i); auto. - apply Int64.same_bits_eq; intros. + apply Int64.same_bits_eq; intros. rewrite Int64.testbit_repr by auto. rewrite Int64.bits_ofwords by auto. rewrite Int.bits_signed by omega. destruct (zlt i0 Int.zwordsize). auto. - assert (Int64.zwordsize = 2 * Int.zwordsize) by reflexivity. + assert (Int64.zwordsize = 2 * Int.zwordsize) by reflexivity. rewrite Int.bits_shr by omega. change (Int.unsigned (Int.repr 31)) with (Int.zwordsize - 1). f_equal. destruct (zlt (i0 - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); omega. @@ -389,19 +389,19 @@ Qed. Theorem eval_negl: unary_constructor_sound negl Val.negl. Proof. unfold negl; red; intros. destruct (is_longconst a) eqn:E. - econstructor; split. apply eval_longconst. + econstructor; split. apply eval_longconst. exploit is_longconst_sound; eauto. intros EQ; subst x. simpl. auto. econstructor; split. eapply eval_builtin_1; eauto. UseHelper. auto. Qed. Theorem eval_notl: unary_constructor_sound notl Val.notl. Proof. - red; intros. unfold notl. apply eval_splitlong; auto. - intros. + red; intros. unfold notl. apply eval_splitlong; auto. + intros. exploit eval_notint. eexact H0. intros [va [A B]]. exploit eval_notint. eexact H1. intros [vb [C D]]. exists (Val.longofwords va vb); split. EvalOp. - intros; subst. simpl in *. inv B; inv D. + intros; subst. simpl in *. inv B; inv D. simpl. unfold Int.not. rewrite <- Int64.decompose_xor. auto. destruct x; auto. Qed. @@ -412,7 +412,7 @@ Theorem eval_longoffloat: Val.longoffloat x = Some y -> exists v, eval_expr ge sp e m le (longoffloat hf a) v /\ Val.lessdef y v. Proof. - intros; unfold longoffloat. econstructor; split. + intros; unfold longoffloat. econstructor; split. eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto. Qed. @@ -422,7 +422,7 @@ Theorem eval_longuoffloat: Val.longuoffloat x = Some y -> exists v, eval_expr ge sp e m le (longuoffloat hf a) v /\ Val.lessdef y v. Proof. - intros; unfold longuoffloat. econstructor; split. + intros; unfold longuoffloat. econstructor; split. eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto. Qed. @@ -432,7 +432,7 @@ Theorem eval_floatoflong: Val.floatoflong x = Some y -> exists v, eval_expr ge sp e m le (floatoflong hf a) v /\ Val.lessdef y v. Proof. - intros; unfold floatoflong. econstructor; split. + intros; unfold floatoflong. econstructor; split. eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto. Qed. @@ -442,7 +442,7 @@ Theorem eval_floatoflongu: Val.floatoflongu x = Some y -> exists v, eval_expr ge sp e m le (floatoflongu hf a) v /\ Val.lessdef y v. Proof. - intros; unfold floatoflongu. econstructor; split. + intros; unfold floatoflongu. econstructor; split. eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto. Qed. @@ -455,7 +455,7 @@ Proof. intros; unfold longofsingle. destruct x; simpl in H0; inv H0. destruct (Float32.to_long f) as [n|] eqn:EQ; simpl in H2; inv H2. exploit eval_floatofsingle; eauto. intros (v & A & B). simpl in B. inv B. - apply Float32.to_long_double in EQ. + apply Float32.to_long_double in EQ. eapply eval_longoffloat; eauto. simpl. change (Float.of_single f) with (Float32.to_double f); rewrite EQ; auto. Qed. @@ -469,7 +469,7 @@ Proof. intros; unfold longuofsingle. destruct x; simpl in H0; inv H0. destruct (Float32.to_longu f) as [n|] eqn:EQ; simpl in H2; inv H2. exploit eval_floatofsingle; eauto. intros (v & A & B). simpl in B. inv B. - apply Float32.to_longu_double in EQ. + apply Float32.to_longu_double in EQ. eapply eval_longuoffloat; eauto. simpl. change (Float.of_single f) with (Float32.to_double f); rewrite EQ; auto. Qed. @@ -480,7 +480,7 @@ Theorem eval_singleoflong: Val.singleoflong x = Some y -> exists v, eval_expr ge sp e m le (singleoflong hf a) v /\ Val.lessdef y v. Proof. - intros; unfold singleoflong. econstructor; split. + intros; unfold singleoflong. econstructor; split. eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto. Qed. @@ -490,17 +490,17 @@ Theorem eval_singleoflongu: Val.singleoflongu x = Some y -> exists v, eval_expr ge sp e m le (singleoflongu hf a) v /\ Val.lessdef y v. Proof. - intros; unfold singleoflongu. econstructor; split. + intros; unfold singleoflongu. econstructor; split. eapply eval_helper_1; eauto. DeclHelper. UseHelper. auto. Qed. Theorem eval_andl: binary_constructor_sound andl Val.andl. Proof. red; intros. unfold andl. apply eval_splitlong2; auto. - intros. + intros. exploit eval_and. eexact H1. eexact H3. intros [va [A B]]. exploit eval_and. eexact H2. eexact H4. intros [vb [C D]]. - exists (Val.longofwords va vb); split. EvalOp. + exists (Val.longofwords va vb); split. EvalOp. intros; subst. simpl in B; inv B. simpl in D; inv D. simpl. f_equal. rewrite Int64.decompose_and. auto. destruct x; auto. destruct y; auto. @@ -509,10 +509,10 @@ Qed. Theorem eval_orl: binary_constructor_sound orl Val.orl. Proof. red; intros. unfold orl. apply eval_splitlong2; auto. - intros. + intros. exploit eval_or. eexact H1. eexact H3. intros [va [A B]]. exploit eval_or. eexact H2. eexact H4. intros [vb [C D]]. - exists (Val.longofwords va vb); split. EvalOp. + exists (Val.longofwords va vb); split. EvalOp. intros; subst. simpl in B; inv B. simpl in D; inv D. simpl. f_equal. rewrite Int64.decompose_or. auto. destruct x; auto. destruct y; auto. @@ -521,10 +521,10 @@ Qed. Theorem eval_xorl: binary_constructor_sound xorl Val.xorl. Proof. red; intros. unfold xorl. apply eval_splitlong2; auto. - intros. + intros. exploit eval_xor. eexact H1. eexact H3. intros [va [A B]]. exploit eval_xor. eexact H2. eexact H4. intros [vb [C D]]. - exists (Val.longofwords va vb); split. EvalOp. + exists (Val.longofwords va vb); split. EvalOp. intros; subst. simpl in B; inv B. simpl in D; inv D. simpl. f_equal. rewrite Int64.decompose_xor. auto. destruct x; auto. destruct y; auto. @@ -536,7 +536,7 @@ Lemma is_intconst_sound: eval_expr ge sp e m le a x -> x = Vint n. Proof. - unfold is_intconst; intros until n; intros LC. + unfold is_intconst; intros until n; intros LC. destruct a; try discriminate. destruct o; try discriminate. destruct e0; try discriminate. inv LC. intros. InvEval. auto. Qed. @@ -561,28 +561,28 @@ Proof. intros until a3; intros A0 A1 A2 A3. predSpec Int.eq Int.eq_spec n Int.zero. apply A0; auto. - assert (NZ: Int.unsigned n <> 0). + assert (NZ: Int.unsigned n <> 0). { red; intros. elim H. rewrite <- (Int.repr_unsigned n). rewrite H0. auto. } destruct (Int.ltu n Int.iwordsize) eqn:LT. exploit Int.ltu_iwordsize_inv; eauto. intros RANGE. assert (0 <= Int.zwordsize - Int.unsigned n < Int.zwordsize) by omega. - apply A1. auto. auto. - unfold Int.ltu, Int.sub. rewrite Int.unsigned_repr_wordsize. - rewrite Int.unsigned_repr. rewrite zlt_true; auto. omega. - generalize Int.wordsize_max_unsigned; omega. - unfold Int.ltu. rewrite zlt_true; auto. + apply A1. auto. auto. + unfold Int.ltu, Int.sub. rewrite Int.unsigned_repr_wordsize. + rewrite Int.unsigned_repr. rewrite zlt_true; auto. omega. + generalize Int.wordsize_max_unsigned; omega. + unfold Int.ltu. rewrite zlt_true; auto. change (Int.unsigned Int64.iwordsize') with 64. change Int.zwordsize with 32 in RANGE. omega. destruct (Int.ltu n Int64.iwordsize') eqn:LT'. - exploit Int.ltu_inv; eauto. + exploit Int.ltu_inv; eauto. change (Int.unsigned Int64.iwordsize') with (Int.zwordsize * 2). intros RANGE. assert (Int.zwordsize <= Int.unsigned n). - unfold Int.ltu in LT. rewrite Int.unsigned_repr_wordsize in LT. - destruct (zlt (Int.unsigned n) Int.zwordsize). discriminate. omega. - apply A2. tauto. unfold Int.ltu, Int.sub. rewrite Int.unsigned_repr_wordsize. - rewrite Int.unsigned_repr. rewrite zlt_true; auto. omega. - generalize Int.wordsize_max_unsigned; omega. + unfold Int.ltu in LT. rewrite Int.unsigned_repr_wordsize in LT. + destruct (zlt (Int.unsigned n) Int.zwordsize). discriminate. omega. + apply A2. tauto. unfold Int.ltu, Int.sub. rewrite Int.unsigned_repr_wordsize. + rewrite Int.unsigned_repr. rewrite zlt_true; auto. omega. + generalize Int.wordsize_max_unsigned; omega. auto. Qed. @@ -593,8 +593,8 @@ Proof. unfold shllimm; red; intros. apply eval_shift_imm; intros. + (* n = 0 *) - subst n. exists x; split; auto. destruct x; simpl; auto. - change (Int64.shl' i Int.zero) with (Int64.shl i Int64.zero). + subst n. exists x; split; auto. destruct x; simpl; auto. + change (Int64.shl' i Int.zero) with (Int64.shl i Int64.zero). rewrite Int64.shl_zero. auto. + (* 0 < n < 32 *) apply eval_splitlong with (sem := fun x => Val.shll x (Vint n)); auto. @@ -603,8 +603,8 @@ Proof. exploit eval_shlimm. eexact H5. instantiate (1 := n). intros [v2 [A2 B2]]. exploit eval_shruimm. eexact H5. instantiate (1 := Int.sub Int.iwordsize n). intros [v3 [A3 B3]]. exploit eval_or. eexact A1. eexact A3. intros [v4 [A4 B4]]. - econstructor; split. EvalOp. - intros. subst. simpl in *. rewrite H1 in *. rewrite H2 in *. rewrite H3. + econstructor; split. EvalOp. + intros. subst. simpl in *. rewrite H1 in *. rewrite H2 in *. rewrite H3. inv B1; inv B2; inv B3. simpl in B4. inv B4. simpl. rewrite Int64.decompose_shl_1; auto. destruct x; auto. @@ -613,9 +613,9 @@ Proof. exploit eval_shlimm. eexact A1. instantiate (1 := Int.sub n Int.iwordsize). intros [v2 [A2 B2]]. econstructor; split. EvalOp. destruct x; simpl; auto. - destruct (Int.ltu n Int64.iwordsize'); auto. - simpl in B1; inv B1. simpl in B2. rewrite H1 in B2. inv B2. - simpl. erewrite <- Int64.decompose_shl_2. instantiate (1 := Int64.hiword i). + destruct (Int.ltu n Int64.iwordsize'); auto. + simpl in B1; inv B1. simpl in B2. rewrite H1 in B2. inv B2. + simpl. erewrite <- Int64.decompose_shl_2. instantiate (1 := Int64.hiword i). rewrite Int64.ofwords_recompose. auto. auto. + (* n >= 64 *) econstructor; split. eapply eval_helper_2; eauto. EvalOp. DeclHelper. UseHelper. auto. @@ -638,8 +638,8 @@ Lemma eval_shrluimm: Proof. unfold shrluimm; red; intros. apply eval_shift_imm; intros. + (* n = 0 *) - subst n. exists x; split; auto. destruct x; simpl; auto. - change (Int64.shru' i Int.zero) with (Int64.shru i Int64.zero). + subst n. exists x; split; auto. destruct x; simpl; auto. + change (Int64.shru' i Int.zero) with (Int64.shru i Int64.zero). rewrite Int64.shru_zero. auto. + (* 0 < n < 32 *) apply eval_splitlong with (sem := fun x => Val.shrlu x (Vint n)); auto. @@ -648,8 +648,8 @@ Proof. exploit eval_shruimm. eexact H4. instantiate (1 := n). intros [v2 [A2 B2]]. exploit eval_shlimm. eexact H4. instantiate (1 := Int.sub Int.iwordsize n). intros [v3 [A3 B3]]. exploit eval_or. eexact A1. eexact A3. intros [v4 [A4 B4]]. - econstructor; split. EvalOp. - intros. subst. simpl in *. rewrite H1 in *. rewrite H2 in *. rewrite H3. + econstructor; split. EvalOp. + intros. subst. simpl in *. rewrite H1 in *. rewrite H2 in *. rewrite H3. inv B1; inv B2; inv B3. simpl in B4. inv B4. simpl. rewrite Int64.decompose_shru_1; auto. destruct x; auto. @@ -658,9 +658,9 @@ Proof. exploit eval_shruimm. eexact A1. instantiate (1 := Int.sub n Int.iwordsize). intros [v2 [A2 B2]]. econstructor; split. EvalOp. destruct x; simpl; auto. - destruct (Int.ltu n Int64.iwordsize'); auto. - simpl in B1; inv B1. simpl in B2. rewrite H1 in B2. inv B2. - simpl. erewrite <- Int64.decompose_shru_2. instantiate (1 := Int64.loword i). + destruct (Int.ltu n Int64.iwordsize'); auto. + simpl in B1; inv B1. simpl in B2. rewrite H1 in B2. inv B2. + simpl. erewrite <- Int64.decompose_shru_2. instantiate (1 := Int64.loword i). rewrite Int64.ofwords_recompose. auto. auto. + (* n >= 64 *) econstructor; split. eapply eval_helper_2; eauto. EvalOp. DeclHelper. UseHelper. auto. @@ -683,8 +683,8 @@ Lemma eval_shrlimm: Proof. unfold shrlimm; red; intros. apply eval_shift_imm; intros. + (* n = 0 *) - subst n. exists x; split; auto. destruct x; simpl; auto. - change (Int64.shr' i Int.zero) with (Int64.shr i Int64.zero). + subst n. exists x; split; auto. destruct x; simpl; auto. + change (Int64.shr' i Int.zero) with (Int64.shr i Int64.zero). rewrite Int64.shr_zero. auto. + (* 0 < n < 32 *) apply eval_splitlong with (sem := fun x => Val.shrl x (Vint n)); auto. @@ -693,8 +693,8 @@ Proof. exploit eval_shrimm. eexact H4. instantiate (1 := n). intros [v2 [A2 B2]]. exploit eval_shlimm. eexact H4. instantiate (1 := Int.sub Int.iwordsize n). intros [v3 [A3 B3]]. exploit eval_or. eexact A1. eexact A3. intros [v4 [A4 B4]]. - econstructor; split. EvalOp. - intros. subst. simpl in *. rewrite H1 in *. rewrite H2 in *. rewrite H3. + econstructor; split. EvalOp. + intros. subst. simpl in *. rewrite H1 in *. rewrite H2 in *. rewrite H3. inv B1; inv B2; inv B3. simpl in B4. inv B4. simpl. rewrite Int64.decompose_shr_1; auto. destruct x; auto. @@ -705,11 +705,11 @@ Proof. exploit eval_shrimm. eexact H2. instantiate (1 := Int.repr 31). intros [v3 [A3 B3]]. econstructor; split. EvalOp. destruct x; simpl; auto. - destruct (Int.ltu n Int64.iwordsize'); auto. + destruct (Int.ltu n Int64.iwordsize'); auto. simpl in B1; inv B1. simpl in B2. rewrite H1 in B2. inv B2. simpl in B3. inv B3. change (Int.ltu (Int.repr 31) Int.iwordsize) with true. simpl. - erewrite <- Int64.decompose_shr_2. instantiate (1 := Int64.loword i). + erewrite <- Int64.decompose_shr_2. instantiate (1 := Int64.loword i). rewrite Int64.ofwords_recompose. auto. auto. + (* n >= 64 *) econstructor; split. eapply eval_helper_2; eauto. EvalOp. DeclHelper. UseHelper. auto. @@ -733,18 +733,18 @@ Proof. assert (DEFAULT: exists v, eval_expr ge sp e m le default v /\ Val.lessdef (Val.addl x y) v). { - econstructor; split. eapply eval_builtin_2; eauto. UseHelper. auto. + econstructor; split. eapply eval_builtin_2; eauto. UseHelper. auto. } destruct (is_longconst a) as [p|] eqn:LC1; destruct (is_longconst b) as [q|] eqn:LC2. -- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. +- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. econstructor; split. apply eval_longconst. simpl; auto. - predSpec Int64.eq Int64.eq_spec p Int64.zero; auto. - subst p. exploit (is_longconst_sound le a); eauto. intros EQ; subst x. + subst p. exploit (is_longconst_sound le a); eauto. intros EQ; subst x. exists y; split; auto. simpl. destruct y; auto. rewrite Int64.add_zero_l; auto. - predSpec Int64.eq Int64.eq_spec q Int64.zero; auto. - subst q. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. + subst q. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. exists x; split; auto. destruct x; simpl; auto. rewrite Int64.add_zero; auto. - auto. Qed. @@ -756,19 +756,19 @@ Proof. assert (DEFAULT: exists v, eval_expr ge sp e m le default v /\ Val.lessdef (Val.subl x y) v). { - econstructor; split. eapply eval_builtin_2; eauto. UseHelper. auto. + econstructor; split. eapply eval_builtin_2; eauto. UseHelper. auto. } destruct (is_longconst a) as [p|] eqn:LC1; destruct (is_longconst b) as [q|] eqn:LC2. -- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. +- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. econstructor; split. apply eval_longconst. simpl; auto. - predSpec Int64.eq Int64.eq_spec p Int64.zero; auto. replace (Val.subl x y) with (Val.negl y). eapply eval_negl; eauto. subst p. exploit (is_longconst_sound le a); eauto. intros EQ; subst x. - destruct y; simpl; auto. + destruct y; simpl; auto. - predSpec Int64.eq Int64.eq_spec q Int64.zero; auto. - subst q. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. + subst q. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. exists x; split; auto. destruct x; simpl; auto. rewrite Int64.sub_zero_l; auto. - auto. Qed. @@ -776,22 +776,22 @@ Qed. Lemma eval_mull_base: binary_constructor_sound mull_base Val.mull. Proof. unfold mull_base; red; intros. apply eval_splitlong2; auto. -- intros. +- intros. set (p := Val.mull' x2 y2). set (le1 := p :: le0). assert (E1: eval_expr ge sp e m le1 (Eop Olowlong (Eletvar O ::: Enil)) (Val.loword p)) by EvalOp. assert (E2: eval_expr ge sp e m le1 (Eop Ohighlong (Eletvar O ::: Enil)) (Val.hiword p)) by EvalOp. - exploit eval_mul. apply eval_lift. eexact H2. apply eval_lift. eexact H3. + exploit eval_mul. apply eval_lift. eexact H2. apply eval_lift. eexact H3. instantiate (1 := p). fold le1. intros [v3 [E3 L3]]. - exploit eval_mul. apply eval_lift. eexact H1. apply eval_lift. eexact H4. + exploit eval_mul. apply eval_lift. eexact H1. apply eval_lift. eexact H4. instantiate (1 := p). fold le1. intros [v4 [E4 L4]]. exploit eval_add. eexact E2. eexact E3. intros [v5 [E5 L5]]. exploit eval_add. eexact E5. eexact E4. intros [v6 [E6 L6]]. exists (Val.longofwords v6 (Val.loword p)); split. - EvalOp. eapply eval_builtin_2; eauto. UseHelper. + EvalOp. eapply eval_builtin_2; eauto. UseHelper. intros. unfold le1, p in *; subst; simpl in *. - inv L3. inv L4. inv L5. simpl in L6. inv L6. - simpl. f_equal. symmetry. apply Int64.decompose_mul. -- destruct x; auto; destruct y; auto. + inv L3. inv L4. inv L5. simpl in L6. inv L6. + simpl. f_equal. symmetry. apply Int64.decompose_mul. +- destruct x; auto; destruct y; auto. Qed. Lemma eval_mullimm: @@ -799,30 +799,30 @@ Lemma eval_mullimm: Proof. unfold mullimm; red; intros. predSpec Int64.eq Int64.eq_spec n Int64.zero. - subst n. econstructor; split. apply eval_longconst. + subst n. econstructor; split. apply eval_longconst. destruct x; simpl; auto. rewrite Int64.mul_zero. auto. predSpec Int64.eq Int64.eq_spec n Int64.one. - subst n. exists x; split; auto. + subst n. exists x; split; auto. destruct x; simpl; auto. rewrite Int64.mul_one. auto. - destruct (Int64.is_power2 n) as [l|] eqn:P2. + destruct (Int64.is_power2 n) as [l|] eqn:P2. exploit eval_shllimm. eauto. instantiate (1 := Int.repr (Int64.unsigned l)). intros [v [A B]]. - exists v; split; auto. - destruct x; simpl; auto. + exists v; split; auto. + destruct x; simpl; auto. erewrite Int64.mul_pow2 by eauto. assert (EQ: Int.unsigned (Int.repr (Int64.unsigned l)) = Int64.unsigned l). { apply Int.unsigned_repr. exploit Int64.is_power2_rng; eauto. - assert (Int64.zwordsize < Int.max_unsigned) by (compute; auto). + assert (Int64.zwordsize < Int.max_unsigned) by (compute; auto). omega. } - simpl in B. + simpl in B. replace (Int.ltu (Int.repr (Int64.unsigned l)) Int64.iwordsize') with (Int64.ltu l Int64.iwordsize) in B. - erewrite Int64.is_power2_range in B by eauto. - unfold Int64.shl' in B. rewrite EQ in B. auto. + erewrite Int64.is_power2_range in B by eauto. + unfold Int64.shl' in B. rewrite EQ in B. auto. unfold Int64.ltu, Int.ltu. rewrite EQ. auto. - apply eval_mull_base; auto. apply eval_longconst. + apply eval_mull_base; auto. apply eval_longconst. Qed. Theorem eval_mull: binary_constructor_sound (mull hf) Val.mull. @@ -830,13 +830,13 @@ Proof. unfold mull; red; intros. destruct (is_longconst a) as [p|] eqn:LC1; destruct (is_longconst b) as [q|] eqn:LC2. -- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. +- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. econstructor; split. apply eval_longconst. simpl; auto. - exploit (is_longconst_sound le a); eauto. intros EQ; subst x. replace (Val.mull (Vlong p) y) with (Val.mull y (Vlong p)) in *. - eapply eval_mullimm; eauto. - destruct y; simpl; auto. rewrite Int64.mul_commut; auto. + eapply eval_mullimm; eauto. + destruct y; simpl; auto. rewrite Int64.mul_commut; auto. - exploit (is_longconst_sound le b); eauto. intros EQ; subst y. eapply eval_mullimm; eauto. - apply eval_mull_base; auto. @@ -851,12 +851,12 @@ Lemma eval_binop_long: eval_expr ge sp e m le b y -> exists v, eval_expr ge sp e m le (binop_long id sem a b) v /\ Val.lessdef z v. Proof. - intros. unfold binop_long. - destruct (is_longconst a) as [p|] eqn:LC1. + intros. unfold binop_long. + destruct (is_longconst a) as [p|] eqn:LC1. destruct (is_longconst b) as [q|] eqn:LC2. exploit is_longconst_sound. eexact LC1. eauto. intros EQ; subst x. exploit is_longconst_sound. eexact LC2. eauto. intros EQ; subst y. - econstructor; split. EvalOp. erewrite H by eauto. rewrite Int64.ofwords_recompose. auto. + econstructor; split. EvalOp. erewrite H by eauto. rewrite Int64.ofwords_recompose. auto. econstructor; split. eapply eval_helper_2; eauto. auto. econstructor; split. eapply eval_helper_2; eauto. auto. Qed. @@ -868,12 +868,12 @@ Theorem eval_divl: Val.divls x y = Some z -> exists v, eval_expr ge sp e m le (divl hf a b) v /\ Val.lessdef z v. Proof. - intros. eapply eval_binop_long; eauto. + intros. eapply eval_binop_long; eauto. intros; subst; simpl in H1. destruct (Int64.eq q Int64.zero - || Int64.eq p (Int64.repr Int64.min_signed) && Int64.eq q Int64.mone); inv H1. + || Int64.eq p (Int64.repr Int64.min_signed) && Int64.eq q Int64.mone); inv H1. auto. - DeclHelper. UseHelper. + DeclHelper. UseHelper. Qed. Theorem eval_modl: @@ -883,10 +883,10 @@ Theorem eval_modl: Val.modls x y = Some z -> exists v, eval_expr ge sp e m le (modl hf a b) v /\ Val.lessdef z v. Proof. - intros. eapply eval_binop_long; eauto. + intros. eapply eval_binop_long; eauto. intros; subst; simpl in H1. destruct (Int64.eq q Int64.zero - || Int64.eq p (Int64.repr Int64.min_signed) && Int64.eq q Int64.mone); inv H1. + || Int64.eq p (Int64.repr Int64.min_signed) && Int64.eq q Int64.mone); inv H1. auto. DeclHelper. UseHelper. Qed. @@ -898,38 +898,38 @@ Theorem eval_divlu: Val.divlu x y = Some z -> exists v, eval_expr ge sp e m le (divlu hf a b) v /\ Val.lessdef z v. Proof. - intros. unfold divlu. + intros. unfold divlu. set (default := Eexternal hf.(i64_udiv) sig_ll_l (a ::: b ::: Enil)). assert (DEFAULT: exists v, eval_expr ge sp e m le default v /\ Val.lessdef z v). { - econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto. + econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto. } destruct (is_longconst a) as [p|] eqn:LC1; destruct (is_longconst b) as [q|] eqn:LC2. -- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. +- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. econstructor; split. apply eval_longconst. - simpl in H1. destruct (Int64.eq q Int64.zero); inv H1. auto. + simpl in H1. destruct (Int64.eq q Int64.zero); inv H1. auto. - auto. - destruct (Int64.is_power2 q) as [l|] eqn:P2; auto. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. replace z with (Val.shrlu x (Vint (Int.repr (Int64.unsigned l)))). apply eval_shrluimm. auto. - destruct x; simpl in H1; try discriminate. - destruct (Int64.eq q Int64.zero); inv H1. - simpl. + destruct x; simpl in H1; try discriminate. + destruct (Int64.eq q Int64.zero); inv H1. + simpl. assert (EQ: Int.unsigned (Int.repr (Int64.unsigned l)) = Int64.unsigned l). { apply Int.unsigned_repr. exploit Int64.is_power2_rng; eauto. - assert (Int64.zwordsize < Int.max_unsigned) by (compute; auto). + assert (Int64.zwordsize < Int.max_unsigned) by (compute; auto). omega. } replace (Int.ltu (Int.repr (Int64.unsigned l)) Int64.iwordsize') with (Int64.ltu l Int64.iwordsize). erewrite Int64.is_power2_range by eauto. - erewrite Int64.divu_pow2 by eauto. - unfold Int64.shru', Int64.shru. rewrite EQ. auto. + erewrite Int64.divu_pow2 by eauto. + unfold Int64.shru', Int64.shru. rewrite EQ. auto. unfold Int64.ltu, Int.ltu. rewrite EQ. auto. - auto. Qed. @@ -941,27 +941,27 @@ Theorem eval_modlu: Val.modlu x y = Some z -> exists v, eval_expr ge sp e m le (modlu hf a b) v /\ Val.lessdef z v. Proof. - intros. unfold modlu. + intros. unfold modlu. set (default := Eexternal hf.(i64_umod) sig_ll_l (a ::: b ::: Enil)). assert (DEFAULT: exists v, eval_expr ge sp e m le default v /\ Val.lessdef z v). { - econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto. + econstructor; split. eapply eval_helper_2; eauto. DeclHelper. UseHelper. auto. } destruct (is_longconst a) as [p|] eqn:LC1; destruct (is_longconst b) as [q|] eqn:LC2. -- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. +- exploit (is_longconst_sound le a); eauto. intros EQ; subst x. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. econstructor; split. apply eval_longconst. - simpl in H1. destruct (Int64.eq q Int64.zero); inv H1. auto. + simpl in H1. destruct (Int64.eq q Int64.zero); inv H1. auto. - auto. - destruct (Int64.is_power2 q) as [l|] eqn:P2; auto. exploit (is_longconst_sound le b); eauto. intros EQ; subst y. replace z with (Val.andl x (Vlong (Int64.sub q Int64.one))). - apply eval_andl. auto. apply eval_longconst. - destruct x; simpl in H1; try discriminate. - destruct (Int64.eq q Int64.zero); inv H1. - simpl. + apply eval_andl. auto. apply eval_longconst. + destruct x; simpl in H1; try discriminate. + destruct (Int64.eq q Int64.zero); inv H1. + simpl. erewrite Int64.modu_and by eauto. auto. - auto. Qed. @@ -970,26 +970,26 @@ Remark decompose_cmpl_eq_zero: forall h l, Int64.eq (Int64.ofwords h l) Int64.zero = Int.eq (Int.or h l) Int.zero. Proof. - intros. + intros. assert (Int64.zwordsize = Int.zwordsize * 2) by reflexivity. predSpec Int64.eq Int64.eq_spec (Int64.ofwords h l) Int64.zero. replace (Int.or h l) with Int.zero. rewrite Int.eq_true. auto. - apply Int.same_bits_eq; intros. - rewrite Int.bits_zero. rewrite Int.bits_or by auto. - symmetry. apply orb_false_intro. + apply Int.same_bits_eq; intros. + rewrite Int.bits_zero. rewrite Int.bits_or by auto. + symmetry. apply orb_false_intro. transitivity (Int64.testbit (Int64.ofwords h l) (i + Int.zwordsize)). rewrite Int64.bits_ofwords by omega. rewrite zlt_false by omega. f_equal; omega. - rewrite H0. apply Int64.bits_zero. + rewrite H0. apply Int64.bits_zero. transitivity (Int64.testbit (Int64.ofwords h l) i). - rewrite Int64.bits_ofwords by omega. rewrite zlt_true by omega. auto. + rewrite Int64.bits_ofwords by omega. rewrite zlt_true by omega. auto. rewrite H0. apply Int64.bits_zero. - symmetry. apply Int.eq_false. red; intros; elim H0. - apply Int64.same_bits_eq; intros. - rewrite Int64.bits_zero. rewrite Int64.bits_ofwords by auto. + symmetry. apply Int.eq_false. red; intros; elim H0. + apply Int64.same_bits_eq; intros. + rewrite Int64.bits_zero. rewrite Int64.bits_ofwords by auto. destruct (zlt i Int.zwordsize). - assert (Int.testbit (Int.or h l) i = false) by (rewrite H1; apply Int.bits_zero). - rewrite Int.bits_or in H3 by omega. exploit orb_false_elim; eauto. tauto. - assert (Int.testbit (Int.or h l) (i - Int.zwordsize) = false) by (rewrite H1; apply Int.bits_zero). + assert (Int.testbit (Int.or h l) i = false) by (rewrite H1; apply Int.bits_zero). + rewrite Int.bits_or in H3 by omega. exploit orb_false_elim; eauto. tauto. + assert (Int.testbit (Int.or h l) (i - Int.zwordsize) = false) by (rewrite H1; apply Int.bits_zero). rewrite Int.bits_or in H3 by omega. exploit orb_false_elim; eauto. tauto. Qed. @@ -998,14 +998,14 @@ Lemma eval_cmpl_eq_zero: eval_expr ge sp e m le a (Vlong x) -> eval_expr ge sp e m le (cmpl_eq_zero a) (Val.of_bool (Int64.eq x Int64.zero)). Proof. - intros. unfold cmpl_eq_zero. + intros. unfold cmpl_eq_zero. eapply eval_splitlong_strict; eauto. intros. exploit eval_or. eexact H0. eexact H1. intros [v1 [A1 B1]]. simpl in B1; inv B1. exploit eval_comp. eexact A1. instantiate (2 := Eop (Ointconst Int.zero) Enil). EvalOp. - instantiate (1 := Ceq). intros [v2 [A2 B2]]. - unfold Val.cmp in B2; simpl in B2. - rewrite <- decompose_cmpl_eq_zero in B2. - rewrite Int64.ofwords_recompose in B2. + instantiate (1 := Ceq). intros [v2 [A2 B2]]. + unfold Val.cmp in B2; simpl in B2. + rewrite <- decompose_cmpl_eq_zero in B2. + rewrite Int64.ofwords_recompose in B2. destruct (Int64.eq x Int64.zero); inv B2; auto. Qed. @@ -1014,14 +1014,14 @@ Lemma eval_cmpl_ne_zero: eval_expr ge sp e m le a (Vlong x) -> eval_expr ge sp e m le (cmpl_ne_zero a) (Val.of_bool (negb (Int64.eq x Int64.zero))). Proof. - intros. unfold cmpl_ne_zero. + intros. unfold cmpl_ne_zero. eapply eval_splitlong_strict; eauto. intros. exploit eval_or. eexact H0. eexact H1. intros [v1 [A1 B1]]. simpl in B1; inv B1. exploit eval_comp. eexact A1. instantiate (2 := Eop (Ointconst Int.zero) Enil). EvalOp. - instantiate (1 := Cne). intros [v2 [A2 B2]]. - unfold Val.cmp in B2; simpl in B2. - rewrite <- decompose_cmpl_eq_zero in B2. - rewrite Int64.ofwords_recompose in B2. + instantiate (1 := Cne). intros [v2 [A2 B2]]. + unfold Val.cmp in B2; simpl in B2. + rewrite <- decompose_cmpl_eq_zero in B2. + rewrite Int64.ofwords_recompose in B2. destruct (negb (Int64.eq x Int64.zero)); inv B2; auto. Qed. @@ -1035,7 +1035,7 @@ Lemma eval_cmplu_gen: else Int.cmpu ch (Int64.hiword x) (Int64.hiword y))). Proof. intros. unfold cmplu_gen. eapply eval_splitlong2_strict; eauto. intros. - econstructor. econstructor. EvalOp. simpl. eauto. + econstructor. econstructor. EvalOp. simpl. eauto. destruct (Int.eq (Int64.hiword x) (Int64.hiword y)); EvalOp. Qed. @@ -1051,34 +1051,34 @@ Proof. Qed. Theorem eval_cmplu: - forall c le a x b y v, + forall c le a x b y v, eval_expr ge sp e m le a x -> eval_expr ge sp e m le b y -> Val.cmplu c x y = Some v -> eval_expr ge sp e m le (cmplu c a b) v. Proof. intros. unfold Val.cmplu in H1. - destruct x; simpl in H1; try discriminate. destruct y; inv H1. + destruct x; simpl in H1; try discriminate. destruct y; inv H1. rename i into x. rename i0 into y. destruct c; simpl. - (* Ceq *) exploit eval_xorl. eexact H. eexact H0. intros [v1 [A B]]. simpl in B. inv B. - rewrite int64_eq_xor. apply eval_cmpl_eq_zero; auto. + rewrite int64_eq_xor. apply eval_cmpl_eq_zero; auto. - (* Cne *) exploit eval_xorl. eexact H. eexact H0. intros [v1 [A B]]. simpl in B. inv B. - rewrite int64_eq_xor. apply eval_cmpl_ne_zero; auto. + rewrite int64_eq_xor. apply eval_cmpl_ne_zero; auto. - (* Clt *) exploit (eval_cmplu_gen Clt Clt). eexact H. eexact H0. simpl. rewrite <- Int64.decompose_ltu. rewrite ! Int64.ofwords_recompose. auto. - (* Cle *) - exploit (eval_cmplu_gen Clt Cle). eexact H. eexact H0. intros. + exploit (eval_cmplu_gen Clt Cle). eexact H. eexact H0. intros. rewrite <- (Int64.ofwords_recompose x). rewrite <- (Int64.ofwords_recompose y). - rewrite Int64.decompose_leu. auto. + rewrite Int64.decompose_leu. auto. - (* Cgt *) exploit (eval_cmplu_gen Cgt Cgt). eexact H. eexact H0. simpl. rewrite Int.eq_sym. rewrite <- Int64.decompose_ltu. rewrite ! Int64.ofwords_recompose. auto. - (* Cge *) - exploit (eval_cmplu_gen Cgt Cge). eexact H. eexact H0. intros. + exploit (eval_cmplu_gen Cgt Cge). eexact H. eexact H0. intros. rewrite <- (Int64.ofwords_recompose x). rewrite <- (Int64.ofwords_recompose y). rewrite Int64.decompose_leu. rewrite Int.eq_sym. auto. Qed. @@ -1093,7 +1093,7 @@ Lemma eval_cmpl_gen: else Int.cmp ch (Int64.hiword x) (Int64.hiword y))). Proof. intros. unfold cmpl_gen. eapply eval_splitlong2_strict; eauto. intros. - econstructor. econstructor. EvalOp. simpl. eauto. + econstructor. econstructor. EvalOp. simpl. eauto. destruct (Int.eq (Int64.hiword x) (Int64.hiword y)); EvalOp. Qed. @@ -1101,29 +1101,29 @@ Remark decompose_cmpl_lt_zero: forall h l, Int64.lt (Int64.ofwords h l) Int64.zero = Int.lt h Int.zero. Proof. - intros. + intros. generalize (Int64.shru_lt_zero (Int64.ofwords h l)). change (Int64.shru (Int64.ofwords h l) (Int64.repr (Int64.zwordsize - 1))) with (Int64.shru' (Int64.ofwords h l) (Int.repr 63)). - rewrite Int64.decompose_shru_2. + rewrite Int64.decompose_shru_2. change (Int.sub (Int.repr 63) Int.iwordsize) - with (Int.repr (Int.zwordsize - 1)). - rewrite Int.shru_lt_zero. + with (Int.repr (Int.zwordsize - 1)). + rewrite Int.shru_lt_zero. destruct (Int64.lt (Int64.ofwords h l) Int64.zero); destruct (Int.lt h Int.zero); auto; intros. - elim Int64.one_not_zero. auto. + elim Int64.one_not_zero. auto. elim Int64.one_not_zero. auto. vm_compute. intuition congruence. Qed. Theorem eval_cmpl: - forall c le a x b y v, + forall c le a x b y v, eval_expr ge sp e m le a x -> eval_expr ge sp e m le b y -> Val.cmpl c x y = Some v -> eval_expr ge sp e m le (cmpl c a b) v. Proof. intros. unfold Val.cmpl in H1. - destruct x; simpl in H1; try discriminate. destruct y; inv H1. + destruct x; simpl in H1; try discriminate. destruct y; inv H1. rename i into x. rename i0 into y. destruct c; simpl. - (* Ceq *) @@ -1135,8 +1135,8 @@ Proof. - (* Clt *) destruct (is_longconst_zero b) eqn:LC. + exploit is_longconst_zero_sound; eauto. intros EQ; inv EQ; clear H0. - exploit eval_highlong. eexact H. intros [v1 [A1 B1]]. simpl in B1. inv B1. - exploit eval_comp. eexact A1. + exploit eval_highlong. eexact H. intros [v1 [A1 B1]]. simpl in B1. inv B1. + exploit eval_comp. eexact A1. instantiate (2 := Eop (Ointconst Int.zero) Enil). EvalOp. instantiate (1 := Clt). intros [v2 [A2 B2]]. unfold Val.cmp in B2. simpl in B2. @@ -1145,9 +1145,9 @@ Proof. + exploit (eval_cmpl_gen Clt Clt). eexact H. eexact H0. simpl. rewrite <- Int64.decompose_lt. rewrite ! Int64.ofwords_recompose. auto. - (* Cle *) - exploit (eval_cmpl_gen Clt Cle). eexact H. eexact H0. intros. + exploit (eval_cmpl_gen Clt Cle). eexact H. eexact H0. intros. rewrite <- (Int64.ofwords_recompose x). rewrite <- (Int64.ofwords_recompose y). - rewrite Int64.decompose_le. auto. + rewrite Int64.decompose_le. auto. - (* Cgt *) exploit (eval_cmpl_gen Cgt Cgt). eexact H. eexact H0. simpl. rewrite Int.eq_sym. rewrite <- Int64.decompose_lt. rewrite ! Int64.ofwords_recompose. auto. @@ -1155,13 +1155,13 @@ Proof. destruct (is_longconst_zero b) eqn:LC. + exploit is_longconst_zero_sound; eauto. intros EQ; inv EQ; clear H0. exploit eval_highlong. eexact H. intros [v1 [A1 B1]]. simpl in B1; inv B1. - exploit eval_comp. eexact A1. + exploit eval_comp. eexact A1. instantiate (2 := Eop (Ointconst Int.zero) Enil). EvalOp. instantiate (1 := Cge). intros [v2 [A2 B2]]. - unfold Val.cmp in B2; simpl in B2. + unfold Val.cmp in B2; simpl in B2. rewrite <- (Int64.ofwords_recompose x). rewrite decompose_cmpl_lt_zero. destruct (negb (Int.lt (Int64.hiword x) Int.zero)); inv B2; auto. -+ exploit (eval_cmpl_gen Cgt Cge). eexact H. eexact H0. intros. ++ exploit (eval_cmpl_gen Cgt Cge). eexact H. eexact H0. intros. rewrite <- (Int64.ofwords_recompose x). rewrite <- (Int64.ofwords_recompose y). rewrite Int64.decompose_le. rewrite Int.eq_sym. auto. Qed. diff --git a/backend/Selection.v b/backend/Selection.v index dea8a008..dcefdd1c 100644 --- a/backend/Selection.v +++ b/backend/Selection.v @@ -83,10 +83,10 @@ Definition sel_constant (cst: Cminor.constant) : expr := Definition sel_unop (op: Cminor.unary_operation) (arg: expr) : expr := match op with - | Cminor.Ocast8unsigned => cast8unsigned arg - | Cminor.Ocast8signed => cast8signed arg - | Cminor.Ocast16unsigned => cast16unsigned arg - | Cminor.Ocast16signed => cast16signed arg + | Cminor.Ocast8unsigned => cast8unsigned arg + | Cminor.Ocast8signed => cast8signed arg + | Cminor.Ocast16unsigned => cast16unsigned arg + | Cminor.Ocast16signed => cast16signed arg | Cminor.Onegint => negint arg | Cminor.Onotint => notint arg | Cminor.Onegf => negf arg @@ -295,7 +295,7 @@ Fixpoint sel_stmt (ge: Cminor.genv) (s: Cminor.stmt) : res stmt := | Cminor.Sbuiltin optid ef args => OK (Sbuiltin (sel_builtin_res optid) ef (sel_builtin_args args (Machregs.builtin_constraints ef))) - | Cminor.Stailcall sg fn args => + | Cminor.Stailcall sg fn args => OK (match classify_call ge fn with | Call_imm id => Stailcall sg (inr _ id) (sel_exprlist args) | _ => Stailcall sg (inl _ (sel_expr fn)) (sel_exprlist args) @@ -362,7 +362,7 @@ Definition globdef_of_interest (gd: globdef) : bool := Definition record_globdef (globs: PTree.t globdef) (id_gd: ident * globdef) := let (id, gd) := id_gd in - if globdef_of_interest gd + if globdef_of_interest gd then PTree.set id gd globs else PTree.remove id globs. diff --git a/backend/Selectionproof.v b/backend/Selectionproof.v index 8ea4c56e..8051df59 100644 --- a/backend/Selectionproof.v +++ b/backend/Selectionproof.v @@ -53,20 +53,20 @@ Hypothesis TRANSFPROG: transform_partial_program (sel_fundef hf ge) prog = OK tp Lemma symbols_preserved: forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s. Proof. - intros. eapply Genv.find_symbol_transf_partial; eauto. + intros. eapply Genv.find_symbol_transf_partial; eauto. Qed. Lemma public_preserved: forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s. Proof. - intros. eapply Genv.public_symbol_transf_partial; eauto. + intros. eapply Genv.public_symbol_transf_partial; eauto. Qed. Lemma function_ptr_translated: forall (b: block) (f: Cminor.fundef), Genv.find_funct_ptr ge b = Some f -> exists tf, Genv.find_funct_ptr tge b = Some tf /\ sel_fundef hf ge f = OK tf. -Proof. +Proof. intros. eapply Genv.find_funct_ptr_transf_partial; eauto. Qed. @@ -75,7 +75,7 @@ Lemma functions_translated: Genv.find_funct ge v = Some f -> Val.lessdef v v' -> exists tf, Genv.find_funct tge v' = Some tf /\ sel_fundef hf ge f = OK tf. -Proof. +Proof. intros. inv H0. eapply Genv.find_funct_transf_partial; eauto. simpl in H. discriminate. @@ -84,13 +84,13 @@ Qed. Lemma sig_function_translated: forall f tf, sel_fundef hf ge f = OK tf -> funsig tf = Cminor.funsig f. Proof. - intros. destruct f; monadInv H; auto. monadInv EQ. auto. + intros. destruct f; monadInv H; auto. monadInv EQ. auto. Qed. Lemma stackspace_function_translated: forall f tf, sel_function hf ge f = OK tf -> fn_stackspace tf = Cminor.fn_stackspace f. Proof. - intros. monadInv H. auto. + intros. monadInv H. auto. Qed. Lemma varinfo_preserved: @@ -103,14 +103,14 @@ Lemma helper_declared_preserved: forall id name sg, helper_declared ge id name sg -> helper_declared tge id name sg. Proof. intros id name sg (b & A & B). - exploit function_ptr_translated; eauto. simpl. intros (tf & P & Q). inv Q. + exploit function_ptr_translated; eauto. simpl. intros (tf & P & Q). inv Q. exists b; split; auto. rewrite symbols_preserved. auto. Qed. Let HELPERS': helper_functions_declared tge hf. Proof. red in HELPERS; decompose [Logic.and] HELPERS. - red. auto 20 using helper_declared_preserved. + red. auto 20 using helper_declared_preserved. Qed. Section CMCONSTR. @@ -127,15 +127,15 @@ Lemma eval_condexpr_of_expr: Proof. intros until a. functional induction (condexpr_of_expr a); intros. (* compare *) - inv H. econstructor; eauto. + inv H. econstructor; eauto. simpl in H6. inv H6. apply Val.bool_of_val_of_optbool. auto. (* condition *) inv H. econstructor; eauto. destruct va; eauto. (* let *) inv H. econstructor; eauto. (* default *) - econstructor. constructor. eauto. constructor. - simpl. inv H0. auto. + econstructor. constructor. eauto. constructor. + simpl. inv H0. auto. Qed. Lemma eval_load: @@ -145,10 +145,10 @@ Lemma eval_load: eval_expr tge sp e m le (load chunk a) v'. Proof. intros. generalize H0; destruct v; simpl; intro; try discriminate. - unfold load. + unfold load. generalize (eval_addressing _ _ _ _ _ chunk _ _ _ _ H (refl_equal _)). - destruct (addressing chunk a). intros [vl [EV EQ]]. - eapply eval_Eload; eauto. + destruct (addressing chunk a). intros [vl [EV EQ]]. + eapply eval_Eload; eauto. Qed. Lemma eval_store: @@ -162,8 +162,8 @@ Proof. intros. generalize H1; destruct v1; simpl; intro; try discriminate. unfold store. generalize (eval_addressing _ _ _ _ _ chunk _ _ _ _ H (refl_equal _)). - destruct (addressing chunk a1). intros [vl [EV EQ]]. - eapply step_store; eauto. + destruct (addressing chunk a1). intros [vl [EV EQ]]. + eapply step_store; eauto. Qed. (** Correctness of instruction selection for operators *) @@ -269,7 +269,7 @@ Lemma expr_is_addrof_ident_correct: expr_is_addrof_ident e = Some id -> e = Cminor.Econst (Cminor.Oaddrsymbol id Int.zero). Proof. - intros e id. unfold expr_is_addrof_ident. + intros e id. unfold expr_is_addrof_ident. destruct e; try congruence. destruct c; try congruence. predSpec Int.eq Int.eq_spec i0 Int.zero; congruence. @@ -285,14 +285,14 @@ Lemma classify_call_correct: | Call_builtin ef => fd = External ef end. Proof. - unfold classify_call; intros. - destruct (expr_is_addrof_ident a) as [id|] eqn:?. + unfold classify_call; intros. + destruct (expr_is_addrof_ident a) as [id|] eqn:?. exploit expr_is_addrof_ident_correct; eauto. intros EQ; subst a. - inv H. inv H2. - destruct (Genv.find_symbol ge id) as [b|] eqn:?. - rewrite Genv.find_funct_find_funct_ptr in H0. - rewrite H0. - destruct fd. exists b; auto. + inv H. inv H2. + destruct (Genv.find_symbol ge id) as [b|] eqn:?. + rewrite Genv.find_funct_find_funct_ptr in H0. + rewrite H0. + destruct fd. exists b; auto. destruct (ef_inline e0). auto. exists b; auto. simpl in H0. discriminate. auto. @@ -344,18 +344,18 @@ Proof. inv WF. assert (eval_expr tge sp e m le (make_cmp_eq (Eletvar arg) key) (Val.of_bool (zeq i key))). { eapply eval_make_cmp_eq; eauto. constructor; auto. } - eapply eval_XEcondition with (va := zeq i key). - eapply eval_condexpr_of_expr; eauto. destruct (zeq i key); constructor; auto. - destruct (zeq i key); simpl. + eapply eval_XEcondition with (va := zeq i key). + eapply eval_condexpr_of_expr; eauto. destruct (zeq i key); constructor; auto. + destruct (zeq i key); simpl. + inv MATCH. constructor. + eapply IHt; eauto. - (* lt test *) inv WF. assert (eval_expr tge sp e m le (make_cmp_ltu (Eletvar arg) key) (Val.of_bool (zlt i key))). { eapply eval_make_cmp_ltu; eauto. constructor; auto. } - eapply eval_XEcondition with (va := zlt i key). - eapply eval_condexpr_of_expr; eauto. destruct (zlt i key); constructor; auto. - destruct (zlt i key); simpl. + eapply eval_XEcondition with (va := zlt i key). + eapply eval_condexpr_of_expr; eauto. destruct (zlt i key); constructor; auto. + destruct (zlt i key); simpl. + eapply IHt1; eauto. + eapply IHt2; eauto. - (* jump table *) @@ -366,13 +366,13 @@ Proof. set (i' := (i - ofs) mod modulus) in *. assert (eval_expr tge sp e m (v' :: le) (make_cmp_ltu (Eletvar O) sz) (Val.of_bool (zlt i' sz))). { eapply eval_make_cmp_ltu; eauto. constructor; auto. } - econstructor. eauto. + econstructor. eauto. eapply eval_XEcondition with (va := zlt i' sz). eapply eval_condexpr_of_expr; eauto. destruct (zlt i' sz); constructor; auto. destruct (zlt i' sz); simpl. + exploit (eval_make_to_int sp e m (v' :: le) (Eletvar O)). - constructor. simpl; eauto. eauto. intros (v'' & C & D). inv D. - econstructor; eauto. congruence. + constructor. simpl; eauto. eauto. intros (v'' & C & D). inv D. + econstructor; eauto. congruence. + eapply IHt; eauto. Qed. @@ -398,37 +398,37 @@ Lemma sel_switch_int_correct: eval_expr tge sp e m le arg (Vint i) -> eval_exitexpr tge sp e m le (XElet arg (sel_switch_int O t)) (switch_target (Int.unsigned i) dfl cases). Proof. - assert (INTCONST: forall n sp e m le, + assert (INTCONST: forall n sp e m le, eval_expr tge sp e m le (Eop (Ointconst n) Enil) (Vint n)). - { intros. econstructor. constructor. auto. } + { intros. econstructor. constructor. auto. } intros. eapply sel_switch_correct with (R := Rint); eauto. - intros until n; intros EVAL R RANGE. - exploit eval_comp. eexact EVAL. apply (INTCONST (Int.repr n)). - instantiate (1 := Ceq). intros (vb & A & B). - inv R. unfold Val.cmp in B. simpl in B. revert B. - predSpec Int.eq Int.eq_spec n0 (Int.repr n); intros B; inv B. - rewrite Int.unsigned_repr. unfold proj_sumbool; rewrite zeq_true; auto. + exploit eval_comp. eexact EVAL. apply (INTCONST (Int.repr n)). + instantiate (1 := Ceq). intros (vb & A & B). + inv R. unfold Val.cmp in B. simpl in B. revert B. + predSpec Int.eq Int.eq_spec n0 (Int.repr n); intros B; inv B. + rewrite Int.unsigned_repr. unfold proj_sumbool; rewrite zeq_true; auto. unfold Int.max_unsigned; omega. unfold proj_sumbool; rewrite zeq_false; auto. red; intros; elim H1. rewrite <- (Int.repr_unsigned n0). congruence. - intros until n; intros EVAL R RANGE. - exploit eval_compu. eexact EVAL. apply (INTCONST (Int.repr n)). - instantiate (1 := Clt). intros (vb & A & B). + exploit eval_compu. eexact EVAL. apply (INTCONST (Int.repr n)). + instantiate (1 := Clt). intros (vb & A & B). inv R. unfold Val.cmpu in B. simpl in B. - unfold Int.ltu in B. rewrite Int.unsigned_repr in B. - destruct (zlt (Int.unsigned n0) n); inv B; auto. + unfold Int.ltu in B. rewrite Int.unsigned_repr in B. + destruct (zlt (Int.unsigned n0) n); inv B; auto. unfold Int.max_unsigned; omega. - intros until n; intros EVAL R RANGE. exploit eval_sub. eexact EVAL. apply (INTCONST (Int.repr n)). intros (vb & A & B). - inv R. simpl in B. inv B. econstructor; split; eauto. + inv R. simpl in B. inv B. econstructor; split; eauto. replace ((Int.unsigned n0 - n) mod Int.modulus) with (Int.unsigned (Int.sub n0 (Int.repr n))). constructor. - unfold Int.sub. rewrite Int.unsigned_repr_eq. f_equal. f_equal. + unfold Int.sub. rewrite Int.unsigned_repr_eq. f_equal. f_equal. apply Int.unsigned_repr. unfold Int.max_unsigned; omega. -- intros until i0; intros EVAL R. exists v; split; auto. +- intros until i0; intros EVAL R. exists v; split; auto. inv R. rewrite Zmod_small by (apply Int.unsigned_range). constructor. -- constructor. +- constructor. - apply Int.unsigned_range. Qed. @@ -441,30 +441,30 @@ Proof. intros. eapply sel_switch_correct with (R := Rlong); eauto. - intros until n; intros EVAL R RANGE. eapply eval_cmpl. eexact EVAL. apply eval_longconst with (n := Int64.repr n). - inv R. unfold Val.cmpl. simpl. f_equal; f_equal. unfold Int64.eq. - rewrite Int64.unsigned_repr. destruct (zeq (Int64.unsigned n0) n); auto. + inv R. unfold Val.cmpl. simpl. f_equal; f_equal. unfold Int64.eq. + rewrite Int64.unsigned_repr. destruct (zeq (Int64.unsigned n0) n); auto. unfold Int64.max_unsigned; omega. -- intros until n; intros EVAL R RANGE. +- intros until n; intros EVAL R RANGE. eapply eval_cmplu. eexact EVAL. apply eval_longconst with (n := Int64.repr n). - inv R. unfold Val.cmplu. simpl. f_equal; f_equal. unfold Int64.ltu. - rewrite Int64.unsigned_repr. destruct (zlt (Int64.unsigned n0) n); auto. + inv R. unfold Val.cmplu. simpl. f_equal; f_equal. unfold Int64.ltu. + rewrite Int64.unsigned_repr. destruct (zlt (Int64.unsigned n0) n); auto. unfold Int64.max_unsigned; omega. - intros until n; intros EVAL R RANGE. exploit eval_subl. eexact EVAL. apply eval_longconst with (n := Int64.repr n). intros (vb & A & B). - inv R. simpl in B. inv B. econstructor; split; eauto. + inv R. simpl in B. inv B. econstructor; split; eauto. replace ((Int64.unsigned n0 - n) mod Int64.modulus) with (Int64.unsigned (Int64.sub n0 (Int64.repr n))). constructor. - unfold Int64.sub. rewrite Int64.unsigned_repr_eq. f_equal. f_equal. + unfold Int64.sub. rewrite Int64.unsigned_repr_eq. f_equal. f_equal. apply Int64.unsigned_repr. unfold Int64.max_unsigned; omega. -- intros until i0; intros EVAL R. - exploit eval_lowlong. eexact EVAL. intros (vb & A & B). +- intros until i0; intros EVAL R. + exploit eval_lowlong. eexact EVAL. intros (vb & A & B). inv R. simpl in B. inv B. econstructor; split; eauto. replace (Int64.unsigned n mod Int.modulus) with (Int.unsigned (Int64.loword n)). constructor. - unfold Int64.loword. apply Int.unsigned_repr_eq. -- constructor. + unfold Int64.loword. apply Int.unsigned_repr_eq. +- constructor. - apply Int64.unsigned_range. Qed. @@ -481,24 +481,24 @@ Lemma eval_unop_lessdef: eval_unop op v1 = Some v -> Val.lessdef v1 v1' -> exists v', eval_unop op v1' = Some v' /\ Val.lessdef v v'. Proof. - intros until v; intros EV LD. inv LD. + intros until v; intros EV LD. inv LD. exists v; auto. destruct op; simpl in *; inv EV; TrivialExists. Qed. Lemma eval_binop_lessdef: forall op v1 v1' v2 v2' v m m', - eval_binop op v1 v2 m = Some v -> + eval_binop op v1 v2 m = Some v -> Val.lessdef v1 v1' -> Val.lessdef v2 v2' -> Mem.extends m m' -> exists v', eval_binop op v1' v2' m' = Some v' /\ Val.lessdef v v'. Proof. intros until m'; intros EV LD1 LD2 ME. assert (exists v', eval_binop op v1' v2' m = Some v' /\ Val.lessdef v v'). - inv LD1. inv LD2. exists v; auto. + inv LD1. inv LD2. exists v; auto. destruct op; destruct v1'; simpl in *; inv EV; TrivialExists. destruct op; simpl in *; inv EV; TrivialExists. - destruct op; try (exact H). - simpl in *. TrivialExists. inv EV. apply Val.of_optbool_lessdef. + destruct op; try (exact H). + simpl in *. TrivialExists. inv EV. apply Val.of_optbool_lessdef. intros. apply Val.cmpu_bool_lessdef with (Mem.valid_pointer m) v1 v2; auto. intros; eapply Mem.valid_pointer_extends; eauto. Qed. @@ -529,7 +529,7 @@ Proof. Qed. Lemma set_params_lessdef: - forall il vl1 vl2, + forall il vl1 vl2, Val.lessdef_list vl1 vl2 -> env_lessdef (set_params vl1 il) (set_params vl2 il). Proof. @@ -558,10 +558,10 @@ Proof. (* Evar *) exploit H0; eauto. intros [v' [A B]]. exists v'; split; auto. constructor; auto. (* Econst *) - destruct cst; simpl in *; inv H. - exists (Vint i); split; auto. econstructor. constructor. auto. + destruct cst; simpl in *; inv H. + exists (Vint i); split; auto. econstructor. constructor. auto. exists (Vfloat f); split; auto. econstructor. constructor. auto. - exists (Vsingle f); split; auto. econstructor. constructor. auto. + exists (Vsingle f); split; auto. econstructor. constructor. auto. exists (Val.longofwords (Vint (Int64.hiword i)) (Vint (Int64.loword i))); split. eapply eval_Eop. constructor. EvalOp. simpl; eauto. constructor. EvalOp. simpl; eauto. constructor. auto. simpl. rewrite Int64.ofwords_recompose. auto. @@ -571,13 +571,13 @@ Proof. exploit IHeval_expr; eauto. intros [v1' [A B]]. exploit eval_unop_lessdef; eauto. intros [v' [C D]]. exploit eval_sel_unop; eauto. intros [v'' [E F]]. - exists v''; split; eauto. eapply Val.lessdef_trans; eauto. + exists v''; split; eauto. eapply Val.lessdef_trans; eauto. (* Ebinop *) exploit IHeval_expr1; eauto. intros [v1' [A B]]. exploit IHeval_expr2; eauto. intros [v2' [C D]]. exploit eval_binop_lessdef; eauto. intros [v' [E F]]. exploit eval_sel_binop. eexact A. eexact C. eauto. intros [v'' [P Q]]. - exists v''; split; eauto. eapply Val.lessdef_trans; eauto. + exists v''; split; eauto. eapply Val.lessdef_trans; eauto. (* Eload *) exploit IHeval_expr; eauto. intros [vaddr' [A B]]. exploit Mem.loadv_extends; eauto. intros [v' [C D]]. @@ -591,7 +591,7 @@ Lemma sel_exprlist_correct: env_lessdef e e' -> Mem.extends m m' -> exists v', eval_exprlist tge sp e' m' le (sel_exprlist hf a) v' /\ Val.lessdef_list v v'. Proof. - induction 1; intros; simpl. + induction 1; intros; simpl. exists (@nil val); split; auto. constructor. exploit sel_expr_correct; eauto. intros [v1' [A B]]. exploit IHeval_exprlist; eauto. intros [vl' [C D]]. @@ -606,7 +606,7 @@ Lemma sel_builtin_arg_correct: CminorSel.eval_builtin_arg tge sp e' m' (sel_builtin_arg hf a c) v' /\ Val.lessdef v v'. Proof. - intros. unfold sel_builtin_arg. + intros. unfold sel_builtin_arg. exploit sel_expr_correct; eauto. intros (v1 & A & B). exists v1; split; auto. destruct (builtin_arg_ok (builtin_arg (sel_expr hf a)) c). @@ -627,7 +627,7 @@ Lemma sel_builtin_args_correct: /\ Val.lessdef_list vl vl'. Proof. induction 3; intros; simpl. -- exists (@nil val); split; constructor. +- exists (@nil val); split; constructor. - exploit sel_builtin_arg_correct; eauto. intros (v1' & A & B). edestruct IHeval_exprlist as (vl' & C & D). exists (v1' :: vl'); split; auto. constructor; eauto. @@ -638,7 +638,7 @@ Lemma sel_builtin_res_correct: env_lessdef e e' -> Val.lessdef v v' -> env_lessdef (set_optvar oid v e) (set_builtin_res (sel_builtin_res oid) v' e'). Proof. - intros. destruct oid; simpl; auto. apply set_var_lessdef; auto. + intros. destruct oid; simpl; auto. apply set_var_lessdef; auto. Qed. (** Semantic preservation for functions and statements. *) @@ -727,12 +727,12 @@ Proof. (* tailcall *) destruct (classify_call ge e); simpl; auto. (* seq *) - exploit (IHs1 (Cminor.Kseq s2 k)). constructor; eauto. eauto. + exploit (IHs1 (Cminor.Kseq s2 k)). constructor; eauto. eauto. destruct (Cminor.find_label lbl s1 (Cminor.Kseq s2 k)) as [[sx kx] | ]; destruct (find_label lbl x (Kseq x0 k')) as [[sy ky] | ]; intuition. apply IHs2; auto. (* ifthenelse *) - exploit (IHs1 k); eauto. + exploit (IHs1 k); eauto. destruct (Cminor.find_label lbl s1 k) as [[sx kx] | ]; destruct (find_label lbl x k') as [[sy ky] | ]; intuition. apply IHs2; auto. @@ -741,7 +741,7 @@ Proof. (* block *) apply IHs. constructor; auto. auto. (* switch *) - destruct b. + destruct b. destruct (validate_switch Int64.modulus n l (compile_switch Int64.modulus n l)); inv SE. simpl; auto. destruct (validate_switch Int.modulus n l (compile_switch Int.modulus n l)); inv SE. @@ -772,10 +772,10 @@ Proof. inv MC. left; econstructor; split. econstructor. constructor; auto. - (* skip call *) exploit Mem.free_parallel_extends; eauto. intros [m2' [A B]]. - left; econstructor; split. - econstructor. inv MC; simpl in H; simpl; auto. - eauto. - erewrite stackspace_function_translated; eauto. + left; econstructor; split. + econstructor. inv MC; simpl in H; simpl; auto. + eauto. + erewrite stackspace_function_translated; eauto. constructor; auto. - (* assign *) exploit sel_expr_correct; eauto. intros [v' [A B]]. @@ -790,18 +790,18 @@ Proof. eapply eval_store; eauto. constructor; auto. - (* Scall *) - exploit classify_call_correct; eauto. + exploit classify_call_correct; eauto. destruct (classify_call ge a) as [ | id | ef]. + (* indirect *) exploit sel_expr_correct; eauto. intros [vf' [A B]]. exploit sel_exprlist_correct; eauto. intros [vargs' [C D]]. exploit functions_translated; eauto. intros (fd' & U & V). left; econstructor; split. - econstructor; eauto. econstructor; eauto. + econstructor; eauto. econstructor; eauto. apply sig_function_translated; auto. constructor; auto. constructor; auto. + (* direct *) - intros [b [U V]]. + intros [b [U V]]. exploit sel_exprlist_correct; eauto. intros [vargs' [C D]]. exploit functions_translated; eauto. intros (fd' & X & Y). left; econstructor; split. @@ -812,7 +812,7 @@ Proof. + (* turned into Sbuiltin *) intros EQ. subst fd. exploit sel_builtin_args_correct; eauto. intros [vargs' [C D]]. - right; split. simpl. omega. split. auto. + right; split. simpl. omega. split. auto. econstructor; eauto. - (* Stailcall *) exploit Mem.free_parallel_extends; eauto. intros [m2' [P Q]]. @@ -821,21 +821,21 @@ Proof. exploit sel_exprlist_correct; eauto. intros [vargs' [C D]]. exploit functions_translated; eauto. intros [fd' [E F]]. left; econstructor; split. - exploit classify_call_correct; eauto. - destruct (classify_call ge a) as [ | id | ef]; intros. + exploit classify_call_correct; eauto. + destruct (classify_call ge a) as [ | id | ef]; intros. econstructor; eauto. econstructor; eauto. apply sig_function_translated; auto. - destruct H2 as [b [U V]]. subst vf. inv B. + destruct H2 as [b [U V]]. subst vf. inv B. econstructor; eauto. econstructor; eauto. rewrite symbols_preserved; eauto. apply sig_function_translated; auto. econstructor; eauto. econstructor; eauto. apply sig_function_translated; auto. constructor; auto. apply call_cont_commut; auto. - (* Sbuiltin *) exploit sel_builtin_args_correct; eauto. intros [vargs' [P Q]]. - exploit external_call_mem_extends; eauto. + exploit external_call_mem_extends; eauto. intros [vres' [m2 [A [B [C D]]]]]. left; econstructor; split. econstructor. eauto. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. - constructor; auto. apply sel_builtin_res_correct; auto. + constructor; auto. apply sel_builtin_res_correct; auto. - (* Seq *) left; econstructor; split. constructor. constructor; auto. constructor; auto. @@ -843,7 +843,7 @@ Proof. exploit sel_expr_correct; eauto. intros [v' [A B]]. assert (Val.bool_of_val v' b). inv B. auto. inv H0. left; exists (State f' (if b then x else x0) k' sp e' m'); split. - econstructor; eauto. eapply eval_condexpr_of_expr; eauto. + econstructor; eauto. eapply eval_condexpr_of_expr; eauto. constructor; auto. destruct b; auto. - (* Sloop *) left; econstructor; split. constructor. constructor; auto. @@ -861,26 +861,26 @@ Proof. + set (ct := compile_switch Int.modulus default cases) in *. destruct (validate_switch Int.modulus default cases ct) eqn:VALID; inv TS. exploit sel_expr_correct; eauto. intros [v' [A B]]. inv B. - left; econstructor; split. - econstructor. eapply sel_switch_int_correct; eauto. + left; econstructor; split. + econstructor. eapply sel_switch_int_correct; eauto. constructor; auto. + set (ct := compile_switch Int64.modulus default cases) in *. destruct (validate_switch Int64.modulus default cases ct) eqn:VALID; inv TS. exploit sel_expr_correct; eauto. intros [v' [A B]]. inv B. left; econstructor; split. - econstructor. eapply sel_switch_long_correct; eauto. + econstructor. eapply sel_switch_long_correct; eauto. constructor; auto. - (* Sreturn None *) exploit Mem.free_parallel_extends; eauto. intros [m2' [P Q]]. erewrite <- stackspace_function_translated in P by eauto. - left; econstructor; split. - econstructor. simpl; eauto. + left; econstructor; split. + econstructor. simpl; eauto. constructor; auto. apply call_cont_commut; auto. - (* Sreturn Some *) exploit Mem.free_parallel_extends; eauto. intros [m2' [P Q]]. erewrite <- stackspace_function_translated in P by eauto. exploit sel_expr_correct; eauto. intros [v' [A B]]. - left; econstructor; split. + left; econstructor; split. econstructor; eauto. constructor; auto. apply call_cont_commut; auto. - (* Slabel *) @@ -890,39 +890,39 @@ Proof. { monadInv TF; simpl; auto. } exploit (find_label_commut lbl (Cminor.fn_body f) (Cminor.call_cont k)). apply call_cont_commut; eauto. eauto. - rewrite H. + rewrite H. destruct (find_label lbl (fn_body f') (call_cont k'0)) as [[s'' k'']|] eqn:?; intros; try contradiction. - destruct H1. + destruct H1. left; econstructor; split. - econstructor; eauto. + econstructor; eauto. constructor; auto. - (* internal function *) monadInv TF. generalize EQ; intros TF; monadInv TF. - exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. + exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. intros [m2' [A B]]. left; econstructor; split. econstructor; simpl; eauto. constructor; simpl; auto. apply set_locals_lessdef. apply set_params_lessdef; auto. - (* external call *) monadInv TF. - exploit external_call_mem_extends; eauto. + exploit external_call_mem_extends; eauto. intros [vres' [m2 [A [B [C D]]]]]. left; econstructor; split. econstructor. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. constructor; auto. - (* external call turned into a Sbuiltin *) - exploit external_call_mem_extends; eauto. + exploit external_call_mem_extends; eauto. intros [vres' [m2 [A [B [C D]]]]]. left; econstructor; split. econstructor. eauto. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. constructor; auto. - (* return *) - inv MC. - left; econstructor; split. - econstructor. + inv MC. + left; econstructor; split. + econstructor. constructor; auto. destruct optid; simpl; auto. apply set_var_lessdef; auto. - (* return of an external call turned into a Sbuiltin *) right; split. simpl; omega. split. auto. constructor; auto. @@ -975,20 +975,20 @@ Proof. - auto. - apply IHgl. red. destruct a as [id1 gd1]; simpl; intros. unfold Genv.find_symbol; simpl. rewrite PTree.gsspec. destruct (peq id id1). - + subst id1. exists (Genv.genv_next ge); split; auto. + + subst id1. exists (Genv.genv_next ge); split; auto. replace gd1 with (@Gfun Cminor.fundef unit fd). - unfold Genv.find_funct_ptr; simpl. apply PTree.gss. + unfold Genv.find_funct_ptr; simpl. apply PTree.gss. destruct (globdef_of_interest gd1). rewrite PTree.gss in H0; congruence. rewrite PTree.grs in H0; congruence. + assert (m!id = Some (Gfun fd)). - { destruct (globdef_of_interest gd1). + { destruct (globdef_of_interest gd1). rewrite PTree.gso in H0; auto. rewrite PTree.gro in H0; auto. } exploit H; eauto. intros (b & A & B). exists b; split; auto. unfold Genv.find_funct_ptr; simpl. - destruct gd1; auto. rewrite PTree.gso; auto. - apply Plt_ne. eapply Genv.genv_symb_range; eauto. + destruct gd1; auto. rewrite PTree.gso; auto. + apply Plt_ne. eapply Genv.genv_symb_range; eauto. } eapply REC. red; intros. rewrite PTree.gempty in H; discriminate. Qed. @@ -1002,19 +1002,19 @@ Proof. set (P := fun (m: PTree.t globdef) res => res = Some id -> m!id = Some(Gfun(External (EF_external name sg)))). assert (P globs (PTree.fold (lookup_helper_aux name sg) globs None)). { apply PTree_Properties.fold_rec; red; intros. - - rewrite <- H0. apply H1; auto. + - rewrite <- H0. apply H1; auto. - discriminate. - assert (EITHER: k = id /\ v = Gfun (External (EF_external name sg)) \/ a = Some id). - { unfold lookup_helper_aux in H3. destruct v; auto. destruct f; auto. destruct e; auto. + { unfold lookup_helper_aux in H3. destruct v; auto. destruct f; auto. destruct e; auto. destruct (String.string_dec name name0); auto. destruct (signature_eq sg sg0); auto. inversion H3. left; split; auto. repeat f_equal; auto. } destruct EITHER as [[X Y] | X]. - subst k v. apply PTree.gss. + subst k v. apply PTree.gss. apply H2 in X. rewrite PTree.gso by congruence. auto. } - red in H0. unfold lookup_helper in H. + red in H0. unfold lookup_helper in H. destruct (PTree.fold (lookup_helper_aux name sg) globs None); inv H. auto. Qed. @@ -1040,11 +1040,11 @@ Theorem transf_program_correct: sel_program prog = OK tprog -> forward_simulation (Cminor.semantics prog) (CminorSel.semantics tprog). Proof. - intros. unfold sel_program in H. + intros. unfold sel_program in H. destruct (get_helpers prog) as [hf|] eqn:G; simpl in H; try discriminate. - apply forward_simulation_opt with (match_states := match_states prog tprog hf) (measure := measure). + apply forward_simulation_opt with (match_states := match_states prog tprog hf) (measure := measure). eapply public_preserved; eauto. apply sel_initial_states; auto. apply sel_final_states; auto. - apply sel_step_correct; auto. eapply get_helpers_correct; eauto. + apply sel_step_correct; auto. eapply get_helpers_correct; eauto. Qed. diff --git a/backend/Splitting.ml b/backend/Splitting.ml index 97b26a50..17b8098d 100644 --- a/backend/Splitting.ml +++ b/backend/Splitting.ml @@ -39,9 +39,9 @@ let rec repr lr = | Link lr' -> let lr'' = repr lr' in lr.kind <- Link lr''; lr'' | _ -> lr -let same_range lr1 lr2 = - lr1 == lr2 || (* quick test for speed *) - repr lr1 == repr lr2 (* the real test *) +let same_range lr1 lr2 = + lr1 == lr2 || (* quick test for speed *) + repr lr1 == repr lr2 (* the real test *) let unify lr1 lr2 = let lr1 = repr lr1 and lr2 = repr lr2 in diff --git a/backend/Stacking.v b/backend/Stacking.v index ef96e4b3..ab67e213 100644 --- a/backend/Stacking.v +++ b/backend/Stacking.v @@ -71,13 +71,13 @@ Definition save_callee_save_regs List.fold_right (save_callee_save_reg bound number mkindex ty fe) k csl. Definition save_callee_save_int (fe: frame_env) := - save_callee_save_regs + save_callee_save_regs fe_num_int_callee_save index_int_callee_save FI_saved_int Tany32 fe int_callee_save_regs. Definition save_callee_save_float (fe: frame_env) := save_callee_save_regs - fe_num_float_callee_save index_float_callee_save FI_saved_float + fe_num_float_callee_save index_float_callee_save FI_saved_float Tany64 fe float_callee_save_regs. Definition save_callee_save (fe: frame_env) (k: Mach.code) := @@ -101,13 +101,13 @@ Definition restore_callee_save_regs List.fold_right (restore_callee_save_reg bound number mkindex ty fe) k csl. Definition restore_callee_save_int (fe: frame_env) := - restore_callee_save_regs + restore_callee_save_regs fe_num_int_callee_save index_int_callee_save FI_saved_int Tany32 fe int_callee_save_regs. Definition restore_callee_save_float (fe: frame_env) := restore_callee_save_regs - fe_num_float_callee_save index_float_callee_save FI_saved_float + fe_num_float_callee_save index_float_callee_save FI_saved_float Tany64 fe float_callee_save_regs. Definition restore_callee_save (fe: frame_env) (k: Mach.code) := @@ -146,7 +146,7 @@ Fixpoint transl_builtin_arg (fe: frame_env) (a: builtin_arg loc) : builtin_arg m BA_addrstack (Int.add ofs (Int.repr fe.(fe_stack_data))) | BA_loadglobal chunk id ofs => BA_loadglobal chunk id ofs | BA_addrglobal id ofs => BA_addrglobal id ofs - | BA_splitlong hi lo => + | BA_splitlong hi lo => BA_splitlong (transl_builtin_arg fe hi) (transl_builtin_arg fe lo) end. diff --git a/backend/Stackingproof.v b/backend/Stackingproof.v index dce49432..8becb773 100644 --- a/backend/Stackingproof.v +++ b/backend/Stackingproof.v @@ -111,7 +111,7 @@ Remark bound_stack_data_stacksize: f.(Linear.fn_stacksize) <= b.(bound_stack_data). Proof. unfold b, function_bounds, bound_stack_data. apply Zmax1. -Qed. +Qed. (** A frame index is valid if it lies within the resource bounds of the current function. *) @@ -155,7 +155,7 @@ Definition index_diff (idx1 idx2: frame_index) : Prop := Lemma index_diff_sym: forall idx1 idx2, index_diff idx1 idx2 -> index_diff idx2 idx1. Proof. - unfold index_diff; intros. + unfold index_diff; intros. destruct idx1; destruct idx2; intuition. Qed. @@ -222,9 +222,9 @@ Lemma offset_of_index_disj_stack_data_2: offset_of_index fe idx + AST.typesize (type_of_index idx) <= fe.(fe_stack_data) \/ fe.(fe_stack_data) + f.(Linear.fn_stacksize) <= offset_of_index fe idx. Proof. - intros. + intros. exploit offset_of_index_disj_stack_data_1; eauto. - generalize bound_stack_data_stacksize. + generalize bound_stack_data_stacksize. omega. Qed. @@ -240,7 +240,7 @@ Remark aligned_8_4: forall x, (8 | x) -> (4 | x). Proof. intros. apply Zdivides_trans with 8; auto. exists 2; auto. Qed. -Hint Resolve Zdivide_0 Zdivide_refl Zdivide_plus_r +Hint Resolve Zdivide_0 Zdivide_refl Zdivide_plus_r aligned_4_4x aligned_4_8x aligned_8_4: align_4. Hint Extern 4 (?X | ?Y) => (exists (Y/X); reflexivity) : align_4. @@ -280,8 +280,8 @@ Lemma index_local_valid: slot_within_bounds b Local ofs ty -> slot_valid f Local ofs ty = true -> index_valid (FI_local ofs ty). Proof. - unfold slot_within_bounds, slot_valid, index_valid; intros. - InvBooleans. + unfold slot_within_bounds, slot_valid, index_valid; intros. + InvBooleans. split. destruct ty; auto || discriminate. auto. Qed. @@ -290,9 +290,9 @@ Lemma index_arg_valid: slot_within_bounds b Outgoing ofs ty -> slot_valid f Outgoing ofs ty = true -> index_valid (FI_arg ofs ty). Proof. - unfold slot_within_bounds, slot_valid, index_valid; intros. - InvBooleans. - split. destruct ty; auto || discriminate. auto. + unfold slot_within_bounds, slot_valid, index_valid; intros. + InvBooleans. + split. destruct ty; auto || discriminate. auto. Qed. Lemma index_saved_int_valid: @@ -301,8 +301,8 @@ Lemma index_saved_int_valid: index_int_callee_save r < b.(bound_int_callee_save) -> index_valid (FI_saved_int (index_int_callee_save r)). Proof. - intros. red. split. - apply Zge_le. apply index_int_callee_save_pos; auto. + intros. red. split. + apply Zge_le. apply index_int_callee_save_pos; auto. auto. Qed. @@ -312,8 +312,8 @@ Lemma index_saved_float_valid: index_float_callee_save r < b.(bound_float_callee_save) -> index_valid (FI_saved_float (index_float_callee_save r)). Proof. - intros. red. split. - apply Zge_le. apply index_float_callee_save_pos; auto. + intros. red. split. + apply Zge_le. apply index_float_callee_save_pos; auto. auto. Qed. @@ -360,7 +360,7 @@ Proof. generalize (offset_of_index_valid idx H). intros [A B]. apply Int.unsigned_repr. generalize (AST.typesize_pos (type_of_index idx)). - generalize size_no_overflow. + generalize size_no_overflow. omega. Qed. @@ -369,14 +369,14 @@ Qed. Lemma shifted_stack_offset_no_overflow: forall ofs, 0 <= Int.unsigned ofs < Linear.fn_stacksize f -> - Int.unsigned (Int.add ofs (Int.repr fe.(fe_stack_data))) + Int.unsigned (Int.add ofs (Int.repr fe.(fe_stack_data))) = Int.unsigned ofs + fe.(fe_stack_data). Proof. intros. unfold Int.add. generalize size_no_overflow stack_data_offset_valid bound_stack_data_stacksize; intros. AddPosProps. replace (Int.unsigned (Int.repr (fe_stack_data fe))) with (fe_stack_data fe). - apply Int.unsigned_repr. omega. + apply Int.unsigned_repr. omega. symmetry. apply Int.unsigned_repr. omega. Qed. @@ -394,7 +394,7 @@ Lemma index_contains_load_stack: load_stack m (Vptr sp Int.zero) (type_of_index idx) (Int.repr (offset_of_index fe idx)) = Some v. Proof. - intros. inv H. + intros. inv H. unfold load_stack, Mem.loadv, Val.add. rewrite Int.add_commut. rewrite Int.add_zero. rewrite offset_of_index_no_overflow; auto. Qed. @@ -409,8 +409,8 @@ Lemma gss_index_contains_base: index_contains m' sp idx v' /\ decode_encode_val v (chunk_of_type (type_of_index idx)) (chunk_of_type (type_of_index idx)) v'. Proof. - intros. - exploit Mem.load_store_similar. eauto. reflexivity. omega. + intros. + exploit Mem.load_store_similar. eauto. reflexivity. omega. intros [v' [A B]]. exists v'; split; auto. constructor; auto. Qed. @@ -437,9 +437,9 @@ Lemma gso_index_contains: index_diff idx idx' -> index_contains m' sp idx' v'. Proof. - intros. inv H1. constructor; auto. + intros. inv H1. constructor; auto. rewrite <- H4. eapply Mem.load_store_other; eauto. - right. repeat rewrite size_type_chunk. + right. repeat rewrite size_type_chunk. apply offset_of_index_disj; auto. apply index_diff_sym; auto. Qed. @@ -451,9 +451,9 @@ Lemma store_other_index_contains: index_contains m sp idx v -> index_contains m' sp idx v. Proof. - intros. inv H1. constructor; auto. rewrite <- H3. - eapply Mem.load_store_other; eauto. - destruct H0. auto. right. + intros. inv H1. constructor; auto. rewrite <- H3. + eapply Mem.load_store_other; eauto. + destruct H0. auto. right. exploit offset_of_index_disj_stack_data_2; eauto. intros. rewrite size_type_chunk. omega. @@ -487,7 +487,7 @@ Proof. intros. destruct (Mem.valid_access_store m (chunk_of_type (type_of_index idx)) sp (offset_of_index fe idx) v) as [m' ST]. constructor. - rewrite size_type_chunk. + rewrite size_type_chunk. apply Mem.range_perm_implies with Freeable; auto with mem. apply offset_of_index_perm; auto. apply offset_of_index_aligned_2; auto. @@ -535,7 +535,7 @@ Lemma gss_index_contains_inj': Proof. intros. exploit gss_index_contains_base; eauto. intros [v'' [A B]]. exists v''; split; auto. - inv H1; destruct (type_of_index idx); simpl in *; try contradiction; subst; auto. + inv H1; destruct (type_of_index idx); simpl in *; try contradiction; subst; auto. econstructor; eauto. econstructor; eauto. econstructor; eauto. @@ -571,7 +571,7 @@ Lemma index_contains_inj_incr: inject_incr j j' -> index_contains_inj j' m sp idx v. Proof. - intros. destruct H as [v'' [A B]]. exists v''; split; auto. eauto. + intros. destruct H as [v'' [A B]]. exists v''; split; auto. eauto. Qed. Lemma index_contains_inj_undef: @@ -580,15 +580,15 @@ Lemma index_contains_inj_undef: frame_perm_freeable m sp -> index_contains_inj j m sp idx Vundef. Proof. - intros. + intros. exploit (Mem.valid_access_load m (chunk_of_type (type_of_index idx)) sp (offset_of_index fe idx)). - constructor. + constructor. rewrite size_type_chunk. apply Mem.range_perm_implies with Freeable; auto with mem. - apply offset_of_index_perm; auto. + apply offset_of_index_perm; auto. apply offset_of_index_aligned_2; auto. - intros [v C]. - exists v; split; auto. constructor; auto. + intros [v C]. + exists v; split; auto. constructor; auto. Qed. Hint Resolve store_other_index_contains_inj index_contains_inj_incr: stacking. @@ -613,21 +613,21 @@ Record agree_frame (j: meminj) (ls ls0: locset) forall r, ~(mreg_within_bounds b r) -> ls (R r) = ls0 (R r); (** Local and outgoing stack slots (on the Linear side) have - the same values as the one loaded from the current Mach frame + the same values as the one loaded from the current Mach frame at the corresponding offsets. *) agree_locals: - forall ofs ty, + forall ofs ty, slot_within_bounds b Local ofs ty -> slot_valid f Local ofs ty = true -> index_contains_inj j m' sp' (FI_local ofs ty) (ls (S Local ofs ty)); agree_outgoing: - forall ofs ty, + forall ofs ty, slot_within_bounds b Outgoing ofs ty -> slot_valid f Outgoing ofs ty = true -> index_contains_inj j m' sp' (FI_arg ofs ty) (ls (S Outgoing ofs ty)); (** Incoming stack slots have the same value as the corresponding Outgoing stack slots in the caller *) agree_incoming: - forall ofs ty, + forall ofs ty, In (S Incoming ofs ty) (loc_parameters f.(Linear.fn_sig)) -> ls (S Incoming ofs ty) = ls0 (S Outgoing ofs ty); @@ -695,7 +695,7 @@ Lemma agree_reg: forall j ls rs r, agree_regs j ls rs -> Val.inject j (ls (R r)) (rs r). Proof. - intros. auto. + intros. auto. Qed. Lemma agree_reglist: @@ -703,7 +703,7 @@ Lemma agree_reglist: agree_regs j ls rs -> Val.inject_list j (reglist ls rl) (rs##rl). Proof. induction rl; simpl; intros. - auto. constructor. eauto with stacking. auto. + auto. constructor. eauto with stacking. auto. Qed. Hint Resolve agree_reg agree_reglist: stacking. @@ -716,8 +716,8 @@ Lemma agree_regs_set_reg: Val.inject j v v' -> agree_regs j (Locmap.set (R r) v ls) (Regmap.set r v' rs). Proof. - intros; red; intros. - unfold Regmap.set. destruct (RegEq.eq r0 r). subst r0. + intros; red; intros. + unfold Regmap.set. destruct (RegEq.eq r0 r). subst r0. rewrite Locmap.gss; auto. rewrite Locmap.gso; auto. red. auto. Qed. @@ -728,10 +728,10 @@ Lemma agree_regs_set_regs: Val.inject_list j vl vl' -> agree_regs j (Locmap.setlist (map R rl) vl ls) (set_regs rl vl' rs). Proof. - induction rl; simpl; intros. + induction rl; simpl; intros. auto. inv H0. auto. - apply IHrl; auto. apply agree_regs_set_reg; auto. + apply IHrl; auto. apply agree_regs_set_reg; auto. Qed. Lemma agree_regs_set_res: @@ -741,9 +741,9 @@ Lemma agree_regs_set_res: agree_regs j (Locmap.setres res v ls) (set_res res v' rs). Proof. induction res; simpl; intros. -- apply agree_regs_set_reg; auto. +- apply agree_regs_set_reg; auto. - auto. -- apply IHres2. apply IHres1. auto. +- apply IHres2. apply IHres1. auto. apply Val.hiword_inject; auto. apply Val.loword_inject; auto. Qed. @@ -755,8 +755,8 @@ Lemma agree_regs_exten: agree_regs j ls' rs'. Proof. intros; red; intros. - destruct (H0 r) as [A | [A B]]. - rewrite A. constructor. + destruct (H0 r) as [A | [A B]]. + rewrite A. constructor. rewrite A; rewrite B; auto. Qed. @@ -767,7 +767,7 @@ Lemma agree_regs_undef_regs: Proof. induction rl; simpl; intros. auto. - apply agree_regs_set_reg; auto. + apply agree_regs_set_reg; auto. Qed. (** Preservation under assignment of stack slot *) @@ -821,8 +821,8 @@ Lemma agree_frame_set_regs: agree_frame j (Locmap.setlist (map R rl) vl ls) ls0 m sp m' sp' parent ra. Proof. induction rl; destruct vl; simpl; intros; intuition. - apply IHrl; auto. - eapply agree_frame_set_reg; eauto. + apply IHrl; auto. + eapply agree_frame_set_reg; eauto. Qed. Lemma agree_frame_set_res: @@ -866,8 +866,8 @@ Lemma agree_frame_undef_locs: incl regs destroyed_at_call -> agree_frame j (LTL.undef_regs regs ls) ls0 m sp m' sp' parent ra. Proof. - intros. eapply agree_frame_undef_regs; eauto. - intros. apply caller_save_reg_within_bounds. auto. + intros. eapply agree_frame_undef_regs; eauto. + intros. apply caller_save_reg_within_bounds. auto. Qed. (** Preservation by assignment to local slot *) @@ -880,7 +880,7 @@ Lemma agree_frame_set_local: Mem.store (chunk_of_type ty) m' sp' (offset_of_index fe (FI_local ofs ty)) v' = Some m'' -> agree_frame j (Locmap.set (S Local ofs ty) v ls) ls0 m sp m'' sp' parent retaddr. Proof. - intros. inv H. + intros. inv H. change (chunk_of_type ty) with (chunk_of_type (type_of_index (FI_local ofs ty))) in H3. constructor; auto; intros. (* local *) @@ -888,19 +888,19 @@ Proof. destruct (Loc.eq (S Local ofs ty) (S Local ofs0 ty0)). inv e. eapply gss_index_contains_inj'; eauto with stacking. destruct (Loc.diff_dec (S Local ofs ty) (S Local ofs0 ty0)). - eapply gso_index_contains_inj. eauto. eauto with stacking. eauto. + eapply gso_index_contains_inj. eauto. eauto with stacking. eauto. simpl. simpl in d. intuition. apply index_contains_inj_undef. auto with stacking. red; intros. eapply Mem.perm_store_1; eauto. (* outgoing *) rewrite Locmap.gso. eapply gso_index_contains_inj; eauto with stacking. - red; auto. red; left; congruence. + red; auto. red; left; congruence. (* parent *) eapply gso_index_contains; eauto with stacking. red; auto. (* retaddr *) eapply gso_index_contains; eauto with stacking. red; auto. (* int callee save *) - eapply gso_index_contains_inj; eauto with stacking. simpl; auto. + eapply gso_index_contains_inj; eauto with stacking. simpl; auto. (* float callee save *) eapply gso_index_contains_inj; eauto with stacking. simpl; auto. (* valid *) @@ -919,7 +919,7 @@ Lemma agree_frame_set_outgoing: Mem.store (chunk_of_type ty) m' sp' (offset_of_index fe (FI_arg ofs ty)) v' = Some m'' -> agree_frame j (Locmap.set (S Outgoing ofs ty) v ls) ls0 m sp m'' sp' parent retaddr. Proof. - intros. inv H. + intros. inv H. change (chunk_of_type ty) with (chunk_of_type (type_of_index (FI_arg ofs ty))) in H3. constructor; auto; intros. (* local *) @@ -930,7 +930,7 @@ Proof. inv e. eapply gss_index_contains_inj'; eauto with stacking. destruct (Loc.diff_dec (S Outgoing ofs ty) (S Outgoing ofs0 ty0)). eapply gso_index_contains_inj; eauto with stacking. - red. red in d. intuition. + red. red in d. intuition. apply index_contains_inj_undef. auto with stacking. red; intros. eapply Mem.perm_store_1; eauto. (* parent *) @@ -938,7 +938,7 @@ Proof. (* retaddr *) eapply gso_index_contains; eauto with stacking. red; auto. (* int callee save *) - eapply gso_index_contains_inj; eauto with stacking. simpl; auto. + eapply gso_index_contains_inj; eauto with stacking. simpl; auto. (* float callee save *) eapply gso_index_contains_inj; eauto with stacking. simpl; auto. (* valid *) @@ -969,11 +969,11 @@ Proof. assert (IC: forall idx v, index_contains m' sp' idx v -> index_contains m1' sp' idx v). intros. inv H5. - exploit offset_of_index_disj_stack_data_2; eauto. intros. + exploit offset_of_index_disj_stack_data_2; eauto. intros. constructor; eauto. apply H3; auto. rewrite size_type_chunk; auto. assert (ICI: forall idx v, index_contains_inj j m' sp' idx v -> index_contains_inj j m1' sp' idx v). - intros. destruct H5 as [v' [A B]]. exists v'; split; auto. + intros. destruct H5 as [v' [A B]]. exists v'; split; auto. inv H; constructor; auto; intros. eauto. red; intros. apply H4; auto. @@ -995,10 +995,10 @@ Proof. ofs < fe.(fe_stack_data) \/ fe.(fe_stack_data) + f.(Linear.fn_stacksize) <= ofs -> loc_out_of_reach j m sp' ofs). intros; red; intros. exploit agree_inj_unique; eauto. intros [EQ1 EQ2]; subst. - red; intros. exploit agree_bounds; eauto. omega. + red; intros. exploit agree_bounds; eauto. omega. eapply agree_frame_invariant; eauto. - intros. eapply Mem.load_unchanged_on; eauto. intros. apply REACH. omega. auto. - intros. eapply Mem.perm_unchanged_on; eauto with mem. auto. + intros. eapply Mem.load_unchanged_on; eauto. intros. apply REACH. omega. auto. + intros. eapply Mem.perm_unchanged_on; eauto with mem. auto. Qed. (** Preservation by parallel stores in the Linear and Mach codes *) @@ -1019,20 +1019,20 @@ Opaque Int.add. eauto with mem. eauto with mem. eauto with mem. - intros. rewrite <- H1. eapply Mem.load_store_other; eauto. + intros. rewrite <- H1. eapply Mem.load_store_other; eauto. destruct (eq_block sp' b2); auto. subst b2. right. exploit agree_inj_unique; eauto. intros [P Q]. subst b1 delta. exploit Mem.store_valid_access_3. eexact STORE1. intros [A B]. rewrite shifted_stack_offset_no_overflow. - exploit agree_bounds. eauto. apply Mem.perm_cur_max. apply A. + exploit agree_bounds. eauto. apply Mem.perm_cur_max. apply A. instantiate (1 := Int.unsigned ofs1). generalize (size_chunk_pos chunk). omega. intros C. - exploit agree_bounds. eauto. apply Mem.perm_cur_max. apply A. + exploit agree_bounds. eauto. apply Mem.perm_cur_max. apply A. instantiate (1 := Int.unsigned ofs1 + size_chunk chunk - 1). generalize (size_chunk_pos chunk). omega. intros D. omega. - eapply agree_bounds. eauto. apply Mem.perm_cur_max. apply A. + eapply agree_bounds. eauto. apply Mem.perm_cur_max. apply A. generalize (size_chunk_pos chunk). omega. intros; eauto with mem. Qed. @@ -1047,8 +1047,8 @@ Lemma agree_frame_inject_incr: agree_frame j' ls ls0 m sp m' sp' parent retaddr. Proof. intros. inv H. constructor; auto; intros; eauto with stacking. - case_eq (j b0). - intros [b' delta'] EQ. rewrite (H0 _ _ _ EQ) in H. inv H. auto. + case_eq (j b0). + intros [b' delta'] EQ. rewrite (H0 _ _ _ EQ) in H. inv H. auto. intros EQ. exploit H1. eauto. eauto. intros [A B]. contradiction. Qed. @@ -1074,7 +1074,7 @@ Lemma agree_frame_return: agree_frame j ls' ls0 m sp m' sp' parent retaddr. Proof. intros. red in H0. inv H; constructor; auto; intros. - rewrite H0; auto. red; intros; elim H. apply caller_save_reg_within_bounds; auto. + rewrite H0; auto. red; intros; elim H. apply caller_save_reg_within_bounds; auto. rewrite H0; auto. rewrite H0; auto. rewrite H0; auto. @@ -1089,10 +1089,10 @@ Lemma agree_frame_tailcall: agree_frame j ls ls0' m sp m' sp' parent retaddr. Proof. intros. red in H0. inv H; constructor; auto; intros. - rewrite <- H0; auto. red; intros; elim H. apply caller_save_reg_within_bounds; auto. + rewrite <- H0; auto. red; intros; elim H. apply caller_save_reg_within_bounds; auto. rewrite <- H0; auto. - rewrite <- H0. auto. red; intros. eapply int_callee_save_not_destroyed; eauto. - rewrite <- H0. auto. red; intros. eapply float_callee_save_not_destroyed; eauto. + rewrite <- H0. auto. red; intros. eapply int_callee_save_not_destroyed; eauto. + rewrite <- H0. auto. red; intros. eapply float_callee_save_not_destroyed; eauto. Qed. (** Properties of [agree_callee_save]. *) @@ -1103,7 +1103,7 @@ Lemma agree_callee_save_return_regs: Proof. intros; red; intros. unfold return_regs. destruct l; auto. - rewrite pred_dec_false; auto. + rewrite pred_dec_false; auto. Qed. Lemma agree_callee_save_set_result: @@ -1116,10 +1116,10 @@ Proof. Opaque destroyed_at_call. induction l; simpl; intros. auto. - destruct vl; auto. + destruct vl; auto. apply IHl; auto. - red; intros. rewrite Locmap.gso. apply H0; auto. - destruct l0; simpl; auto. + red; intros. rewrite Locmap.gso. apply H0; auto. + destruct l0; simpl; auto. Qed. (** Properties of destroyed registers. *) @@ -1129,8 +1129,8 @@ Lemma check_mreg_list_incl: forallb (fun r => In_dec mreg_eq r l2) l1 = true -> incl l1 l2. Proof. - intros; red; intros. - rewrite forallb_forall in H. eapply proj_sumbool_true. eauto. + intros; red; intros. + rewrite forallb_forall in H. eapply proj_sumbool_true. eauto. Qed. Remark destroyed_by_op_caller_save: @@ -1191,7 +1191,7 @@ Hint Resolve destroyed_by_op_caller_save destroyed_by_load_caller_save Remark destroyed_by_setstack_function_entry: forall ty, incl (destroyed_by_setstack ty) destroyed_at_function_entry. Proof. - destruct ty; apply check_mreg_list_incl; compute; auto. + destruct ty; apply check_mreg_list_incl; compute; auto. Qed. Remark transl_destroyed_by_op: @@ -1249,7 +1249,7 @@ Proof. induction 1; intros. auto. econstructor; eauto. Qed. -Hypothesis number_inj: +Hypothesis number_inj: forall r1 r2, In r1 csregs -> In r2 csregs -> r1 <> r2 -> number r1 <> number r2. Hypothesis mkindex_valid: forall r, In r csregs -> number r < bound fe -> index_valid (mkindex (number r)). @@ -1275,7 +1275,7 @@ Lemma save_callee_save_regs_correct: frame_perm_freeable m sp -> agree_regs j ls rs -> exists rs', exists m', - star step tge + star step tge (State cs fb (Vptr sp Int.zero) (save_callee_save_regs bound number mkindex ty fe l k) rs m) E0 (State cs fb (Vptr sp Int.zero) k rs' m') @@ -1294,7 +1294,7 @@ Lemma save_callee_save_regs_correct: Proof. induction l; intros; simpl save_callee_save_regs. (* base case *) - exists rs; exists m. split. apply star_refl. + exists rs; exists m. split. apply star_refl. split. intros. elim H3. split. auto. split. constructor. @@ -1305,42 +1305,42 @@ Proof. unfold save_callee_save_reg. destruct (zlt (number a) (bound fe)). (* a store takes place *) - exploit store_index_succeeds. apply (mkindex_valid a); auto with coqlib. + exploit store_index_succeeds. apply (mkindex_valid a); auto with coqlib. eauto. instantiate (1 := rs a). intros [m1 ST]. - exploit (IHl k (undef_regs (destroyed_by_setstack ty) rs) m1). auto with coqlib. auto. + exploit (IHl k (undef_regs (destroyed_by_setstack ty) rs) m1). auto with coqlib. auto. red; eauto with mem. apply agree_regs_exten with ls rs. auto. intros. destruct (In_dec mreg_eq r (destroyed_by_setstack ty)). - left. apply ls_temp_undef; auto. + left. apply ls_temp_undef; auto. right; split. auto. apply undef_regs_other; auto. intros [rs' [m' [A [B [C [D [E F]]]]]]]. - exists rs'; exists m'. - split. eapply star_left; eauto. econstructor. - rewrite <- (mkindex_typ (number a)). + exists rs'; exists m'. + split. eapply star_left; eauto. econstructor. + rewrite <- (mkindex_typ (number a)). apply store_stack_succeeds; auto with coqlib. auto. traceEq. split; intros. simpl in H3. destruct (mreg_eq a r). subst r. assert (index_contains_inj j m1 sp (mkindex (number a)) (ls (R a))). eapply gss_index_contains_inj; eauto. - rewrite mkindex_typ. rewrite <- (csregs_typ a). apply wt_ls. + rewrite mkindex_typ. rewrite <- (csregs_typ a). apply wt_ls. auto with coqlib. destruct H5 as [v' [P Q]]. - exists v'; split; auto. apply C; auto. - intros. apply mkindex_inj. apply number_inj; auto with coqlib. + exists v'; split; auto. apply C; auto. + intros. apply mkindex_inj. apply number_inj; auto with coqlib. inv H0. intuition congruence. - apply B; auto with coqlib. + apply B; auto with coqlib. intuition congruence. split. intros. apply C; auto with coqlib. - eapply gso_index_contains; eauto with coqlib. + eapply gso_index_contains; eauto with coqlib. split. econstructor; eauto. rewrite size_type_chunk. apply offset_of_index_disj_stack_data_2; eauto with coqlib. auto. (* no store takes place *) - exploit (IHl k rs m); auto with coqlib. + exploit (IHl k rs m); auto with coqlib. intros [rs' [m' [A [B [C [D [E F]]]]]]]. - exists rs'; exists m'; intuition. + exists rs'; exists m'; intuition. simpl in H3. destruct H3. subst r. omegaContradiction. apply B; auto. apply C; auto with coqlib. intros. eapply H4; eauto. auto with coqlib. @@ -1351,9 +1351,9 @@ End SAVE_CALLEE_SAVE. Remark LTL_undef_regs_same: forall r rl ls, In r rl -> LTL.undef_regs rl ls (R r) = Vundef. Proof. - induction rl; simpl; intros. contradiction. - unfold Locmap.set. destruct (Loc.eq (R a) (R r)). auto. - destruct (Loc.diff_dec (R a) (R r)); auto. + induction rl; simpl; intros. contradiction. + unfold Locmap.set. destruct (Loc.eq (R a) (R r)). auto. + destruct (Loc.diff_dec (R a) (R r)); auto. apply IHrl. intuition congruence. Qed. @@ -1361,14 +1361,14 @@ Remark LTL_undef_regs_others: forall r rl ls, ~In r rl -> LTL.undef_regs rl ls (R r) = ls (R r). Proof. induction rl; simpl; intros. auto. - rewrite Locmap.gso. apply IHrl. intuition. red. intuition. + rewrite Locmap.gso. apply IHrl. intuition. red. intuition. Qed. Remark LTL_undef_regs_slot: forall sl ofs ty rl ls, LTL.undef_regs rl ls (S sl ofs ty) = ls (S sl ofs ty). Proof. induction rl; simpl; intros. auto. - rewrite Locmap.gso. apply IHrl. red; auto. + rewrite Locmap.gso. apply IHrl. red; auto. Qed. Lemma save_callee_save_correct: @@ -1378,7 +1378,7 @@ Lemma save_callee_save_correct: (forall r, Val.has_type (ls (R r)) (mreg_type r)) -> frame_perm_freeable m sp -> exists rs', exists m', - star step tge + star step tge (State cs fb (Vptr sp Int.zero) (save_callee_save fe k) rs m) E0 (State cs fb (Vptr sp Int.zero) k rs' m') /\ (forall r, @@ -1399,12 +1399,12 @@ Proof. intros. assert (UNDEF: forall r ty, In r (destroyed_by_setstack ty) -> ls (R r) = Vundef). intros. unfold ls. apply LTL_undef_regs_same. eapply destroyed_by_setstack_function_entry; eauto. - exploit (save_callee_save_regs_correct + exploit (save_callee_save_regs_correct fe_num_int_callee_save index_int_callee_save FI_saved_int Tany32 j cs fb sp int_callee_save_regs ls). - intros. apply index_int_callee_save_inj; auto. + intros. apply index_int_callee_save_inj; auto. intros. simpl. split. apply Zge_le. apply index_int_callee_save_pos; auto. assumption. auto. intros; congruence. @@ -1412,41 +1412,41 @@ Proof. intros. apply int_callee_save_type. auto. eauto. auto. - apply incl_refl. + apply incl_refl. apply int_callee_save_norepet. eauto. eauto. intros [rs1 [m1 [A [B [C [D [E F]]]]]]]. - exploit (save_callee_save_regs_correct + exploit (save_callee_save_regs_correct fe_num_float_callee_save index_float_callee_save FI_saved_float Tany64 j cs fb sp float_callee_save_regs ls). - intros. apply index_float_callee_save_inj; auto. + intros. apply index_float_callee_save_inj; auto. intros. simpl. split. apply Zge_le. apply index_float_callee_save_pos; auto. assumption. simpl; auto. intros; congruence. intros; simpl. destruct idx; auto. congruence. intros. apply float_callee_save_type. auto. eauto. - auto. - apply incl_refl. + auto. + apply incl_refl. apply float_callee_save_norepet. eexact E. eexact F. intros [rs2 [m2 [P [Q [R [S [T U]]]]]]]. exists rs2; exists m2. split. unfold save_callee_save, save_callee_save_int, save_callee_save_float. - eapply star_trans; eauto. + eapply star_trans; eauto. split; intros. destruct (B r H2 H3) as [v [X Y]]. exists v; split; auto. apply R. - apply index_saved_int_valid; auto. + apply index_saved_int_valid; auto. intros. congruence. auto. split. intros. apply Q; auto. split. intros. apply R. auto. intros. destruct idx; contradiction||congruence. - apply C. auto. + apply C. auto. intros. destruct idx; contradiction||congruence. auto. split. eapply stores_in_frame_trans; eauto. @@ -1466,7 +1466,7 @@ Proof. apply IHstores_in_frame. intros. eapply Mem.store_outside_inject; eauto. intros. exploit H; eauto. intros [A B]; subst. - exploit H0; eauto. omega. + exploit H0; eauto. omega. Qed. Lemma stores_in_frame_valid: @@ -1483,10 +1483,10 @@ Qed. Lemma stores_in_frame_contents: forall chunk b ofs sp, Plt b sp -> - forall m m', stores_in_frame sp m m' -> + forall m m', stores_in_frame sp m m' -> Mem.load chunk m' b ofs = Mem.load chunk m b ofs. Proof. - induction 2. auto. + induction 2. auto. rewrite IHstores_in_frame. eapply Mem.load_store_other; eauto. left. apply Plt_ne; auto. Qed. @@ -1497,7 +1497,7 @@ Lemma undef_regs_type: Proof. induction rl; simpl; intros. - auto. -- unfold Locmap.set. destruct (Loc.eq (R a) l). red; auto. +- unfold Locmap.set. destruct (Loc.eq (R a) l). red; auto. destruct (Loc.diff_dec (R a) l); auto. red; auto. Qed. @@ -1520,7 +1520,7 @@ Lemma function_prologue_correct: Mem.alloc m1' 0 tf.(fn_stacksize) = (m2', sp') /\ store_stack m2' (Vptr sp' Int.zero) Tint tf.(fn_link_ofs) parent = Some m3' /\ store_stack m3' (Vptr sp' Int.zero) Tint tf.(fn_retaddr_ofs) ra = Some m4' - /\ star step tge + /\ star step tge (State cs fb (Vptr sp' Int.zero) (save_callee_save fe k) rs1 m4') E0 (State cs fb (Vptr sp' Int.zero) k rs' m5') /\ agree_regs j' ls1 rs' @@ -1541,13 +1541,13 @@ Proof. instantiate (1 := sp'). eauto with mem. instantiate (1 := fe_stack_data fe). generalize stack_data_offset_valid (bound_stack_data_pos b) size_no_overflow; omega. - intros; right. - exploit Mem.perm_alloc_inv. eexact ALLOC'. eauto. rewrite dec_eq_true. - generalize size_no_overflow. omega. - intros. apply Mem.perm_implies with Freeable; auto with mem. + intros; right. + exploit Mem.perm_alloc_inv. eexact ALLOC'. eauto. rewrite dec_eq_true. + generalize size_no_overflow. omega. + intros. apply Mem.perm_implies with Freeable; auto with mem. eapply Mem.perm_alloc_2; eauto. generalize stack_data_offset_valid bound_stack_data_stacksize; omega. - red. intros. apply Zdivides_trans with 8. + red. intros. apply Zdivides_trans with 8. destruct chunk; simpl; auto with align_4. apply fe_stack_data_aligned. intros. @@ -1558,17 +1558,17 @@ Proof. assert (PERM: frame_perm_freeable m2' sp'). red; intros. eapply Mem.perm_alloc_2; eauto. (* Store of parent *) - exploit (store_index_succeeds m2' sp' FI_link parent). red; auto. auto. + exploit (store_index_succeeds m2' sp' FI_link parent). red; auto. auto. intros [m3' STORE2]. (* Store of retaddr *) exploit (store_index_succeeds m3' sp' FI_retaddr ra). red; auto. red; eauto with mem. intros [m4' STORE3]. (* Saving callee-save registers *) assert (PERM4: frame_perm_freeable m4' sp'). - red; intros. eauto with mem. - exploit save_callee_save_correct. + red; intros. eauto with mem. + exploit save_callee_save_correct. instantiate (1 := rs1). instantiate (1 := call_regs ls). instantiate (1 := j'). - subst rs1. apply agree_regs_undef_regs. + subst rs1. apply agree_regs_undef_regs. apply agree_regs_call_regs. eapply agree_regs_inject_incr; eauto. intros. apply undef_regs_type. simpl. apply WTREGS. eexact PERM4. @@ -1576,15 +1576,15 @@ Proof. intros [rs' [m5' [STEPS [ICS [FCS [OTHERS [STORES [PERM5 AGREGS']]]]]]]]. (* stores in frames *) assert (SIF: stores_in_frame sp' m2' m5'). - econstructor; eauto. + econstructor; eauto. rewrite size_type_chunk. apply offset_of_index_disj_stack_data_2; auto. red; auto. econstructor; eauto. rewrite size_type_chunk. apply offset_of_index_disj_stack_data_2; auto. red; auto. (* separation *) assert (SEP: forall b0 delta, j' b0 = Some(sp', delta) -> b0 = sp /\ delta = fe_stack_data fe). - intros. destruct (eq_block b0 sp). + intros. destruct (eq_block b0 sp). subst b0. rewrite MAP1 in H; inv H; auto. - rewrite MAP2 in H; auto. + rewrite MAP2 in H; auto. assert (Mem.valid_block m1' sp'). eapply Mem.valid_block_inject_2; eauto. assert (~Mem.valid_block m1' sp') by eauto with mem. contradiction. @@ -1592,11 +1592,11 @@ Proof. exists j'; exists rs'; exists m2'; exists sp'; exists m3'; exists m4'; exists m5'. split. auto. (* store parent *) - split. change Tint with (type_of_index FI_link). + split. change Tint with (type_of_index FI_link). change (fe_ofs_link fe) with (offset_of_index fe FI_link). apply store_stack_succeeds; auto. red; auto. (* store retaddr *) - split. change Tint with (type_of_index FI_retaddr). + split. change Tint with (type_of_index FI_retaddr). change (fe_ofs_retaddr fe) with (offset_of_index fe FI_retaddr). apply store_stack_succeeds; auto. red; auto. (* saving of registers *) @@ -1606,20 +1606,20 @@ Proof. (* agree frame *) split. constructor; intros. (* unused regs *) - assert (~In r destroyed_at_call). + assert (~In r destroyed_at_call). red; intros; elim H; apply caller_save_reg_within_bounds; auto. - rewrite LS1. rewrite LTL_undef_regs_others. unfold call_regs. - apply AGCS; auto. red; intros; elim H0. + rewrite LS1. rewrite LTL_undef_regs_others. unfold call_regs. + apply AGCS; auto. red; intros; elim H0. apply destroyed_at_function_entry_caller_save; auto. (* locals *) - rewrite LS1. rewrite LTL_undef_regs_slot. unfold call_regs. + rewrite LS1. rewrite LTL_undef_regs_slot. unfold call_regs. apply index_contains_inj_undef; auto with stacking. (* outgoing *) - rewrite LS1. rewrite LTL_undef_regs_slot. unfold call_regs. + rewrite LS1. rewrite LTL_undef_regs_slot. unfold call_regs. apply index_contains_inj_undef; auto with stacking. (* incoming *) rewrite LS1. rewrite LTL_undef_regs_slot. unfold call_regs. - apply AGCS; auto. + apply AGCS; auto. (* parent *) apply OTHERS; auto. red; auto. eapply gso_index_contains; eauto. red; auto. @@ -1629,16 +1629,16 @@ Proof. apply OTHERS; auto. red; auto. eapply gss_index_contains; eauto. red; auto. (* int callee save *) - assert (~In r destroyed_at_call). + assert (~In r destroyed_at_call). red; intros. eapply int_callee_save_not_destroyed; eauto. exploit ICS; eauto. rewrite LS1. rewrite LTL_undef_regs_others. unfold call_regs. - rewrite AGCS; auto. + rewrite AGCS; auto. red; intros; elim H1. apply destroyed_at_function_entry_caller_save; auto. (* float callee save *) - assert (~In r destroyed_at_call). + assert (~In r destroyed_at_call). red; intros. eapply float_callee_save_not_destroyed; eauto. exploit FCS; eauto. rewrite LS1. rewrite LTL_undef_regs_others. unfold call_regs. - rewrite AGCS; auto. + rewrite AGCS; auto. red; intros; elim H1. apply destroyed_at_function_entry_caller_save; auto. (* inj *) auto. @@ -1700,7 +1700,7 @@ Definition agree_unused (ls0: locset) (rs: regset) : Prop := Lemma restore_callee_save_regs_correct: forall l rs k, incl l csregs -> - list_norepet l -> + list_norepet l -> agree_unused ls0 rs -> exists rs', star step tge @@ -1727,9 +1727,9 @@ Proof. subst r. auto. auto. intros [rs' [A [B [C D]]]]. - exists rs'. split. - eapply star_left. - constructor. rewrite <- (mkindex_typ (number a)). apply index_contains_load_stack. eauto. + exists rs'. split. + eapply star_left. + constructor. rewrite <- (mkindex_typ (number a)). apply index_contains_load_stack. eauto. eauto. traceEq. split. intros. destruct H2. subst r. rewrite C. unfold rs1. rewrite Regmap.gss. auto. inv H0; auto. @@ -1742,7 +1742,7 @@ Proof. intros [rs' [A [B [C D]]]]. exists rs'. split. assumption. split. intros. destruct H2. - subst r. apply D. + subst r. apply D. rewrite <- number_within_bounds. auto. auto. auto. split. intros. simpl in H2. apply C. tauto. auto. @@ -1758,16 +1758,16 @@ Lemma restore_callee_save_correct: star step tge (State cs fb (Vptr sp' Int.zero) (restore_callee_save fe k) rs m') E0 (State cs fb (Vptr sp' Int.zero) k rs' m') - /\ (forall r, - In r int_callee_save_regs \/ In r float_callee_save_regs -> + /\ (forall r, + In r int_callee_save_regs \/ In r float_callee_save_regs -> Val.inject j (ls0 (R r)) (rs' r)) - /\ (forall r, + /\ (forall r, ~(In r int_callee_save_regs) -> ~(In r float_callee_save_regs) -> rs' r = rs r). Proof. - intros. - exploit (restore_callee_save_regs_correct + intros. + exploit (restore_callee_save_regs_correct fe_num_int_callee_save index_int_callee_save FI_saved_int @@ -1776,16 +1776,16 @@ Proof. j cs fb sp' ls0 m'); auto. intros. unfold mreg_within_bounds. split; intros. split; auto. destruct (zlt (index_float_callee_save r) 0). - generalize (bound_float_callee_save_pos b). omega. - eelim int_float_callee_save_disjoint. eauto. + generalize (bound_float_callee_save_pos b). omega. + eelim int_float_callee_save_disjoint. eauto. eapply index_float_callee_save_pos2. eauto. auto. - destruct H2; auto. - eapply agree_saved_int; eauto. + destruct H2; auto. + eapply agree_saved_int; eauto. apply incl_refl. apply int_callee_save_norepet. eauto. intros [rs1 [A [B [C D]]]]. - exploit (restore_callee_save_regs_correct + exploit (restore_callee_save_regs_correct fe_num_float_callee_save index_float_callee_save FI_saved_float @@ -1794,11 +1794,11 @@ Proof. j cs fb sp' ls0 m'); auto. intros. unfold mreg_within_bounds. split; intros. split; auto. destruct (zlt (index_int_callee_save r) 0). - generalize (bound_int_callee_save_pos b). omega. - eelim int_float_callee_save_disjoint. + generalize (bound_int_callee_save_pos b). omega. + eelim int_float_callee_save_disjoint. eapply index_int_callee_save_pos2. eauto. eauto. auto. - destruct H2; auto. - eapply agree_saved_float; eauto. + destruct H2; auto. + eapply agree_saved_float; eauto. apply incl_refl. apply float_callee_save_norepet. eexact D. @@ -1842,34 +1842,34 @@ Proof. by omega. destruct EITHER. replace ofs with ((ofs - fe_stack_data fe) + fe_stack_data fe) by omega. - eapply Mem.perm_inject with (f := j). eapply agree_inj; eauto. eauto. + eapply Mem.perm_inject with (f := j). eapply agree_inj; eauto. eauto. eapply Mem.free_range_perm; eauto. omega. - eapply agree_perm; eauto. + eapply agree_perm; eauto. (* inject after free *) assert (INJ1: Mem.inject j m1 m1'). eapply Mem.free_inject with (l := (sp, 0, f.(Linear.fn_stacksize)) :: nil); eauto. simpl. rewrite H2. auto. intros. exploit agree_inj_unique; eauto. intros [P Q]; subst b1 delta. exists 0; exists (Linear.fn_stacksize f); split. auto with coqlib. - eapply agree_bounds. eauto. eapply Mem.perm_max. eauto. + eapply agree_bounds. eauto. eapply Mem.perm_max. eauto. (* can execute epilogue *) exploit restore_callee_save_correct; eauto. - instantiate (1 := rs). red; intros. - rewrite <- (agree_unused_reg _ _ _ _ _ _ _ _ _ H0). auto. auto. + instantiate (1 := rs). red; intros. + rewrite <- (agree_unused_reg _ _ _ _ _ _ _ _ _ H0). auto. auto. intros [rs1 [A [B C]]]. (* conclusions *) exists rs1; exists m1'. - split. rewrite unfold_transf_function; unfold fn_link_ofs. + split. rewrite unfold_transf_function; unfold fn_link_ofs. eapply index_contains_load_stack with (idx := FI_link); eauto with stacking. - split. rewrite unfold_transf_function; unfold fn_retaddr_ofs. + split. rewrite unfold_transf_function; unfold fn_retaddr_ofs. eapply index_contains_load_stack with (idx := FI_retaddr); eauto with stacking. split. auto. split. eexact A. split. red; intros. unfold return_regs. generalize (register_classification r) (int_callee_save_not_destroyed r) (float_callee_save_not_destroyed r); intros. - destruct (in_dec mreg_eq r destroyed_at_call). - rewrite C; auto. - apply B. intuition. + destruct (in_dec mreg_eq r destroyed_at_call). + rewrite C; auto. + apply B. intuition. split. apply agree_callee_save_return_regs. auto. Qed. @@ -1886,7 +1886,7 @@ Inductive match_globalenvs (j: meminj) (bound: block) : Prop := (FUNCTIONS: forall b fd, Genv.find_funct_ptr ge b = Some fd -> Plt b bound) (VARINFOS: forall b gv, Genv.find_var_info ge b = Some gv -> Plt b bound). -Inductive match_stacks (j: meminj) (m m': mem): +Inductive match_stacks (j: meminj) (m m': mem): list Linear.stackframe -> list stackframe -> signature -> block -> block -> Prop := | match_stacks_empty: forall sg hi bound bound', Ple hi bound -> Ple hi bound' -> match_globalenvs j hi -> @@ -1919,9 +1919,9 @@ Lemma match_stacks_change_bounds: Ple bound xbound -> Ple bound' xbound' -> match_stacks j m1 m' cs cs' sg xbound xbound'. Proof. - induction 1; intros. - apply match_stacks_empty with hi; auto. apply Ple_trans with bound; eauto. apply Ple_trans with bound'; eauto. - econstructor; eauto. eapply Plt_le_trans; eauto. eapply Plt_le_trans; eauto. + induction 1; intros. + apply match_stacks_empty with hi; auto. apply Ple_trans with bound; eauto. apply Ple_trans with bound'; eauto. + econstructor; eauto. eapply Plt_le_trans; eauto. eapply Plt_le_trans; eauto. Qed. (** Invariance with respect to change of [m]. *) @@ -1936,7 +1936,7 @@ Proof. induction 1; intros. econstructor; eauto. econstructor; eauto. - eapply agree_frame_invariant; eauto. + eapply agree_frame_invariant; eauto. apply IHmatch_stacks. intros. apply H0; auto. apply Plt_trans with sp; auto. intros. apply H1. apply Plt_trans with sp; auto. auto. @@ -1955,11 +1955,11 @@ Proof. induction 1; intros. econstructor; eauto. econstructor; eauto. - eapply agree_frame_invariant; eauto. - apply IHmatch_stacks. - intros; apply H0; auto. apply Plt_trans with sp'; auto. - intros; apply H1; auto. apply Plt_trans with sp'; auto. - intros; apply H2; auto. apply Plt_trans with sp'; auto. + eapply agree_frame_invariant; eauto. + apply IHmatch_stacks. + intros; apply H0; auto. apply Plt_trans with sp'; auto. + intros; apply H1; auto. apply Plt_trans with sp'; auto. + intros; apply H2; auto. apply Plt_trans with sp'; auto. Qed. (** A variant of the latter, for use with external calls *) @@ -1977,10 +1977,10 @@ Proof. econstructor; eauto. econstructor; eauto. eapply agree_frame_extcall_invariant; eauto. - apply IHmatch_stacks. - intros; apply H0; auto. apply Plt_trans with sp; auto. + apply IHmatch_stacks. + intros; apply H0; auto. apply Plt_trans with sp; auto. intros; apply H1. apply Plt_trans with sp; auto. auto. - intros; apply H2; auto. apply Plt_trans with sp'; auto. + intros; apply H2; auto. apply Plt_trans with sp'; auto. auto. Qed. @@ -2002,8 +2002,8 @@ Proof. intros [b' delta'] EQ. rewrite (H _ _ _ EQ) in H3. inv H3. eauto. intros EQ. exploit H0; eauto. intros [A B]. elim B. red. apply Plt_le_trans with hi. auto. apply Ple_trans with bound'; auto. - econstructor; eauto. - eapply agree_frame_inject_incr; eauto. red. eapply Plt_le_trans; eauto. + econstructor; eauto. + eapply agree_frame_inject_incr; eauto. red. eapply Plt_le_trans; eauto. apply IHmatch_stacks. apply Ple_trans with bound'; auto. apply Plt_Ple; auto. Qed. @@ -2040,11 +2040,11 @@ Lemma match_stack_change_extcall: Ple bound (Mem.nextblock m1) -> Ple bound' (Mem.nextblock m1') -> match_stacks j' m2 m2' cs cs' sg bound bound'. Proof. - intros. - eapply match_stacks_change_meminj; eauto. + intros. + eapply match_stacks_change_meminj; eauto. eapply match_stacks_change_mem_extcall; eauto. intros; eapply external_call_valid_block; eauto. - intros; eapply external_call_max_perm; eauto. red. eapply Plt_le_trans; eauto. + intros; eapply external_call_max_perm; eauto. red. eapply Plt_le_trans; eauto. intros; eapply external_call_valid_block; eauto. Qed. @@ -2057,7 +2057,7 @@ Lemma match_stacks_change_sig: match_stacks j m m' cs cs' sg1 bound bound'. Proof. induction 1; intros. - econstructor; eauto. + econstructor; eauto. econstructor; eauto. intros. elim (H0 _ H1). Qed. @@ -2077,7 +2077,7 @@ Lemma match_stacks_preserves_globals: meminj_preserves_globals ge j. Proof. intros. exploit match_stacks_globalenvs; eauto. intros [hi MG]. inv MG. - split. eauto. split. eauto. intros. symmetry. eauto. + split. eauto. split. eauto. intros. symmetry. eauto. Qed. (** Typing properties of [match_stacks]. *) @@ -2109,7 +2109,7 @@ Remark find_label_fold_right: (forall x k, Mach.find_label lbl (fn x k) = Mach.find_label lbl k) -> forall (args: list A) k, Mach.find_label lbl (List.fold_right fn k args) = Mach.find_label lbl k. Proof. - induction args; simpl. auto. + induction args; simpl. auto. intros. rewrite H. auto. Qed. @@ -2119,10 +2119,10 @@ Remark find_label_save_callee_save: Proof. intros. unfold save_callee_save, save_callee_save_int, save_callee_save_float, save_callee_save_regs. repeat rewrite find_label_fold_right. reflexivity. - intros. unfold save_callee_save_reg. + intros. unfold save_callee_save_reg. case (zlt (index_float_callee_save x) (fe_num_float_callee_save fe)); intro; reflexivity. - intros. unfold save_callee_save_reg. + intros. unfold save_callee_save_reg. case (zlt (index_int_callee_save x) (fe_num_int_callee_save fe)); intro; reflexivity. Qed. @@ -2133,10 +2133,10 @@ Remark find_label_restore_callee_save: Proof. intros. unfold restore_callee_save, restore_callee_save_int, restore_callee_save_float, restore_callee_save_regs. repeat rewrite find_label_fold_right. reflexivity. - intros. unfold restore_callee_save_reg. + intros. unfold restore_callee_save_reg. case (zlt (index_float_callee_save x) (fe_num_float_callee_save fe)); intro; reflexivity. - intros. unfold restore_callee_save_reg. + intros. unfold restore_callee_save_reg. case (zlt (index_int_callee_save x) (fe_num_int_callee_save fe)); intro; reflexivity. Qed. @@ -2154,7 +2154,7 @@ Lemma find_label_transl_code: Proof. induction c; simpl; intros. auto. - rewrite transl_code_eq. + rewrite transl_code_eq. destruct a; unfold transl_instr; auto. destruct s; simpl; auto. destruct s; simpl; auto. @@ -2167,10 +2167,10 @@ Lemma transl_find_label: forall f tf lbl c, transf_function f = OK tf -> Linear.find_label lbl f.(Linear.fn_code) = Some c -> - Mach.find_label lbl tf.(Mach.fn_code) = + Mach.find_label lbl tf.(Mach.fn_code) = Some (transl_code (make_env (function_bounds f)) c). Proof. - intros. rewrite (unfold_transf_function _ _ H). simpl. + intros. rewrite (unfold_transf_function _ _ H). simpl. unfold transl_body. rewrite find_label_save_callee_save. rewrite find_label_transl_code. rewrite H0. reflexivity. Qed. @@ -2180,7 +2180,7 @@ End LABELS. (** Code tail property for Linear executions. *) Lemma find_label_tail: - forall lbl c c', + forall lbl c c', Linear.find_label lbl c = Some c' -> is_tail c' c. Proof. induction c; simpl. @@ -2197,7 +2197,7 @@ Lemma is_tail_save_callee_save_regs: is_tail k (save_callee_save_regs bound number mkindex ty fe csl k). Proof. induction csl; intros; simpl. auto with coqlib. - unfold save_callee_save_reg. destruct (zlt (number a) (bound fe)). + unfold save_callee_save_reg. destruct (zlt (number a) (bound fe)). constructor; auto. auto. Qed. @@ -2214,7 +2214,7 @@ Lemma is_tail_restore_callee_save_regs: is_tail k (restore_callee_save_regs bound number mkindex ty fe csl k). Proof. induction csl; intros; simpl. auto with coqlib. - unfold restore_callee_save_reg. destruct (zlt (number a) (bound fe)). + unfold restore_callee_save_reg. destruct (zlt (number a) (bound fe)). constructor; auto. auto. Qed. @@ -2241,7 +2241,7 @@ Lemma is_tail_transl_code: forall fe c1 c2, is_tail c1 c2 -> is_tail (transl_code fe c1) (transl_code fe c2). Proof. induction 1; simpl. auto with coqlib. - rewrite transl_code_eq. + rewrite transl_code_eq. eapply is_tail_trans. eauto. apply is_tail_transl_instr. Qed. @@ -2251,7 +2251,7 @@ Lemma is_tail_transf_function: is_tail c (Linear.fn_code f) -> is_tail (transl_code (make_env (function_bounds f)) c) (fn_code tf). Proof. - intros. rewrite (unfold_transf_function _ _ H). simpl. + intros. rewrite (unfold_transf_function _ _ H). simpl. unfold transl_body. eapply is_tail_trans. 2: apply is_tail_save_callee_save. apply is_tail_transl_code; auto. Qed. @@ -2263,25 +2263,25 @@ Qed. Lemma symbols_preserved: forall id, Genv.find_symbol tge id = Genv.find_symbol ge id. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.find_symbol_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma public_preserved: forall id, Genv.public_symbol tge id = Genv.public_symbol ge id. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.public_symbol_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma varinfo_preserved: forall b, Genv.find_var_info tge b = Genv.find_var_info ge b. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.find_var_info_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma functions_translated: @@ -2305,7 +2305,7 @@ Lemma sig_preserved: Proof. intros until tf; unfold transf_fundef, transf_partial_fundef. destruct f; intros; monadInv H. - rewrite (unfold_transf_function _ _ EQ). auto. + rewrite (unfold_transf_function _ _ EQ). auto. auto. Qed. @@ -2320,17 +2320,17 @@ Lemma find_function_translated: /\ transf_fundef f = OK tf. Proof. intros until f; intros AG MS FF. - exploit match_stacks_globalenvs; eauto. intros [hi MG]. + exploit match_stacks_globalenvs; eauto. intros [hi MG]. destruct ros; simpl in FF. - exploit Genv.find_funct_inv; eauto. intros [b EQ]. rewrite EQ in FF. - rewrite Genv.find_funct_find_funct_ptr in FF. + exploit Genv.find_funct_inv; eauto. intros [b EQ]. rewrite EQ in FF. + rewrite Genv.find_funct_find_funct_ptr in FF. exploit function_ptr_translated; eauto. intros [tf [A B]]. exists b; exists tf; split; auto. simpl. generalize (AG m0). rewrite EQ. intro INJ. inv INJ. - inv MG. rewrite DOMAIN in H2. inv H2. simpl. auto. eapply FUNCTIONS; eauto. - destruct (Genv.find_symbol ge i) as [b|] eqn:?; try discriminate. + inv MG. rewrite DOMAIN in H2. inv H2. simpl. auto. eapply FUNCTIONS; eauto. + destruct (Genv.find_symbol ge i) as [b|] eqn:?; try discriminate. exploit function_ptr_translated; eauto. intros [tf [A B]]. - exists b; exists tf; split; auto. simpl. + exists b; exists tf; split; auto. simpl. rewrite symbols_preserved. auto. Qed. @@ -2358,21 +2358,21 @@ Proof. intros. assert (loc_argument_acceptable l). apply loc_arguments_acceptable with sg; auto. destruct l; red in H0. - exists (rs r); split. constructor. auto. + exists (rs r); split. constructor. auto. destruct sl; try contradiction. inv MS. elim (H4 _ H). unfold parent_sp. assert (slot_valid f Outgoing pos ty = true). - exploit loc_arguments_acceptable; eauto. intros [A B]. + exploit loc_arguments_acceptable; eauto. intros [A B]. unfold slot_valid. unfold proj_sumbool. rewrite zle_true by omega. destruct ty; auto; congruence. assert (slot_within_bounds (function_bounds f) Outgoing pos ty). eauto. exploit agree_outgoing; eauto. intros [v [A B]]. exists v; split. - constructor. - eapply index_contains_load_stack with (idx := FI_arg pos ty); eauto. + constructor. + eapply index_contains_load_stack with (idx := FI_arg pos ty); eauto. red in AGCS. rewrite AGCS; auto. Qed. @@ -2394,7 +2394,7 @@ Lemma transl_external_arguments: extcall_arguments rs m' (parent_sp cs') sg vl /\ Val.inject_list j (ls ## (loc_arguments sg)) vl. Proof. - unfold extcall_arguments. + unfold extcall_arguments. apply transl_external_arguments_rec. auto with coqlib. Qed. @@ -2435,34 +2435,34 @@ Local Opaque fe offset_of_index. - assert (loc_valid f x = true) by auto. destruct x as [r | [] ofs ty]; try discriminate. + exists (rs r); auto with barg. - + exploit agree_locals; eauto. intros [v [A B]]. inv A. + + exploit agree_locals; eauto. intros [v [A B]]. inv A. exists v; split; auto. constructor. simpl. rewrite Int.add_zero_l. Local Transparent fe. - unfold fe, b. erewrite offset_of_index_no_overflow by eauto. exact H1. + unfold fe, b. erewrite offset_of_index_no_overflow by eauto. exact H1. - econstructor; eauto with barg. - econstructor; eauto with barg. - econstructor; eauto with barg. - econstructor; eauto with barg. -- simpl in H. exploit Mem.load_inject; eauto. eapply agree_inj; eauto. +- simpl in H. exploit Mem.load_inject; eauto. eapply agree_inj; eauto. intros (v' & A & B). exists v'; split; auto. constructor. unfold Mem.loadv, Val.add. rewrite <- Int.add_assoc. unfold fe, b; erewrite shifted_stack_offset_no_overflow; eauto. - eapply agree_bounds; eauto. eapply Mem.valid_access_perm. eapply Mem.load_valid_access; eauto. + eapply agree_bounds; eauto. eapply Mem.valid_access_perm. eapply Mem.load_valid_access; eauto. - econstructor; split; eauto with barg. unfold Val.add. rewrite ! Int.add_zero_l. econstructor. eapply agree_inj; eauto. auto. - assert (Val.inject j (Senv.symbol_address ge id ofs) (Senv.symbol_address ge id ofs)). - { unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. + { unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) eqn:FS; auto. econstructor. eapply (proj1 GINJ); eauto. rewrite Int.add_zero; auto. } exploit Mem.loadv_inject; eauto. intros (v' & A & B). exists v'; auto with barg. -- econstructor; split; eauto with barg. - unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. +- econstructor; split; eauto with barg. + unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) eqn:FS; auto. econstructor. eapply (proj1 GINJ); eauto. rewrite Int.add_zero; auto. - destruct IHeval_builtin_arg1 as (v1 & A1 & B1); auto using in_or_app. destruct IHeval_builtin_arg2 as (v2 & A2 & B2); auto using in_or_app. - exists (Val.longofwords v1 v2); split; auto with barg. - apply Val.longofwords_inject; auto. + exists (Val.longofwords v1 v2); split; auto with barg. + apply Val.longofwords_inject; auto. Qed. Lemma transl_builtin_args_correct: @@ -2478,7 +2478,7 @@ Proof. - exists (@nil val); split; constructor. - exploit transl_builtin_arg_correct; eauto using in_or_app. intros (v1' & A & B). exploit IHlist_forall2; eauto using in_or_app. intros (vl' & C & D). - exists (v1'::vl'); split; constructor; auto. + exists (v1'::vl'); split; constructor; auto. Qed. End BUILTIN_ARGUMENTS. @@ -2528,7 +2528,7 @@ Inductive match_states: Linear.state -> Mach.state -> Prop := match_states (Linear.Callstate cs f ls m) (Mach.Callstate cs' fb rs m') | match_states_return: - forall cs ls m cs' rs m' j sg + forall cs ls m cs' rs m' j sg (MINJ: Mem.inject j m m') (STACKS: match_stacks j m m' cs cs' sg (Mem.nextblock m) (Mem.nextblock m')) (AGREGS: agree_regs j ls rs) @@ -2546,7 +2546,7 @@ Proof. wt_function f = true -> is_tail (i :: c) (Linear.fn_code f) -> wt_instr f i = true). intros. unfold wt_function, wt_code in H. rewrite forallb_forall in H. - apply H. eapply is_tail_in; eauto. + apply H. eapply is_tail_in; eauto. *) induction 1; intros; try inv MS; @@ -2562,7 +2562,7 @@ Proof. + (* Lgetstack, local *) exploit agree_locals; eauto. intros [v [A B]]. econstructor; split. - apply plus_one. apply exec_Mgetstack. + apply plus_one. apply exec_Mgetstack. eapply index_contains_load_stack; eauto. econstructor; eauto with coqlib. apply agree_regs_set_reg; auto. @@ -2575,12 +2575,12 @@ Proof. subst bound bound' s cs'. exploit agree_outgoing. eexact FRM. eapply ARGS; eauto. exploit loc_arguments_acceptable; eauto. intros [A B]. - unfold slot_valid, proj_sumbool. rewrite zle_true. + unfold slot_valid, proj_sumbool. rewrite zle_true. destruct ty; reflexivity || congruence. omega. intros [v [A B]]. econstructor; split. - apply plus_one. eapply exec_Mgetparam; eauto. - rewrite (unfold_transf_function _ _ TRANSL). unfold fn_link_ofs. + apply plus_one. eapply exec_Mgetparam; eauto. + rewrite (unfold_transf_function _ _ TRANSL). unfold fn_link_ofs. eapply index_contains_load_stack with (idx := FI_link). eapply TRANSL. eapply agree_link; eauto. simpl parent_sp. change (offset_of_index (make_env (function_bounds f)) (FI_arg ofs ty)) @@ -2588,21 +2588,21 @@ Proof. eapply index_contains_load_stack with (idx := FI_arg ofs ty). eauto. eauto. exploit agree_incoming; eauto. intros EQ; simpl in EQ. econstructor; eauto with coqlib. econstructor; eauto. - apply agree_regs_set_reg. apply agree_regs_set_reg. auto. auto. congruence. - eapply agree_frame_set_reg; eauto. eapply agree_frame_set_reg; eauto. - apply caller_save_reg_within_bounds. + apply agree_regs_set_reg. apply agree_regs_set_reg. auto. auto. congruence. + eapply agree_frame_set_reg; eauto. eapply agree_frame_set_reg; eauto. + apply caller_save_reg_within_bounds. apply temp_for_parent_frame_caller_save. + (* Lgetstack, outgoing *) exploit agree_outgoing; eauto. intros [v [A B]]. econstructor; split. - apply plus_one. apply exec_Mgetstack. + apply plus_one. apply exec_Mgetstack. eapply index_contains_load_stack; eauto. econstructor; eauto with coqlib. apply agree_regs_set_reg; auto. apply agree_frame_set_reg; auto. - (* Lsetstack *) - exploit wt_state_setstack; eauto. intros (SV & SW). + exploit wt_state_setstack; eauto. intros (SV & SW). set (idx := match sl with | Local => FI_local ofs ty | Incoming => FI_link (*dummy*) @@ -2619,22 +2619,22 @@ Proof. apply plus_one. destruct sl; simpl in SW. econstructor. eapply store_stack_succeeds with (idx := idx); eauto. eauto. discriminate. - econstructor. eapply store_stack_succeeds with (idx := idx); eauto. auto. - econstructor. - eapply Mem.store_outside_inject; eauto. + econstructor. eapply store_stack_succeeds with (idx := idx); eauto. auto. + econstructor. + eapply Mem.store_outside_inject; eauto. intros. exploit agree_inj_unique; eauto. intros [EQ1 EQ2]; subst b' delta. rewrite size_type_chunk in H2. exploit offset_of_index_disj_stack_data_2; eauto. - exploit agree_bounds. eauto. apply Mem.perm_cur_max. eauto. + exploit agree_bounds. eauto. apply Mem.perm_cur_max. eauto. omega. apply match_stacks_change_mach_mem with m'; auto. - eauto with mem. eauto with mem. intros. rewrite <- H1; eapply Mem.load_store_other; eauto. left; apply Plt_ne; auto. - eauto. eauto. - apply agree_regs_set_slot. apply agree_regs_undef_regs; auto. + eauto with mem. eauto with mem. intros. rewrite <- H1; eapply Mem.load_store_other; eauto. left; apply Plt_ne; auto. + eauto. eauto. + apply agree_regs_set_slot. apply agree_regs_undef_regs; auto. destruct sl. + eapply agree_frame_set_local. eapply agree_frame_undef_locs; eauto. apply destroyed_by_setstack_caller_save. auto. auto. auto. - assumption. + assumption. + simpl in SW; discriminate. + eapply agree_frame_set_outgoing. eapply agree_frame_undef_locs; eauto. apply destroyed_by_setstack_caller_save. auto. auto. auto. @@ -2649,13 +2649,13 @@ Proof. eapply match_stacks_preserves_globals; eauto. eapply agree_inj; eauto. eapply agree_reglist; eauto. destruct H0 as [v' [A B]]. - econstructor; split. - apply plus_one. econstructor. - instantiate (1 := v'). rewrite <- A. apply eval_operation_preserved. + econstructor; split. + apply plus_one. econstructor. + instantiate (1 := v'). rewrite <- A. apply eval_operation_preserved. exact symbols_preserved. eauto. econstructor; eauto with coqlib. apply agree_regs_set_reg; auto. - rewrite transl_destroyed_by_op. apply agree_regs_undef_regs; auto. + rewrite transl_destroyed_by_op. apply agree_regs_undef_regs; auto. apply agree_frame_set_reg; auto. apply agree_frame_undef_locs; auto. apply destroyed_by_op_caller_save. @@ -2663,38 +2663,38 @@ Proof. assert (exists a', eval_addressing ge (Vptr sp' Int.zero) (transl_addr (make_env (function_bounds f)) addr) rs0##args = Some a' /\ Val.inject j a a'). - eapply eval_addressing_inject; eauto. + eapply eval_addressing_inject; eauto. eapply match_stacks_preserves_globals; eauto. eapply agree_inj; eauto. eapply agree_reglist; eauto. destruct H1 as [a' [A B]]. exploit Mem.loadv_inject; eauto. intros [v' [C D]]. - econstructor; split. - apply plus_one. econstructor. + econstructor; split. + apply plus_one. econstructor. instantiate (1 := a'). rewrite <- A. apply eval_addressing_preserved. exact symbols_preserved. eexact C. eauto. econstructor; eauto with coqlib. - apply agree_regs_set_reg. rewrite transl_destroyed_by_load. apply agree_regs_undef_regs; auto. auto. + apply agree_regs_set_reg. rewrite transl_destroyed_by_load. apply agree_regs_undef_regs; auto. auto. apply agree_frame_set_reg. apply agree_frame_undef_locs; auto. - apply destroyed_by_load_caller_save. auto. + apply destroyed_by_load_caller_save. auto. - (* Lstore *) assert (exists a', eval_addressing ge (Vptr sp' Int.zero) (transl_addr (make_env (function_bounds f)) addr) rs0##args = Some a' /\ Val.inject j a a'). - eapply eval_addressing_inject; eauto. + eapply eval_addressing_inject; eauto. eapply match_stacks_preserves_globals; eauto. eapply agree_inj; eauto. eapply agree_reglist; eauto. destruct H1 as [a' [A B]]. exploit Mem.storev_mapped_inject; eauto. intros [m1' [C D]]. - econstructor; split. - apply plus_one. econstructor. + econstructor; split. + apply plus_one. econstructor. instantiate (1 := a'). rewrite <- A. apply eval_addressing_preserved. exact symbols_preserved. eexact C. eauto. econstructor. eauto. - eapply match_stacks_parallel_stores. eexact MINJ. eexact B. eauto. eauto. auto. - eauto. eauto. - rewrite transl_destroyed_by_store. - apply agree_regs_undef_regs; auto. + eapply match_stacks_parallel_stores. eexact MINJ. eexact B. eauto. eauto. auto. + eauto. eauto. + rewrite transl_destroyed_by_store. + apply agree_regs_undef_regs; auto. apply agree_frame_undef_locs; auto. eapply agree_frame_parallel_stores; eauto. apply destroyed_by_store_caller_save. @@ -2727,23 +2727,23 @@ Proof. econstructor; eauto. apply match_stacks_change_sig with (Linear.fn_sig f); auto. apply match_stacks_change_bounds with stk sp'. - apply match_stacks_change_linear_mem with m. + apply match_stacks_change_linear_mem with m. apply match_stacks_change_mach_mem with m'0. - auto. - eauto with mem. intros. eapply Mem.perm_free_1; eauto. left; apply Plt_ne; auto. - intros. rewrite <- H1. eapply Mem.load_free; eauto. left; apply Plt_ne; auto. - eauto with mem. intros. eapply Mem.perm_free_3; eauto. - apply Plt_Ple. change (Mem.valid_block m' stk). eapply Mem.valid_block_free_1; eauto. eapply agree_valid_linear; eauto. - apply Plt_Ple. change (Mem.valid_block m1' sp'). eapply Mem.valid_block_free_1; eauto. eapply agree_valid_mach; eauto. - apply zero_size_arguments_tailcall_possible. eapply wt_state_tailcall; eauto. + auto. + eauto with mem. intros. eapply Mem.perm_free_1; eauto. left; apply Plt_ne; auto. + intros. rewrite <- H1. eapply Mem.load_free; eauto. left; apply Plt_ne; auto. + eauto with mem. intros. eapply Mem.perm_free_3; eauto. + apply Plt_Ple. change (Mem.valid_block m' stk). eapply Mem.valid_block_free_1; eauto. eapply agree_valid_linear; eauto. + apply Plt_Ple. change (Mem.valid_block m1' sp'). eapply Mem.valid_block_free_1; eauto. eapply agree_valid_mach; eauto. + apply zero_size_arguments_tailcall_possible. eapply wt_state_tailcall; eauto. - (* Lbuiltin *) destruct BOUND as [BND1 BND2]. exploit transl_builtin_args_correct; eauto. eapply match_stacks_preserves_globals; eauto. rewrite <- forallb_forall. eapply wt_state_builtin; eauto. - intros [vargs' [P Q]]. - exploit external_call_mem_inject; eauto. + intros [vargs' [P Q]]. + exploit external_call_mem_inject; eauto. eapply match_stacks_preserves_globals; eauto. intros [j' [res' [m1' [A [B [C [D [E [F G]]]]]]]]]. econstructor; split. @@ -2756,7 +2756,7 @@ Proof. apply Plt_Ple. change (Mem.valid_block m sp0). eapply agree_valid_linear; eauto. apply Plt_Ple. change (Mem.valid_block m'0 sp'). eapply agree_valid_mach; eauto. apply agree_regs_set_res; auto. apply agree_regs_undef_regs; auto. eapply agree_regs_inject_incr; eauto. - eapply agree_frame_inject_incr; eauto. + eapply agree_frame_inject_incr; eauto. apply agree_frame_set_res; auto. apply agree_frame_undef_regs; auto. apply agree_frame_extcall_invariant with m m'0; auto. eapply external_call_valid_block; eauto. @@ -2773,7 +2773,7 @@ Proof. econstructor; split. apply plus_one; eapply exec_Mgoto; eauto. apply transl_find_label; eauto. - econstructor; eauto. + econstructor; eauto. eapply find_label_tail; eauto. - (* Lcond, true *) @@ -2782,8 +2782,8 @@ Proof. eapply eval_condition_inject; eauto. eapply agree_reglist; eauto. eapply transl_find_label; eauto. econstructor. eauto. eauto. eauto. eauto. - apply agree_regs_undef_regs; auto. - apply agree_frame_undef_locs; auto. apply destroyed_by_cond_caller_save. + apply agree_regs_undef_regs; auto. + apply agree_frame_undef_locs; auto. apply destroyed_by_cond_caller_save. eapply find_label_tail; eauto. - (* Lcond, false *) @@ -2791,15 +2791,15 @@ Proof. apply plus_one. eapply exec_Mcond_false; eauto. eapply eval_condition_inject; eauto. eapply agree_reglist; eauto. econstructor. eauto. eauto. eauto. eauto. - apply agree_regs_undef_regs; auto. - apply agree_frame_undef_locs; auto. apply destroyed_by_cond_caller_save. + apply agree_regs_undef_regs; auto. + apply agree_frame_undef_locs; auto. apply destroyed_by_cond_caller_save. eauto with coqlib. - (* Ljumptable *) assert (rs0 arg = Vint n). { generalize (AGREGS arg). rewrite H. intro IJ; inv IJ; auto. } econstructor; split. - apply plus_one; eapply exec_Mjumptable; eauto. + apply plus_one; eapply exec_Mjumptable; eauto. apply transl_find_label; eauto. econstructor. eauto. eauto. eauto. eauto. apply agree_regs_undef_regs; auto. @@ -2814,37 +2814,37 @@ Proof. traceEq. econstructor; eauto. apply match_stacks_change_bounds with stk sp'. - apply match_stacks_change_linear_mem with m. + apply match_stacks_change_linear_mem with m. apply match_stacks_change_mach_mem with m'0. - eauto. - eauto with mem. intros. eapply Mem.perm_free_1; eauto. left; apply Plt_ne; auto. - intros. rewrite <- H1. eapply Mem.load_free; eauto. left; apply Plt_ne; auto. - eauto with mem. intros. eapply Mem.perm_free_3; eauto. - apply Plt_Ple. change (Mem.valid_block m' stk). eapply Mem.valid_block_free_1; eauto. eapply agree_valid_linear; eauto. - apply Plt_Ple. change (Mem.valid_block m1' sp'). eapply Mem.valid_block_free_1; eauto. eapply agree_valid_mach; eauto. + eauto. + eauto with mem. intros. eapply Mem.perm_free_1; eauto. left; apply Plt_ne; auto. + intros. rewrite <- H1. eapply Mem.load_free; eauto. left; apply Plt_ne; auto. + eauto with mem. intros. eapply Mem.perm_free_3; eauto. + apply Plt_Ple. change (Mem.valid_block m' stk). eapply Mem.valid_block_free_1; eauto. eapply agree_valid_linear; eauto. + apply Plt_Ple. change (Mem.valid_block m1' sp'). eapply Mem.valid_block_free_1; eauto. eapply agree_valid_mach; eauto. - (* internal function *) revert TRANSL. unfold transf_fundef, transf_partial_fundef. caseEq (transf_function f); simpl; try congruence. intros tfn TRANSL EQ. inversion EQ; clear EQ; subst tf. exploit function_prologue_correct; eauto. eapply wt_callstate_wt_regs; eauto. - eapply match_stacks_type_sp; eauto. + eapply match_stacks_type_sp; eauto. eapply match_stacks_type_retaddr; eauto. intros [j' [rs' [m2' [sp' [m3' [m4' [m5' [A [B [C [D [E [F [G [J [K L]]]]]]]]]]]]]]]]. econstructor; split. - eapply plus_left. econstructor; eauto. - rewrite (unfold_transf_function _ _ TRANSL). unfold fn_code. unfold transl_body. + eapply plus_left. econstructor; eauto. + rewrite (unfold_transf_function _ _ TRANSL). unfold fn_code. unfold transl_body. eexact D. traceEq. - generalize (Mem.alloc_result _ _ _ _ _ H). intro SP_EQ. + generalize (Mem.alloc_result _ _ _ _ _ H). intro SP_EQ. generalize (Mem.alloc_result _ _ _ _ _ A). intro SP'_EQ. - econstructor; eauto. + econstructor; eauto. apply match_stacks_change_mach_mem with m'0. apply match_stacks_change_linear_mem with m. rewrite SP_EQ; rewrite SP'_EQ. - eapply match_stacks_change_meminj; eauto. apply Ple_refl. - eauto with mem. intros. exploit Mem.perm_alloc_inv. eexact H. eauto. - rewrite dec_eq_false; auto. apply Plt_ne; auto. - intros. eapply stores_in_frame_valid; eauto with mem. + eapply match_stacks_change_meminj; eauto. apply Ple_refl. + eauto with mem. intros. exploit Mem.perm_alloc_inv. eexact H. eauto. + rewrite dec_eq_false; auto. apply Plt_ne; auto. + intros. eapply stores_in_frame_valid; eauto with mem. intros. eapply stores_in_frame_perm; eauto with mem. intros. rewrite <- H1. transitivity (Mem.load chunk m2' b ofs). eapply stores_in_frame_contents; eauto. eapply Mem.load_alloc_unchanged; eauto. red. congruence. @@ -2853,7 +2853,7 @@ Proof. - (* external function *) simpl in TRANSL. inversion TRANSL; subst tf. exploit transl_external_arguments; eauto. intros [vl [ARGS VINJ]]. - exploit external_call_mem_inject'; eauto. + exploit external_call_mem_inject'; eauto. eapply match_stacks_preserves_globals; eauto. intros [j' [res' [m1' [A [B [C [D [E [F G]]]]]]]]]. econstructor; split. @@ -2862,18 +2862,18 @@ Proof. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. econstructor; eauto. apply match_stacks_change_bounds with (Mem.nextblock m) (Mem.nextblock m'0). - inv H0; inv A. eapply match_stack_change_extcall; eauto. apply Ple_refl. apply Ple_refl. + inv H0; inv A. eapply match_stack_change_extcall; eauto. apply Ple_refl. apply Ple_refl. eapply external_call_nextblock'; eauto. eapply external_call_nextblock'; eauto. - apply agree_regs_set_regs; auto. apply agree_regs_inject_incr with j; auto. - apply agree_callee_save_set_result; auto. + apply agree_regs_set_regs; auto. apply agree_regs_inject_incr with j; auto. + apply agree_callee_save_set_result; auto. - (* return *) - inv STACKS. simpl in AGLOCS. + inv STACKS. simpl in AGLOCS. econstructor; split. - apply plus_one. apply exec_return. + apply plus_one. apply exec_return. econstructor; eauto. - apply agree_frame_return with rs0; auto. + apply agree_frame_return with rs0; auto. Qed. Lemma transf_initial_states: @@ -2883,13 +2883,13 @@ Proof. intros. inv H. exploit function_ptr_translated; eauto. intros [tf [FIND TR]]. econstructor; split. - econstructor. + econstructor. eapply Genv.init_mem_transf_partial; eauto. - rewrite (transform_partial_program_main _ _ TRANSF). + rewrite (transform_partial_program_main _ _ TRANSF). rewrite symbols_preserved. eauto. econstructor; eauto. eapply Genv.initmem_inject; eauto. - apply match_stacks_empty with (Mem.nextblock m0). apply Ple_refl. apply Ple_refl. + apply match_stacks_empty with (Mem.nextblock m0). apply Ple_refl. apply Ple_refl. constructor. intros. unfold Mem.flat_inj. apply pred_dec_true; auto. unfold Mem.flat_inj; intros. destruct (plt b1 (Mem.nextblock m0)); congruence. @@ -2902,21 +2902,21 @@ Proof. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> Linear.final_state st1 r -> Mach.final_state st2 r. Proof. intros. inv H0. inv H. inv STACKS. - generalize (AGREGS r0). rewrite H2. intros A; inv A. - econstructor; eauto. + generalize (AGREGS r0). rewrite H2. intros A; inv A. + econstructor; eauto. Qed. Lemma wt_prog: forall i fd, In (i, Gfun fd) prog.(prog_defs) -> wt_fundef fd. Proof. - intros. exploit transform_partial_program_succeeds; eauto. - intros [tfd TF]. destruct fd; simpl in *. + intros. exploit transform_partial_program_succeeds; eauto. + intros [tfd TF]. destruct fd; simpl in *. - monadInv TF. unfold transf_function in EQ. - destruct (wt_function f). auto. discriminate. + destruct (wt_function f). auto. discriminate. - auto. Qed. @@ -2924,16 +2924,16 @@ Theorem transf_program_correct: forward_simulation (Linear.semantics prog) (Mach.semantics return_address_offset tprog). Proof. set (ms := fun s s' => wt_state s /\ match_states s s'). - eapply forward_simulation_plus with (match_states := ms). + eapply forward_simulation_plus with (match_states := ms). - exact public_preserved. -- intros. exploit transf_initial_states; eauto. intros [st2 [A B]]. +- intros. exploit transf_initial_states; eauto. intros [st2 [A B]]. exists st2; split; auto. split; auto. - apply wt_initial_state with (prog := prog); auto. exact wt_prog. -- intros. destruct H. eapply transf_final_states; eauto. -- intros. destruct H0. + apply wt_initial_state with (prog := prog); auto. exact wt_prog. +- intros. destruct H. eapply transf_final_states; eauto. +- intros. destruct H0. exploit transf_step_correct; eauto. intros [s2' [A B]]. exists s2'; split. exact A. split. - eapply step_type_preservation; eauto. eexact wt_prog. eexact H. + eapply step_type_preservation; eauto. eexact wt_prog. eexact H. auto. Qed. diff --git a/backend/Tailcall.v b/backend/Tailcall.v index db246fec..e8ce9e25 100644 --- a/backend/Tailcall.v +++ b/backend/Tailcall.v @@ -27,7 +27,7 @@ Require Import Conventions. If the current function had a non-empty stack block, it could be that the called function accesses it, for instance if a pointer into the -stack block is passed as an argument. In this case, it would be +stack block is passed as an argument. In this case, it would be semantically incorrect to deallocate the stack block before the call, as [Itailcall] does. Therefore, the optimization can only be performed if the stack block of the current function is empty, in which case it makes @@ -47,7 +47,7 @@ The general pattern we recognize is therefore: The [is_return] function below recognizes this pattern. *) -Fixpoint is_return (n: nat) (f: function) (pc: node) (rret: reg) +Fixpoint is_return (n: nat) (f: function) (pc: node) (rret: reg) {struct n}: bool := match n with | O => false diff --git a/backend/Tailcallproof.v b/backend/Tailcallproof.v index 1c25d244..7e7b7b53 100644 --- a/backend/Tailcallproof.v +++ b/backend/Tailcallproof.v @@ -59,7 +59,7 @@ Proof. assert (forall n pc, (return_measure_rec n f pc <= n)%nat). induction n; intros; simpl. omega. - destruct (f!pc); try omega. + destruct (f!pc); try omega. destruct i; try omega. generalize (IHn n0). omega. generalize (IHn n0). omega. @@ -125,28 +125,28 @@ Lemma is_return_charact: Proof. induction n; intros. simpl in H. congruence. - generalize H. simpl. + generalize H. simpl. caseEq ((fn_code f)!pc); try congruence. intro i. caseEq i; try congruence. intros s; intros. eapply is_return_nop; eauto. eapply IHn; eauto. omega. unfold return_measure. rewrite <- (is_return_measure_rec f (S n) niter pc rret); auto. - rewrite <- (is_return_measure_rec f n niter s rret); auto. + rewrite <- (is_return_measure_rec f n niter s rret); auto. simpl. rewrite H2. omega. omega. - intros op args dst s EQ1 EQ2. + intros op args dst s EQ1 EQ2. caseEq (is_move_operation op args); try congruence. intros src IMO. destruct (Reg.eq rret src); try congruence. - subst rret. intro. - exploit is_move_operation_correct; eauto. intros [A B]. subst. + subst rret. intro. + exploit is_move_operation_correct; eauto. intros [A B]. subst. eapply is_return_move; eauto. eapply IHn; eauto. omega. unfold return_measure. rewrite <- (is_return_measure_rec f (S n) niter pc src); auto. - rewrite <- (is_return_measure_rec f n niter s dst); auto. + rewrite <- (is_return_measure_rec f n niter s dst); auto. simpl. rewrite EQ2. omega. omega. - - intros or EQ1 EQ2. destruct or; intros. - assert (r = rret). eapply proj_sumbool_true; eauto. subst r. + + intros or EQ1 EQ2. destruct or; intros. + assert (r = rret). eapply proj_sumbool_true; eauto. subst r. apply is_return_some; auto. apply is_return_none; auto. Qed. @@ -172,7 +172,7 @@ Proof. opt_typ_eq (sig_res s) (sig_res (fn_sig f))); intros. destruct (andb_prop _ _ H0). destruct (andb_prop _ _ H1). eapply transf_instr_tailcall; eauto. - eapply is_return_charact; eauto. + eapply is_return_charact; eauto. constructor. Qed. @@ -183,8 +183,8 @@ Lemma transf_instr_lookup: Proof. intros. unfold transf_function. destruct (zeq (fn_stacksize f) 0). - simpl. rewrite PTree.gmap. rewrite H. simpl. - exists (transf_instr f pc i); split. auto. apply transf_instr_charact; auto. + simpl. rewrite PTree.gmap. rewrite H. simpl. + exists (transf_instr f pc i); split. auto. apply transf_instr_charact; auto. exists i; split. auto. constructor. Qed. @@ -246,14 +246,14 @@ Proof (@Genv.find_funct_ptr_transf _ _ _ transf_fundef prog). Lemma sig_preserved: forall f, funsig (transf_fundef f) = funsig f. Proof. - destruct f; auto. simpl. unfold transf_function. - destruct (zeq (fn_stacksize f) 0); auto. + destruct f; auto. simpl. unfold transf_function. + destruct (zeq (fn_stacksize f) 0); auto. Qed. Lemma stacksize_preserved: forall f, fn_stacksize (transf_function f) = fn_stacksize f. Proof. - unfold transf_function. intros. + unfold transf_function. intros. destruct (zeq (fn_stacksize f) 0); auto. Qed. @@ -410,33 +410,33 @@ Proof. induction 1; intros; inv MS; EliminatedInstr. (* nop *) - TransfInstr. left. econstructor; split. + TransfInstr. left. econstructor; split. eapply exec_Inop; eauto. constructor; auto. (* eliminated nop *) assert (s0 = pc') by congruence. subst s0. - right. split. simpl. omega. split. auto. - econstructor; eauto. + right. split. simpl. omega. split. auto. + econstructor; eauto. (* op *) TransfInstr. - assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto. - exploit eval_operation_lessdef; eauto. - intros [v' [EVAL' VLD]]. + assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto. + exploit eval_operation_lessdef; eauto. + intros [v' [EVAL' VLD]]. left. exists (State s' (transf_function f) (Vptr sp0 Int.zero) pc' (rs'#res <- v') m'); split. eapply exec_Iop; eauto. rewrite <- EVAL'. apply eval_operation_preserved. exact symbols_preserved. econstructor; eauto. apply set_reg_lessdef; auto. (* eliminated move *) - rewrite H1 in H. clear H1. inv H. + rewrite H1 in H. clear H1. inv H. right. split. simpl. omega. split. auto. - econstructor; eauto. simpl in H0. rewrite PMap.gss. congruence. + econstructor; eauto. simpl in H0. rewrite PMap.gss. congruence. (* load *) TransfInstr. - assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto. - exploit eval_addressing_lessdef; eauto. + assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto. + exploit eval_addressing_lessdef; eauto. intros [a' [ADDR' ALD]]. - exploit Mem.loadv_extends; eauto. + exploit Mem.loadv_extends; eauto. intros [v' [LOAD' VLD]]. left. exists (State s' (transf_function f) (Vptr sp0 Int.zero) pc' (rs'#dst <- v') m'); split. eapply exec_Iload with (a := a'). eauto. rewrite <- ADDR'. @@ -445,10 +445,10 @@ Proof. (* store *) TransfInstr. - assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto. - exploit eval_addressing_lessdef; eauto. + assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto. + exploit eval_addressing_lessdef; eauto. intros [a' [ADDR' ALD]]. - exploit Mem.storev_extends. 2: eexact H1. eauto. eauto. apply RLD. + exploit Mem.storev_extends. 2: eexact H1. eauto. eauto. apply RLD. intros [m'1 [STORE' MLD']]. left. exists (State s' (transf_function f) (Vptr sp0 Int.zero) pc' rs' m'1); split. eapply exec_Istore with (a := a'). eauto. rewrite <- ADDR'. @@ -457,32 +457,32 @@ Proof. econstructor; eauto. (* call *) - exploit find_function_translated; eauto. intro FIND'. + exploit find_function_translated; eauto. intro FIND'. TransfInstr. (* call turned tailcall *) assert ({ m'' | Mem.free m' sp0 0 (fn_stacksize (transf_function f)) = Some m''}). - apply Mem.range_perm_free. rewrite stacksize_preserved. rewrite H7. + apply Mem.range_perm_free. rewrite stacksize_preserved. rewrite H7. red; intros; omegaContradiction. destruct X as [m'' FREE]. left. exists (Callstate s' (transf_fundef fd) (rs'##args) m''); split. - eapply exec_Itailcall; eauto. apply sig_preserved. + eapply exec_Itailcall; eauto. apply sig_preserved. constructor. eapply match_stackframes_tail; eauto. apply regs_lessdef_regs; auto. eapply Mem.free_right_extends; eauto. rewrite stacksize_preserved. rewrite H7. intros. omegaContradiction. (* call that remains a call *) left. exists (Callstate (Stackframe res (transf_function f) (Vptr sp0 Int.zero) pc' rs' :: s') (transf_fundef fd) (rs'##args) m'); split. - eapply exec_Icall; eauto. apply sig_preserved. - constructor. constructor; auto. apply regs_lessdef_regs; auto. auto. + eapply exec_Icall; eauto. apply sig_preserved. + constructor. constructor; auto. apply regs_lessdef_regs; auto. auto. -(* tailcall *) +(* tailcall *) exploit find_function_translated; eauto. intro FIND'. exploit Mem.free_parallel_extends; eauto. intros [m'1 [FREE EXT]]. TransfInstr. left. exists (Callstate s' (transf_fundef fd) (rs'##args) m'1); split. eapply exec_Itailcall; eauto. apply sig_preserved. rewrite stacksize_preserved; auto. - constructor. auto. apply regs_lessdef_regs; auto. auto. + constructor. auto. apply regs_lessdef_regs; auto. auto. (* builtin *) TransfInstr. @@ -498,18 +498,18 @@ Proof. econstructor; eauto. apply set_res_lessdef; auto. (* cond *) - TransfInstr. + TransfInstr. left. exists (State s' (transf_function f) (Vptr sp0 Int.zero) (if b then ifso else ifnot) rs' m'); split. eapply exec_Icond; eauto. apply eval_condition_lessdef with (rs##args) m; auto. apply regs_lessdef_regs; auto. - constructor; auto. + constructor; auto. (* jumptable *) - TransfInstr. + TransfInstr. left. exists (State s' (transf_function f) (Vptr sp0 Int.zero) pc' rs' m'); split. eapply exec_Ijumptable; eauto. generalize (RLD arg). rewrite H0. intro. inv H2. auto. - constructor; auto. + constructor; auto. (* return *) exploit Mem.free_parallel_extends; eauto. intros [m'1 [FREE EXT]]. @@ -521,11 +521,11 @@ Proof. auto. (* eliminated return None *) - assert (or = None) by congruence. subst or. - right. split. simpl. omega. split. auto. + assert (or = None) by congruence. subst or. + right. split. simpl. omega. split. auto. constructor. auto. simpl. constructor. - eapply Mem.free_left_extends; eauto. + eapply Mem.free_left_extends; eauto. (* eliminated return Some *) assert (or = Some r) by congruence. subst or. @@ -542,12 +542,12 @@ Proof. assert (fn_stacksize (transf_function f) = fn_stacksize f /\ fn_entrypoint (transf_function f) = fn_entrypoint f /\ fn_params (transf_function f) = fn_params f). - unfold transf_function. destruct (zeq (fn_stacksize f) 0); auto. - destruct H0 as [EQ1 [EQ2 EQ3]]. + unfold transf_function. destruct (zeq (fn_stacksize f) 0); auto. + destruct H0 as [EQ1 [EQ2 EQ3]]. left. econstructor; split. simpl. eapply exec_function_internal; eauto. rewrite EQ1; eauto. rewrite EQ2. rewrite EQ3. constructor; auto. - apply regs_lessdef_init_regs. auto. + apply regs_lessdef_init_regs. auto. (* external call *) exploit external_call_mem_extends; eauto. @@ -556,29 +556,29 @@ Proof. simpl. econstructor; eauto. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. - constructor; auto. + constructor; auto. (* returnstate *) - inv H2. + inv H2. (* synchronous return in both programs *) - left. econstructor; split. - apply exec_return. - constructor; auto. apply set_reg_lessdef; auto. + left. econstructor; split. + apply exec_return. + constructor; auto. apply set_reg_lessdef; auto. (* return instr in source program, eliminated because of tailcall *) - right. split. unfold measure. simpl length. + right. split. unfold measure. simpl length. change (S (length s) * (niter + 2))%nat - with ((niter + 2) + (length s) * (niter + 2))%nat. - generalize (return_measure_bounds (fn_code f) pc). omega. - split. auto. + with ((niter + 2) + (length s) * (niter + 2))%nat. + generalize (return_measure_bounds (fn_code f) pc). omega. + split. auto. econstructor; eauto. - rewrite Regmap.gss. auto. + rewrite Regmap.gss. auto. Qed. Lemma transf_initial_states: forall st1, initial_state prog st1 -> exists st2, initial_state tprog st2 /\ match_states st1 st2. Proof. - intros. inv H. + intros. inv H. exploit funct_ptr_translated; eauto. intro FIND. exists (Callstate nil (transf_fundef f) nil m0); split. econstructor; eauto. apply Genv.init_mem_transf. auto. @@ -586,14 +586,14 @@ Proof. rewrite symbols_preserved. eauto. reflexivity. rewrite <- H3. apply sig_preserved. - constructor. constructor. constructor. apply Mem.extends_refl. + constructor. constructor. constructor. apply Mem.extends_refl. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> final_state st1 r -> final_state st2 r. Proof. - intros. inv H0. inv H. inv H5. inv H3. constructor. + intros. inv H0. inv H. inv H5. inv H3. constructor. Qed. @@ -607,7 +607,7 @@ Proof. eexact public_preserved. eexact transf_initial_states. eexact transf_final_states. - exact transf_step_correct. + exact transf_step_correct. Qed. End PRESERVATION. diff --git a/backend/Tunneling.v b/backend/Tunneling.v index bdc8117e..fa7ff787 100644 --- a/backend/Tunneling.v +++ b/backend/Tunneling.v @@ -55,7 +55,7 @@ Require Import LTL. << L1: nop L2; L2: nop L1; >> - Coq warns us of this fact by not accepting the definition + Coq warns us of this fact by not accepting the definition of [branch_target] above. To handle this problem, we proceed in two passes. The first pass diff --git a/backend/Tunnelingproof.v b/backend/Tunnelingproof.v index e9e4856e..22f0521e 100644 --- a/backend/Tunnelingproof.v +++ b/backend/Tunnelingproof.v @@ -65,8 +65,8 @@ Proof. red; intros; simpl. rewrite PTree.gempty. apply U.repr_empty. (* inductive case *) - intros m uf pc bb; intros. destruct uf as [u f]. - assert (PC: U.repr u pc = pc). + intros m uf pc bb; intros. destruct uf as [u f]. + assert (PC: U.repr u pc = pc). generalize (H1 pc). rewrite H. auto. assert (record_goto' (u, f) pc bb = (u, f) \/ exists s, exists bb', bb = Lbranch s :: bb' /\ record_goto' (u, f) pc bb = (U.union u pc s, measure_edge u pc s f)). @@ -75,27 +75,27 @@ Proof. (* u and f are unchanged *) rewrite B. - red. intro pc'. simpl. rewrite PTree.gsspec. destruct (peq pc' pc). subst pc'. + red. intro pc'. simpl. rewrite PTree.gsspec. destruct (peq pc' pc). subst pc'. destruct bb; auto. destruct i; auto. - apply H1. + apply H1. (* b is Lbranch s, u becomes union u pc s, f becomes measure_edge u pc s f *) rewrite B. red. intro pc'. simpl. rewrite PTree.gsspec. destruct (peq pc' pc). subst pc'. rewrite EQ. (* The new instruction *) - rewrite (U.repr_union_2 u pc s); auto. rewrite U.repr_union_3. + rewrite (U.repr_union_2 u pc s); auto. rewrite U.repr_union_3. unfold measure_edge. destruct (peq (U.repr u s) pc). auto. right. split. auto. rewrite PC. rewrite peq_true. omega. (* An old instruction *) assert (U.repr u pc' = pc' -> U.repr (U.union u pc s) pc' = pc'). - intro. rewrite <- H2 at 2. apply U.repr_union_1. congruence. + intro. rewrite <- H2 at 2. apply U.repr_union_1. congruence. generalize (H1 pc'). simpl. destruct (m!pc'); auto. destruct b; auto. destruct i; auto. intros [P | [P Q]]. left; auto. right. split. apply U.sameclass_union_2. auto. unfold measure_edge. destruct (peq (U.repr u s) pc). auto. - rewrite P. destruct (peq (U.repr u s0) pc). omega. auto. + rewrite P. destruct (peq (U.repr u s0) pc). omega. auto. Qed. Definition record_gotos' (f: function) := @@ -104,12 +104,12 @@ Definition record_gotos' (f: function) := Lemma record_gotos_gotos': forall f, fst (record_gotos' f) = record_gotos f. Proof. - intros. unfold record_gotos', record_gotos. + intros. unfold record_gotos', record_gotos. repeat rewrite PTree.fold_spec. generalize (PTree.elements (fn_code f)) (U.empty) (fun _ : node => O). induction l; intros; simpl. auto. - unfold record_goto' at 2. unfold record_goto at 2. + unfold record_goto' at 2. unfold record_goto at 2. destruct (snd a). apply IHl. destruct i; apply IHl. Qed. @@ -128,7 +128,7 @@ Theorem record_gotos_correct: | _ => branch_target f pc = pc end. Proof. - intros. + intros. generalize (record_gotos'_correct f.(fn_code) pc). simpl. fold (record_gotos' f). unfold branch_map_correct, branch_target, count_gotos. rewrite record_gotos_gotos'. auto. @@ -284,14 +284,14 @@ Proof. (exists st2' : state, step tge (State ts (tunnel_function f) sp (branch_target f pc) rs m) E0 st2' /\ match_states (Block s f sp bb rs m) st2')). - intros. rewrite H0. econstructor; split. - econstructor. simpl. rewrite PTree.gmap1. rewrite H. simpl. eauto. + intros. rewrite H0. econstructor; split. + econstructor. simpl. rewrite PTree.gmap1. rewrite H. simpl. eauto. econstructor; eauto. - generalize (record_gotos_correct f pc). rewrite H. - destruct bb; auto. destruct i; auto. - intros [A | [B C]]. auto. - right. split. simpl. omega. + generalize (record_gotos_correct f pc). rewrite H. + destruct bb; auto. destruct i; auto. + intros [A | [B C]]. auto. + right. split. simpl. omega. split. auto. rewrite B. econstructor; eauto. @@ -302,7 +302,7 @@ Proof. econstructor; eauto. (* Lload *) left; simpl; econstructor; split. - eapply exec_Lload with (a := a). + eapply exec_Lload with (a := a). rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. eauto. eauto. econstructor; eauto. @@ -321,24 +321,24 @@ Proof. eauto. eauto. econstructor; eauto. (* Lcall *) - left; simpl; econstructor; split. + left; simpl; econstructor; split. eapply exec_Lcall with (fd := tunnel_fundef fd); eauto. apply find_function_translated; auto. rewrite sig_preserved. auto. econstructor; eauto. - constructor; auto. + constructor; auto. constructor; auto. (* Ltailcall *) - left; simpl; econstructor; split. + left; simpl; econstructor; split. eapply exec_Ltailcall with (fd := tunnel_fundef fd); eauto. - erewrite match_parent_locset; eauto. + erewrite match_parent_locset; eauto. apply find_function_translated; auto. apply sig_preserved. erewrite <- match_parent_locset; eauto. econstructor; eauto. (* Lbuiltin *) left; simpl; econstructor; split. - eapply exec_Lbuiltin; eauto. + eapply exec_Lbuiltin; eauto. eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. eapply external_call_symbols_preserved. eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. @@ -346,10 +346,10 @@ Proof. (* Lbranch (preserved) *) left; simpl; econstructor; split. - eapply exec_Lbranch; eauto. + eapply exec_Lbranch; eauto. fold (branch_target f pc). econstructor; eauto. (* Lbranch (eliminated) *) - right; split. simpl. omega. split. auto. constructor; auto. + right; split. simpl. omega. split. auto. constructor; auto. (* Lcond *) left; simpl; econstructor; split. @@ -357,9 +357,9 @@ Proof. destruct b; econstructor; eauto. (* Ljumptable *) left; simpl; econstructor; split. - eapply exec_Ljumptable. + eapply exec_Ljumptable. eauto. rewrite list_nth_z_map. change U.elt with node. rewrite H0. reflexivity. eauto. - econstructor; eauto. + econstructor; eauto. (* Lreturn *) left; simpl; econstructor; split. eapply exec_Lreturn; eauto. @@ -368,13 +368,13 @@ Proof. (* internal function *) left; simpl; econstructor; split. eapply exec_function_internal; eauto. - simpl. econstructor; eauto. + simpl. econstructor; eauto. (* external function *) left; simpl; econstructor; split. eapply exec_function_external; eauto. eapply external_call_symbols_preserved'; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. - simpl. econstructor; eauto. + simpl. econstructor; eauto. (* return *) inv H3. inv H1. left; econstructor; split. @@ -386,22 +386,22 @@ Lemma transf_initial_states: forall st1, initial_state prog st1 -> exists st2, initial_state tprog st2 /\ match_states st1 st2. Proof. - intros. inversion H. + intros. inversion H. exists (Callstate nil (tunnel_fundef f) (Locmap.init Vundef) m0); split. econstructor; eauto. apply Genv.init_mem_transf; auto. change (prog_main tprog) with (prog_main prog). rewrite symbols_preserved. eauto. apply function_ptr_translated; auto. - rewrite <- H3. apply sig_preserved. + rewrite <- H3. apply sig_preserved. constructor. constructor. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> final_state st1 r -> final_state st2 r. Proof. - intros. inv H0. inv H. inv H6. econstructor; eauto. + intros. inv H0. inv H. inv H6. econstructor; eauto. Qed. Theorem transf_program_correct: @@ -411,7 +411,7 @@ Proof. eexact public_preserved. eexact transf_initial_states. eexact transf_final_states. - eexact tunnel_step_correct. + eexact tunnel_step_correct. Qed. End PRESERVATION. diff --git a/backend/Unusedglobproof.v b/backend/Unusedglobproof.v index 4d7547f0..7c1b60a9 100644 --- a/backend/Unusedglobproof.v +++ b/backend/Unusedglobproof.v @@ -37,7 +37,7 @@ Module ISP := FSetProperties.Properties(IS). (** Monotonic evolution of the workset. *) -Inductive workset_incl (w1 w2: workset) : Prop := +Inductive workset_incl (w1 w2: workset) : Prop := workset_incl_intro: forall (SEEN: IS.Subset w1.(w_seen) w2.(w_seen)) (TODO: List.incl w1.(w_todo) w2.(w_todo)) @@ -53,7 +53,7 @@ Qed. Lemma workset_incl_refl: forall w, workset_incl w w. Proof. - intros; split. red; auto. red; auto. auto. + intros; split. red; auto. red; auto. auto. Qed. Lemma workset_incl_trans: @@ -62,7 +62,7 @@ Proof. intros. destruct H, H0; split. red; eauto. red; eauto. - intros. edestruct TRACK0; eauto. edestruct TRACK; eauto. + intros. edestruct TRACK0; eauto. edestruct TRACK; eauto. Qed. Lemma add_workset_incl: @@ -73,13 +73,13 @@ Proof. - split; simpl. + red; intros. apply IS.add_2; auto. + red; simpl; auto. - + intros. destruct (ident_eq id id0); auto. apply IS.add_3 in H; auto. + + intros. destruct (ident_eq id id0); auto. apply IS.add_3 in H; auto. Qed. Lemma addlist_workset_incl: forall l w, workset_incl w (addlist_workset l w). Proof. - induction l; simpl; intros. + induction l; simpl; intros. apply workset_incl_refl. eapply workset_incl_trans. apply add_workset_incl. eauto. Qed. @@ -90,14 +90,14 @@ Proof. unfold add_ref_function; intros. apply PTree_Properties.fold_rec. - auto. - apply workset_incl_refl. -- intros. apply workset_incl_trans with a; auto. +- intros. apply workset_incl_trans with a; auto. unfold add_ref_instruction. apply addlist_workset_incl. Qed. Lemma add_ref_globvar_incl: forall gv w, workset_incl w (add_ref_globvar gv w). Proof. - unfold add_ref_globvar; intros. + unfold add_ref_globvar; intros. revert w. induction (gvar_init gv); simpl; intros. apply workset_incl_refl. eapply workset_incl_trans; [ | eauto ]. @@ -108,7 +108,7 @@ Qed. Lemma add_ref_definition_incl: forall pm id w, workset_incl w (add_ref_definition pm id w). Proof. - unfold add_ref_definition; intros. + unfold add_ref_definition; intros. destruct (pm!id) as [[[] | ? ] | ]. apply add_ref_function_incl. apply workset_incl_refl. @@ -120,10 +120,10 @@ Lemma initial_workset_incl: forall p, workset_incl {| w_seen := IS.empty; w_todo := nil |} (initial_workset p). Proof. unfold initial_workset; intros. - eapply workset_incl_trans. 2: apply add_workset_incl. + eapply workset_incl_trans. 2: apply add_workset_incl. generalize {| w_seen := IS.empty; w_todo := nil |}. induction (prog_public p); simpl; intros. apply workset_incl_refl. - eapply workset_incl_trans. eapply add_workset_incl. eapply IHl. + eapply workset_incl_trans. eapply add_workset_incl. eapply IHl. Qed. (** Soundness properties for functions that add identifiers to the workset *) @@ -141,7 +141,7 @@ Lemma seen_addlist_workset: forall id l (w: workset), In id l -> IS.In id (addlist_workset l w). Proof. - induction l; simpl; intros. + induction l; simpl; intros. tauto. destruct H. subst a. eapply seen_workset_incl. apply addlist_workset_incl. apply seen_add_workset. @@ -159,9 +159,9 @@ Proof. - destruct H1 as (pc & i & A & B). apply H0; auto. exists pc, i; split; auto. rewrite H; auto. - destruct H as (pc & i & A & B). rewrite PTree.gempty in A; discriminate. - destruct H2 as (pc & i & A & B). rewrite PTree.gsspec in A. destruct (peq pc k). - + inv A. unfold add_ref_instruction. apply seen_addlist_workset; auto. - + unfold add_ref_instruction. eapply seen_workset_incl. apply addlist_workset_incl. - apply H1. exists pc, i; auto. + + inv A. unfold add_ref_instruction. apply seen_addlist_workset; auto. + + unfold add_ref_instruction. eapply seen_workset_incl. apply addlist_workset_incl. + apply H1. exists pc, i; auto. Qed. Definition ref_fundef (fd: fundef) (id: ident) : Prop := @@ -186,35 +186,35 @@ Proof. IS.In id' w \/ In (Init_addrof id' ofs) l -> IS.In id' (fold_left add_ref_init_data l w)). { - induction l; simpl; intros. + induction l; simpl; intros. tauto. apply IHl. intuition auto. - left. destruct a; simpl; auto. eapply seen_workset_incl. apply add_workset_incl. auto. + left. destruct a; simpl; auto. eapply seen_workset_incl. apply add_workset_incl. auto. subst; left; simpl. apply seen_add_workset. } - apply H0; auto. + apply H0; auto. Qed. Lemma seen_main_initial_workset: forall p, IS.In p.(prog_main) (initial_workset p). Proof. - unfold initial_workset; intros. apply seen_add_workset. + unfold initial_workset; intros. apply seen_add_workset. Qed. Lemma seen_public_initial_workset: forall p id, In id p.(prog_public) -> IS.In id (initial_workset p). Proof. - intros. unfold initial_workset. eapply seen_workset_incl. apply add_workset_incl. + intros. unfold initial_workset. eapply seen_workset_incl. apply add_workset_incl. assert (forall l (w: workset), IS.In id w \/ In id l -> IS.In id (fold_left (fun w id => add_workset id w) l w)). { induction l; simpl; intros. tauto. apply IHl. intuition auto; left. - eapply seen_workset_incl. apply add_workset_incl. auto. - subst a. apply seen_add_workset. + eapply seen_workset_incl. apply add_workset_incl. auto. + subst a. apply seen_add_workset. } - apply H0. auto. + apply H0. auto. Qed. (** * Semantic preservation *) @@ -248,16 +248,16 @@ Lemma iter_step_invariant: | inr w' => workset_invariant w' end. Proof. - unfold iter_step, workset_invariant, used_set_closed; intros. + unfold iter_step, workset_invariant, used_set_closed; intros. destruct (w_todo w) as [ | id rem ]; intros. - eapply H; eauto. - set (w' := {| w_seen := w.(w_seen); w_todo := rem |}) in *. destruct (add_ref_definition_incl pm id w'). destruct (ident_eq id id0). - + subst id0. eapply seen_add_ref_definition; eauto. + + subst id0. eapply seen_add_ref_definition; eauto. + exploit TRACK; eauto. intros [A|A]. - * apply SEEN. eapply H; eauto. simpl. - assert (~ In id0 rem). + * apply SEEN. eapply H; eauto. simpl. + assert (~ In id0 rem). { change rem with (w_todo w'). red; intros. elim H1; auto. } tauto. * contradiction. @@ -267,10 +267,10 @@ Theorem used_globals_sound: forall u, used_globals p = Some u -> used_set_closed u. Proof. unfold used_globals; intros. eapply PrimIter.iterate_prop with (P := workset_invariant); eauto. -- intros. apply iter_step_invariant; auto. -- destruct (initial_workset_incl p). - red; intros. edestruct TRACK; eauto. - simpl in H4. eelim IS.empty_1; eauto. +- intros. apply iter_step_invariant; auto. +- destruct (initial_workset_incl p). + red; intros. edestruct TRACK; eauto. + simpl in H4. eelim IS.empty_1; eauto. contradiction. Qed. @@ -286,7 +286,7 @@ Proof. - red; auto. Qed. -Definition used: IS.t := +Definition used: IS.t := match used_globals p with Some u => u | None => IS.empty end. Remark USED_GLOBALS: used_globals p = Some used. @@ -322,7 +322,7 @@ Remark filter_globdefs_accu: Proof. induction defs; simpl; intros. auto. - destruct a as [id gd]. destruct (IS.mem id u); auto. + destruct a as [id gd]. destruct (IS.mem id u); auto. rewrite <- IHdefs. auto. Qed. @@ -330,28 +330,28 @@ Remark filter_globdefs_nil: forall u accu defs, filter_globdefs u accu defs = filter_globdefs u nil defs ++ accu. Proof. - intros. rewrite <- filter_globdefs_accu. auto. + intros. rewrite <- filter_globdefs_accu. auto. Qed. Theorem transform_program_charact: forall id, (program_map tp)!id = if IS.mem id used then pm!id else None. Proof. - intros. + intros. assert (X: forall l u m1 m2, IS.In id u -> m1!id = m2!id -> (fold_left add_def_prog_map (filter_globdefs u nil l) m1)!id = (fold_left add_def_prog_map (List.rev l) m2)!id). { - induction l; simpl; intros. + induction l; simpl; intros. auto. - destruct a as [id1 gd1]. rewrite fold_left_app. simpl. + destruct a as [id1 gd1]. rewrite fold_left_app. simpl. destruct (IS.mem id1 u) eqn:MEM. - rewrite filter_globdefs_nil. rewrite fold_left_app. simpl. - unfold add_def_prog_map at 1 3. simpl. + rewrite filter_globdefs_nil. rewrite fold_left_app. simpl. + unfold add_def_prog_map at 1 3. simpl. rewrite ! PTree.gsspec. destruct (peq id id1). auto. - apply IHl; auto. apply IS.remove_2; auto. - unfold add_def_prog_map at 2. simpl. rewrite PTree.gso. apply IHl; auto. + apply IHl; auto. apply IS.remove_2; auto. + unfold add_def_prog_map at 2. simpl. rewrite PTree.gso. apply IHl; auto. red; intros; subst id1. assert (IS.mem id u = true) by (apply IS.mem_1; auto). congruence. } @@ -364,9 +364,9 @@ Proof. auto. destruct a as [id1 gd1]. destruct (IS.mem id1 u) eqn:MEM. - rewrite filter_globdefs_nil. rewrite fold_left_app. simpl. + rewrite filter_globdefs_nil. rewrite fold_left_app. simpl. unfold add_def_prog_map at 1. simpl. rewrite PTree.gso by congruence. eapply IHl; eauto. - rewrite ISF.remove_b. rewrite H; auto. + rewrite ISF.remove_b. rewrite H; auto. eapply IHl; eauto. } unfold pm, program_map. @@ -393,8 +393,8 @@ Definition genv_progmap_match (ge: genv) (pm: prog_map) : Prop := Lemma genv_program_map: forall p, genv_progmap_match (Genv.globalenv p) (program_map p). Proof. - intros. unfold Genv.globalenv, program_map. - assert (REC: forall defs g m, + intros. unfold Genv.globalenv, program_map. + assert (REC: forall defs g m, genv_progmap_match g m -> genv_progmap_match (Genv.add_globals g defs) (fold_left add_def_prog_map defs m)). { @@ -407,12 +407,12 @@ Proof. - rewrite PTree.gsspec. destruct (peq id id1); subst. + rewrite ! PTree.gss. auto. + destruct (Genv.genv_symb g)!id as [b|] eqn:S; rewrite PTree.gso by auto. - * rewrite PTree.gso. auto. apply Plt_ne. eapply Genv.genv_symb_range; eauto. + * rewrite PTree.gso. auto. apply Plt_ne. eapply Genv.genv_symb_range; eauto. * auto. - rewrite PTree.gsspec. destruct (peq id id1); subst. + rewrite ! PTree.gss. auto. + destruct (Genv.genv_symb g)!id as [b|] eqn:S; rewrite PTree.gso by auto. - * rewrite PTree.gso. auto. apply Plt_ne. eapply Genv.genv_symb_range; eauto. + * rewrite PTree.gso. auto. apply Plt_ne. eapply Genv.genv_symb_range; eauto. * auto. } apply REC. red; intros. unfold Genv.find_symbol, Genv.empty_genv; simpl. rewrite ! PTree.gempty; auto. @@ -421,7 +421,7 @@ Qed. Lemma transform_program_kept: forall id b, Genv.find_symbol tge id = Some b -> kept id. Proof. - intros. generalize (genv_program_map tp id). fold tge; rewrite H. + intros. generalize (genv_program_map tp id). fold tge; rewrite H. rewrite transform_program_charact. intros. destruct (IS.mem id used) eqn:U. unfold kept; apply IS.mem_2; auto. contradiction. @@ -454,7 +454,7 @@ Record meminj_preserves_globals (f: meminj) : Prop := { Definition init_meminj : meminj := fun b => match Genv.invert_symbol ge b with - | Some id => + | Some id => match Genv.find_symbol tge id with | Some b' => Some (b', 0) | None => None @@ -471,7 +471,7 @@ Proof. destruct (Genv.invert_symbol ge b) as [id|] eqn:S; try discriminate. destruct (Genv.find_symbol tge id) as [b''|] eqn:F; inv H. split. auto. exists id. split. apply Genv.invert_find_symbol; auto. auto. -Qed. +Qed. Lemma init_meminj_preserves_globals: meminj_preserves_globals init_meminj. @@ -487,35 +487,35 @@ Proof. exists b'; auto. rewrite H2 in H1; contradiction. - generalize (genv_program_map tp id). fold tge. rewrite H. intros. destruct (program_map tp)!id as [gd|] eqn:PM; try contradiction. - generalize (transform_program_charact id). rewrite PM. + generalize (transform_program_charact id). rewrite PM. destruct (IS.mem id used) eqn:USED; intros; try discriminate. generalize (genv_program_map p id). fold ge; fold pm. destruct (Genv.find_symbol ge id) as [b|] eqn:FS; intros; try congruence. - exists b; split; auto. unfold init_meminj. + exists b; split; auto. unfold init_meminj. erewrite Genv.find_invert_symbol by eauto. rewrite H. auto. - exploit init_meminj_invert; eauto. intros (A & id & B & C). generalize (genv_program_map p id) (genv_program_map tp id). fold ge; fold tge; fold pm. rewrite transform_program_charact. rewrite B, C. intros. destruct (IS.mem id used) eqn:KEPT; try contradiction. - destruct (pm!id) as [gd|] eqn:PM; try contradiction. + destruct (pm!id) as [gd|] eqn:PM; try contradiction. destruct gd as [fd'|gv']. - + assert (fd' = fd) by congruence. subst fd'. split. auto. split. auto. - intros. eapply kept_closed; eauto. red; apply IS.mem_2; auto. + + assert (fd' = fd) by congruence. subst fd'. split. auto. split. auto. + intros. eapply kept_closed; eauto. red; apply IS.mem_2; auto. + assert (b <> b) by (eapply Genv.genv_funs_vars; eassumption). congruence. - exploit init_meminj_invert; eauto. intros (A & id & B & C). split; auto. generalize (genv_program_map p id) (genv_program_map tp id). fold ge; fold tge; fold pm. rewrite transform_program_charact. rewrite B, C. intros. destruct (IS.mem id used); try contradiction. - destruct (pm!id) as [gd|]; try contradiction. - destruct gd as [fd'|gv']. + destruct (pm!id) as [gd|]; try contradiction. + destruct gd as [fd'|gv']. + assert (b <> b) by (eapply Genv.genv_funs_vars; eassumption). congruence. + congruence. - exploit init_meminj_invert; eauto. intros (A & id & B & C). split; auto. generalize (genv_program_map p id) (genv_program_map tp id). fold ge; fold tge; fold pm. rewrite transform_program_charact. rewrite B, C. intros. destruct (IS.mem id used); try contradiction. - destruct (pm!id) as [gd|]; try contradiction. - destruct gd as [fd'|gv']. + destruct (pm!id) as [gd|]; try contradiction. + destruct gd as [fd'|gv']. + assert (b' <> b') by (eapply Genv.genv_funs_vars; eassumption). congruence. + congruence. Qed. @@ -523,28 +523,28 @@ Qed. Lemma globals_symbols_inject: forall j, meminj_preserves_globals j -> symbols_inject j ge tge. Proof. - intros. + intros. assert (E1: Genv.genv_public ge = p.(prog_public)). { apply Genv.globalenv_public. } assert (E2: Genv.genv_public tge = p.(prog_public)). - { unfold tge; rewrite Genv.globalenv_public. + { unfold tge; rewrite Genv.globalenv_public. unfold transform_program in TRANSF. rewrite USED_GLOBALS in TRANSF. inversion TRANSF. auto. } split; [|split;[|split]]; intros. + simpl; unfold Genv.public_symbol; rewrite E1, E2. destruct (Genv.find_symbol tge id) as [b'|] eqn:TFS. - exploit symbols_inject_3; eauto. intros (b & FS & INJ). rewrite FS. auto. + exploit symbols_inject_3; eauto. intros (b & FS & INJ). rewrite FS. auto. destruct (Genv.find_symbol ge id) as [b|] eqn:FS; auto. destruct (in_dec ident_eq id (prog_public p)); simpl; auto. - exploit symbols_inject_2; eauto. apply kept_public; auto. + exploit symbols_inject_2; eauto. apply kept_public; auto. intros (b' & TFS' & INJ). congruence. - + eapply symbols_inject_1; eauto. - + simpl in *; unfold Genv.public_symbol in H0. + + eapply symbols_inject_1; eauto. + + simpl in *; unfold Genv.public_symbol in H0. destruct (Genv.find_symbol ge id) as [b|] eqn:FS; try discriminate. - rewrite E1 in H0. + rewrite E1 in H0. destruct (in_dec ident_eq id (prog_public p)); try discriminate. inv H1. - exploit symbols_inject_2; eauto. apply kept_public; auto. + exploit symbols_inject_2; eauto. apply kept_public; auto. intros (b' & A & B); exists b'; auto. - + simpl. unfold Genv.block_is_volatile. + + simpl. unfold Genv.block_is_volatile. destruct (Genv.find_var_info ge b1) as [gv|] eqn:V1. exploit var_info_inject; eauto. intros [A B]. rewrite A. auto. destruct (Genv.find_var_info tge b2) as [gv|] eqn:V2; auto. @@ -552,14 +552,14 @@ Proof. Qed. Lemma symbol_address_inject: - forall j id ofs, + forall j id ofs, meminj_preserves_globals j -> kept id -> Val.inject j (Genv.symbol_address ge id ofs) (Genv.symbol_address tge id ofs). Proof. intros. unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) as [b|] eqn:FS; auto. - exploit symbols_inject_2; eauto. intros (b' & TFS & INJ). rewrite TFS. + exploit symbols_inject_2; eauto. intros (b' & TFS & INJ). rewrite TFS. econstructor; eauto. rewrite Int.add_zero; auto. -Qed. +Qed. (** Semantic preservation *) @@ -569,7 +569,7 @@ Definition regset_inject (f: meminj) (rs rs': regset): Prop := Lemma regs_inject: forall f rs rs', regset_inject f rs rs' -> forall l, Val.inject_list f rs##l rs'##l. Proof. - induction l; simpl. constructor. constructor; auto. + induction l; simpl. constructor. constructor; auto. Qed. Lemma set_reg_inject: @@ -577,7 +577,7 @@ Lemma set_reg_inject: regset_inject f rs rs' -> Val.inject f v v' -> regset_inject f (rs#r <- v) (rs'#r <- v'). Proof. - intros; red; intros. rewrite ! Regmap.gsspec. destruct (peq r0 r); auto. + intros; red; intros. rewrite ! Regmap.gsspec. destruct (peq r0 r); auto. Qed. Lemma set_res_inject: @@ -585,13 +585,13 @@ Lemma set_res_inject: regset_inject f rs rs' -> Val.inject f v v' -> regset_inject f (regmap_setres res v rs) (regmap_setres res v' rs'). Proof. - intros. destruct res; auto. apply set_reg_inject; auto. + intros. destruct res; auto. apply set_reg_inject; auto. Qed. Lemma regset_inject_incr: forall f f' rs rs', regset_inject f rs rs' -> inject_incr f f' -> regset_inject f' rs rs'. Proof. - intros; red; intros. apply val_inject_incr with f; auto. + intros; red; intros. apply val_inject_incr with f; auto. Qed. Lemma regset_undef_inject: @@ -606,7 +606,7 @@ Lemma init_regs_inject: regset_inject f (init_regs args params) (init_regs args' params). Proof. induction 1; intros; destruct params; simpl; try (apply regset_undef_inject). - apply set_reg_inject; auto. + apply set_reg_inject; auto. Qed. Inductive match_stacks (j: meminj): @@ -631,7 +631,7 @@ Lemma match_stacks_preserves_globals: match_stacks j s ts bound tbound -> meminj_preserves_globals j. Proof. - induction 1; auto. + induction 1; auto. Qed. Lemma match_stacks_incr: @@ -645,7 +645,7 @@ Proof. - assert (SAME: forall b b' delta, Plt b (Genv.genv_next ge) -> j' b = Some(b', delta) -> j b = Some(b', delta)). { intros. destruct (j b) as [[b1 delta1] | ] eqn: J. - exploit H; eauto. congruence. + exploit H; eauto. congruence. exploit H3; eauto. intros [A B]. elim (Plt_strict b). eapply Plt_Ple_trans. eauto. eapply Ple_trans; eauto. } assert (SAME': forall b b' delta, Plt b' (Genv.genv_next tge) -> @@ -655,19 +655,19 @@ Proof. exploit H3; eauto. intros [A B]. elim (Plt_strict b'). eapply Plt_Ple_trans. eauto. eapply Ple_trans; eauto. } constructor; auto. constructor; intros. - + exploit symbols_inject_1; eauto. apply SAME; auto. - eapply Genv.genv_symb_range; eauto. - + exploit symbols_inject_2; eauto. intros (b' & A & B). + + exploit symbols_inject_1; eauto. apply SAME; auto. + eapply Genv.genv_symb_range; eauto. + + exploit symbols_inject_2; eauto. intros (b' & A & B). exists b'; auto. + exploit symbols_inject_3; eauto. intros (b & A & B). exists b; auto. - + eapply funct_ptr_inject; eauto. apply SAME; auto. + + eapply funct_ptr_inject; eauto. apply SAME; auto. eapply Genv.genv_funs_range; eauto. - + eapply var_info_inject; eauto. apply SAME; auto. + + eapply var_info_inject; eauto. apply SAME; auto. eapply Genv.genv_vars_range; eauto. - + eapply var_info_rev_inject; eauto. apply SAME'; auto. + + eapply var_info_rev_inject; eauto. apply SAME'; auto. eapply Genv.genv_vars_range; eauto. -- econstructor; eauto. +- econstructor; eauto. apply IHmatch_stacks. intros. exploit H1; eauto. intros [A B]. split; eapply Ple_trans; eauto. apply Plt_Ple; auto. apply Plt_Ple; auto. @@ -681,8 +681,8 @@ Lemma match_stacks_bound: match_stacks j s ts bound' tbound'. Proof. induction 1; intros. -- constructor; auto. eapply Ple_trans; eauto. eapply Ple_trans; eauto. -- econstructor; eauto. eapply Plt_Ple_trans; eauto. eapply Plt_Ple_trans; eauto. +- constructor; auto. eapply Ple_trans; eauto. eapply Ple_trans; eauto. +- econstructor; eauto. eapply Plt_Ple_trans; eauto. eapply Plt_Ple_trans; eauto. Qed. Inductive match_states: state -> state -> Prop := @@ -735,14 +735,14 @@ Lemma find_function_inject: find_function tge ros trs = Some fd /\ (forall id, ref_fundef fd id -> kept id). Proof. intros. destruct ros as [r|id]; simpl in *. -- exploit Genv.find_funct_inv; eauto. intros (b & R). rewrite R in H0. - rewrite Genv.find_funct_find_funct_ptr in H0. - specialize (H1 r). rewrite R in H1. inv H1. - exploit funct_ptr_inject; eauto. intros (A & B & C). +- exploit Genv.find_funct_inv; eauto. intros (b & R). rewrite R in H0. + rewrite Genv.find_funct_find_funct_ptr in H0. + specialize (H1 r). rewrite R in H1. inv H1. + exploit funct_ptr_inject; eauto. intros (A & B & C). rewrite B; auto. - destruct (Genv.find_symbol ge id) as [b|] eqn:FS; try discriminate. - exploit symbols_inject_2; eauto. intros (tb & P & Q). rewrite P. - exploit funct_ptr_inject; eauto. intros (A & B & C). + exploit symbols_inject_2; eauto. intros (tb & P & Q). rewrite P. + exploit funct_ptr_inject; eauto. intros (A & B & C). auto. Qed. @@ -759,28 +759,28 @@ Lemma eval_builtin_arg_inject: /\ Val.inject j v v'. Proof. induction 1; intros SP GL RS MI K; simpl in K. -- exists rs'#x; split; auto. constructor. +- exists rs'#x; split; auto. constructor. - econstructor; eauto with barg. - econstructor; eauto with barg. - econstructor; eauto with barg. - econstructor; eauto with barg. -- simpl in H. exploit Mem.load_inject; eauto. rewrite Zplus_0_r. +- simpl in H. exploit Mem.load_inject; eauto. rewrite Zplus_0_r. intros (v' & A & B). exists v'; auto with barg. - econstructor; split; eauto with barg. simpl. econstructor; eauto. rewrite Int.add_zero; auto. - assert (Val.inject j (Senv.symbol_address ge id ofs) (Senv.symbol_address tge id ofs)). - { unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. + { unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) as [b|] eqn:FS; auto. - exploit symbols_inject_2; eauto. intros (b' & A & B). rewrite A. + exploit symbols_inject_2; eauto. intros (b' & A & B). rewrite A. econstructor; eauto. rewrite Int.add_zero; auto. } exploit Mem.loadv_inject; eauto. intros (v' & A & B). exists v'; auto with barg. - econstructor; split; eauto with barg. - unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. + unfold Senv.symbol_address; simpl; unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) as [b|] eqn:FS; auto. - exploit symbols_inject_2; eauto. intros (b' & A & B). rewrite A. + exploit symbols_inject_2; eauto. intros (b' & A & B). rewrite A. econstructor; eauto. rewrite Int.add_zero; auto. - destruct IHeval_builtin_arg1 as (v1' & A1 & B1); eauto using in_or_app. destruct IHeval_builtin_arg2 as (v2' & A2 & B2); eauto using in_or_app. - exists (Val.longofwords v1' v2'); split; auto with barg. + exists (Val.longofwords v1' v2'); split; auto with barg. apply Val.longofwords_inject; auto. Qed. @@ -796,11 +796,11 @@ Lemma eval_builtin_args_inject: eval_builtin_args tge (fun r => rs'#r) (Vptr sp' Int.zero) m' al vl' /\ Val.inject_list j vl vl'. Proof. - induction 1; intros. + induction 1; intros. - exists (@nil val); split; constructor. -- simpl in H5. +- simpl in H5. exploit eval_builtin_arg_inject; eauto using in_or_app. intros (v1' & A & B). - destruct IHlist_forall2 as (vl' & C & D); eauto using in_or_app. + destruct IHlist_forall2 as (vl' & C & D); eauto using in_or_app. exists (v1' :: vl'); split; constructor; auto. Qed. @@ -812,36 +812,36 @@ Proof. induction 1; intros; inv MS. - (* nop *) - econstructor; split. - eapply exec_Inop; eauto. - econstructor; eauto. + econstructor; split. + eapply exec_Inop; eauto. + econstructor; eauto. - (* op *) - assert (A: exists tv, + assert (A: exists tv, eval_operation tge (Vptr tsp Int.zero) op trs##args tm = Some tv /\ Val.inject j v tv). - { apply eval_operation_inj with (ge1 := ge) (m1 := m) (sp1 := Vptr sp0 Int.zero) (vl1 := rs##args). + { apply eval_operation_inj with (ge1 := ge) (m1 := m) (sp1 := Vptr sp0 Int.zero) (vl1 := rs##args). intros; eapply Mem.valid_pointer_inject_val; eauto. intros; eapply Mem.weak_valid_pointer_inject_val; eauto. intros; eapply Mem.weak_valid_pointer_inject_no_overflow; eauto. intros; eapply Mem.different_pointers_inject; eauto. intros. apply symbol_address_inject. eapply match_stacks_preserves_globals; eauto. apply KEPT. red. exists pc, (Iop op args res pc'); auto. - econstructor; eauto. + econstructor; eauto. apply regs_inject; auto. assumption. } destruct A as (tv & B & C). econstructor; split. eapply exec_Iop; eauto. - econstructor; eauto. apply set_reg_inject; auto. + econstructor; eauto. apply set_reg_inject; auto. - (* load *) - assert (A: exists ta, + assert (A: exists ta, eval_addressing tge (Vptr tsp Int.zero) addr trs##args = Some ta /\ Val.inject j a ta). - { apply eval_addressing_inj with (ge1 := ge) (sp1 := Vptr sp0 Int.zero) (vl1 := rs##args). + { apply eval_addressing_inj with (ge1 := ge) (sp1 := Vptr sp0 Int.zero) (vl1 := rs##args). intros. apply symbol_address_inject. eapply match_stacks_preserves_globals; eauto. apply KEPT. red. exists pc, (Iload chunk addr args dst pc'); auto. - econstructor; eauto. + econstructor; eauto. apply regs_inject; auto. assumption. } destruct A as (ta & B & C). @@ -850,13 +850,13 @@ Proof. econstructor; eauto. apply set_reg_inject; auto. - (* store *) - assert (A: exists ta, + assert (A: exists ta, eval_addressing tge (Vptr tsp Int.zero) addr trs##args = Some ta /\ Val.inject j a ta). - { apply eval_addressing_inj with (ge1 := ge) (sp1 := Vptr sp0 Int.zero) (vl1 := rs##args). + { apply eval_addressing_inj with (ge1 := ge) (sp1 := Vptr sp0 Int.zero) (vl1 := rs##args). intros. apply symbol_address_inject. eapply match_stacks_preserves_globals; eauto. apply KEPT. red. exists pc, (Istore chunk addr args src pc'); auto. - econstructor; eauto. + econstructor; eauto. apply regs_inject; auto. assumption. } destruct A as (ta & B & C). @@ -865,45 +865,45 @@ Proof. econstructor; eauto. - (* call *) - exploit find_function_inject. - eapply match_stacks_preserves_globals; eauto. eauto. + exploit find_function_inject. + eapply match_stacks_preserves_globals; eauto. eauto. destruct ros as [r|id]. eauto. apply KEPT. red. econstructor; econstructor; split; eauto. simpl; auto. intros (A & B). - econstructor; split. eapply exec_Icall; eauto. - econstructor; eauto. + econstructor; split. eapply exec_Icall; eauto. + econstructor; eauto. econstructor; eauto. - change (Mem.valid_block m sp0). eapply Mem.valid_block_inject_1; eauto. - change (Mem.valid_block tm tsp). eapply Mem.valid_block_inject_2; eauto. + change (Mem.valid_block m sp0). eapply Mem.valid_block_inject_1; eauto. + change (Mem.valid_block tm tsp). eapply Mem.valid_block_inject_2; eauto. apply regs_inject; auto. - (* tailcall *) - exploit find_function_inject. - eapply match_stacks_preserves_globals; eauto. eauto. + exploit find_function_inject. + eapply match_stacks_preserves_globals; eauto. eauto. destruct ros as [r|id]. eauto. apply KEPT. red. econstructor; econstructor; split; eauto. simpl; auto. intros (A & B). exploit Mem.free_parallel_inject; eauto. rewrite ! Zplus_0_r. intros (tm' & C & D). econstructor; split. - eapply exec_Itailcall; eauto. - econstructor; eauto. + eapply exec_Itailcall; eauto. + econstructor; eauto. apply match_stacks_bound with stk tsp; auto. - apply Plt_Ple. + apply Plt_Ple. change (Mem.valid_block m' stk). eapply Mem.valid_block_inject_1; eauto. - apply Plt_Ple. + apply Plt_Ple. change (Mem.valid_block tm' tsp). eapply Mem.valid_block_inject_2; eauto. apply regs_inject; auto. - (* builtin *) - exploit eval_builtin_args_inject; eauto. + exploit eval_builtin_args_inject; eauto. eapply match_stacks_preserves_globals; eauto. - intros. apply KEPT. red. econstructor; econstructor; eauto. + intros. apply KEPT. red. econstructor; econstructor; eauto. intros (vargs' & P & Q). - exploit external_call_inject; eauto. + exploit external_call_inject; eauto. eapply match_stacks_preserves_globals; eauto. intros (j' & tv & tm' & A & B & C & D & E & F & G). econstructor; split. eapply exec_Ibuiltin; eauto. - eapply match_states_regular with (j := j'); eauto. - apply match_stacks_incr with j; auto. + eapply match_states_regular with (j := j'); eauto. + apply match_stacks_incr with j; auto. intros. exploit G; eauto. intros [U V]. assert (Mem.valid_block m sp0) by (eapply Mem.valid_block_inject_1; eauto). assert (Mem.valid_block tm tsp) by (eapply Mem.valid_block_inject_2; eauto). @@ -914,52 +914,52 @@ Proof. assert (C: eval_condition cond trs##args tm = Some b). { eapply eval_condition_inject; eauto. apply regs_inject; auto. } econstructor; split. - eapply exec_Icond with (pc' := if b then ifso else ifnot); eauto. + eapply exec_Icond with (pc' := if b then ifso else ifnot); eauto. econstructor; eauto. - (* jumptbl *) generalize (REGINJ arg); rewrite H0; intros INJ; inv INJ. econstructor; split. - eapply exec_Ijumptable; eauto. + eapply exec_Ijumptable; eauto. econstructor; eauto. - (* return *) exploit Mem.free_parallel_inject; eauto. rewrite ! Zplus_0_r. intros (tm' & C & D). econstructor; split. - eapply exec_Ireturn; eauto. - econstructor; eauto. + eapply exec_Ireturn; eauto. + econstructor; eauto. apply match_stacks_bound with stk tsp; auto. - apply Plt_Ple. + apply Plt_Ple. change (Mem.valid_block m' stk). eapply Mem.valid_block_inject_1; eauto. - apply Plt_Ple. + apply Plt_Ple. change (Mem.valid_block tm' tsp). eapply Mem.valid_block_inject_2; eauto. - destruct or; simpl; auto. + destruct or; simpl; auto. - (* internal function *) - exploit Mem.alloc_parallel_inject. eauto. eauto. apply Zle_refl. apply Zle_refl. + exploit Mem.alloc_parallel_inject. eauto. eauto. apply Zle_refl. apply Zle_refl. intros (j' & tm' & tstk & C & D & E & F & G). - assert (STK: stk = Mem.nextblock m) by (eapply Mem.alloc_result; eauto). - assert (TSTK: tstk = Mem.nextblock tm) by (eapply Mem.alloc_result; eauto). + assert (STK: stk = Mem.nextblock m) by (eapply Mem.alloc_result; eauto). + assert (TSTK: tstk = Mem.nextblock tm) by (eapply Mem.alloc_result; eauto). assert (STACKS': match_stacks j' s ts stk tstk). - { rewrite STK, TSTK. - apply match_stacks_incr with j; auto. - intros. destruct (eq_block b1 stk). - subst b1. rewrite F in H1; inv H1. subst b2. split; apply Ple_refl. + { rewrite STK, TSTK. + apply match_stacks_incr with j; auto. + intros. destruct (eq_block b1 stk). + subst b1. rewrite F in H1; inv H1. subst b2. split; apply Ple_refl. rewrite G in H1 by auto. congruence. } - econstructor; split. + econstructor; split. eapply exec_function_internal; eauto. eapply match_states_regular with (j := j'); eauto. - apply init_regs_inject; auto. apply val_inject_list_incr with j; auto. + apply init_regs_inject; auto. apply val_inject_list_incr with j; auto. - (* external function *) - exploit external_call_inject; eauto. + exploit external_call_inject; eauto. eapply match_stacks_preserves_globals; eauto. intros (j' & tres & tm' & A & B & C & D & E & F & G). econstructor; split. eapply exec_function_external; eauto. eapply match_states_return with (j := j'); eauto. apply match_stacks_bound with (Mem.nextblock m) (Mem.nextblock tm). - apply match_stacks_incr with j; auto. + apply match_stacks_incr with j; auto. intros. exploit G; eauto. intros [P Q]. unfold Mem.valid_block in *; xomega. eapply external_call_nextblock; eauto. @@ -967,8 +967,8 @@ Proof. - (* return *) inv STACKS. econstructor; split. - eapply exec_return. - econstructor; eauto. apply set_reg_inject; auto. + eapply exec_return. + econstructor; eauto. apply set_reg_inject; auto. Qed. (** Relating initial memory states *) @@ -976,11 +976,11 @@ Qed. Remark init_meminj_no_overlap: forall m, Mem.meminj_no_overlap init_meminj m. Proof. - intros; red; intros. + intros; red; intros. exploit init_meminj_invert. eexact H0. intros (A1 & id1 & B1 & C1). exploit init_meminj_invert. eexact H1. intros (A2 & id2 & B2 & C2). - left; red; intros; subst b2'. - assert (id1 = id2) by (eapply Genv.genv_vars_inj; eauto). + left; red; intros; subst b2'. + assert (id1 = id2) by (eapply Genv.genv_vars_inj; eauto). congruence. Qed. @@ -994,7 +994,7 @@ Lemma store_zeros_unmapped_inj: Proof. intros until m1'. functional induction (store_zeros m1 b1 i n); intros. inv H. auto. - eapply IHo; eauto. eapply Mem.store_unmapped_inj; eauto. + eapply IHo; eauto. eapply Mem.store_unmapped_inj; eauto. discriminate. Qed. @@ -1007,10 +1007,10 @@ Lemma store_zeros_mapped_inj: exists m2', store_zeros m2 b2 i n = Some m2' /\ Mem.mem_inj init_meminj m1' m2'. Proof. intros until m1'. functional induction (store_zeros m1 b1 i n); intros. - inv H. exists m2; split; auto. rewrite store_zeros_equation, e; auto. - exploit Mem.store_mapped_inj; eauto. apply init_meminj_no_overlap. instantiate (1 := Vzero); constructor. + inv H. exists m2; split; auto. rewrite store_zeros_equation, e; auto. + exploit Mem.store_mapped_inj; eauto. apply init_meminj_no_overlap. instantiate (1 := Vzero); constructor. intros (m2' & A & B). rewrite Zplus_0_r in A. - exploit IHo; eauto. intros (m3' & C & D). + exploit IHo; eauto. intros (m3' & C & D). exists m3'; split; auto. rewrite store_zeros_equation, e, A, C; auto. discriminate. Qed. @@ -1022,7 +1022,7 @@ Lemma store_init_data_unmapped_inj: init_meminj b1 = None -> Mem.mem_inj init_meminj m1' m2. Proof. - intros. destruct id; simpl in H; try (eapply Mem.store_unmapped_inj; now eauto). + intros. destruct id; simpl in H; try (eapply Mem.store_unmapped_inj; now eauto). inv H; auto. destruct (Genv.find_symbol ge i0); try discriminate. eapply Mem.store_unmapped_inj; now eauto. Qed. @@ -1039,8 +1039,8 @@ Proof. destruct init; simpl in *; try (eapply Mem.store_mapped_inj; now eauto). inv H. exists m2; auto. destruct (Genv.find_symbol ge i0) as [bi|] eqn:FS1; try discriminate. - exploit symbols_inject_2. eapply init_meminj_preserves_globals. eapply H2; eauto. eauto. - intros (bi' & A & B). rewrite A. eapply Mem.store_mapped_inj; eauto. + exploit symbols_inject_2. eapply init_meminj_preserves_globals. eapply H2; eauto. eauto. + intros (bi' & A & B). rewrite A. eapply Mem.store_mapped_inj; eauto. econstructor; eauto. rewrite Int.add_zero; auto. Qed. @@ -1051,7 +1051,7 @@ Qed. init_meminj b1 = None -> Mem.mem_inj init_meminj m1' m2. Proof. - induction initlist; simpl; intros. + induction initlist; simpl; intros. - inv H; auto. - destruct (Genv.store_init_data ge m1 b1 i a) as [m1''|] eqn:ST; try discriminate. eapply IHinitlist; eauto. eapply store_init_data_unmapped_inj; eauto. @@ -1070,7 +1070,7 @@ Proof. - destruct (Genv.store_init_data ge m1 b1 i a) as [m1''|] eqn:ST; try discriminate. exploit store_init_data_mapped_inj; eauto. intros (m2'' & A & B). exploit IHinitlist; eauto. intros (m2' & C & D). - exists m2'; split; auto. rewrite A; auto. + exists m2'; split; auto. rewrite A; auto. Qed. Lemma alloc_global_unmapped_inj: @@ -1082,16 +1082,16 @@ Lemma alloc_global_unmapped_inj: Proof. unfold Genv.alloc_global; intros. destruct g as [fd|gv]. - destruct (Mem.alloc m1 0 1) as (m1a, b) eqn:ALLOC. - exploit Mem.alloc_result; eauto. intros EQ. rewrite <- EQ in H1. - eapply Mem.drop_unmapped_inj with (m1 := m1a); eauto. + exploit Mem.alloc_result; eauto. intros EQ. rewrite <- EQ in H1. + eapply Mem.drop_unmapped_inj with (m1 := m1a); eauto. eapply Mem.alloc_left_unmapped_inj; eauto. - set (sz := Genv.init_data_list_size (gvar_init gv)) in *. destruct (Mem.alloc m1 0 sz) as (m1a, b) eqn:ALLOC. destruct (store_zeros m1a b 0 sz) as [m1b|] eqn: STZ; try discriminate. destruct (Genv.store_init_data_list ge m1b b 0 (gvar_init gv)) as [m1c|] eqn:ST; try discriminate. - exploit Mem.alloc_result; eauto. intros EQ. rewrite <- EQ in H1. + exploit Mem.alloc_result; eauto. intros EQ. rewrite <- EQ in H1. eapply Mem.drop_unmapped_inj with (m1 := m1c); eauto. - eapply store_init_data_list_unmapped_inj with (m1 := m1b); eauto. + eapply store_init_data_list_unmapped_inj with (m1 := m1b); eauto. eapply store_zeros_unmapped_inj with (m1 := m1a); eauto. eapply Mem.alloc_left_unmapped_inj; eauto. Qed. @@ -1114,10 +1114,10 @@ Proof. { eapply Mem.alloc_left_mapped_inj with (b1 := b1) (b2 := b2) (delta := 0). eapply Mem.alloc_right_inj; eauto. eauto. - eauto with mem. + eauto with mem. red; intros; apply Z.divide_0_r. - intros. apply Mem.perm_implies with Freeable; auto with mem. - eapply Mem.perm_alloc_2; eauto. omega. + intros. apply Mem.perm_implies with Freeable; auto with mem. + eapply Mem.perm_alloc_2; eauto. omega. auto. } exploit Mem.drop_mapped_inj; eauto. apply init_meminj_no_overlap. @@ -1132,14 +1132,14 @@ Proof. { eapply Mem.alloc_left_mapped_inj with (b1 := b1) (b2 := b2) (delta := 0). eapply Mem.alloc_right_inj; eauto. eauto. - eauto with mem. + eauto with mem. red; intros; apply Z.divide_0_r. - intros. apply Mem.perm_implies with Freeable; auto with mem. - eapply Mem.perm_alloc_2; eauto. omega. + intros. apply Mem.perm_implies with Freeable; auto with mem. + eapply Mem.perm_alloc_2; eauto. omega. auto. } exploit store_zeros_mapped_inj; eauto. intros (m2b & A & B). - exploit store_init_data_list_mapped_inj; eauto. + exploit store_init_data_list_mapped_inj; eauto. intros. apply H2. red. exists ofs; auto. intros (m2c & C & D). exploit Mem.drop_mapped_inj; eauto. apply init_meminj_no_overlap. intros (m2' & E & F). exists m2'; split; auto. rewrite ! Zplus_0_r in E. rewrite A, C, E. auto. @@ -1153,8 +1153,8 @@ Lemma alloc_globals_app: | Some m1 => Genv.alloc_globals g m1 defs2 end. Proof. - induction defs1; simpl; intros. auto. - destruct (Genv.alloc_global g m a); auto. + induction defs1; simpl; intros. auto. + destruct (Genv.alloc_global g m a); auto. Qed. Lemma alloc_globals_snoc: @@ -1166,7 +1166,7 @@ Lemma alloc_globals_snoc: end. Proof. intros. rewrite alloc_globals_app. - destruct (Genv.alloc_globals g m defs1); auto. unfold Genv.alloc_globals. + destruct (Genv.alloc_globals g m defs1); auto. unfold Genv.alloc_globals. destruct (Genv.alloc_global g m0 id_def); auto. Qed. @@ -1187,20 +1187,20 @@ Lemma alloc_globals_inj: Proof. induction defs; simpl; intros until g2; intros ALLOC GE1 GE2 NEXT1 SYMB1 SYMB2 SYMB3 PROGMAP. - inv ALLOC. exists Mem.empty. intuition auto. constructor; intros. - eelim Mem.perm_empty; eauto. - exploit init_meminj_invert; eauto. intros [A B]. subst delta. apply Z.divide_0_r. eelim Mem.perm_empty; eauto. -- rewrite Genv.add_globals_app in GE1. simpl in GE1. + exploit init_meminj_invert; eauto. intros [A B]. subst delta. apply Z.divide_0_r. + eelim Mem.perm_empty; eauto. +- rewrite Genv.add_globals_app in GE1. simpl in GE1. set (g1' := Genv.add_globals (Genv.empty_genv fundef unit pubs) (rev defs)) in *. rewrite alloc_globals_snoc in ALLOC. destruct (Genv.alloc_globals ge Mem.empty (rev defs)) as [m1'|] eqn:ALLOC1'; try discriminate. exploit Genv.alloc_global_nextblock; eauto. intros NEXTBLOCK1. - assert (NEXTGE1: Genv.genv_next g1 = Pos.succ (Genv.genv_next g1')) by (rewrite GE1; reflexivity). + assert (NEXTGE1: Genv.genv_next g1 = Pos.succ (Genv.genv_next g1')) by (rewrite GE1; reflexivity). assert (NEXT1': Mem.nextblock m1' = Genv.genv_next g1') by (unfold block in *; xomega). rewrite fold_left_app in PROGMAP. simpl in PROGMAP. destruct a as [id gd]. unfold add_def_prog_map at 1 in PROGMAP. simpl in PROGMAP. destruct (IS.mem id u) eqn:MEM. - + rewrite filter_globdefs_nil in *. rewrite alloc_globals_snoc. + + rewrite filter_globdefs_nil in *. rewrite alloc_globals_snoc. rewrite Genv.add_globals_app in GE2. simpl in GE2. set (g2' := Genv.add_globals (Genv.empty_genv fundef unit pubs) (filter_globdefs (IS.remove id u) nil defs)) in *. assert (NEXTGE2: Genv.genv_next g2 = Pos.succ (Genv.genv_next g2')) by (rewrite GE2; reflexivity). @@ -1209,15 +1209,15 @@ Proof. rewrite GE1. unfold Genv.find_symbol; simpl. rewrite PTree.gss. congruence. } exploit (IHdefs m1' (IS.remove id u) g1' g2'); eauto. intros. rewrite ISF.remove_iff in H; destruct H. - rewrite <- SYMB1 by auto. rewrite GE1. unfold Genv.find_symbol; simpl. + rewrite <- SYMB1 by auto. rewrite GE1. unfold Genv.find_symbol; simpl. rewrite PTree.gso; auto. intros. rewrite ISF.remove_iff in H; destruct H. - rewrite <- SYMB2 by auto. rewrite GE2. unfold Genv.find_symbol; simpl. + rewrite <- SYMB2 by auto. rewrite GE2. unfold Genv.find_symbol; simpl. rewrite PTree.gso; auto. intros. rewrite ISF.remove_iff. destruct (ident_eq id id0). subst id0. rewrite FS1 in H. inv H. eelim Plt_strict; eauto. - exploit SYMB3. eexact H. unfold block in *; xomega. auto. tauto. - intros. rewrite ISF.remove_iff in H; destruct H. + exploit SYMB3. eexact H. unfold block in *; xomega. auto. tauto. + intros. rewrite ISF.remove_iff in H; destruct H. rewrite <- PROGMAP by auto. rewrite PTree.gso by auto. auto. intros (m2' & A & B & C). fold g2' in B. assert (FS2: Genv.find_symbol tge id = Some (Mem.nextblock m2')). @@ -1226,16 +1226,16 @@ Proof. assert (INJ: init_meminj (Mem.nextblock m1') = Some (Mem.nextblock m2', 0)). { apply Genv.find_invert_symbol in FS1. unfold init_meminj. rewrite FS1, FS2. auto. } exploit alloc_global_mapped_inj. eexact ALLOC. eexact C. exact INJ. - intros. apply kept_closed with id gd. eapply transform_program_kept; eauto. - rewrite <- PROGMAP by (apply IS.mem_2; auto). apply PTree.gss. auto. + intros. apply kept_closed with id gd. eapply transform_program_kept; eauto. + rewrite <- PROGMAP by (apply IS.mem_2; auto). apply PTree.gss. auto. intros (m2 & D & E). - exploit Genv.alloc_global_nextblock; eauto. intros NEXTBLOCK2. - exists m2; split. rewrite A, D. auto. + exploit Genv.alloc_global_nextblock; eauto. intros NEXTBLOCK2. + exists m2; split. rewrite A, D. auto. split. unfold block in *; xomega. auto. - + exploit (IHdefs m1' u g1' g2); auto. - intros. rewrite <- SYMB1 by auto. rewrite GE1. - unfold Genv.find_symbol; simpl. rewrite PTree.gso; auto. + + exploit (IHdefs m1' u g1' g2); auto. + intros. rewrite <- SYMB1 by auto. rewrite GE1. + unfold Genv.find_symbol; simpl. rewrite PTree.gso; auto. red; intros; subst id0. apply IS.mem_1 in H. congruence. intros. eapply SYMB3; eauto. unfold block in *; xomega. intros. rewrite <- PROGMAP by auto. rewrite PTree.gso; auto. @@ -1248,8 +1248,8 @@ Proof. eapply transform_program_kept; eauto. intros P. revert V. rewrite <- SYMB1, GE1 by auto. unfold Genv.find_symbol; simpl. - rewrite PTree.gsspec. rewrite NEXT1'. destruct (peq id1 id); intros Q. - subst id1. apply IS.mem_1 in P. congruence. + rewrite PTree.gsspec. rewrite NEXT1'. destruct (peq id1 id); intros Q. + subst id1. apply IS.mem_1 in P. congruence. eelim Plt_strict. eapply Genv.genv_symb_range; eauto. } exists m2; intuition auto. eapply alloc_global_unmapped_inj; eauto. Qed. @@ -1262,15 +1262,15 @@ Proof. intros. unfold transform_program in TRANSF; rewrite USED_GLOBALS in TRANSF; injection TRANSF. intros EQ. destruct (alloc_globals_inj (prog_public p) (List.rev (prog_defs p)) m used ge tge) as (tm & A & B & C). - rewrite rev_involutive; auto. + rewrite rev_involutive; auto. rewrite rev_involutive; auto. unfold tge; rewrite <- EQ; auto. - symmetry. apply Genv.init_mem_genv_next; auto. + symmetry. apply Genv.init_mem_genv_next; auto. auto. auto. auto. intros. rewrite rev_involutive. auto. assert (D: Genv.init_mem tp = Some tm). { unfold Genv.init_mem. fold tge. rewrite <- EQ. exact A. } - pose proof (init_meminj_preserves_globals). + pose proof (init_meminj_preserves_globals). exists init_meminj, tm; intuition auto. constructor; intros. + auto. @@ -1280,7 +1280,7 @@ Proof. + exploit init_meminj_invert; eauto. intros (P & id & Q & R). eapply Genv.find_symbol_not_fresh; eauto. + apply init_meminj_no_overlap. - + exploit init_meminj_invert; eauto. intros (P & id & Q & R). + + exploit init_meminj_invert; eauto. intros (P & id & Q & R). split. omega. generalize (Int.unsigned_range_2 ofs). omega. Qed. @@ -1289,28 +1289,28 @@ Lemma transf_initial_states: Proof. intros. inv H. exploit init_mem_inject; eauto. intros (j & tm & A & B & C). exploit symbols_inject_2. eauto. apply kept_main. eexact H1. intros (tb & P & Q). - exploit funct_ptr_inject. eauto. eexact Q. exact H2. + exploit funct_ptr_inject. eauto. eexact Q. exact H2. intros (R & S & T). exists (Callstate nil f nil tm); split. econstructor; eauto. - fold tge. unfold transform_program in TRANSF; rewrite USED_GLOBALS in TRANSF; inversion TRANSF; auto. + fold tge. unfold transform_program in TRANSF; rewrite USED_GLOBALS in TRANSF; inversion TRANSF; auto. econstructor; eauto. - constructor. auto. - erewrite <- Genv.init_mem_genv_next by eauto. apply Ple_refl. - erewrite <- Genv.init_mem_genv_next by eauto. apply Ple_refl. + constructor. auto. + erewrite <- Genv.init_mem_genv_next by eauto. apply Ple_refl. + erewrite <- Genv.init_mem_genv_next by eauto. apply Ple_refl. Qed. Lemma transf_final_states: forall S1 S2 r, match_states S1 S2 -> final_state S1 r -> final_state S2 r. Proof. - intros. inv H0. inv H. inv STACKS. inv RESINJ. constructor. + intros. inv H0. inv H. inv STACKS. inv RESINJ. constructor. Qed. Theorem transf_program_correct: forward_simulation (semantics p) (semantics tp). Proof. - intros. + intros. eapply forward_simulation_step. exploit globals_symbols_inject. apply init_meminj_preserves_globals. intros [A B]. exact A. eexact transf_initial_states. diff --git a/backend/ValueAnalysis.v b/backend/ValueAnalysis.v index 22121075..979f8c0e 100644 --- a/backend/ValueAnalysis.v +++ b/backend/ValueAnalysis.v @@ -231,7 +231,7 @@ Definition definitive_initializer (init: list init_data) : bool := Definition alloc_global (rm: romem) (idg: ident * globdef fundef unit): romem := match idg with - | (id, Gfun f) => + | (id, Gfun f) => PTree.remove id rm | (id, Gvar v) => if v.(gvar_readonly) && negb v.(gvar_volatile) && definitive_initializer v.(gvar_init) @@ -255,26 +255,26 @@ Lemma analyze_entrypoint: /\ ematch bc (init_regs vl (fn_params f)) ae /\ mmatch bc m am. Proof. - intros. - unfold analyze. + intros. + unfold analyze. set (lu := Liveness.last_uses f). set (entry := VA.State (einit_regs f.(fn_params)) mfunction_entry). destruct (DS.fixpoint (fn_code f) successors_instr (transfer' f lu rm) (fn_entrypoint f) entry) as [res|] eqn:FIX. - assert (A: VA.ge res!!(fn_entrypoint f) entry) by (eapply DS.fixpoint_entry; eauto). destruct (res!!(fn_entrypoint f)) as [ | ae am ]; simpl in A. contradiction. - destruct A as [A1 A2]. - exists ae, am. - split. auto. - split. eapply ematch_ge; eauto. apply ematch_init; auto. + destruct A as [A1 A2]. + exists ae, am. + split. auto. + split. eapply ematch_ge; eauto. apply ematch_init; auto. auto. - exists AE.top, mtop. - split. apply PMap.gi. - split. apply ematch_ge with (einit_regs (fn_params f)). - apply ematch_init; auto. apply AE.ge_top. - eapply mmatch_top'; eauto. + split. apply PMap.gi. + split. apply ematch_ge with (einit_regs (fn_params f)). + apply ematch_init; auto. apply AE.ge_top. + eapply mmatch_top'; eauto. Qed. - + Lemma analyze_successor: forall f n ae am instr s rm ae' am', (analyze rm f)!!n = VA.State ae am -> @@ -291,9 +291,9 @@ Proof. - assert (A: VA.ge res!!s (transfer' f lu rm n res#n)). { eapply DS.fixpoint_solution; eauto with coqlib. intros. unfold transfer'. simpl. auto. } - rewrite H in A. unfold transfer' in A. rewrite H2 in A. rewrite H2. + rewrite H in A. unfold transfer' in A. rewrite H2 in A. rewrite H2. destruct lu!n. - eapply VA.ge_trans. eauto. split; auto. apply eforget_ge. + eapply VA.ge_trans. eauto. split; auto. apply eforget_ge. auto. - rewrite H2. rewrite PMap.gi. split; intros. apply AE.ge_top. eapply mmatch_top'; eauto. Qed. @@ -311,11 +311,11 @@ Lemma analyze_succ: /\ ematch bc e ae'' /\ mmatch bc m am''. Proof. - intros. exploit analyze_successor; eauto. rewrite H2. + intros. exploit analyze_successor; eauto. rewrite H2. destruct (analyze rm f)#s as [ | ae'' am'']; simpl; try tauto. intros [A B]. exists ae'', am''. - split. auto. - split. eapply ematch_ge; eauto. eauto. + split. auto. + split. eapply ematch_ge; eauto. eauto. Qed. (** ** Analysis of registers and builtin arguments *) @@ -323,7 +323,7 @@ Qed. Lemma areg_sound: forall bc e ae r, ematch bc e ae -> vmatch bc (e#r) (areg ae r). Proof. - intros. apply H. + intros. apply H. Qed. Lemma aregs_sound: @@ -347,8 +347,8 @@ Lemma abuiltin_arg_sound: Proof. intros until am; intros EM RM MM GM SP. induction 1; simpl; eauto with va. -- eapply loadv_sound; eauto. simpl. rewrite Int.add_zero_l. auto with va. -- simpl. rewrite Int.add_zero_l. auto with va. +- eapply loadv_sound; eauto. simpl. rewrite Int.add_zero_l. auto with va. +- simpl. rewrite Int.add_zero_l. auto with va. - eapply loadv_sound; eauto. apply symbol_address_sound; auto. - apply symbol_address_sound; auto. Qed. @@ -367,7 +367,7 @@ Proof. intros until am; intros EM RM MM GM SP. induction 1; simpl. - constructor. -- constructor; auto. eapply abuiltin_arg_sound; eauto. +- constructor; auto. eapply abuiltin_arg_sound; eauto. Qed. Lemma set_builtin_res_sound: @@ -376,7 +376,7 @@ Lemma set_builtin_res_sound: vmatch bc v av -> ematch bc (regmap_setres res v rs) (set_builtin_res res av ae). Proof. - intros. destruct res; simpl; auto. apply ematch_update; auto. + intros. destruct res; simpl; auto. apply ematch_update; auto. Qed. (** ** Constructing block classifications *) @@ -396,24 +396,24 @@ Qed. Lemma vmatch_no_stack: forall v x, vmatch bc v x -> vmatch bc v (Ifptr Nonstack). Proof. - induction 1; constructor; auto; eapply pmatch_no_stack; eauto. + induction 1; constructor; auto; eapply pmatch_no_stack; eauto. Qed. Lemma smatch_no_stack: forall m b p, smatch bc m b p -> smatch bc m b Nonstack. Proof. - intros. destruct H as [A B]. split; intros. - eapply vmatch_no_stack; eauto. - eapply pmatch_no_stack; eauto. + intros. destruct H as [A B]. split; intros. + eapply vmatch_no_stack; eauto. + eapply pmatch_no_stack; eauto. Qed. Lemma mmatch_no_stack: forall m am astk, mmatch bc m am -> mmatch bc m {| am_stack := astk; am_glob := PTree.empty _; am_nonstack := Nonstack; am_top := Nonstack |}. Proof. intros. destruct H. constructor; simpl; intros. -- elim (NOSTACK b); auto. +- elim (NOSTACK b); auto. - rewrite PTree.gempty in H0; discriminate. -- eapply smatch_no_stack; eauto. -- eapply smatch_no_stack; eauto. +- eapply smatch_no_stack; eauto. +- eapply smatch_no_stack; eauto. - auto. Qed. @@ -439,8 +439,8 @@ Theorem allocate_stack: /\ (forall b, Plt b sp -> bc' b = bc b) /\ (forall v x, vmatch bc v x -> vmatch bc' v (Ifptr Nonstack)). Proof. - intros until am; intros ALLOC GENV RO MM NOSTACK. - exploit Mem.nextblock_alloc; eauto. intros NB. + intros until am; intros ALLOC GENV RO MM NOSTACK. + exploit Mem.nextblock_alloc; eauto. intros NB. exploit Mem.alloc_result; eauto. intros SP. assert (SPINVALID: bc sp = BCinvalid). { rewrite SP. eapply bc_below_invalid. apply Plt_strict. eapply mmatch_below; eauto. } @@ -450,13 +450,13 @@ Proof. { assert (forall b, f b = BCstack -> b = sp). { unfold f; intros. destruct (eq_block b sp); auto. eelim NOSTACK; eauto. } - intros. transitivity sp; auto. symmetry; auto. + intros. transitivity sp; auto. symmetry; auto. } assert (F_glob: forall b1 b2 id, f b1 = BCglob id -> f b2 = BCglob id -> b1 = b2). { assert (forall b id, f b = BCglob id -> bc b = BCglob id). { unfold f; intros. destruct (eq_block b sp). congruence. auto. } - intros. eapply (bc_glob bc); eauto. + intros. eapply (bc_glob bc); eauto. } set (bc' := BC f F_stack F_glob). unfold f in bc'. assert (BC'EQ: forall b, bc b <> BCinvalid -> bc' b = bc b). @@ -466,15 +466,15 @@ Proof. (* Part 2: invariance properties *) assert (SM: forall b p, bc b <> BCinvalid -> smatch bc m b p -> smatch bc' m' b Nonstack). { - intros. + intros. apply smatch_incr with bc; auto. - apply smatch_inv with m. + apply smatch_inv with m. apply smatch_no_stack with p; auto. - intros. eapply Mem.loadbytes_alloc_unchanged; eauto. eapply mmatch_below; eauto. + intros. eapply Mem.loadbytes_alloc_unchanged; eauto. eapply mmatch_below; eauto. } assert (SMSTACK: smatch bc' m' sp Pbot). { - split; intros. + split; intros. exploit Mem.load_alloc_same; eauto. intros EQ. subst v. constructor. exploit Mem.loadbytes_alloc_same; eauto with coqlib. congruence. } @@ -483,15 +483,15 @@ Proof. - (* incr *) assumption. - (* sp is BCstack *) - simpl; apply dec_eq_true. + simpl; apply dec_eq_true. - (* genv match *) eapply genv_match_exten; eauto. simpl; intros. destruct (eq_block b sp); intuition congruence. - simpl; intros. destruct (eq_block b sp); congruence. + simpl; intros. destruct (eq_block b sp); congruence. - (* romatch *) - apply romatch_exten with bc. - eapply romatch_alloc; eauto. eapply mmatch_below; eauto. - simpl; intros. destruct (eq_block b sp); intuition. + apply romatch_exten with bc. + eapply romatch_alloc; eauto. eapply mmatch_below; eauto. + simpl; intros. destruct (eq_block b sp); intuition. - (* mmatch *) constructor; simpl; intros. + (* stack *) @@ -504,16 +504,16 @@ Proof. destruct (eq_block b sp). congruence. eapply SM; auto. eapply mmatch_nonstack; eauto. + (* top *) destruct (eq_block b sp). - subst b. apply smatch_ge with Pbot. apply SMSTACK. constructor. + subst b. apply smatch_ge with Pbot. apply SMSTACK. constructor. eapply SM; auto. eapply mmatch_top; eauto. + (* below *) - red; simpl; intros. rewrite NB. destruct (eq_block b sp). - subst b; rewrite SP; xomega. - exploit mmatch_below; eauto. xomega. + red; simpl; intros. rewrite NB. destruct (eq_block b sp). + subst b; rewrite SP; xomega. + exploit mmatch_below; eauto. xomega. - (* unchanged *) simpl; intros. apply dec_eq_false. apply Plt_ne. auto. - (* values *) - intros. apply vmatch_incr with bc; auto. eapply vmatch_no_stack; eauto. + intros. apply vmatch_incr with bc; auto. eapply vmatch_no_stack; eauto. Qed. (** Construction 2: turn the stack into an "other" block, at public calls or function returns *) @@ -540,15 +540,15 @@ Proof. { unfold f; intros. destruct (eq_block b1 sp); try discriminate. - destruct (eq_block b2 sp); try discriminate. - eapply bc_stack; eauto. + destruct (eq_block b2 sp); try discriminate. + eapply bc_stack; eauto. } assert (F_glob: forall b1 b2 id, f b1 = BCglob id -> f b2 = BCglob id -> b1 = b2). { unfold f; intros. destruct (eq_block b1 sp); try discriminate. - destruct (eq_block b2 sp); try discriminate. - eapply bc_glob; eauto. + destruct (eq_block b2 sp); try discriminate. + eapply bc_glob; eauto. } set (bc' := BC f F_stack F_glob). unfold f in bc'. @@ -556,7 +556,7 @@ Proof. assert (PM: forall b ofs p, pmatch bc b ofs p -> pmatch bc' b ofs Ptop). { intros. assert (pmatch bc b ofs Ptop) by (eapply pmatch_top'; eauto). - inv H0. constructor; simpl. destruct (eq_block b sp); congruence. + inv H0. constructor; simpl. destruct (eq_block b sp); congruence. } assert (VM: forall v x, vmatch bc v x -> vmatch bc' v Vtop). { @@ -571,32 +571,32 @@ Proof. (* Conclusions *) exists bc'; splitall. - (* nostack *) - red; simpl; intros. destruct (eq_block b sp). congruence. - red; intros. elim n. eapply bc_stack; eauto. + red; simpl; intros. destruct (eq_block b sp). congruence. + red; intros. elim n. eapply bc_stack; eauto. - (* bc' sp is BCother *) - simpl; apply dec_eq_true. + simpl; apply dec_eq_true. - (* other blocks *) - intros; simpl; apply dec_eq_false; auto. + intros; simpl; apply dec_eq_false; auto. - (* values *) auto. - (* genv *) - apply genv_match_exten with bc; auto. + apply genv_match_exten with bc; auto. simpl; intros. destruct (eq_block b sp); intuition congruence. simpl; intros. destruct (eq_block b sp); auto. - (* romatch *) - apply romatch_exten with bc; auto. - simpl; intros. destruct (eq_block b sp); intuition. + apply romatch_exten with bc; auto. + simpl; intros. destruct (eq_block b sp); intuition. - (* mmatch top *) - constructor; simpl; intros. + constructor; simpl; intros. + destruct (eq_block b sp). congruence. elim n. eapply bc_stack; eauto. + rewrite PTree.gempty in H0; discriminate. + destruct (eq_block b sp). subst b. eapply SM. eapply mmatch_stack; eauto. - eapply SM. eapply mmatch_nonstack; eauto. + eapply SM. eapply mmatch_nonstack; eauto. + destruct (eq_block b sp). subst b. eapply SM. eapply mmatch_stack; eauto. eapply SM. eapply mmatch_top; eauto. - + red; simpl; intros. destruct (eq_block b sp). + + red; simpl; intros. destruct (eq_block b sp). subst b. eapply mmatch_below; eauto. congruence. eapply mmatch_below; eauto. Qed. @@ -626,15 +626,15 @@ Proof. { unfold f; intros. destruct (eq_block b1 sp); try discriminate. - destruct (eq_block b2 sp); try discriminate. - eapply bc_stack; eauto. + destruct (eq_block b2 sp); try discriminate. + eapply bc_stack; eauto. } assert (F_glob: forall b1 b2 id, f b1 = BCglob id -> f b2 = BCglob id -> b1 = b2). { unfold f; intros. destruct (eq_block b1 sp); try discriminate. - destruct (eq_block b2 sp); try discriminate. - eapply bc_glob; eauto. + destruct (eq_block b2 sp); try discriminate. + eapply bc_glob; eauto. } set (bc' := BC f F_stack F_glob). unfold f in bc'. @@ -642,11 +642,11 @@ Proof. assert (PM: forall b ofs p, pge Nonstack p -> pmatch bc b ofs p -> pmatch bc' b ofs Ptop). { intros. assert (pmatch bc b ofs Nonstack) by (eapply pmatch_ge; eauto). - inv H1. constructor; simpl; destruct (eq_block b sp); congruence. + inv H1. constructor; simpl; destruct (eq_block b sp); congruence. } assert (VM: forall v x, vge (Ifptr Nonstack) x -> vmatch bc v x -> vmatch bc' v Vtop). { - intros. apply vmatch_ifptr; intros. subst v. + intros. apply vmatch_ifptr; intros. subst v. inv H0; inv H; eapply PM; eauto. } assert (SM: forall b p, pge Nonstack p -> smatch bc m b p -> smatch bc' m b Ptop). @@ -658,31 +658,31 @@ Proof. (* Conclusions *) exists bc'; splitall. - (* nostack *) - red; simpl; intros. destruct (eq_block b sp). congruence. - red; intros. elim n. eapply bc_stack; eauto. + red; simpl; intros. destruct (eq_block b sp). congruence. + red; intros. elim n. eapply bc_stack; eauto. - (* bc' sp is BCinvalid *) - simpl; apply dec_eq_true. + simpl; apply dec_eq_true. - (* other blocks *) - intros; simpl; apply dec_eq_false; auto. + intros; simpl; apply dec_eq_false; auto. - (* values *) auto. - (* genv *) - apply genv_match_exten with bc; auto. + apply genv_match_exten with bc; auto. simpl; intros. destruct (eq_block b sp); intuition congruence. simpl; intros. destruct (eq_block b sp); congruence. - (* romatch *) - apply romatch_exten with bc; auto. - simpl; intros. destruct (eq_block b sp); intuition. + apply romatch_exten with bc; auto. + simpl; intros. destruct (eq_block b sp); intuition. - (* mmatch top *) - constructor; simpl; intros. + constructor; simpl; intros. + destruct (eq_block b sp). congruence. elim n. eapply bc_stack; eauto. + rewrite PTree.gempty in H0; discriminate. + destruct (eq_block b sp). congruence. - eapply SM. eauto. eapply mmatch_nonstack; eauto. + eapply SM. eauto. eapply mmatch_nonstack; eauto. + destruct (eq_block b sp). congruence. - eapply SM. eauto. eapply mmatch_nonstack; eauto. - red; intros; elim n. eapply bc_stack; eauto. - + red; simpl; intros. destruct (eq_block b sp). congruence. + eapply SM. eauto. eapply mmatch_nonstack; eauto. + red; intros; elim n. eapply bc_stack; eauto. + + red; simpl; intros. destruct (eq_block b sp). congruence. eapply mmatch_below; eauto. Qed. @@ -718,29 +718,29 @@ Proof. { assert (forall b, f b = BCstack -> b = sp). { unfold f; intros. destruct (eq_block b sp); auto. eelim NOSTACK; eauto. } - intros. transitivity sp; auto. symmetry; auto. + intros. transitivity sp; auto. symmetry; auto. } assert (F_glob: forall b1 b2 id, f b1 = BCglob id -> f b2 = BCglob id -> b1 = b2). { assert (forall b id, f b = BCglob id -> callee b = BCglob id). { unfold f; intros. destruct (eq_block b sp). congruence. auto. } - intros. eapply (bc_glob callee); eauto. + intros. eapply (bc_glob callee); eauto. } set (bc := BC f F_stack F_glob). unfold f in bc. assert (INCR: bc_incr caller bc). { - red; simpl; intros. destruct (eq_block b sp). congruence. - symmetry; apply SAME; auto. + red; simpl; intros. destruct (eq_block b sp). congruence. + symmetry; apply SAME; auto. } (* Invariance properties *) - assert (PM: forall b ofs p, pmatch callee b ofs p -> pmatch bc b ofs Ptop). + assert (PM: forall b ofs p, pmatch callee b ofs p -> pmatch bc b ofs Ptop). { intros. assert (pmatch callee b ofs Ptop) by (eapply pmatch_top'; eauto). inv H0. constructor; simpl. destruct (eq_block b sp); congruence. } assert (VM: forall v x, vmatch callee v x -> vmatch bc v Vtop). { - intros. assert (vmatch callee v0 Vtop) by (eapply vmatch_top; eauto). + intros. assert (vmatch callee v0 Vtop) by (eapply vmatch_top; eauto). inv H0; constructor; eauto. } assert (SM: forall b p, smatch callee m b p -> smatch bc m b Ptop). @@ -752,38 +752,38 @@ Proof. - (* result value *) eapply VM; eauto. - (* environment *) - eapply ematch_incr; eauto. + eapply ematch_incr; eauto. - (* romem *) apply romatch_exten with callee; auto. - intros; simpl. destruct (eq_block b sp); intuition. + intros; simpl. destruct (eq_block b sp); intuition. - (* mmatch *) constructor; simpl; intros. + (* stack *) apply ablock_init_sound. destruct (eq_block b sp). - subst b. eapply SM. eapply mmatch_nonstack; eauto. congruence. + subst b. eapply SM. eapply mmatch_nonstack; eauto. congruence. elim (NOSTACK b); auto. + (* globals *) rewrite PTree.gempty in H0; discriminate. + (* nonstack *) destruct (eq_block b sp). congruence. eapply SM; auto. eapply mmatch_nonstack; eauto. + (* top *) - eapply SM. eapply mmatch_top; eauto. + eapply SM. eapply mmatch_top; eauto. destruct (eq_block b sp); congruence. + (* below *) - red; simpl; intros. destruct (eq_block b sp). + red; simpl; intros. destruct (eq_block b sp). subst b. eapply mmatch_below; eauto. congruence. eapply mmatch_below; eauto. - (* genv *) eapply genv_match_exten with caller; eauto. - simpl; intros. destruct (eq_block b sp). intuition congruence. + simpl; intros. destruct (eq_block b sp). intuition congruence. split; intros. rewrite SAME in H by eauto with va. auto. apply <- (proj1 GE2) in H. apply (proj1 GE1) in H. auto. - simpl; intros. destruct (eq_block b sp). congruence. + simpl; intros. destruct (eq_block b sp). congruence. rewrite <- SAME; eauto with va. - (* sp *) simpl. apply dec_eq_true. - (* unchanged *) - simpl; intros. destruct (eq_block b sp). congruence. + simpl; intros. destruct (eq_block b sp). congruence. symmetry. apply SAME; auto. eapply Plt_trans. eauto. apply BELOW. congruence. Qed. @@ -820,19 +820,19 @@ Proof. { assert (forall b, f b = BCstack -> b = sp). { unfold f; intros. destruct (eq_block b sp); auto. eelim NOSTACK; eauto. } - intros. transitivity sp; auto. symmetry; auto. + intros. transitivity sp; auto. symmetry; auto. } assert (F_glob: forall b1 b2 id, f b1 = BCglob id -> f b2 = BCglob id -> b1 = b2). { assert (forall b id, f b = BCglob id -> callee b = BCglob id). { unfold f; intros. destruct (eq_block b sp). congruence. auto. } - intros. eapply (bc_glob callee); eauto. + intros. eapply (bc_glob callee); eauto. } set (bc := BC f F_stack F_glob). unfold f in bc. assert (INCR1: bc_incr caller bc). { - red; simpl; intros. destruct (eq_block b sp). congruence. - symmetry; apply SAME; auto. + red; simpl; intros. destruct (eq_block b sp). congruence. + symmetry; apply SAME; auto. } assert (INCR2: bc_incr callee bc). { @@ -840,14 +840,14 @@ Proof. } (* Invariance properties *) - assert (PM: forall b ofs p, pmatch callee b ofs p -> pmatch bc b ofs Nonstack). + assert (PM: forall b ofs p, pmatch callee b ofs p -> pmatch bc b ofs Nonstack). { intros. assert (pmatch callee b ofs Ptop) by (eapply pmatch_top'; eauto). inv H0. constructor; simpl; destruct (eq_block b sp); congruence. } assert (VM: forall v x, vmatch callee v x -> vmatch bc v (Ifptr Nonstack)). { - intros. assert (vmatch callee v0 Vtop) by (eapply vmatch_top; eauto). + intros. assert (vmatch callee v0 Vtop) by (eapply vmatch_top; eauto). inv H0; constructor; eauto. } assert (SM: forall b p, smatch callee m b p -> smatch bc m b Nonstack). @@ -856,21 +856,21 @@ Proof. } assert (BSTK: bmatch bc m sp (am_stack am)). { - apply bmatch_incr with caller; eauto. + apply bmatch_incr with caller; eauto. } (* Conclusions *) exists bc; splitall. - (* result value *) eapply VM; eauto. - (* environment *) - eapply ematch_incr; eauto. + eapply ematch_incr; eauto. - (* romem *) apply romatch_exten with callee; auto. - intros; simpl. destruct (eq_block b sp); intuition. + intros; simpl. destruct (eq_block b sp); intuition. - (* mmatch *) constructor; simpl; intros. + (* stack *) - destruct (eq_block b sp). + destruct (eq_block b sp). subst b. exact BSTK. elim (NOSTACK b); auto. + (* globals *) @@ -878,12 +878,12 @@ Proof. + (* nonstack *) destruct (eq_block b sp). congruence. eapply SM; auto. eapply mmatch_nonstack; eauto. + (* top *) - destruct (eq_block b sp). - subst. apply smatch_ge with (ab_summary (am_stack am)). apply BSTK. apply pge_lub_l. + destruct (eq_block b sp). + subst. apply smatch_ge with (ab_summary (am_stack am)). apply BSTK. apply pge_lub_l. apply smatch_ge with Nonstack. eapply SM. eapply mmatch_top; eauto. apply pge_lub_r. + (* below *) - red; simpl; intros. destruct (eq_block b sp). - subst b. apply Plt_le_trans with bound. apply BELOW. congruence. auto. + red; simpl; intros. destruct (eq_block b sp). + subst b. apply Plt_le_trans with bound. apply BELOW. congruence. auto. eapply mmatch_below; eauto. - (* genv *) eapply genv_match_exten; eauto. @@ -892,7 +892,7 @@ Proof. - (* sp *) simpl. apply dec_eq_true. - (* unchanged *) - simpl; intros. destruct (eq_block b sp). congruence. + simpl; intros. destruct (eq_block b sp). congruence. symmetry. apply SAME; auto. eapply Plt_trans. eauto. apply BELOW. congruence. Qed. @@ -919,19 +919,19 @@ Proof. intros until am; intros EC GENV ARGS RO MM NOSTACK. (* Part 1: using ec_mem_inject *) exploit (@external_call_mem_inject ef _ _ ge vargs m t vres m' (inj_of_bc bc) m vargs). - apply inj_of_bc_preserves_globals; auto. + apply inj_of_bc_preserves_globals; auto. exact EC. eapply mmatch_inj; eauto. eapply mmatch_below; eauto. - revert ARGS. generalize vargs. + revert ARGS. generalize vargs. induction vargs0; simpl; intros; constructor. - eapply vmatch_inj; eauto. auto. + eapply vmatch_inj; eauto. auto. intros (j' & vres' & m'' & EC' & IRES & IMEM & UNCH1 & UNCH2 & IINCR & ISEP). assert (JBELOW: forall b, Plt b (Mem.nextblock m) -> j' b = inj_of_bc bc b). { intros. destruct (inj_of_bc bc b) as [[b' delta] | ] eqn:EQ. - eapply IINCR; eauto. + eapply IINCR; eauto. destruct (j' b) as [[b'' delta'] | ] eqn:EQ'; auto. - exploit ISEP; eauto. tauto. + exploit ISEP; eauto. tauto. } (* Part 2: constructing bc' from j' *) set (f := fun b => if plt b (Mem.nextblock m) @@ -941,13 +941,13 @@ Proof. { assert (forall b, f b = BCstack -> bc b = BCstack). { unfold f; intros. destruct (plt b (Mem.nextblock m)); auto. destruct (j' b); discriminate. } - intros. apply (bc_stack bc); auto. + intros. apply (bc_stack bc); auto. } assert (F_glob: forall b1 b2 id, f b1 = BCglob id -> f b2 = BCglob id -> b1 = b2). { assert (forall b id, f b = BCglob id -> bc b = BCglob id). { unfold f; intros. destruct (plt b (Mem.nextblock m)); auto. destruct (j' b); discriminate. } - intros. eapply (bc_glob bc); eauto. + intros. eapply (bc_glob bc); eauto. } set (bc' := BC f F_stack F_glob). unfold f in bc'. assert (INCR: bc_incr bc bc'). @@ -956,34 +956,34 @@ Proof. } assert (BC'INV: forall b, bc' b <> BCinvalid -> exists b' delta, j' b = Some(b', delta)). { - simpl; intros. destruct (plt b (Mem.nextblock m)). + simpl; intros. destruct (plt b (Mem.nextblock m)). exists b, 0. rewrite JBELOW by auto. apply inj_of_bc_valid; auto. - destruct (j' b) as [[b' delta] | ]. - exists b', delta; auto. + destruct (j' b) as [[b' delta] | ]. + exists b', delta; auto. congruence. } (* Part 3: injection wrt j' implies matching with top wrt bc' *) assert (PMTOP: forall b b' delta ofs, j' b = Some (b', delta) -> pmatch bc' b ofs Ptop). { - intros. constructor. simpl; unfold f. + intros. constructor. simpl; unfold f. destruct (plt b (Mem.nextblock m)). - rewrite JBELOW in H by auto. eapply inj_of_bc_inv; eauto. + rewrite JBELOW in H by auto. eapply inj_of_bc_inv; eauto. rewrite H; congruence. } assert (VMTOP: forall v v', Val.inject j' v v' -> vmatch bc' v Vtop). { - intros. inv H; constructor. eapply PMTOP; eauto. + intros. inv H; constructor. eapply PMTOP; eauto. } assert (SMTOP: forall b, bc' b <> BCinvalid -> smatch bc' m' b Ptop). { intros; split; intros. - - exploit BC'INV; eauto. intros (b' & delta & J'). - exploit Mem.load_inject. eexact IMEM. eauto. eauto. intros (v' & A & B). + - exploit BC'INV; eauto. intros (b' & delta & J'). + exploit Mem.load_inject. eexact IMEM. eauto. eauto. intros (v' & A & B). eapply VMTOP; eauto. - - exploit BC'INV; eauto. intros (b'' & delta & J'). + - exploit BC'INV; eauto. intros (b'' & delta & J'). exploit Mem.loadbytes_inject. eexact IMEM. eauto. eauto. intros (bytes & A & B). - inv B. inv H3. inv H7. eapply PMTOP; eauto. + inv B. inv H3. inv H7. eapply PMTOP; eauto. } (* Conclusions *) exists bc'; splitall. @@ -1004,29 +1004,29 @@ Proof. exploit RO; eauto. intros (R & P & Q). split; auto. split. apply bmatch_incr with bc; auto. apply bmatch_inv with m; auto. - intros. eapply Mem.loadbytes_unchanged_on_1. eapply external_call_readonly; eauto. - auto. intros; red. apply Q. - intros; red; intros; elim (Q ofs). + intros. eapply Mem.loadbytes_unchanged_on_1. eapply external_call_readonly; eauto. + auto. intros; red. apply Q. + intros; red; intros; elim (Q ofs). eapply external_call_max_perm with (m2 := m'); eauto. destruct (j' b); congruence. - (* mmatch top *) constructor; simpl; intros. - + apply ablock_init_sound. apply SMTOP. simpl; congruence. + + apply ablock_init_sound. apply SMTOP. simpl; congruence. + rewrite PTree.gempty in H0; discriminate. + apply SMTOP; auto. - + apply SMTOP; auto. - + red; simpl; intros. destruct (plt b (Mem.nextblock m)). - eapply Plt_le_trans. eauto. eapply external_call_nextblock; eauto. - destruct (j' b) as [[bx deltax] | ] eqn:J'. - eapply Mem.valid_block_inject_1; eauto. + + apply SMTOP; auto. + + red; simpl; intros. destruct (plt b (Mem.nextblock m)). + eapply Plt_le_trans. eauto. eapply external_call_nextblock; eauto. + destruct (j' b) as [[bx deltax] | ] eqn:J'. + eapply Mem.valid_block_inject_1; eauto. congruence. - (* nostack *) - red; simpl; intros. destruct (plt b (Mem.nextblock m)). + red; simpl; intros. destruct (plt b (Mem.nextblock m)). apply NOSTACK; auto. destruct (j' b); congruence. - (* unmapped blocks are invariant *) intros. eapply Mem.loadbytes_unchanged_on_1; auto. - apply UNCH1; auto. intros; red. unfold inj_of_bc; rewrite H0; auto. + apply UNCH1; auto. intros; red. unfold inj_of_bc; rewrite H0; auto. Qed. Remark list_forall2_in_l: @@ -1036,8 +1036,8 @@ Proof. induction 1; simpl; intros. - contradiction. - destruct H1. - + subst. exists b1; auto. - + exploit IHlist_forall2; eauto. intros (x2 & U & V). exists x2; auto. + + subst. exists b1; auto. + + exploit IHlist_forall2; eauto. intros (x2 & U & V). exists x2; auto. Qed. (** ** Semantic invariant *) @@ -1122,10 +1122,10 @@ Lemma sound_stack_ext: Proof. induction 1; intros INV. - constructor. -- assert (Plt sp bound') by eauto with va. +- assert (Plt sp bound') by eauto with va. eapply sound_stack_public_call; eauto. apply IHsound_stack; intros. apply INV. xomega. rewrite SAME; auto. xomega. auto. auto. -- assert (Plt sp bound') by eauto with va. +- assert (Plt sp bound') by eauto with va. eapply sound_stack_private_call; eauto. apply IHsound_stack; intros. apply INV. xomega. rewrite SAME; auto. xomega. auto. auto. apply bmatch_ext with m; auto. intros. apply INV. xomega. auto. auto. auto. @@ -1137,7 +1137,7 @@ Lemma sound_stack_inv: (forall b ofs n, Plt b bound -> bc b = BCinvalid -> n >= 0 -> Mem.loadbytes m' b ofs n = Mem.loadbytes m b ofs n) -> sound_stack bc stk m' bound. Proof. - intros. eapply sound_stack_ext; eauto. intros. rewrite <- H0; auto. + intros. eapply sound_stack_ext; eauto. intros. rewrite <- H0; auto. Qed. Lemma sound_stack_storev: @@ -1147,13 +1147,13 @@ Lemma sound_stack_storev: sound_stack bc stk m bound -> sound_stack bc stk m' bound. Proof. - intros. apply sound_stack_inv with m; auto. + intros. apply sound_stack_inv with m; auto. destruct addr; simpl in H; try discriminate. assert (A: pmatch bc b i Ptop). { inv H0; eapply pmatch_top'; eauto. } - inv A. - intros. eapply Mem.loadbytes_store_other; eauto. left; congruence. -Qed. + inv A. + intros. eapply Mem.loadbytes_store_other; eauto. left; congruence. +Qed. Lemma sound_stack_storebytes: forall m b ofs bytes m' bc aaddr stk bound, @@ -1162,12 +1162,12 @@ Lemma sound_stack_storebytes: sound_stack bc stk m bound -> sound_stack bc stk m' bound. Proof. - intros. apply sound_stack_inv with m; auto. + intros. apply sound_stack_inv with m; auto. assert (A: pmatch bc b ofs Ptop). { inv H0; eapply pmatch_top'; eauto. } - inv A. - intros. eapply Mem.loadbytes_storebytes_other; eauto. left; congruence. -Qed. + inv A. + intros. eapply Mem.loadbytes_storebytes_other; eauto. left; congruence. +Qed. Lemma sound_stack_free: forall m b lo hi m' bc stk bound, @@ -1185,10 +1185,10 @@ Lemma sound_stack_new_bound: Ple bound bound' -> sound_stack bc stk m bound'. Proof. - intros. inv H. + intros. inv H. - constructor. -- eapply sound_stack_public_call with (bound' := bound'0); eauto. xomega. -- eapply sound_stack_private_call with (bound' := bound'0); eauto. xomega. +- eapply sound_stack_public_call with (bound' := bound'0); eauto. xomega. +- eapply sound_stack_private_call with (bound' := bound'0); eauto. xomega. Qed. Lemma sound_stack_exten: @@ -1197,15 +1197,15 @@ Lemma sound_stack_exten: (forall b, Plt b bound -> bc1 b = bc b) -> sound_stack bc1 stk m bound. Proof. - intros. inv H. + intros. inv H. - constructor. -- assert (Plt sp bound') by eauto with va. +- assert (Plt sp bound') by eauto with va. eapply sound_stack_public_call; eauto. - rewrite H0; auto. xomega. + rewrite H0; auto. xomega. intros. rewrite H0; auto. xomega. -- assert (Plt sp bound') by eauto with va. +- assert (Plt sp bound') by eauto with va. eapply sound_stack_private_call; eauto. - rewrite H0; auto. xomega. + rewrite H0; auto. xomega. intros. rewrite H0; auto. xomega. Qed. @@ -1226,7 +1226,7 @@ Lemma sound_succ_state: sound_state (State s f (Vptr sp Int.zero) pc' e' m'). Proof. intros. exploit analyze_succ; eauto. intros (ae'' & am'' & AN & EM & MM). - econstructor; eauto. + econstructor; eauto. Qed. Theorem sound_step: @@ -1235,72 +1235,72 @@ Proof. induction 1; intros SOUND; inv SOUND. - (* nop *) - eapply sound_succ_state; eauto. simpl; auto. + eapply sound_succ_state; eauto. simpl; auto. unfold transfer; rewrite H. auto. - (* op *) - eapply sound_succ_state; eauto. simpl; auto. - unfold transfer; rewrite H. eauto. + eapply sound_succ_state; eauto. simpl; auto. + unfold transfer; rewrite H. eauto. apply ematch_update; auto. eapply eval_static_operation_sound; eauto with va. - (* load *) - eapply sound_succ_state; eauto. simpl; auto. - unfold transfer; rewrite H. eauto. - apply ematch_update; auto. eapply loadv_sound; eauto with va. + eapply sound_succ_state; eauto. simpl; auto. + unfold transfer; rewrite H. eauto. + apply ematch_update; auto. eapply loadv_sound; eauto with va. eapply eval_static_addressing_sound; eauto with va. - (* store *) exploit eval_static_addressing_sound; eauto with va. intros VMADDR. - eapply sound_succ_state; eauto. simpl; auto. - unfold transfer; rewrite H. eauto. - eapply storev_sound; eauto. - destruct a; simpl in H1; try discriminate. eapply romatch_store; eauto. - eapply sound_stack_storev; eauto. + eapply sound_succ_state; eauto. simpl; auto. + unfold transfer; rewrite H. eauto. + eapply storev_sound; eauto. + destruct a; simpl in H1; try discriminate. eapply romatch_store; eauto. + eapply sound_stack_storev; eauto. - (* call *) assert (TR: transfer f rm pc ae am = transfer_call ae am args res). { unfold transfer; rewrite H; auto. } - unfold transfer_call, analyze_call in TR. - destruct (pincl (am_nonstack am) Nonstack && + unfold transfer_call, analyze_call in TR. + destruct (pincl (am_nonstack am) Nonstack && forallb (fun av => vpincl av Nonstack) (aregs ae args)) eqn:NOLEAK. + (* private call *) InvBooleans. - exploit analyze_successor; eauto. simpl; eauto. rewrite TR. intros SUCC. + exploit analyze_successor; eauto. simpl; eauto. rewrite TR. intros SUCC. exploit hide_stack; eauto. apply pincl_ge; auto. intros (bc' & A & B & C & D & E & F & G). apply sound_call_state with bc'; auto. * eapply sound_stack_private_call with (bound' := Mem.nextblock m) (bc' := bc); eauto. apply Ple_refl. eapply mmatch_below; eauto. - eapply mmatch_stack; eauto. - * intros. exploit list_in_map_inv; eauto. intros (r & P & Q). subst v. - apply D with (areg ae r). + eapply mmatch_stack; eauto. + * intros. exploit list_in_map_inv; eauto. intros (r & P & Q). subst v. + apply D with (areg ae r). rewrite forallb_forall in H2. apply vpincl_ge. apply H2. apply in_map; auto. auto with va. + (* public call *) - exploit analyze_successor; eauto. simpl; eauto. rewrite TR. intros SUCC. + exploit analyze_successor; eauto. simpl; eauto. rewrite TR. intros SUCC. exploit anonymize_stack; eauto. intros (bc' & A & B & C & D & E & F & G). apply sound_call_state with bc'; auto. * eapply sound_stack_public_call with (bound' := Mem.nextblock m) (bc' := bc); eauto. apply Ple_refl. eapply mmatch_below; eauto. - * intros. exploit list_in_map_inv; eauto. intros (r & P & Q). subst v. + * intros. exploit list_in_map_inv; eauto. intros (r & P & Q). subst v. apply D with (areg ae r). auto with va. - (* tailcall *) exploit anonymize_stack; eauto. intros (bc' & A & B & C & D & E & F & G). apply sound_call_state with bc'; auto. - erewrite Mem.nextblock_free by eauto. + erewrite Mem.nextblock_free by eauto. apply sound_stack_new_bound with stk. apply sound_stack_exten with bc. eapply sound_stack_free; eauto. intros. apply C. apply Plt_ne; auto. - apply Plt_Ple. eapply mmatch_below; eauto. congruence. - intros. exploit list_in_map_inv; eauto. intros (r & P & Q). subst v. + apply Plt_Ple. eapply mmatch_below; eauto. congruence. + intros. exploit list_in_map_inv; eauto. intros (r & P & Q). subst v. apply D with (areg ae r). auto with va. - eapply romatch_free; eauto. - eapply mmatch_free; eauto. + eapply romatch_free; eauto. + eapply mmatch_free; eauto. - (* builtin *) assert (SPVALID: Plt sp0 (Mem.nextblock m)) by (eapply mmatch_below; eauto with va). @@ -1314,72 +1314,72 @@ Proof. { unfold transfer_builtin_default, analyze_call; intros TR'. set (aargs := map (abuiltin_arg ae am rm) args) in *. assert (ARGS: list_forall2 (vmatch bc) vargs aargs) by (eapply abuiltin_args_sound; eauto). - destruct (pincl (am_nonstack am) Nonstack && + destruct (pincl (am_nonstack am) Nonstack && forallb (fun av => vpincl av Nonstack) aargs) eqn: NOLEAK. * (* private builtin call *) InvBooleans. rewrite forallb_forall in H3. exploit hide_stack; eauto. apply pincl_ge; auto. intros (bc1 & A & B & C & D & E & F & G). - exploit external_call_match; eauto. + exploit external_call_match; eauto. intros. exploit list_forall2_in_l; eauto. intros (av & U & V). - eapply D; eauto with va. apply vpincl_ge. apply H3; auto. + eapply D; eauto with va. apply vpincl_ge. apply H3; auto. intros (bc2 & J & K & L & M & N & O & P & Q). exploit (return_from_private_call bc bc2); eauto. eapply mmatch_below; eauto. rewrite K; auto. intros. rewrite K; auto. rewrite C; auto. - apply bmatch_inv with m. eapply mmatch_stack; eauto. + apply bmatch_inv with m. eapply mmatch_stack; eauto. intros. apply Q; auto. - eapply external_call_nextblock; eauto. + eapply external_call_nextblock; eauto. intros (bc3 & U & V & W & X & Y & Z & AA). - eapply sound_succ_state with (bc := bc3); eauto. simpl; auto. - apply set_builtin_res_sound; auto. - apply sound_stack_exten with bc. + eapply sound_succ_state with (bc := bc3); eauto. simpl; auto. + apply set_builtin_res_sound; auto. + apply sound_stack_exten with bc. apply sound_stack_inv with m. auto. intros. apply Q. red. eapply Plt_trans; eauto. rewrite C; auto. exact AA. * (* public builtin call *) - exploit anonymize_stack; eauto. + exploit anonymize_stack; eauto. intros (bc1 & A & B & C & D & E & F & G). - exploit external_call_match; eauto. + exploit external_call_match; eauto. intros. exploit list_forall2_in_l; eauto. intros (av & U & V). eapply D; eauto with va. intros (bc2 & J & K & L & M & N & O & P & Q). exploit (return_from_public_call bc bc2); eauto. eapply mmatch_below; eauto. rewrite K; auto. intros. rewrite K; auto. rewrite C; auto. - eapply external_call_nextblock; eauto. + eapply external_call_nextblock; eauto. intros (bc3 & U & V & W & X & Y & Z & AA). - eapply sound_succ_state with (bc := bc3); eauto. simpl; auto. - apply set_builtin_res_sound; auto. - apply sound_stack_exten with bc. + eapply sound_succ_state with (bc := bc3); eauto. simpl; auto. + apply set_builtin_res_sound; auto. + apply sound_stack_exten with bc. apply sound_stack_inv with m. auto. intros. apply Q. red. eapply Plt_trans; eauto. rewrite C; auto. exact AA. } - unfold transfer_builtin in TR. + unfold transfer_builtin in TR. destruct ef; auto. + (* volatile load *) inv H0; auto. inv H3; auto. inv H1. exploit abuiltin_arg_sound; eauto. intros VM1. eapply sound_succ_state; eauto. simpl; auto. - apply set_builtin_res_sound; auto. + apply set_builtin_res_sound; auto. inv H3. * (* true volatile access *) assert (V: vmatch bc v (Ifptr Glob)). { inv H4; simpl in *; constructor. econstructor. eapply GE; eauto. } - destruct (va_strict tt). apply vmatch_lub_r. apply vnormalize_sound. auto. + destruct (va_strict tt). apply vmatch_lub_r. apply vnormalize_sound. auto. apply vnormalize_sound. eapply vmatch_ge; eauto. constructor. constructor. * (* normal memory access *) exploit loadv_sound; eauto. simpl; eauto. intros V. - destruct (va_strict tt). + destruct (va_strict tt). apply vmatch_lub_l. auto. - eapply vnormalize_cast; eauto. eapply vmatch_top; eauto. + eapply vnormalize_cast; eauto. eapply vmatch_top; eauto. + (* volatile store *) - inv H0; auto. inv H3; auto. inv H4; auto. inv H1. + inv H0; auto. inv H3; auto. inv H4; auto. inv H1. exploit abuiltin_arg_sound. eauto. eauto. eauto. eauto. eauto. eexact H0. intros VM1. exploit abuiltin_arg_sound. eauto. eauto. eauto. eauto. eauto. eexact H2. intros VM2. inv H9. @@ -1394,84 +1394,84 @@ Proof. eapply romatch_store; eauto. eapply sound_stack_storev; eauto. simpl; eauto. + (* memcpy *) - inv H0; auto. inv H3; auto. inv H4; auto. inv H1. + inv H0; auto. inv H3; auto. inv H4; auto. inv H1. exploit abuiltin_arg_sound. eauto. eauto. eauto. eauto. eauto. eexact H0. intros VM1. exploit abuiltin_arg_sound. eauto. eauto. eauto. eauto. eauto. eexact H2. intros VM2. - eapply sound_succ_state; eauto. simpl; auto. + eapply sound_succ_state; eauto. simpl; auto. apply set_builtin_res_sound; auto. constructor. - eapply storebytes_sound; eauto. - apply match_aptr_of_aval; auto. - eapply Mem.loadbytes_length; eauto. - intros. eapply loadbytes_sound; eauto. apply match_aptr_of_aval; auto. - eapply romatch_storebytes; eauto. - eapply sound_stack_storebytes; eauto. + eapply storebytes_sound; eauto. + apply match_aptr_of_aval; auto. + eapply Mem.loadbytes_length; eauto. + intros. eapply loadbytes_sound; eauto. apply match_aptr_of_aval; auto. + eapply romatch_storebytes; eauto. + eapply sound_stack_storebytes; eauto. + (* annot *) - inv H1. eapply sound_succ_state; eauto. simpl; auto. apply set_builtin_res_sound; auto. constructor. + inv H1. eapply sound_succ_state; eauto. simpl; auto. apply set_builtin_res_sound; auto. constructor. + (* annot val *) inv H0; auto. inv H3; auto. inv H1. eapply sound_succ_state; eauto. simpl; auto. apply set_builtin_res_sound; auto. eapply abuiltin_arg_sound; eauto. + (* debug *) - inv H1. eapply sound_succ_state; eauto. simpl; auto. apply set_builtin_res_sound; auto. constructor. + inv H1. eapply sound_succ_state; eauto. simpl; auto. apply set_builtin_res_sound; auto. constructor. - (* cond *) - eapply sound_succ_state; eauto. - simpl. destruct b; auto. - unfold transfer; rewrite H; auto. + eapply sound_succ_state; eauto. + simpl. destruct b; auto. + unfold transfer; rewrite H; auto. - (* jumptable *) - eapply sound_succ_state; eauto. - simpl. eapply list_nth_z_in; eauto. + eapply sound_succ_state; eauto. + simpl. eapply list_nth_z_in; eauto. unfold transfer; rewrite H; auto. - (* return *) exploit anonymize_stack; eauto. intros (bc' & A & B & C & D & E & F & G). apply sound_return_state with bc'; auto. - erewrite Mem.nextblock_free by eauto. + erewrite Mem.nextblock_free by eauto. apply sound_stack_new_bound with stk. apply sound_stack_exten with bc. eapply sound_stack_free; eauto. intros. apply C. apply Plt_ne; auto. apply Plt_Ple. eapply mmatch_below; eauto with va. - destruct or; simpl. eapply D; eauto. constructor. - eapply romatch_free; eauto. + destruct or; simpl. eapply D; eauto. constructor. + eapply romatch_free; eauto. eapply mmatch_free; eauto. - (* internal function *) - exploit allocate_stack; eauto. + exploit allocate_stack; eauto. intros (bc' & A & B & C & D & E & F & G). - exploit (analyze_entrypoint rm f args m' bc'); eauto. + exploit (analyze_entrypoint rm f args m' bc'); eauto. intros (ae & am & AN & EM & MM'). - econstructor; eauto. - erewrite Mem.alloc_result by eauto. + econstructor; eauto. + erewrite Mem.alloc_result by eauto. apply sound_stack_exten with bc; auto. - apply sound_stack_inv with m; auto. + apply sound_stack_inv with m; auto. intros. eapply Mem.loadbytes_alloc_unchanged; eauto. intros. apply F. erewrite Mem.alloc_result by eauto. auto. - (* external function *) exploit external_call_match; eauto with va. intros (bc' & A & B & C & D & E & F & G & K). - econstructor; eauto. + econstructor; eauto. apply sound_stack_new_bound with (Mem.nextblock m). apply sound_stack_exten with bc; auto. - apply sound_stack_inv with m; auto. + apply sound_stack_inv with m; auto. eapply external_call_nextblock; eauto. - (* return *) inv STK. + (* from public call *) - exploit return_from_public_call; eauto. + exploit return_from_public_call; eauto. intros; rewrite SAME; auto. - intros (bc1 & A & B & C & D & E & F & G). + intros (bc1 & A & B & C & D & E & F & G). destruct (analyze rm f)#pc as [ |ae' am'] eqn:EQ; simpl in AN; try contradiction. destruct AN as [A1 A2]. eapply sound_regular_state with (bc := bc1); eauto. apply sound_stack_exten with bc'; auto. - eapply ematch_ge; eauto. apply ematch_update. auto. auto. + eapply ematch_ge; eauto. apply ematch_update. auto. auto. + (* from private call *) - exploit return_from_private_call; eauto. + exploit return_from_private_call; eauto. intros; rewrite SAME; auto. - intros (bc1 & A & B & C & D & E & F & G). + intros (bc1 & A & B & C & D & E & F & G). destruct (analyze rm f)#pc as [ |ae' am'] eqn:EQ; simpl in AN; try contradiction. destruct AN as [A1 A2]. eapply sound_regular_state with (bc := bc1); eauto. apply sound_stack_exten with bc'; auto. @@ -1498,8 +1498,8 @@ Lemma initial_block_classification: /\ (forall b id, bc b = BCglob id -> Genv.find_symbol ge id = Some b) /\ (forall b, Mem.valid_block m b -> bc b <> BCinvalid). Proof. - intros. - set (f := fun b => + intros. + set (f := fun b => if plt b (Genv.genv_next ge) then match Genv.invert_symbol ge b with None => BCother | Some id => BCglob id end else @@ -1511,8 +1511,8 @@ Proof. destruct (Genv.invert_symbol ge b1) as [id1|] eqn:I1; inv H0. destruct (plt b2 (Genv.genv_next ge)); try discriminate. destruct (Genv.invert_symbol ge b2) as [id2|] eqn:I2; inv H1. - exploit Genv.invert_find_symbol. eexact I1. - exploit Genv.invert_find_symbol. eexact I2. + exploit Genv.invert_find_symbol. eexact I1. + exploit Genv.invert_find_symbol. eexact I2. congruence. } assert (F_stack: forall b1 b2, f b1 = BCstack -> f b2 = BCstack -> b1 = b2). @@ -1523,19 +1523,19 @@ Proof. } set (bc := BC f F_stack F_glob). unfold f in bc. exists bc; splitall. -- split; simpl; intros. +- split; simpl; intros. + split; intros. * rewrite pred_dec_true by (eapply Genv.genv_symb_range; eauto). erewrite Genv.find_invert_symbol; eauto. - * apply Genv.invert_find_symbol. + * apply Genv.invert_find_symbol. destruct (plt b (Genv.genv_next ge)); try discriminate. destruct (Genv.invert_symbol ge b); congruence. - + rewrite ! pred_dec_true by assumption. + + rewrite ! pred_dec_true by assumption. destruct (Genv.invert_symbol); split; congruence. - red; simpl; intros. destruct (plt b (Genv.genv_next ge)); try congruence. - erewrite <- Genv.init_mem_genv_next by eauto. auto. -- red; simpl; intros. - destruct (plt b (Genv.genv_next ge)). + erewrite <- Genv.init_mem_genv_next by eauto. auto. +- red; simpl; intros. + destruct (plt b (Genv.genv_next ge)). destruct (Genv.invert_symbol ge b); congruence. congruence. - simpl; intros. destruct (plt b (Genv.genv_next ge)); try discriminate. @@ -1561,13 +1561,13 @@ Proof. vge (Ifptr Glob) av -> pge Glob (ab_summary (ablock_store chunk ab p av))). { - intros. simpl. unfold vplub; destruct av; auto. + intros. simpl. unfold vplub; destruct av; auto. inv H0. apply plub_least; auto. inv H0. apply plub_least; auto. } destruct id; auto. - simpl. destruct (propagate_float_constants tt); auto. - simpl. destruct (propagate_float_constants tt); auto. + simpl. destruct (propagate_float_constants tt); auto. + simpl. destruct (propagate_float_constants tt); auto. apply DFL. constructor. constructor. Qed. @@ -1576,7 +1576,7 @@ Lemma store_init_data_list_summary: pge Glob (ab_summary ab) -> pge Glob (ab_summary (store_init_data_list ab p idl)). Proof. - induction idl; simpl; intros. auto. apply IHidl. apply store_init_data_summary; auto. + induction idl; simpl; intros. auto. apply IHidl. apply store_init_data_summary; auto. Qed. Lemma store_init_data_sound: @@ -1588,7 +1588,7 @@ Proof. intros. destruct id; try (eapply ablock_store_sound; eauto; constructor). simpl. destruct (propagate_float_constants tt); eapply ablock_store_sound; eauto; constructor. simpl. destruct (propagate_float_constants tt); eapply ablock_store_sound; eauto; constructor. - simpl in H. inv H. auto. + simpl in H. inv H. auto. simpl in H. destruct (Genv.find_symbol ge i) as [b'|] eqn:FS; try discriminate. eapply ablock_store_sound; eauto. constructor. constructor. apply GMATCH; auto. Qed. @@ -1602,7 +1602,7 @@ Proof. induction idl; simpl; intros. - inv H; auto. - destruct (Genv.store_init_data ge m b p a) as [m1|] eqn:SI; try discriminate. - eapply IHidl; eauto. eapply store_init_data_sound; eauto. + eapply IHidl; eauto. eapply store_init_data_sound; eauto. Qed. Lemma store_init_data_other: @@ -1614,7 +1614,7 @@ Lemma store_init_data_other: Proof. intros. eapply bmatch_inv; eauto. intros. destruct id; try (eapply Mem.loadbytes_store_other; eauto; fail); simpl in H. - inv H; auto. + inv H; auto. destruct (Genv.find_symbol ge i); try discriminate. eapply Mem.loadbytes_store_other; eauto. Qed. @@ -1626,10 +1626,10 @@ Lemma store_init_data_list_other: bmatch bc m b' ab -> bmatch bc m' b' ab. Proof. - induction idl; simpl; intros. + induction idl; simpl; intros. inv H; auto. destruct (Genv.store_init_data ge m b p a) as [m1|] eqn:SI; try discriminate. - eapply IHidl; eauto. eapply store_init_data_other; eauto. + eapply IHidl; eauto. eapply store_init_data_other; eauto. Qed. Lemma store_zeros_same: @@ -1640,8 +1640,8 @@ Lemma store_zeros_same: Proof. intros until n. functional induction (store_zeros m b pos n); intros. - inv H. auto. -- eapply IHo; eauto. change p with (vplub (I Int.zero) p). - eapply smatch_store; eauto. constructor. +- eapply IHo; eauto. change p with (vplub (I Int.zero) p). + eapply smatch_store; eauto. constructor. - discriminate. Qed. @@ -1654,8 +1654,8 @@ Lemma store_zeros_other: Proof. intros until n. functional induction (store_zeros m b p n); intros. - inv H. auto. -- eapply IHo; eauto. eapply bmatch_inv; eauto. - intros. eapply Mem.loadbytes_store_other; eauto. +- eapply IHo; eauto. eapply bmatch_inv; eauto. + intros. eapply Mem.loadbytes_store_other; eauto. - discriminate. Qed. @@ -1673,16 +1673,16 @@ Lemma alloc_global_match: initial_mem_match bc m' (Genv.add_global g idg). Proof. intros; red; intros. destruct idg as [id [fd | gv]]; simpl in *. -- destruct (Mem.alloc m 0 1) as [m1 b1] eqn:ALLOC. +- destruct (Mem.alloc m 0 1) as [m1 b1] eqn:ALLOC. unfold Genv.find_var_info, Genv.add_global in H2; simpl in H2. - assert (Plt b (Mem.nextblock m)). + assert (Plt b (Mem.nextblock m)). { rewrite <- H. eapply Genv.genv_vars_range; eauto. } - assert (b <> b1). + assert (b <> b1). { apply Plt_ne. erewrite Mem.alloc_result by eauto. auto. } - apply bmatch_inv with m. - eapply H0; eauto. - intros. transitivity (Mem.loadbytes m1 b ofs n). - eapply Mem.loadbytes_drop; eauto. + apply bmatch_inv with m. + eapply H0; eauto. + intros. transitivity (Mem.loadbytes m1 b ofs n). + eapply Mem.loadbytes_drop; eauto. eapply Mem.loadbytes_alloc_unchanged; eauto. - set (sz := Genv.init_data_list_size (gvar_init gv)) in *. destruct (Mem.alloc m 0 sz) as [m1 b1] eqn:ALLOC. @@ -1690,28 +1690,28 @@ Proof. destruct (Genv.store_init_data_list ge m2 b1 0 (gvar_init gv)) as [m3 | ] eqn:SIDL; try discriminate. unfold Genv.find_var_info, Genv.add_global in H2; simpl in H2. rewrite PTree.gsspec in H2. destruct (peq b (Genv.genv_next g)). -+ inversion H2; clear H2; subst v. ++ inversion H2; clear H2; subst v. assert (b = b1). { erewrite Mem.alloc_result by eauto. congruence. } - clear e. subst b. - apply bmatch_inv with m3. - eapply store_init_data_list_sound; eauto. + clear e. subst b. + apply bmatch_inv with m3. + eapply store_init_data_list_sound; eauto. apply ablock_init_sound. - eapply store_zeros_same; eauto. - split; intros. - exploit Mem.load_alloc_same; eauto. intros EQ; subst v; constructor. + eapply store_zeros_same; eauto. + split; intros. + exploit Mem.load_alloc_same; eauto. intros EQ; subst v; constructor. exploit Mem.loadbytes_alloc_same; eauto with coqlib. congruence. - intros. eapply Mem.loadbytes_drop; eauto. - right; right; right. unfold Genv.perm_globvar. rewrite H3, H4. constructor. -+ assert (Plt b (Mem.nextblock m)). + intros. eapply Mem.loadbytes_drop; eauto. + right; right; right. unfold Genv.perm_globvar. rewrite H3, H4. constructor. ++ assert (Plt b (Mem.nextblock m)). { rewrite <- H. eapply Genv.genv_vars_range; eauto. } - assert (b <> b1). + assert (b <> b1). { apply Plt_ne. erewrite Mem.alloc_result by eauto. auto. } apply bmatch_inv with m3. - eapply store_init_data_list_other; eauto. - eapply store_zeros_other; eauto. - apply bmatch_inv with m. - eapply H0; eauto. - intros. eapply Mem.loadbytes_alloc_unchanged; eauto. + eapply store_init_data_list_other; eauto. + eapply store_zeros_other; eauto. + apply bmatch_inv with m. + eapply H0; eauto. + intros. eapply Mem.loadbytes_alloc_unchanged; eauto. intros. eapply Mem.loadbytes_drop; eauto. Qed. @@ -1722,12 +1722,12 @@ Lemma alloc_globals_match: Genv.alloc_globals ge m gl = Some m' -> initial_mem_match bc m' (Genv.add_globals g gl). Proof. - induction gl; simpl; intros. -- inv H1; auto. + induction gl; simpl; intros. +- inv H1; auto. - destruct (Genv.alloc_global ge m a) as [m1|] eqn:AG; try discriminate. - eapply IHgl; eauto. - erewrite Genv.alloc_global_nextblock; eauto. simpl. congruence. - eapply alloc_global_match; eauto. + eapply IHgl; eauto. + erewrite Genv.alloc_global_nextblock; eauto. simpl. congruence. + eapply alloc_global_match; eauto. Qed. Definition romem_consistent (g: genv) (rm: romem) := @@ -1747,19 +1747,19 @@ Proof. intros; red; intros. destruct idg as [id1 [fd1 | v1]]; unfold Genv.add_global, Genv.find_symbol, Genv.find_var_info, alloc_global in *; simpl in *. - rewrite PTree.gsspec in H0. rewrite PTree.grspec in H1. unfold PTree.elt_eq in *. - destruct (peq id id1). congruence. eapply H; eauto. + destruct (peq id id1). congruence. eapply H; eauto. - rewrite PTree.gsspec in H0. destruct (peq id id1). -+ inv H0. rewrite PTree.gss. ++ inv H0. rewrite PTree.gss. destruct (gvar_readonly v1 && negb (gvar_volatile v1) && definitive_initializer (gvar_init v1)) eqn:RO. InvBooleans. rewrite negb_true_iff in H4. rewrite PTree.gss in H1. - exists v1. intuition congruence. + exists v1. intuition congruence. rewrite PTree.grs in H1. discriminate. -+ rewrite PTree.gso. eapply H; eauto. ++ rewrite PTree.gso. eapply H; eauto. destruct (gvar_readonly v1 && negb (gvar_volatile v1) && definitive_initializer (gvar_init v1)). - rewrite PTree.gso in H1; auto. - rewrite PTree.gro in H1; auto. - apply Plt_ne. eapply Genv.genv_symb_range; eauto. + rewrite PTree.gso in H1; auto. + rewrite PTree.gro in H1; auto. + apply Plt_ne. eapply Genv.genv_symb_range; eauto. Qed. Lemma alloc_globals_consistent: @@ -1767,14 +1767,14 @@ Lemma alloc_globals_consistent: romem_consistent g rm -> romem_consistent (Genv.add_globals g gl) (List.fold_left alloc_global gl rm). Proof. - induction gl; simpl; intros. auto. apply IHgl. apply alloc_global_consistent; auto. + induction gl; simpl; intros. auto. apply IHgl. apply alloc_global_consistent; auto. Qed. End INIT. Theorem initial_mem_matches: forall m, - Genv.init_mem prog = Some m -> + Genv.init_mem prog = Some m -> exists bc, genv_match bc ge /\ bc_below bc (Mem.nextblock m) @@ -1783,7 +1783,7 @@ Theorem initial_mem_matches: /\ (forall b, Mem.valid_block m b -> bc b <> BCinvalid). Proof. intros. - exploit initial_block_classification; eauto. intros (bc & GE & BELOW & NOSTACK & INV & VALID). + exploit initial_block_classification; eauto. intros (bc & GE & BELOW & NOSTACK & INV & VALID). exists bc; splitall; auto. assert (A: initial_mem_match bc m ge). { @@ -1796,34 +1796,34 @@ Proof. red; intros. rewrite PTree.gempty in H1; discriminate. } red; intros. - exploit B; eauto. intros (v & FV & RO & NVOL & EQ). - split. subst ab. apply store_init_data_list_summary. constructor. - split. subst ab. eapply A; eauto. - unfold ge in FV; exploit Genv.init_mem_characterization; eauto. - intros (P & Q & R). - intros; red; intros. exploit Q; eauto. intros [U V]. - unfold Genv.perm_globvar in V; rewrite RO, NVOL in V. inv V. + exploit B; eauto. intros (v & FV & RO & NVOL & EQ). + split. subst ab. apply store_init_data_list_summary. constructor. + split. subst ab. eapply A; eauto. + unfold ge in FV; exploit Genv.init_mem_characterization; eauto. + intros (P & Q & R). + intros; red; intros. exploit Q; eauto. intros [U V]. + unfold Genv.perm_globvar in V; rewrite RO, NVOL in V. inv V. Qed. -End INITIAL. +End INITIAL. Require Import Axioms. Theorem sound_initial: forall prog st, initial_state prog st -> sound_state prog st. Proof. - destruct 1. + destruct 1. exploit initial_mem_matches; eauto. intros (bc & GE & BELOW & NOSTACK & RM & VALID). - apply sound_call_state with bc. -- constructor. -- simpl; tauto. + apply sound_call_state with bc. +- constructor. +- simpl; tauto. - exact RM. - apply mmatch_inj_top with m0. replace (inj_of_bc bc) with (Mem.flat_inj (Mem.nextblock m0)). eapply Genv.initmem_inject; eauto. symmetry; apply extensionality; unfold Mem.flat_inj; intros x. - destruct (plt x (Mem.nextblock m0)). - apply inj_of_bc_valid; auto. + destruct (plt x (Mem.nextblock m0)). + apply inj_of_bc_valid; auto. unfold inj_of_bc. erewrite bc_below_invalid; eauto. - exact GE. - exact NOSTACK. @@ -1848,7 +1848,7 @@ Lemma avalue_sound: /\ bc sp = BCstack. Proof. intros. inv H. exists bc; split; auto. rewrite AN. apply EM. -Qed. +Qed. Definition aaddr (a: VA.t) (r: reg) : aptr := match a with @@ -1867,7 +1867,7 @@ Lemma aaddr_sound: Proof. intros. inv H. exists bc; split; auto. unfold aaddr; rewrite AN. apply match_aptr_of_aval. rewrite <- H0. apply EM. -Qed. +Qed. Definition aaddressing (a: VA.t) (addr: addressing) (args: list reg) : aptr := match a with @@ -1884,8 +1884,8 @@ Lemma aaddressing_sound: /\ genv_match bc (Genv.globalenv prog) /\ bc sp = BCstack. Proof. - intros. inv H. exists bc; split; auto. - unfold aaddressing. rewrite AN. apply match_aptr_of_aval. + intros. inv H. exists bc; split; auto. + unfold aaddressing. rewrite AN. apply match_aptr_of_aval. eapply eval_static_addressing_sound; eauto with va. Qed. @@ -1895,7 +1895,7 @@ Qed. Definition aaddr_arg (a: VA.t) (ba: builtin_arg reg) : aptr := match a with | VA.Bot => Pbot - | VA.State ae am => + | VA.State ae am => match ba with | BA r => aptr_of_aval (AE.get r ae) | BA_addrstack ofs => Stk ofs @@ -1914,7 +1914,7 @@ Lemma aaddr_arg_sound_1: eval_builtin_arg ge (fun r : positive => rs # r) (Vptr sp Int.zero) m a (Vptr b ofs) -> pmatch bc b ofs (aaddr_arg (VA.State ae am) a). Proof. - intros. + intros. apply pmatch_ge with (aptr_of_aval (abuiltin_arg ae am rm a)). simpl. destruct a; try (apply pge_top); simpl; apply pge_refl. apply match_aptr_of_aval. eapply abuiltin_arg_sound; eauto. diff --git a/backend/ValueDomain.v b/backend/ValueDomain.v index 3d95bdd1..048ab816 100644 --- a/backend/ValueDomain.v +++ b/backend/ValueDomain.v @@ -47,7 +47,7 @@ Definition bc_below (bc: block_classification) (bound: block) : Prop := Lemma bc_below_invalid: forall b bc bound, ~Plt b bound -> bc_below bc bound -> bc b = BCinvalid. Proof. - intros. destruct (block_class_eq (bc b) BCinvalid); auto. + intros. destruct (block_class_eq (bc b) BCinvalid); auto. elim H. apply H0; auto. Qed. @@ -96,7 +96,7 @@ Lemma cmatch_lub_l: Proof. intros. unfold club; inv H; destruct y; try constructor; destruct (eqb b b0) eqn:EQ; try constructor. - replace b0 with b by (apply eqb_prop; auto). constructor. + replace b0 with b by (apply eqb_prop; auto). constructor. Qed. Lemma cmatch_lub_r: @@ -136,7 +136,7 @@ Inductive aptr : Type := Definition eq_aptr: forall (p1 p2: aptr), {p1=p2} + {p1<>p2}. Proof. - intros. generalize ident_eq, Int.eq_dec; intros. decide equality. + intros. generalize ident_eq, Int.eq_dec; intros. decide equality. Defined. Inductive pmatch (b: block) (ofs: int): aptr -> Prop := @@ -192,7 +192,7 @@ Qed. Lemma pmatch_top': forall b ofs p, pmatch b ofs p -> pmatch b ofs Ptop. Proof. - intros. apply pmatch_ge with p; auto with va. + intros. apply pmatch_ge with p; auto with va. Qed. Definition plub (p q: aptr) : aptr := @@ -215,7 +215,7 @@ Definition plub (p q: aptr) : aptr := Nonstack | Stk ofs1, Stk ofs2 => if Int.eq_dec ofs1 ofs2 then p else Stack - | (Stk _ | Stack), Stack => + | (Stk _ | Stack), Stack => Stack | Stack, Stk _ => Stack @@ -226,22 +226,22 @@ Lemma plub_comm: forall p q, plub p q = plub q p. Proof. intros; unfold plub; destruct p; destruct q; auto. - destruct (ident_eq id id0). subst id0. - rewrite dec_eq_true. + destruct (ident_eq id id0). subst id0. + rewrite dec_eq_true. destruct (Int.eq_dec ofs ofs0). subst ofs0. rewrite dec_eq_true. auto. - rewrite dec_eq_false by auto. auto. - rewrite dec_eq_false by auto. auto. - destruct (ident_eq id id0). subst id0. + rewrite dec_eq_false by auto. auto. + rewrite dec_eq_false by auto. auto. + destruct (ident_eq id id0). subst id0. rewrite dec_eq_true; auto. rewrite dec_eq_false; auto. - destruct (ident_eq id id0). subst id0. + destruct (ident_eq id id0). subst id0. rewrite dec_eq_true; auto. rewrite dec_eq_false; auto. - destruct (ident_eq id id0). subst id0. + destruct (ident_eq id id0). subst id0. rewrite dec_eq_true; auto. rewrite dec_eq_false; auto. destruct (Int.eq_dec ofs ofs0). subst ofs0. rewrite dec_eq_true; auto. - rewrite dec_eq_false; auto. + rewrite dec_eq_false; auto. Qed. Lemma pge_lub_l: @@ -283,7 +283,7 @@ Proof. - unfold plub; destruct q; repeat rewrite dec_eq_true; constructor. - rewrite dec_eq_true; constructor. - rewrite dec_eq_true; constructor. -- rewrite dec_eq_true. destruct (Int.eq_dec ofs ofs0); constructor. +- rewrite dec_eq_true. destruct (Int.eq_dec ofs ofs0); constructor. - destruct (ident_eq id id0). destruct (Int.eq_dec ofs ofs0); constructor. constructor. - destruct (ident_eq id id0); constructor. - destruct (ident_eq id id0); constructor. @@ -328,7 +328,7 @@ Lemma pincl_sound: forall b ofs p q, pincl p q = true -> pmatch b ofs p -> pmatch b ofs q. Proof. - intros. eapply pmatch_ge; eauto. apply pincl_ge; auto. + intros. eapply pmatch_ge; eauto. apply pincl_ge; auto. Qed. Definition padd (p: aptr) (n: int) : aptr := @@ -343,7 +343,7 @@ Lemma padd_sound: pmatch b ofs p -> pmatch b (Int.add ofs delta) (padd p delta). Proof. - intros. inv H; simpl padd; eauto with va. + intros. inv H; simpl padd; eauto with va. Qed. Definition psub (p: aptr) (n: int) : aptr := @@ -358,7 +358,7 @@ Lemma psub_sound: pmatch b ofs p -> pmatch b (Int.sub ofs delta) (psub p delta). Proof. - intros. inv H; simpl psub; eauto with va. + intros. inv H; simpl psub; eauto with va. Qed. Definition poffset (p: aptr) : aptr := @@ -373,7 +373,7 @@ Lemma poffset_sound: pmatch b ofs1 p -> pmatch b ofs2 (poffset p). Proof. - intros. inv H; simpl poffset; eauto with va. + intros. inv H; simpl poffset; eauto with va. Qed. Definition psub2 (p q: aptr) : option int := @@ -442,7 +442,7 @@ Lemma pcmp_sound: cmatch (Val.cmpu_bool valid c (Vptr b1 ofs1) (Vptr b2 ofs2)) (pcmp c p1 p2). Proof. intros. - assert (DIFF: b1 <> b2 -> + assert (DIFF: b1 <> b2 -> cmatch (Val.cmpu_bool valid c (Vptr b1 ofs1) (Vptr b2 ofs2)) (cmp_different_blocks c)). { @@ -455,19 +455,19 @@ Proof. cmatch (Val.cmpu_bool valid c (Vptr b1 ofs1) (Vptr b2 ofs2)) (Maybe (Int.cmpu c ofs1 ofs2))). { - intros. subst b2. simpl. rewrite dec_eq_true. + intros. subst b2. simpl. rewrite dec_eq_true. destruct ((valid b1 (Int.unsigned ofs1) || valid b1 (Int.unsigned ofs1 - 1)) && (valid b1 (Int.unsigned ofs2) || valid b1 (Int.unsigned ofs2 - 1))); simpl. - constructor. + constructor. constructor. } unfold pcmp; inv H; inv H0; (apply cmatch_top || (apply DIFF; congruence) || idtac). - - destruct (peq id id0). subst id0. apply SAME. eapply bc_glob; eauto. + - destruct (peq id id0). subst id0. apply SAME. eapply bc_glob; eauto. auto with va. - destruct (peq id id0); auto with va. - destruct (peq id id0); auto with va. - destruct (peq id id0); auto with va. - - apply SAME. eapply bc_stack; eauto. + - apply SAME. eapply bc_stack; eauto. Qed. Lemma pcmp_none: @@ -539,7 +539,7 @@ Definition Vtop := Ifptr Ptop. Definition eq_aval: forall (v1 v2: aval), {v1=v2} + {v1<>v2}. Proof. intros. generalize zeq Int.eq_dec Int64.eq_dec Float.eq_dec Float32.eq_dec eq_aptr; intros. - decide equality. + decide equality. Defined. Definition is_uns (n: Z) (i: int) : Prop := @@ -570,7 +570,7 @@ Lemma vmatch_ifptr: (forall b ofs, v = Vptr b ofs -> pmatch b ofs p) -> vmatch v (Ifptr p). Proof. - intros. destruct v; constructor; auto. + intros. destruct v; constructor; auto. Qed. Lemma vmatch_top: forall v x, vmatch v x -> vmatch v Vtop. @@ -604,8 +604,8 @@ Definition ssize (i: int) := Int.size (if Int.lt i Int.zero then Int.not i else Lemma is_uns_usize: forall i, is_uns (usize i) i. Proof. - unfold usize; intros; red; intros. - apply Int.bits_size_2. omega. + unfold usize; intros; red; intros. + apply Int.bits_size_2. omega. Qed. Lemma is_sgn_ssize: @@ -627,7 +627,7 @@ Qed. Lemma is_uns_zero_ext: forall n i, is_uns n i <-> Int.zero_ext n i = i. Proof. - intros; split; intros. + intros; split; intros. Int.bit_solve. destruct (zlt i0 n); auto. symmetry; apply H; auto. omega. rewrite <- H. red; intros. rewrite Int.bits_zero_ext by omega. rewrite zlt_false by omega. auto. Qed. @@ -635,12 +635,12 @@ Qed. Lemma is_sgn_sign_ext: forall n i, 0 < n -> (is_sgn n i <-> Int.sign_ext n i = i). Proof. - intros; split; intros. + intros; split; intros. Int.bit_solve. destruct (zlt i0 n); auto. transitivity (Int.testbit i (Int.zwordsize - 1)). - apply H0; omega. symmetry; apply H0; omega. + apply H0; omega. symmetry; apply H0; omega. rewrite <- H0. red; intros. rewrite ! Int.bits_sign_ext by omega. - f_equal. transitivity (n-1). destruct (zlt m n); omega. + f_equal. transitivity (n-1). destruct (zlt m n); omega. destruct (zlt (Int.zwordsize - 1) n); omega. Qed. @@ -649,7 +649,7 @@ Lemma is_zero_ext_uns: is_uns m i \/ n <= m -> is_uns m (Int.zero_ext n i). Proof. intros. red; intros. rewrite Int.bits_zero_ext by omega. - destruct (zlt m0 n); auto. destruct H. apply H; omega. omegaContradiction. + destruct (zlt m0 n); auto. destruct H. apply H; omega. omegaContradiction. Qed. Lemma is_zero_ext_sgn: @@ -657,7 +657,7 @@ Lemma is_zero_ext_sgn: n < m -> is_sgn m (Int.zero_ext n i). Proof. - intros. red; intros. rewrite ! Int.bits_zero_ext by omega. + intros. red; intros. rewrite ! Int.bits_zero_ext by omega. transitivity false. apply zlt_false; omega. symmetry; apply zlt_false; omega. Qed. @@ -668,18 +668,18 @@ Lemma is_sign_ext_uns: is_uns m i -> is_uns m (Int.sign_ext n i). Proof. - intros; red; intros. rewrite Int.bits_sign_ext by omega. + intros; red; intros. rewrite Int.bits_sign_ext by omega. apply H0. destruct (zlt m0 n); omega. destruct (zlt m0 n); omega. Qed. - + Lemma is_sign_ext_sgn: forall i n m, 0 < n -> 0 < m -> is_sgn m i \/ n <= m -> is_sgn m (Int.sign_ext n i). Proof. intros. apply is_sgn_sign_ext; auto. - destruct (zlt m n). destruct H1. apply is_sgn_sign_ext in H1; auto. - rewrite <- H1. rewrite (Int.sign_ext_widen i) by omega. apply Int.sign_ext_idem; auto. + destruct (zlt m n). destruct H1. apply is_sgn_sign_ext in H1; auto. + rewrite <- H1. rewrite (Int.sign_ext_widen i) by omega. apply Int.sign_ext_idem; auto. omegaContradiction. apply Int.sign_ext_widen; omega. Qed. @@ -690,7 +690,7 @@ Lemma is_uns_1: forall n, is_uns 1 n -> n = Int.zero \/ n = Int.one. Proof. intros. destruct (Int.testbit n 0) eqn:B0; [right|left]; apply Int.same_bits_eq; intros. - rewrite Int.bits_one. destruct (zeq i 0). subst i; auto. apply H; omega. + rewrite Int.bits_one. destruct (zeq i 0). subst i; auto. apply H; omega. rewrite Int.bits_zero. destruct (zeq i 0). subst i; auto. apply H; omega. Qed. @@ -744,8 +744,8 @@ Lemma vmatch_uns': Proof. intros. assert (A: forall n', n' >= 0 -> n' >= n -> is_uns n' i) by (eauto with va). - unfold uns. - destruct (zle n 1). auto with va. + unfold uns. + destruct (zle n 1). auto with va. destruct (zle n 7). auto with va. destruct (zle n 8). auto with va. destruct (zle n 15). auto with va. @@ -761,8 +761,8 @@ Qed. Lemma vmatch_uns_undef: forall p n, vmatch Vundef (uns p n). Proof. - intros. unfold uns. - destruct (zle n 1). auto with va. + intros. unfold uns. + destruct (zle n 1). auto with va. destruct (zle n 7). auto with va. destruct (zle n 8). auto with va. destruct (zle n 15). auto with va. @@ -774,7 +774,7 @@ Lemma vmatch_sgn': Proof. intros. assert (A: forall n', n' >= 1 -> n' >= n -> is_sgn n' i) by (eauto with va). - unfold sgn. + unfold sgn. destruct (zle n 8). auto with va. destruct (zle n 16); auto with va. Qed. @@ -893,8 +893,8 @@ Proof. intros. unfold vlub; destruct v; destruct w; auto. - rewrite Int.eq_sym. predSpec Int.eq Int.eq_spec n0 n. congruence. - rewrite orb_comm. - destruct (Int.lt n0 Int.zero || Int.lt n Int.zero); f_equal; apply Z.max_comm. + rewrite orb_comm. + destruct (Int.lt n0 Int.zero || Int.lt n Int.zero); f_equal; apply Z.max_comm. - f_equal. apply plub_comm. apply Z.max_comm. - f_equal. apply plub_comm. apply Z.max_comm. - f_equal; apply plub_comm. @@ -918,7 +918,7 @@ Qed. Lemma vge_uns_uns': forall p n, vge (uns p n) (Uns p n). Proof. - unfold uns; intros. + unfold uns; intros. destruct (zle n 1). auto with va. destruct (zle n 7). auto with va. destruct (zle n 8). auto with va. @@ -928,19 +928,19 @@ Qed. Lemma vge_uns_i': forall p n i, 0 <= n -> is_uns n i -> vge (uns p n) (I i). Proof. - intros. apply vge_trans with (Uns p n). apply vge_uns_uns'. auto with va. + intros. apply vge_trans with (Uns p n). apply vge_uns_uns'. auto with va. Qed. Lemma vge_sgn_sgn': forall p n, vge (sgn p n) (Sgn p n). Proof. - unfold sgn; intros. + unfold sgn; intros. destruct (zle n 8). auto with va. destruct (zle n 16); auto with va. Qed. Lemma vge_sgn_i': forall p n i, 0 < n -> is_sgn n i -> vge (sgn p n) (I i). Proof. - intros. apply vge_trans with (Sgn p n). apply vge_sgn_sgn'. auto with va. + intros. apply vge_trans with (Sgn p n). apply vge_sgn_sgn'. auto with va. Qed. Hint Resolve vge_uns_uns' vge_uns_i' vge_sgn_sgn' vge_sgn_i' : va. @@ -952,7 +952,7 @@ Qed. Lemma ssize_pos: forall n, 0 < ssize n. Proof. - unfold ssize; intros. + unfold ssize; intros. generalize (Int.size_range (if Int.lt n Int.zero then Int.not n else n)); omega. Qed. @@ -964,16 +964,16 @@ Proof. unfold vlub; destruct x, y; eauto using pge_lub_l with va. - predSpec Int.eq Int.eq_spec n n0. auto with va. destruct (Int.lt n Int.zero || Int.lt n0 Int.zero). - apply vge_sgn_i'. generalize (ssize_pos n); xomega. eauto with va. - apply vge_uns_i'. generalize (usize_pos n); xomega. eauto with va. + apply vge_sgn_i'. generalize (ssize_pos n); xomega. eauto with va. + apply vge_uns_i'. generalize (usize_pos n); xomega. eauto with va. - destruct (Int.lt n Int.zero). - apply vge_sgn_i'. generalize (ssize_pos n); xomega. eauto with va. - apply vge_uns_i'. generalize (usize_pos n); xomega. eauto with va. -- apply vge_sgn_i'. generalize (ssize_pos n); xomega. eauto with va. + apply vge_sgn_i'. generalize (ssize_pos n); xomega. eauto with va. + apply vge_uns_i'. generalize (usize_pos n); xomega. eauto with va. +- apply vge_sgn_i'. generalize (ssize_pos n); xomega. eauto with va. - destruct (Int.lt n0 Int.zero). eapply vge_trans. apply vge_sgn_sgn'. apply vge_trans with (Sgn p (n + 1)); eauto with va. - eapply vge_trans. apply vge_uns_uns'. eauto with va. + eapply vge_trans. apply vge_uns_uns'. eauto with va. - eapply vge_trans. apply vge_sgn_sgn'. apply vge_trans with (Sgn p (n + 1)); eauto using pge_lub_l with va. - eapply vge_trans. apply vge_sgn_sgn'. eauto with va. @@ -987,7 +987,7 @@ Qed. Lemma vge_lub_r: forall x y, vge (vlub x y) y. Proof. - intros. rewrite vlub_comm. apply vge_lub_l. + intros. rewrite vlub_comm. apply vge_lub_l. Qed. Lemma vmatch_lub_l: @@ -1036,13 +1036,13 @@ Definition vplub (v: aval) (p: aptr) : aptr := Lemma vmatch_vplub_l: forall v x p, vmatch v x -> vmatch v (Ifptr (vplub x p)). Proof. - intros. unfold vplub; inv H; auto with va; constructor; eapply pmatch_lub_l; eauto. + intros. unfold vplub; inv H; auto with va; constructor; eapply pmatch_lub_l; eauto. Qed. Lemma pmatch_vplub: forall b ofs x p, pmatch b ofs p -> pmatch b ofs (vplub x p). Proof. - intros. + intros. assert (DFL: pmatch b ofs (if va_strict tt then p else Ptop)). { destruct (va_strict tt); auto. eapply pmatch_top'; eauto. } unfold vplub; destruct x; auto; apply pmatch_lub_r; auto. @@ -1051,7 +1051,7 @@ Qed. Lemma vmatch_vplub_r: forall v x p, vmatch v (Ifptr p) -> vmatch v (Ifptr (vplub x p)). Proof. - intros. apply vmatch_ifptr; intros; subst v. inv H. apply pmatch_vplub; auto. + intros. apply vmatch_ifptr; intros; subst v. inv H. apply pmatch_vplub; auto. Qed. (** Inclusion *) @@ -1065,13 +1065,13 @@ Definition vpincl (v: aval) (p: aptr) : bool := Lemma vpincl_ge: forall x p, vpincl x p = true -> vge (Ifptr p) x. Proof. - unfold vpincl; intros. destruct x; constructor; apply pincl_ge; auto. + unfold vpincl; intros. destruct x; constructor; apply pincl_ge; auto. Qed. Lemma vpincl_sound: forall v x p, vpincl x p = true -> vmatch v x -> vmatch v (Ifptr p). Proof. - intros. apply vmatch_ge with x; auto. apply vpincl_ge; auto. + intros. apply vmatch_ge with x; auto. apply vpincl_ge; auto. Qed. Definition vincl (v w: aval) : bool := @@ -1111,8 +1111,8 @@ Lemma symbol_address_sound: genv_match ge -> vmatch (Genv.symbol_address ge id ofs) (Ptr (Gl id ofs)). Proof. - intros. unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) as [b|] eqn:F. - constructor. constructor. apply H; auto. + intros. unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) as [b|] eqn:F. + constructor. constructor. apply H; auto. constructor. Qed. @@ -1122,8 +1122,8 @@ Lemma vmatch_ptr_gl: vmatch v (Ptr (Gl id ofs)) -> Val.lessdef v (Genv.symbol_address ge id ofs). Proof. - intros. unfold Genv.symbol_address. inv H0. -- inv H3. replace (Genv.find_symbol ge id) with (Some b). constructor. + intros. unfold Genv.symbol_address. inv H0. +- inv H3. replace (Genv.find_symbol ge id) with (Some b). constructor. symmetry. apply H; auto. - constructor. Qed. @@ -1134,7 +1134,7 @@ Lemma vmatch_ptr_stk: bc sp = BCstack -> Val.lessdef v (Vptr sp ofs). Proof. - intros. inv H. + intros. inv H. - inv H3. replace b with sp by (eapply bc_stack; eauto). constructor. - constructor. Qed. @@ -1223,19 +1223,19 @@ Definition shl (v w: aval) := | _ => ntop1 v end. -Lemma shl_sound: +Lemma shl_sound: forall v w x y, vmatch v x -> vmatch w y -> vmatch (Val.shl v w) (shl x y). Proof. intros. - assert (DEFAULT: vmatch (Val.shl v w) (ntop1 x)). + assert (DEFAULT: vmatch (Val.shl v w) (ntop1 x)). { - destruct v; destruct w; simpl; try constructor. + destruct v; destruct w; simpl; try constructor. destruct (Int.ltu i0 Int.iwordsize); constructor. } destruct y; auto. simpl. inv H0. unfold Val.shl. destruct (Int.ltu n Int.iwordsize) eqn:LTU; auto. exploit Int.ltu_inv; eauto. intros RANGE. - inv H; auto with va. + inv H; auto with va. - apply vmatch_uns'. red; intros. rewrite Int.bits_shl by omega. destruct (zlt m (Int.unsigned n)). auto. apply H1; xomega. - apply vmatch_sgn'. red; intros. zify. @@ -1258,13 +1258,13 @@ Definition shru (v w: aval) := | _ => ntop1 v end. -Lemma shru_sound: +Lemma shru_sound: forall v w x y, vmatch v x -> vmatch w y -> vmatch (Val.shru v w) (shru x y). Proof. intros. - assert (DEFAULT: vmatch (Val.shru v w) (ntop1 x)). + assert (DEFAULT: vmatch (Val.shru v w) (ntop1 x)). { - destruct v; destruct w; simpl; try constructor. + destruct v; destruct w; simpl; try constructor. destruct (Int.ltu i0 Int.iwordsize); constructor. } destruct y; auto. inv H0. unfold shru, Val.shru. @@ -1272,14 +1272,14 @@ Proof. exploit Int.ltu_inv; eauto. intros RANGE. change (Int.unsigned Int.iwordsize) with Int.zwordsize in RANGE. assert (DEFAULT2: forall i, vmatch (Vint (Int.shru i n)) (uns (provenance x) (Int.zwordsize - Int.unsigned n))). { - intros. apply vmatch_uns. red; intros. - rewrite Int.bits_shru by omega. apply zlt_false. omega. + intros. apply vmatch_uns. red; intros. + rewrite Int.bits_shru by omega. apply zlt_false. omega. } inv H; auto with va. - apply vmatch_uns'. red; intros. zify. rewrite Int.bits_shru by omega. destruct (zlt (m + Int.unsigned n) Int.zwordsize); auto. - apply H1; omega. + apply H1; omega. - destruct v; constructor. Qed. @@ -1297,13 +1297,13 @@ Definition shr (v w: aval) := | _ => ntop1 v end. -Lemma shr_sound: +Lemma shr_sound: forall v w x y, vmatch v x -> vmatch w y -> vmatch (Val.shr v w) (shr x y). Proof. intros. - assert (DEFAULT: vmatch (Val.shr v w) (ntop1 x)). + assert (DEFAULT: vmatch (Val.shr v w) (ntop1 x)). { - destruct v; destruct w; simpl; try constructor. + destruct v; destruct w; simpl; try constructor. destruct (Int.ltu i0 Int.iwordsize); constructor. } destruct y; auto. inv H0. unfold shr, Val.shr. @@ -1311,7 +1311,7 @@ Proof. exploit Int.ltu_inv; eauto. intros RANGE. change (Int.unsigned Int.iwordsize) with Int.zwordsize in RANGE. assert (DEFAULT2: forall i, vmatch (Vint (Int.shr i n)) (sgn (provenance x) (Int.zwordsize - Int.unsigned n))). { - intros. apply vmatch_sgn. red; intros. + intros. apply vmatch_sgn. red; intros. rewrite ! Int.bits_shr by omega. f_equal. destruct (zlt (m + Int.unsigned n) Int.zwordsize); destruct (zlt (Int.zwordsize - 1 + Int.unsigned n) Int.zwordsize); @@ -1346,12 +1346,12 @@ Definition and (v w: aval) := | _, _ => ntop2 v w end. -Lemma and_sound: +Lemma and_sound: forall v w x y, vmatch v x -> vmatch w y -> vmatch (Val.and v w) (and x y). Proof. assert (UNS_l: forall i j n, is_uns n i -> is_uns n (Int.and i j)). { - intros; red; intros. rewrite Int.bits_and by auto. rewrite (H m) by auto. + intros; red; intros. rewrite Int.bits_and by auto. rewrite (H m) by auto. apply andb_false_l. } assert (UNS_r: forall i j n, is_uns n i -> is_uns n (Int.and j i)). @@ -1360,7 +1360,7 @@ Proof. } assert (UNS: forall i j n m, is_uns n i -> is_uns m j -> is_uns (Z.min n m) (Int.and i j)). { - intros. apply Z.min_case; auto. + intros. apply Z.min_case; auto. } assert (SGN: forall i j n m, is_sgn n i -> is_sgn m j -> is_sgn (Z.max n m) (Int.and i j)). { @@ -1379,12 +1379,12 @@ Definition or (v w: aval) := | _, _ => ntop2 v w end. -Lemma or_sound: +Lemma or_sound: forall v w x y, vmatch v x -> vmatch w y -> vmatch (Val.or v w) (or x y). Proof. assert (UNS: forall i j n m, is_uns n i -> is_uns m j -> is_uns (Z.max n m) (Int.or i j)). { - intros; red; intros. rewrite Int.bits_or by auto. + intros; red; intros. rewrite Int.bits_or by auto. rewrite H by xomega. rewrite H0 by xomega. auto. } assert (SGN: forall i j n m, is_sgn n i -> is_sgn m j -> is_sgn (Z.max n m) (Int.or i j)). @@ -1404,12 +1404,12 @@ Definition xor (v w: aval) := | _, _ => ntop2 v w end. -Lemma xor_sound: +Lemma xor_sound: forall v w x y, vmatch v x -> vmatch w y -> vmatch (Val.xor v w) (xor x y). Proof. assert (UNS: forall i j n m, is_uns n i -> is_uns m j -> is_uns (Z.max n m) (Int.xor i j)). { - intros; red; intros. rewrite Int.bits_xor by auto. + intros; red; intros. rewrite Int.bits_xor by auto. rewrite H by xomega. rewrite H0 by xomega. auto. } assert (SGN: forall i j n m, is_sgn n i -> is_sgn m j -> is_sgn (Z.max n m) (Int.xor i j)). @@ -1433,7 +1433,7 @@ Lemma notint_sound: Proof. assert (SGN: forall n i, is_sgn n i -> is_sgn n (Int.not i)). { - intros; red; intros. rewrite ! Int.bits_not by omega. + intros; red; intros. rewrite ! Int.bits_not by omega. f_equal. apply H; auto. } intros. unfold Val.notint, notint; inv H; eauto with va. @@ -1445,13 +1445,13 @@ Definition ror (x y: aval) := | _, _ => ntop1 x end. -Lemma ror_sound: +Lemma ror_sound: forall v w x y, vmatch v x -> vmatch w y -> vmatch (Val.ror v w) (ror x y). Proof. - intros. - assert (DEFAULT: forall p, vmatch (Val.ror v w) (Ifptr p)). + intros. + assert (DEFAULT: forall p, vmatch (Val.ror v w) (Ifptr p)). { - destruct v; destruct w; simpl; try constructor. + destruct v; destruct w; simpl; try constructor. destruct (Int.ltu i0 Int.iwordsize); constructor. } unfold ror; destruct y; try apply DEFAULT; auto. inv H0. unfold Val.ror. @@ -1473,7 +1473,7 @@ Proof. intros. assert (UNS_r: forall i j n, is_uns n j -> is_uns n (Int.and i j)). { - intros; red; intros. rewrite Int.bits_and by auto. rewrite (H0 m) by auto. + intros; red; intros. rewrite Int.bits_and by auto. rewrite (H0 m) by auto. apply andb_false_r. } assert (UNS: forall i, vmatch (Vint (Int.rolm i amount mask)) @@ -1486,7 +1486,7 @@ Qed. Definition neg := unop_int Int.neg. -Lemma neg_sound: +Lemma neg_sound: forall v x, vmatch v x -> vmatch (Val.neg v) (neg x). Proof (unop_int_sound Int.neg). @@ -1506,8 +1506,8 @@ Lemma add_sound: Proof. intros. unfold Val.add, add; inv H; inv H0; constructor; ((apply padd_sound; assumption) || (eapply poffset_sound; eassumption) || idtac). - apply pmatch_lub_r. eapply poffset_sound; eauto. - apply pmatch_lub_l. eapply poffset_sound; eauto. + apply pmatch_lub_r. eapply poffset_sound; eauto. + apply pmatch_lub_l. eapply poffset_sound; eauto. Qed. Definition sub (v w: aval) := @@ -1524,7 +1524,7 @@ Definition sub (v w: aval) := | _, _ => ntop2 v w end. -Lemma sub_sound: +Lemma sub_sound: forall v w x y, vmatch v x -> vmatch w y -> vmatch (Val.sub v w) (sub x y). Proof. intros. inv H; subst; inv H0; subst; simpl; @@ -1534,19 +1534,19 @@ Qed. Definition mul := binop_int Int.mul. -Lemma mul_sound: +Lemma mul_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.mul v w) (mul x y). Proof (binop_int_sound Int.mul). Definition mulhs := binop_int Int.mulhs. -Lemma mulhs_sound: +Lemma mulhs_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.mulhs v w) (mulhs x y). Proof (binop_int_sound Int.mulhs). Definition mulhu := binop_int Int.mulhu. -Lemma mulhu_sound: +Lemma mulhu_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.mulhu v w) (mulhu x y). Proof (binop_int_sound Int.mulhu). @@ -1563,7 +1563,7 @@ Definition divs (v w: aval) := Lemma divs_sound: forall v w u x y, vmatch v x -> vmatch w y -> Val.divs v w = Some u -> vmatch u (divs x y). Proof. - intros. destruct v; destruct w; try discriminate; simpl in H1. + intros. destruct v; destruct w; try discriminate; simpl in H1. destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone) eqn:E; inv H1. inv H; inv H0; auto with va. simpl. rewrite E. constructor. @@ -1581,7 +1581,7 @@ Definition divu (v w: aval) := Lemma divu_sound: forall v w u x y, vmatch v x -> vmatch w y -> Val.divu v w = Some u -> vmatch u (divu x y). Proof. - intros. destruct v; destruct w; try discriminate; simpl in H1. + intros. destruct v; destruct w; try discriminate; simpl in H1. destruct (Int.eq i0 Int.zero) eqn:E; inv H1. inv H; inv H0; auto with va. simpl. rewrite E. constructor. Qed. @@ -1599,7 +1599,7 @@ Definition mods (v w: aval) := Lemma mods_sound: forall v w u x y, vmatch v x -> vmatch w y -> Val.mods v w = Some u -> vmatch u (mods x y). Proof. - intros. destruct v; destruct w; try discriminate; simpl in H1. + intros. destruct v; destruct w; try discriminate; simpl in H1. destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone) eqn:E; inv H1. inv H; inv H0; auto with va. simpl. rewrite E. constructor. @@ -1623,14 +1623,14 @@ Proof. intros. apply is_uns_mon with (usize (Int.modu i j)); auto with va. unfold usize, Int.size. apply Int.Zsize_monotone. generalize (Int.unsigned_range_2 j); intros RANGE. - assert (Int.unsigned j <> 0). + assert (Int.unsigned j <> 0). { red; intros; elim H. rewrite <- (Int.repr_unsigned j). rewrite H0. auto. } exploit (Z_mod_lt (Int.unsigned i) (Int.unsigned j)). omega. intros MOD. - unfold Int.modu. rewrite Int.unsigned_repr. omega. omega. + unfold Int.modu. rewrite Int.unsigned_repr. omega. omega. } intros. destruct v; destruct w; try discriminate; simpl in H1. destruct (Int.eq i0 Int.zero) eqn:Z; inv H1. - assert (i0 <> Int.zero) by (generalize (Int.eq_spec i0 Int.zero); rewrite Z; auto). + assert (i0 <> Int.zero) by (generalize (Int.eq_spec i0 Int.zero); rewrite Z; auto). unfold modu. inv H; inv H0; auto with va. rewrite Z. constructor. Qed. @@ -1640,13 +1640,13 @@ Definition shrx (v w: aval) := | _, _ => ntop1 v end. -Lemma shrx_sound: +Lemma shrx_sound: forall v w u x y, vmatch v x -> vmatch w y -> Val.shrx v w = Some u -> vmatch u (shrx x y). Proof. intros. - destruct v; destruct w; try discriminate; simpl in H1. + destruct v; destruct w; try discriminate; simpl in H1. destruct (Int.ltu i0 (Int.repr 31)) eqn:LTU; inv H1. - unfold shrx; inv H; auto with va; inv H0; auto with va. + unfold shrx; inv H; auto with va; inv H0; auto with va. rewrite LTU; auto with va. Qed. @@ -1654,73 +1654,73 @@ Qed. Definition negf := unop_float Float.neg. -Lemma negf_sound: +Lemma negf_sound: forall v x, vmatch v x -> vmatch (Val.negf v) (negf x). Proof (unop_float_sound Float.neg). Definition absf := unop_float Float.abs. -Lemma absf_sound: +Lemma absf_sound: forall v x, vmatch v x -> vmatch (Val.absf v) (absf x). Proof (unop_float_sound Float.abs). Definition addf := binop_float Float.add. -Lemma addf_sound: +Lemma addf_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.addf v w) (addf x y). Proof (binop_float_sound Float.add). Definition subf := binop_float Float.sub. -Lemma subf_sound: +Lemma subf_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.subf v w) (subf x y). Proof (binop_float_sound Float.sub). Definition mulf := binop_float Float.mul. -Lemma mulf_sound: +Lemma mulf_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.mulf v w) (mulf x y). Proof (binop_float_sound Float.mul). Definition divf := binop_float Float.div. -Lemma divf_sound: +Lemma divf_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.divf v w) (divf x y). Proof (binop_float_sound Float.div). Definition negfs := unop_single Float32.neg. -Lemma negfs_sound: +Lemma negfs_sound: forall v x, vmatch v x -> vmatch (Val.negfs v) (negfs x). Proof (unop_single_sound Float32.neg). Definition absfs := unop_single Float32.abs. -Lemma absfs_sound: +Lemma absfs_sound: forall v x, vmatch v x -> vmatch (Val.absfs v) (absfs x). Proof (unop_single_sound Float32.abs). Definition addfs := binop_single Float32.add. -Lemma addfs_sound: +Lemma addfs_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.addfs v w) (addfs x y). Proof (binop_single_sound Float32.add). Definition subfs := binop_single Float32.sub. -Lemma subfs_sound: +Lemma subfs_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.subfs v w) (subfs x y). Proof (binop_single_sound Float32.sub). Definition mulfs := binop_single Float32.mul. -Lemma mulfs_sound: +Lemma mulfs_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.mulfs v w) (mulfs x y). Proof (binop_single_sound Float32.mul). Definition divfs := binop_single Float32.div. -Lemma divfs_sound: +Lemma divfs_sound: forall v x w y, vmatch v x -> vmatch w y -> vmatch (Val.divfs v w) (divfs x y). Proof (binop_single_sound Float32.div). @@ -1738,12 +1738,12 @@ Lemma zero_ext_sound: Proof. assert (DFL: forall nbits i, is_uns nbits (Int.zero_ext nbits i)). { - intros; red; intros. rewrite Int.bits_zero_ext by omega. apply zlt_false; auto. + intros; red; intros. rewrite Int.bits_zero_ext by omega. apply zlt_false; auto. } intros. inv H; simpl; auto with va. apply vmatch_uns. red; intros. zify. rewrite Int.bits_zero_ext by omega. - destruct (zlt m nbits); auto. apply H1; omega. + destruct (zlt m nbits); auto. apply H1; omega. Qed. Definition sign_ext (nbits: Z) (v: aval) := @@ -1761,9 +1761,9 @@ Proof. { intros. apply vmatch_sgn. apply is_sign_ext_sgn; auto with va. } - intros. inv H0; simpl; auto with va. + intros. inv H0; simpl; auto with va. - destruct (zlt n nbits); eauto with va. - constructor; auto. eapply is_sign_ext_uns; eauto with va. + constructor; auto. eapply is_sign_ext_uns; eauto with va. - destruct (zlt n nbits); auto with va. - apply vmatch_sgn. apply is_sign_ext_sgn; auto with va. apply Z.min_case; auto with va. @@ -1778,10 +1778,10 @@ Definition singleoffloat (v: aval) := Lemma singleoffloat_sound: forall v x, vmatch v x -> vmatch (Val.singleoffloat v) (singleoffloat x). Proof. - intros. + intros. assert (DEFAULT: vmatch (Val.singleoffloat v) (ntop1 x)). { destruct v; constructor. } - destruct x; auto. inv H. constructor. + destruct x; auto. inv H. constructor. Qed. Definition floatofsingle (v: aval) := @@ -1793,10 +1793,10 @@ Definition floatofsingle (v: aval) := Lemma floatofsingle_sound: forall v x, vmatch v x -> vmatch (Val.floatofsingle v) (floatofsingle x). Proof. - intros. + intros. assert (DEFAULT: vmatch (Val.floatofsingle v) (ntop1 x)). { destruct v; constructor. } - destruct x; auto. inv H. constructor. + destruct x; auto. inv H. constructor. Qed. Definition intoffloat (x: aval) := @@ -1812,9 +1812,9 @@ Definition intoffloat (x: aval) := Lemma intoffloat_sound: forall v x w, vmatch v x -> Val.intoffloat v = Some w -> vmatch w (intoffloat x). Proof. - unfold Val.intoffloat; intros. destruct v; try discriminate. + unfold Val.intoffloat; intros. destruct v; try discriminate. destruct (Float.to_int f) as [i|] eqn:E; simpl in H0; inv H0. - inv H; simpl; auto with va. rewrite E; constructor. + inv H; simpl; auto with va. rewrite E; constructor. Qed. Definition intuoffloat (x: aval) := @@ -1830,9 +1830,9 @@ Definition intuoffloat (x: aval) := Lemma intuoffloat_sound: forall v x w, vmatch v x -> Val.intuoffloat v = Some w -> vmatch w (intuoffloat x). Proof. - unfold Val.intuoffloat; intros. destruct v; try discriminate. + unfold Val.intuoffloat; intros. destruct v; try discriminate. destruct (Float.to_intu f) as [i|] eqn:E; simpl in H0; inv H0. - inv H; simpl; auto with va. rewrite E; constructor. + inv H; simpl; auto with va. rewrite E; constructor. Qed. Definition floatofint (x: aval) := @@ -1874,9 +1874,9 @@ Definition intofsingle (x: aval) := Lemma intofsingle_sound: forall v x w, vmatch v x -> Val.intofsingle v = Some w -> vmatch w (intofsingle x). Proof. - unfold Val.intofsingle; intros. destruct v; try discriminate. + unfold Val.intofsingle; intros. destruct v; try discriminate. destruct (Float32.to_int f) as [i|] eqn:E; simpl in H0; inv H0. - inv H; simpl; auto with va. rewrite E; constructor. + inv H; simpl; auto with va. rewrite E; constructor. Qed. Definition intuofsingle (x: aval) := @@ -1892,9 +1892,9 @@ Definition intuofsingle (x: aval) := Lemma intuofsingle_sound: forall v x w, vmatch v x -> Val.intuofsingle v = Some w -> vmatch w (intuofsingle x). Proof. - unfold Val.intuofsingle; intros. destruct v; try discriminate. + unfold Val.intuofsingle; intros. destruct v; try discriminate. destruct (Float32.to_intu f) as [i|] eqn:E; simpl in H0; inv H0. - inv H; simpl; auto with va. rewrite E; constructor. + inv H; simpl; auto with va. rewrite E; constructor. Qed. Definition singleofint (x: aval) := @@ -2000,7 +2000,7 @@ Proof. intros c [lo hi] x n; simpl; intros R. destruct c; unfold zcmp, proj_sumbool. - (* eq *) - destruct (zlt n lo). rewrite zeq_false by omega. constructor. + destruct (zlt n lo). rewrite zeq_false by omega. constructor. destruct (zlt hi n). rewrite zeq_false by omega. constructor. constructor. - (* ne *) @@ -2055,7 +2055,7 @@ Proof. intros. inv H; simpl; try (apply Int.unsigned_range_2). - omega. - destruct (zlt n0 Int.zwordsize); simpl. -+ rewrite is_uns_zero_ext in H2. rewrite <- H2. rewrite Int.zero_ext_mod by omega. ++ rewrite is_uns_zero_ext in H2. rewrite <- H2. rewrite Int.zero_ext_mod by omega. exploit (Z_mod_lt (Int.unsigned n) (two_p n0)). apply two_p_gt_ZERO; auto. omega. + apply Int.unsigned_range_2. Qed. @@ -2077,7 +2077,7 @@ Lemma cmpu_intv_sound_2: vmatch (Vint n1) v1 -> cmatch (Val.cmpu_bool valid c (Vint n2) (Vint n1)) (cmp_intv (swap_comparison c) (uintv v1) (Int.unsigned n2)). Proof. - intros. rewrite <- Val.swap_cmpu_bool. apply cmpu_intv_sound; auto. + intros. rewrite <- Val.swap_cmpu_bool. apply cmpu_intv_sound; auto. Qed. Definition sintv (v: aval) : Z * Z := @@ -2098,20 +2098,20 @@ Proof. intros. inv H; simpl; try (apply Int.signed_range). - omega. - destruct (zlt n0 Int.zwordsize); simpl. -+ rewrite is_uns_zero_ext in H2. rewrite <- H2. ++ rewrite is_uns_zero_ext in H2. rewrite <- H2. assert (Int.unsigned (Int.zero_ext n0 n) = Int.unsigned n mod two_p n0) by (apply Int.zero_ext_mod; omega). exploit (Z_mod_lt (Int.unsigned n) (two_p n0)). apply two_p_gt_ZERO; auto. intros. replace (Int.signed (Int.zero_ext n0 n)) with (Int.unsigned (Int.zero_ext n0 n)). - rewrite H. omega. - unfold Int.signed. rewrite zlt_true. auto. - assert (two_p n0 <= Int.half_modulus). - { change Int.half_modulus with (two_p (Int.zwordsize - 1)). + rewrite H. omega. + unfold Int.signed. rewrite zlt_true. auto. + assert (two_p n0 <= Int.half_modulus). + { change Int.half_modulus with (two_p (Int.zwordsize - 1)). apply two_p_monotone. omega. } - omega. + omega. + apply Int.signed_range. - destruct (zlt n0 (Int.zwordsize)); simpl. -+ rewrite is_sgn_sign_ext in H2 by auto. rewrite <- H2. - exploit (Int.sign_ext_range n0 n). omega. omega. ++ rewrite is_sgn_sign_ext in H2 by auto. rewrite <- H2. + exploit (Int.sign_ext_range n0 n). omega. omega. + apply Int.signed_range. Qed. @@ -2132,8 +2132,8 @@ Lemma cmp_intv_sound_2: vmatch (Vint n1) v1 -> cmatch (Val.cmp_bool c (Vint n2) (Vint n1)) (cmp_intv (swap_comparison c) (sintv v1) (Int.signed n2)). Proof. - intros. rewrite <- Val.swap_cmp_bool. apply cmp_intv_sound; auto. -Qed. + intros. rewrite <- Val.swap_cmp_bool. apply cmp_intv_sound; auto. +Qed. (** Comparisons *) @@ -2184,7 +2184,7 @@ Definition cmp_bool (c: comparison) (v w: aval) : abool := Lemma cmp_bool_sound: forall c v w x y, vmatch v x -> vmatch w y -> cmatch (Val.cmp_bool c v w) (cmp_bool c x y). Proof. - intros. + intros. unfold cmp_bool; inversion H; subst; inversion H0; subst; auto using cmatch_top, cmp_intv_sound, cmp_intv_sound_2, cmp_intv_None. - constructor. @@ -2199,7 +2199,7 @@ Definition cmpf_bool (c: comparison) (v w: aval) : abool := Lemma cmpf_bool_sound: forall c v w x y, vmatch v x -> vmatch w y -> cmatch (Val.cmpf_bool c v w) (cmpf_bool c x y). Proof. - intros. inv H; try constructor; inv H0; constructor. + intros. inv H; try constructor; inv H0; constructor. Qed. Definition cmpfs_bool (c: comparison) (v w: aval) : abool := @@ -2211,7 +2211,7 @@ Definition cmpfs_bool (c: comparison) (v w: aval) : abool := Lemma cmpfs_bool_sound: forall c v w x y, vmatch v x -> vmatch w y -> cmatch (Val.cmpfs_bool c v w) (cmpfs_bool c x y). Proof. - intros. inv H; try constructor; inv H0; constructor. + intros. inv H; try constructor; inv H0; constructor. Qed. Definition maskzero (x: aval) (mask: int) : abool := @@ -2226,12 +2226,12 @@ Lemma maskzero_sound: vmatch v x -> cmatch (Val.maskzero_bool v mask) (maskzero x mask). Proof. - intros. inv H; simpl; auto with va. + intros. inv H; simpl; auto with va. predSpec Int.eq Int.eq_spec (Int.zero_ext n mask) Int.zero; auto with va. replace (Int.and i mask) with Int.zero. rewrite Int.eq_true. constructor. rewrite is_uns_zero_ext in H1. rewrite Int.zero_ext_and in * by auto. - rewrite <- H1. rewrite Int.and_assoc. rewrite Int.and_commut in H. rewrite H. + rewrite <- H1. rewrite Int.and_assoc. rewrite Int.and_commut in H. rewrite H. rewrite Int.and_zero; auto. destruct (Int.eq (Int.zero_ext n mask) Int.zero); constructor. Qed. @@ -2249,7 +2249,7 @@ Proof. assert (DEFAULT: vmatch (Val.of_optbool ob) (Uns Pbot 1)). { destruct ob; simpl; auto with va. - destruct b; constructor; try omega. + destruct b; constructor; try omega. change 1 with (usize Int.one). apply is_uns_usize. red; intros. apply Int.bits_zero. } @@ -2329,16 +2329,16 @@ Lemma vnormalize_cast: vmatch v (Ifptr p) -> vmatch v (vnormalize chunk (Ifptr p)). Proof. - intros. exploit Mem.load_cast; eauto. exploit Mem.load_type; eauto. + intros. exploit Mem.load_cast; eauto. exploit Mem.load_type; eauto. destruct chunk; simpl; intros. - (* int8signed *) - rewrite H2. destruct v; simpl; constructor. omega. apply is_sign_ext_sgn; auto with va. + rewrite H2. destruct v; simpl; constructor. omega. apply is_sign_ext_sgn; auto with va. - (* int8unsigned *) - rewrite H2. destruct v; simpl; constructor. omega. apply is_zero_ext_uns; auto with va. + rewrite H2. destruct v; simpl; constructor. omega. apply is_zero_ext_uns; auto with va. - (* int16signed *) - rewrite H2. destruct v; simpl; constructor. omega. apply is_sign_ext_sgn; auto with va. + rewrite H2. destruct v; simpl; constructor. omega. apply is_sign_ext_sgn; auto with va. - (* int16unsigned *) - rewrite H2. destruct v; simpl; constructor. omega. apply is_zero_ext_uns; auto with va. + rewrite H2. destruct v; simpl; constructor. omega. apply is_zero_ext_uns; auto with va. - (* int32 *) auto. - (* int64 *) @@ -2391,7 +2391,7 @@ Proof with (auto using provenance_monotone with va). - constructor... apply is_zero_ext_uns... - unfold provenance; destruct (va_strict tt)... - destruct (va_strict tt)... -- destruct (zlt n2 8); constructor... +- destruct (zlt n2 8); constructor... - destruct (zlt n2 16); constructor... - destruct (va_strict tt)... - destruct (va_strict tt)... @@ -2423,7 +2423,7 @@ Inductive acontent : Type := Definition eq_acontent : forall (c1 c2: acontent), {c1=c2} + {c1<>c2}. Proof. - intros. generalize chunk_eq eq_aval. decide equality. + intros. generalize chunk_eq eq_aval. decide equality. Defined. Record ablock : Type := ABlock { @@ -2494,7 +2494,7 @@ Qed. Remark fst_inval_before: forall hi lo c, fst (inval_before hi lo c) = fst c. Proof. intros. functional induction (inval_before hi lo c); auto. - rewrite IHt. unfold inval_if. destruct c##lo; auto. + rewrite IHt. unfold inval_if. destruct c##lo; auto. destruct (zle (lo + size_chunk chunk) hi); auto. Qed. @@ -2507,7 +2507,7 @@ Program Definition ablock_store (chunk: memory_chunk) (ab: ablock) (i: Z) (av: a vplub av ab.(ab_summary); ab_default := _ |}. Next Obligation. - rewrite fst_inval_before, fst_inval_after. apply ab_default. + rewrite fst_inval_before, fst_inval_after. apply ab_default. Qed. Definition ablock_store_anywhere (chunk: memory_chunk) (ab: ablock) (av: aval) : ablock := @@ -2539,7 +2539,7 @@ Remark loadbytes_load_ext: forall chunk ofs v, Mem.load chunk m' b ofs = Some v -> Mem.load chunk m b ofs = Some v. Proof. intros. exploit Mem.load_loadbytes; eauto. intros [bytes [A B]]. - exploit Mem.load_valid_access; eauto. intros [C D]. + exploit Mem.load_valid_access; eauto. intros [C D]. subst v. apply Mem.loadbytes_load; auto. apply H; auto. generalize (size_chunk_pos chunk); omega. Qed. @@ -2567,7 +2567,7 @@ Qed. Lemma smatch_ge: forall m b p q, smatch m b p -> pge q p -> smatch m b q. Proof. - intros. destruct H as [A B]. split; intros. + intros. destruct H as [A B]. split; intros. apply vmatch_ge with (Ifptr p); eauto with va. apply pmatch_ge with p; eauto with va. Qed. @@ -2578,26 +2578,26 @@ Lemma In_loadbytes: In byte bytes -> exists ofs', ofs <= ofs' < ofs + n /\ Mem.loadbytes m b ofs' 1 = Some(byte :: nil). Proof. - intros until n. pattern n. + intros until n. pattern n. apply well_founded_ind with (R := Zwf 0). - apply Zwf_well_founded. - intros sz REC ofs bytes LOAD IN. - destruct (zle sz 0). + destruct (zle sz 0). + rewrite (Mem.loadbytes_empty m b ofs sz) in LOAD by auto. inv LOAD. contradiction. + exploit (Mem.loadbytes_split m b ofs 1 (sz - 1) bytes). replace (1 + (sz - 1)) with sz by omega. auto. omega. omega. - intros (bytes1 & bytes2 & LOAD1 & LOAD2 & CONCAT). - subst bytes. + intros (bytes1 & bytes2 & LOAD1 & LOAD2 & CONCAT). + subst bytes. exploit Mem.loadbytes_length. eexact LOAD1. change (nat_of_Z 1) with 1%nat. intros LENGTH1. rewrite in_app_iff in IN. destruct IN. - * destruct bytes1; try discriminate. destruct bytes1; try discriminate. + * destruct bytes1; try discriminate. destruct bytes1; try discriminate. simpl in H. destruct H; try contradiction. subst m0. exists ofs; split. omega. auto. * exploit (REC (sz - 1)). red; omega. eexact LOAD2. auto. - intros (ofs' & A & B). + intros (ofs' & A & B). exists ofs'; split. omega. auto. Qed. @@ -2609,7 +2609,7 @@ Lemma smatch_loadbytes: pmatch b' ofs' p. Proof. intros. exploit In_loadbytes; eauto. intros (ofs1 & A & B). - eapply H0; eauto. + eapply H0; eauto. Qed. Lemma loadbytes_provenance: @@ -2619,7 +2619,7 @@ Lemma loadbytes_provenance: ofs <= ofs' < ofs + n -> In byte bytes. Proof. - intros until n. pattern n. + intros until n. pattern n. apply well_founded_ind with (R := Zwf 0). - apply Zwf_well_founded. - intros sz REC ofs bytes LOAD LOAD1 IN. @@ -2640,15 +2640,15 @@ Lemma storebytes_provenance: In (Fragment (Vptr b'' ofs'') q i) bytes \/ Mem.loadbytes m b' ofs' 1 = Some (Fragment (Vptr b'' ofs'') q i :: nil). Proof. - intros. + intros. assert (EITHER: (b' <> b \/ ofs' + 1 <= ofs \/ ofs + Z.of_nat (length bytes) <= ofs') \/ (b' = b /\ ofs <= ofs' < ofs + Z.of_nat (length bytes))). { destruct (eq_block b' b); auto. - destruct (zle (ofs' + 1) ofs); auto. - destruct (zle (ofs + Z.of_nat (length bytes)) ofs'); auto. - right. split. auto. omega. + destruct (zle (ofs' + 1) ofs); auto. + destruct (zle (ofs + Z.of_nat (length bytes)) ofs'); auto. + right. split. auto. omega. } destruct EITHER as [A | (A & B)]. - right. rewrite <- H0. symmetry. eapply Mem.loadbytes_storebytes_other; eauto. omega. @@ -2664,15 +2664,15 @@ Lemma store_provenance: v = Vptr b'' ofs'' /\ (chunk = Mint32 \/ chunk = Many32 \/ chunk = Many64) \/ Mem.loadbytes m b' ofs' 1 = Some (Fragment (Vptr b'' ofs'') q i :: nil). Proof. - intros. exploit storebytes_provenance; eauto. eapply Mem.store_storebytes; eauto. + intros. exploit storebytes_provenance; eauto. eapply Mem.store_storebytes; eauto. intros [A|A]; auto. left. generalize (encode_val_shape chunk v). intros ENC; inv ENC. - split; auto. rewrite <- H1 in A; destruct A. + congruence. + exploit H5; eauto. intros (j & P & Q); congruence. -- rewrite <- H1 in A; destruct A. +- rewrite <- H1 in A; destruct A. + congruence. - + exploit H3; eauto. intros [byte P]; congruence. + + exploit H3; eauto. intros [byte P]; congruence. - rewrite <- H1 in A; destruct A. + congruence. + exploit H2; eauto. congruence. @@ -2687,18 +2687,18 @@ Lemma smatch_store: Proof. intros. destruct H0 as [A B]. split. - intros chunk' ofs' v' LOAD. destruct v'; auto with va. - exploit Mem.load_pointer_store; eauto. - intros [(P & Q & R & S) | DISJ]. + exploit Mem.load_pointer_store; eauto. + intros [(P & Q & R & S) | DISJ]. + subst. apply vmatch_vplub_l. auto. + apply vmatch_vplub_r. apply A with (chunk := chunk') (ofs := ofs'). rewrite <- LOAD. symmetry. eapply Mem.load_store_other; eauto. -- intros. exploit store_provenance; eauto. intros [[P Q] | P]. -+ subst. +- intros. exploit store_provenance; eauto. intros [[P Q] | P]. ++ subst. assert (V: vmatch (Vptr b'0 ofs') (Ifptr (vplub av p))). { - apply vmatch_vplub_l. auto. + apply vmatch_vplub_l. auto. } - inv V; auto. + inv V; auto. + apply pmatch_vplub. eapply B; eauto. Qed. @@ -2710,22 +2710,22 @@ Lemma smatch_storebytes: smatch m' b' (plub p' p). Proof. intros. destruct H0 as [A B]. split. -- intros. apply vmatch_ifptr. intros bx ofsx EQ; subst v. +- intros. apply vmatch_ifptr. intros bx ofsx EQ; subst v. exploit Mem.load_loadbytes; eauto. intros (bytes' & P & Q). - destruct bytes' as [ | byte1' bytes']. + destruct bytes' as [ | byte1' bytes']. exploit Mem.loadbytes_length; eauto. intros. destruct chunk; discriminate. - generalize (decode_val_shape chunk byte1' bytes'). rewrite <- Q. + generalize (decode_val_shape chunk byte1' bytes'). rewrite <- Q. intros DEC; inv DEC; try contradiction. assert (v = Vptr bx ofsx). { destruct H5 as [E|[E|E]]; rewrite E in H4; destruct v; simpl in H4; congruence. } - exploit In_loadbytes; eauto. eauto with coqlib. - intros (ofs' & X & Y). subst v. + exploit In_loadbytes; eauto. eauto with coqlib. + intros (ofs' & X & Y). subst v. exploit storebytes_provenance; eauto. intros [Z | Z]. - apply pmatch_lub_l. eauto. - apply pmatch_lub_r. eauto. + apply pmatch_lub_l. eauto. + apply pmatch_lub_r. eauto. - intros. exploit storebytes_provenance; eauto. intros [Z | Z]. - apply pmatch_lub_l. eauto. - apply pmatch_lub_r. eauto. + apply pmatch_lub_l. eauto. + apply pmatch_lub_r. eauto. Qed. Definition bmatch (m: mem) (b: block) (ab: ablock) : Prop := @@ -2740,7 +2740,7 @@ Lemma bmatch_ext: Proof. intros. destruct H as [A B]. split; intros. apply smatch_ext with m; auto. - eapply B; eauto. eapply loadbytes_load_ext; eauto. + eapply B; eauto. eapply loadbytes_load_ext; eauto. Qed. Lemma bmatch_inv: @@ -2759,7 +2759,7 @@ Lemma ablock_load_sound: bmatch m b ab -> vmatch v (ablock_load chunk ab ofs). Proof. - intros. destruct H0. eauto. + intros. destruct H0. eauto. Qed. Lemma ablock_load_anywhere_sound: @@ -2768,16 +2768,16 @@ Lemma ablock_load_anywhere_sound: bmatch m b ab -> vmatch v (ablock_load_anywhere chunk ab). Proof. - intros. destruct H0. destruct H0. unfold ablock_load_anywhere. - eapply vnormalize_cast; eauto. + intros. destruct H0. destruct H0. unfold ablock_load_anywhere. + eapply vnormalize_cast; eauto. Qed. Lemma ablock_init_sound: forall m b p, smatch m b p -> bmatch m b (ablock_init p). Proof. - intros; split; auto; intros. + intros; split; auto; intros. unfold ablock_load, ablock_init; simpl. rewrite ZMap.gi. - eapply vnormalize_cast; eauto. eapply H; eauto. + eapply vnormalize_cast; eauto. eapply H; eauto. Qed. Lemma ablock_store_anywhere_sound: @@ -2788,14 +2788,14 @@ Lemma ablock_store_anywhere_sound: bmatch m' b' (ablock_store_anywhere chunk ab av). Proof. intros. destruct H0 as [A B]. unfold ablock_store_anywhere. - apply ablock_init_sound. eapply smatch_store; eauto. + apply ablock_init_sound. eapply smatch_store; eauto. Qed. Remark inval_after_outside: forall i lo hi c, i < lo \/ i > hi -> (inval_after lo hi c)##i = c##i. Proof. intros until c. functional induction (inval_after lo hi c); intros. - rewrite IHt by omega. apply ZMap.gso. unfold ZIndexed.t; omega. + rewrite IHt by omega. apply ZMap.gso. unfold ZIndexed.t; omega. auto. Qed. @@ -2805,7 +2805,7 @@ Remark inval_after_contents: c##i = ACval chunk av /\ (i < lo \/ i > hi). Proof. intros until c. functional induction (inval_after lo hi c); intros. - destruct (zeq i hi). + destruct (zeq i hi). subst i. rewrite inval_after_outside in H by omega. rewrite ZMap.gss in H. discriminate. exploit IHt; eauto. intros [A B]. rewrite ZMap.gso in A by auto. split. auto. omega. split. auto. omega. @@ -2815,9 +2815,9 @@ Remark inval_before_outside: forall i hi lo c, i < lo \/ i >= hi -> (inval_before hi lo c)##i = c##i. Proof. intros until c. functional induction (inval_before hi lo c); intros. - rewrite IHt by omega. unfold inval_if. destruct (c##lo); auto. + rewrite IHt by omega. unfold inval_if. destruct (c##lo); auto. destruct (zle (lo + size_chunk chunk) hi); auto. - apply ZMap.gso. unfold ZIndexed.t; omega. + apply ZMap.gso. unfold ZIndexed.t; omega. auto. Qed. @@ -2828,15 +2828,15 @@ Remark inval_before_contents_1: Proof. intros until c. functional induction (inval_before hi lo c); intros. - destruct (zeq lo i). -+ subst i. rewrite inval_before_outside in H0 by omega. - unfold inval_if in H0. destruct (c##lo) eqn:C. congruence. ++ subst i. rewrite inval_before_outside in H0 by omega. + unfold inval_if in H0. destruct (c##lo) eqn:C. congruence. destruct (zle (lo + size_chunk chunk0) hi). - rewrite C in H0; inv H0. auto. + rewrite C in H0; inv H0. auto. rewrite ZMap.gss in H0. congruence. -+ exploit IHt. omega. auto. intros [A B]; split; auto. ++ exploit IHt. omega. auto. intros [A B]; split; auto. unfold inval_if in A. destruct (c##lo) eqn:C. auto. destruct (zle (lo + size_chunk chunk0) hi); auto. - rewrite ZMap.gso in A; auto. + rewrite ZMap.gso in A; auto. - omegaContradiction. Qed. @@ -2850,12 +2850,12 @@ Remark inval_before_contents: (inval_before i (i - 7) c)##j = ACval chunk' av' -> c##j = ACval chunk' av' /\ (j + size_chunk chunk' <= i \/ i <= j). Proof. - intros. destruct (zlt j (i - 7)). - rewrite inval_before_outside in H by omega. + intros. destruct (zlt j (i - 7)). + rewrite inval_before_outside in H by omega. split. auto. left. generalize (max_size_chunk chunk'); omega. - destruct (zlt j i). + destruct (zlt j i). exploit inval_before_contents_1; eauto. omega. tauto. - rewrite inval_before_outside in H by omega. + rewrite inval_before_outside in H by omega. split. auto. omega. Qed. @@ -2863,12 +2863,12 @@ Lemma ablock_store_contents: forall chunk ab i av j chunk' av', (ablock_store chunk ab i av).(ab_contents)##j = ACval chunk' av' -> (i = j /\ chunk' = chunk /\ av' = av) - \/ (ab.(ab_contents)##j = ACval chunk' av' + \/ (ab.(ab_contents)##j = ACval chunk' av' /\ (j + size_chunk chunk' <= i \/ i + size_chunk chunk <= j)). Proof. unfold ablock_store; simpl; intros. - destruct (zeq i j). - subst j. rewrite ZMap.gss in H. inv H; auto. + destruct (zeq i j). + subst j. rewrite ZMap.gss in H. inv H; auto. right. rewrite ZMap.gso in H by auto. exploit inval_before_contents; eauto. intros [A B]. exploit inval_after_contents; eauto. intros [C D]. @@ -2891,20 +2891,20 @@ Lemma ablock_store_sound: bmatch m' b (ablock_store chunk ab ofs av). Proof. intros until av; intros STORE BIN VIN. destruct BIN as [BIN1 BIN2]. split. - eapply smatch_store; eauto. + eapply smatch_store; eauto. intros chunk' ofs' v' LOAD. assert (SUMMARY: vmatch v' (vnormalize chunk' (Ifptr (vplub av ab.(ab_summary))))). { exploit smatch_store; eauto. intros [A B]. eapply vnormalize_cast; eauto. } - unfold ablock_load. + unfold ablock_load. destruct ((ab_contents (ablock_store chunk ab ofs av)) ## ofs') as [ | chunk1 av1] eqn:C. apply SUMMARY. destruct (chunk_compat chunk' chunk1) eqn:COMPAT; auto. exploit chunk_compat_true; eauto. intros (U & V & W). exploit ablock_store_contents; eauto. intros [(P & Q & R) | (P & Q)]. - (* same offset and compatible chunks *) - subst. - assert (v' = Val.load_result chunk' v). - { exploit Mem.load_store_similar_2; eauto. congruence. } + subst. + assert (v' = Val.load_result chunk' v). + { exploit Mem.load_store_similar_2; eauto. congruence. } subst v'. apply vnormalize_sound; auto. - (* disjoint load/store *) assert (Mem.load chunk' m b ofs' = Some v'). @@ -2920,7 +2920,7 @@ Lemma ablock_loadbytes_sound: In (Fragment (Vptr b' ofs') q i) bytes -> pmatch b' ofs' (ablock_loadbytes ab). Proof. - intros. destruct H0. eapply smatch_loadbytes; eauto. + intros. destruct H0. eapply smatch_loadbytes; eauto. Qed. Lemma ablock_storebytes_anywhere_sound: @@ -2937,7 +2937,7 @@ Qed. Lemma ablock_storebytes_contents: forall ab p i sz j chunk' av', (ablock_storebytes ab p i sz).(ab_contents)##j = ACval chunk' av' -> - ab.(ab_contents)##j = ACval chunk' av' + ab.(ab_contents)##j = ACval chunk' av' /\ (j + size_chunk chunk' <= i \/ i + Zmax sz 0 <= j). Proof. unfold ablock_storebytes; simpl; intros. @@ -2954,15 +2954,15 @@ Lemma ablock_storebytes_sound: bmatch m b ab -> bmatch m' b (ablock_storebytes ab p ofs sz). Proof. - intros until sz; intros STORE LENGTH CONTENTS BM. destruct BM as [BM1 BM2]. split. - eapply smatch_storebytes; eauto. + intros until sz; intros STORE LENGTH CONTENTS BM. destruct BM as [BM1 BM2]. split. + eapply smatch_storebytes; eauto. intros chunk' ofs' v' LOAD'. assert (SUMMARY: vmatch v' (vnormalize chunk' (Ifptr (plub p ab.(ab_summary))))). { exploit smatch_storebytes; eauto. intros [A B]. eapply vnormalize_cast; eauto. } - unfold ablock_load. + unfold ablock_load. destruct (ab_contents (ablock_storebytes ab p ofs sz))##ofs' eqn:C. exact SUMMARY. - destruct (chunk_compat chunk' chunk) eqn:COMPAT; auto. + destruct (chunk_compat chunk' chunk) eqn:COMPAT; auto. exploit chunk_compat_true; eauto. intros (U & V & W). exploit ablock_storebytes_contents; eauto. intros [A B]. assert (Mem.load chunk' m b ofs' = Some v'). @@ -2975,7 +2975,7 @@ Qed. Definition bbeq (ab1 ab2: ablock) : bool := eq_aptr ab1.(ab_summary) ab2.(ab_summary) && - PTree.beq (fun c1 c2 => proj_sumbool (eq_acontent c1 c2)) + PTree.beq (fun c1 c2 => proj_sumbool (eq_acontent c1 c2)) (snd ab1.(ab_contents)) (snd ab2.(ab_contents)). Lemma bbeq_load: @@ -2989,7 +2989,7 @@ Proof. - rewrite PTree.beq_correct in H1. assert (A: forall i, ZMap.get i (ab_contents ab1) = ZMap.get i (ab_contents ab2)). { - intros. unfold ZMap.get, PMap.get. set (j := ZIndexed.index i). + intros. unfold ZMap.get, PMap.get. set (j := ZIndexed.index i). specialize (H1 j). destruct (snd (ab_contents ab1))!j; destruct (snd (ab_contents ab2))!j; try contradiction. InvBooleans; auto. @@ -3004,9 +3004,9 @@ Lemma bbeq_sound: bbeq ab1 ab2 = true -> forall m b, bmatch m b ab1 <-> bmatch m b ab2. Proof. - intros. exploit bbeq_load; eauto. intros [A B]. - unfold bmatch. rewrite A. intuition. rewrite <- B; eauto. rewrite B; eauto. -Qed. + intros. exploit bbeq_load; eauto. intros [A B]. + unfold bmatch. rewrite A. intuition. rewrite <- B; eauto. rewrite B; eauto. +Qed. (** Least upper bound *) @@ -3039,11 +3039,11 @@ Lemma get_combine_contentmaps: ZMap.get i (combine_contentmaps m1 m2) = combine_acontents (ZMap.get i m1) (ZMap.get i m2). Proof. intros. destruct m1 as [dfl1 pt1]. destruct m2 as [dfl2 pt2]; simpl in *. - subst dfl1 dfl2. unfold combine_contentmaps, ZMap.get, PMap.get, fst, snd. - set (j := ZIndexed.index i). + subst dfl1 dfl2. unfold combine_contentmaps, ZMap.get, PMap.get, fst, snd. + set (j := ZIndexed.index i). rewrite PTree.gcombine by auto. destruct (pt1!j) as [[]|]; destruct (pt2!j) as [[]|]; simpl; auto. - destruct (chunk_eq chunk chunk0); auto. + destruct (chunk_eq chunk chunk0); auto. Qed. Lemma smatch_lub_l: @@ -3051,7 +3051,7 @@ Lemma smatch_lub_l: Proof. intros. destruct H as [A B]. split; intros. change (vmatch v (vlub (Ifptr p) (Ifptr q))). apply vmatch_lub_l. eapply A; eauto. - apply pmatch_lub_l. eapply B; eauto. + apply pmatch_lub_l. eapply B; eauto. Qed. Lemma smatch_lub_r: @@ -3059,14 +3059,14 @@ Lemma smatch_lub_r: Proof. intros. destruct H as [A B]. split; intros. change (vmatch v (vlub (Ifptr p) (Ifptr q))). apply vmatch_lub_r. eapply A; eauto. - apply pmatch_lub_r. eapply B; eauto. + apply pmatch_lub_r. eapply B; eauto. Qed. Lemma bmatch_lub_l: forall m b x y, bmatch m b x -> bmatch m b (blub x y). Proof. intros. destruct H as [BM1 BM2]. split; unfold blub; simpl. -- apply smatch_lub_l; auto. +- apply smatch_lub_l; auto. - intros. assert (SUMMARY: vmatch v (vnormalize chunk (Ifptr (plub (ab_summary x) (ab_summary y)))) ). @@ -3077,14 +3077,14 @@ Proof. unfold combine_acontents; destruct (ab_contents x)##ofs, (ab_contents y)##ofs; auto. destruct (chunk_eq chunk0 chunk1); auto. subst chunk0. destruct (chunk_compat chunk chunk1); auto. - intros. eapply vmatch_ge; eauto. apply vnormalize_monotone. apply vge_lub_l. + intros. eapply vmatch_ge; eauto. apply vnormalize_monotone. apply vge_lub_l. Qed. Lemma bmatch_lub_r: forall m b x y, bmatch m b y -> bmatch m b (blub x y). Proof. intros. destruct H as [BM1 BM2]. split; unfold blub; simpl. -- apply smatch_lub_r; auto. +- apply smatch_lub_r; auto. - intros. assert (SUMMARY: vmatch v (vnormalize chunk (Ifptr (plub (ab_summary x) (ab_summary y)))) ). @@ -3095,7 +3095,7 @@ Proof. unfold combine_acontents; destruct (ab_contents x)##ofs, (ab_contents y)##ofs; auto. destruct (chunk_eq chunk0 chunk1); auto. subst chunk0. destruct (chunk_compat chunk chunk1); auto. - intros. eapply vmatch_ge; eauto. apply vnormalize_monotone. apply vge_lub_r. + intros. eapply vmatch_ge; eauto. apply vnormalize_monotone. apply vge_lub_r. Qed. (** * Abstracting read-only global variables *) @@ -3119,7 +3119,7 @@ Proof. intros; red; intros. exploit H0; eauto. intros (A & B & C). split; auto. split. - exploit Mem.store_valid_access_3; eauto. intros [P _]. apply bmatch_inv with m; auto. -+ intros. eapply Mem.loadbytes_store_other; eauto. ++ intros. eapply Mem.loadbytes_store_other; eauto. left. red; intros; subst b0. elim (C ofs). apply Mem.perm_cur_max. apply P. generalize (size_chunk_pos chunk); omega. - intros; red; intros; elim (C ofs0). eauto with mem. @@ -3133,7 +3133,7 @@ Lemma romatch_storebytes: Proof. intros; red; intros. exploit H0; eauto. intros (A & B & C). split; auto. split. - apply bmatch_inv with m; auto. - intros. eapply Mem.loadbytes_storebytes_disjoint; eauto. + intros. eapply Mem.loadbytes_storebytes_disjoint; eauto. destruct (eq_block b0 b); auto. subst b0. right; red; unfold Intv.In; simpl; red; intros. elim (C x). apply Mem.perm_cur_max. eapply Mem.storebytes_range_perm; eauto. - intros; red; intros; elim (C ofs0). eauto with mem. @@ -3149,7 +3149,7 @@ Proof. intros; red; intros. exploit H; eauto. intros (A & B & C). split. auto. split. apply bmatch_ext with m; auto. intros. eapply H0; eauto. - intros; red; intros. elim (C ofs). eapply H1; eauto. + intros; red; intros. elim (C ofs). eapply H1; eauto. Qed. Lemma romatch_free: @@ -3158,8 +3158,8 @@ Lemma romatch_free: romatch m rm -> romatch m' rm. Proof. - intros. apply romatch_ext with m; auto. - intros. eapply Mem.loadbytes_free_2; eauto. + intros. apply romatch_ext with m; auto. + intros. eapply Mem.loadbytes_free_2; eauto. intros. eauto with mem. Qed. @@ -3170,7 +3170,7 @@ Lemma romatch_alloc: romatch m rm -> romatch m' rm. Proof. - intros. apply romatch_ext with m; auto. + intros. apply romatch_ext with m; auto. intros. rewrite <- H3; symmetry. eapply Mem.loadbytes_alloc_unchanged; eauto. apply H0. congruence. intros. eapply Mem.perm_alloc_4; eauto. apply Mem.valid_not_valid_diff with m; eauto with mem. @@ -3191,7 +3191,7 @@ Record mmatch (m: mem) (am: amem) : Prop := mk_mem_match { bc b = BCstack -> bmatch m b am.(am_stack); mmatch_glob: forall id ab b, - bc b = BCglob id -> + bc b = BCglob id -> am.(am_glob)!id = Some ab -> bmatch m b ab; mmatch_nonstack: forall b, @@ -3323,18 +3323,18 @@ Theorem load_sound: pmatch b ofs p -> vmatch v (load chunk rm am p). Proof. - intros. unfold load. inv H2. + intros. unfold load. inv H2. - (* Gl id ofs *) - destruct (rm!id) as [ab|] eqn:RM. - eapply ablock_load_sound; eauto. eapply H0; eauto. + destruct (rm!id) as [ab|] eqn:RM. + eapply ablock_load_sound; eauto. eapply H0; eauto. destruct (am_glob am)!id as [ab|] eqn:AM. - eapply ablock_load_sound; eauto. eapply mmatch_glob; eauto. + eapply ablock_load_sound; eauto. eapply mmatch_glob; eauto. eapply vnormalize_cast; eauto. eapply mmatch_nonstack; eauto; congruence. - (* Glo id *) - destruct (rm!id) as [ab|] eqn:RM. - eapply ablock_load_anywhere_sound; eauto. eapply H0; eauto. + destruct (rm!id) as [ab|] eqn:RM. + eapply ablock_load_anywhere_sound; eauto. eapply H0; eauto. destruct (am_glob am)!id as [ab|] eqn:AM. - eapply ablock_load_anywhere_sound; eauto. eapply mmatch_glob; eauto. + eapply ablock_load_anywhere_sound; eauto. eapply mmatch_glob; eauto. eapply vnormalize_cast; eauto. eapply mmatch_nonstack; eauto; congruence. - (* Glob *) eapply vnormalize_cast; eauto. eapply mmatch_nonstack; eauto. congruence. congruence. @@ -3343,7 +3343,7 @@ Proof. - (* Stack *) eapply ablock_load_anywhere_sound; eauto. eapply mmatch_stack; eauto. - (* Nonstack *) - eapply vnormalize_cast; eauto. eapply mmatch_nonstack; eauto. + eapply vnormalize_cast; eauto. eapply mmatch_nonstack; eauto. - (* Top *) eapply vnormalize_cast; eauto. eapply mmatch_top; eauto. Qed. @@ -3357,7 +3357,7 @@ Theorem loadv_sound: vmatch v (loadv chunk rm am aaddr). Proof. intros. destruct addr; simpl in H; try discriminate. - eapply load_sound; eauto. apply match_aptr_of_aval; auto. + eapply load_sound; eauto. apply match_aptr_of_aval; auto. Qed. Theorem store_sound: @@ -3372,27 +3372,27 @@ Proof. unfold store; constructor; simpl; intros. - (* Stack *) assert (DFL: bc b <> BCstack -> bmatch m' b0 (am_stack am)). - { intros. apply bmatch_inv with m. eapply mmatch_stack; eauto. + { intros. apply bmatch_inv with m. eapply mmatch_stack; eauto. intros. eapply Mem.loadbytes_store_other; eauto. left; congruence. } inv PM; try (apply DFL; congruence). - + assert (b0 = b) by (eapply bc_stack; eauto). subst b0. - eapply ablock_store_sound; eauto. eapply mmatch_stack; eauto. - + assert (b0 = b) by (eapply bc_stack; eauto). subst b0. - eapply ablock_store_anywhere_sound; eauto. eapply mmatch_stack; eauto. + + assert (b0 = b) by (eapply bc_stack; eauto). subst b0. + eapply ablock_store_sound; eauto. eapply mmatch_stack; eauto. + + assert (b0 = b) by (eapply bc_stack; eauto). subst b0. + eapply ablock_store_anywhere_sound; eauto. eapply mmatch_stack; eauto. + eapply ablock_store_anywhere_sound; eauto. eapply mmatch_stack; eauto. - (* Globals *) rename b0 into b'. - assert (DFL: bc b <> BCglob id -> (am_glob am)!id = Some ab -> + assert (DFL: bc b <> BCglob id -> (am_glob am)!id = Some ab -> bmatch m' b' ab). { intros. apply bmatch_inv with m. eapply mmatch_glob; eauto. intros. eapply Mem.loadbytes_store_other; eauto. left; congruence. } - inv PM. + inv PM. + rewrite PTree.gsspec in H0. destruct (peq id id0). subst id0; inv H0. assert (b' = b) by (eapply bc_glob; eauto). subst b'. eapply ablock_store_sound; eauto. - destruct (am_glob am)!id as [ab0|] eqn:GL. + destruct (am_glob am)!id as [ab0|] eqn:GL. eapply mmatch_glob; eauto. apply ablock_init_sound. eapply mmatch_nonstack; eauto; congruence. eapply DFL; eauto. congruence. @@ -3400,13 +3400,13 @@ Proof. subst id0; inv H0. assert (b' = b) by (eapply bc_glob; eauto). subst b'. eapply ablock_store_anywhere_sound; eauto. - destruct (am_glob am)!id as [ab0|] eqn:GL. + destruct (am_glob am)!id as [ab0|] eqn:GL. eapply mmatch_glob; eauto. apply ablock_init_sound. eapply mmatch_nonstack; eauto; congruence. eapply DFL; eauto. congruence. + rewrite PTree.gempty in H0; congruence. + eapply DFL; eauto. congruence. - + eapply DFL; eauto. congruence. + + eapply DFL; eauto. congruence. + rewrite PTree.gempty in H0; congruence. + rewrite PTree.gempty in H0; congruence. @@ -3434,7 +3434,7 @@ Theorem storev_sound: vmatch v av -> mmatch m' (storev chunk am aaddr av). Proof. - intros. destruct addr; simpl in H; try discriminate. + intros. destruct addr; simpl in H; try discriminate. eapply store_sound; eauto. apply match_aptr_of_aval; auto. Qed. @@ -3451,21 +3451,21 @@ Proof. destruct (rm!id) as [ab|] eqn:RM. exploit H0; eauto. intros (A & B & C). eapply ablock_loadbytes_sound; eauto. destruct (am_glob am)!id as [ab|] eqn:GL. - eapply ablock_loadbytes_sound; eauto. eapply mmatch_glob; eauto. + eapply ablock_loadbytes_sound; eauto. eapply mmatch_glob; eauto. eapply smatch_loadbytes; eauto. eapply mmatch_nonstack; eauto with va. - (* Glo id *) destruct (rm!id) as [ab|] eqn:RM. exploit H0; eauto. intros (A & B & C). eapply ablock_loadbytes_sound; eauto. destruct (am_glob am)!id as [ab|] eqn:GL. - eapply ablock_loadbytes_sound; eauto. eapply mmatch_glob; eauto. + eapply ablock_loadbytes_sound; eauto. eapply mmatch_glob; eauto. eapply smatch_loadbytes; eauto. eapply mmatch_nonstack; eauto with va. - (* Glob *) eapply smatch_loadbytes; eauto. eapply mmatch_nonstack; eauto with va. - (* Stk ofs *) - eapply ablock_loadbytes_sound; eauto. eapply mmatch_stack; eauto. + eapply ablock_loadbytes_sound; eauto. eapply mmatch_stack; eauto. - (* Stack *) eapply ablock_loadbytes_sound; eauto. eapply mmatch_stack; eauto. -- (* Nonstack *) +- (* Nonstack *) eapply smatch_loadbytes; eauto. eapply mmatch_nonstack; eauto with va. - (* Top *) eapply smatch_loadbytes; eauto. eapply mmatch_top; eauto with va. @@ -3484,27 +3484,27 @@ Proof. unfold storebytes; constructor; simpl; intros. - (* Stack *) assert (DFL: bc b <> BCstack -> bmatch m' b0 (am_stack am)). - { intros. apply bmatch_inv with m. eapply mmatch_stack; eauto. + { intros. apply bmatch_inv with m. eapply mmatch_stack; eauto. intros. eapply Mem.loadbytes_storebytes_other; eauto. left; congruence. } inv PM; try (apply DFL; congruence). - + assert (b0 = b) by (eapply bc_stack; eauto). subst b0. - eapply ablock_storebytes_sound; eauto. eapply mmatch_stack; eauto. - + assert (b0 = b) by (eapply bc_stack; eauto). subst b0. - eapply ablock_storebytes_anywhere_sound; eauto. eapply mmatch_stack; eauto. + + assert (b0 = b) by (eapply bc_stack; eauto). subst b0. + eapply ablock_storebytes_sound; eauto. eapply mmatch_stack; eauto. + + assert (b0 = b) by (eapply bc_stack; eauto). subst b0. + eapply ablock_storebytes_anywhere_sound; eauto. eapply mmatch_stack; eauto. + eapply ablock_storebytes_anywhere_sound; eauto. eapply mmatch_stack; eauto. - (* Globals *) rename b0 into b'. - assert (DFL: bc b <> BCglob id -> (am_glob am)!id = Some ab -> + assert (DFL: bc b <> BCglob id -> (am_glob am)!id = Some ab -> bmatch m' b' ab). { intros. apply bmatch_inv with m. eapply mmatch_glob; eauto. intros. eapply Mem.loadbytes_storebytes_other; eauto. left; congruence. } - inv PM. + inv PM. + rewrite PTree.gsspec in H0. destruct (peq id id0). subst id0; inv H0. assert (b' = b) by (eapply bc_glob; eauto). subst b'. eapply ablock_storebytes_sound; eauto. - destruct (am_glob am)!id as [ab0|] eqn:GL. + destruct (am_glob am)!id as [ab0|] eqn:GL. eapply mmatch_glob; eauto. apply ablock_init_sound. eapply mmatch_nonstack; eauto; congruence. eapply DFL; eauto. congruence. @@ -3512,13 +3512,13 @@ Proof. subst id0; inv H0. assert (b' = b) by (eapply bc_glob; eauto). subst b'. eapply ablock_storebytes_anywhere_sound; eauto. - destruct (am_glob am)!id as [ab0|] eqn:GL. + destruct (am_glob am)!id as [ab0|] eqn:GL. eapply mmatch_glob; eauto. apply ablock_init_sound. eapply mmatch_nonstack; eauto; congruence. eapply DFL; eauto. congruence. + rewrite PTree.gempty in H0; congruence. + eapply DFL; eauto. congruence. - + eapply DFL; eauto. congruence. + + eapply DFL; eauto. congruence. + rewrite PTree.gempty in H0; congruence. + rewrite PTree.gempty in H0; congruence. @@ -3550,7 +3550,7 @@ Proof. - apply bmatch_ext with m; eauto with va. - apply smatch_ext with m; auto with va. - apply smatch_ext with m; auto with va. -- red; intros. exploit mmatch_below0; eauto. xomega. +- red; intros. exploit mmatch_below0; eauto. xomega. Qed. Lemma mmatch_free: @@ -3559,16 +3559,16 @@ Lemma mmatch_free: mmatch m am -> mmatch m' am. Proof. - intros. apply mmatch_ext with m; auto. - intros. eapply Mem.loadbytes_free_2; eauto. - erewrite <- Mem.nextblock_free by eauto. xomega. + intros. apply mmatch_ext with m; auto. + intros. eapply Mem.loadbytes_free_2; eauto. + erewrite <- Mem.nextblock_free by eauto. xomega. Qed. Lemma mmatch_top': forall m am, mmatch m am -> mmatch m mtop. Proof. intros. constructor; simpl; intros. -- apply ablock_init_sound. apply smatch_ge with (ab_summary (am_stack am)). +- apply ablock_init_sound. apply smatch_ge with (ab_summary (am_stack am)). eapply mmatch_stack; eauto. constructor. - rewrite PTree.gempty in H1; discriminate. - eapply smatch_ge. eapply mmatch_nonstack; eauto. constructor. @@ -3589,16 +3589,16 @@ Lemma mbeq_sound: Proof. unfold mbeq; intros. InvBooleans. rewrite PTree.beq_correct in H1. split; intros M; inv M; constructor; intros. -- erewrite <- bbeq_sound; eauto. -- specialize (H1 id). rewrite H4 in H1. destruct (am_glob m1)!id eqn:G; try contradiction. - erewrite <- bbeq_sound; eauto. -- rewrite <- H; eauto. +- erewrite <- bbeq_sound; eauto. +- specialize (H1 id). rewrite H4 in H1. destruct (am_glob m1)!id eqn:G; try contradiction. + erewrite <- bbeq_sound; eauto. +- rewrite <- H; eauto. - rewrite <- H0; eauto. - auto. -- erewrite bbeq_sound; eauto. -- specialize (H1 id). rewrite H4 in H1. destruct (am_glob m2)!id eqn:G; try contradiction. - erewrite bbeq_sound; eauto. -- rewrite H; eauto. +- erewrite bbeq_sound; eauto. +- specialize (H1 id). rewrite H4 in H1. destruct (am_glob m2)!id eqn:G; try contradiction. + erewrite bbeq_sound; eauto. +- rewrite H; eauto. - rewrite H0; eauto. - auto. Qed. @@ -3620,14 +3620,14 @@ Definition mlub (m1 m2: amem) : amem := Lemma mmatch_lub_l: forall m x y, mmatch m x -> mmatch m (mlub x y). Proof. - intros. inv H. constructor; simpl; intros. -- apply bmatch_lub_l; auto. -- rewrite PTree.gcombine in H0 by auto. unfold combine_ablock in H0. + intros. inv H. constructor; simpl; intros. +- apply bmatch_lub_l; auto. +- rewrite PTree.gcombine in H0 by auto. unfold combine_ablock in H0. destruct (am_glob x)!id as [b1|] eqn:G1; destruct (am_glob y)!id as [b2|] eqn:G2; inv H0. - apply bmatch_lub_l; eauto. -- apply smatch_lub_l; auto. + apply bmatch_lub_l; eauto. +- apply smatch_lub_l; auto. - apply smatch_lub_l; auto. - auto. Qed. @@ -3635,14 +3635,14 @@ Qed. Lemma mmatch_lub_r: forall m x y, mmatch m y -> mmatch m (mlub x y). Proof. - intros. inv H. constructor; simpl; intros. -- apply bmatch_lub_r; auto. -- rewrite PTree.gcombine in H0 by auto. unfold combine_ablock in H0. + intros. inv H. constructor; simpl; intros. +- apply bmatch_lub_r; auto. +- rewrite PTree.gcombine in H0 by auto. unfold combine_ablock in H0. destruct (am_glob x)!id as [b1|] eqn:G1; destruct (am_glob y)!id as [b2|] eqn:G2; inv H0. - apply bmatch_lub_r; eauto. -- apply smatch_lub_r; auto. + apply bmatch_lub_r; eauto. +- apply smatch_lub_r; auto. - apply smatch_lub_r; auto. - auto. Qed. @@ -3658,9 +3658,9 @@ Lemma genv_match_exten: (forall b, bc1 b = BCother -> bc2 b = BCother) -> genv_match bc2 ge. Proof. - intros. destruct H as [A B]. split; intros. -- rewrite <- H0. eauto. -- exploit B; eauto. destruct (bc1 b) eqn:BC1. + intros. destruct H as [A B]. split; intros. +- rewrite <- H0. eauto. +- exploit B; eauto. destruct (bc1 b) eqn:BC1. + intuition congruence. + rewrite H0 in BC1. intuition congruence. + intuition congruence. @@ -3678,19 +3678,19 @@ Proof. assert (PM: forall b ofs p, pmatch bc1 b ofs p -> pmatch bc1 b ofs (ab_summary ab) -> pmatch bc2 b ofs p). { intros. - assert (pmatch bc1 b0 ofs Glob) by (eapply pmatch_ge; eauto). + assert (pmatch bc1 b0 ofs Glob) by (eapply pmatch_ge; eauto). inv H5. - assert (bc2 b0 = BCglob id0) by (rewrite H0; auto). + assert (bc2 b0 = BCglob id0) by (rewrite H0; auto). inv H3; econstructor; eauto with va. } assert (VM: forall v x, vmatch bc1 v x -> vmatch bc1 v (Ifptr (ab_summary ab)) -> vmatch bc2 v x). { - intros. inv H3; constructor; auto; inv H4; eapply PM; eauto. + intros. inv H3; constructor; auto; inv H4; eapply PM; eauto. } destruct B as [[B1 B2] B3]. split. split. -- intros. apply VM; eauto. -- intros. apply PM; eauto. -- intros. apply VM; eauto. +- intros. apply VM; eauto. +- intros. apply PM; eauto. +- intros. apply VM; eauto. Qed. Definition bc_incr (bc1 bc2: block_classification) : Prop := @@ -3703,28 +3703,28 @@ Hypothesis INCR: bc_incr bc1 bc2. Lemma pmatch_incr: forall b ofs p, pmatch bc1 b ofs p -> pmatch bc2 b ofs p. Proof. - induction 1; + induction 1; assert (bc2 b = bc1 b) by (apply INCR; congruence); - econstructor; eauto with va. rewrite H0; eauto. + econstructor; eauto with va. rewrite H0; eauto. Qed. Lemma vmatch_incr: forall v x, vmatch bc1 v x -> vmatch bc2 v x. Proof. - induction 1; constructor; auto; apply pmatch_incr; auto. + induction 1; constructor; auto; apply pmatch_incr; auto. Qed. Lemma smatch_incr: forall m b p, smatch bc1 m b p -> smatch bc2 m b p. Proof. - intros. destruct H as [A B]. split; intros. - apply vmatch_incr; eauto. + intros. destruct H as [A B]. split; intros. + apply vmatch_incr; eauto. apply pmatch_incr; eauto. Qed. Lemma bmatch_incr: forall m b ab, bmatch bc1 m b ab -> bmatch bc2 m b ab. Proof. - intros. destruct H as [B1 B2]. split. - apply smatch_incr; auto. - intros. apply vmatch_incr; eauto. + intros. destruct H as [B1 B2]. split. + apply smatch_incr; auto. + intros. apply vmatch_incr; eauto. Qed. End MATCH_INCR. @@ -3737,7 +3737,7 @@ Definition inj_of_bc (bc: block_classification) : meminj := Lemma inj_of_bc_valid: forall (bc: block_classification) b, bc b <> BCinvalid -> inj_of_bc bc b = Some(b, 0). Proof. - intros. unfold inj_of_bc. destruct (bc b); congruence. + intros. unfold inj_of_bc. destruct (bc b); congruence. Qed. Lemma inj_of_bc_inv: @@ -3750,44 +3750,44 @@ Qed. Lemma pmatch_inj: forall bc b ofs p, pmatch bc b ofs p -> inj_of_bc bc b = Some(b, 0). Proof. - intros. apply inj_of_bc_valid. inv H; congruence. + intros. apply inj_of_bc_valid. inv H; congruence. Qed. Lemma vmatch_inj: forall bc v x, vmatch bc v x -> Val.inject (inj_of_bc bc) v v. Proof. - induction 1; econstructor. - eapply pmatch_inj; eauto. rewrite Int.add_zero; auto. - eapply pmatch_inj; eauto. rewrite Int.add_zero; auto. + induction 1; econstructor. + eapply pmatch_inj; eauto. rewrite Int.add_zero; auto. + eapply pmatch_inj; eauto. rewrite Int.add_zero; auto. Qed. Lemma vmatch_list_inj: forall bc vl xl, list_forall2 (vmatch bc) vl xl -> Val.inject_list (inj_of_bc bc) vl vl. Proof. - induction 1; constructor. eapply vmatch_inj; eauto. auto. -Qed. + induction 1; constructor. eapply vmatch_inj; eauto. auto. +Qed. Lemma mmatch_inj: forall bc m am, mmatch bc m am -> bc_below bc (Mem.nextblock m) -> Mem.inject (inj_of_bc bc) m m. Proof. intros. constructor. constructor. - (* perms *) - intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. - rewrite Zplus_0_r. auto. + intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. + rewrite Zplus_0_r. auto. - (* alignment *) - intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. - apply Zdivide_0. + intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. + apply Zdivide_0. - (* contents *) - intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. - rewrite Zplus_0_r. + intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. + rewrite Zplus_0_r. set (mv := ZMap.get ofs (Mem.mem_contents m)#b1). assert (Mem.loadbytes m b1 ofs 1 = Some (mv :: nil)). { Local Transparent Mem.loadbytes. - unfold Mem.loadbytes. rewrite pred_dec_true. reflexivity. + unfold Mem.loadbytes. rewrite pred_dec_true. reflexivity. red; intros. replace ofs0 with ofs by omega. auto. } - destruct mv; econstructor. destruct v; econstructor. + destruct mv; econstructor. destruct v; econstructor. apply inj_of_bc_valid. assert (PM: pmatch bc b i Ptop). { exploit mmatch_top; eauto. intros [P Q]. @@ -3795,17 +3795,17 @@ Proof. inv PM; auto. rewrite Int.add_zero; auto. - (* free blocks *) - intros. unfold inj_of_bc. erewrite bc_below_invalid; eauto. + intros. unfold inj_of_bc. erewrite bc_below_invalid; eauto. - (* mapped blocks *) intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. apply H0; auto. - (* overlap *) - red; intros. + red; intros. exploit inj_of_bc_inv. eexact H2. intros (A1 & B & C); subst. exploit inj_of_bc_inv. eexact H3. intros (A2 & B & C); subst. auto. - (* overflow *) - intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. + intros. exploit inj_of_bc_inv; eauto. intros (A & B & C); subst. rewrite Zplus_0_r. split. omega. apply Int.unsigned_range_2. Qed. @@ -3814,8 +3814,8 @@ Lemma inj_of_bc_preserves_globals: Proof. intros. destruct H as [A B]. split. intros. apply inj_of_bc_valid. rewrite A in H. congruence. - split. intros. apply inj_of_bc_valid. apply B. eapply Genv.genv_vars_range; eauto. - intros. exploit inj_of_bc_inv; eauto. intros (P & Q & R). auto. + split. intros. apply inj_of_bc_valid. apply B. eapply Genv.genv_vars_range; eauto. + intros. exploit inj_of_bc_inv; eauto. intros (P & Q & R). auto. Qed. Lemma pmatch_inj_top: @@ -3827,27 +3827,27 @@ Qed. Lemma vmatch_inj_top: forall bc v v', Val.inject (inj_of_bc bc) v v' -> vmatch bc v Vtop. Proof. - intros. inv H; constructor. eapply pmatch_inj_top; eauto. + intros. inv H; constructor. eapply pmatch_inj_top; eauto. Qed. Lemma mmatch_inj_top: forall bc m m', Mem.inject (inj_of_bc bc) m m' -> mmatch bc m mtop. Proof. - intros. + intros. assert (SM: forall b, bc b <> BCinvalid -> smatch bc m b Ptop). { - intros; split; intros. - - exploit Mem.load_inject. eauto. eauto. apply inj_of_bc_valid; auto. - intros (v' & A & B). eapply vmatch_inj_top; eauto. - - exploit Mem.loadbytes_inject. eauto. eauto. apply inj_of_bc_valid; auto. - intros (bytes' & A & B). inv B. inv H4. inv H8. eapply pmatch_inj_top; eauto. + intros; split; intros. + - exploit Mem.load_inject. eauto. eauto. apply inj_of_bc_valid; auto. + intros (v' & A & B). eapply vmatch_inj_top; eauto. + - exploit Mem.loadbytes_inject. eauto. eauto. apply inj_of_bc_valid; auto. + intros (bytes' & A & B). inv B. inv H4. inv H8. eapply pmatch_inj_top; eauto. } - constructor; simpl; intros. + constructor; simpl; intros. - apply ablock_init_sound. apply SM. congruence. - rewrite PTree.gempty in H1; discriminate. - apply SM; auto. - apply SM; auto. - - red; intros. eapply Mem.valid_block_inject_1. eapply inj_of_bc_valid; eauto. eauto. + - red; intros. eapply Mem.valid_block_inject_1. eapply inj_of_bc_valid; eauto. eauto. Qed. (** * Abstracting RTL register environments *) @@ -3882,30 +3882,30 @@ End AVal. Module AE := LPMap(AVal). -Definition aenv := AE.t. +Definition aenv := AE.t. Section MATCHENV. Variable bc: block_classification. Definition ematch (e: regset) (ae: aenv) : Prop := - forall r, vmatch bc e#r (AE.get r ae). + forall r, vmatch bc e#r (AE.get r ae). Lemma ematch_ge: forall e ae1 ae2, ematch e ae1 -> AE.ge ae2 ae1 -> ematch e ae2. Proof. - intros; red; intros. apply vmatch_ge with (AE.get r ae1); auto. apply H0. + intros; red; intros. apply vmatch_ge with (AE.get r ae1); auto. apply H0. Qed. Lemma ematch_update: forall e ae v av r, ematch e ae -> vmatch bc v av -> ematch (e#r <- v) (AE.set r av ae). Proof. - intros; red; intros. rewrite AE.gsspec. rewrite PMap.gsspec. - destruct (peq r0 r); auto. - red; intros. specialize (H xH). subst ae. simpl in H. inv H. - unfold AVal.eq; red; intros. subst av. inv H0. + intros; red; intros. rewrite AE.gsspec. rewrite PMap.gsspec. + destruct (peq r0 r); auto. + red; intros. specialize (H xH). subst ae. simpl in H. inv H. + unfold AVal.eq; red; intros. subst av. inv H0. Qed. Fixpoint einit_regs (rl: list reg) : aenv := @@ -3919,23 +3919,23 @@ Lemma ematch_init: (forall v, In v vl -> vmatch bc v (Ifptr Nonstack)) -> ematch (init_regs vl rl) (einit_regs rl). Proof. - induction rl; simpl; intros. -- red; intros. rewrite Regmap.gi. simpl AE.get. rewrite PTree.gempty. - constructor. -- destruct vl as [ | v1 vs ]. + induction rl; simpl; intros. +- red; intros. rewrite Regmap.gi. simpl AE.get. rewrite PTree.gempty. + constructor. +- destruct vl as [ | v1 vs ]. + assert (ematch (init_regs nil rl) (einit_regs rl)). { apply IHrl. simpl; tauto. } - replace (init_regs nil rl) with (Regmap.init Vundef) in H0 by (destruct rl; auto). - red; intros. rewrite AE.gsspec. destruct (peq r a). - rewrite Regmap.gi. constructor. - apply H0. + replace (init_regs nil rl) with (Regmap.init Vundef) in H0 by (destruct rl; auto). + red; intros. rewrite AE.gsspec. destruct (peq r a). + rewrite Regmap.gi. constructor. + apply H0. red; intros EQ; rewrite EQ in H0. specialize (H0 xH). simpl in H0. inv H0. unfold AVal.eq, AVal.bot. congruence. + assert (ematch (init_regs vs rl) (einit_regs rl)). { apply IHrl. eauto with coqlib. } - red; intros. rewrite Regmap.gsspec. rewrite AE.gsspec. destruct (peq r a). + red; intros. rewrite Regmap.gsspec. rewrite AE.gsspec. destruct (peq r a). auto with coqlib. - apply H0. + apply H0. red; intros EQ; rewrite EQ in H0. specialize (H0 xH). simpl in H0. inv H0. unfold AVal.eq, AVal.bot. congruence. Qed. @@ -3954,14 +3954,14 @@ Proof. destruct ae. unfold AE.get at 2. apply AVal.ge_bot. eapply AVal.ge_trans. apply IHrl. rewrite AE.gsspec. destruct (peq p a). apply AVal.ge_top. apply AVal.ge_refl. apply AVal.eq_refl. - congruence. + congruence. unfold AVal.eq, Vtop, AVal.bot. congruence. Qed. Lemma ematch_forget: forall e rl ae, ematch e ae -> ematch e (eforget rl ae). Proof. - intros. eapply ematch_ge; eauto. apply eforget_ge. + intros. eapply ematch_ge; eauto. apply eforget_ge. Qed. End MATCHENV. @@ -3969,7 +3969,7 @@ End MATCHENV. Lemma ematch_incr: forall bc bc' e ae, ematch bc e ae -> bc_incr bc bc' -> ematch bc' e ae. Proof. - intros; red; intros. apply vmatch_incr with bc; auto. + intros; red; intros. apply vmatch_incr with bc; auto. Qed. (** * Lattice for dataflow analysis *) @@ -3989,12 +3989,12 @@ Module VA <: SEMILATTICE. Lemma eq_refl: forall x, eq x x. Proof. - destruct x; simpl. auto. split. apply AE.eq_refl. tauto. + destruct x; simpl. auto. split. apply AE.eq_refl. tauto. Qed. Lemma eq_sym: forall x y, eq x y -> eq y x. Proof. - destruct x, y; simpl; auto. intros [A B]. - split. apply AE.eq_sym; auto. intros. rewrite B. tauto. + destruct x, y; simpl; auto. intros [A B]. + split. apply AE.eq_sym; auto. intros. rewrite B. tauto. Qed. Lemma eq_trans: forall x y z, eq x y -> eq y z -> eq x z. Proof. @@ -4009,16 +4009,16 @@ Module VA <: SEMILATTICE. | State ae1 am1, State ae2 am2 => AE.beq ae1 ae2 && mbeq am1 am2 | _, _ => false end. - + Lemma beq_correct: forall x y, beq x y = true -> eq x y. Proof. - destruct x, y; simpl; intros. + destruct x, y; simpl; intros. auto. congruence. congruence. InvBooleans; split. apply AE.beq_correct; auto. - intros. apply mbeq_sound; auto. + intros. apply mbeq_sound; auto. Qed. Definition ge (x y: t) : Prop := @@ -4030,21 +4030,21 @@ Module VA <: SEMILATTICE. Lemma ge_refl: forall x y, eq x y -> ge x y. Proof. - destruct x, y; simpl; try tauto. intros [A B]; split. + destruct x, y; simpl; try tauto. intros [A B]; split. apply AE.ge_refl; auto. - intros. rewrite B; auto. + intros. rewrite B; auto. Qed. Lemma ge_trans: forall x y z, ge x y -> ge y z -> ge x z. Proof. destruct x, y, z; simpl; try tauto. intros [A B] [C D]; split. - eapply AE.ge_trans; eauto. - eauto. + eapply AE.ge_trans; eauto. + eauto. Qed. Definition bot : t := Bot. Lemma ge_bot: forall x, ge x bot. Proof. - destruct x; simpl; auto. + destruct x; simpl; auto. Qed. Definition lub (x y: t) : t := @@ -4078,7 +4078,7 @@ Hint Constructors pmatch: va. Hint Constructors vmatch: va. Hint Resolve cnot_sound symbol_address_sound shl_sound shru_sound shr_sound - and_sound or_sound xor_sound notint_sound + and_sound or_sound xor_sound notint_sound ror_sound rolm_sound neg_sound add_sound sub_sound mul_sound mulhs_sound mulhu_sound @@ -4090,6 +4090,6 @@ Hint Resolve cnot_sound symbol_address_sound zero_ext_sound sign_ext_sound singleoffloat_sound floatofsingle_sound intoffloat_sound intuoffloat_sound floatofint_sound floatofintu_sound intofsingle_sound intuofsingle_sound singleofint_sound singleofintu_sound - longofwords_sound loword_sound hiword_sound + longofwords_sound loword_sound hiword_sound cmpu_bool_sound cmp_bool_sound cmpf_bool_sound cmpfs_bool_sound maskzero_sound : va. diff --git a/backend/XTL.ml b/backend/XTL.ml index dde9bdb0..2ddbc50a 100644 --- a/backend/XTL.ml +++ b/backend/XTL.ml @@ -186,7 +186,7 @@ let type_block blk = let type_function f = PTree.fold (fun () pc blk -> - try + try type_block blk with Type_error -> raise (Type_error_at pc)) diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 9b31dfdb..4835f785 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -141,8 +141,8 @@ let builtins_generic = { (* Block copy *) "__builtin_memcpy_aligned", (TVoid [], - [TPtr(TVoid [], []); - TPtr(TVoid [AConst], []); + [TPtr(TVoid [], []); + TPtr(TVoid [AConst], []); TInt(IUInt, []); TInt(IUInt, [])], false); @@ -357,12 +357,12 @@ let make_builtin_memcpy args = let sz1 = match Initializers.constval !comp_env sz with | Errors.OK(Vint n) -> n - | _ -> error "ill-formed __builtin_memcpy_aligned (3rd argument must be + | _ -> error "ill-formed __builtin_memcpy_aligned (3rd argument must be a constant)"; Integers.Int.zero in let al1 = match Initializers.constval !comp_env al with | Errors.OK(Vint n) -> n - | _ -> error "ill-formed __builtin_memcpy_aligned (4th argument must be + | _ -> error "ill-formed __builtin_memcpy_aligned (4th argument must be a constant)"; Integers.Int.one in (* to check: sz1 > 0, al1 divides sz1, al1 = 1|2|4|8 *) (* Issue #28: must decay array types to pointer types *) @@ -384,7 +384,7 @@ let va_list_ptr e = let make_builtin_va_arg_by_val helper ty ty_ret arg = let ty_fun = Tfunction(Tcons(Tpointer(Tvoid, noattr), Tnil), ty_ret, cc_default) in - Ecast + Ecast (Ecall(Evalof(Evar(intern_string helper, ty_fun), ty_fun), Econs(va_list_ptr arg, Enil), ty_ret), @@ -392,13 +392,13 @@ let make_builtin_va_arg_by_val helper ty ty_ret arg = let make_builtin_va_arg_by_ref helper ty arg = let ty_fun = - Tfunction(Tcons(Tpointer(Tvoid, noattr), Tnil), + Tfunction(Tcons(Tpointer(Tvoid, noattr), Tnil), Tpointer(Tvoid, noattr), cc_default) in let ty_ptr = Tpointer(ty, noattr) in let call = Ecall(Evalof(Evar(intern_string helper, ty_fun), ty_fun), - Econs(va_list_ptr arg, + Econs(va_list_ptr arg, Econs(Esizeof(ty, Tint(I32, Unsigned, noattr)), Enil)), Tpointer(Tvoid, noattr)) in Evalof(Ederef(Ecast(call, ty_ptr), ty), ty) @@ -406,13 +406,13 @@ let make_builtin_va_arg_by_ref helper ty arg = let make_builtin_va_arg env ty e = match ty with | Tint _ | Tpointer _ -> - make_builtin_va_arg_by_val + make_builtin_va_arg_by_val "__compcert_va_int32" ty (Tint(I32, Unsigned, noattr)) e | Tlong _ -> - make_builtin_va_arg_by_val + make_builtin_va_arg_by_val "__compcert_va_int64" ty (Tlong(Unsigned, noattr)) e | Tfloat _ -> - make_builtin_va_arg_by_val + make_builtin_va_arg_by_val "__compcert_va_float64" ty (Tfloat(F64, noattr)) e | Tstruct _ | Tunion _ -> make_builtin_va_arg_by_ref @@ -433,7 +433,7 @@ let rec log2 n = if n = 1 then 0 else 1 + log2 (n lsr 1) let convertAttr a = { attr_volatile = List.mem AVolatile a; - attr_alignas = + attr_alignas = let n = Cutil.alignas_attribute a in if n > 0 then Some (N.of_int (log2 n)) else None } @@ -463,7 +463,7 @@ let convertFkind = function | C.FFloat -> F32 | C.FDouble -> F64 | C.FLongDouble -> - if not !Clflags.option_flongdouble then unsupported "'long double' type"; + if not !Clflags.option_flongdouble then unsupported "'long double' type"; F64 let rec convertTyp env t = @@ -524,11 +524,11 @@ let convertField env f = (intern_string f.fld_name, convertTyp env f.fld_typ) let convertCompositedef env su id attr members = - let t = match su with - | C.Struct -> + let t = match su with + | C.Struct -> let layout = Cutil.struct_layout env members in List.iter (fun (a,b) -> Debug.set_member_offset id a b) layout; - TStruct (id,attr) + TStruct (id,attr) | C.Union -> TUnion (id,attr) in Debug.set_composite_size id su (Cutil.sizeof env t); Composite(intern_string id.name, @@ -763,7 +763,7 @@ let rec convertExpr env e = EF_debug(P.of_int64 kind, intern_string text, typlist_of_typelist targs2), targs2, convertExprList env args2, convertTyp env e.etyp) - + | C.ECall({edesc = C.EVar {name = "__builtin_annot"}}, args) -> begin match args with | {edesc = C.EConst(CStr txt)} :: args1 -> @@ -774,20 +774,20 @@ let rec convertExpr env e = | _ -> error "ill-formed __builtin_annot (first argument must be string literal)"; ezero - end - + end + | C.ECall({edesc = C.EVar {name = "__builtin_annot_intval"}}, args) -> begin match args with | [ {edesc = C.EConst(CStr txt)}; arg ] -> let targ = convertTyp env (Cutil.default_argument_conversion env arg.etyp) in Ebuiltin(EF_annot_val(coqstring_of_camlstring txt, typ_of_type targ), - Tcons(targ, Tnil), convertExprList env [arg], + Tcons(targ, Tnil), convertExprList env [arg], convertTyp env e.etyp) | _ -> error "ill-formed __builtin_annot_intval (first argument must be string literal)"; ezero - end + end | C.ECall({edesc = C.EVar {name = "__builtin_memcpy_aligned"}}, args) -> make_builtin_memcpy (convertExprList env args) @@ -822,9 +822,9 @@ let rec convertExpr env e = let sg = signature_of_type targs tres {cc_vararg = true; cc_unproto = false; cc_structret = false} in - Ebuiltin(EF_external(coqstring_of_camlstring "printf", sg), + Ebuiltin(EF_external(coqstring_of_camlstring "printf", sg), targs, convertExprList env args, tres) - + | C.ECall(fn, args) -> if not (supported_return_type env e.etyp) then unsupported ("function returning a result of type " ^ string_of_type e.etyp ^ " (consider adding option -fstruct-return)"); @@ -867,17 +867,17 @@ and convertExprList env el = (* Extended assembly *) let convertAsm loc env txt outputs inputs clobber = - let (txt', output', inputs') = + let (txt', output', inputs') = ExtendedAsm.transf_asm loc env txt outputs inputs clobber in let clobber' = List.map (fun s -> coqstring_of_camlstring (String.uppercase s)) clobber in let ty_res = match output' with None -> TVoid [] | Some e -> e.etyp in (* Build the Ebuiltin expression *) - let e = + let e = let tinputs = convertTypArgs env [] inputs' in let toutput = convertTyp env ty_res in - Ebuiltin(EF_inline_asm(coqstring_of_camlstring txt', + Ebuiltin(EF_inline_asm(coqstring_of_camlstring txt', signature_of_type tinputs toutput cc_default, clobber'), tinputs, @@ -894,7 +894,7 @@ type switchlabel = | Case of C.exp | Default -type switchbody = +type switchbody = | Label of switchlabel | Stmt of C.stmt @@ -922,16 +922,16 @@ let rec groupSwitch = function (Cutil.sseq s.sloc s fst, cases) (* Test whether the statement contains case and give an *) -let rec contains_case s = +let rec contains_case s = match s.sdesc with - | C.Sskip - | C.Sdo _ + | C.Sskip + | C.Sdo _ | C.Sbreak - | C.Scontinue + | C.Scontinue | C.Sswitch _ (* Stop at a switch *) - | C.Sgoto _ - | C.Sreturn _ - | C.Sdecl _ + | C.Sgoto _ + | C.Sreturn _ + | C.Sdecl _ | C.Sasm _ -> () | C.Sseq (s1,s2) | C.Sif(_,s1,s2) -> contains_case s1; contains_case s2 @@ -1021,7 +1021,7 @@ and convertSwitch env is_64 = function match lbl with | Default -> None - | Case e -> + | Case e -> match Ceval.integer_expr env e with | None -> unsupported "'case' label is not a compile-time integer"; None @@ -1128,7 +1128,7 @@ let convertInitializer env ty i = let convertGlobvar loc env (sto, id, ty, optinit) = let id' = intern_string id.name in Debug.atom_global_variable id id'; - let ty' = convertTyp env ty in + let ty' = convertTyp env ty in let sz = Ctypes.sizeof !comp_env ty' in let al = Ctypes.alignof !comp_env ty' in let attr = Cutil.attributes_of_type env ty in @@ -1190,7 +1190,7 @@ let rec convertGlobdecls env res gl = warning ("'#pragma " ^ s ^ "' directive ignored"); convertGlobdecls env res gl' -(** Convert struct and union declarations. +(** Convert struct and union declarations. Result is a list of CompCert C composite declarations. *) let rec convertCompositedefs env res gl = @@ -1229,7 +1229,7 @@ let rec translEnv env = function module IdentSet = Set.Make(struct type t = C.ident let compare = compare end) let cleanupGlobals p = - + (* First pass: determine what is defined *) let strong = ref IdentSet.empty (* def functions or variables with inits *) and weak = ref IdentSet.empty (* variables without inits *) @@ -1252,7 +1252,7 @@ let cleanupGlobals p = | _ -> () in List.iter classify_def p; - (* Second pass: keep "best" definition for each identifier *) + (* Second pass: keep "best" definition for each identifier *) let rec clean defs accu = function | [] -> accu | g :: gl -> diff --git a/cfrontend/Cexec.v b/cfrontend/Cexec.v index 938454c5..7e966ffe 100644 --- a/cfrontend/Cexec.v +++ b/cfrontend/Cexec.v @@ -85,7 +85,7 @@ Proof. intros until ty. destruct a; simpl; congruence. Qed. -Local Open Scope option_monad_scope. +Local Open Scope option_monad_scope. Fixpoint is_val_list (al: exprlist) : option (list (val * type)) := match al with @@ -110,7 +110,7 @@ Definition eventval_of_val (v: val) (t: typ) : option eventval := | Vfloat f, AST.Tfloat => Some (EVfloat f) | Vsingle f, AST.Tsingle => Some (EVsingle f) | Vlong n, AST.Tlong => Some (EVlong n) - | Vptr b ofs, AST.Tint => + | Vptr b ofs, AST.Tint => do id <- Genv.invert_symbol ge b; check (Genv.public_symbol ge id); Some (EVptr_global id ofs) @@ -153,7 +153,7 @@ Lemma eventval_of_val_complete: forall ev t v, eventval_match ge ev t v -> eventval_of_val v t = Some ev. Proof. induction 1; simpl; auto. - rewrite (Genv.find_invert_symbol _ _ H0). simpl in H; rewrite H. auto. + rewrite (Genv.find_invert_symbol _ _ H0). simpl in H; rewrite H. auto. Qed. Lemma list_eventval_of_val_sound: @@ -169,7 +169,7 @@ Qed. Lemma list_eventval_of_val_complete: forall evl tl vl, eventval_list_match ge evl tl vl -> list_eventval_of_val vl tl = Some evl. Proof. - induction 1; simpl. auto. + induction 1; simpl. auto. rewrite (eventval_of_val_complete _ _ _ H). rewrite IHeventval_list_match. auto. Qed. @@ -190,7 +190,7 @@ Qed. (** Volatile memory accesses. *) -Definition do_volatile_load (w: world) (chunk: memory_chunk) (m: mem) (b: block) (ofs: int) +Definition do_volatile_load (w: world) (chunk: memory_chunk) (m: mem) (b: block) (ofs: int) : option (world * trace * val) := if Genv.block_is_volatile ge b then do id <- Genv.invert_symbol ge b; @@ -230,11 +230,11 @@ Lemma do_volatile_load_sound: do_volatile_load w chunk m b ofs = Some(w', t, v) -> volatile_load ge chunk m b ofs t v /\ possible_trace w t w'. Proof. - intros until v. unfold do_volatile_load. mydestr. - destruct p as [ev w'']. mydestr. - split. constructor; auto. apply Genv.invert_find_symbol; auto. - apply val_of_eventval_sound; auto. - econstructor. constructor; eauto. constructor. + intros until v. unfold do_volatile_load. mydestr. + destruct p as [ev w'']. mydestr. + split. constructor; auto. apply Genv.invert_find_symbol; auto. + apply val_of_eventval_sound; auto. + econstructor. constructor; eauto. constructor. split. constructor; auto. constructor. Qed. @@ -254,10 +254,10 @@ Lemma do_volatile_store_sound: do_volatile_store w chunk m b ofs v = Some(w', t, m') -> volatile_store ge chunk m b ofs v t m' /\ possible_trace w t w'. Proof. - intros until m'. unfold do_volatile_store. mydestr. - split. constructor; auto. apply Genv.invert_find_symbol; auto. - apply eventval_of_val_sound; auto. - econstructor. constructor; eauto. constructor. + intros until m'. unfold do_volatile_store. mydestr. + split. constructor; auto. apply Genv.invert_find_symbol; auto. + apply eventval_of_val_sound; auto. + econstructor. constructor; eauto. constructor. split. constructor; auto. constructor. Qed. @@ -297,7 +297,7 @@ Remark check_assign_copy: forall (ty: type) (b: block) (ofs: int) (b': block) (ofs': int), { assign_copy_ok ty b ofs b' ofs' } + {~ assign_copy_ok ty b ofs b' ofs' }. Proof with try (right; intuition omega). - intros. unfold assign_copy_ok. + intros. unfold assign_copy_ok. assert (alignof_blockcopy ge ty > 0) by apply alignof_blockcopy_pos. destruct (Zdivide_dec (alignof_blockcopy ge ty) (Int.unsigned ofs')); auto... destruct (Zdivide_dec (alignof_blockcopy ge ty) (Int.unsigned ofs)); auto... @@ -314,7 +314,7 @@ Proof with try (right; intuition omega). destruct (zle (Int.unsigned ofs' + sizeof ge ty) (Int.unsigned ofs)); auto. destruct (zle (Int.unsigned ofs + sizeof ge ty) (Int.unsigned ofs')); auto. right; intuition omega. - destruct Y... left; intuition omega. + destruct Y... left; intuition omega. Defined. Definition do_assign_loc (w: world) (ty: type) (m: mem) (b: block) (ofs: int) (v: val): option (world * trace * mem) := @@ -343,8 +343,8 @@ Lemma do_deref_loc_sound: deref_loc ge ty m b ofs t v /\ possible_trace w t w'. Proof. unfold do_deref_loc; intros until v. - destruct (access_mode ty) eqn:?; mydestr. - intros. exploit do_volatile_load_sound; eauto. intuition. eapply deref_loc_volatile; eauto. + destruct (access_mode ty) eqn:?; mydestr. + intros. exploit do_volatile_load_sound; eauto. intuition. eapply deref_loc_volatile; eauto. split. eapply deref_loc_value; eauto. constructor. split. eapply deref_loc_reference; eauto. constructor. split. eapply deref_loc_copy; eauto. constructor. @@ -368,10 +368,10 @@ Lemma do_assign_loc_sound: assign_loc ge ty m b ofs v t m' /\ possible_trace w t w'. Proof. unfold do_assign_loc; intros until m'. - destruct (access_mode ty) eqn:?; mydestr. - intros. exploit do_volatile_store_sound; eauto. intuition. eapply assign_loc_volatile; eauto. + destruct (access_mode ty) eqn:?; mydestr. + intros. exploit do_volatile_store_sound; eauto. intuition. eapply assign_loc_volatile; eauto. split. eapply assign_loc_value; eauto. constructor. - destruct v; mydestr. destruct a as [P [Q R]]. + destruct v; mydestr. destruct a as [P [Q R]]. split. eapply assign_loc_copy; eauto. constructor. Qed. @@ -385,7 +385,7 @@ Proof. rewrite H1; rewrite H2. apply do_volatile_store_complete; auto. rewrite H1. destruct (check_assign_copy ty b ofs b' ofs'). inv H0. rewrite H5; rewrite H6; auto. - elim n. red; tauto. + elim n. red; tauto. Qed. (** External calls *) @@ -477,7 +477,7 @@ Remark memcpy_check_args: forall sz al bdst odst bsrc osrc, {memcpy_args_ok sz al bdst odst bsrc osrc} + {~memcpy_args_ok sz al bdst odst bsrc osrc}. Proof with try (right; intuition omega). - intros. + intros. assert (X: {al = 1 \/ al = 2 \/ al = 4 \/ al = 8} + {~(al = 1 \/ al = 2 \/ al = 4 \/ al = 8)}). destruct (zeq al 1); auto. destruct (zeq al 2); auto. destruct (zeq al 4); auto. destruct (zeq al 8); auto... @@ -486,9 +486,9 @@ Proof with try (right; intuition omega). destruct (zle 0 sz)... destruct (Zdivide_dec al sz); auto... assert(U: forall x, {sz > 0 -> (al | x)} + {~(sz > 0 -> (al | x))}). - intros. destruct (zeq sz 0). + intros. destruct (zeq sz 0). left; intros; omegaContradiction. - destruct (Zdivide_dec al x); auto. right; red; intros. elim n0. apply H0. omega. + destruct (Zdivide_dec al x); auto. right; red; intros. elim n0. apply H0. omega. destruct (U osrc); auto... destruct (U odst); auto... assert (Y: {bsrc <> bdst \/ osrc = odst \/ osrc + sz <= odst \/ odst + sz <= osrc} @@ -555,17 +555,17 @@ Proof with try congruence. intros until m'. destruct ef; simpl. (* EF_external *) - eapply do_external_function_sound; eauto. + eapply do_external_function_sound; eauto. (* EF_builtin *) - eapply do_external_function_sound; eauto. + eapply do_external_function_sound; eauto. (* EF_vload *) - unfold do_ef_volatile_load. destruct vargs... destruct v... destruct vargs... + unfold do_ef_volatile_load. destruct vargs... destruct v... destruct vargs... mydestr. destruct p as [[w'' t''] v]; mydestr. - exploit do_volatile_load_sound; eauto. intuition. econstructor; eauto. + exploit do_volatile_load_sound; eauto. intuition. econstructor; eauto. auto. (* EF_vstore *) - unfold do_ef_volatile_store. destruct vargs... destruct v... destruct vargs... destruct vargs... - mydestr. destruct p as [[w'' t''] m'']. mydestr. + unfold do_ef_volatile_store. destruct vargs... destruct v... destruct vargs... destruct vargs... + mydestr. destruct p as [[w'' t''] m'']. mydestr. exploit do_volatile_store_sound; eauto. intuition. econstructor; eauto. auto. (* EF_malloc *) @@ -573,19 +573,19 @@ Proof with try congruence. destruct (Mem.alloc m (-4) (Int.unsigned i)) as [m1 b] eqn:?. mydestr. split. econstructor; eauto. constructor. (* EF_free *) - unfold do_ef_free. destruct vargs... destruct v... destruct vargs... - mydestr. destruct v... mydestr. + unfold do_ef_free. destruct vargs... destruct v... destruct vargs... + mydestr. destruct v... mydestr. split. econstructor; eauto. omega. constructor. (* EF_memcpy *) - unfold do_ef_memcpy. destruct vargs... destruct v... destruct vargs... - destruct v... destruct vargs... mydestr. red in m0. + unfold do_ef_memcpy. destruct vargs... destruct v... destruct vargs... + destruct v... destruct vargs... mydestr. red in m0. split. econstructor; eauto; tauto. constructor. (* EF_annot *) - unfold do_ef_annot. mydestr. + unfold do_ef_annot. mydestr. split. constructor. apply list_eventval_of_val_sound; auto. econstructor. constructor; eauto. constructor. (* EF_annot_val *) - unfold do_ef_annot_val. destruct vargs... destruct vargs... mydestr. + unfold do_ef_annot_val. destruct vargs... destruct vargs... mydestr. split. constructor. apply eventval_of_val_sound; auto. econstructor. constructor; eauto. constructor. (* EF_inline_asm *) @@ -611,7 +611,7 @@ Proof. inv H; unfold do_ef_volatile_store. exploit do_volatile_store_complete; eauto. intros EQ; rewrite EQ; auto. (* EF_malloc *) - inv H; unfold do_ef_malloc. + inv H; unfold do_ef_malloc. inv H0. rewrite H1. rewrite H2. auto. (* EF_free *) inv H; unfold do_ef_free. @@ -619,12 +619,12 @@ Proof. (* EF_memcpy *) inv H; unfold do_ef_memcpy. inv H0. rewrite pred_dec_true. rewrite H7; rewrite H8; auto. - red. tauto. + red. tauto. (* EF_annot *) - inv H; unfold do_ef_annot. inv H0. inv H6. inv H4. + inv H; unfold do_ef_annot. inv H0. inv H6. inv H4. rewrite (list_eventval_of_val_complete _ _ _ H1). auto. (* EF_annot_val *) - inv H; unfold do_ef_annot_val. inv H0. inv H6. inv H4. + inv H; unfold do_ef_annot_val. inv H0. inv H6. inv H4. rewrite (eventval_of_val_complete _ _ _ H1). auto. (* EF_inline_asm *) eapply do_inline_assembly_complete; eauto. @@ -837,7 +837,7 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr := do w',t, v1 <- do_deref_loc w ty m b ofs; let op := match id with Incr => Oadd | Decr => Osub end in let r' := - Ecomma (Eassign (Eloc b ofs ty) + Ecomma (Eassign (Eloc b ofs ty) (Ebinop op (Eval v1 ty) (Eval (Vint Int.one) type_int32s) (incrdecr_type ty)) ty) (Eval v1 ty) ty in @@ -922,7 +922,7 @@ Inductive imm_safe_t: kind -> expr -> mem -> Prop := Remark imm_safe_t_imm_safe: forall k a m, imm_safe_t k a m -> imm_safe ge e k a m. Proof. - induction 1. + induction 1. constructor. constructor. eapply imm_safe_lred; eauto. @@ -975,7 +975,7 @@ Definition invert_expr_prop (a: expr) (m: mem) : Prop := exists t, exists v1, exists w', ty = ty1 /\ deref_loc ge ty1 m b ofs t v1 /\ possible_trace w t w' | Epostincr id (Eloc b ofs ty1) ty => - exists t, exists v1, exists w', + exists t, exists v1, exists w', ty = ty1 /\ deref_loc ge ty m b ofs t v1 /\ possible_trace w t w' | Ecomma (Eval v ty1) r2 ty => typeof r2 = ty @@ -1004,7 +1004,7 @@ Proof. exists b; auto. exists b; auto. exists b; exists ofs; auto. - exists b; exists ofs; split; auto. exists co, delta; auto. + exists b; exists ofs; split; auto. exists co, delta; auto. exists b; exists ofs; split; auto. exists co; auto. Qed. @@ -1072,8 +1072,8 @@ Proof. intros. elim (H0 a m); auto. destruct (C a); auto; contradiction. destruct (C a); auto; contradiction. - red; intros. destruct (C a); auto. - red; intros. destruct e1; auto. elim (H0 a m); auto. + red; intros. destruct (C a); auto. + red; intros. destruct e1; auto. elim (H0 a m); auto. Qed. Lemma imm_safe_t_inv: @@ -1086,7 +1086,7 @@ Lemma imm_safe_t_inv: end. Proof. destruct invert_expr_context as [A B]. - intros. inv H. + intros. inv H. auto. auto. assert (invert_expr_prop (C l) m). @@ -1160,7 +1160,7 @@ Proof. induction rargs; simpl; intros. inv H. destruct tyargs; simpl in H0; inv H0. constructor. monadInv. inv H. simpl in H0. destruct p as [v1 t1]. destruct tyargs; try congruence. monadInv. - inv H0. rewrite (is_val_inv _ _ _ Heqo). constructor. auto. eauto. + inv H0. rewrite (is_val_inv _ _ _ Heqo). constructor. auto. eauto. Qed. Lemma sem_cast_arguments_complete: @@ -1170,7 +1170,7 @@ Lemma sem_cast_arguments_complete: Proof. induction 1. exists (@nil (val * type)); auto. - destruct IHcast_arguments as [vtl [A B]]. + destruct IHcast_arguments as [vtl [A B]]. exists ((v, ty) :: vtl); simpl. rewrite A; rewrite B; rewrite H. auto. Qed. @@ -1179,7 +1179,7 @@ Lemma topred_ok: reduction_ok k a m rd -> reducts_ok k a m (topred rd). Proof. - intros. unfold topred; split; simpl; intros. + intros. unfold topred; split; simpl; intros. destruct H0; try contradiction. inv H0. exists a; exists k; auto. congruence. Qed. @@ -1199,7 +1199,7 @@ Lemma wrong_kind_ok: k <> Cstrategy.expr_kind a -> reducts_ok k a m stuck. Proof. - intros. apply stuck_ok. red; intros. exploit Cstrategy.imm_safe_kind; eauto. + intros. apply stuck_ok. red; intros. exploit Cstrategy.imm_safe_kind; eauto. eapply imm_safe_t_imm_safe; eauto. Qed. @@ -1212,9 +1212,9 @@ Lemma not_invert_ok: end -> reducts_ok k a m stuck. Proof. - intros. apply stuck_ok. red; intros. - exploit imm_safe_t_inv; eauto. destruct a; auto. -Qed. + intros. apply stuck_ok. red; intros. + exploit imm_safe_t_inv; eauto. destruct a; auto. +Qed. Lemma incontext_ok: forall k a m C res k' a', @@ -1272,7 +1272,7 @@ Lemma incontext2_list_ok: reducts_ok RV a1 m res1 -> list_reducts_ok a2 m res2 -> is_val a1 = None \/ is_val_list a2 = None -> - reducts_ok RV (Ecall a1 a2 ty) m + reducts_ok RV (Ecall a1 a2 ty) m (incontext2 (fun x => Ecall x a2 ty) res1 (fun x => Ecall a1 x ty) res2). Proof. @@ -1280,7 +1280,7 @@ Proof. destruct (in_app_or _ _ _ H4). exploit list_in_map_inv; eauto. intros [[C' rd'] [P Q]]. inv P. exploit H; eauto. intros [a'' [k'' [U [V W]]]]. - exists a''; exists k''. split. eauto. rewrite V; auto. + exists a''; exists k''. split. eauto. rewrite V; auto. exploit list_in_map_inv; eauto. intros [[C' rd'] [P Q]]. inv P. exploit H0; eauto. intros [a'' [k'' [U [V W]]]]. exists a''; exists k''. split. eauto. rewrite V; auto. @@ -1301,7 +1301,7 @@ Proof. destruct (in_app_or _ _ _ H3). exploit list_in_map_inv; eauto. intros [[C' rd'] [P Q]]. inv P. exploit H; eauto. intros [a'' [k'' [U [V W]]]]. - exists a''; exists k''. split. eauto. rewrite V; auto. + exists a''; exists k''. split. eauto. rewrite V; auto. exploit list_in_map_inv; eauto. intros [[C' rd'] [P Q]]. inv P. exploit H0; eauto. intros [a'' [k'' [U [V W]]]]. exists a''; exists k''. split. eauto. rewrite V; auto. @@ -1312,7 +1312,7 @@ Qed. Lemma is_val_list_all_values: forall al vtl, is_val_list al = Some vtl -> exprlist_all_values al. Proof. - induction al; simpl; intros. auto. + induction al; simpl; intros. auto. destruct (is_val r1) as [[v ty]|] eqn:?; try discriminate. destruct (is_val_list al) as [vtl'|] eqn:?; try discriminate. rewrite (is_val_inv _ _ _ Heqo). eauto. @@ -1344,7 +1344,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). destruct v... - destruct ty'... + destruct ty'... (* top struct *) destruct (ge.(genv_cenv)!i0) as [co|] eqn:?... destruct (field_offset ge f (co_members co)) as [delta|] eqn:?... @@ -1353,7 +1353,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; destruct (ge.(genv_cenv)!i0) as [co|] eqn:?... apply topred_ok; auto. eapply red_field_union; eauto. (* in depth *) - eapply incontext_ok; eauto. + eapply incontext_ok; eauto. (* Evalof *) destruct (is_loc a) as [[[b ofs] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo). (* top *) @@ -1367,7 +1367,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; (* Ederef *) destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). (* top *) - destruct v... apply topred_ok; auto. apply red_deref; auto. + destruct v... apply topred_ok; auto. apply red_deref; auto. (* depth *) eapply incontext_ok; eauto. (* Eaddrof *) @@ -1377,31 +1377,31 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; (* depth *) eapply incontext_ok; eauto. (* unop *) - destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). + destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). (* top *) destruct (sem_unary_operation op v ty' m) as [v'|] eqn:?... - apply topred_ok; auto. split. apply red_unop; auto. exists w; constructor. + apply topred_ok; auto. split. apply red_unop; auto. exists w; constructor. (* depth *) eapply incontext_ok; eauto. (* binop *) - destruct (is_val a1) as [[v1 ty1] | ] eqn:?. + destruct (is_val a1) as [[v1 ty1] | ] eqn:?. destruct (is_val a2) as [[v2 ty2] | ] eqn:?. - rewrite (is_val_inv _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0). + rewrite (is_val_inv _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0). (* top *) destruct (sem_binary_operation ge op v1 ty1 v2 ty2 m) as [v|] eqn:?... apply topred_ok; auto. split. apply red_binop; auto. exists w; constructor. (* depth *) - eapply incontext2_ok; eauto. - eapply incontext2_ok; eauto. + eapply incontext2_ok; eauto. + eapply incontext2_ok; eauto. (* cast *) - destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). + destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). (* top *) destruct (sem_cast v ty' ty) as [v'|] eqn:?... - apply topred_ok; auto. split. apply red_cast; auto. exists w; constructor. + apply topred_ok; auto. split. apply red_cast; auto. exists w; constructor. (* depth *) eapply incontext_ok; eauto. (* seqand *) - destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). + destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). (* top *) destruct (bool_val v ty' m) as [v'|] eqn:?... destruct v'. apply topred_ok; auto. split. eapply red_seqand_true; eauto. exists w; constructor. @@ -1409,7 +1409,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; (* depth *) eapply incontext_ok; eauto. (* seqor *) - destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). + destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). (* top *) destruct (bool_val v ty' m) as [v'|] eqn:?... destruct v'. apply topred_ok; auto. split. eapply red_seqor_true; eauto. exists w; constructor. @@ -1417,7 +1417,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; (* depth *) eapply incontext_ok; eauto. (* condition *) - destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). + destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). (* top *) destruct (bool_val v ty' m) as [v'|] eqn:?... apply topred_ok; auto. split. eapply red_condition; eauto. exists w; constructor. @@ -1428,8 +1428,8 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; (* alignof *) apply topred_ok; auto. split. apply red_alignof. exists w; constructor. (* assign *) - destruct (is_loc a1) as [[[b ofs] ty1] | ] eqn:?. - destruct (is_val a2) as [[v2 ty2] | ] eqn:?. + destruct (is_loc a1) as [[[b ofs] ty1] | ] eqn:?. + destruct (is_val a2) as [[v2 ty2] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0). (* top *) destruct (type_eq ty1 ty)... subst ty1. @@ -1442,9 +1442,9 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; eapply incontext2_ok; eauto. eapply incontext2_ok; eauto. (* assignop *) - destruct (is_loc a1) as [[[b ofs] ty1] | ] eqn:?. - destruct (is_val a2) as [[v2 ty2] | ] eqn:?. - rewrite (is_loc_inv _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0). + destruct (is_loc a1) as [[[b ofs] ty1] | ] eqn:?. + destruct (is_val a2) as [[v2 ty2] | ] eqn:?. + rewrite (is_loc_inv _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0). (* top *) destruct (type_eq ty1 ty)... subst ty1. destruct (do_deref_loc w ty m b ofs) as [[[w' t] v] | ] eqn:?. @@ -1455,7 +1455,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; eapply incontext2_ok; eauto. eapply incontext2_ok; eauto. (* postincr *) - destruct (is_loc a) as [[[b ofs] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo). + destruct (is_loc a) as [[[b ofs] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo). (* top *) destruct (type_eq ty' ty)... subst ty'. destruct (do_deref_loc w ty m b ofs) as [[[w' t] v] | ] eqn:?. @@ -1465,22 +1465,22 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; (* depth *) eapply incontext_ok; eauto. (* comma *) - destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). + destruct (is_val a1) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). (* top *) destruct (type_eq (typeof a2) ty)... subst ty. apply topred_ok; auto. split. apply red_comma; auto. exists w; constructor. (* depth *) eapply incontext_ok; eauto. (* call *) - destruct (is_val a) as [[vf tyf] | ] eqn:?. - destruct (is_val_list rargs) as [vtl | ] eqn:?. + destruct (is_val a) as [[vf tyf] | ] eqn:?. + destruct (is_val_list rargs) as [vtl | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). exploit is_val_list_all_values; eauto. intros ALLVAL. (* top *) destruct (classify_fun tyf) as [tyargs tyres cconv|] eqn:?... destruct (Genv.find_funct ge vf) as [fd|] eqn:?... - destruct (sem_cast_arguments vtl tyargs) as [vargs|] eqn:?... + destruct (sem_cast_arguments vtl tyargs) as [vargs|] eqn:?... destruct (type_eq (type_of_fundef fd) (Tfunction tyargs tyres cconv))... - apply topred_ok; auto. red. split; auto. eapply red_call; eauto. + apply topred_ok; auto. red. split; auto. eapply red_call; eauto. eapply sem_cast_arguments_sound; eauto. apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv. congruence. apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv. @@ -1491,31 +1491,31 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence; eapply incontext2_list_ok; eauto. eapply incontext2_list_ok; eauto. (* builtin *) - destruct (is_val_list rargs) as [vtl | ] eqn:?. + destruct (is_val_list rargs) as [vtl | ] eqn:?. exploit is_val_list_all_values; eauto. intros ALLVAL. (* top *) - destruct (sem_cast_arguments vtl tyargs) as [vargs|] eqn:?... + destruct (sem_cast_arguments vtl tyargs) as [vargs|] eqn:?... destruct (do_external ef w vargs m) as [[[[? ?] v] m'] | ] eqn:?... exploit do_ef_external_sound; eauto. intros [EC PT]. - apply topred_ok; auto. red. split; auto. eapply red_builtin; eauto. + apply topred_ok; auto. red. split; auto. eapply red_builtin; eauto. eapply sem_cast_arguments_sound; eauto. exists w0; auto. apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv. - assert (x = vargs). + assert (x = vargs). exploit sem_cast_arguments_complete; eauto. intros [vtl' [A B]]. congruence. subst x. exploit do_ef_external_complete; eauto. congruence. - apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv. + apply not_invert_ok; simpl; intros; myinv. specialize (H ALLVAL). myinv. exploit sem_cast_arguments_complete; eauto. intros [vtl' [A B]]. congruence. (* depth *) eapply incontext_list_ok; eauto. - + (* loc *) split; intros. tauto. simpl; congruence. (* paren *) - destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). + destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo). (* top *) destruct (sem_cast v ty' tycast) as [v'|] eqn:?... - apply topred_ok; auto. split. apply red_paren; auto. exists w; constructor. + apply topred_ok; auto. split. apply red_paren; auto. exists w; constructor. (* depth *) eapply incontext_ok; eauto. @@ -1529,7 +1529,7 @@ Qed. Lemma step_exprlist_val_list: forall m al, is_val_list al <> None -> step_exprlist al m = nil. Proof. - induction al; simpl; intros. + induction al; simpl; intros. auto. destruct (is_val r1) as [[v1 ty1]|] eqn:?; try congruence. destruct (is_val_list al) eqn:?; try congruence. @@ -1549,7 +1549,7 @@ Proof. rewrite H. rewrite dec_eq_true. econstructor; eauto. (* var global *) rewrite H; rewrite H0. econstructor; eauto. -(* deref *) +(* deref *) econstructor; eauto. (* field struct *) rewrite H, H0; econstructor; eauto. @@ -1564,7 +1564,7 @@ Lemma rred_topred: Proof. induction 1; simpl; intros. (* valof *) - rewrite dec_eq_true. + rewrite dec_eq_true. rewrite (do_deref_loc_complete _ _ _ _ _ _ _ _ H H0). econstructor; eauto. (* addrof *) inv H. econstructor; eauto. @@ -1591,7 +1591,7 @@ Proof. econstructor; eauto. (* assignop *) rewrite dec_eq_true. rewrite (do_deref_loc_complete _ _ _ _ _ _ _ _ H H0). - econstructor; eauto. + econstructor; eauto. (* postincr *) rewrite dec_eq_true. subst. rewrite (do_deref_loc_complete _ _ _ _ _ _ _ _ H H1). econstructor; eauto. @@ -1601,7 +1601,7 @@ Proof. inv H0. rewrite H; econstructor; eauto. (* builtin *) exploit sem_cast_arguments_complete; eauto. intros [vtl [A B]]. - exploit do_ef_external_complete; eauto. intros C. + exploit do_ef_external_complete; eauto. intros C. rewrite A. rewrite B. rewrite C. econstructor; eauto. Qed. @@ -1624,7 +1624,7 @@ Lemma reducts_incl_trans: reducts_incl C' res2 res3 -> reducts_incl (fun x => C'(C x)) res1 res3. Proof. - unfold reducts_incl; intros. auto. + unfold reducts_incl; intros. auto. Qed. Lemma reducts_incl_nil: @@ -1756,11 +1756,11 @@ Proof. eapply reducts_incl_trans with (C' := fun x => Ecall x el ty); eauto. destruct (is_val (C a)) as [[v ty']|] eqn:?; eauto. (* call right *) - eapply reducts_incl_trans with (C' := fun x => Ecall e1 x ty). apply step_exprlist_context. auto. + eapply reducts_incl_trans with (C' := fun x => Ecall e1 x ty). apply step_exprlist_context. auto. destruct (is_val e1) as [[v1 ty1]|] eqn:?; eauto. destruct (is_val_list (C a)) as [vl|] eqn:?; eauto. (* builtin *) - eapply reducts_incl_trans with (C' := fun x => Ebuiltin ef tyargs x ty). apply step_exprlist_context. auto. + eapply reducts_incl_trans with (C' := fun x => Ebuiltin ef tyargs x ty). apply step_exprlist_context. auto. destruct (is_val_list (C a)) as [vl|] eqn:?; eauto. (* comma *) eapply reducts_incl_trans with (C' := fun x => Ecomma x e2 ty); eauto. @@ -1785,18 +1785,18 @@ Lemma not_stuckred_imm_safe: forall m a k, (forall C, ~In (C, Stuckred) (step_expr k a m)) -> imm_safe_t k a m. Proof. - intros. generalize (step_expr_sound a k m). intros [A B]. + intros. generalize (step_expr_sound a k m). intros [A B]. destruct (step_expr k a m) as [|[C rd] res] eqn:?. specialize (B (refl_equal _)). destruct k. destruct a; simpl in B; try congruence. constructor. destruct a; simpl in B; try congruence. constructor. assert (NOTSTUCK: rd <> Stuckred). red; intros. elim (H C); subst rd; auto with coqlib. - exploit A. eauto with coqlib. intros [a' [k' [P [Q R]]]]. + exploit A. eauto with coqlib. intros [a' [k' [P [Q R]]]]. destruct k'; destruct rd; simpl in R; intuition. subst a. eapply imm_safe_t_lred; eauto. - subst a. destruct H1 as [w' PT]. eapply imm_safe_t_rred; eauto. - subst. eapply imm_safe_t_callred; eauto. + subst a. destruct H1 as [w' PT]. eapply imm_safe_t_rred; eauto. + subst. eapply imm_safe_t_callred; eauto. Qed. Lemma not_imm_safe_stuck_red: @@ -1805,14 +1805,14 @@ Lemma not_imm_safe_stuck_red: ~imm_safe_t k a m -> exists C', In (C', Stuckred) (step_expr RV (C a) m). Proof. - intros. + intros. assert (exists C', In (C', Stuckred) (step_expr k a m)). destruct (classic (exists C', In (C', Stuckred) (step_expr k a m))); auto. - elim H0. apply not_stuckred_imm_safe. apply not_ex_all_not. auto. + elim H0. apply not_stuckred_imm_safe. apply not_ex_all_not. auto. destruct H1 as [C' IN]. - specialize (step_expr_context _ _ _ H a m). unfold reducts_incl. + specialize (step_expr_context _ _ _ H a m). unfold reducts_incl. intro. - exists (fun x => (C (C' x))). apply H1; auto. + exists (fun x => (C (C' x))). apply H1; auto. Qed. (** Connections between [imm_safe_t] and [imm_safe] *) @@ -1824,12 +1824,12 @@ Lemma imm_safe_imm_safe_t: exists C, exists a1, exists t, exists a1', exists m', context RV k C /\ a = C a1 /\ rred ge a1 m t a1' m' /\ forall w', ~possible_trace w t w'. Proof. - intros. inv H. + intros. inv H. left. apply imm_safe_t_val. left. apply imm_safe_t_loc. left. eapply imm_safe_t_lred; eauto. destruct (classic (exists w', possible_trace w t w')) as [[w' A] | A]. - left. eapply imm_safe_t_rred; eauto. + left. eapply imm_safe_t_rred; eauto. right. exists C; exists e0; exists t; exists e'; exists m'; intuition. apply A; exists w'; auto. left. eapply imm_safe_t_callred; eauto. Qed. @@ -1847,10 +1847,10 @@ Theorem not_imm_safe_t: Csem.step ge (ExprState f (C a) k e m) E0 Stuckstate \/ can_crash_world w (ExprState f (C a) k e m). Proof. intros. destruct (classic (imm_safe ge e K a m)). - exploit imm_safe_imm_safe_t; eauto. + exploit imm_safe_imm_safe_t; eauto. intros [A | [C1 [a1 [t [a1' [m' [A [B [D E]]]]]]]]]. contradiction. - right. red. exists t; econstructor; split; auto. - left. rewrite B. eapply step_rred with (C := fun x => C(C1 x)). eauto. eauto. + right. red. exists t; econstructor; split; auto. + left. rewrite B. eapply step_rred with (C := fun x => C(C1 x)). eauto. eauto. left. left. eapply step_stuck; eauto. Qed. @@ -1862,14 +1862,14 @@ Fixpoint do_alloc_variables (e: env) (m: mem) (l: list (ident * type)) {struct l match l with | nil => (e,m) | (id, ty) :: l' => - let (m1,b1) := Mem.alloc m 0 (sizeof ge ty) in + let (m1,b1) := Mem.alloc m 0 (sizeof ge ty) in do_alloc_variables (PTree.set id (b1, ty) e) m1 l' end. Lemma do_alloc_variables_sound: forall l e m, alloc_variables ge e m l (fst (do_alloc_variables e m l)) (snd (do_alloc_variables e m l)). Proof. - induction l; intros; simpl. + induction l; intros; simpl. constructor. destruct a as [id ty]. destruct (Mem.alloc m 0 (sizeof ge ty)) as [m1 b1] eqn:?; simpl. econstructor; eauto. @@ -1879,12 +1879,12 @@ Lemma do_alloc_variables_complete: forall e1 m1 l e2 m2, alloc_variables ge e1 m1 l e2 m2 -> do_alloc_variables e1 m1 l = (e2, m2). Proof. - induction 1; simpl. + induction 1; simpl. auto. - rewrite H; rewrite IHalloc_variables; auto. + rewrite H; rewrite IHalloc_variables; auto. Qed. -Function sem_bind_parameters (w: world) (e: env) (m: mem) (l: list (ident * type)) (lv: list val) +Function sem_bind_parameters (w: world) (e: env) (m: mem) (l: list (ident * type)) (lv: list val) {struct l} : option mem := match l, lv with | nil, nil => Some m @@ -1900,7 +1900,7 @@ Function sem_bind_parameters (w: world) (e: env) (m: mem) (l: list (ident * type end. Lemma sem_bind_parameters_sound : forall w e m l lv m', - sem_bind_parameters w e m l lv = Some m' -> + sem_bind_parameters w e m l lv = Some m' -> bind_parameters ge e m l lv m'. Proof. intros; functional induction (sem_bind_parameters w e m l lv); try discriminate. @@ -1916,7 +1916,7 @@ Proof. rewrite H. rewrite dec_eq_true. assert (possible_trace w E0 w) by constructor. rewrite (do_assign_loc_complete _ _ _ _ _ _ _ _ _ H0 H2). - simpl. auto. + simpl. auto. Qed. Inductive transition : Type := TR (rule: string) (t: trace) (S': state). @@ -1946,7 +1946,7 @@ Definition do_step (w: world) (s: state) : list transition := do b <- bool_val v ty m; ret "step_ifthenelse_2" (State f (if b then s1 else s2) k e m) | Kwhile1 x s k => - do b <- bool_val v ty m; + do b <- bool_val v ty m; if b then ret "step_while_true" (State f s (Kwhile2 x s k) e m) else ret "step_while_false" (State f Sskip k e m) @@ -2018,7 +2018,7 @@ Definition do_step (w: world) (s: state) : list transition := ret "step_return_0" (Returnstate Vundef (call_cont k) m') | State f (Sreturn (Some x)) k e m => ret "step_return_1" (ExprState f x (Kreturn k) e m) - | State f Sskip ((Kstop | Kcall _ _ _ _ _) as k) e m => + | State f Sskip ((Kstop | Kcall _ _ _ _ _) as k) e m => do m' <- Mem.free_list m (blocks_of_env ge e); ret "step_skip_call" (Returnstate Vundef k m') @@ -2057,10 +2057,10 @@ Definition do_step (w: world) (s: state) : list transition := Ltac myinv := match goal with | [ |- In _ nil -> _ ] => intro X; elim X - | [ |- In _ (ret _ _) -> _ ] => + | [ |- In _ (ret _ _) -> _ ] => intro X; elim X; clear X; [intro EQ; unfold ret in EQ; inv EQ; myinv | myinv] - | [ |- In _ (_ :: nil) -> _ ] => + | [ |- In _ (_ :: nil) -> _ ] => intro X; elim X; clear X; [intro EQ; inv EQ; myinv | myinv] | [ |- In _ (match ?x with Some _ => _ | None => _ end) -> _ ] => destruct x eqn:?; myinv | [ |- In _ (match ?x with false => _ | true => _ end) -> _ ] => destruct x eqn:?; myinv @@ -2096,7 +2096,7 @@ Proof with try (left; right; econstructor; eauto; fail). generalize (step_expr_sound e w r RV m). unfold reducts_ok. intros [P Q]. exploit P; eauto. intros [a' [k' [CTX [EQ RD]]]]. unfold expr_final_state in A. simpl in A. - destruct k'; destruct rd; inv A; simpl in RD; try contradiction. + destruct k'; destruct rd; inv A; simpl in RD; try contradiction. (* lred *) left; left; apply step_lred; auto. (* stuck lred *) @@ -2111,11 +2111,11 @@ Proof with try (left; right; econstructor; eauto; fail). destruct fd; myinv. (* internal *) destruct (do_alloc_variables empty_env m (fn_params f ++ fn_vars f)) as [e m1] eqn:?. - myinv. left; right; apply step_internal_function with m1. auto. - change e with (fst (e,m1)). change m1 with (snd (e,m1)) at 2. rewrite <- Heqp. + myinv. left; right; apply step_internal_function with m1. auto. + change e with (fst (e,m1)). change m1 with (snd (e,m1)) at 2. rewrite <- Heqp. apply do_alloc_variables_sound. eapply sem_bind_parameters_sound; eauto. (* external *) - destruct p as [[[w' tr] v] m']. myinv. left; right; constructor. + destruct p as [[[w' tr] v] m']. myinv. left; right; constructor. eapply do_ef_external_sound; eauto. (* returnstate *) destruct k; myinv... @@ -2126,10 +2126,10 @@ Qed. Remark estep_not_val: forall f a k e m t S, estep ge (ExprState f a k e m) t S -> is_val a = None. Proof. - intros. + intros. assert (forall b from to C, context from to C -> (from = to /\ C = fun x => x) \/ is_val (C b) = None). - induction 1; simpl; auto. - inv H. + induction 1; simpl; auto. + inv H. destruct (H0 a0 _ _ _ H9) as [[A B] | A]. subst. inv H8; auto. auto. destruct (H0 a0 _ _ _ H9) as [[A B] | A]. subst. inv H8; auto. auto. destruct (H0 a0 _ _ _ H9) as [[A B] | A]. subst. inv H8; auto. auto. @@ -2141,7 +2141,7 @@ Theorem do_step_complete: possible_trace w t w' -> Csem.step ge S t S' -> exists rule, In (TR rule t S') (do_step w S). Proof with (unfold ret; eauto with coqlib). intros until w'; intros PT H. - destruct H. + destruct H. (* Expression step *) inversion H; subst; exploit estep_not_val; eauto; intro NOTVAL. (* lred *) @@ -2170,7 +2170,7 @@ Proof with (unfold ret; eauto with coqlib). change (TR rule E0 (Callstate fd vargs (Kcall f e C ty k) m)) with (expr_final_state f k e (C, Callred rule fd vargs ty m)). apply in_map. generalize (step_expr_context e w _ _ _ H1 a m). unfold reducts_incl. - intro. replace C with (fun x => C x). apply H2. + intro. replace C with (fun x => C x). apply H2. rewrite STEP; unfold topred; auto with coqlib. apply extensionality; auto. (* stuck *) @@ -2179,7 +2179,7 @@ Proof with (unfold ret; eauto with coqlib). simpl do_step. rewrite NOTVAL. exists "step_stuck". change (TR "step_stuck" E0 Stuckstate) with (expr_final_state f k e (C', Stuckred)). - apply in_map. auto. + apply in_map. auto. (* Statement step *) inv H; simpl; econstructor... diff --git a/cfrontend/Clight.v b/cfrontend/Clight.v index 77511b2c..8722da69 100644 --- a/cfrontend/Clight.v +++ b/cfrontend/Clight.v @@ -325,7 +325,7 @@ Fixpoint bind_parameter_temps (formals: list (ident * type)) (args: list val) | nil, nil => Some le | (id, t) :: xl, v :: vl => bind_parameter_temps xl vl (PTree.set id v le) | _, _ => None - end. + end. (** Return the list of blocks in the codomain of [e], with low and high bounds. *) @@ -419,7 +419,7 @@ Inductive eval_expr: expr -> val -> Prop := | eval_Ealignof: forall ty1 ty, eval_expr (Ealignof ty1 ty) (Vint (Int.repr (alignof ge ty1))) | eval_Elvalue: forall a loc ofs v, - eval_lvalue a loc ofs -> + eval_lvalue a loc ofs -> deref_loc (typeof a) m loc ofs v -> eval_expr a v @@ -523,11 +523,11 @@ Inductive state: Type := (res: val) (k: cont) (m: mem) : state. - -(** Find the statement and manufacture the continuation + +(** Find the statement and manufacture the continuation corresponding to a label *) -Fixpoint find_label (lbl: label) (s: statement) (k: cont) +Fixpoint find_label (lbl: label) (s: statement) (k: cont) {struct s}: option (statement * cont) := match s with | Ssequence s1 s2 => @@ -552,7 +552,7 @@ Fixpoint find_label (lbl: label) (s: statement) (k: cont) | _ => None end -with find_label_ls (lbl: label) (sl: labeled_statements) (k: cont) +with find_label_ls (lbl: label) (sl: labeled_statements) (k: cont) {struct sl}: option (statement * cont) := match sl with | LSnil => None @@ -646,7 +646,7 @@ Inductive step: state -> trace -> state -> Prop := step (State f (Sreturn None) k e le m) E0 (Returnstate Vundef (call_cont k) m') | step_return_1: forall f a k e le m v v' m', - eval_expr e le m a v -> + eval_expr e le m a v -> sem_cast v (typeof a) f.(fn_return) = Some v' -> Mem.free_list m (blocks_of_env e) = Some m' -> step (State f (Sreturn (Some a)) k e le m) @@ -764,10 +764,10 @@ Proof. intros. subst. inv H0. exists s1; auto. inversion H; subst; auto. (* builtin *) - exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. + exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. econstructor; econstructor; eauto. (* external *) - exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. + exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. exists (Returnstate vres2 k m2). econstructor; eauto. (* trace length *) red; simpl; intros. inv H; simpl; try omega. diff --git a/cfrontend/ClightBigstep.v b/cfrontend/ClightBigstep.v index ac8931e5..ee653d50 100644 --- a/cfrontend/ClightBigstep.v +++ b/cfrontend/ClightBigstep.v @@ -66,9 +66,9 @@ Definition outcome_result_value (out: outcome) (t: type) (v: val) : Prop := | Out_return None, Tvoid => v = Vundef | Out_return (Some (v',t')), ty => ty <> Tvoid /\ sem_cast v' t' t = Some v | _, _ => False - end. + end. -(** [exec_stmt ge e m1 s t m2 out] describes the execution of +(** [exec_stmt ge e m1 s t m2 out] describes the execution of the statement [s]. [out] is the outcome for this execution. [m1] is the initial memory state, [m2] the final memory state. [t] is the trace of input/output events performed during this @@ -88,7 +88,7 @@ Inductive exec_stmt: env -> temp_env -> mem -> statement -> trace -> temp_env -> | exec_Sset: forall e le m id a v, eval_expr ge e le m a v -> exec_stmt e le m (Sset id a) - E0 (PTree.set id v le) m Out_normal + E0 (PTree.set id v le) m Out_normal | exec_Scall: forall e le m optid a al tyargs tyres cconv vf vargs f t m' vres, classify_fun (typeof a) = fun_case_f tyargs tyres cconv -> eval_expr ge e le m a vf -> @@ -244,7 +244,7 @@ End BIGSTEP. Inductive bigstep_program_terminates (p: program): trace -> int -> Prop := | bigstep_program_terminates_intro: forall b f m0 m1 t r, - let ge := globalenv p in + let ge := globalenv p in Genv.init_mem p = Some m0 -> Genv.find_symbol ge p.(prog_main) = Some b -> Genv.find_funct_ptr ge b = Some f -> @@ -254,7 +254,7 @@ Inductive bigstep_program_terminates (p: program): trace -> int -> Prop := Inductive bigstep_program_diverges (p: program): traceinf -> Prop := | bigstep_program_diverges_intro: forall b f m0 t, - let ge := globalenv p in + let ge := globalenv p in Genv.init_mem p = Some m0 -> Genv.find_symbol ge p.(prog_main) = Some b -> Genv.find_funct_ptr ge b = Some f -> @@ -282,7 +282,7 @@ Inductive outcome_state_match outcome_state_match e le m f k Out_continue (State f Scontinue k e le m) | osm_return_none: forall k', call_cont k' = call_cont k -> - outcome_state_match e le m f k + outcome_state_match e le m f k (Out_return None) (State f (Sreturn None) k' e le m) | osm_return_some: forall a v k', call_cont k' = call_cont k -> @@ -322,7 +322,7 @@ Proof. (* call *) econstructor; split. - eapply star_left. econstructor; eauto. + eapply star_left. econstructor; eauto. eapply star_right. apply H5. simpl; auto. econstructor. reflexivity. traceEq. constructor. @@ -331,10 +331,10 @@ Proof. (* sequence 2 *) destruct (H0 f (Kseq s2 k)) as [S1 [A1 B1]]. inv B1. - destruct (H2 f k) as [S2 [A2 B2]]. + destruct (H2 f k) as [S2 [A2 B2]]. econstructor; split. eapply star_left. econstructor. - eapply star_trans. eexact A1. + eapply star_trans. eexact A1. eapply star_left. constructor. eexact A2. reflexivity. reflexivity. traceEq. auto. @@ -385,10 +385,10 @@ Proof. | _ => S1 end). exists S2; split. - eapply star_left. eapply step_loop. + eapply star_left. eapply step_loop. eapply star_trans. eexact A1. unfold S2. inversion H1; subst. - inv B1. apply star_one. constructor. + inv B1. apply star_one. constructor. apply star_refl. reflexivity. traceEq. unfold S2. inversion H1; subst. constructor. inv B1; econstructor; eauto. @@ -402,14 +402,14 @@ Proof. | _ => S2 end). exists S3; split. - eapply star_left. eapply step_loop. + eapply star_left. eapply step_loop. eapply star_trans. eexact A1. eapply star_left with (s2 := State f s2 (Kloop2 s1 s2 k) e le1 m1). inv H1; inv B1; constructor; auto. eapply star_trans. eexact A2. unfold S3. inversion H4; subst. inv B2. apply star_one. constructor. apply star_refl. - reflexivity. reflexivity. reflexivity. traceEq. + reflexivity. reflexivity. reflexivity. traceEq. unfold S3. inversion H4; subst. constructor. inv B2; econstructor; eauto. (* loop loop *) @@ -417,15 +417,15 @@ Proof. destruct (H3 f (Kloop2 s1 s2 k)) as [S2 [A2 B2]]. destruct (H5 f k) as [S3 [A3 B3]]. exists S3; split. - eapply star_left. eapply step_loop. + eapply star_left. eapply step_loop. eapply star_trans. eexact A1. eapply star_left with (s2 := State f s2 (Kloop2 s1 s2 k) e le1 m1). inv H1; inv B1; constructor; auto. eapply star_trans. eexact A2. eapply star_left with (s2 := State f (Sloop s1 s2) k e le2 m2). - inversion H4; subst; inv B2; constructor; auto. + inversion H4; subst; inv B2; constructor; auto. eexact A3. - reflexivity. reflexivity. reflexivity. reflexivity. traceEq. + reflexivity. reflexivity. reflexivity. reflexivity. traceEq. auto. (* switch *) @@ -438,12 +438,12 @@ Proof. | _ => S1 end). exists S2; split. - eapply star_left. eapply step_switch; eauto. - eapply star_trans. eexact A1. - unfold S2; inv B1. - apply star_one. constructor. auto. - apply star_one. constructor. auto. - apply star_one. constructor. + eapply star_left. eapply step_switch; eauto. + eapply star_trans. eexact A1. + unfold S2; inv B1. + apply star_one. constructor. auto. + apply star_one. constructor. auto. + apply star_one. constructor. apply star_refl. apply star_refl. reflexivity. traceEq. @@ -452,7 +452,7 @@ Proof. (* call internal *) destruct (H3 f k) as [S1 [A1 B1]]. eapply star_left. eapply step_internal_function; eauto. econstructor; eauto. - eapply star_right. eexact A1. + eapply star_right. eexact A1. inv B1; simpl in H4; try contradiction. (* Out_normal *) assert (fn_return f = Tvoid /\ vres = Vundef). @@ -471,7 +471,7 @@ Proof. reflexivity. traceEq. (* call external *) - apply star_one. apply step_external_function; auto. + apply star_one. apply step_external_function; auto. Qed. Lemma exec_stmt_steps: @@ -506,7 +506,7 @@ Proof. (* call *) eapply forever_N_plus. - apply plus_one. eapply step_call; eauto. + apply plus_one. eapply step_call; eauto. eapply CIH_FUN. eauto. traceEq. (* seq 1 *) @@ -517,25 +517,25 @@ Proof. destruct (exec_stmt_steps _ _ _ _ _ _ _ _ H0 f (Kseq s2 k)) as [S1 [A1 B1]]. inv B1. eapply forever_N_plus. - eapply plus_left. constructor. eapply star_trans. eexact A1. + eapply plus_left. constructor. eapply star_trans. eexact A1. apply star_one. constructor. reflexivity. reflexivity. apply CIH_STMT; eauto. traceEq. (* ifthenelse *) eapply forever_N_plus. - apply plus_one. eapply step_ifthenelse with (b := b); eauto. + apply plus_one. eapply step_ifthenelse with (b := b); eauto. apply CIH_STMT; eauto. traceEq. (* loop body 1 *) eapply forever_N_plus. - eapply plus_one. constructor. + eapply plus_one. constructor. apply CIH_STMT; eauto. traceEq. (* loop body 2 *) destruct (exec_stmt_steps _ _ _ _ _ _ _ _ H0 f (Kloop1 s1 s2 k)) as [S1 [A1 B1]]. eapply forever_N_plus with (s2 := State f s2 (Kloop2 s1 s2 k) e le1 m1). eapply plus_left. constructor. eapply star_right. eexact A1. - inv H1; inv B1; constructor; auto. + inv H1; inv B1; constructor; auto. reflexivity. reflexivity. apply CIH_STMT; eauto. traceEq. (* loop loop *) @@ -571,14 +571,14 @@ Proof. (* termination *) inv H. econstructor; econstructor. split. econstructor; eauto. - split. eapply eval_funcall_steps. eauto. red; auto. + split. eapply eval_funcall_steps. eauto. red; auto. econstructor. (* divergence *) inv H. econstructor. split. econstructor; eauto. eapply forever_N_forever with (order := order). red; intros. constructor; intros. red in H. elim H. - eapply evalinf_funcall_forever; eauto. + eapply evalinf_funcall_forever; eauto. Qed. End BIGSTEP_TO_TRANSITIONS. diff --git a/cfrontend/Cminorgen.v b/cfrontend/Cminorgen.v index 82509b04..c2b59fbe 100644 --- a/cfrontend/Cminorgen.v +++ b/cfrontend/Cminorgen.v @@ -37,7 +37,7 @@ Local Open Scope error_monad_scope. or assigning such a variable becomes a load or store operation at that address. Only scalar local variables whose address is never taken in the Csharpminor code can be mapped to Cminor local - variable, since the latter do not reside in memory. + variable, since the latter do not reside in memory. Another task performed during the translation to Cminor is to transform the Clight-like [switch] construct of Csharpminor @@ -220,7 +220,7 @@ with transl_lblstmt (cenv: compilenv) (xenv: exit_env) (ls: Csharpminor.lbl_stmt (** * Stack layout *) -(** Layout of the Cminor stack data block and construction of the +(** Layout of the Cminor stack data block and construction of the compilation environment. Every Csharpminor local variable is allocated a slot in the Cminor stack data. Sufficient padding is inserted to ensure adequate alignment of addresses. *) @@ -240,7 +240,7 @@ Definition assign_variable Definition assign_variables (cenv_stacksize: compilenv * Z) (vars: list (ident * Z)) : compilenv * Z := List.fold_left assign_variable vars cenv_stacksize. -(** Before allocating stack slots, we sort variables by increasing size +(** Before allocating stack slots, we sort variables by increasing size so as to minimize padding. *) Module VarOrder <: TotalLeBool. @@ -248,7 +248,7 @@ Module VarOrder <: TotalLeBool. Definition leb (v1 v2: t) : bool := zle (snd v1) (snd v2). Theorem leb_total: forall v1 v2, leb v1 v2 = true \/ leb v2 v1 = true. Proof. - unfold leb; intros. + unfold leb; intros. assert (snd v1 <= snd v2 \/ snd v2 <= snd v1) by omega. unfold proj_sumbool. destruct H; [left|right]; apply zle_true; auto. Qed. diff --git a/cfrontend/Cminorgenproof.v b/cfrontend/Cminorgenproof.v index dfc69412..7a5d882e 100644 --- a/cfrontend/Cminorgenproof.v +++ b/cfrontend/Cminorgenproof.v @@ -70,7 +70,7 @@ Proof (Genv.find_var_info_transf_partial transl_fundef _ TRANSL). Lemma sig_preserved_body: forall f tf cenv size, - transl_funbody cenv size f = OK tf -> + transl_funbody cenv size f = OK tf -> tf.(fn_sig) = Csharpminor.fn_sig f. Proof. intros. unfold transl_funbody in H. monadInv H; reflexivity. @@ -78,13 +78,13 @@ Qed. Lemma sig_preserved: forall f tf, - transl_fundef f = OK tf -> + transl_fundef f = OK tf -> Cminor.funsig tf = Csharpminor.funsig f. Proof. intros until tf; destruct f; simpl. unfold transl_function. destruct (build_compilenv f). case (zle z Int.max_unsigned); simpl bind; try congruence. - intros. monadInv H. simpl. eapply sig_preserved_body; eauto. + intros. monadInv H. simpl. eapply sig_preserved_body; eauto. intro. inv H. reflexivity. Qed. @@ -92,7 +92,7 @@ Qed. Lemma load_freelist: forall fbl chunk m b ofs m', - (forall b' lo hi, In (b', lo, hi) fbl -> b' <> b) -> + (forall b' lo hi, In (b', lo, hi) fbl -> b' <> b) -> Mem.free_list m fbl = Some m' -> Mem.load chunk m' b ofs = Mem.load chunk m b ofs. Proof. @@ -100,10 +100,10 @@ Proof. simpl in H0. congruence. destruct a as [[b' lo] hi]. generalize H0. simpl. case_eq (Mem.free m b' lo hi); try congruence. - intros m1 FR1 FRL. + intros m1 FR1 FRL. transitivity (Mem.load chunk m1 b ofs). - eapply IHfbl; eauto. intros. eapply H. eauto with coqlib. - eapply Mem.load_free; eauto. left. apply sym_not_equal. eapply H. auto with coqlib. + eapply IHfbl; eauto. intros. eapply H. eauto with coqlib. + eapply Mem.load_free; eauto. left. apply sym_not_equal. eapply H. auto with coqlib. Qed. Lemma perm_freelist: @@ -125,7 +125,7 @@ Lemma nextblock_freelist: Proof. induction fbl; intros until m'; simpl. congruence. - destruct a as [[b lo] hi]. + destruct a as [[b lo] hi]. case_eq (Mem.free m b lo hi); intros; try congruence. transitivity (Mem.nextblock m0). eauto. eapply Mem.nextblock_free; eauto. Qed. @@ -141,7 +141,7 @@ Proof. revert H. destruct a as [[b' lo'] hi']. caseEq (Mem.free m b' lo' hi'); try congruence. intros m1 FREE1 FREE2. - destruct H0. inv H. + destruct H0. inv H. eauto with mem. red; intros. eapply Mem.perm_free_3; eauto. exploit IHl; eauto. Qed. @@ -150,7 +150,7 @@ Lemma nextblock_storev: forall chunk m addr v m', Mem.storev chunk m addr v = Some m' -> Mem.nextblock m' = Mem.nextblock m. Proof. - unfold Mem.storev; intros. destruct addr; try discriminate. + unfold Mem.storev; intros. destruct addr; try discriminate. eapply Mem.nextblock_store; eauto. Qed. @@ -159,7 +159,7 @@ Qed. (** In C#minor, every variable is stored in a separate memory block. In the corresponding Cminor code, these variables become sub-blocks of the stack data block. We capture these changes in memory via a - memory injection [f]: + memory injection [f]: [f b = Some(b', ofs)] means that C#minor block [b] corresponds to a sub-block of Cminor block [b] at offset [ofs]. @@ -239,7 +239,7 @@ Record match_env (f: meminj) (cenv: compilenv) f b = Some(tb, delta) -> Plt b lo -> Plt tb sp }. -Ltac geninv x := +Ltac geninv x := let H := fresh in (generalize x; intro H; inv H). Lemma match_env_invariant: @@ -254,7 +254,7 @@ Proof. (* vars *) intros. geninv (me_vars0 id); econstructor; eauto. (* bounded *) - intros. eauto. + intros. eauto. (* below *) intros. rewrite H2 in H; eauto. Qed. @@ -267,7 +267,7 @@ Remark inject_incr_separated_same: forall b, Mem.valid_block m1 b -> f2 b = f1 b. Proof. intros. case_eq (f1 b). - intros [b' delta] EQ. apply H; auto. + intros [b' delta] EQ. apply H; auto. intros EQ. case_eq (f2 b). intros [b'1 delta1] EQ1. exploit H0; eauto. intros [C D]. contradiction. auto. @@ -294,7 +294,7 @@ Lemma match_env_external_call: Proof. intros. apply match_env_invariant with f1; auto. intros. eapply inject_incr_separated_same'; eauto. - intros. eapply inject_incr_separated_same; eauto. red. destruct H. xomega. + intros. eapply inject_incr_separated_same; eauto. red. destruct H. xomega. Qed. (** [match_env] and allocations *) @@ -317,7 +317,7 @@ Proof. (* vars *) intros. rewrite PTree.gsspec. destruct (peq id0 id). (* the new var *) - subst id0. rewrite CENV. constructor. econstructor. eauto. + subst id0. rewrite CENV. constructor. econstructor. eauto. rewrite Int.add_commut; rewrite Int.add_zero; auto. (* old vars *) generalize (me_vars0 id0). rewrite PTree.gro; auto. intros M; inv M. @@ -331,8 +331,8 @@ Proof. exploit me_bounded0; eauto. rewrite NEXTBLOCK; xomega. (* inv *) intros. destruct (eq_block b (Mem.nextblock m1)). - subst b. rewrite SAME in H; inv H. exists id; exists sz. apply PTree.gss. - rewrite OTHER in H; auto. exploit me_inv0; eauto. + subst b. rewrite SAME in H; inv H. exists id; exists sz. apply PTree.gss. + rewrite OTHER in H; auto. exploit me_inv0; eauto. intros [id1 [sz1 EQ]]. exists id1; exists sz1. rewrite PTree.gso; auto. congruence. (* incr *) intros. rewrite OTHER in H. eauto. unfold block in *; xomega. @@ -351,7 +351,7 @@ Lemma match_bounds_invariant: PTree.get id e = Some(b, sz) -> Mem.perm m2 b ofs Max p -> Mem.perm m1 b ofs Max p) -> match_bounds e m2. Proof. - intros; red; intros. eapply H; eauto. + intros; red; intros. eapply H; eauto. Qed. (** ** Permissions on the Cminor stack block *) @@ -367,7 +367,7 @@ Inductive is_reachable_from_env (f: meminj) (e: Csharpminor.env) (sp: block) (of is_reachable_from_env f e sp ofs. Definition padding_freeable (f: meminj) (e: Csharpminor.env) (tm: mem) (sp: block) (sz: Z) : Prop := - forall ofs, + forall ofs, 0 <= ofs < sz -> Mem.perm tm sp ofs Cur Freeable \/ is_reachable_from_env f e sp ofs. Lemma padding_freeable_invariant: @@ -382,7 +382,7 @@ Proof. exploit H; eauto. intros [A | A]. left; auto. right. inv A. exploit me_bounded; eauto. intros [D E]. - econstructor; eauto. rewrite H2; auto. + econstructor; eauto. rewrite H2; auto. Qed. (** Decidability of the [is_reachable_from_env] predicate. *) @@ -390,7 +390,7 @@ Qed. Lemma is_reachable_from_env_dec: forall f e sp ofs, is_reachable_from_env f e sp ofs \/ ~is_reachable_from_env f e sp ofs. Proof. - intros. + intros. set (pred := fun id_b_sz : ident * (block * Z) => match id_b_sz with | (id, (b, sz)) => @@ -404,22 +404,22 @@ Proof. end). destruct (List.existsb pred (PTree.elements e)) eqn:?. (* yes *) - rewrite List.existsb_exists in Heqb. + rewrite List.existsb_exists in Heqb. destruct Heqb as [[id [b sz]] [A B]]. simpl in B. destruct (f b) as [[sp' delta] |] eqn:?; try discriminate. destruct (eq_block sp sp'); try discriminate. destruct (andb_prop _ _ B). left. apply is_reachable_intro with id b sz delta. - apply PTree.elements_complete; auto. + apply PTree.elements_complete; auto. congruence. split; eapply proj_sumbool_true; eauto. (* no *) - right; red; intro NE; inv NE. + right; red; intro NE; inv NE. assert (existsb pred (PTree.elements e) = true). rewrite List.existsb_exists. exists (id, (b, sz)); split. - apply PTree.elements_correct; auto. + apply PTree.elements_correct; auto. simpl. rewrite H0. rewrite dec_eq_true. - unfold proj_sumbool. destruct H1. rewrite zle_true; auto. rewrite zlt_true; auto. + unfold proj_sumbool. destruct H1. rewrite zle_true; auto. rewrite zlt_true; auto. congruence. Qed. @@ -443,8 +443,8 @@ Remark inj_preserves_globals: Proof. intros. inv H. split. intros. apply DOMAIN. eapply SYMBOLS. eauto. - split. intros. apply DOMAIN. eapply VARINFOS. eauto. - intros. symmetry. eapply IMAGE; eauto. + split. intros. apply DOMAIN. eapply VARINFOS. eauto. + intros. symmetry. eapply IMAGE; eauto. Qed. (** * Invariant on abstract call stacks *) @@ -481,7 +481,7 @@ Inductive match_callstack (f: meminj) (m: mem) (tm: mem): forall hi bound tbound, match_globalenvs f hi -> Ple hi bound -> Ple hi tbound -> - match_callstack f m tm nil bound tbound + match_callstack f m tm nil bound tbound | mcs_cons: forall cenv tf e le te sp lo hi cs bound tbound (BOUND: Ple hi bound) @@ -524,16 +524,16 @@ Proof. assert (Ple lo hi) by (eapply me_low_high; eauto). econstructor; eauto. eapply match_temps_invariant; eauto. - eapply match_env_invariant; eauto. + eapply match_env_invariant; eauto. intros. apply H3. xomega. eapply match_bounds_invariant; eauto. - intros. eapply H1; eauto. - exploit me_bounded; eauto. xomega. - eapply padding_freeable_invariant; eauto. - intros. apply H3. xomega. - eapply IHmatch_callstack; eauto. - intros. eapply H1; eauto. xomega. - intros. eapply H2; eauto. xomega. + intros. eapply H1; eauto. + exploit me_bounded; eauto. xomega. + eapply padding_freeable_invariant; eauto. + intros. apply H3. xomega. + eapply IHmatch_callstack; eauto. + intros. eapply H1; eauto. xomega. + intros. eapply H2; eauto. xomega. intros. eapply H3; eauto. xomega. intros. eapply H4; eauto. xomega. Qed. @@ -545,7 +545,7 @@ Lemma match_callstack_incr_bound: match_callstack f m tm cs bound' tbound'. Proof. intros. inv H. - econstructor; eauto. xomega. xomega. + econstructor; eauto. xomega. xomega. constructor; auto. xomega. xomega. Qed. @@ -558,7 +558,7 @@ Lemma match_callstack_set_temp: match_callstack f m tm (Frame cenv tf e (PTree.set id v le) (PTree.set id tv te) sp lo hi :: cs) bound tbound. Proof. intros. inv H0. constructor; auto. - eapply match_temps_assign; eauto. + eapply match_temps_assign; eauto. Qed. (** Preservation of [match_callstack] by freeing all blocks allocated @@ -569,7 +569,7 @@ Lemma in_blocks_of_env: forall e id b sz, e!id = Some(b, sz) -> In (b, 0, sz) (blocks_of_env e). Proof. - unfold blocks_of_env; intros. + unfold blocks_of_env; intros. change (b, 0, sz) with (block_of_binding (id, (b, sz))). apply List.in_map. apply PTree.elements_correct. auto. Qed. @@ -579,9 +579,9 @@ Lemma in_blocks_of_env_inv: In (b, lo, hi) (blocks_of_env e) -> exists id, e!id = Some(b, hi) /\ lo = 0. Proof. - unfold blocks_of_env; intros. + unfold blocks_of_env; intros. exploit list_in_map_inv; eauto. intros [[id [b' sz]] [A B]]. - unfold block_of_binding in A. inv A. + unfold block_of_binding in A. inv A. exists id; intuition. apply PTree.elements_complete. auto. Qed. @@ -601,10 +601,10 @@ Proof. red; intros. exploit PERM; eauto. intros [A | A]. auto. - inv A. assert (Mem.range_perm m b 0 sz Cur Freeable). + inv A. assert (Mem.range_perm m b 0 sz Cur Freeable). eapply free_list_freeable; eauto. eapply in_blocks_of_env; eauto. - replace ofs with ((ofs - delta) + delta) by omega. - eapply Mem.perm_inject; eauto. apply H3. omega. + replace ofs with ((ofs - delta) + delta) by omega. + eapply Mem.perm_inject; eauto. apply H3. omega. destruct X as [tm' FREE]. exploit nextblock_freelist; eauto. intro NEXT. exploit Mem.nextblock_free; eauto. intro NEXT'. @@ -615,10 +615,10 @@ Proof. intros. eapply perm_freelist; eauto. intros. eapply Mem.perm_free_1; eauto. left; unfold block; xomega. xomega. xomega. eapply Mem.free_inject; eauto. - intros. exploit me_inv0; eauto. intros [id [sz A]]. + intros. exploit me_inv0; eauto. intros [id [sz A]]. exists 0; exists sz; split. eapply in_blocks_of_env; eauto. - eapply BOUND0; eauto. eapply Mem.perm_max. eauto. + eapply BOUND0; eauto. eapply Mem.perm_max. eauto. Qed. (** Preservation of [match_callstack] by external calls. *) @@ -635,33 +635,33 @@ Lemma match_callstack_external_call: Ple bound (Mem.nextblock m1) -> Ple tbound (Mem.nextblock m1') -> match_callstack f2 m2 m2' cs bound tbound. Proof. - intros until m2'. + intros until m2'. intros UNMAPPED OUTOFREACH INCR SEPARATED MAXPERMS. induction 1; intros. (* base case *) apply mcs_nil with hi; auto. inv H. constructor; auto. - intros. case_eq (f1 b1). - intros [b2' delta'] EQ. rewrite (INCR _ _ _ EQ) in H. inv H. eauto. - intro EQ. exploit SEPARATED; eauto. intros [A B]. elim B. red. xomega. + intros. case_eq (f1 b1). + intros [b2' delta'] EQ. rewrite (INCR _ _ _ EQ) in H. inv H. eauto. + intro EQ. exploit SEPARATED; eauto. intros [A B]. elim B. red. xomega. (* inductive case *) - constructor. auto. auto. + constructor. auto. auto. eapply match_temps_invariant; eauto. - eapply match_env_invariant; eauto. - red in SEPARATED. intros. destruct (f1 b) as [[b' delta']|] eqn:?. + eapply match_env_invariant; eauto. + red in SEPARATED. intros. destruct (f1 b) as [[b' delta']|] eqn:?. exploit INCR; eauto. congruence. - exploit SEPARATED; eauto. intros [A B]. elim B. red. xomega. + exploit SEPARATED; eauto. intros [A B]. elim B. red. xomega. intros. assert (Ple lo hi) by (eapply me_low_high; eauto). - destruct (f1 b) as [[b' delta']|] eqn:?. - apply INCR; auto. + destruct (f1 b) as [[b' delta']|] eqn:?. + apply INCR; auto. destruct (f2 b) as [[b' delta']|] eqn:?; auto. exploit SEPARATED; eauto. intros [A B]. elim A. red. xomega. - eapply match_bounds_invariant; eauto. - intros. eapply MAXPERMS; eauto. red. exploit me_bounded; eauto. xomega. + eapply match_bounds_invariant; eauto. + intros. eapply MAXPERMS; eauto. red. exploit me_bounded; eauto. xomega. (* padding-freeable *) red; intros. destruct (is_reachable_from_env_dec f1 e sp ofs). - inv H3. right. apply is_reachable_intro with id b sz delta; auto. + inv H3. right. apply is_reachable_intro with id b sz delta; auto. exploit PERM; eauto. intros [A|A]; try contradiction. left. eapply Mem.perm_unchanged_on; eauto. red; intros; red; intros. elim H3. @@ -698,10 +698,10 @@ Proof. xomega. rewrite PTree.gempty in H4; discriminate. eelim Mem.fresh_block_alloc; eauto. eapply Mem.valid_block_inject_2; eauto. - rewrite RES. change (Mem.valid_block tm tb). eapply Mem.valid_block_inject_2; eauto. + rewrite RES. change (Mem.valid_block tm tb). eapply Mem.valid_block_inject_2; eauto. red; intros. rewrite PTree.gempty in H4. discriminate. - red; intros. left. eapply Mem.perm_alloc_2; eauto. - eapply match_callstack_invariant with (tm1 := tm); eauto. + red; intros. left. eapply Mem.perm_alloc_2; eauto. + eapply match_callstack_invariant with (tm1 := tm); eauto. rewrite RES; auto. intros. eapply Mem.perm_alloc_1; eauto. Qed. @@ -721,10 +721,10 @@ Lemma match_callstack_alloc_left: (Frame cenv tf (PTree.set id (b, sz) e) le te sp lo (Mem.nextblock m2) :: cs) (Mem.nextblock m2) (Mem.nextblock tm). Proof. - intros. inv H. + intros. inv H. exploit Mem.nextblock_alloc; eauto. intros NEXTBLOCK. exploit Mem.alloc_result; eauto. intros RES. - assert (LO: Ple lo (Mem.nextblock m1)) by (eapply me_low_high; eauto). + assert (LO: Ple lo (Mem.nextblock m1)) by (eapply me_low_high; eauto). constructor. xomega. auto. @@ -732,17 +732,17 @@ Proof. eapply match_env_alloc; eauto. red; intros. rewrite PTree.gsspec in H. destruct (peq id0 id). inversion H. subst b0 sz0 id0. eapply Mem.perm_alloc_3; eauto. - eapply BOUND0; eauto. eapply Mem.perm_alloc_4; eauto. + eapply BOUND0; eauto. eapply Mem.perm_alloc_4; eauto. exploit me_bounded; eauto. unfold block in *; xomega. - red; intros. exploit PERM; eauto. intros [A|A]. auto. right. + red; intros. exploit PERM; eauto. intros [A|A]. auto. right. inv A. apply is_reachable_intro with id0 b0 sz0 delta; auto. rewrite PTree.gso. auto. congruence. - eapply match_callstack_invariant with (m1 := m1); eauto. + eapply match_callstack_invariant with (m1 := m1); eauto. intros. eapply Mem.perm_alloc_4; eauto. unfold block in *; xomega. intros. apply H4. unfold block in *; xomega. - intros. destruct (eq_block b0 b). - subst b0. rewrite H3 in H. inv H. xomegaContradiction. + intros. destruct (eq_block b0 b). + subst b0. rewrite H3 in H. inv H. xomegaContradiction. rewrite H4 in H; auto. Qed. @@ -761,8 +761,8 @@ Remark cenv_remove_gso: Proof. induction vars; simpl; intros. auto. - rewrite PTree.gro. apply IHvars. intuition. intuition. -Qed. + rewrite PTree.gro. apply IHvars. intuition. intuition. +Qed. Remark cenv_remove_gss: forall id vars cenv, @@ -778,8 +778,8 @@ Qed. Definition cenv_compat (cenv: compilenv) (vars: list (ident * Z)) (tsz: Z) : Prop := forall id sz, In (id, sz) vars -> - exists ofs, - PTree.get id cenv = Some ofs + exists ofs, + PTree.get id cenv = Some ofs /\ Mem.inj_offset_aligned ofs sz /\ 0 <= ofs /\ ofs + Zmax 0 sz <= tsz. @@ -794,7 +794,7 @@ Definition cenv_separated (cenv: compilenv) (vars: list (ident * Z)) : Prop := Definition cenv_mem_separated (cenv: compilenv) (vars: list (ident * Z)) (f: meminj) (sp: block) (m: mem) : Prop := forall id sz ofs b delta ofs' k p, In (id, sz) vars -> PTree.get id cenv = Some ofs -> - f b = Some (sp, delta) -> + f b = Some (sp, delta) -> Mem.perm m b ofs' k p -> ofs <= ofs' + delta < sz + ofs -> False. @@ -825,36 +825,36 @@ Proof. intros until cs; intros VALID REPRES STKSIZE STKPERMS. induction 1; intros f1 NOREPET COMPAT SEP1 SEP2 UNBOUND MCS MINJ. (* base case *) - simpl in MCS. exists f1; auto. + simpl in MCS. exists f1; auto. (* inductive case *) simpl in NOREPET. inv NOREPET. (* exploit Mem.alloc_result; eauto. intros RES. exploit Mem.nextblock_alloc; eauto. intros NB.*) exploit (COMPAT id sz). auto with coqlib. intros [ofs [CENV [ALIGNED [LOB HIB]]]]. - exploit Mem.alloc_left_mapped_inject. + exploit Mem.alloc_left_mapped_inject. eexact MINJ. eexact H. eexact VALID. - instantiate (1 := ofs). zify. omega. - intros. exploit STKSIZE; eauto. omega. + instantiate (1 := ofs). zify. omega. + intros. exploit STKSIZE; eauto. omega. intros. apply STKPERMS. zify. omega. replace (sz - 0) with sz by omega. auto. - intros. eapply SEP2. eauto with coqlib. eexact CENV. eauto. eauto. omega. + intros. eapply SEP2. eauto with coqlib. eexact CENV. eauto. eauto. omega. intros [f2 [A [B [C D]]]]. exploit (IHalloc_variables f2); eauto. red; intros. eapply COMPAT. auto with coqlib. red; intros. eapply SEP1; eauto with coqlib. red; intros. exploit Mem.perm_alloc_inv; eauto. destruct (eq_block b b1); intros P. - subst b. rewrite C in H5; inv H5. - exploit SEP1. eapply in_eq. eapply in_cons; eauto. eauto. eauto. - red; intros; subst id0. elim H3. change id with (fst (id, sz0)). apply in_map; auto. + subst b. rewrite C in H5; inv H5. + exploit SEP1. eapply in_eq. eapply in_cons; eauto. eauto. eauto. + red; intros; subst id0. elim H3. change id with (fst (id, sz0)). apply in_map; auto. omega. - eapply SEP2. apply in_cons; eauto. eauto. - rewrite D in H5; eauto. eauto. auto. - intros. rewrite PTree.gso. eapply UNBOUND; eauto with coqlib. + eapply SEP2. apply in_cons; eauto. eauto. + rewrite D in H5; eauto. eauto. auto. + intros. rewrite PTree.gso. eapply UNBOUND; eauto with coqlib. red; intros; subst id0. elim H3. change id with (fst (id, sz0)). apply in_map; auto. - eapply match_callstack_alloc_left; eauto. - rewrite cenv_remove_gso; auto. + eapply match_callstack_alloc_left; eauto. + rewrite cenv_remove_gso; auto. apply UNBOUND with sz; auto with coqlib. Qed. @@ -881,14 +881,14 @@ Proof. intros. eapply Mem.perm_alloc_3; eauto. intros. apply Mem.perm_implies with Freeable; auto with mem. eapply Mem.perm_alloc_2; eauto. instantiate (1 := f1). red; intros. eelim Mem.fresh_block_alloc; eauto. - eapply Mem.valid_block_inject_2; eauto. + eapply Mem.valid_block_inject_2; eauto. intros. apply PTree.gempty. - eapply match_callstack_alloc_right; eauto. + eapply match_callstack_alloc_right; eauto. intros. destruct (In_dec peq id (map fst vars)). apply cenv_remove_gss; auto. rewrite cenv_remove_gso; auto. - destruct (cenv!id) as [ofs|] eqn:?; auto. elim n; eauto. - eapply Mem.alloc_right_inject; eauto. + destruct (cenv!id) as [ofs|] eqn:?; auto. elim n; eauto. + eapply Mem.alloc_right_inject; eauto. Qed. (** Properties of the compilation environment produced by [build_compilenv] *) @@ -896,8 +896,8 @@ Qed. Remark block_alignment_pos: forall sz, block_alignment sz > 0. Proof. - unfold block_alignment; intros. - destruct (zlt sz 2). omega. + unfold block_alignment; intros. + destruct (zlt sz 2). omega. destruct (zlt sz 4). omega. destruct (zlt sz 8); omega. Qed. @@ -906,7 +906,7 @@ Remark assign_variable_incr: forall id sz cenv stksz cenv' stksz', assign_variable (cenv, stksz) (id, sz) = (cenv', stksz') -> stksz <= stksz'. Proof. - simpl; intros. inv H. + simpl; intros. inv H. generalize (align_le stksz (block_alignment sz) (block_alignment_pos sz)). assert (0 <= Zmax 0 sz). apply Zmax_bound_l. omega. omega. @@ -920,7 +920,7 @@ Proof. simpl; intros. inv H. omega. Opaque assign_variable. destruct a as [id s]. simpl. intros. - destruct (assign_variable (cenv, sz) (id, s)) as [cenv1 sz1] eqn:?. + destruct (assign_variable (cenv, sz) (id, s)) as [cenv1 sz1] eqn:?. apply Zle_trans with sz1. eapply assign_variable_incr; eauto. eauto. Transparent assign_variable. Qed. @@ -951,9 +951,9 @@ Remark inj_offset_aligned_block': forall stacksize sz, Mem.inj_offset_aligned (align stacksize (block_alignment sz)) (Zmax 0 sz). Proof. - intros. + intros. replace (block_alignment sz) with (block_alignment (Zmax 0 sz)). - apply inj_offset_aligned_block. + apply inj_offset_aligned_block. rewrite Zmax_spec. destruct (zlt sz 0); auto. transitivity 1. reflexivity. unfold block_alignment. rewrite zlt_true. auto. omega. Qed. @@ -974,31 +974,31 @@ Proof. assert (EITHER: forall id' sz', In (id', sz') (vars ++ (id, sz) :: nil) -> In (id', sz') vars /\ id' <> id \/ (id', sz') = (id, sz)). - intros. rewrite in_app in H. destruct H. - left; split; auto. red; intros; subst id'. elim NOREPET. + intros. rewrite in_app in H. destruct H. + left; split; auto. red; intros; subst id'. elim NOREPET. change id with (fst (id, sz')). apply in_map; auto. simpl in H. destruct H. auto. contradiction. split; red; intros. apply EITHER in H. destruct H as [[P Q] | P]. - exploit COMPAT; eauto. intros [ofs [A [B [C D]]]]. + exploit COMPAT; eauto. intros [ofs [A [B [C D]]]]. exists ofs. split. rewrite PTree.gso; auto. - split. auto. split. auto. zify; omega. + split. auto. split. auto. zify; omega. inv P. exists (align sz1 (block_alignment sz)). split. apply PTree.gss. split. apply inj_offset_aligned_block. - split. omega. + split. omega. omega. apply EITHER in H; apply EITHER in H0. destruct H as [[P Q] | P]; destruct H0 as [[R S] | R]. - rewrite PTree.gso in *; auto. eapply SEP; eauto. + rewrite PTree.gso in *; auto. eapply SEP; eauto. inv R. rewrite PTree.gso in H1; auto. rewrite PTree.gss in H2; inv H2. - exploit COMPAT; eauto. intros [ofs [A [B [C D]]]]. - assert (ofs = ofs1) by congruence. subst ofs. - left. zify; omega. + exploit COMPAT; eauto. intros [ofs [A [B [C D]]]]. + assert (ofs = ofs1) by congruence. subst ofs. + left. zify; omega. inv P. rewrite PTree.gso in H2; auto. rewrite PTree.gss in H1; inv H1. - exploit COMPAT; eauto. intros [ofs [A [B [C D]]]]. - assert (ofs = ofs2) by congruence. subst ofs. + exploit COMPAT; eauto. intros [ofs [A [B [C D]]]]. + assert (ofs = ofs2) by congruence. subst ofs. right. zify; omega. congruence. Qed. @@ -1026,13 +1026,13 @@ Proof. exploit IHvars'. eauto. instantiate (1 := vars ++ ((id, sz) :: nil)). - rewrite list_norepet_app. split. auto. - split. rewrite map_app. apply list_norepet_append_commut. simpl. constructor; auto. - rewrite map_app. simpl. red; intros. rewrite in_app in H4. destruct H4. + rewrite list_norepet_app. split. auto. + split. rewrite map_app. apply list_norepet_append_commut. simpl. constructor; auto. + rewrite map_app. simpl. red; intros. rewrite in_app in H4. destruct H4. eauto. simpl in H4. destruct H4. subst y. red; intros; subst x. tauto. tauto. generalize (assign_variable_incr _ _ _ _ _ _ Heqp). omega. auto. auto. - rewrite app_ass. auto. + rewrite app_ass. auto. Qed. Remark permutation_norepet: @@ -1051,7 +1051,7 @@ Lemma build_compilenv_sound: list_norepet (map fst (Csharpminor.fn_vars f)) -> cenv_compat cenv (Csharpminor.fn_vars f) sz /\ cenv_separated cenv (Csharpminor.fn_vars f). Proof. - unfold build_compilenv; intros. + unfold build_compilenv; intros. set (vars1 := Csharpminor.fn_vars f) in *. generalize (VarSort.Permuted_sort vars1). intros P. set (vars2 := VarSort.sort vars1) in *. @@ -1061,11 +1061,11 @@ Proof. eexact H. simpl. rewrite app_nil_r. apply permutation_norepet with (map fst vars1); auto. apply Permutation_map. auto. - omega. + omega. red; intros. contradiction. red; intros. contradiction. destruct H1 as [A B]. split. - red; intros. apply A. apply Permutation_in with vars1; auto. + red; intros. apply A. apply Permutation_in with vars1; auto. red; intros. eapply B; eauto; apply Permutation_in with vars1; auto. Qed. @@ -1077,7 +1077,7 @@ Proof. induction vars; simpl; intros. auto. exploit IHvars; eauto. unfold assign_variable. destruct a as [id1 sz1]. - destruct cesz as [cenv stksz]. simpl. + destruct cesz as [cenv stksz]. simpl. rewrite PTree.gsspec. destruct (peq id id1). auto. tauto. Qed. @@ -1086,12 +1086,12 @@ Lemma build_compilenv_domain: build_compilenv f = (cenv, sz) -> cenv!id = Some ofs -> In id (map fst (Csharpminor.fn_vars f)). Proof. - unfold build_compilenv; intros. + unfold build_compilenv; intros. set (vars1 := Csharpminor.fn_vars f) in *. generalize (VarSort.Permuted_sort vars1). intros P. set (vars2 := VarSort.sort vars1) in *. generalize (assign_variables_domain id vars2 (PTree.empty Z, 0)). - rewrite H. simpl. intros. destruct H1. congruence. + rewrite H. simpl. intros. destruct H1. congruence. rewrite PTree.gempty in H1. congruence. apply Permutation_in with (map fst vars2); auto. apply Permutation_map. apply Permutation_sym; auto. @@ -1106,7 +1106,7 @@ Proof. rewrite PTree.gempty in H. congruence. rewrite PTree.gsspec in H. destruct (peq id a). split. auto. congruence. - exploit IHtemps; eauto. tauto. + exploit IHtemps; eauto. tauto. Qed. Fixpoint set_params' (vl: list val) (il: list ident) (te: Cminor.env) : Cminor.env := @@ -1125,10 +1125,10 @@ Lemma bind_parameters_agree_rec: Proof. Opaque PTree.set. induction vars; simpl; intros. - destruct vals; try discriminate. inv H. auto. + destruct vals; try discriminate. inv H. auto. destruct vals; try discriminate. inv H0. simpl. eapply IHvars; eauto. - red; intros. rewrite PTree.gsspec in *. destruct (peq id a). + red; intros. rewrite PTree.gsspec in *. destruct (peq id a). inv H0. exists v'; auto. apply H1; auto. Qed. @@ -1136,7 +1136,7 @@ Qed. Lemma set_params'_outside: forall id il vl te, ~In id il -> (set_params' vl il te)!id = te!id. Proof. - induction il; simpl; intros. auto. + induction il; simpl; intros. auto. destruct vl; rewrite IHil. apply PTree.gso. intuition. intuition. apply PTree.gso. intuition. intuition. @@ -1161,17 +1161,17 @@ Lemma set_params_set_params': Proof. induction il; simpl; intros. auto. - inv H. destruct vl. - rewrite PTree.gsspec. destruct (peq id a). + inv H. destruct vl. + rewrite PTree.gsspec. destruct (peq id a). subst a. rewrite set_params'_outside; auto. rewrite PTree.gss; auto. rewrite IHil; auto. destruct (List.in_dec peq id il). apply set_params'_inside; auto. - repeat rewrite set_params'_outside; auto. rewrite PTree.gso; auto. - rewrite PTree.gsspec. destruct (peq id a). + repeat rewrite set_params'_outside; auto. rewrite PTree.gso; auto. + rewrite PTree.gsspec. destruct (peq id a). subst a. rewrite set_params'_outside; auto. rewrite PTree.gss; auto. rewrite IHil; auto. destruct (List.in_dec peq id il). apply set_params'_inside; auto. - repeat rewrite set_params'_outside; auto. rewrite PTree.gso; auto. + repeat rewrite set_params'_outside; auto. rewrite PTree.gso; auto. Qed. Lemma set_locals_outside: @@ -1180,7 +1180,7 @@ Lemma set_locals_outside: Proof. induction il; simpl; intros. auto. - rewrite PTree.gso. apply IHil. tauto. intuition. + rewrite PTree.gso. apply IHil. tauto. intuition. Qed. Lemma set_locals_inside: @@ -1189,8 +1189,8 @@ Lemma set_locals_inside: Proof. induction il; simpl; intros. contradiction. - destruct H. subst a. apply PTree.gss. - rewrite PTree.gsspec. destruct (peq id a). auto. auto. + destruct H. subst a. apply PTree.gss. + rewrite PTree.gsspec. destruct (peq id a). auto. auto. Qed. Lemma set_locals_set_params': @@ -1203,11 +1203,11 @@ Proof. intros. destruct (in_dec peq id vars). assert (~In id params). apply list_disjoint_notin with vars; auto. apply list_disjoint_sym; auto. rewrite set_locals_inside; auto. rewrite set_params'_outside; auto. rewrite set_locals_inside; auto. - rewrite set_locals_outside; auto. rewrite set_params_set_params'; auto. - destruct (in_dec peq id params). + rewrite set_locals_outside; auto. rewrite set_params_set_params'; auto. + destruct (in_dec peq id params). apply set_params'_inside; auto. - repeat rewrite set_params'_outside; auto. - rewrite set_locals_outside; auto. + repeat rewrite set_params'_outside; auto. + rewrite set_locals_outside; auto. Qed. Lemma bind_parameters_agree: @@ -1253,7 +1253,7 @@ Proof. exploit build_compilenv_sound; eauto. intros [C1 C2]. eapply match_callstack_alloc_variables; eauto. intros. eapply build_compilenv_domain; eauto. - eapply bind_parameters_agree; eauto. + eapply bind_parameters_agree; eauto. Qed. (** * Compatibility of evaluation functions with respect to memory injections. *) @@ -1348,18 +1348,18 @@ Proof. inv H; inv H0; inv H1; TrivialExists. apply Int.sub_add_l. simpl. destruct (eq_block b1 b0); auto. - subst b1. rewrite H in H0; inv H0. + subst b1. rewrite H in H0; inv H0. rewrite dec_eq_true. rewrite Int.sub_shifted. auto. inv H; inv H0; inv H1; TrivialExists. - inv H0; try discriminate; inv H1; try discriminate. simpl in *. + inv H0; try discriminate; inv H1; try discriminate. simpl in *. destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H; TrivialExists. - inv H0; try discriminate; inv H1; try discriminate. simpl in *. + inv H0; try discriminate; inv H1; try discriminate. simpl in *. destruct (Int.eq i0 Int.zero); inv H. TrivialExists. - inv H0; try discriminate; inv H1; try discriminate. simpl in *. + inv H0; try discriminate; inv H1; try discriminate. simpl in *. destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H; TrivialExists. - inv H0; try discriminate; inv H1; try discriminate. simpl in *. + inv H0; try discriminate; inv H1; try discriminate. simpl in *. destruct (Int.eq i0 Int.zero); inv H. TrivialExists. inv H; inv H0; inv H1; TrivialExists. inv H; inv H0; inv H1; TrivialExists. @@ -1378,15 +1378,15 @@ Proof. inv H; inv H0; inv H1; TrivialExists. inv H; inv H0; inv H1; TrivialExists. inv H; inv H0; inv H1; TrivialExists. - inv H0; try discriminate; inv H1; try discriminate. simpl in *. + inv H0; try discriminate; inv H1; try discriminate. simpl in *. destruct (Int64.eq i0 Int64.zero || Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq i0 Int64.mone); inv H; TrivialExists. - inv H0; try discriminate; inv H1; try discriminate. simpl in *. + inv H0; try discriminate; inv H1; try discriminate. simpl in *. destruct (Int64.eq i0 Int64.zero); inv H. TrivialExists. - inv H0; try discriminate; inv H1; try discriminate. simpl in *. + inv H0; try discriminate; inv H1; try discriminate. simpl in *. destruct (Int64.eq i0 Int64.zero || Int64.eq i (Int64.repr Int64.min_signed) && Int64.eq i0 Int64.mone); inv H; TrivialExists. - inv H0; try discriminate; inv H1; try discriminate. simpl in *. + inv H0; try discriminate; inv H1; try discriminate. simpl in *. destruct (Int64.eq i0 Int64.zero); inv H. TrivialExists. inv H; inv H0; inv H1; TrivialExists. inv H; inv H0; inv H1; TrivialExists. @@ -1396,8 +1396,8 @@ Proof. inv H; inv H0; inv H1; TrivialExists. simpl. destruct (Int.ltu i0 Int64.iwordsize'); auto. inv H; inv H0; inv H1; TrivialExists. apply val_inject_val_of_optbool. (* cmpu *) - inv H. econstructor; split; eauto. - unfold Val.cmpu. + inv H. econstructor; split; eauto. + unfold Val.cmpu. destruct (Val.cmpu_bool (Mem.valid_pointer m) c v1 v2) as [b|] eqn:E. replace (Val.cmpu_bool (Mem.valid_pointer tm) c tv1 tv2) with (Some b). destruct b; simpl; constructor. @@ -1437,7 +1437,7 @@ Proof. inv H1; inv H0; try congruence. (* local *) exists (Vptr sp (Int.repr ofs)); split. - constructor. simpl. rewrite Int.add_zero_l; auto. + constructor. simpl. rewrite Int.add_zero_l; auto. congruence. (* global *) exploit match_callstack_match_globalenvs; eauto. intros [bnd MG]. inv MG. @@ -1486,7 +1486,7 @@ Lemma transl_constant_correct: eval_constant tge sp (transl_constant cst) = Some tv /\ Val.inject f v tv. Proof. - destruct cst; simpl; intros; inv H. + destruct cst; simpl; intros; inv H. exists (Vint i); auto. exists (Vfloat f0); auto. exists (Vsingle f0); auto. @@ -1509,17 +1509,17 @@ Lemma transl_expr_correct: Proof. induction 3; intros; simpl in TR; try (monadInv TR). (* Etempvar *) - inv MATCH. exploit MTMP; eauto. intros [tv [A B]]. + inv MATCH. exploit MTMP; eauto. intros [tv [A B]]. exists tv; split. constructor; auto. auto. (* Eaddrof *) eapply var_addr_correct; eauto. (* Econst *) exploit transl_constant_correct; eauto. intros [tv [A B]]. - exists tv; split; eauto. constructor; eauto. + exists tv; split; eauto. constructor; eauto. (* Eunop *) exploit IHeval_expr; eauto. intros [tv1 [EVAL1 INJ1]]. exploit eval_unop_compat; eauto. intros [tv [EVAL INJ]]. - exists tv; split; auto. econstructor; eauto. + exists tv; split; auto. econstructor; eauto. (* Ebinop *) exploit IHeval_expr1; eauto. intros [tv1 [EVAL1 INJ1]]. exploit IHeval_expr2; eauto. intros [tv2 [EVAL2 INJ2]]. @@ -1672,17 +1672,17 @@ Inductive lbl_stmt_tail: lbl_stmt -> nat -> lbl_stmt -> Prop := Lemma switch_table_default: forall sl base, - exists n, + exists n, lbl_stmt_tail sl n (select_switch_default sl) /\ snd (switch_table sl base) = (n + base)%nat. Proof. induction sl; simpl; intros. - exists O; split. constructor. omega. -- destruct o. - + destruct (IHsl (S base)) as (n & P & Q). exists (S n); split. - constructor; auto. +- destruct o. + + destruct (IHsl (S base)) as (n & P & Q). exists (S n); split. + constructor; auto. destruct (switch_table sl (S base)) as [tbl dfl]; simpl in *. omega. - + exists O; split. constructor. + + exists O; split. constructor. destruct (switch_table sl (S base)) as [tbl dfl]; simpl in *. auto. Qed. @@ -1699,17 +1699,17 @@ Lemma switch_table_case: Proof. induction sl; simpl; intros. - auto. -- destruct (switch_table sl (S base)) as [tbl1 dfl1] eqn:ST. +- destruct (switch_table sl (S base)) as [tbl1 dfl1] eqn:ST. destruct o; simpl. rewrite dec_eq_sym. destruct (zeq i z). exists O; split; auto. constructor. specialize (IHsl (S base) dfl). rewrite ST in IHsl. simpl in *. destruct (select_switch_case i sl). - destruct IHsl as (x & P & Q). exists (S x); split. constructor; auto. omega. + destruct IHsl as (x & P & Q). exists (S x); split. constructor; auto. omega. auto. specialize (IHsl (S base) dfl). rewrite ST in IHsl. simpl in *. destruct (select_switch_case i sl). - destruct IHsl as (x & P & Q). exists (S x); split. constructor; auto. omega. + destruct IHsl as (x & P & Q). exists (S x); split. constructor; auto. omega. auto. Qed. @@ -1720,7 +1720,7 @@ Lemma switch_table_select: (select_switch i sl). Proof. unfold select_switch; intros. - generalize (switch_table_case i sl O (snd (switch_table sl O))). + generalize (switch_table_case i sl O (snd (switch_table sl O))). destruct (select_switch_case i sl) as [sl'|]. intros (n & P & Q). replace (n + O)%nat with n in Q by omega. congruence. intros E; rewrite E. @@ -1744,15 +1744,15 @@ Lemma switch_descent: /\ (forall f sp e m, plus step tge (State f s k sp e m) E0 (State f body k' sp e m)). Proof. - induction ls; intros. + induction ls; intros. - monadInv H. econstructor; split. econstructor. - intros. eapply plus_two. constructor. constructor. auto. -- monadInv H. exploit IHls; eauto. intros [k' [A B]]. + intros. eapply plus_two. constructor. constructor. auto. +- monadInv H. exploit IHls; eauto. intros [k' [A B]]. econstructor; split. econstructor; eauto. - intros. eapply plus_star_trans. eauto. - eapply star_left. constructor. apply star_one. constructor. + intros. eapply plus_star_trans. eauto. + eapply star_left. constructor. apply star_one. constructor. reflexivity. traceEq. Qed. @@ -1766,12 +1766,12 @@ Lemma switch_ascent: E0 (State f (Sexit O) k2 sp e m) /\ transl_lblstmt_cont cenv xenv ls' k k2. Proof. - induction 1; intros. + induction 1; intros. - exists k1; split; auto. apply star_refl. -- inv H0. exploit IHlbl_stmt_tail; eauto. intros (k2 & P & Q). +- inv H0. exploit IHlbl_stmt_tail; eauto. intros (k2 & P & Q). exists k2; split; auto. eapply star_left. constructor. eapply star_left. constructor. eexact P. - eauto. auto. + eauto. auto. Qed. Lemma switch_match_cont: @@ -1782,7 +1782,7 @@ Lemma switch_match_cont: Proof. induction ls; intros; simpl. inv H0. apply match_Kblock2. econstructor; eauto. - inv H0. apply match_Kblock2. eapply match_Kseq2. auto. eauto. + inv H0. apply match_Kblock2. eapply match_Kseq2. auto. eauto. Qed. Lemma switch_match_states: @@ -1799,9 +1799,9 @@ Lemma switch_match_states: plus step tge (State tfn (Sexit O) tk' (Vptr sp Int.zero) te tm) E0 S /\ match_states (Csharpminor.State fn (seq_of_lbl_stmt ls) k e le m) S. Proof. - intros. inv TK. -- econstructor; split. eapply plus_two. constructor. constructor. auto. - eapply match_state; eauto. + intros. inv TK. +- econstructor; split. eapply plus_two. constructor. constructor. auto. + eapply match_state; eauto. - econstructor; split. eapply plus_left. constructor. apply star_one. constructor. auto. simpl. eapply match_state_seq; eauto. simpl. eapply switch_match_cont; eauto. Qed. @@ -1812,9 +1812,9 @@ Lemma transl_lblstmt_suffix: forall body ts, transl_lblstmt cenv (switch_env ls xenv) ls body = OK ts -> exists body', exists ts', transl_lblstmt cenv (switch_env ls' xenv) ls' body' = OK ts'. Proof. - induction 1; intros. + induction 1; intros. - exists body, ts; auto. -- monadInv H0. eauto. +- monadInv H0. eauto. Qed. (** Commutation between [find_label] and compilation *) @@ -1834,7 +1834,7 @@ Lemma transl_lblstmt_find_label_context: Proof. induction ls; intros. - monadInv H. inv H0. simpl. rewrite H1. auto. -- monadInv H. inv H0. simpl in H6. eapply IHls; eauto. +- monadInv H. inv H0. simpl in H6. eapply IHls; eauto. replace x with ts0 by congruence. simpl. rewrite H1. auto. Qed. @@ -1868,25 +1868,25 @@ with transl_lblstmt_find_label: Proof. intros. destruct s; try (monadInv H); simpl; auto. (* seq *) - exploit (transl_find_label s1). eauto. eapply match_Kseq. eexact EQ1. eauto. + exploit (transl_find_label s1). eauto. eapply match_Kseq. eexact EQ1. eauto. destruct (Csharpminor.find_label lbl s1 (Csharpminor.Kseq s2 k)) as [[s' k'] | ]. - intros [ts' [tk' [xenv' [A [B C]]]]]. + intros [ts' [tk' [xenv' [A [B C]]]]]. exists ts'; exists tk'; exists xenv'. intuition. rewrite A; auto. - intro. rewrite H. apply transl_find_label with xenv; auto. + intro. rewrite H. apply transl_find_label with xenv; auto. (* ifthenelse *) - exploit (transl_find_label s1). eauto. eauto. + exploit (transl_find_label s1). eauto. eauto. destruct (Csharpminor.find_label lbl s1 k) as [[s' k'] | ]. - intros [ts' [tk' [xenv' [A [B C]]]]]. + intros [ts' [tk' [xenv' [A [B C]]]]]. exists ts'; exists tk'; exists xenv'. intuition. rewrite A; auto. - intro. rewrite H. apply transl_find_label with xenv; auto. + intro. rewrite H. apply transl_find_label with xenv; auto. (* loop *) apply transl_find_label with xenv. auto. econstructor; eauto. simpl. rewrite EQ; auto. (* block *) - apply transl_find_label with (true :: xenv). auto. constructor; auto. + apply transl_find_label with (true :: xenv). auto. constructor; auto. (* switch *) - simpl in H. destruct (switch_table l O) as [tbl dfl]. monadInv H. + simpl in H. destruct (switch_table l O) as [tbl dfl]. monadInv H. exploit switch_descent; eauto. intros [k' [A B]]. - eapply transl_lblstmt_find_label. eauto. eauto. eauto. reflexivity. + eapply transl_lblstmt_find_label. eauto. eauto. eauto. reflexivity. (* return *) destruct o; monadInv H; auto. (* label *) @@ -1899,14 +1899,14 @@ Proof. inv H1. rewrite H2. auto. (* cons *) inv H1. simpl in H7. - exploit (transl_find_label s). eauto. eapply switch_match_cont; eauto. + exploit (transl_find_label s). eauto. eapply switch_match_cont; eauto. destruct (Csharpminor.find_label lbl s (Csharpminor.Kseq (seq_of_lbl_stmt ls) k)) as [[s' k''] | ]. intros [ts' [tk' [xenv' [A [B C]]]]]. - exists ts'; exists tk'; exists xenv'; intuition. - eapply transl_lblstmt_find_label_context; eauto. + exists ts'; exists tk'; exists xenv'; intuition. + eapply transl_lblstmt_find_label_context; eauto. + simpl. replace x with ts0 by congruence. rewrite H2. auto. + intro. eapply transl_lblstmt_find_label. eauto. auto. eauto. simpl. replace x with ts0 by congruence. rewrite H2. auto. - intro. eapply transl_lblstmt_find_label. eauto. auto. eauto. - simpl. replace x with ts0 by congruence. rewrite H2. auto. Qed. End FIND_LABEL. @@ -1921,7 +1921,7 @@ Lemma transl_find_label_body: /\ transl_stmt cenv xenv' s' = OK ts' /\ match_cont k' tk' cenv xenv' cs. Proof. - intros. monadInv H. simpl. + intros. monadInv H. simpl. exploit transl_find_label. eexact EQ. eapply match_call_cont. eexact H0. instantiate (1 := lbl). rewrite H1. auto. Qed. @@ -1951,12 +1951,12 @@ Proof. (* skip seq *) monadInv TR. left. dependent induction MK. - econstructor; split. + econstructor; split. apply plus_one. constructor. econstructor; eauto. econstructor; split. apply plus_one. constructor. - eapply match_state_seq; eauto. + eapply match_state_seq; eauto. exploit IHMK; eauto. intros [T2 [A B]]. exists T2; split. eapply plus_left. constructor. apply plus_star; eauto. traceEq. auto. @@ -1971,7 +1971,7 @@ Proof. auto. (* skip call *) monadInv TR. left. - exploit match_is_call_cont; eauto. intros [tk' [A [B C]]]. + exploit match_is_call_cont; eauto. intros [tk' [A [B C]]]. exploit match_callstack_freelist; eauto. intros [tm' [P [Q R]]]. econstructor; split. eapply plus_right. eexact A. apply step_skip_call. auto. eauto. traceEq. @@ -1981,25 +1981,25 @@ Proof. monadInv TR. exploit transl_expr_correct; eauto. intros [tv [EVAL VINJ]]. left; econstructor; split. - apply plus_one. econstructor; eauto. - econstructor; eauto. - eapply match_callstack_set_temp; eauto. + apply plus_one. econstructor; eauto. + econstructor; eauto. + eapply match_callstack_set_temp; eauto. (* store *) monadInv TR. - exploit transl_expr_correct. eauto. eauto. eexact H. eauto. + exploit transl_expr_correct. eauto. eauto. eexact H. eauto. intros [tv1 [EVAL1 VINJ1]]. - exploit transl_expr_correct. eauto. eauto. eexact H0. eauto. + exploit transl_expr_correct. eauto. eauto. eexact H0. eauto. intros [tv2 [EVAL2 VINJ2]]. - exploit Mem.storev_mapped_inject; eauto. intros [tm' [STORE' MINJ']]. + exploit Mem.storev_mapped_inject; eauto. intros [tm' [STORE' MINJ']]. left; econstructor; split. - apply plus_one. econstructor; eauto. + apply plus_one. econstructor; eauto. econstructor; eauto. inv VINJ1; simpl in H1; try discriminate. unfold Mem.storev in STORE'. rewrite (Mem.nextblock_store _ _ _ _ _ _ H1). rewrite (Mem.nextblock_store _ _ _ _ _ _ STORE'). eapply match_callstack_invariant with f0 m tm; eauto. - intros. eapply Mem.perm_store_2; eauto. + intros. eapply Mem.perm_store_2; eauto. intros. eapply Mem.perm_store_1; eauto. (* call *) @@ -2024,11 +2024,11 @@ Proof. exploit transl_exprlist_correct; eauto. intros [tvargs [EVAL2 VINJ2]]. exploit match_callstack_match_globalenvs; eauto. intros [hi' MG]. - exploit external_call_mem_inject; eauto. + exploit external_call_mem_inject; eauto. eapply inj_preserves_globals; eauto. intros [f' [vres' [tm' [EC [VINJ [MINJ' [UNMAPPED [OUTOFREACH [INCR SEPARATED]]]]]]]]]. left; econstructor; split. - apply plus_one. econstructor. eauto. + apply plus_one. econstructor. eauto. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. eexact varinfo_preserved. assert (MCS': match_callstack f' m' tm' @@ -2037,23 +2037,23 @@ Proof. apply match_callstack_incr_bound with (Mem.nextblock m) (Mem.nextblock tm). eapply match_callstack_external_call; eauto. intros. eapply external_call_max_perm; eauto. - xomega. xomega. + xomega. xomega. eapply external_call_nextblock; eauto. eapply external_call_nextblock; eauto. econstructor; eauto. Opaque PTree.set. - unfold set_optvar. destruct optid; simpl. - eapply match_callstack_set_temp; eauto. + unfold set_optvar. destruct optid; simpl. + eapply match_callstack_set_temp; eauto. auto. (* seq *) - monadInv TR. + monadInv TR. left; econstructor; split. - apply plus_one. constructor. + apply plus_one. constructor. econstructor; eauto. econstructor; eauto. (* seq 2 *) - right. split. auto. split. auto. econstructor; eauto. + right. split. auto. split. auto. econstructor; eauto. (* ifthenelse *) monadInv TR. @@ -2065,21 +2065,21 @@ Opaque PTree.set. (* loop *) monadInv TR. left; econstructor; split. - apply plus_one. constructor. + apply plus_one. constructor. econstructor; eauto. - econstructor; eauto. simpl. rewrite EQ; auto. + econstructor; eauto. simpl. rewrite EQ; auto. (* block *) monadInv TR. left; econstructor; split. - apply plus_one. constructor. + apply plus_one. constructor. econstructor; eauto. econstructor; eauto. (* exit seq *) monadInv TR. left. dependent induction MK. - econstructor; split. + econstructor; split. apply plus_one. constructor. econstructor; eauto. simpl. auto. exploit IHMK; eauto. intros [T2 [A B]]. @@ -2092,20 +2092,20 @@ Opaque PTree.set. monadInv TR. left. dependent induction MK. econstructor; split. - simpl. apply plus_one. constructor. + simpl. apply plus_one. constructor. econstructor; eauto. exploit IHMK; eauto. intros [T2 [A B]]. - exists T2; split; auto. simpl. + exists T2; split; auto. simpl. eapply plus_left. constructor. apply plus_star; eauto. traceEq. (* exit block n+1 *) monadInv TR. left. dependent induction MK. econstructor; split. - simpl. apply plus_one. constructor. - econstructor; eauto. auto. + simpl. apply plus_one. constructor. + econstructor; eauto. auto. exploit IHMK; eauto. intros [T2 [A B]]. - exists T2; split; auto. simpl. + exists T2; split; auto. simpl. eapply plus_left. constructor. apply plus_star; eauto. traceEq. (* switch *) @@ -2120,9 +2120,9 @@ Opaque PTree.set. simpl. intros [body' [ts' E]]. exploit switch_match_states; eauto. intros [T2 [F G]]. left; exists T2; split. - eapply plus_star_trans. eapply B. - eapply star_left. econstructor; eauto. - eapply star_trans. eexact C. + eapply plus_star_trans. eapply B. + eapply star_left. econstructor; eauto. + eapply star_trans. eexact C. apply plus_star. eexact F. reflexivity. reflexivity. traceEq. auto. @@ -2136,11 +2136,11 @@ Opaque PTree.set. simpl; auto. (* return some *) - monadInv TR. left. + monadInv TR. left. exploit transl_expr_correct; eauto. intros [tv [EVAL VINJ]]. exploit match_callstack_freelist; eauto. intros [tm' [A [B C]]]. econstructor; split. - apply plus_one. eapply step_return_1. eauto. eauto. + apply plus_one. eapply step_return_1. eauto. eauto. econstructor; eauto. eapply match_call_cont; eauto. (* label *) @@ -2151,10 +2151,10 @@ Opaque PTree.set. (* goto *) monadInv TR. - exploit transl_find_label_body; eauto. + exploit transl_find_label_body; eauto. intros [ts' [tk' [xenv' [A [B C]]]]]. left; econstructor; split. - apply plus_one. apply step_goto. eexact A. + apply plus_one. apply step_goto. eexact A. econstructor; eauto. (* internal call *) @@ -2163,7 +2163,7 @@ Opaque PTree.set. destruct (zle sz Int.max_unsigned); try congruence. intro TRBODY. generalize TRBODY; intro TMP. monadInv TMP. - set (tf := mkfunction (Csharpminor.fn_sig f) + set (tf := mkfunction (Csharpminor.fn_sig f) (Csharpminor.fn_params f) (Csharpminor.fn_temps f) sz @@ -2172,14 +2172,14 @@ Opaque PTree.set. exploit match_callstack_function_entry; eauto. simpl; eauto. simpl; auto. intros [f2 [MCS2 MINJ2]]. left; econstructor; split. - apply plus_one. constructor; simpl; eauto. + apply plus_one. constructor; simpl; eauto. econstructor. eexact TRBODY. eauto. eexact MINJ2. eexact MCS2. inv MK; simpl in ISCC; contradiction || econstructor; eauto. (* external call *) - monadInv TR. + monadInv TR. exploit match_callstack_match_globalenvs; eauto. intros [hi MG]. - exploit external_call_mem_inject; eauto. + exploit external_call_mem_inject; eauto. eapply inj_preserves_globals; eauto. intros [f' [vres' [tm' [EC [VINJ [MINJ' [UNMAPPED [OUTOFREACH [INCR SEPARATED]]]]]]]]]. left; econstructor; split. @@ -2197,9 +2197,9 @@ Opaque PTree.set. (* return *) inv MK. simpl. left; econstructor; split. - apply plus_one. econstructor; eauto. + apply plus_one. econstructor; eauto. unfold set_optvar. destruct optid; simpl; econstructor; eauto. - eapply match_callstack_set_temp; eauto. + eapply match_callstack_set_temp; eauto. Qed. Lemma match_globalenvs_init: @@ -2208,12 +2208,12 @@ Lemma match_globalenvs_init: match_globalenvs (Mem.flat_inj (Mem.nextblock m)) (Mem.nextblock m). Proof. intros. constructor. - intros. unfold Mem.flat_inj. apply pred_dec_true; auto. - intros. unfold Mem.flat_inj in H0. + intros. unfold Mem.flat_inj. apply pred_dec_true; auto. + intros. unfold Mem.flat_inj in H0. destruct (plt b1 (Mem.nextblock m)); congruence. intros. eapply Genv.find_symbol_not_fresh; eauto. intros. eapply Genv.find_funct_ptr_not_fresh; eauto. - intros. eapply Genv.find_var_info_not_fresh; eauto. + intros. eapply Genv.find_var_info_not_fresh; eauto. Qed. Lemma transl_initial_states: @@ -2224,19 +2224,19 @@ Proof. exploit function_ptr_translated; eauto. intros [tf [FIND TR]]. econstructor; split. econstructor. - apply (Genv.init_mem_transf_partial _ _ TRANSL). eauto. + apply (Genv.init_mem_transf_partial _ _ TRANSL). eauto. simpl. fold tge. rewrite symbols_preserved. replace (prog_main tprog) with (prog_main prog). eexact H0. symmetry. unfold transl_program in TRANSL. eapply transform_partial_program_main; eauto. - eexact FIND. + eexact FIND. rewrite <- H2. apply sig_preserved; auto. eapply match_callstate with (f := Mem.flat_inj (Mem.nextblock m0)) (cs := @nil frame) (cenv := PTree.empty Z). auto. eapply Genv.initmem_inject; eauto. apply mcs_nil with (Mem.nextblock m0). apply match_globalenvs_init; auto. xomega. xomega. constructor. red; auto. - constructor. + constructor. Qed. Lemma transl_final_states: @@ -2253,7 +2253,7 @@ Proof. eexact public_preserved. eexact transl_initial_states. eexact transl_final_states. - eexact transl_step_correct. + eexact transl_step_correct. Qed. End TRANSLATION. diff --git a/cfrontend/Cop.v b/cfrontend/Cop.v index 948ccaca..b4784028 100644 --- a/cfrontend/Cop.v +++ b/cfrontend/Cop.v @@ -65,7 +65,7 @@ Inductive incr_or_decr : Type := Incr | Decr. The [sem_*] functions below compute the result of an operator application. Since operators are overloaded, the result depends both on the static types of the arguments and on their run-time values. - The corresponding [classify_*] function is first called on the + The corresponding [classify_*] function is first called on the types of the arguments to resolve static overloading. It is then followed by a case analysis on the values of the arguments. *) @@ -139,7 +139,7 @@ Definition cast_int_int (sz: intsize) (sg: signedness) (i: int) : int := | I8, Signed => Int.sign_ext 8 i | I8, Unsigned => Int.zero_ext 8 i | I16, Signed => Int.sign_ext 16 i - | I16, Unsigned => Int.zero_ext 16 i + | I16, Unsigned => Int.zero_ext 16 i | I32, _ => i | IBool, _ => if Int.eq i Int.zero then Int.zero else Int.one end. @@ -343,8 +343,8 @@ Definition sem_cast (v: val) (t1 t2: type) : option val := end. (** The following describes types that can be interpreted as a boolean: - integers, floats, pointers. It is used for the semantics of - the [!] and [?] operators, as well as the [if], [while], + integers, floats, pointers. It is used for the semantics of + the [!] and [?] operators, as well as the [if], [while], and [for] statements. *) Inductive classify_bool_cases : Type := @@ -638,33 +638,33 @@ Definition classify_add (ty1: type) (ty2: type) := end. Definition sem_add (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type) : option val := - match classify_add t1 t2 with + match classify_add t1 t2 with | add_case_pi ty => (**r pointer plus integer *) match v1,v2 with - | Vptr b1 ofs1, Vint n2 => + | Vptr b1 ofs1, Vint n2 => Some (Vptr b1 (Int.add ofs1 (Int.mul (Int.repr (sizeof cenv ty)) n2))) | _, _ => None - end + end | add_case_ip ty => (**r integer plus pointer *) match v1,v2 with - | Vint n1, Vptr b2 ofs2 => + | Vint n1, Vptr b2 ofs2 => Some (Vptr b2 (Int.add ofs2 (Int.mul (Int.repr (sizeof cenv ty)) n1))) | _, _ => None - end + end | add_case_pl ty => (**r pointer plus long *) match v1,v2 with - | Vptr b1 ofs1, Vlong n2 => + | Vptr b1 ofs1, Vlong n2 => let n2 := Int.repr (Int64.unsigned n2) in Some (Vptr b1 (Int.add ofs1 (Int.mul (Int.repr (sizeof cenv ty)) n2))) | _, _ => None - end + end | add_case_lp ty => (**r long plus pointer *) match v1,v2 with - | Vlong n1, Vptr b2 ofs2 => + | Vlong n1, Vptr b2 ofs2 => let n1 := Int.repr (Int64.unsigned n1) in Some (Vptr b2 (Int.add ofs2 (Int.mul (Int.repr (sizeof cenv ty)) n1))) | _, _ => None - end + end | add_default => sem_binarith (fun sg n1 n2 => Some(Vint(Int.add n1 n2))) @@ -694,13 +694,13 @@ Definition sem_sub (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type) match classify_sub t1 t2 with | sub_case_pi ty => (**r pointer minus integer *) match v1,v2 with - | Vptr b1 ofs1, Vint n2 => + | Vptr b1 ofs1, Vint n2 => Some (Vptr b1 (Int.sub ofs1 (Int.mul (Int.repr (sizeof cenv ty)) n2))) | _, _ => None end | sub_case_pl ty => (**r pointer minus long *) match v1,v2 with - | Vptr b1 ofs1, Vlong n2 => + | Vptr b1 ofs1, Vlong n2 => let n2 := Int.repr (Int64.unsigned n2) in Some (Vptr b1 (Int.sub ofs1 (Int.mul (Int.repr (sizeof cenv ty)) n2))) | _, _ => None @@ -724,7 +724,7 @@ Definition sem_sub (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type) (fun n1 n2 => Some(Vsingle(Float32.sub n1 n2))) v1 t1 v2 t2 end. - + (** *** Multiplication, division, modulus *) Definition sem_mul (v1:val) (t1:type) (v2: val) (t2:type) : option val := @@ -842,28 +842,28 @@ Definition sem_shift match classify_shift t1 t2 with | shift_case_ii sg => match v1, v2 with - | Vint n1, Vint n2 => + | Vint n1, Vint n2 => if Int.ltu n2 Int.iwordsize then Some(Vint(sem_int sg n1 n2)) else None | _, _ => None end | shift_case_il sg => match v1, v2 with - | Vint n1, Vlong n2 => + | Vint n1, Vlong n2 => if Int64.ltu n2 (Int64.repr 32) then Some(Vint(sem_int sg n1 (Int64.loword n2))) else None | _, _ => None end | shift_case_li sg => match v1, v2 with - | Vlong n1, Vint n2 => + | Vlong n1, Vint n2 => if Int.ltu n2 Int64.iwordsize' then Some(Vlong(sem_long sg n1 (Int64.repr (Int.unsigned n2)))) else None | _, _ => None end | shift_case_ll sg => match v1, v2 with - | Vlong n1, Vlong n2 => + | Vlong n1, Vlong n2 => if Int64.ltu n2 Int64.iwordsize then Some(Vlong(sem_long sg n1 n2)) else None | _, _ => None @@ -892,7 +892,7 @@ Inductive classify_cmp_cases : Type := | cmp_default. (**r numerical, numerical *) Definition classify_cmp (ty1: type) (ty2: type) := - match typeconv ty1, typeconv ty2 with + match typeconv ty1, typeconv ty2 with | Tpointer _ _ , Tpointer _ _ => cmp_case_pp | Tpointer _ _ , Tint _ _ _ => cmp_case_pp | Tint _ _ _, Tpointer _ _ => cmp_case_pp @@ -909,14 +909,14 @@ Definition sem_cmp (c:comparison) option_map Val.of_bool (Val.cmpu_bool (Mem.valid_pointer m) c v1 v2) | cmp_case_pl => match v2 with - | Vlong n2 => + | Vlong n2 => let n2 := Int.repr (Int64.unsigned n2) in option_map Val.of_bool (Val.cmpu_bool (Mem.valid_pointer m) c v1 (Vint n2)) | _ => None end | cmp_case_lp => match v1 with - | Vlong n1 => + | Vlong n1 => let n1 := Int.repr (Int64.unsigned n1) in option_map Val.of_bool (Val.cmpu_bool (Mem.valid_pointer m) c (Vint n1) v2) | _ => None @@ -941,7 +941,7 @@ Inductive classify_fun_cases : Type := | fun_default. Definition classify_fun (ty: type) := - match ty with + match ty with | Tfunction args res cc => fun_case_f args res cc | Tpointer (Tfunction args res cc) _ => fun_case_f args res cc | _ => fun_default @@ -989,15 +989,15 @@ Definition sem_binary_operation (m: mem): option val := match op with | Oadd => sem_add cenv v1 t1 v2 t2 - | Osub => sem_sub cenv v1 t1 v2 t2 + | Osub => sem_sub cenv v1 t1 v2 t2 | Omul => sem_mul v1 t1 v2 t2 | Omod => sem_mod v1 t1 v2 t2 - | Odiv => sem_div v1 t1 v2 t2 + | Odiv => sem_div v1 t1 v2 t2 | Oand => sem_and v1 t1 v2 t2 | Oor => sem_or v1 t1 v2 t2 | Oxor => sem_xor v1 t1 v2 t2 | Oshl => sem_shl v1 t1 v2 t2 - | Oshr => sem_shr v1 t1 v2 t2 + | Oshr => sem_shr v1 t1 v2 t2 | Oeq => sem_cmp Ceq v1 t1 v2 t2 m | One => sem_cmp Cne v1 t1 v2 t2 m | Olt => sem_cmp Clt v1 t1 v2 t2 m @@ -1063,7 +1063,7 @@ Remark val_inject_vfalse: forall f, Val.inject f Vfalse Vfalse. Proof. unfold Vfalse; auto. Qed. Remark val_inject_of_bool: forall f b, Val.inject f (Val.of_bool b) (Val.of_bool b). -Proof. intros. unfold Val.of_bool. destruct b; [apply val_inject_vtrue|apply val_inject_vfalse]. +Proof. intros. unfold Val.of_bool. destruct b; [apply val_inject_vtrue|apply val_inject_vfalse]. Qed. Hint Resolve val_inject_vtrue val_inject_vfalse val_inject_of_bool. @@ -1082,7 +1082,7 @@ Lemma sem_cast_inject: Proof. unfold sem_cast; intros; destruct (classify_cast ty1 ty); inv H0; inv H; TrivialInject. -- econstructor; eauto. +- econstructor; eauto. - destruct (cast_float_int si2 f0); inv H1; TrivialInject. - destruct (cast_single_int si2 f0); inv H1; TrivialInject. - destruct (cast_float_long si2 f0); inv H1; TrivialInject. @@ -1102,7 +1102,7 @@ Proof. (* notbool *) unfold sem_notbool in *; destruct (classify_bool ty); inv H0; inv H; TrivialInject. destruct (Mem.weak_valid_pointer m b1 (Int.unsigned ofs1)) eqn:VP; inv H2. - erewrite weak_valid_pointer_inj by eauto. TrivialInject. + erewrite weak_valid_pointer_inj by eauto. TrivialInject. (* notint *) unfold sem_notint in *; destruct (classify_notint ty); inv H0; inv H; TrivialInject. (* neg *) @@ -1127,7 +1127,7 @@ Remark sem_binarith_inject: (forall n1 n2, optval_self_injects (sem_single n1 n2)) -> exists v', sem_binarith sem_int sem_long sem_float sem_single v1' t1 v2' t2 = Some v' /\ Val.inject f v v'. Proof. - intros. + intros. assert (SELF: forall ov v, ov = Some v -> optval_self_injects ov -> Val.inject f v v). { intros. subst ov; simpl in H7. destruct v0; contradiction || constructor. @@ -1169,22 +1169,22 @@ Proof. - (* pointer - pointer *) destruct (Val.cmpu_bool (Mem.valid_pointer m) cmp v1 v2) as [b|] eqn:E; simpl in H; inv H. replace (Val.cmpu_bool (Mem.valid_pointer m') cmp tv1 tv2) with (Some b). - simpl. TrivialInject. - symmetry. eapply Val.cmpu_bool_inject; eauto. + simpl. TrivialInject. + symmetry. eapply Val.cmpu_bool_inject; eauto. - (* pointer - long *) - destruct v2; try discriminate. inv H1. + destruct v2; try discriminate. inv H1. set (v2 := Vint (Int.repr (Int64.unsigned i))) in *. destruct (Val.cmpu_bool (Mem.valid_pointer m) cmp v1 v2) as [b|] eqn:E; simpl in H; inv H. replace (Val.cmpu_bool (Mem.valid_pointer m') cmp tv1 v2) with (Some b). - simpl. TrivialInject. - symmetry. eapply Val.cmpu_bool_inject with (v2 := v2); eauto. constructor. + simpl. TrivialInject. + symmetry. eapply Val.cmpu_bool_inject with (v2 := v2); eauto. constructor. - (* long - pointer *) - destruct v1; try discriminate. inv H0. + destruct v1; try discriminate. inv H0. set (v1 := Vint (Int.repr (Int64.unsigned i))) in *. destruct (Val.cmpu_bool (Mem.valid_pointer m) cmp v1 v2) as [b|] eqn:E; simpl in H; inv H. replace (Val.cmpu_bool (Mem.valid_pointer m') cmp v1 tv2) with (Some b). - simpl. TrivialInject. - symmetry. eapply Val.cmpu_bool_inject with (v1 := v1); eauto. constructor. + simpl. TrivialInject. + symmetry. eapply Val.cmpu_bool_inject with (v1 := v1); eauto. constructor. - (* numerical - numerical *) assert (SELF: forall b, optval_self_injects (Some (Val.of_bool b))). { @@ -1202,13 +1202,13 @@ Proof. unfold sem_binary_operation; intros; destruct op. - (* add *) unfold sem_add in *; destruct (classify_add ty1 ty2). - + inv H0; inv H1; inv H. TrivialInject. + + inv H0; inv H1; inv H. TrivialInject. econstructor. eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - + inv H0; inv H1; inv H. TrivialInject. + + inv H0; inv H1; inv H. TrivialInject. econstructor. eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - + inv H0; inv H1; inv H. TrivialInject. + + inv H0; inv H1; inv H. TrivialInject. econstructor. eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - + inv H0; inv H1; inv H. TrivialInject. + + inv H0; inv H1; inv H. TrivialInject. econstructor. eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. + eapply sem_binarith_inject; eauto; intros; exact I. - (* sub *) @@ -1216,8 +1216,8 @@ Proof. + inv H0; inv H1; inv H. TrivialInject. econstructor. eauto. rewrite Int.sub_add_l. auto. + inv H0; inv H1; inv H. TrivialInject. - destruct (eq_block b1 b0); try discriminate. subst b1. - rewrite H0 in H2; inv H2. rewrite dec_eq_true. + destruct (eq_block b1 b0); try discriminate. subst b1. + rewrite H0 in H2; inv H2. rewrite dec_eq_true. destruct (zlt 0 (sizeof cenv ty) && zle (sizeof cenv ty) Int.max_signed); inv H3. rewrite Int.sub_shifted. TrivialInject. + inv H0; inv H1; inv H. TrivialInject. @@ -1274,7 +1274,7 @@ Lemma bool_val_inj: Val.inject f v tv -> bool_val tv ty m' = Some b. Proof. - unfold bool_val; intros. + unfold bool_val; intros. destruct (classify_bool ty); inv H0; try congruence. destruct (Mem.weak_valid_pointer m b1 (Int.unsigned ofs1)) eqn:VP; inv H. erewrite weak_valid_pointer_inj by eauto. auto. @@ -1289,7 +1289,7 @@ Lemma sem_unary_operation_inject: Mem.inject f m m' -> exists tv, sem_unary_operation op tv1 ty1 m' = Some tv /\ Val.inject f v tv. Proof. - intros. eapply sem_unary_operation_inj; eauto. + intros. eapply sem_unary_operation_inj; eauto. intros; eapply Mem.weak_valid_pointer_inject_val; eauto. Qed. @@ -1300,7 +1300,7 @@ Lemma sem_binary_operation_inject: Mem.inject f m m' -> exists tv, sem_binary_operation cenv op tv1 ty1 tv2 ty2 m' = Some tv /\ Val.inject f v tv. Proof. - intros. eapply sem_binary_operation_inj; eauto. + intros. eapply sem_binary_operation_inj; eauto. intros; eapply Mem.valid_pointer_inject_val; eauto. intros; eapply Mem.weak_valid_pointer_inject_val; eauto. intros; eapply Mem.weak_valid_pointer_inject_no_overflow; eauto. @@ -1359,9 +1359,9 @@ Proof. destruct f; auto. destruct (Float32.cmp Ceq f0 Float32.zero); auto. destruct f; auto. - destruct (Int.eq i Int.zero); auto. - destruct (Int.eq i Int.zero); auto. - destruct (Int.eq i Int.zero); auto. + destruct (Int.eq i Int.zero); auto. + destruct (Int.eq i Int.zero); auto. + destruct (Int.eq i Int.zero); auto. Qed. (** Relation between Boolean value and Boolean negation. *) @@ -1371,9 +1371,9 @@ Lemma notbool_bool_val: sem_notbool v t m = match bool_val v t m with None => None | Some b => Some(Val.of_bool (negb b)) end. Proof. - intros. unfold sem_notbool, bool_val. + intros. unfold sem_notbool, bool_val. destruct (classify_bool t); auto; destruct v; auto; rewrite ? negb_involutive; auto. - destruct (Mem.weak_valid_pointer m b (Int.unsigned i)); auto. + destruct (Mem.weak_valid_pointer m b (Int.unsigned i)); auto. Qed. (** Relation with the arithmetic conversions of ISO C99, section 6.3.1 *) @@ -1558,4 +1558,4 @@ End ArithConv. - + diff --git a/cfrontend/Csem.v b/cfrontend/Csem.v index 3e9017c9..539b6826 100644 --- a/cfrontend/Csem.v +++ b/cfrontend/Csem.v @@ -292,7 +292,7 @@ Inductive rred: expr -> mem -> trace -> expr -> mem -> Prop := deref_loc ty m b ofs t v1 -> op = match id with Incr => Oadd | Decr => Osub end -> rred (Epostincr id (Eloc b ofs ty) ty) m - t (Ecomma (Eassign (Eloc b ofs ty) + t (Ecomma (Eassign (Eloc b ofs ty) (Ebinop op (Eval v1 ty) (Eval (Vint Int.one) type_int32s) (incrdecr_type ty)) @@ -408,7 +408,7 @@ with contextlist: kind -> (expr -> exprlist) -> Prop := This expression is never stuck because the evaluation of [f()] can make infinitely many transitions. Yet it contains a subexpression [10 / x] that can go wrong if [x = 0], and the compiler may choose to evaluate - [10 / x] first, before calling [f()]. + [10 / x] first, before calling [f()]. Therefore, we must make sure that not only an expression cannot get stuck, but none of its subexpressions can either. We say that a subexpression @@ -437,10 +437,10 @@ Inductive imm_safe: kind -> expr -> mem -> Prop := is immediately stuck. *) (* Definition not_stuck (e: expr) (m: mem) : Prop := - forall k C e' , + forall k C e' , context k RV C -> e = C e' -> not_imm_stuck k e' m. *) -End EXPR. +End EXPR. (** ** Transition semantics. *) @@ -527,11 +527,11 @@ Inductive state: Type := (k: cont) (m: mem) : state | Stuckstate. (**r undefined behavior occurred *) - -(** Find the statement and manufacture the continuation + +(** Find the statement and manufacture the continuation corresponding to a label. *) -Fixpoint find_label (lbl: label) (s: statement) (k: cont) +Fixpoint find_label (lbl: label) (s: statement) (k: cont) {struct s}: option (statement * cont) := match s with | Ssequence s1 s2 => @@ -564,7 +564,7 @@ Fixpoint find_label (lbl: label) (s: statement) (k: cont) | _ => None end -with find_label_ls (lbl: label) (sl: labeled_statements) (k: cont) +with find_label_ls (lbl: label) (sl: labeled_statements) (k: cont) {struct sl}: option (statement * cont) := match sl with | LSnil => None @@ -793,7 +793,7 @@ Definition semantics (p: program) := (** This semantics has the single-event property. *) -Lemma semantics_single_events: +Lemma semantics_single_events: forall p, single_events (semantics p). Proof. unfold semantics; intros; red; simpl; intros. diff --git a/cfrontend/Csharpminor.v b/cfrontend/Csharpminor.v index c34b10a4..e42091af 100644 --- a/cfrontend/Csharpminor.v +++ b/cfrontend/Csharpminor.v @@ -104,7 +104,7 @@ Definition funsig (fd: fundef) := (** Three evaluation environments are involved: - [genv]: global environments, map symbols and functions to memory blocks, and maps symbols to variable informations (type [var_kind]) -- [env]: local environments, map local variables +- [env]: local environments, map local variables to pairs (memory block, size) - [temp_env]: local environments, map temporary variables to their current values. @@ -133,7 +133,7 @@ Fixpoint bind_parameters (formals: list ident) (args: list val) | nil, nil => Some le | id :: xl, v :: vl => bind_parameters xl vl (PTree.set id v le) | _, _ => None - end. + end. (** Continuations *) @@ -211,10 +211,10 @@ Fixpoint seq_of_lbl_stmt (sl: lbl_stmt) : stmt := | LScons c s sl' => Sseq s (seq_of_lbl_stmt sl') end. -(** Find the statement and manufacture the continuation +(** Find the statement and manufacture the continuation corresponding to a label *) -Fixpoint find_label (lbl: label) (s: stmt) (k: cont) +Fixpoint find_label (lbl: label) (s: stmt) (k: cont) {struct s}: option (stmt * cont) := match s with | Sseq s1 s2 => @@ -238,7 +238,7 @@ Fixpoint find_label (lbl: label) (s: stmt) (k: cont) | _ => None end -with find_label_ls (lbl: label) (sl: lbl_stmt) (k: cont) +with find_label_ls (lbl: label) (sl: lbl_stmt) (k: cont) {struct sl}: option (stmt * cont) := match sl with | LSnil => None @@ -290,8 +290,8 @@ Section RELSEM. Variable ge: genv. -(* Evaluation of the address of a variable: - [eval_var_addr prg ge e id b] states that variable [id] +(* Evaluation of the address of a variable: + [eval_var_addr prg ge e id b] states that variable [id] in environment [e] evaluates to block [b]. *) Inductive eval_var_addr: env -> ident -> block -> Prop := @@ -460,7 +460,7 @@ Inductive step: state -> trace -> state -> Prop := | step_external_function: forall ef vargs k m t vres m', external_call ef ge vargs m t vres m' -> step (Callstate (External ef) vargs k m) - t (Returnstate vres k m') + t (Returnstate vres k m') | step_return: forall v optid f e le k m, step (Returnstate v (Kcall optid f e le k) m) diff --git a/cfrontend/Cshmgen.v b/cfrontend/Cshmgen.v index a80f4c15..825a563c 100644 --- a/cfrontend/Cshmgen.v +++ b/cfrontend/Cshmgen.v @@ -130,10 +130,10 @@ Definition make_cmp_ne_zero (e: expr) := Definition make_cast_int (e: expr) (sz: intsize) (si: signedness) := match sz, si with - | I8, Signed => Eunop Ocast8signed e - | I8, Unsigned => Eunop Ocast8unsigned e - | I16, Signed => Eunop Ocast16signed e - | I16, Unsigned => Eunop Ocast16unsigned e + | I8, Signed => Eunop Ocast8signed e + | I8, Unsigned => Eunop Ocast8unsigned e + | I16, Signed => Eunop Ocast16signed e + | I16, Unsigned => Eunop Ocast16unsigned e | I32, _ => e | IBool, _ => make_cmp_ne_zero e end. @@ -356,7 +356,7 @@ Definition make_memcpy (ce: composite_env) (dst src: expr) (ty: type) := (** [make_store addr ty rhs] stores the value of the Csharpminor expression [rhs] into the memory location denoted by the - Csharpminor expression [addr]. + Csharpminor expression [addr]. [ty] is the type of the memory location. *) Definition make_store (ce: composite_env) (addr: expr) (ty: type) (rhs: expr) := @@ -376,7 +376,7 @@ Definition transl_unop (op: Cop.unary_operation) (a: expr) (ta: type) : res expr | Cop.Oabsfloat => make_absfloat a ta end. -Definition transl_binop (ce: composite_env) +Definition transl_binop (ce: composite_env) (op: Cop.binary_operation) (a: expr) (ta: type) (b: expr) (tb: type) : res expr := @@ -473,10 +473,10 @@ with transl_lvalue (ce: composite_env) (a: Clight.expr) {struct a} : res expr := OK (Eaddrof id) | Clight.Ederef b _ => transl_expr ce b - | Clight.Efield b i ty => + | Clight.Efield b i ty => do tb <- transl_expr ce b; make_field_access ce (typeof b) i tb - | _ => + | _ => Error(msg "Cshmgen.transl_lvalue") end. @@ -492,7 +492,7 @@ Fixpoint transl_arglist (ce: composite_env) (al: list Clight.expr) (tyl: typelis | a1 :: a2, Tcons ty1 ty2 => do ta1 <- transl_expr ce a1; do ta1' <- make_cast (typeof a1) ty1 ta1; - do ta2 <- transl_arglist ce a2 ty2; + do ta2 <- transl_arglist ce a2 ty2; OK (ta1' :: ta2) | a1 :: a2, Tnil => (* Tolerance for calls to K&R or variadic functions *) @@ -630,7 +630,7 @@ Definition signature_of_function (f: Clight.function) := Definition transl_function (ce: composite_env) (f: Clight.function) : res function := do tbody <- transl_statement ce f.(Clight.fn_return) 1%nat 0%nat (Clight.fn_body f); - OK (mkfunction + OK (mkfunction (signature_of_function f) (map fst (Clight.fn_params f)) (map (transl_var ce) (Clight.fn_vars f)) @@ -639,7 +639,7 @@ Definition transl_function (ce: composite_env) (f: Clight.function) : res functi Definition transl_fundef (ce: composite_env) (f: Clight.fundef) : res fundef := match f with - | Clight.Internal g => + | Clight.Internal g => do tg <- transl_function ce g; OK(AST.Internal tg) | Clight.External ef args res cconv => if signature_eq (ef_sig ef) (signature_of_type args res cconv) diff --git a/cfrontend/Cshmgenproof.v b/cfrontend/Cshmgenproof.v index c69d0c0a..e25e21c9 100644 --- a/cfrontend/Cshmgenproof.v +++ b/cfrontend/Cshmgenproof.v @@ -45,8 +45,8 @@ Lemma transl_fundef_sig1: classify_fun (type_of_fundef f) = fun_case_f args res cc -> funsig tf = signature_of_type args res cc. Proof. - intros. destruct f; simpl in *. - monadInv H. monadInv EQ. simpl. inversion H0. + intros. destruct f; simpl in *. + monadInv H. monadInv EQ. simpl. inversion H0. unfold signature_of_function, signature_of_type. f_equal. apply transl_params_types. destruct (signature_eq (ef_sig e) (signature_of_type t t0 c)); inv H. @@ -81,9 +81,9 @@ Proof. (* deref *) monadInv TR. exists x; auto. (* field struct *) - monadInv TR. exists x0; split; auto. simpl; rewrite EQ; auto. + monadInv TR. exists x0; split; auto. simpl; rewrite EQ; auto. (* field union *) - monadInv TR. exists x0; split; auto. simpl; rewrite EQ; auto. + monadInv TR. exists x0; split; auto. simpl; rewrite EQ; auto. Qed. (** Properties of labeled statements *) @@ -98,7 +98,7 @@ Proof. transl_lbl_stmt ce tyret nbrk ncnt sl = OK tsl -> transl_lbl_stmt ce tyret nbrk ncnt (Clight.select_switch_default sl) = OK (select_switch_default tsl)). { - induction sl; simpl; intros. + induction sl; simpl; intros. inv H; auto. monadInv H. simpl. destruct o; eauto. simpl; rewrite EQ; simpl; rewrite EQ1; auto. } @@ -114,16 +114,16 @@ Proof. end). { induction sl; simpl; intros. - inv H; auto. + inv H; auto. monadInv H; simpl. destruct o. destruct (zeq z n). econstructor; split; eauto. simpl; rewrite EQ; simpl; rewrite EQ1; auto. apply IHsl; auto. apply IHsl; auto. } - intros. specialize (CASE _ _ H). unfold Clight.select_switch, select_switch. - destruct (Clight.select_switch_case n sl) as [sl'|]. + intros. specialize (CASE _ _ H). unfold Clight.select_switch, select_switch. + destruct (Clight.select_switch_case n sl) as [sl'|]. destruct CASE as [tsl' [P Q]]. rewrite P, Q. auto. - rewrite CASE. auto. + rewrite CASE. auto. Qed. Lemma transl_lbl_stmt_2: @@ -132,7 +132,7 @@ Lemma transl_lbl_stmt_2: transl_statement ce tyret nbrk ncnt (seq_of_labeled_statement sl) = OK (seq_of_lbl_stmt tsl). Proof. induction sl; intros. - monadInv H. auto. + monadInv H. auto. monadInv H. simpl. rewrite EQ; simpl. rewrite (IHsl _ EQ1). simpl. auto. Qed. @@ -147,28 +147,28 @@ Lemma make_intconst_correct: forall n e le m, eval_expr ge e le m (make_intconst n) (Vint n). Proof. - intros. unfold make_intconst. econstructor. reflexivity. + intros. unfold make_intconst. econstructor. reflexivity. Qed. Lemma make_floatconst_correct: forall n e le m, eval_expr ge e le m (make_floatconst n) (Vfloat n). Proof. - intros. unfold make_floatconst. econstructor. reflexivity. + intros. unfold make_floatconst. econstructor. reflexivity. Qed. Lemma make_singleconst_correct: forall n e le m, eval_expr ge e le m (make_singleconst n) (Vsingle n). Proof. - intros. unfold make_singleconst. econstructor. reflexivity. + intros. unfold make_singleconst. econstructor. reflexivity. Qed. Lemma make_longconst_correct: forall n e le m, eval_expr ge e le m (make_longconst n) (Vlong n). Proof. - intros. unfold make_floatconst. econstructor. reflexivity. + intros. unfold make_floatconst. econstructor. reflexivity. Qed. Lemma make_singleoffloat_correct: @@ -193,7 +193,7 @@ Lemma make_floatofint_correct: eval_expr ge e le m (make_floatofint a sg) (Vfloat(cast_int_float sg n)). Proof. intros. unfold make_floatofint, cast_int_float. - destruct sg; econstructor; eauto. + destruct sg; econstructor; eauto. Qed. Hint Resolve make_intconst_correct make_floatconst_correct make_longconst_correct @@ -207,33 +207,33 @@ Lemma make_cmp_ne_zero_correct: eval_expr ge e le m a (Vint n) -> eval_expr ge e le m (make_cmp_ne_zero a) (Vint (if Int.eq n Int.zero then Int.zero else Int.one)). Proof. - intros. + intros. assert (DEFAULT: eval_expr ge e le m (Ebinop (Ocmp Cne) a (make_intconst Int.zero)) (Vint (if Int.eq n Int.zero then Int.zero else Int.one))). - econstructor; eauto with cshm. simpl. unfold Val.cmp, Val.cmp_bool. - unfold Int.cmp. destruct (Int.eq n Int.zero); auto. + econstructor; eauto with cshm. simpl. unfold Val.cmp, Val.cmp_bool. + unfold Int.cmp. destruct (Int.eq n Int.zero); auto. assert (CMP: forall ob, Val.of_optbool ob = Vint n -> n = (if Int.eq n Int.zero then Int.zero else Int.one)). - intros. destruct ob; simpl in H0; inv H0. destruct b; inv H2. + intros. destruct ob; simpl in H0; inv H0. destruct b; inv H2. rewrite Int.eq_false. auto. apply Int.one_not_zero. rewrite Int.eq_true. auto. - destruct a; simpl; auto. destruct b; auto. - inv H. econstructor; eauto. rewrite H6. decEq. decEq. + destruct a; simpl; auto. destruct b; auto. + inv H. econstructor; eauto. rewrite H6. decEq. decEq. simpl in H6. inv H6. unfold Val.cmp in H0. eauto. - inv H. econstructor; eauto. rewrite H6. decEq. decEq. + inv H. econstructor; eauto. rewrite H6. decEq. decEq. simpl in H6. inv H6. unfold Val.cmp in H0. eauto. - inv H. econstructor; eauto. rewrite H6. decEq. decEq. + inv H. econstructor; eauto. rewrite H6. decEq. decEq. simpl in H6. inv H6. unfold Val.cmp in H0. eauto. - inv H. econstructor; eauto. rewrite H6. decEq. decEq. + inv H. econstructor; eauto. rewrite H6. decEq. decEq. simpl in H6. unfold Val.cmpfs in H6. - destruct (Val.cmpfs_bool c v1 v2) as [[]|]; inv H6; reflexivity. - inv H. econstructor; eauto. rewrite H6. decEq. decEq. + destruct (Val.cmpfs_bool c v1 v2) as [[]|]; inv H6; reflexivity. + inv H. econstructor; eauto. rewrite H6. decEq. decEq. simpl in H6. unfold Val.cmpl in H6. - destruct (Val.cmpl_bool c v1 v2) as [[]|]; inv H6; reflexivity. - inv H. econstructor; eauto. rewrite H6. decEq. decEq. + destruct (Val.cmpl_bool c v1 v2) as [[]|]; inv H6; reflexivity. + inv H. econstructor; eauto. rewrite H6. decEq. decEq. simpl in H6. unfold Val.cmplu in H6. - destruct (Val.cmplu_bool c v1 v2) as [[]|]; inv H6; reflexivity. + destruct (Val.cmplu_bool c v1 v2) as [[]|]; inv H6; reflexivity. Qed. Lemma make_cast_int_correct: @@ -241,7 +241,7 @@ Lemma make_cast_int_correct: eval_expr ge e le m a (Vint n) -> eval_expr ge e le m (make_cast_int a sz si) (Vint (cast_int_int sz si n)). Proof. - intros. unfold make_cast_int, cast_int_int. + intros. unfold make_cast_int, cast_int_int. destruct sz. destruct si; eauto with cshm. destruct si; eauto with cshm. @@ -261,15 +261,15 @@ Proof. intros. unfold make_cast, sem_cast in *; destruct (classify_cast ty1 ty2); inv H; destruct v; inv H1; eauto with cshm. (* single -> int *) - unfold make_singleofint, cast_int_float. destruct si1; eauto with cshm. + unfold make_singleofint, cast_int_float. destruct si1; eauto with cshm. (* float -> int *) destruct (cast_float_int si2 f) as [i|] eqn:E; inv H2. - apply make_cast_int_correct. + apply make_cast_int_correct. unfold cast_float_int in E. unfold make_intoffloat. destruct si2; econstructor; eauto; simpl; rewrite E; auto. (* single -> int *) destruct (cast_single_int si2 f) as [i|] eqn:E; inv H2. - apply make_cast_int_correct. + apply make_cast_int_correct. unfold cast_single_int in E. unfold make_intofsingle. destruct si2; econstructor; eauto with cshm; simpl; rewrite E; auto. (* long -> int *) @@ -316,36 +316,36 @@ Lemma make_boolean_correct: eval_expr ge e le m (make_boolean a ty) vb /\ Val.bool_of_val vb b. Proof. - intros. unfold make_boolean. unfold bool_val in H0. + intros. unfold make_boolean. unfold bool_val in H0. destruct (classify_bool ty); destruct v; inv H0. (* int *) - econstructor; split. apply make_cmp_ne_zero_correct with (n := i); auto. - destruct (Int.eq i Int.zero); simpl; constructor. + econstructor; split. apply make_cmp_ne_zero_correct with (n := i); auto. + destruct (Int.eq i Int.zero); simpl; constructor. (* float *) - econstructor; split. econstructor; eauto with cshm. simpl. eauto. - unfold Val.cmpf, Val.cmpf_bool. simpl. rewrite <- Float.cmp_ne_eq. - destruct (Float.cmp Cne f Float.zero); constructor. + econstructor; split. econstructor; eauto with cshm. simpl. eauto. + unfold Val.cmpf, Val.cmpf_bool. simpl. rewrite <- Float.cmp_ne_eq. + destruct (Float.cmp Cne f Float.zero); constructor. (* single *) - econstructor; split. econstructor; eauto with cshm. simpl. eauto. - unfold Val.cmpfs, Val.cmpfs_bool. simpl. rewrite <- Float32.cmp_ne_eq. - destruct (Float32.cmp Cne f Float32.zero); constructor. + econstructor; split. econstructor; eauto with cshm. simpl. eauto. + unfold Val.cmpfs, Val.cmpfs_bool. simpl. rewrite <- Float32.cmp_ne_eq. + destruct (Float32.cmp Cne f Float32.zero); constructor. (* pointer *) - econstructor; split. econstructor; eauto with cshm. simpl. eauto. + econstructor; split. econstructor; eauto with cshm. simpl. eauto. unfold Val.cmpu, Val.cmpu_bool. simpl. destruct (Int.eq i Int.zero); simpl; constructor. econstructor; split. econstructor; eauto with cshm. simpl. eauto. destruct (Mem.weak_valid_pointer m b0 (Int.unsigned i)) eqn:V; inv H2. unfold Val.cmpu, Val.cmpu_bool. simpl. - unfold Mem.weak_valid_pointer in V; rewrite V. constructor. + unfold Mem.weak_valid_pointer in V; rewrite V. constructor. (* long *) - econstructor; split. econstructor; eauto with cshm. simpl. unfold Val.cmpl. simpl. eauto. - destruct (Int64.eq i Int64.zero); simpl; constructor. + econstructor; split. econstructor; eauto with cshm. simpl. unfold Val.cmpl. simpl. eauto. + destruct (Int64.eq i Int64.zero); simpl; constructor. Qed. Lemma make_neg_correct: forall a tya c va v e le m, sem_neg va tya = Some v -> - make_neg a tya = OK c -> + make_neg a tya = OK c -> eval_expr ge e le m a va -> eval_expr ge e le m c v. Proof. @@ -356,21 +356,21 @@ Qed. Lemma make_absfloat_correct: forall a tya c va v e le m, sem_absfloat va tya = Some v -> - make_absfloat a tya = OK c -> + make_absfloat a tya = OK c -> eval_expr ge e le m a va -> eval_expr ge e le m c v. Proof. unfold sem_absfloat, make_absfloat; intros until m; intros SEM MAKE EV1; destruct (classify_neg tya); inv MAKE; destruct va; inv SEM; eauto with cshm. unfold make_floatoflong, cast_long_float. destruct s. - econstructor. econstructor; simpl; eauto. simpl; eauto. simpl; eauto. - econstructor. econstructor; simpl; eauto. simpl; eauto. simpl; eauto. + econstructor. econstructor; simpl; eauto. simpl; eauto. simpl; eauto. + econstructor. econstructor; simpl; eauto. simpl; eauto. simpl; eauto. Qed. Lemma make_notbool_correct: forall a tya c va v e le m, sem_notbool va tya m = Some v -> - make_notbool a tya = OK c -> + make_notbool a tya = OK c -> eval_expr ge e le m a va -> eval_expr ge e le m c v. Proof. @@ -378,13 +378,13 @@ Proof. destruct (classify_bool tya); inv MAKE; destruct va; inv SEM; eauto with cshm. destruct (Mem.weak_valid_pointer m b (Int.unsigned i)) eqn:V; inv H0. econstructor; eauto with cshm. simpl. unfold Val.cmpu, Val.cmpu_bool. - unfold Mem.weak_valid_pointer in V; rewrite V. auto. + unfold Mem.weak_valid_pointer in V; rewrite V. auto. Qed. Lemma make_notint_correct: forall a tya c va v e le m, sem_notint va tya = Some v -> - make_notint a tya = OK c -> + make_notint a tya = OK c -> eval_expr ge e le m a va -> eval_expr ge e le m c v. Proof. @@ -397,7 +397,7 @@ Definition binary_constructor_correct (sem: val -> type -> val -> type -> option val): Prop := forall a tya b tyb c va vb v e le m, sem va tya vb tyb = Some v -> - make a tya b tyb = OK c -> + make a tya b tyb = OK c -> eval_expr ge e le m a va -> eval_expr ge e le m b vb -> eval_expr ge e le m c v. @@ -438,9 +438,9 @@ Proof. exploit make_cast_correct. eexact EQ. eauto. eauto. intros EV1'. exploit make_cast_correct. eexact EQ1. eauto. eauto. intros EV2'. destruct cls; inv EQ2; destruct va'; try discriminate; destruct vb'; try discriminate. -- destruct s; inv H0; econstructor; eauto with cshm. +- destruct s; inv H0; econstructor; eauto with cshm. rewrite iop_ok; auto. rewrite iopu_ok; auto. -- destruct s; inv H0; econstructor; eauto with cshm. +- destruct s; inv H0; econstructor; eauto with cshm. rewrite lop_ok; auto. rewrite lopu_ok; auto. - erewrite <- fop_ok in SEM; eauto with cshm. - erewrite <- sop_ok in SEM; eauto with cshm. @@ -461,9 +461,9 @@ Proof. exploit make_cast_correct. eexact EQ. eauto. eauto. intros EV1'. exploit make_cast_correct. eexact EQ1. eauto. eauto. intros EV2'. destruct cls; inv EQ2; destruct va'; try discriminate; destruct vb'; try discriminate. -- destruct s; inv H0; econstructor; eauto with cshm. +- destruct s; inv H0; econstructor; eauto with cshm. rewrite iop_ok; auto. rewrite iopu_ok; auto. -- destruct s; inv H0; econstructor; eauto with cshm. +- destruct s; inv H0; econstructor; eauto with cshm. rewrite lop_ok; auto. rewrite lopu_ok; auto. Qed. @@ -492,17 +492,17 @@ Proof. - destruct va; try discriminate; destruct vb; inv SEM. destruct (eq_block b0 b1); try discriminate. set (sz := sizeof ce ty) in *. - destruct (zlt 0 sz); try discriminate. + destruct (zlt 0 sz); try discriminate. destruct (zle sz Int.max_signed); simpl in H0; inv H0. - econstructor; eauto with cshm. - rewrite dec_eq_true; simpl. - assert (E: Int.signed (Int.repr sz) = sz). + econstructor; eauto with cshm. + rewrite dec_eq_true; simpl. + assert (E: Int.signed (Int.repr sz) = sz). { apply Int.signed_repr. generalize Int.min_signed_neg; omega. } predSpec Int.eq Int.eq_spec (Int.repr sz) Int.zero. rewrite H in E; rewrite Int.signed_zero in E; omegaContradiction. predSpec Int.eq Int.eq_spec (Int.repr sz) Int.mone. rewrite H0 in E; rewrite Int.signed_mone in E; omegaContradiction. - rewrite andb_false_r; auto. + rewrite andb_false_r; auto. - destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm. - eapply make_binarith_correct; eauto; intros; auto. Qed. @@ -546,10 +546,10 @@ Remark small_shift_amount_1: Int.ltu (Int64.loword i) Int64.iwordsize' = true /\ Int64.unsigned i = Int.unsigned (Int64.loword i). Proof. - intros. apply Int64.ltu_inv in H. comput (Int64.unsigned Int64.iwordsize). + intros. apply Int64.ltu_inv in H. comput (Int64.unsigned Int64.iwordsize). assert (Int64.unsigned i = Int.unsigned (Int64.loword i)). { - unfold Int64.loword. rewrite Int.unsigned_repr; auto. + unfold Int64.loword. rewrite Int.unsigned_repr; auto. comput Int.max_unsigned; omega. } split; auto. unfold Int.ltu. apply zlt_true. rewrite <- H0. tauto. @@ -563,7 +563,7 @@ Proof. intros. apply Int64.ltu_inv in H. comput (Int64.unsigned (Int64.repr 32)). assert (Int64.unsigned i = Int.unsigned (Int64.loword i)). { - unfold Int64.loword. rewrite Int.unsigned_repr; auto. + unfold Int64.loword. rewrite Int.unsigned_repr; auto. comput Int.max_unsigned; omega. } unfold Int.ltu. apply zlt_true. rewrite <- H0. tauto. @@ -574,7 +574,7 @@ Lemma small_shift_amount_3: Int.ltu i Int64.iwordsize' = true -> Int64.unsigned (Int64.repr (Int.unsigned i)) = Int.unsigned i. Proof. - intros. apply Int.ltu_inv in H. comput (Int.unsigned Int64.iwordsize'). + intros. apply Int.ltu_inv in H. comput (Int.unsigned Int64.iwordsize'). apply Int64.unsigned_repr. comput Int64.max_unsigned; omega. Qed. @@ -588,12 +588,12 @@ Proof. econstructor; eauto. simpl; rewrite E; auto. - destruct (Int64.ltu i0 Int64.iwordsize) eqn:E; inv SEM. exploit small_shift_amount_1; eauto. intros [A B]. - econstructor; eauto with cshm. simpl. rewrite A. + econstructor; eauto with cshm. simpl. rewrite A. f_equal; f_equal. unfold Int64.shl', Int64.shl. rewrite B; auto. - destruct (Int64.ltu i0 (Int64.repr 32)) eqn:E; inv SEM. - econstructor; eauto with cshm. simpl. rewrite small_shift_amount_2; auto. -- destruct (Int.ltu i0 Int64.iwordsize') eqn:E; inv SEM. - econstructor; eauto with cshm. simpl. rewrite E. + econstructor; eauto with cshm. simpl. rewrite small_shift_amount_2; auto. +- destruct (Int.ltu i0 Int64.iwordsize') eqn:E; inv SEM. + econstructor; eauto with cshm. simpl. rewrite E. unfold Int64.shl', Int64.shl. rewrite small_shift_amount_3; auto. Qed. @@ -612,9 +612,9 @@ Proof. unfold Int64.shr', Int64.shr; rewrite B; auto. unfold Int64.shru', Int64.shru; rewrite B; auto. - destruct (Int64.ltu i0 (Int64.repr 32)) eqn:E; inv SEM. - destruct s; inv H0; econstructor; eauto with cshm; simpl; rewrite small_shift_amount_2; auto. + destruct s; inv H0; econstructor; eauto with cshm; simpl; rewrite small_shift_amount_2; auto. - destruct (Int.ltu i0 Int64.iwordsize') eqn:E; inv SEM. - destruct s; inv H0; econstructor; eauto with cshm; simpl; rewrite E. + destruct s; inv H0; econstructor; eauto with cshm; simpl; rewrite E. unfold Int64.shr', Int64.shr; rewrite small_shift_amount_3; auto. unfold Int64.shru', Int64.shru; rewrite small_shift_amount_3; auto. Qed. @@ -622,7 +622,7 @@ Qed. Lemma make_cmp_correct: forall cmp a tya b tyb c va vb v e le m, sem_cmp cmp va tya vb tyb m = Some v -> - make_cmp cmp a tya b tyb = OK c -> + make_cmp cmp a tya b tyb = OK c -> eval_expr ge e le m a va -> eval_expr ge e le m b vb -> eval_expr ge e le m c v. @@ -632,38 +632,38 @@ Proof. - inv MAKE. destruct (Val.cmpu_bool (Mem.valid_pointer m) cmp va vb) as [bv|] eqn:E; simpl in SEM; inv SEM. econstructor; eauto. simpl. unfold Val.cmpu. rewrite E. auto. -- inv MAKE. destruct vb; try discriminate. +- inv MAKE. destruct vb; try discriminate. set (vb := Vint (Int.repr (Int64.unsigned i))) in *. destruct (Val.cmpu_bool (Mem.valid_pointer m) cmp va vb) as [bv|] eqn:E; simpl in SEM; inv SEM. - econstructor; eauto with cshm. simpl. change (Vint (Int64.loword i)) with vb. + econstructor; eauto with cshm. simpl. change (Vint (Int64.loword i)) with vb. unfold Val.cmpu. rewrite E. auto. -- inv MAKE. destruct va; try discriminate. +- inv MAKE. destruct va; try discriminate. set (va := Vint (Int.repr (Int64.unsigned i))) in *. destruct (Val.cmpu_bool (Mem.valid_pointer m) cmp va vb) as [bv|] eqn:E; simpl in SEM; inv SEM. - econstructor; eauto with cshm. simpl. change (Vint (Int64.loword i)) with va. + econstructor; eauto with cshm. simpl. change (Vint (Int64.loword i)) with va. unfold Val.cmpu. rewrite E. auto. - eapply make_binarith_correct; eauto; intros; auto. Qed. Lemma transl_unop_correct: - forall op a tya c va v e le m, + forall op a tya c va v e le m, transl_unop op a tya = OK c -> sem_unary_operation op va tya m = Some v -> eval_expr ge e le m a va -> eval_expr ge e le m c v. Proof. intros. destruct op; simpl in *. - eapply make_notbool_correct; eauto. - eapply make_notint_correct; eauto. + eapply make_notbool_correct; eauto. + eapply make_notint_correct; eauto. eapply make_neg_correct; eauto. eapply make_absfloat_correct; eauto. Qed. Lemma transl_binop_correct: forall op a tya b tyb c va vb v e le m, - transl_binop ce op a tya b tyb = OK c -> + transl_binop ce op a tya b tyb = OK c -> sem_binary_operation ce op va tya vb tyb m = Some v -> eval_expr ge e le m a va -> eval_expr ge e le m b vb -> @@ -686,7 +686,7 @@ Proof. eapply make_cmp_correct; eauto. eapply make_cmp_correct; eauto. eapply make_cmp_correct; eauto. -Qed. +Qed. Lemma make_load_correct: forall addr ty code b ofs v e le m, @@ -696,7 +696,7 @@ Lemma make_load_correct: eval_expr ge e le m code v. Proof. unfold make_load; intros until m; intros MKLOAD EVEXP DEREF. - inv DEREF. + inv DEREF. (* scalar *) rewrite H in MKLOAD. inv MKLOAD. apply eval_Eload with (Vptr b ofs); auto. (* by reference *) @@ -713,16 +713,16 @@ Lemma make_memcpy_correct: access_mode ty = By_copy -> step ge (State f (make_memcpy ce dst src ty) k e le m) E0 (State f Sskip k e le m'). Proof. - intros. inv H1; try congruence. - unfold make_memcpy. change le with (set_optvar None Vundef le) at 2. + intros. inv H1; try congruence. + unfold make_memcpy. change le with (set_optvar None Vundef le) at 2. econstructor. - econstructor. eauto. econstructor. eauto. constructor. - econstructor; eauto. + econstructor. eauto. econstructor. eauto. constructor. + econstructor; eauto. apply alignof_blockcopy_1248. apply sizeof_pos. apply sizeof_alignof_blockcopy_compat. Qed. - + Lemma make_store_correct: forall addr ty rhs code e le m b ofs v m' f k, make_store ce addr ty rhs = OK code -> @@ -735,10 +735,10 @@ Proof. inversion ASSIGN; subst. (* nonvolatile scalar *) rewrite H in MKSTORE; inv MKSTORE. - econstructor; eauto. + econstructor; eauto. (* by copy *) - rewrite H in MKSTORE; inv MKSTORE. - eapply make_memcpy_correct; eauto. + rewrite H in MKSTORE; inv MKSTORE. + eapply make_memcpy_correct; eauto. Qed. End CONSTRUCTORS. @@ -813,19 +813,19 @@ Proof. match x, y with | (b1, ty), (b2, sz) => b2 = b1 /\ sz = sizeof ge ty end). - assert (list_forall2 + assert (list_forall2 (fun i_x i_y => fst i_x = fst i_y /\ R (snd i_x) (snd i_y)) (PTree.elements e) (PTree.elements te)). apply PTree.elements_canonical_order. intros id [b ty] GET. exists (b, sizeof ge ty); split. eapply me_local; eauto. red; auto. intros id [b sz] GET. exploit me_local_inv; eauto. intros [ty EQ]. - exploit me_local; eauto. intros EQ1. + exploit me_local; eauto. intros EQ1. exists (b, ty); split. auto. red; split; congruence. unfold blocks_of_env, Clight.blocks_of_env. - generalize H0. induction 1. auto. + generalize H0. induction 1. auto. simpl. f_equal; auto. - unfold block_of_binding, Clight.block_of_binding. + unfold block_of_binding, Clight.block_of_binding. destruct a1 as [id1 [blk1 ty1]]. destruct b1 as [id2 [blk2 sz2]]. simpl in *. destruct H1 as [A [B C]]. congruence. Qed. @@ -867,19 +867,19 @@ Proof. constructor. (* me_local *) intros until ty0. repeat rewrite PTree.gsspec. - destruct (peq id0 id); intros. congruence. eapply me_local; eauto. + destruct (peq id0 id); intros. congruence. eapply me_local; eauto. (* me_local_inv *) - intros until sz. repeat rewrite PTree.gsspec. - destruct (peq id0 id); intros. exists ty; congruence. eapply me_local_inv; eauto. + intros until sz. repeat rewrite PTree.gsspec. + destruct (peq id0 id); intros. exists ty; congruence. eapply me_local_inv; eauto. intros [te2 [ALLOC MENV]]. exists te2; split. econstructor; eauto. auto. -Qed. +Qed. Lemma create_undef_temps_match: forall temps, create_undef_temps (map fst temps) = Clight.create_undef_temps temps. Proof. - induction temps; simpl. auto. + induction temps; simpl. auto. destruct a as [id ty]. simpl. decEq. auto. Qed. @@ -889,8 +889,8 @@ Lemma bind_parameter_temps_match: bind_parameters (map fst vars) vals le1 = Some le2. Proof. induction vars; simpl; intros. - destruct vals; inv H. auto. - destruct a as [id ty]. destruct vals; try discriminate. auto. + destruct vals; inv H. auto. + destruct a as [id ty]. destruct vals; try discriminate. auto. Qed. (** * Proof of semantic preservation *) @@ -909,9 +909,9 @@ Qed. >> Left: evaluation of r-value expression [a] in Clight. Right: evaluation of its translation [ta] in Csharpminor. - Top (precondition): matching between environments [e], [te], + Top (precondition): matching between environments [e], [te], plus well-typedness of expression [a]. - Bottom (postcondition): the result values [v] + Bottom (postcondition): the result values [v] are identical in both evaluations. We state these diagrams as the following properties, parameterized @@ -947,7 +947,7 @@ Proof. (* temp var *) constructor; auto. (* addrof *) - simpl in TR. auto. + simpl in TR. auto. (* unop *) eapply transl_unop_correct; eauto. (* binop *) @@ -960,21 +960,21 @@ Proof. apply make_intconst_correct. (* rvalue out of lvalue *) exploit transl_expr_lvalue; eauto. intros [tb [TRLVAL MKLOAD]]. - eapply make_load_correct; eauto. + eapply make_load_correct; eauto. (* var local *) exploit (me_local _ _ MENV); eauto. intros EQ. econstructor. eapply eval_var_addr_local. eauto. (* var global *) - econstructor. eapply eval_var_addr_global. + econstructor. eapply eval_var_addr_global. eapply match_env_globals; eauto. rewrite symbols_preserved. auto. (* deref *) - simpl in TR. eauto. + simpl in TR. eauto. (* field struct *) change (prog_comp_env prog) with (genv_cenv ge) in EQ0. unfold make_field_access in EQ0; rewrite H1, H2 in EQ0; monadInv EQ0. eapply eval_Ebinop; eauto. - apply make_intconst_correct. + apply make_intconst_correct. simpl. congruence. (* field union *) unfold make_field_access in EQ0; rewrite H1 in EQ0; monadInv EQ0. @@ -1003,8 +1003,8 @@ Lemma transl_arglist_correct: Proof. induction 1; intros. monadInv H. constructor. - monadInv H2. constructor. - eapply make_cast_correct; eauto. eapply transl_expr_correct; eauto. auto. + monadInv H2. constructor. + eapply make_cast_correct; eauto. eapply transl_expr_correct; eauto. auto. Qed. Lemma typlist_of_arglist_eq: @@ -1026,9 +1026,9 @@ End EXPR. << I S1 ------- R1 - | | + | | t | + | t - v v + v v S2 ------- R2 I I >> @@ -1047,8 +1047,8 @@ Lemma match_transl_step: match_transl (Sblock ts) tk ts' tk' -> star step tge (State f ts' tk' te le m) E0 (State f ts (Kblock tk) te le m). Proof. - intros. inv H. - apply star_one. constructor. + intros. inv H. + apply star_one. constructor. apply star_refl. Qed. @@ -1084,7 +1084,7 @@ Inductive match_cont: type -> nat -> nat -> Clight.cont -> Csharpminor.cont -> P transl_function ge f = OK tf -> match_env e te -> match_cont (Clight.fn_return f) nbrk' ncnt' k tk -> - match_cont tyret nbrk ncnt + match_cont tyret nbrk ncnt (Clight.Kcall id f e le k) (Kcall id tf te le tk). @@ -1107,7 +1107,7 @@ Inductive match_states: Clight.state -> Csharpminor.state -> Prop := match_states (Clight.Callstate fd args k m) (Callstate tfd args tk m) | match_returnstate: - forall res k m tk + forall res k m tk (MK: match_cont Tvoid 0%nat 0%nat k tk), match_states (Clight.Returnstate res k m) (Returnstate res tk m). @@ -1119,7 +1119,7 @@ Remark match_states_skip: match_cont (Clight.fn_return f) nbrk ncnt k tk -> match_states (Clight.State f Clight.Sskip k e le m) (State tf Sskip tk te le m). Proof. - intros. econstructor; eauto. simpl; reflexivity. constructor. + intros. econstructor; eauto. simpl; reflexivity. constructor. Qed. (** Commutation between label resolution and compilation *) @@ -1168,13 +1168,13 @@ Proof. (* builtin *) auto. (* seq *) - exploit (transl_find_label s0 nbrk ncnt (Clight.Kseq s1 k)); eauto. constructor; eauto. + exploit (transl_find_label s0 nbrk ncnt (Clight.Kseq s1 k)); eauto. constructor; eauto. destruct (Clight.find_label lbl s0 (Clight.Kseq s1 k)) as [[s' k'] | ]. intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]]. rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto. intro. rewrite H. eapply transl_find_label; eauto. (* ifthenelse *) - exploit (transl_find_label s0); eauto. + exploit (transl_find_label s0); eauto. destruct (Clight.find_label lbl s0 k) as [[s' k'] | ]. intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]]. rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto. @@ -1185,20 +1185,20 @@ Proof. intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]]. rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto. intro. rewrite H. - eapply transl_find_label; eauto. econstructor; eauto. + eapply transl_find_label; eauto. econstructor; eauto. (* break *) auto. (* continue *) auto. (* return *) - simpl in TR. destruct o; monadInv TR. auto. auto. + simpl in TR. destruct o; monadInv TR. auto. auto. (* switch *) assert (exists b, ts = Sblock (Sswitch b x x0)). { destruct (classify_switch (typeof e)); inv EQ2; econstructor; eauto. } destruct H as [b EQ3]; rewrite EQ3; simpl. - eapply transl_find_label_ls with (k := Clight.Kswitch k); eauto. econstructor; eauto. + eapply transl_find_label_ls with (k := Clight.Kswitch k); eauto. econstructor; eauto. (* label *) - destruct (ident_eq lbl l). + destruct (ident_eq lbl l). exists x; exists tk; exists nbrk; exists ncnt; auto. eapply transl_find_label; eauto. (* goto *) @@ -1208,7 +1208,7 @@ Proof. (* nil *) auto. (* cons *) - exploit (transl_find_label s nbrk ncnt (Clight.Kseq (seq_of_labeled_statement l) k)); eauto. + exploit (transl_find_label s nbrk ncnt (Clight.Kseq (seq_of_labeled_statement l) k)); eauto. econstructor; eauto. apply transl_lbl_stmt_2; eauto. destruct (Clight.find_label lbl s (Clight.Kseq (seq_of_labeled_statement l) k)) as [[s' k'] | ]. intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]]. @@ -1228,7 +1228,7 @@ Lemma match_cont_call_cont: Proof. induction 1; simpl; auto. constructor. - econstructor; eauto. + econstructor; eauto. Qed. Lemma match_cont_is_call_cont: @@ -1254,41 +1254,41 @@ Proof. (* assign *) monadInv TR. assert (SAME: ts' = ts /\ tk' = tk). - inversion MTR. auto. + inversion MTR. auto. subst ts. unfold make_store, make_memcpy in EQ3. destruct (access_mode (typeof a1)); congruence. destruct SAME; subst ts' tk'. econstructor; split. apply plus_one. eapply make_store_correct; eauto. eapply transl_lvalue_correct; eauto. eapply make_cast_correct; eauto. - eapply transl_expr_correct; eauto. + eapply transl_expr_correct; eauto. eapply match_states_skip; eauto. (* set *) monadInv TR. inv MTR. econstructor; split. - apply plus_one. econstructor. eapply transl_expr_correct; eauto. + apply plus_one. econstructor. eapply transl_expr_correct; eauto. eapply match_states_skip; eauto. (* call *) revert TR. simpl. case_eq (classify_fun (typeof a)); try congruence. - intros targs tres cc CF TR. monadInv TR. inv MTR. + intros targs tres cc CF TR. monadInv TR. inv MTR. exploit functions_translated; eauto. intros [tfd [FIND TFD]]. rewrite H in CF. simpl in CF. inv CF. econstructor; split. - apply plus_one. econstructor; eauto. + apply plus_one. econstructor; eauto. exploit transl_expr_correct; eauto. exploit transl_arglist_correct; eauto. - erewrite typlist_of_arglist_eq by eauto. + erewrite typlist_of_arglist_eq by eauto. eapply transl_fundef_sig1; eauto. rewrite H3. auto. - econstructor; eauto. + econstructor; eauto. econstructor; eauto. simpl. auto. (* builtin *) - monadInv TR. inv MTR. + monadInv TR. inv MTR. econstructor; split. - apply plus_one. econstructor. - eapply transl_arglist_correct; eauto. + apply plus_one. econstructor. + eapply transl_arglist_correct; eauto. eapply external_call_symbols_preserved_gen with (ge1 := ge). exact symbols_preserved. exact public_preserved. exact block_is_volatile_preserved. eauto. eapply match_states_skip; eauto. @@ -1296,31 +1296,31 @@ Proof. (* seq *) monadInv TR. inv MTR. econstructor; split. - apply plus_one. constructor. - econstructor; eauto. constructor. + apply plus_one. constructor. + econstructor; eauto. constructor. econstructor; eauto. (* skip seq *) monadInv TR. inv MTR. inv MK. econstructor; split. - apply plus_one. apply step_skip_seq. + apply plus_one. apply step_skip_seq. econstructor; eauto. constructor. (* continue seq *) monadInv TR. inv MTR. inv MK. econstructor; split. - apply plus_one. constructor. + apply plus_one. constructor. econstructor; eauto. simpl. reflexivity. constructor. (* break seq *) monadInv TR. inv MTR. inv MK. econstructor; split. - apply plus_one. constructor. + apply plus_one. constructor. econstructor; eauto. simpl. reflexivity. constructor. (* ifthenelse *) monadInv TR. inv MTR. - exploit make_boolean_correct; eauto. + exploit make_boolean_correct; eauto. exploit transl_expr_correct; eauto. intros [v [A B]]. econstructor; split. @@ -1330,12 +1330,12 @@ Proof. (* loop *) monadInv TR. econstructor; split. - eapply star_plus_trans. eapply match_transl_step; eauto. - eapply plus_left. constructor. + eapply star_plus_trans. eapply match_transl_step; eauto. + eapply plus_left. constructor. eapply star_left. constructor. apply star_one. constructor. reflexivity. reflexivity. traceEq. - econstructor; eauto. constructor. econstructor; eauto. + econstructor; eauto. constructor. econstructor; eauto. (* skip-or-continue loop *) assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk). @@ -1345,7 +1345,7 @@ Proof. eapply plus_left. destruct H0; subst ts'. 2:constructor. constructor. apply star_one. constructor. traceEq. - econstructor; eauto. constructor. econstructor; eauto. + econstructor; eauto. constructor. econstructor; eauto. (* break loop1 *) monadInv TR. inv MTR. inv MK. @@ -1362,9 +1362,9 @@ Proof. econstructor; split. apply plus_one. constructor. econstructor; eauto. -Local Opaque ge. - simpl. rewrite H5; simpl. rewrite H7; simpl. eauto. - constructor. +Local Opaque ge. + simpl. rewrite H5; simpl. rewrite H7; simpl. eauto. + constructor. (* break loop2 *) monadInv TR. inv MTR. inv MK. @@ -1375,21 +1375,21 @@ Local Opaque ge. eapply match_states_skip; eauto. (* return none *) - monadInv TR. inv MTR. + monadInv TR. inv MTR. econstructor; split. apply plus_one. constructor. - eapply match_env_free_blocks; eauto. + eapply match_env_free_blocks; eauto. econstructor; eauto. - eapply match_cont_call_cont. eauto. + eapply match_cont_call_cont. eauto. (* return some *) - monadInv TR. inv MTR. + monadInv TR. inv MTR. econstructor; split. apply plus_one. constructor. eapply make_cast_correct; eauto. eapply transl_expr_correct; eauto. eapply match_env_free_blocks; eauto. econstructor; eauto. - eapply match_cont_call_cont. eauto. + eapply match_cont_call_cont. eauto. (* skip call *) monadInv TR. inv MTR. @@ -1405,13 +1405,13 @@ Local Opaque ge. { unfold sem_switch_arg in H0. destruct (classify_switch (typeof a)); inv EQ2; econstructor; split; eauto; destruct v; inv H0; constructor. } - destruct E as (b & A & B). subst ts. + destruct E as (b & A & B). subst ts. exploit transl_expr_correct; eauto. intro EV. econstructor; split. eapply star_plus_trans. eapply match_transl_step; eauto. - apply plus_one. econstructor; eauto. traceEq. + apply plus_one. econstructor; eauto. traceEq. econstructor; eauto. - apply transl_lbl_stmt_2. apply transl_lbl_stmt_1. eauto. + apply transl_lbl_stmt_2. apply transl_lbl_stmt_1. eauto. constructor. econstructor. eauto. @@ -1427,29 +1427,29 @@ Local Opaque ge. (* continue switch *) monadInv TR. inv MTR. inv MK. econstructor; split. - apply plus_one. constructor. + apply plus_one. constructor. econstructor; eauto. simpl. reflexivity. constructor. (* label *) - monadInv TR. inv MTR. + monadInv TR. inv MTR. econstructor; split. - apply plus_one. constructor. + apply plus_one. constructor. econstructor; eauto. constructor. (* goto *) monadInv TR. inv MTR. generalize TRF. unfold transl_function. intro TRF'. monadInv TRF'. exploit (transl_find_label lbl). eexact EQ. eapply match_cont_call_cont. eauto. - rewrite H. + rewrite H. intros [ts' [tk'' [nbrk' [ncnt' [A [B C]]]]]]. econstructor; split. - apply plus_one. constructor. simpl. eexact A. + apply plus_one. constructor. simpl. eexact A. econstructor; eauto. constructor. (* internal function *) inv H. monadInv TR. monadInv EQ. exploit match_cont_is_call_cont; eauto. intros [A B]. - exploit match_env_alloc_variables; eauto. + exploit match_env_alloc_variables; eauto. apply match_env_empty. intros [te1 [C D]]. econstructor; split. @@ -1464,17 +1464,17 @@ Local Opaque ge. constructor. (* external function *) - simpl in TR. + simpl in TR. destruct (signature_eq (ef_sig ef) (signature_of_type targs tres cconv)); inv TR. exploit match_cont_is_call_cont; eauto. intros [A B]. econstructor; split. - apply plus_one. constructor. eauto. + apply plus_one. constructor. eauto. eapply external_call_symbols_preserved_gen with (ge1 := ge). exact symbols_preserved. exact public_preserved. exact block_is_volatile_preserved. eauto. econstructor; eauto. (* returnstate *) - inv MK. + inv MK. econstructor; split. apply plus_one. constructor. econstructor; eauto. simpl; reflexivity. constructor. @@ -1492,10 +1492,10 @@ Proof. change (prog_main prog) with (AST.prog_main (program_of_program prog)). eapply transform_partial_program2_main; eauto. assert (funsig tf = signature_of_type Tnil type_int32s cc_default). - eapply transl_fundef_sig2; eauto. + eapply transl_fundef_sig2; eauto. econstructor; split. - econstructor; eauto. eapply Genv.init_mem_transf_partial2; eauto. - econstructor; eauto. constructor; auto. exact I. + econstructor; eauto. eapply Genv.init_mem_transf_partial2; eauto. + econstructor; eauto. constructor; auto. exact I. Qed. Lemma transl_final_states: diff --git a/cfrontend/Cstrategy.v b/cfrontend/Cstrategy.v index b082ea56..b3cbacca 100644 --- a/cfrontend/Cstrategy.v +++ b/cfrontend/Cstrategy.v @@ -40,7 +40,7 @@ Variable ge: genv. (** We now formalize a particular strategy for reducing expressions which is the one implemented by the CompCert compiler. It evaluates effectful - subexpressions first, in leftmost-innermost order, then finishes + subexpressions first, in leftmost-innermost order, then finishes with the evaluation of the remaining simple expression. *) (** Simple expressions are defined as follows. *) @@ -99,7 +99,7 @@ Inductive eval_simple_lvalue: expr -> block -> int -> Prop := eval_simple_lvalue (Ederef r ty) b ofs | esl_field_struct: forall r f ty b ofs id co a delta, eval_simple_rvalue r (Vptr b ofs) -> - typeof r = Tstruct id a -> + typeof r = Tstruct id a -> ge.(genv_cenv)!id = Some co -> field_offset ge f (co_members co) = OK delta -> eval_simple_lvalue (Efield r f ty) b (Int.add ofs (Int.repr delta)) @@ -402,7 +402,7 @@ Hint Resolve context_compose contextlist_compose. (** * Safe executions. *) -(** A state is safe according to the nondeterministic semantics +(** A state is safe according to the nondeterministic semantics if it cannot get stuck by doing silent transitions only. *) Definition safe (s: Csem.state) : Prop := @@ -413,8 +413,8 @@ Lemma safe_steps: forall s s', safe s -> star Csem.step ge s E0 s' -> safe s'. Proof. - intros; red; intros. - eapply H. eapply star_trans; eauto. + intros; red; intros. + eapply H. eapply star_trans; eauto. Qed. Lemma star_safe: @@ -433,7 +433,7 @@ Proof. intros. eapply star_plus_trans; eauto. apply H1. eapply safe_steps; eauto. auto. Qed. -Require Import Classical. +Require Import Classical. Lemma safe_imm_safe: forall f C a k e m K, @@ -442,10 +442,10 @@ Lemma safe_imm_safe: imm_safe ge e K a m. Proof. intros. destruct (classic (imm_safe ge e K a m)); auto. - destruct (H Stuckstate). + destruct (H Stuckstate). apply star_one. left. econstructor; eauto. - destruct H2 as [r F]. inv F. - destruct H2 as [t [s' S]]. inv S. inv H2. inv H2. + destruct H2 as [r F]. inv F. + destruct H2 as [t [s' S]]. inv S. inv H2. inv H2. Qed. (** Safe expressions are well-formed with respect to l-values and r-values. *) @@ -649,11 +649,11 @@ Proof. destruct (C a); auto; contradiction. destruct (C a); auto; contradiction. destruct e1; auto. intros. elim (H0 a m); auto. - intros. elim (H0 a m); auto. + intros. elim (H0 a m); auto. destruct (C a); auto; contradiction. destruct (C a); auto; contradiction. - red; intros. destruct (C a); auto. - red; intros. destruct e1; auto. elim (H0 a m); auto. + red; intros. destruct (C a); auto. + red; intros. destruct e1; auto. elim (H0 a m); auto. Qed. Lemma imm_safe_inv: @@ -666,7 +666,7 @@ Lemma imm_safe_inv: end. Proof. destruct invert_expr_context as [A B]. - intros. inv H. + intros. inv H. auto. auto. assert (invert_expr_prop (C e0) m). @@ -733,7 +733,7 @@ Ltac FinishL := apply star_one; left; apply step_lred; eauto; simpl; try (econst Steps H2 (fun x => C(Ebinop op (Eval v1 (typeof r1)) x ty)). FinishR. (* cast *) - Steps H0 (fun x => C(Ecast x ty)). FinishR. + Steps H0 (fun x => C(Ecast x ty)). FinishR. (* sizeof *) FinishR. (* alignof *) @@ -741,11 +741,11 @@ Ltac FinishL := apply star_one; left; apply step_lred; eauto; simpl; try (econst (* loc *) apply star_refl. (* var local *) - FinishL. + FinishL. (* var global *) FinishL. apply red_var_global; auto. (* deref *) - Steps H0 (fun x => C(Ederef x ty)). FinishL. + Steps H0 (fun x => C(Ederef x ty)). FinishL. (* field struct *) Steps H0 (fun x => C(Efield x f0 ty)). rewrite H1 in *. FinishL. (* field union *) @@ -796,13 +796,13 @@ Ltac StepL REC C' a := let b := fresh "b" in let ofs := fresh "ofs" in let E := fresh "E" in let S := fresh "SAFE" in exploit (REC LV C'); eauto; intros [b [ofs E]]; - assert (S: safe (ExprState f (C' (Eloc b ofs (typeof a))) k e m)) by + assert (S: safe (ExprState f (C' (Eloc b ofs (typeof a))) k e m)) by (eapply (eval_simple_lvalue_safe C'); eauto); simpl in S. Ltac StepR REC C' a := let v := fresh "v" in let E := fresh "E" in let S := fresh "SAFE" in exploit (REC RV C'); eauto; intros [v E]; - assert (S: safe (ExprState f (C' (Eval v (typeof a))) k e m)) by + assert (S: safe (ExprState f (C' (Eval v (typeof a))) k e m)) by (eapply (eval_simple_rvalue_safe C'); eauto); simpl in S. @@ -857,22 +857,22 @@ Ltac StepR REC C' a := Qed. Lemma simple_can_eval_rval: - forall r C, + forall r C, simple r = true -> context RV RV C -> safe (ExprState f (C r) k e m) -> exists v, eval_simple_rvalue e m r v /\ safe (ExprState f (C (Eval v (typeof r))) k e m). Proof. - intros. exploit (simple_can_eval r RV); eauto. intros [v A]. + intros. exploit (simple_can_eval r RV); eauto. intros [v A]. exists v; split; auto. eapply eval_simple_rvalue_safe; eauto. Qed. Lemma simple_can_eval_lval: - forall l C, + forall l C, simple l = true -> context LV RV C -> safe (ExprState f (C l) k e m) -> exists b, exists ofs, eval_simple_lvalue e m l b ofs /\ safe (ExprState f (C (Eloc b ofs (typeof l))) k e m). Proof. - intros. exploit (simple_can_eval l LV); eauto. intros [b [ofs A]]. + intros. exploit (simple_can_eval l LV); eauto. intros [b [ofs A]]. exists b; exists ofs; split; auto. eapply eval_simple_lvalue_safe; eauto. Qed. @@ -892,7 +892,7 @@ Inductive eval_simple_list': exprlist -> list val -> Prop := Lemma eval_simple_list_implies: forall rl tyl vl, - eval_simple_list e m rl tyl vl -> + eval_simple_list e m rl tyl vl -> exists vl', cast_arguments (rval_list vl' rl) tyl vl /\ eval_simple_list' rl vl'. Proof. induction 1. @@ -908,9 +908,9 @@ Lemma can_eval_simple_list: cast_arguments (rval_list vl rl) tyl vl' -> eval_simple_list e m rl tyl vl'. Proof. - induction 1; simpl; intros. + induction 1; simpl; intros. inv H. constructor. - inv H1. econstructor; eauto. + inv H1. econstructor; eauto. Qed. Fixpoint exprlist_app (rl1 rl2: exprlist) : exprlist := @@ -924,7 +924,7 @@ Lemma exprlist_app_assoc: exprlist_app (exprlist_app rl1 rl2) rl3 = exprlist_app rl1 (exprlist_app rl2 rl3). Proof. - induction rl1; auto. simpl. congruence. + induction rl1; auto. simpl. congruence. Qed. Inductive contextlist' : (exprlist -> expr) -> Prop := @@ -939,9 +939,9 @@ Lemma exprlist_app_context: forall rl1 rl2, contextlist RV (fun x => exprlist_app rl1 (Econs x rl2)). Proof. - induction rl1; simpl; intros. + induction rl1; simpl; intros. apply ctx_list_head. constructor. - apply ctx_list_tail. auto. + apply ctx_list_tail. auto. Qed. Lemma contextlist'_head: @@ -949,14 +949,14 @@ Lemma contextlist'_head: contextlist' C -> context RV RV (fun x => C (Econs x rl)). Proof. - intros. inv H. + intros. inv H. set (C' := fun x => Ecall r1 (exprlist_app rl0 (Econs x rl)) ty). assert (context RV RV C'). constructor. apply exprlist_app_context. - change (context RV RV (fun x => C0 (C' x))). + change (context RV RV (fun x => C0 (C' x))). eapply context_compose; eauto. set (C' := fun x => Ebuiltin ef tyargs (exprlist_app rl0 (Econs x rl)) ty). assert (context RV RV C'). constructor. apply exprlist_app_context. - change (context RV RV (fun x => C0 (C' x))). + change (context RV RV (fun x => C0 (C' x))). eapply context_compose; eauto. Qed. @@ -965,14 +965,14 @@ Lemma contextlist'_tail: contextlist' C -> contextlist' (fun x => C (Econs r1 x)). Proof. - intros. inv H. + intros. inv H. replace (fun x => C0 (Ecall r0 (exprlist_app rl0 (Econs r1 x)) ty)) with (fun x => C0 (Ecall r0 (exprlist_app (exprlist_app rl0 (Econs r1 Enil)) x) ty)). - constructor. auto. + constructor. auto. apply extensionality; intros. f_equal. f_equal. apply exprlist_app_assoc. replace (fun x => C0 (Ebuiltin ef tyargs (exprlist_app rl0 (Econs r1 x)) ty)) with (fun x => C0 (Ebuiltin ef tyargs (exprlist_app (exprlist_app rl0 (Econs r1 Enil)) x) ty)). - constructor. auto. + constructor. auto. apply extensionality; intros. f_equal. f_equal. apply exprlist_app_assoc. Qed. @@ -984,7 +984,7 @@ Lemma eval_simple_list_steps: star Csem.step ge (ExprState f (C rl) k e m) E0 (ExprState f (C (rval_list vl rl)) k e m). Proof. - induction 1; intros. + induction 1; intros. (* nil *) apply star_refl. (* cons *) @@ -1003,7 +1003,7 @@ Lemma simple_list_can_eval: Proof. induction rl; intros. econstructor; constructor. - simpl in H. destruct (andb_prop _ _ H). + simpl in H. destruct (andb_prop _ _ H). exploit (simple_can_eval r1 RV (fun x => C(Econs x rl))); eauto. intros [v1 EV1]. exploit (IHrl (fun x => C(Econs (Eval v1 (typeof r1)) x))); eauto. @@ -1015,7 +1015,7 @@ Qed. Lemma rval_list_all_values: forall vl rl, exprlist_all_values (rval_list vl rl). Proof. - induction vl; simpl; intros. auto. + induction vl; simpl; intros. auto. destruct rl; simpl; auto. Qed. @@ -1105,13 +1105,13 @@ Ltac Base := (* comma *) Kind. Rec H RV C (fun x => Ecomma x r2 ty). Base. (* call *) - Kind. Rec H RV C (fun x => Ecall x rargs ty). + Kind. Rec H RV C (fun x => Ecall x rargs ty). destruct (H0 (fun x => C (Ecall r1 x ty))) as [A | [C' [a' [D [A B]]]]]. eapply contextlist'_call with (C := C) (rl0 := Enil). auto. auto. Base. right; exists (fun x => Ecall r1 (C' x) ty); exists a'. rewrite D; simpl; auto. (* builtin *) - Kind. + Kind. destruct (H (fun x => C (Ebuiltin ef tyargs x ty))) as [A | [C' [a' [D [A B]]]]]. eapply contextlist'_builtin with (C := C) (rl0 := Enil). auto. auto. Base. @@ -1123,7 +1123,7 @@ Ltac Base := eapply contextlist'_head; eauto. auto. destruct (H0 (fun x => C (Econs r1 x))) as [A' | [C' [a' [A' [B D]]]]]. eapply contextlist'_tail; eauto. auto. - rewrite A; rewrite A'; auto. + rewrite A; rewrite A'; auto. right; exists (fun x => Econs r1 (C' x)); exists a'. rewrite A'; eauto. right; exists (fun x => Econs (C' x) rl); exists a'. rewrite A; eauto. Qed. @@ -1145,43 +1145,43 @@ Lemma estep_simulation: forall S t S', estep S t S' -> plus Csem.step ge S t S'. Proof. - intros. inv H. + intros. inv H. (* simple *) exploit eval_simple_rvalue_steps; eauto. simpl; intros STEPS. - exploit star_inv; eauto. intros [[EQ1 EQ2] | A]; eauto. + exploit star_inv; eauto. intros [[EQ1 EQ2] | A]; eauto. inversion EQ1. rewrite <- H2 in H1; contradiction. (* valof volatile *) - eapply plus_right. + eapply plus_right. eapply eval_simple_lvalue_steps with (C := fun x => C(Evalof x (typeof l))); eauto. left. apply step_rred; eauto. econstructor; eauto. auto. (* seqand true *) eapply plus_right. - eapply eval_simple_rvalue_steps with (C := fun x => C(Eseqand x r2 ty)); eauto. + eapply eval_simple_rvalue_steps with (C := fun x => C(Eseqand x r2 ty)); eauto. left. apply step_rred; eauto. apply red_seqand_true; auto. traceEq. (* seqand false *) eapply plus_right. - eapply eval_simple_rvalue_steps with (C := fun x => C(Eseqand x r2 ty)); eauto. + eapply eval_simple_rvalue_steps with (C := fun x => C(Eseqand x r2 ty)); eauto. left. apply step_rred; eauto. apply red_seqand_false; auto. traceEq. (* seqor true *) eapply plus_right. - eapply eval_simple_rvalue_steps with (C := fun x => C(Eseqor x r2 ty)); eauto. + eapply eval_simple_rvalue_steps with (C := fun x => C(Eseqor x r2 ty)); eauto. left. apply step_rred; eauto. apply red_seqor_true; auto. traceEq. (* seqor false *) eapply plus_right. - eapply eval_simple_rvalue_steps with (C := fun x => C(Eseqor x r2 ty)); eauto. + eapply eval_simple_rvalue_steps with (C := fun x => C(Eseqor x r2 ty)); eauto. left. apply step_rred; eauto. apply red_seqor_false; auto. traceEq. (* condition *) eapply plus_right. eapply eval_simple_rvalue_steps with (C := fun x => C(Econdition x r2 r3 ty)); eauto. - left; apply step_rred; eauto. constructor; auto. auto. + left; apply step_rred; eauto. constructor; auto. auto. (* assign *) eapply star_plus_trans. eapply eval_simple_lvalue_steps with (C := fun x => C(Eassign x r (typeof l))); eauto. eapply plus_right. eapply eval_simple_rvalue_steps with (C := fun x => C(Eassign (Eloc b ofs (typeof l)) x (typeof l))); eauto. left; apply step_rred; eauto. econstructor; eauto. - reflexivity. auto. -(* assignop *) + reflexivity. auto. +(* assignop *) eapply star_plus_trans. eapply eval_simple_lvalue_steps with (C := fun x => C(Eassignop op x r tyres (typeof l))); eauto. eapply star_plus_trans. @@ -1189,9 +1189,9 @@ Proof. eapply plus_left. left; apply step_rred; auto. econstructor; eauto. eapply star_left. - left; apply step_rred with (C := fun x => C(Eassign (Eloc b ofs (typeof l)) x (typeof l))); eauto. econstructor; eauto. - apply star_one. - left; apply step_rred; auto. econstructor; eauto. + left; apply step_rred with (C := fun x => C(Eassign (Eloc b ofs (typeof l)) x (typeof l))); eauto. econstructor; eauto. + apply star_one. + left; apply step_rred; auto. econstructor; eauto. reflexivity. reflexivity. reflexivity. traceEq. (* assignop stuck *) eapply star_plus_trans. @@ -1202,8 +1202,8 @@ Proof. left; apply step_rred; auto. econstructor; eauto. destruct (sem_binary_operation ge op v1 (typeof l) v2 (typeof r) m) as [v3|] eqn:?. eapply star_left. - left; apply step_rred with (C := fun x => C(Eassign (Eloc b ofs (typeof l)) x (typeof l))); eauto. econstructor; eauto. - apply star_one. + left; apply step_rred with (C := fun x => C(Eassign (Eloc b ofs (typeof l)) x (typeof l))); eauto. econstructor; eauto. + apply star_one. left; eapply step_stuck; eauto. red; intros. exploit imm_safe_inv; eauto. simpl. intros [v4' [m' [t' [A [B D]]]]]. rewrite B in H4. eelim H4; eauto. @@ -1220,12 +1220,12 @@ Proof. left; apply step_rred; auto. econstructor; eauto. eapply star_left. left; apply step_rred with (C := fun x => C (Ecomma (Eassign (Eloc b ofs (typeof l)) x (typeof l)) (Eval v1 (typeof l)) (typeof l))); eauto. - econstructor. instantiate (1 := v2). destruct id; assumption. + econstructor. instantiate (1 := v2). destruct id; assumption. eapply star_left. left; apply step_rred with (C := fun x => C (Ecomma x (Eval v1 (typeof l)) (typeof l))); eauto. econstructor; eauto. apply star_one. - left; apply step_rred; auto. econstructor; eauto. + left; apply step_rred; auto. econstructor; eauto. reflexivity. reflexivity. reflexivity. traceEq. (* postincr stuck *) eapply star_plus_trans. @@ -1248,7 +1248,7 @@ Proof. apply star_one. left; eapply step_stuck with (C := fun x => C (Ecomma (Eassign (Eloc b ofs (typeof l)) x (typeof l)) (Eval v1 (typeof l)) (typeof l))); eauto. red; intros. exploit imm_safe_inv; eauto. simpl. intros [v2 A]. congruence. - reflexivity. + reflexivity. traceEq. (* comma *) eapply plus_right. @@ -1260,7 +1260,7 @@ Proof. left; apply step_rred; eauto. econstructor; eauto. auto. (* call *) exploit eval_simple_list_implies; eauto. intros [vl' [A B]]. - eapply star_plus_trans. + eapply star_plus_trans. eapply eval_simple_rvalue_steps with (C := fun x => C(Ecall x rargs ty)); eauto. eapply plus_right. eapply eval_simple_list_steps with (C := fun x => C(Ecall (Eval vf (typeof rf)) x ty)); eauto. @@ -1273,7 +1273,7 @@ Proof. eapply eval_simple_list_steps with (C := fun x => C(Ebuiltin ef tyargs x ty)); eauto. eapply contextlist'_builtin with (rl0 := Enil); auto. left; apply Csem.step_rred; eauto. econstructor; eauto. - traceEq. + traceEq. Qed. Lemma can_estep: @@ -1285,34 +1285,34 @@ Proof. intros. destruct (decompose_topexpr f k e m a H) as [A | [C [b [P [Q R]]]]]. (* simple expr *) exploit (simple_can_eval f k e m a RV (fun x => x)); auto. intros [v P]. - econstructor; econstructor; eapply step_expr; eauto. + econstructor; econstructor; eapply step_expr; eauto. (* side effect *) - clear H0. subst a. red in Q. destruct b; try contradiction. + clear H0. subst a. red in Q. destruct b; try contradiction. (* valof volatile *) destruct Q. exploit (simple_can_eval_lval f k e m b (fun x => C(Evalof x ty))); eauto. intros [b1 [ofs [E1 S1]]]. exploit safe_inv. eexact S1. eauto. simpl. intros [A [t [v B]]]. - econstructor; econstructor; eapply step_rvalof_volatile; eauto. congruence. + econstructor; econstructor; eapply step_rvalof_volatile; eauto. congruence. (* seqand *) exploit (simple_can_eval_rval f k e m b1 (fun x => C(Eseqand x b2 ty))); eauto. intros [v1 [E1 S1]]. exploit safe_inv. eexact S1. eauto. simpl. intros [b BV]. destruct b. - econstructor; econstructor; eapply step_seqand_true; eauto. - econstructor; econstructor; eapply step_seqand_false; eauto. + econstructor; econstructor; eapply step_seqand_true; eauto. + econstructor; econstructor; eapply step_seqand_false; eauto. (* seqor *) exploit (simple_can_eval_rval f k e m b1 (fun x => C(Eseqor x b2 ty))); eauto. intros [v1 [E1 S1]]. exploit safe_inv. eexact S1. eauto. simpl. intros [b BV]. destruct b. - econstructor; econstructor; eapply step_seqor_true; eauto. - econstructor; econstructor; eapply step_seqor_false; eauto. + econstructor; econstructor; eapply step_seqor_true; eauto. + econstructor; econstructor; eapply step_seqor_false; eauto. (* condition *) exploit (simple_can_eval_rval f k e m b1 (fun x => C(Econdition x b2 b3 ty))); eauto. intros [v1 [E1 S1]]. exploit safe_inv. eexact S1. eauto. simpl. intros [b BV]. - econstructor; econstructor. eapply step_condition; eauto. + econstructor; econstructor. eapply step_condition; eauto. (* assign *) destruct Q. exploit (simple_can_eval_lval f k e m b1 (fun x => C(Eassign x b2 ty))); eauto. @@ -1320,7 +1320,7 @@ Proof. exploit (simple_can_eval_rval f k e m b2 (fun x => C(Eassign (Eloc b ofs (typeof b1)) x ty))); eauto. intros [v [E2 S2]]. exploit safe_inv. eexact S2. eauto. simpl. intros [v' [m' [t [A [B D]]]]]. - econstructor; econstructor; eapply step_assign; eauto. + econstructor; econstructor; eapply step_assign; eauto. (* assignop *) destruct Q. exploit (simple_can_eval_lval f k e m b1 (fun x => C(Eassignop op x b2 tyres ty))); eauto. @@ -1333,11 +1333,11 @@ Proof. destruct (classic (exists t2, exists m', assign_loc ge (typeof b1) m b ofs v4 t2 m')). destruct H2 as [t2 [m' D]]. econstructor; econstructor; eapply step_assignop; eauto. - econstructor; econstructor; eapply step_assignop_stuck; eauto. + econstructor; econstructor; eapply step_assignop_stuck; eauto. rewrite Heqo. rewrite Heqo0. intros; red; intros. elim H2. exists t2; exists m'; auto. - econstructor; econstructor; eapply step_assignop_stuck; eauto. + econstructor; econstructor; eapply step_assignop_stuck; eauto. rewrite Heqo. rewrite Heqo0. auto. - econstructor; econstructor; eapply step_assignop_stuck; eauto. + econstructor; econstructor; eapply step_assignop_stuck; eauto. rewrite Heqo. auto. (* postincr *) exploit (simple_can_eval_lval f k e m b (fun x => C(Epostincr id x ty))); eauto. @@ -1348,11 +1348,11 @@ Proof. destruct (classic (exists t2, exists m', assign_loc ge ty m b1 ofs v3 t2 m')). destruct H0 as [t2 [m' D]]. econstructor; econstructor; eapply step_postincr; eauto. - econstructor; econstructor; eapply step_postincr_stuck; eauto. + econstructor; econstructor; eapply step_postincr_stuck; eauto. rewrite Heqo. rewrite Heqo0. intros; red; intros. elim H0. exists t2; exists m'; congruence. - econstructor; econstructor; eapply step_postincr_stuck; eauto. + econstructor; econstructor; eapply step_postincr_stuck; eauto. rewrite Heqo. rewrite Heqo0. auto. - econstructor; econstructor; eapply step_postincr_stuck; eauto. + econstructor; econstructor; eapply step_postincr_stuck; eauto. rewrite Heqo. auto. (* comma *) exploit (simple_can_eval_rval f k e m b1 (fun x => C(Ecomma x b2 ty))); eauto. @@ -1370,9 +1370,9 @@ Proof. exploit safe_inv. 2: eapply leftcontext_context; eexact R. eapply safe_steps. eexact S1. apply (eval_simple_list_steps f k e m rargs vl E2 C'); auto. - simpl. intros X. exploit X. eapply rval_list_all_values. + simpl. intros X. exploit X. eapply rval_list_all_values. intros [tyargs [tyres [cconv [fd [vargs [P [Q [U V]]]]]]]]. - econstructor; econstructor; eapply step_call; eauto. eapply can_eval_simple_list; eauto. + econstructor; econstructor; eapply step_call; eauto. eapply can_eval_simple_list; eauto. (* builtin *) pose (C' := fun x => C(Ebuiltin ef tyargs x ty)). assert (contextlist' C'). unfold C'; eapply contextlist'_builtin with (rl0 := Enil); auto. @@ -1384,7 +1384,7 @@ Proof. simpl. intros X. exploit X. eapply rval_list_all_values. intros [vargs [t [vres [m' [U V]]]]]. econstructor; econstructor; eapply step_builtin; eauto. - eapply can_eval_simple_list; eauto. + eapply can_eval_simple_list; eauto. (* paren *) exploit (simple_can_eval_rval f k e m b (fun x => C(Eparen x tycast ty))); eauto. intros [v1 [E1 S1]]. @@ -1415,9 +1415,9 @@ Proof. assert (exists t, exists S', estep S t S'). inv H0. (* lred *) - eapply can_estep; eauto. inv H2; auto. + eapply can_estep; eauto. inv H2; auto. (* rred *) - eapply can_estep; eauto. inv H2; auto. inv H1; auto. + eapply can_estep; eauto. inv H2; auto. inv H1; auto. (* callred *) eapply can_estep; eauto. inv H2; auto. inv H1; auto. (* stuck *) @@ -1444,7 +1444,7 @@ Remark deref_loc_trace: deref_loc ge ty m b ofs t v -> match t with nil => True | ev :: nil => True | _ => False end. Proof. - intros. inv H; simpl; auto. inv H2; simpl; auto. + intros. inv H; simpl; auto. inv H2; simpl; auto. Qed. Remark deref_loc_receptive: @@ -1455,7 +1455,7 @@ Remark deref_loc_receptive: Proof. intros. assert (t1 = nil). exploit deref_loc_trace; eauto. destruct t1; simpl; tauto. - inv H. exploit volatile_load_receptive; eauto. intros [v' A]. + inv H. exploit volatile_load_receptive; eauto. intros [v' A]. split; auto; exists v'; econstructor; eauto. Qed. @@ -1464,7 +1464,7 @@ Remark assign_loc_trace: assign_loc ge ty m b ofs v t m' -> match t with nil => True | ev :: nil => output_event ev | _ => False end. Proof. - intros. inv H; simpl; auto. inv H2; simpl; auto. + intros. inv H; simpl; auto. inv H2; simpl; auto. Qed. Remark assign_loc_receptive: @@ -1475,10 +1475,10 @@ Remark assign_loc_receptive: Proof. intros. assert (t1 = nil). exploit assign_loc_trace; eauto. destruct t1; simpl; tauto. - inv H. eapply volatile_store_receptive; eauto. + inv H. eapply volatile_store_receptive; eauto. Qed. -Lemma semantics_strongly_receptive: +Lemma semantics_strongly_receptive: forall p, strongly_receptive (semantics p). Proof. intros. constructor; simpl; intros. @@ -1487,78 +1487,78 @@ Proof. inversion H; subst. inv H1. (* valof volatile *) - exploit deref_loc_receptive; eauto. intros [A [v' B]]. - econstructor; econstructor. left; eapply step_rvalof_volatile; eauto. + exploit deref_loc_receptive; eauto. intros [A [v' B]]. + econstructor; econstructor. left; eapply step_rvalof_volatile; eauto. (* assign *) exploit assign_loc_receptive; eauto. intro EQ; rewrite EQ in H. econstructor; econstructor; eauto. (* assignop *) - destruct t0 as [ | ev0 t0]; simpl in H10. + destruct t0 as [ | ev0 t0]; simpl in H10. subst t2. exploit assign_loc_receptive; eauto. intros EQ; rewrite EQ in H. econstructor; econstructor; eauto. inv H10. exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t0. destruct (sem_binary_operation ge op v1' (typeof l) v2 (typeof r) m) as [v3'|] eqn:?. destruct (sem_cast v3' tyres (typeof l)) as [v4'|] eqn:?. destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v4' t2' m'')). - destruct H1 as [t2' [m'' P]]. - econstructor; econstructor. left; eapply step_assignop with (v1 := v1'); eauto. simpl; reflexivity. - econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. + destruct H1 as [t2' [m'' P]]. + econstructor; econstructor. left; eapply step_assignop with (v1 := v1'); eauto. simpl; reflexivity. + econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t0; exists m'0; auto. - econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. + econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. rewrite Heqo; rewrite Heqo0; auto. - econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. + econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. rewrite Heqo; auto. (* assignop stuck *) exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t1. destruct (sem_binary_operation ge op v1' (typeof l) v2 (typeof r) m) as [v3'|] eqn:?. destruct (sem_cast v3' tyres (typeof l)) as [v4'|] eqn:?. destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v4' t2' m'')). - destruct H1 as [t2' [m'' P]]. - econstructor; econstructor. left; eapply step_assignop with (v1 := v1'); eauto. simpl; reflexivity. - econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. + destruct H1 as [t2' [m'' P]]. + econstructor; econstructor. left; eapply step_assignop with (v1 := v1'); eauto. simpl; reflexivity. + econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t2; exists m'; auto. - econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. + econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. rewrite Heqo; rewrite Heqo0; auto. - econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. + econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto. rewrite Heqo; auto. (* postincr *) - destruct t0 as [ | ev0 t0]; simpl in H9. + destruct t0 as [ | ev0 t0]; simpl in H9. subst t2. exploit assign_loc_receptive; eauto. intros EQ; rewrite EQ in H. econstructor; econstructor; eauto. inv H9. exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t0. destruct (sem_incrdecr ge id v1' (typeof l)) as [v2'|] eqn:?. destruct (sem_cast v2' (incrdecr_type (typeof l)) (typeof l)) as [v3'|] eqn:?. destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v3' t2' m'')). - destruct H1 as [t2' [m'' P]]. - econstructor; econstructor. left; eapply step_postincr with (v1 := v1'); eauto. simpl; reflexivity. - econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. + destruct H1 as [t2' [m'' P]]. + econstructor; econstructor. left; eapply step_postincr with (v1 := v1'); eauto. simpl; reflexivity. + econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t0; exists m'0; auto. - econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. + econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. rewrite Heqo; rewrite Heqo0; auto. - econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. + econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. rewrite Heqo; auto. (* postincr stuck *) exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t1. destruct (sem_incrdecr ge id v1' (typeof l)) as [v2'|] eqn:?. destruct (sem_cast v2' (incrdecr_type (typeof l)) (typeof l)) as [v3'|] eqn:?. destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v3' t2' m'')). - destruct H1 as [t2' [m'' P]]. - econstructor; econstructor. left; eapply step_postincr with (v1 := v1'); eauto. simpl; reflexivity. - econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. + destruct H1 as [t2' [m'' P]]. + econstructor; econstructor. left; eapply step_postincr with (v1 := v1'); eauto. simpl; reflexivity. + econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t2; exists m'; auto. - econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. + econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. rewrite Heqo; rewrite Heqo0; auto. - econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. + econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto. rewrite Heqo; auto. (* builtin *) - exploit external_call_trace_length; eauto. destruct t1; simpl; intros. - exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. + exploit external_call_trace_length; eauto. destruct t1; simpl; intros. + exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. econstructor; econstructor. left; eapply step_builtin; eauto. omegaContradiction. (* external calls *) inv H1. - exploit external_call_trace_length; eauto. destruct t1; simpl; intros. - exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. + exploit external_call_trace_length; eauto. destruct t1; simpl; intros. + exploit external_call_receptive; eauto. intros [vres2 [m2 EC2]]. exists (Returnstate vres2 k m2); exists E0; right; econstructor; eauto. omegaContradiction. (* well-behaved traces *) @@ -1569,15 +1569,15 @@ Proof. exploit assign_loc_trace; eauto. destruct t; auto. destruct t; simpl; tauto. (* assignop *) exploit deref_loc_trace; eauto. exploit assign_loc_trace; eauto. - destruct t1. destruct t2. simpl; auto. destruct t2; simpl; tauto. - destruct t1. destruct t2. simpl; auto. destruct t2; simpl; tauto. + destruct t1. destruct t2. simpl; auto. destruct t2; simpl; tauto. + destruct t1. destruct t2. simpl; auto. destruct t2; simpl; tauto. tauto. (* assignop stuck *) exploit deref_loc_trace; eauto. destruct t; auto. destruct t; tauto. (* postincr *) exploit deref_loc_trace; eauto. exploit assign_loc_trace; eauto. - destruct t1. destruct t2. simpl; auto. destruct t2; simpl; tauto. - destruct t1. destruct t2. simpl; auto. destruct t2; simpl; tauto. + destruct t1. destruct t2. simpl; auto. destruct t2; simpl; tauto. + destruct t1. destruct t2. simpl; auto. destruct t2; simpl; tauto. tauto. (* postincr stuck *) exploit deref_loc_trace; eauto. destruct t; auto. destruct t; tauto. @@ -1603,9 +1603,9 @@ Proof. (* initial states match *) intros. exists s2; auto. (* final states match *) - intros. subst s2. auto. + intros. subst s2. auto. (* progress *) - intros. subst s2. apply progress. auto. + intros. subst s2. apply progress. auto. (* simulation *) intros. subst s1. exists s2'; split; auto. apply step_simulation; auto. Qed. @@ -1647,7 +1647,7 @@ Definition outcome_result_value (out: outcome) (t: type) (v: val) : Prop := | Out_return None, Tvoid => v = Vundef | Out_return (Some (v', ty')), ty => ty <> Tvoid /\ sem_cast v' ty' ty = Some v | _, _ => False - end. + end. (** [eval_expression ge e m1 a t m2 a'] describes the evaluation of the complex expression e. [v] is the resulting value, [m2] the final @@ -1775,7 +1775,7 @@ with eval_exprlist: env -> mem -> exprlist -> trace -> mem -> exprlist -> Prop : eval_expr e m RV a1 t1 m1 a1' -> eval_exprlist e m1 al t2 m2 al' -> eval_exprlist e m (Econs a1 al) (t1**t2) m2 (Econs a1' al') -(** [exec_stmt ge e m1 s t m2 out] describes the execution of +(** [exec_stmt ge e m1 s t m2 out] describes the execution of the statement [s]. [out] is the outcome for this execution. [m1] is the initial memory state, [m2] the final memory state. [t] is the trace of input/output events performed during this @@ -1856,12 +1856,12 @@ with exec_stmt: env -> mem -> statement -> trace -> mem -> outcome -> Prop := eval_expression e m1 a t2 m2 v -> bool_val v (typeof a) m2 = Some true -> exec_stmt e m2 (Sdowhile a s) t3 m3 out -> - exec_stmt e m (Sdowhile a s) + exec_stmt e m (Sdowhile a s) (t1 ** t2 ** t3) m3 out | exec_Sfor_start: forall e m s a1 a2 a3 out m1 m2 t1 t2, exec_stmt e m a1 t1 m1 Out_normal -> exec_stmt e m1 (Sfor Sskip a2 a3 s) t2 m2 out -> - exec_stmt e m (Sfor a1 a2 a3 s) + exec_stmt e m (Sfor a1 a2 a3 s) (t1 ** t2) m2 out | exec_Sfor_false: forall e m s a2 a3 t m' v, eval_expression e m a2 t m' v -> @@ -1998,7 +1998,7 @@ CoInductive evalinf_expr: env -> mem -> kind -> expr -> traceinf -> Prop := evalinf_expr e m RV a1 t1 -> evalinf_expr e m RV (Ecall a1 a2 ty) t1 | evalinf_call_right: forall e m a1 t1 m1 a1' a2 t2 ty, - eval_expr e m RV a1 t1 m1 a1' -> + eval_expr e m RV a1 t1 m1 a1' -> evalinf_exprlist e m1 a2 t2 -> evalinf_expr e m RV (Ecall a1 a2 ty) (t1 *** t2) | evalinf_call: forall e m rf rargs ty t1 m1 rf' t2 m2 rargs' vf vargs @@ -2020,7 +2020,7 @@ with evalinf_exprlist: env -> mem -> exprlist -> traceinf -> Prop := eval_expr e m RV a1 t1 m1 a1' -> evalinf_exprlist e m1 al t2 -> evalinf_exprlist e m (Econs a1 al) (t1***t2) -(** [execinf_stmt ge e m1 s t] describes the diverging execution of +(** [execinf_stmt ge e m1 s t] describes the diverging execution of the statement [s]. *) with execinf_stmt: env -> mem -> statement -> traceinf -> Prop := @@ -2137,7 +2137,7 @@ Inductive outcome_state_match outcome_state_match e m f k Out_continue (State f Scontinue k e m) | osm_return_none: forall k', call_cont k' = call_cont k -> - outcome_state_match e m f k + outcome_state_match e m f k (Out_return None) (State f (Sreturn None) k' e m) | osm_return_some: forall v ty k', call_cont k' = call_cont k -> @@ -2168,16 +2168,16 @@ Lemma exprlist_app_leftcontext: forall rl1 rl2, simplelist rl1 = true -> leftcontextlist RV (fun x => exprlist_app rl1 (Econs x rl2)). Proof. - induction rl1; simpl; intros. + induction rl1; simpl; intros. apply lctx_list_head. constructor. - destruct (andb_prop _ _ H). apply lctx_list_tail. auto. auto. + destruct (andb_prop _ _ H). apply lctx_list_tail. auto. auto. Qed. Lemma exprlist_app_simple: forall rl1 rl2, simplelist (exprlist_app rl1 rl2) = simplelist rl1 && simplelist rl2. Proof. - induction rl1; intros; simpl. auto. rewrite IHrl1. apply andb_assoc. + induction rl1; intros; simpl. auto. rewrite IHrl1. apply andb_assoc. Qed. Lemma bigstep_to_steps: @@ -2212,9 +2212,9 @@ Proof. exploit (H0 (fun x => x) f k). constructor. intros [A [B C]]. assert (match a' with Eval _ _ => False | _ => True end -> star step ge (ExprState f a k e m) t (ExprState f (Eval v (typeof a)) k e m')). - intro. eapply star_right. eauto. left. eapply step_expr; eauto. traceEq. + intro. eapply star_right. eauto. left. eapply step_expr; eauto. traceEq. destruct a'; auto. - simpl in B. rewrite B in C. inv H1. auto. + simpl in B. rewrite B in C. inv H1. auto. (* val *) simpl; intuition. apply star_refl. @@ -2223,7 +2223,7 @@ Proof. (* field *) exploit (H0 (fun x => C(Efield x f ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. - simpl; intuition; eauto. + simpl; intuition; eauto. (* valof *) exploit (H1 (fun x => C(Evalof x ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. @@ -2232,8 +2232,8 @@ Proof. exploit (H1 (fun x => C(Evalof x ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. simpl; intuition. - eapply star_right. eexact D. - left. eapply step_rvalof_volatile; eauto. rewrite H4; eauto. congruence. congruence. + eapply star_right. eexact D. + left. eapply step_rvalof_volatile; eauto. rewrite H4; eauto. congruence. congruence. traceEq. (* deref *) exploit (H0 (fun x => C(Ederef x ty))). @@ -2252,7 +2252,7 @@ Proof. eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. exploit (H2 (fun x => C(Ebinop op a1' x ty))). eapply leftcontext_compose; eauto. repeat constructor. auto. intros [E [F G]]. - simpl; intuition. eapply star_trans; eauto. + simpl; intuition. eapply star_trans; eauto. (* cast *) exploit (H0 (fun x => C(Ecast x ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. @@ -2262,15 +2262,15 @@ Proof. eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. exploit (H4 (fun x => C(Eparen x type_bool ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [E [F G]]. - simpl; intuition. eapply star_trans. eexact D. - eapply star_left. left; eapply step_seqand_true; eauto. rewrite B; auto. + simpl; intuition. eapply star_trans. eexact D. + eapply star_left. left; eapply step_seqand_true; eauto. rewrite B; auto. eapply star_right. eexact G. left; eapply step_paren; eauto. rewrite F; eauto. - eauto. eauto. traceEq. + eauto. eauto. traceEq. (* seqand false *) exploit (H0 (fun x => C(Eseqand x a2 ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. - simpl; intuition. eapply star_right. eexact D. + simpl; intuition. eapply star_right. eexact D. left; eapply step_seqand_false; eauto. rewrite B; auto. traceEq. (* seqor false *) @@ -2278,15 +2278,15 @@ Proof. eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. exploit (H4 (fun x => C(Eparen x type_bool ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [E [F G]]. - simpl; intuition. eapply star_trans. eexact D. - eapply star_left. left; eapply step_seqor_false; eauto. rewrite B; auto. + simpl; intuition. eapply star_trans. eexact D. + eapply star_left. left; eapply step_seqor_false; eauto. rewrite B; auto. eapply star_right. eexact G. left; eapply step_paren; eauto. rewrite F; eauto. - eauto. eauto. traceEq. + eauto. eauto. traceEq. (* seqor true *) exploit (H0 (fun x => C(Eseqor x a2 ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. - simpl; intuition. eapply star_right. eexact D. + simpl; intuition. eapply star_right. eexact D. left; eapply step_seqor_true; eauto. rewrite B; auto. traceEq. (* condition *) @@ -2294,10 +2294,10 @@ Proof. eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. exploit (H4 (fun x => C(Eparen x ty ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [E [F G]]. - simpl. split; auto. split; auto. + simpl. split; auto. split; auto. eapply star_trans. eexact D. - eapply star_left. left; eapply step_condition; eauto. rewrite B; eauto. - eapply star_right. eexact G. left; eapply step_paren; eauto. congruence. + eapply star_left. left; eapply step_condition; eauto. rewrite B; eauto. + eapply star_right. eexact G. left; eapply step_paren; eauto. congruence. reflexivity. reflexivity. traceEq. (* sizeof *) simpl; intuition. apply star_refl. @@ -2309,7 +2309,7 @@ Proof. exploit (H2 (fun x => C(Eassign l' x ty))). eapply leftcontext_compose; eauto. repeat constructor. auto. intros [E [F G]]. simpl; intuition. - eapply star_trans. eexact D. + eapply star_trans. eexact D. eapply star_right. eexact G. left. eapply step_assign; eauto. congruence. rewrite B; eauto. congruence. reflexivity. traceEq. @@ -2319,7 +2319,7 @@ Proof. exploit (H2 (fun x => C(Eassignop op l' x tyres ty))). eapply leftcontext_compose; eauto. repeat constructor. auto. intros [E [F G]]. simpl; intuition. - eapply star_trans. eexact D. + eapply star_trans. eexact D. eapply star_right. eexact G. left. eapply step_assignop; eauto. rewrite B; eauto. rewrite B; rewrite F; eauto. congruence. rewrite B; eauto. congruence. @@ -2328,8 +2328,8 @@ Proof. exploit (H0 (fun x => C(Epostincr id x ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. simpl; intuition. - eapply star_right. eexact D. - left. eapply step_postincr; eauto. congruence. + eapply star_right. eexact D. + left. eapply step_postincr; eauto. congruence. traceEq. (* comma *) exploit (H0 (fun x => C(Ecomma x r2 ty))). @@ -2337,19 +2337,19 @@ Proof. exploit (H3 C). auto. intros [E [F G]]. simpl; intuition. congruence. eapply star_trans. eexact D. - eapply star_left. left; eapply step_comma; eauto. + eapply star_left. left; eapply step_comma; eauto. eexact G. reflexivity. traceEq. (* call *) exploit (H0 (fun x => C(Ecall x rargs ty))). eapply leftcontext_compose; eauto. repeat constructor. intros [A [B D]]. exploit (H2 rf' Enil ty C); eauto. intros [E F]. - simpl; intuition. + simpl; intuition. eapply star_trans. eexact D. - eapply star_trans. eexact F. - eapply star_left. left; eapply step_call; eauto. congruence. - eapply star_right. eapply H9. red; auto. - right; constructor. + eapply star_trans. eexact F. + eapply star_left. left; eapply step_call; eauto. congruence. + eapply star_right. eapply H9. red; auto. + right; constructor. reflexivity. reflexivity. reflexivity. traceEq. (* nil *) simpl; intuition. apply star_refl. @@ -2358,18 +2358,18 @@ Proof. eapply leftcontext_compose; eauto. repeat constructor. auto. apply exprlist_app_leftcontext; auto. intros [A [B D]]. exploit (H2 a0 (exprlist_app al2 (Econs a1' Enil))); eauto. - rewrite exprlist_app_simple. simpl. rewrite H5; rewrite A; auto. - repeat rewrite exprlist_app_assoc. simpl. + rewrite exprlist_app_simple. simpl. rewrite H5; rewrite A; auto. + repeat rewrite exprlist_app_assoc. simpl. intros [E F]. - simpl; intuition. + simpl; intuition. eapply star_trans; eauto. (* skip *) econstructor; split. apply star_refl. constructor. (* do *) - econstructor; split. - eapply star_left. right; constructor. + econstructor; split. + eapply star_left. right; constructor. eapply star_right. apply H0. right; constructor. reflexivity. traceEq. constructor. @@ -2379,7 +2379,7 @@ Proof. destruct (H2 f k) as [S2 [A2 B2]]; auto. econstructor; split. eapply star_left. right; econstructor. - eapply star_trans. eexact A1. + eapply star_trans. eexact A1. eapply star_left. right; constructor. eexact A2. reflexivity. reflexivity. traceEq. auto. @@ -2420,7 +2420,7 @@ Proof. econstructor; split. eapply star_left. right; apply step_return_1. eapply H0. traceEq. - econstructor; eauto. + econstructor; eauto. (* break *) econstructor; split. apply star_refl. constructor. @@ -2431,7 +2431,7 @@ Proof. (* while false *) econstructor; split. eapply star_left. right; apply step_while. - eapply star_right. apply H0. right; eapply step_while_false; eauto. + eapply star_right. apply H0. right; eapply step_while_false; eauto. reflexivity. traceEq. constructor. @@ -2448,7 +2448,7 @@ Proof. eapply star_left. right; eapply step_while_true; eauto. eapply star_trans. eexact A1. unfold S2. inversion H4; subst. - inv B1. apply star_one. right; constructor. + inv B1. apply star_one. right; constructor. apply star_refl. reflexivity. reflexivity. reflexivity. traceEq. unfold S2. inversion H4; subst. constructor. inv B1; econstructor; eauto. @@ -2474,9 +2474,9 @@ Proof. eapply star_trans. eexact A1. eapply star_left. inv H1; inv B1; right; eapply step_skip_or_continue_dowhile; eauto. - eapply star_right. apply H3. - right; eapply step_dowhile_false; eauto. - reflexivity. reflexivity. reflexivity. traceEq. + eapply star_right. apply H3. + right; eapply step_dowhile_false; eauto. + reflexivity. reflexivity. reflexivity. traceEq. constructor. (* dowhile stop *) @@ -2487,7 +2487,7 @@ Proof. | _ => S1 end). exists S2; split. - eapply star_left. right; apply step_dowhile. + eapply star_left. right; apply step_dowhile. eapply star_trans. eexact A1. unfold S2. inversion H1; subst. inv B1. apply star_one. right; constructor. @@ -2510,13 +2510,13 @@ Proof. auto. (* for start *) - assert (a1 = Sskip \/ a1 <> Sskip). destruct a1; auto; right; congruence. + assert (a1 = Sskip \/ a1 <> Sskip). destruct a1; auto; right; congruence. destruct H3. subst a1. inv H. apply H2; auto. destruct (H0 f (Kseq (Sfor Sskip a2 a3 s) k)) as [S1 [A1 B1]]; auto. inv B1. destruct (H2 f k) as [S2 [A2 B2]]; auto. exists S2; split. - eapply star_left. right; apply step_for_start; auto. + eapply star_left. right; apply step_for_start; auto. eapply star_trans. eexact A1. eapply star_left. right; constructor. eexact A2. reflexivity. reflexivity. traceEq. @@ -2524,8 +2524,8 @@ Proof. (* for false *) econstructor; split. - eapply star_left. right; apply step_for. - eapply star_right. apply H0. right; eapply step_for_false; eauto. + eapply star_left. right; apply step_for. + eapply star_right. apply H0. right; eapply step_for_false; eauto. reflexivity. traceEq. constructor. @@ -2537,12 +2537,12 @@ Proof. | _ => S1 end). exists S2; split. - eapply star_left. right; apply step_for. - eapply star_trans. apply H0. + eapply star_left. right; apply step_for. + eapply star_trans. apply H0. eapply star_left. right; eapply step_for_true; eauto. - eapply star_trans. eexact A1. + eapply star_trans. eexact A1. unfold S2. inversion H4; subst. - inv B1. apply star_one. right; constructor. + inv B1. apply star_one. right; constructor. apply star_refl. reflexivity. reflexivity. reflexivity. traceEq. unfold S2. inversion H4; subst. constructor. inv B1; econstructor; eauto. @@ -2552,15 +2552,15 @@ Proof. destruct (H6 f (Kfor4 a2 a3 s k)) as [S2 [A2 B2]]; auto. inv B2. destruct (H8 f k) as [S3 [A3 B3]]; auto. exists S3; split. - eapply star_left. right; apply step_for. - eapply star_trans. apply H0. + eapply star_left. right; apply step_for. + eapply star_trans. apply H0. eapply star_left. right; eapply step_for_true; eauto. eapply star_trans. eexact A1. eapply star_trans with (s2 := State f a3 (Kfor4 a2 a3 s k) e m2). inv H4; inv B1. - apply star_one. right; constructor; auto. - apply star_one. right; constructor; auto. - eapply star_trans. eexact A2. + apply star_one. right; constructor; auto. + apply star_one. right; constructor; auto. + eapply star_trans. eexact A2. eapply star_left. right; constructor. eexact A3. reflexivity. reflexivity. reflexivity. reflexivity. @@ -2578,13 +2578,13 @@ Proof. end). exists S2; split. eapply star_left. right; eapply step_switch. - eapply star_trans. apply H0. - eapply star_left. right; eapply step_expr_switch. eauto. - eapply star_trans. eexact A1. + eapply star_trans. apply H0. + eapply star_left. right; eapply step_expr_switch. eauto. + eapply star_trans. eexact A1. unfold S2; inv B1. - apply star_one. right; constructor. auto. - apply star_one. right; constructor. auto. - apply star_one. right; constructor. + apply star_one. right; constructor. auto. + apply star_one. right; constructor. auto. + apply star_one. right; constructor. apply star_refl. apply star_refl. reflexivity. reflexivity. reflexivity. traceEq. @@ -2593,7 +2593,7 @@ Proof. (* call internal *) destruct (H3 f k) as [S1 [A1 B1]]. eapply star_left. right; eapply step_internal_function; eauto. - eapply star_right. eexact A1. + eapply star_right. eexact A1. inv B1; simpl in H4; try contradiction. (* Out_normal *) assert (fn_return f = Tvoid /\ vres = Vundef). @@ -2611,7 +2611,7 @@ Proof. reflexivity. traceEq. (* call external *) - apply star_one. right; apply step_external_function; auto. + apply star_one. right; apply step_external_function; auto. Qed. Lemma eval_expression_to_steps: @@ -2713,7 +2713,7 @@ Lemma evalinf_funcall_steps: Proof. cofix COF. - assert (COS: + assert (COS: forall e m s t f k, execinf_stmt e m s t -> forever_N step lt ge O (State f s k e m) t). @@ -2735,180 +2735,180 @@ Proof. cofix COEL. intros. inv H. (* cons left *) - eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. + eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. eapply COE with (C := fun x => C(Ecall a1 (exprlist_app al (Econs x al0)) ty)). - eauto. eapply leftcontext_compose; eauto. constructor. auto. + eauto. eapply leftcontext_compose; eauto. constructor. auto. apply exprlist_app_leftcontext; auto. traceEq. -(* cons right *) - destruct (eval_expr_to_steps _ _ _ _ _ _ _ H3 +(* cons right *) + destruct (eval_expr_to_steps _ _ _ _ _ _ _ H3 (fun x => C(Ecall a1 (exprlist_app al (Econs x al0)) ty)) f k) - as [P [Q R]]. - eapply leftcontext_compose; eauto. repeat constructor. auto. - apply exprlist_app_leftcontext; auto. + as [P [Q R]]. + eapply leftcontext_compose; eauto. repeat constructor. auto. + apply exprlist_app_leftcontext; auto. eapply forever_N_star with (a2 := (esizelist al0)). eexact R. simpl; omega. change (Econs a1' al0) with (exprlist_app (Econs a1' Enil) al0). - rewrite <- exprlist_app_assoc. - eapply COEL. eauto. auto. auto. + rewrite <- exprlist_app_assoc. + eapply COEL. eauto. auto. auto. rewrite exprlist_app_simple. simpl. rewrite H2; rewrite P; auto. auto. intros. inv H. (* field *) eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Efield x f0 ty)). eauto. + eapply COE with (C := fun x => C(Efield x f0 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* valof *) eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Evalof x ty)). eauto. + eapply COE with (C := fun x => C(Evalof x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* deref *) eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Ederef x ty)). eauto. + eapply COE with (C := fun x => C(Ederef x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* addrof *) eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Eaddrof x ty)). eauto. + eapply COE with (C := fun x => C(Eaddrof x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* unop *) eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Eunop op x ty)). eauto. + eapply COE with (C := fun x => C(Eunop op x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* binop left *) eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Ebinop op x a2 ty)). eauto. + eapply COE with (C := fun x => C(Ebinop op x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* binop right *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ebinop op x a2 ty)) f k) - as [P [Q R]]. + as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; omega. - eapply COE with (C := fun x => C(Ebinop op a1' x ty)). eauto. + eapply COE with (C := fun x => C(Ebinop op a1' x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. auto. traceEq. (* cast *) eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Ecast x ty)). eauto. + eapply COE with (C := fun x => C(Ecast x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* seqand left *) eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Eseqand x a2 ty)). eauto. + eapply COE with (C := fun x => C(Eseqand x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* seqand 2 *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Eseqand x a2 ty)) f k) - as [P [Q R]]. + as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. - eapply forever_N_plus. eapply plus_right. eexact R. + eapply forever_N_plus. eapply plus_right. eexact R. left; eapply step_seqand_true; eauto. rewrite Q; eauto. - reflexivity. + reflexivity. eapply COE with (C := fun x => (C (Eparen x type_bool ty))). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* seqor left *) eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Eseqor x a2 ty)). eauto. + eapply COE with (C := fun x => C(Eseqor x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* seqor 2 *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Eseqor x a2 ty)) f k) - as [P [Q R]]. + as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. - eapply forever_N_plus. eapply plus_right. eexact R. + eapply forever_N_plus. eapply plus_right. eexact R. left; eapply step_seqor_false; eauto. rewrite Q; eauto. - reflexivity. + reflexivity. eapply COE with (C := fun x => (C (Eparen x type_bool ty))). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* condition top *) eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Econdition x a2 a3 ty)). eauto. + eapply COE with (C := fun x => C(Econdition x a2 a3 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* condition *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Econdition x a2 a3 ty)) f k) - as [P [Q R]]. + as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. - eapply forever_N_plus. eapply plus_right. eexact R. + eapply forever_N_plus. eapply plus_right. eexact R. left; eapply step_condition; eauto. rewrite Q; eauto. - reflexivity. + reflexivity. eapply COE with (C := fun x => (C (Eparen x ty ty))). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* assign left *) eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Eassign x a2 ty)). eauto. + eapply COE with (C := fun x => C(Eassign x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* assign right *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Eassign x a2 ty)) f k) - as [P [Q R]]. + as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; omega. - eapply COE with (C := fun x => C(Eassign a1' x ty)). eauto. + eapply COE with (C := fun x => C(Eassign a1' x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. auto. traceEq. (* assignop left *) eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Eassignop op x a2 tyres ty)). eauto. + eapply COE with (C := fun x => C(Eassignop op x a2 tyres ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* assignop right *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Eassignop op x a2 tyres ty)) f k) - as [P [Q R]]. + as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. eapply forever_N_star with (a2 := (esize a2)). eexact R. simpl; omega. - eapply COE with (C := fun x => C(Eassignop op a1' x tyres ty)). eauto. + eapply COE with (C := fun x => C(Eassignop op a1' x tyres ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. auto. traceEq. (* postincr *) eapply forever_N_star with (a2 := (esize a0)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Epostincr id x ty)). eauto. + eapply COE with (C := fun x => C(Epostincr id x ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* comma left *) eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Ecomma x a2 ty)). eauto. + eapply COE with (C := fun x => C(Ecomma x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* comma right *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ecomma x a2 (typeof a2))) f k) - as [P [Q R]]. + as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. - eapply forever_N_plus. eapply plus_right. eexact R. - left; eapply step_comma; eauto. reflexivity. + eapply forever_N_plus. eapply plus_right. eexact R. + left; eapply step_comma; eauto. reflexivity. eapply COE with (C := C); eauto. traceEq. (* call left *) eapply forever_N_star with (a2 := (esize a1)). apply star_refl. simpl; omega. - eapply COE with (C := fun x => C(Ecall x a2 ty)). eauto. + eapply COE with (C := fun x => C(Ecall x a2 ty)). eauto. eapply leftcontext_compose; eauto. repeat constructor. traceEq. (* call right *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ecall x a2 ty)) f k) - as [P [Q R]]. + as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. eapply forever_N_star with (a2 := (esizelist a2)). eexact R. simpl; omega. eapply COEL with (al := Enil). eauto. auto. auto. auto. traceEq. (* call *) destruct (eval_expr_to_steps _ _ _ _ _ _ _ H1 (fun x => C(Ecall x rargs ty)) f k) - as [P [Q R]]. + as [P [Q R]]. eapply leftcontext_compose; eauto. repeat constructor. destruct (eval_exprlist_to_steps _ _ _ _ _ _ H2 rf' Enil ty C f k) as [S T]. auto. auto. simpl; auto. eapply forever_N_plus. eapply plus_right. eapply star_trans. eexact R. eexact T. reflexivity. - simpl. left; eapply step_call; eauto. congruence. reflexivity. - apply COF. eauto. traceEq. + simpl. left; eapply step_call; eauto. congruence. reflexivity. + apply COF. eauto. traceEq. (* statements *) intros. inv H. (* do *) - eapply forever_N_plus. apply plus_one; right; constructor. + eapply forever_N_plus. apply plus_one; right; constructor. eapply COE with (C := fun x => x); eauto. constructor. traceEq. (* seq 1 *) - eapply forever_N_plus. apply plus_one; right; constructor. + eapply forever_N_plus. apply plus_one; right; constructor. eapply COS; eauto. traceEq. (* seq 2 *) destruct (exec_stmt_to_steps _ _ _ _ _ _ H0 f (Kseq s2 k)) as [S1 [A1 B1]]; auto. inv B1. - eapply forever_N_plus. - eapply plus_left. right; constructor. + eapply forever_N_plus. + eapply plus_left. right; constructor. eapply star_right. eauto. right; constructor. - reflexivity. reflexivity. + reflexivity. reflexivity. eapply COS; eauto. traceEq. (* if test *) - eapply forever_N_plus. apply plus_one; right; constructor. + eapply forever_N_plus. apply plus_one; right; constructor. eapply COE with (C := fun x => x); eauto. constructor. traceEq. (* if true/false *) eapply forever_N_plus. eapply plus_left. right; constructor. eapply star_right. eapply eval_expression_to_steps; eauto. - right. eapply step_ifthenelse_2 with (b := b). auto. + right. eapply step_ifthenelse_2 with (b := b). auto. reflexivity. reflexivity. eapply COS; eauto. traceEq. (* return some *) @@ -2919,7 +2919,7 @@ Proof. eapply COE with (C := fun x => x); eauto. constructor. traceEq. (* while body *) eapply forever_N_plus. - eapply plus_left. right; constructor. + eapply plus_left. right; constructor. eapply star_right. eapply eval_expression_to_steps; eauto. right; apply step_while_true; auto. reflexivity. reflexivity. @@ -2927,10 +2927,10 @@ Proof. (* while loop *) destruct (exec_stmt_to_steps _ _ _ _ _ _ H2 f (Kwhile2 a s0 k)) as [S1 [A1 B1]]; auto. eapply forever_N_plus. - eapply plus_left. right; constructor. + eapply plus_left. right; constructor. eapply star_trans. eapply eval_expression_to_steps; eauto. eapply star_left. right; apply step_while_true; auto. - eapply star_trans. eexact A1. + eapply star_trans. eexact A1. inv H3; inv B1; apply star_one; right; apply step_skip_or_continue_while; auto. reflexivity. reflexivity. reflexivity. reflexivity. eapply COS; eauto. traceEq. @@ -2940,7 +2940,7 @@ Proof. (* dowhile test *) destruct (exec_stmt_to_steps _ _ _ _ _ _ H0 f (Kdowhile1 a s0 k)) as [S1 [A1 B1]]; auto. eapply forever_N_plus. - eapply plus_left. right; constructor. + eapply plus_left. right; constructor. eapply star_trans. eexact A1. eapply star_one. right. inv H1; inv B1; apply step_skip_or_continue_dowhile; auto. reflexivity. reflexivity. @@ -2948,7 +2948,7 @@ Proof. (* dowhile loop *) destruct (exec_stmt_to_steps _ _ _ _ _ _ H0 f (Kdowhile1 a s0 k)) as [S1 [A1 B1]]; auto. eapply forever_N_plus. - eapply plus_left. right; constructor. + eapply plus_left. right; constructor. eapply star_trans. eexact A1. eapply star_left. right. inv H1; inv B1; apply step_skip_or_continue_dowhile; auto. eapply star_right. eapply eval_expression_to_steps; eauto. @@ -2962,9 +2962,9 @@ Proof. (* for start 2 *) destruct (exec_stmt_to_steps _ _ _ _ _ _ H0 f (Kseq (Sfor Sskip a2 a3 s0) k)) as [S1 [A1 B1]]; auto. inv B1. eapply forever_N_plus. - eapply plus_left. right; constructor. auto. + eapply plus_left. right; constructor. auto. eapply star_trans. eexact A1. - apply star_one. right; constructor. + apply star_one. right; constructor. reflexivity. reflexivity. eapply COS; eauto. traceEq. (* for test *) @@ -2983,7 +2983,7 @@ Proof. eapply plus_left. right; apply step_for. eapply star_trans. eapply eval_expression_to_steps; eauto. eapply star_left. right; apply step_for_true; auto. - eapply star_trans. eexact A1. + eapply star_trans. eexact A1. inv H3; inv B1; apply star_one; right; apply step_skip_or_continue_for3; auto. reflexivity. reflexivity. reflexivity. reflexivity. eapply COS; eauto. traceEq. @@ -2997,7 +2997,7 @@ Proof. eapply star_trans. eexact A1. eapply star_left. inv H3; inv B1; right; apply step_skip_or_continue_for3; auto. - eapply star_right. eexact A2. + eapply star_right. eexact A2. right; constructor. reflexivity. reflexivity. reflexivity. reflexivity. reflexivity. reflexivity. eapply COS; eauto. traceEq. @@ -3006,15 +3006,15 @@ Proof. eapply COE with (C := fun x => x); eauto. constructor. traceEq. (* switch body *) eapply forever_N_plus. - eapply plus_left. right; constructor. - eapply star_right. eapply eval_expression_to_steps; eauto. - right; constructor. eauto. - reflexivity. reflexivity. - eapply COS; eauto. traceEq. + eapply plus_left. right; constructor. + eapply star_right. eapply eval_expression_to_steps; eauto. + right; constructor. eauto. + reflexivity. reflexivity. + eapply COS; eauto. traceEq. (* funcalls *) intros. inv H. - eapply forever_N_plus. apply plus_one. right; econstructor; eauto. + eapply forever_N_plus. apply plus_one. right; econstructor; eauto. eapply COS; eauto. traceEq. Qed. @@ -3024,7 +3024,7 @@ End BIGSTEP. Inductive bigstep_program_terminates (p: program): trace -> int -> Prop := | bigstep_program_terminates_intro: forall b f m0 m1 t r, - let ge := globalenv p in + let ge := globalenv p in Genv.init_mem p = Some m0 -> Genv.find_symbol ge p.(prog_main) = Some b -> Genv.find_funct_ptr ge b = Some f -> @@ -3034,7 +3034,7 @@ Inductive bigstep_program_terminates (p: program): trace -> int -> Prop := Inductive bigstep_program_diverges (p: program): traceinf -> Prop := | bigstep_program_diverges_intro: forall b f m0 t, - let ge := globalenv p in + let ge := globalenv p in Genv.init_mem p = Some m0 -> Genv.find_symbol ge p.(prog_main) = Some b -> Genv.find_funct_ptr ge b = Some f -> @@ -3050,7 +3050,7 @@ Theorem bigstep_semantics_sound: Proof. intros; constructor; intros. (* termination *) - inv H. econstructor; econstructor. + inv H. econstructor; econstructor. split. econstructor; eauto. split. apply eval_funcall_to_steps. eauto. red; auto. econstructor. diff --git a/cfrontend/Csyntax.v b/cfrontend/Csyntax.v index db059791..89d0b2bf 100644 --- a/cfrontend/Csyntax.v +++ b/cfrontend/Csyntax.v @@ -74,18 +74,18 @@ ranged over by [l] and [r], respectively, in the grammar above. L-values are those expressions that can occur to the left of an assignment. They denote memory locations. (Indeed, the reduction semantics for expression reduces them to [Eloc b ofs] expressions.) L-values are -variables ([Evar]), pointer dereferences ([Ederef]), field accesses ([Efield]). +variables ([Evar]), pointer dereferences ([Ederef]), field accesses ([Efield]). R-values are all other expressions. They denote values, and the reduction -semantics reduces them to [Eval v] expressions. +semantics reduces them to [Eval v] expressions. A l-value can be used in a r-value context, but this use must be marked -explicitly with the [Evalof] operator, which is not materialized in the +explicitly with the [Evalof] operator, which is not materialized in the concrete syntax of C but denotes a read from the location corresponding to the l-value [l] argument of [Evalof l]. The grammar above contains some forms that cannot appear in source terms but appear during reduction. These forms are: -- [Eval v] where [v] is a pointer or [Vundef]. ([Eval] of an integer or +- [Eval v] where [v] is a pointer or [Vundef]. ([Eval] of an integer or float value can occur in a source term and represents a numeric literal.) - [Eloc b ofs], which appears during reduction of l-values. - [Eparen r tycast ty], which appears during reduction of conditionals @@ -102,7 +102,7 @@ Definition Eindex (r1 r2: expr) (ty: type) := [l += 1] and [l -= 1], respectively. *) Definition Epreincr (id: incr_or_decr) (l: expr) (ty: type) := - Eassignop (match id with Incr => Oadd | Decr => Osub end) + Eassignop (match id with Incr => Oadd | Decr => Osub end) l (Eval (Vint Int.one) type_int32s) (typeconv ty) ty. (** Extract the type part of a type-annotated expression. *) diff --git a/cfrontend/Ctypes.v b/cfrontend/Ctypes.v index 1f55da7f..78345b42 100644 --- a/cfrontend/Ctypes.v +++ b/cfrontend/Ctypes.v @@ -24,7 +24,7 @@ Require Archi. (** * Syntax of types *) (** Compcert C types are similar to those of C. They include numeric types, - pointers, arrays, function types, and composite types (struct and + pointers, arrays, function types, and composite types (struct and union). Numeric types (integers and floats) fully specify the bit size of the type. An integer type is a pair of a signed/unsigned flag and a bit size: 8, 16, or 32 bits, or the special [IBool] size @@ -140,7 +140,7 @@ Definition attr_union (a1 a2: attr) : attr := | None, al => al | al, None => al | Some n1, Some n2 => Some (N.max n1 n2) - end + end |}. Definition merge_attributes (ty: type) (a: attr) : type := @@ -184,7 +184,7 @@ Definition type_int32s := Tint I32 Signed noattr. Definition type_bool := Tint IBool Signed noattr. (** The usual unary conversion. Promotes small integer types to [signed int32] - and degrades array types and function types to pointer types. + and degrades array types and function types to pointer types. Attributes are erased. *) Definition typeconv (ty: type) : type := @@ -272,7 +272,7 @@ Remark align_attr_two_p: (exists n, al = two_power_nat n) -> (exists n, align_attr a al = two_power_nat n). Proof. - intros. unfold align_attr. destruct (attr_alignas a). + intros. unfold align_attr. destruct (attr_alignas a). exists (N.to_nat n). rewrite two_power_nat_two_p. rewrite N_nat_Z. auto. auto. Qed. @@ -309,7 +309,7 @@ Qed. (** In the ISO C standard, size is defined only for complete types. However, it is convenient that [sizeof] is a total function. For [void] and function types, we follow GCC and define - their size to be 1. For undefined structures and unions, the size is + their size to be 1. For undefined structures and unions, the size is arbitrarily taken to be 0. *) @@ -355,16 +355,16 @@ Fixpoint naturally_aligned (t: type) : Prop := Lemma sizeof_alignof_compat: forall env t, naturally_aligned t -> (alignof env t | sizeof env t). Proof. - induction t; intros [A B]; unfold alignof, align_attr; rewrite A; simpl. + induction t; intros [A B]; unfold alignof, align_attr; rewrite A; simpl. - apply Zdivide_refl. - destruct i; apply Zdivide_refl. -- exists (8 / Archi.align_int64); reflexivity. -- destruct f. apply Zdivide_refl. exists (8 / Archi.align_float64); reflexivity. +- exists (8 / Archi.align_int64); reflexivity. +- destruct f. apply Zdivide_refl. exists (8 / Archi.align_float64); reflexivity. - apply Zdivide_refl. -- apply Z.divide_mul_l; auto. +- apply Z.divide_mul_l; auto. - apply Zdivide_refl. -- destruct (env!i). apply co_sizeof_alignof. apply Zdivide_0. -- destruct (env!i). apply co_sizeof_alignof. apply Zdivide_0. +- destruct (env!i). apply co_sizeof_alignof. apply Zdivide_0. +- destruct (env!i). apply co_sizeof_alignof. apply Zdivide_0. Qed. (** ** Size and alignment for composite definitions *) @@ -399,7 +399,7 @@ Fixpoint sizeof_union (env: composite_env) (m: members) : Z := Lemma alignof_composite_two_p: forall env m, exists n, alignof_composite env m = two_power_nat n. Proof. - induction m as [|[id t]]; simpl. + induction m as [|[id t]]; simpl. - exists 0%nat; auto. - apply Z.max_case; auto. apply alignof_two_p. Qed. @@ -408,8 +408,8 @@ Lemma alignof_composite_pos: forall env m a, align_attr a (alignof_composite env m) > 0. Proof. intros. - exploit align_attr_two_p. apply (alignof_composite_two_p env m). - instantiate (1 := a). intros [n EQ]. + exploit align_attr_two_p. apply (alignof_composite_two_p env m). + instantiate (1 := a). intros [n EQ]. rewrite EQ; apply two_power_nat_pos. Qed. @@ -418,10 +418,10 @@ Lemma sizeof_struct_incr: Proof. induction m as [|[id t]]; simpl; intros. - omega. -- apply Zle_trans with (align cur (alignof env t)). +- apply Zle_trans with (align cur (alignof env t)). apply align_le. apply alignof_pos. apply Zle_trans with (align cur (alignof env t) + sizeof env t). - generalize (sizeof_pos env t); omega. + generalize (sizeof_pos env t); omega. apply IHm. Qed. @@ -457,7 +457,7 @@ Fixpoint field_type (id: ident) (fld: members) {struct fld} : res type := | (id', t) :: fld' => if ident_eq id id' then OK t else field_type id fld' end. -(** Some sanity checks about field offsets. First, field offsets are +(** Some sanity checks about field offsets. First, field offsets are within the range of acceptable offsets. *) Remark field_offset_rec_in_range: @@ -470,9 +470,9 @@ Proof. - destruct (ident_eq id i); intros. inv H. inv H0. split. apply align_le. apply alignof_pos. apply sizeof_struct_incr. - exploit IHfld; eauto. intros [A B]. split; auto. + exploit IHfld; eauto. intros [A B]. split; auto. eapply Zle_trans; eauto. apply Zle_trans with (align pos (alignof env t)). - apply align_le. apply alignof_pos. generalize (sizeof_pos env t). omega. + apply align_le. apply alignof_pos. generalize (sizeof_pos env t). omega. Qed. Lemma field_offset_in_range: @@ -496,11 +496,11 @@ Proof. induction fld as [|[i t]]; simpl; intros. - discriminate. - destruct (ident_eq id1 i); destruct (ident_eq id2 i). -+ congruence. ++ congruence. + subst i. inv H; inv H0. - exploit field_offset_rec_in_range. eexact H1. eauto. tauto. + exploit field_offset_rec_in_range. eexact H1. eauto. tauto. + subst i. inv H1; inv H2. - exploit field_offset_rec_in_range. eexact H. eauto. tauto. + exploit field_offset_rec_in_range. eexact H. eauto. tauto. + eapply IHfld; eauto. Qed. @@ -512,10 +512,10 @@ Lemma field_offset_prefix: field_offset env id fld1 = OK ofs -> field_offset env id (fld1 ++ fld2) = OK ofs. Proof. - intros until fld1. unfold field_offset. generalize 0 as pos. + intros until fld1. unfold field_offset. generalize 0 as pos. induction fld1 as [|[i t]]; simpl; intros. - discriminate. -- destruct (ident_eq id i); auto. +- destruct (ident_eq id i); auto. Qed. (** Fourth, the position of each field respects its alignment. *) @@ -525,7 +525,7 @@ Lemma field_offset_aligned: field_offset env id fld = OK ofs -> field_type id fld = OK ty -> (alignof env ty | ofs). Proof. - intros until ty. unfold field_offset. generalize 0 as pos. revert fld. + intros until ty. unfold field_offset. generalize 0 as pos. revert fld. induction fld as [|[i t]]; simpl; intros. - discriminate. - destruct (ident_eq id i). @@ -613,18 +613,18 @@ Proof. assert (X: forall co, let a := Zmin 8 (co_alignof co) in a = 1 \/ a = 2 \/ a = 4 \/ a = 8). { - intros. destruct (co_alignof_two_p co) as [n EQ]. unfold a; rewrite EQ. + intros. destruct (co_alignof_two_p co) as [n EQ]. unfold a; rewrite EQ. destruct n; auto. destruct n; auto. destruct n; auto. right; right; right. apply Z.min_l. - rewrite two_power_nat_two_p. rewrite ! inj_S. + rewrite two_power_nat_two_p. rewrite ! inj_S. change 8 with (two_p 3). apply two_p_monotone. omega. } induction ty; simpl; auto. destruct i; auto. destruct f; auto. - destruct (env!i); auto. + destruct (env!i); auto. destruct (env!i); auto. Qed. @@ -644,9 +644,9 @@ Proof. destruct n. apply Zdivide_refl. destruct n. apply Zdivide_refl. destruct n. apply Zdivide_refl. - apply Z.min_case. - exists (two_p (Z.of_nat n)). - change 8 with (two_p 3). + apply Z.min_case. + exists (two_p (Z.of_nat n)). + change 8 with (two_p 3). rewrite <- two_p_is_exp by omega. rewrite two_power_nat_two_p. rewrite !inj_S. f_equal. omega. apply Zdivide_refl. @@ -659,8 +659,8 @@ Proof. apply Zdivide_refl. apply Z.divide_mul_l. auto. apply Zdivide_refl. - destruct (env!i). apply X. apply Zdivide_0. - destruct (env!i). apply X. apply Zdivide_0. + destruct (env!i). apply X. apply Zdivide_0. + destruct (env!i). apply X. apply Zdivide_0. Qed. (** Type ranks *) @@ -761,7 +761,7 @@ Qed. The size and alignment of the composite are determined at this time. The alignment takes into account the [__Alignas] attributes associated with the definition. The size is rounded up to a multiple - of the alignment. + of the alignment. The conversion fails if a type of a member is not complete. This rules out incorrect recursive definitions such as @@ -800,7 +800,7 @@ Program Definition composite_of_def co_sizeof_alignof := _ |} end. Next Obligation. - apply Zle_ge. eapply Zle_trans. eapply sizeof_composite_pos. + apply Zle_ge. eapply Zle_trans. eapply sizeof_composite_pos. apply align_le; apply alignof_composite_pos. Defined. Next Obligation. @@ -842,9 +842,9 @@ Lemma alignof_stable: forall t, complete_type env t = true -> alignof env' t = alignof env t. Proof. induction t; simpl; intros; f_equal; auto. - destruct (env!i) as [co|] eqn:E; try discriminate. + destruct (env!i) as [co|] eqn:E; try discriminate. erewrite extends by eauto. auto. - destruct (env!i) as [co|] eqn:E; try discriminate. + destruct (env!i) as [co|] eqn:E; try discriminate. erewrite extends by eauto. auto. Qed. @@ -853,9 +853,9 @@ Lemma sizeof_stable: Proof. induction t; simpl; intros; auto. rewrite IHt by auto. auto. - destruct (env!i) as [co|] eqn:E; try discriminate. + destruct (env!i) as [co|] eqn:E; try discriminate. erewrite extends by eauto. auto. - destruct (env!i) as [co|] eqn:E; try discriminate. + destruct (env!i) as [co|] eqn:E; try discriminate. erewrite extends by eauto. auto. Qed. @@ -863,9 +863,9 @@ Lemma complete_type_stable: forall t, complete_type env t = true -> complete_type env' t = true. Proof. induction t; simpl; intros; auto. - destruct (env!i) as [co|] eqn:E; try discriminate. + destruct (env!i) as [co|] eqn:E; try discriminate. erewrite extends by eauto. auto. - destruct (env!i) as [co|] eqn:E; try discriminate. + destruct (env!i) as [co|] eqn:E; try discriminate. erewrite extends by eauto. auto. Qed. @@ -873,16 +873,16 @@ Lemma rank_type_stable: forall t, complete_type env t = true -> rank_type env' t = rank_type env t. Proof. induction t; simpl; intros; auto. - destruct (env!i) as [co|] eqn:E; try discriminate. + destruct (env!i) as [co|] eqn:E; try discriminate. erewrite extends by eauto. auto. - destruct (env!i) as [co|] eqn:E; try discriminate. + destruct (env!i) as [co|] eqn:E; try discriminate. erewrite extends by eauto. auto. Qed. Lemma alignof_composite_stable: forall m, complete_members env m = true -> alignof_composite env' m = alignof_composite env m. Proof. - induction m as [|[id t]]; simpl; intros. + induction m as [|[id t]]; simpl; intros. auto. InvBooleans. rewrite alignof_stable by auto. rewrite IHm by auto. auto. Qed. @@ -892,7 +892,7 @@ Lemma sizeof_struct_stable: Proof. induction m as [|[id t]]; simpl; intros. auto. - InvBooleans. rewrite alignof_stable by auto. rewrite sizeof_stable by auto. + InvBooleans. rewrite alignof_stable by auto. rewrite sizeof_stable by auto. rewrite IHm by auto. auto. Qed. @@ -907,8 +907,8 @@ Qed. Lemma sizeof_composite_stable: forall su m, complete_members env m = true -> sizeof_composite env' su m = sizeof_composite env su m. Proof. - intros. destruct su; simpl. - apply sizeof_struct_stable; auto. + intros. destruct su; simpl. + apply sizeof_struct_stable; auto. apply sizeof_union_stable; auto. Qed. @@ -937,7 +937,7 @@ Lemma add_composite_definitions_incr: Proof. induction defs; simpl; intros. - inv H; auto. -- destruct a; monadInv H. +- destruct a; monadInv H. eapply IHdefs; eauto. rewrite PTree.gso; auto. red; intros; subst id0. unfold composite_of_def in EQ. rewrite H0 in EQ; discriminate. Qed. @@ -974,22 +974,22 @@ Proof. eapply IHdefs; eauto. set (env1 := PTree.set id x env0) in *. unfold composite_of_def in EQ. - destruct (env0!id) eqn:E; try discriminate. + destruct (env0!id) eqn:E; try discriminate. destruct (complete_members env0 m) eqn:C; inversion EQ; clear EQ. assert (forall id1 co1, env0!id1 = Some co1 -> env1!id1 = Some co1). { intros. unfold env1. rewrite PTree.gso; auto. congruence. } red; intros. unfold env1 in H2; rewrite PTree.gsspec in H2; destruct (peq id0 id). -+ subst id0. inversion H2; clear H2. subst co. ++ subst id0. inversion H2; clear H2. subst co. (* assert (A: alignof_composite env1 m = alignof_composite env0 m) by (apply alignof_composite_stable; assumption). *) rewrite <- H1; constructor; simpl. -* eapply complete_members_stable; eauto. -* f_equal. symmetry. apply alignof_composite_stable; auto. -* f_equal. symmetry. apply sizeof_composite_stable; auto. +* eapply complete_members_stable; eauto. +* f_equal. symmetry. apply alignof_composite_stable; auto. +* f_equal. symmetry. apply sizeof_composite_stable; auto. * symmetry. apply rank_members_stable; auto. -+ exploit H0; eauto. intros [P Q R S]. ++ exploit H0; eauto. intros [P Q R S]. constructor; intros. * eapply complete_members_stable; eauto. * rewrite Q. f_equal. symmetry. apply alignof_composite_stable; auto. @@ -1005,13 +1005,13 @@ Theorem build_composite_env_charact: In (Composite id su m a) defs -> exists co, env!id = Some co /\ co_members co = m /\ co_attr co = a /\ co_su co = su. Proof. - intros until defs. unfold build_composite_env. generalize (PTree.empty composite) as env0. + intros until defs. unfold build_composite_env. generalize (PTree.empty composite) as env0. revert defs. induction defs as [|d1 defs]; simpl; intros. - contradiction. - destruct d1; monadInv H. - destruct H0; [idtac|eapply IHdefs;eauto]. inv H. - unfold composite_of_def in EQ. - destruct (env0!id) eqn:E; try discriminate. + destruct H0; [idtac|eapply IHdefs;eauto]. inv H. + unfold composite_of_def in EQ. + destruct (env0!id) eqn:E; try discriminate. destruct (complete_members env0 m) eqn:C; simplify_eq EQ. clear EQ; intros EQ. exists x. split. eapply add_composite_definitions_incr; eauto. apply PTree.gss. diff --git a/cfrontend/Ctyping.v b/cfrontend/Ctyping.v index cde9ad11..aa320f20 100644 --- a/cfrontend/Ctyping.v +++ b/cfrontend/Ctyping.v @@ -180,7 +180,7 @@ Definition floatsize_eq: forall (x y: floatsize), {x=y} + {x<>y}. Proof. decide equality. Defined. Definition callconv_combine (cc1 cc2: calling_convention) : res calling_convention := - if bool_eq cc1.(cc_vararg) cc2.(cc_vararg) then + if bool_eq cc1.(cc_vararg) cc2.(cc_vararg) then OK {| cc_vararg := cc1.(cc_vararg); cc_unproto := cc1.(cc_unproto) && cc2.(cc_unproto); cc_structret := cc1.(cc_structret) |} @@ -356,11 +356,11 @@ Inductive wt_rvalue : expr -> Prop := wt_rvalue r -> wt_cast (typeof r) ty -> wt_rvalue (Ecast r ty) | wt_Eseqand: forall r1 r2, - wt_rvalue r1 -> wt_rvalue r2 -> + wt_rvalue r1 -> wt_rvalue r2 -> wt_bool (typeof r1) -> wt_bool (typeof r2) -> wt_rvalue (Eseqand r1 r2 (Tint I32 Signed noattr)) | wt_Eseqor: forall r1 r2, - wt_rvalue r1 -> wt_rvalue r2 -> + wt_rvalue r1 -> wt_rvalue r2 -> wt_bool (typeof r1) -> wt_bool (typeof r2) -> wt_rvalue (Eseqor r1 r2 (Tint I32 Signed noattr)) | wt_Econdition: forall r1 r2 r3 ty, @@ -873,7 +873,7 @@ Fixpoint retype_stmt (ce: composite_env) (e: typenv) (rt: type) (s: statement) : | Sreturn None => OK (Sreturn None) | Sreturn (Some a) => - do a' <- retype_expr ce e a; + do a' <- retype_expr ce e a; sreturn rt a' | Sswitch a sl => do a' <- retype_expr ce e a; @@ -924,14 +924,14 @@ Definition typecheck_program (p: program) : res program := Lemma check_cast_sound: forall t1 t2 x, check_cast t1 t2 = OK x -> wt_cast t1 t2. Proof. - unfold check_cast, wt_cast; intros. + unfold check_cast, wt_cast; intros. destruct (classify_cast t1 t2); congruence. Qed. Lemma check_bool_sound: forall t x, check_bool t = OK x -> wt_bool t. Proof. - unfold check_bool, wt_bool; intros. + unfold check_bool, wt_bool; intros. destruct (classify_bool t); congruence. Qed. @@ -940,7 +940,7 @@ Hint Resolve check_cast_sound check_bool_sound: ty. Lemma check_arguments_sound: forall el tl x, check_arguments el tl = OK x -> wt_arguments el tl. Proof. - intros el tl; revert tl el. + intros el tl; revert tl el. induction tl; destruct el; simpl; intros; try discriminate. constructor. destruct strict eqn:S; try discriminate. constructor; auto. @@ -970,13 +970,13 @@ Qed. Lemma typeconv_cast: forall t1 t2, wt_cast (typeconv t1) t2 -> wt_cast t1 t2. Proof. - unfold typeconv, wt_cast; intros. destruct t1; auto. + unfold typeconv, wt_cast; intros. destruct t1; auto. assert (classify_cast (Tint I32 Signed a) t2 <> cast_case_default -> classify_cast (Tint i s a) t2 <> cast_case_default). { unfold classify_cast. destruct t2; try congruence. destruct f; congruence. } - destruct i; auto. + destruct i; auto. Qed. Lemma type_combine_cast: @@ -1006,20 +1006,20 @@ Lemma type_conditional_cast: forall t1 t2 t, type_conditional t1 t2 = OK t -> wt_cast t1 t /\ wt_cast t2 t. Proof. - intros. + intros. assert (A: forall x, match typeconv x with Tarray _ _ _ => False | Tfunction _ _ _ => False | _ => True end). { destruct x; simpl; auto. destruct i; auto. } assert (D: type_combine (typeconv t1) (typeconv t2) = OK t -> wt_cast t1 t /\ wt_cast t2 t). - { intros. apply type_combine_cast in H0. destruct H0; split; apply typeconv_cast; auto. + { intros. apply type_combine_cast in H0. destruct H0; split; apply typeconv_cast; auto. apply A. apply A. } clear A. unfold type_conditional in H. destruct (typeconv t1) eqn:T1; try discriminate; destruct (typeconv t2) eqn:T2; inv H; eauto using D, binarith_type_cast. -- split; apply typeconv_cast; unfold wt_cast. +- split; apply typeconv_cast; unfold wt_cast. rewrite T1; simpl; congruence. rewrite T2; simpl; congruence. -- split; apply typeconv_cast; unfold wt_cast. +- split; apply typeconv_cast; unfold wt_cast. rewrite T1; simpl; congruence. rewrite T2; simpl; congruence. -- split; apply typeconv_cast; unfold wt_cast. +- split; apply typeconv_cast; unfold wt_cast. rewrite T1; simpl; congruence. rewrite T2; simpl; congruence. Qed. @@ -1053,13 +1053,13 @@ Qed. Lemma ederef_sound: forall r a, ederef r = OK a -> wt_expr ce e r -> wt_expr ce e a. Proof. - intros. monadInv H. eauto with ty. + intros. monadInv H. eauto with ty. Qed. Lemma efield_sound: forall r f a, efield ce r f = OK a -> wt_expr ce e r -> wt_expr ce e a. Proof. - intros. monadInv H. + intros. monadInv H. destruct (typeof r) eqn:TR; try discriminate; destruct (ce!i) as [co|] eqn:CE; monadInv EQ0; eauto with ty. Qed. @@ -1085,13 +1085,13 @@ Qed. Lemma econst_float_sound: forall n, wt_expr ce e (econst_float n). Proof. - unfold econst_float; auto with ty. + unfold econst_float; auto with ty. Qed. Lemma econst_single_sound: forall n, wt_expr ce e (econst_single n). Proof. - unfold econst_single; auto with ty. + unfold econst_single; auto with ty. Qed. Lemma evalof_sound: @@ -1140,14 +1140,14 @@ Lemma econdition_sound: forall r1 r2 r3 a, econdition r1 r2 r3 = OK a -> wt_expr ce e r1 -> wt_expr ce e r2 -> wt_expr ce e r3 -> wt_expr ce e a. Proof. - intros. monadInv H. apply type_conditional_cast in EQ3. destruct EQ3. eauto 10 with ty. + intros. monadInv H. apply type_conditional_cast in EQ3. destruct EQ3. eauto 10 with ty. Qed. Lemma econdition'_sound: forall r1 r2 r3 ty a, econdition' r1 r2 r3 ty = OK a -> wt_expr ce e r1 -> wt_expr ce e r2 -> wt_expr ce e r3 -> wt_expr ce e a. Proof. - intros. monadInv H. eauto 10 with ty. + intros. monadInv H. eauto 10 with ty. Qed. Lemma esizeof_sound: @@ -1189,16 +1189,16 @@ Qed. Lemma ecall_sound: forall fn args a, ecall fn args = OK a -> wt_expr ce e fn -> wt_exprlist ce e args -> wt_expr ce e a. Proof. - intros. monadInv H. - destruct (classify_fun (typeof fn)) eqn:CF; monadInv EQ2. - econstructor; eauto with ty. eapply check_arguments_sound; eauto. + intros. monadInv H. + destruct (classify_fun (typeof fn)) eqn:CF; monadInv EQ2. + econstructor; eauto with ty. eapply check_arguments_sound; eauto. Qed. Lemma ebuiltin_sound: forall ef tyargs args tyres a, ebuiltin ef tyargs args tyres = OK a -> wt_exprlist ce e args -> wt_expr ce e a. Proof. - intros. monadInv H. + intros. monadInv H. destruct (type_eq tyres Tvoid); simpl in EQ2; try discriminate. destruct (opt_typ_eq (sig_res (ef_sig ef)) None); inv EQ2. econstructor; eauto. eapply check_arguments_sound; eauto. @@ -1242,14 +1242,14 @@ Qed. Lemma sreturn_sound: forall a s, sreturn rt a = OK s -> wt_expr ce e a -> wt_stmt ce e rt s. Proof. - intros. monadInv H; eauto with ty. + intros. monadInv H; eauto with ty. Qed. Lemma sswitch_sound: forall a sl s, sswitch a sl = OK s -> wt_expr ce e a -> wt_lblstmts ce e rt sl -> wt_stmt ce e rt s. Proof. - intros. monadInv H. destruct (typeof a) eqn:TA; inv EQ0. + intros. monadInv H. destruct (typeof a) eqn:TA; inv EQ0. eauto with ty. eapply wt_Sswitch with (sz := I32); eauto with ty. Qed. @@ -1262,11 +1262,11 @@ Proof. - destruct a; simpl; intros a' RT; try (monadInv RT). + destruct v; try discriminate. destruct ty; inv RT. apply econst_int_sound. apply econst_ptr_int_sound. - destruct ty; inv RT. apply econst_long_sound. + destruct ty; inv RT. apply econst_long_sound. inv RT. apply econst_float_sound. inv RT. apply econst_single_sound. + eapply evar_sound; eauto. -+ eapply efield_sound; eauto. ++ eapply efield_sound; eauto. + eapply evalof_sound; eauto. + eapply ederef_sound; eauto. + eapply eaddrof_sound; eauto. @@ -1282,7 +1282,7 @@ Proof. + eapply eassignop_sound; eauto. + eapply epostincrdecr_sound; eauto. + eapply ecomma_sound; eauto. -+ eapply ecall_sound; eauto. ++ eapply ecall_sound; eauto. + eapply ebuiltin_sound; eauto. - destruct al; simpl; intros al' RT; monadInv RT. + constructor. @@ -1297,7 +1297,7 @@ Proof. - destruct s; simpl; intros s' RT; try (monadInv RT). + constructor. + eapply sdo_sound; eauto using retype_expr_sound. -+ constructor; eauto. ++ constructor; eauto. + eapply sifthenelse_sound; eauto using retype_expr_sound. + eapply swhile_sound; eauto using retype_expr_sound. + eapply sdowhile_sound; eauto using retype_expr_sound. @@ -1306,9 +1306,9 @@ Proof. + constructor. + destruct o; monadInv RT. eapply sreturn_sound; eauto using retype_expr_sound. constructor. + eapply sswitch_sound; eauto using retype_expr_sound. -+ constructor; eauto. ++ constructor; eauto. + constructor. -- destruct sl; simpl; intros sl' RT; monadInv RT. +- destruct sl; simpl; intros sl' RT; monadInv RT. + constructor. + constructor; eauto. Qed. @@ -1318,13 +1318,13 @@ End SOUNDNESS_CONSTRUCTORS. Lemma retype_function_sound: forall ce e f f', retype_function ce e f = OK f' -> wt_function ce e f'. Proof. - intros. monadInv H. constructor; simpl. eapply retype_stmt_sound; eauto. + intros. monadInv H. constructor; simpl. eapply retype_stmt_sound; eauto. Qed. Theorem typecheck_program_sound: forall p p', typecheck_program p = OK p' -> wt_program p'. Proof. - unfold typecheck_program; intros. monadInv H. + unfold typecheck_program; intros. monadInv H. rename x into defs. constructor; simpl. set (ce := prog_comp_env p) in *. @@ -1335,22 +1335,22 @@ Proof. { revert EQ; generalize (prog_defs p) defs. induction l as [ | [id gd] l ]; intros l'; simpl; intros. - inv EQ. constructor. + inv EQ. constructor. destruct gd as [f | v]. destruct (retype_fundef ce e f) as [tf|msg] eqn:R; monadInv EQ. - constructor; auto. constructor; auto. + constructor; auto. constructor; auto. monadInv EQ. constructor; auto. destruct v; constructor; auto. } assert (ENVS: e' = e). - { unfold e, e'. revert MATCH; generalize (prog_defs p) defs (PTree.empty type). + { unfold e, e'. revert MATCH; generalize (prog_defs p) defs (PTree.empty type). induction l as [ | [id gd] l ]; intros l' t M; inv M. - auto. inv H1; simpl; auto. replace (type_of_fundef f2) with (type_of_fundef f1); auto. - unfold retype_fundef in H4. destruct f1; monadInv H4; auto. monadInv EQ0; auto. + auto. inv H1; simpl; auto. replace (type_of_fundef f2) with (type_of_fundef f1); auto. + unfold retype_fundef in H4. destruct f1; monadInv H4; auto. monadInv EQ0; auto. } rewrite ENVS. intros id f. revert MATCH; generalize (prog_defs p) defs. induction 1; simpl; intros. contradiction. - destruct H0; auto. subst b1; inv H. destruct f1; simpl in H2. - monadInv H2. eapply retype_function_sound; eauto. congruence. + destruct H0; auto. subst b1; inv H. destruct f1; simpl in H2. + monadInv H2. eapply retype_function_sound; eauto. congruence. Qed. (** * Subject reduction *) @@ -1360,7 +1360,7 @@ Qed. Lemma pres_cast_int_int: forall sz sg n, wt_int (cast_int_int sz sg n) sz sg. Proof. - intros. unfold cast_int_int. destruct sz; simpl. + intros. unfold cast_int_int. destruct sz; simpl. - destruct sg. apply Int.sign_ext_idem; omega. apply Int.zero_ext_idem; omega. - destruct sg. apply Int.sign_ext_idem; omega. apply Int.zero_ext_idem; omega. - auto. @@ -1389,7 +1389,7 @@ Proof. Qed. Lemma pres_sem_binarith: - forall + forall (sem_int: signedness -> int -> int -> option val) (sem_long: signedness -> int64 -> int64 -> option val) (sem_float: float -> float -> option val) @@ -1411,19 +1411,19 @@ Proof with (try discriminate). set (ty' := Cop.binarith_type (classify_binarith ty1 ty2)) in *. destruct (sem_cast v1 ty1 ty') as [v1'|] eqn:CAST1... destruct (sem_cast v2 ty2 ty') as [v2'|] eqn:CAST2... - DestructCases. -- specialize (H s i i0). rewrite H3 in H. + DestructCases. +- specialize (H s i i0). rewrite H3 in H. destruct v; auto with ty; contradiction. -- specialize (H0 s i i0). rewrite H3 in H0. +- specialize (H0 s i i0). rewrite H3 in H0. destruct v; auto with ty; contradiction. -- specialize (H1 f f0). rewrite H3 in H1. +- specialize (H1 f f0). rewrite H3 in H1. destruct v; auto with ty; contradiction. -- specialize (H2 f f0). rewrite H3 in H2. +- specialize (H2 f f0). rewrite H3 in H2. destruct v; auto with ty; contradiction. Qed. Lemma pres_sem_binarith_int: - forall + forall (sem_int: signedness -> int -> int -> option val) (sem_long: signedness -> int64 -> int64 -> option val) v1 ty1 v2 ty2 v ty msg, @@ -1435,9 +1435,9 @@ Lemma pres_sem_binarith_int: binarith_int_type ty1 ty2 msg = OK ty -> wt_val v ty. Proof. - intros. eapply pres_sem_binarith with (msg := msg); eauto. + intros. eapply pres_sem_binarith with (msg := msg); eauto. simpl; auto. simpl; auto. - unfold binarith_int_type, binarith_type in *. + unfold binarith_int_type, binarith_type in *. destruct (classify_binarith ty1 ty2); congruence. Qed. @@ -1463,13 +1463,13 @@ Proof with (try discriminate). } assert (Y: forall ob, option_map Val.of_bool ob = Some v -> wt_val v (Tint I32 Signed noattr)). { - intros ob EQ. destruct ob as [b|]; inv EQ. eauto. + intros ob EQ. destruct ob as [b|]; inv EQ. eauto. } destruct (classify_cmp ty1 ty2). - inv H; eauto. - DestructCases; eauto. - DestructCases; eauto. -- unfold sem_binarith in H0. +- unfold sem_binarith in H0. set (ty' := Cop.binarith_type (classify_binarith ty1 ty2)) in *. destruct (sem_cast v1 ty1 ty') as [v1'|]... destruct (sem_cast v2 ty2 ty') as [v2'|]... @@ -1510,16 +1510,16 @@ Proof. - (* xor *) unfold sem_xor in SEM. eapply pres_sem_binarith_int; eauto; intros; exact I. - (* shl *) - unfold sem_shl in SEM. eapply pres_sem_shift; eauto. + unfold sem_shl in SEM. eapply pres_sem_shift; eauto. - (* shr *) - unfold sem_shr in SEM. eapply pres_sem_shift; eauto. + unfold sem_shr in SEM. eapply pres_sem_shift; eauto. - (* comparisons *) - eapply pres_sem_cmp; eauto. -- eapply pres_sem_cmp; eauto. -- eapply pres_sem_cmp; eauto. -- eapply pres_sem_cmp; eauto. -- eapply pres_sem_cmp; eauto. -- eapply pres_sem_cmp; eauto. + eapply pres_sem_cmp; eauto. +- eapply pres_sem_cmp; eauto. +- eapply pres_sem_cmp; eauto. +- eapply pres_sem_cmp; eauto. +- eapply pres_sem_cmp; eauto. +- eapply pres_sem_cmp; eauto. Qed. Lemma pres_sem_unop: @@ -1529,7 +1529,7 @@ Lemma pres_sem_unop: wt_val v1 ty1 -> wt_val v ty. Proof. - intros until v; intros TY SEM WT1. + intros until v; intros TY SEM WT1. destruct op; simpl in TY; simpl in SEM. - (* notbool *) unfold sem_notbool in SEM; DestructCases. @@ -1542,10 +1542,10 @@ Proof. - (* notint *) unfold sem_notint in SEM; DestructCases; auto with ty. - (* neg *) - unfold sem_neg in SEM; DestructCases; auto with ty. + unfold sem_neg in SEM; DestructCases; auto with ty. - (* absfloat *) unfold sem_absfloat in SEM; DestructCases; auto with ty. -Qed. +Qed. Lemma wt_load_result: forall ty chunk v, @@ -1569,10 +1569,10 @@ Lemma wt_decode_val: access_mode ty = By_value chunk -> wt_val (decode_val chunk vl) ty. Proof. - intros until vl; intros ACC. + intros until vl; intros ACC. destruct ty; simpl in ACC; try discriminate. - destruct i; [destruct s|destruct s|idtac|idtac]; inv ACC; unfold decode_val; - destruct (proj_bytes vl); auto with ty. + destruct (proj_bytes vl); auto with ty. constructor; red. apply Int.sign_ext_idem; omega. constructor; red. apply Int.zero_ext_idem; omega. constructor; red. apply Int.sign_ext_idem; omega. @@ -1643,7 +1643,7 @@ Lemma type_add_int32s: type_binop Oadd ty1 type_int32s = OK ty2 -> ty2 = incrdecr_type ty1. Proof. - simpl; intros. unfold classify_add in H; destruct ty1; simpl in H; + simpl; intros. unfold classify_add in H; destruct ty1; simpl in H; try (eapply binarith_type_int32s; eauto; fail). destruct i; eapply binarith_type_int32s; eauto. inv H; auto. @@ -1656,7 +1656,7 @@ Lemma type_sub_int32s: type_binop Osub ty1 type_int32s = OK ty2 -> ty2 = incrdecr_type ty1. Proof. - simpl; intros. unfold classify_sub in H; destruct ty1; simpl in H; + simpl; intros. unfold classify_sub in H; destruct ty1; simpl in H; try (eapply binarith_type_int32s; eauto; fail). destruct i; eapply binarith_type_int32s; eauto. inv H; auto. @@ -1669,37 +1669,37 @@ Lemma wt_rred: rred ge a m t a' m' -> wt_rvalue ge tenv a -> wt_rvalue ge tenv a'. Proof. induction 1; intros WT; inversion WT. -- (* valof *) simpl in *. constructor. eapply wt_deref_loc; eauto. +- (* valof *) simpl in *. constructor. eapply wt_deref_loc; eauto. - (* addrof *) constructor; auto with ty. -- (* unop *) simpl in H4. inv H2. constructor. eapply pres_sem_unop; eauto. -- (* binop *) +- (* unop *) simpl in H4. inv H2. constructor. eapply pres_sem_unop; eauto. +- (* binop *) simpl in H6. inv H3. inv H5. constructor. eapply pres_sem_binop; eauto. - (* cast *) inv H2. constructor. eapply pres_sem_cast; eauto. - (* sequand true *) subst. constructor. auto. apply wt_bool_cast; auto. - red; intros. inv H0; auto with ty. + red; intros. inv H0; auto with ty. - (* sequand false *) constructor. auto with ty. - (* seqor true *) constructor. auto with ty. - (* seqor false *) subst. constructor. auto. apply wt_bool_cast; auto. - red; intros. inv H0; auto with ty. -- (* condition *) constructor. destruct b; auto. destruct b; auto. red; auto. + red; intros. inv H0; auto with ty. +- (* condition *) constructor. destruct b; auto. destruct b; auto. red; auto. - (* sizeof *) constructor; auto with ty. - (* alignof *) constructor; auto with ty. - (* assign *) inversion H5. constructor. eapply pres_sem_cast; eauto. -- (* assignop *) subst tyres l r. constructor. auto. +- (* assignop *) subst tyres l r. constructor. auto. constructor. constructor. eapply wt_deref_loc; eauto. - auto. auto. auto. -- (* postincr *) simpl in *. subst id0 l. + auto. auto. auto. +- (* postincr *) simpl in *. subst id0 l. exploit wt_deref_loc; eauto. intros WTV1. - constructor. - constructor. auto. rewrite <- H0 in H5. constructor. + constructor. + constructor. auto. rewrite <- H0 in H5. constructor. constructor; auto. constructor. constructor. auto with ty. - subst op. destruct id. + subst op. destruct id. erewrite <- type_add_int32s by eauto. auto. erewrite <- type_sub_int32s by eauto. auto. simpl; auto. constructor; auto. - (* comma *) auto. -- (* paren *) inv H3. constructor. apply H5. eapply pres_sem_cast; eauto. +- (* paren *) inv H3. constructor. apply H5. eapply pres_sem_cast; eauto. - (* builtin *) subst. auto with ty. Qed. @@ -1707,7 +1707,7 @@ Lemma wt_lred: forall tenv ge e a m a' m', lred ge e a m a' m' -> wt_lvalue ge tenv a -> wt_lvalue ge tenv a'. Proof. - induction 1; intros WT; constructor. + induction 1; intros WT; constructor. Qed. Lemma rred_same_type: @@ -1733,7 +1733,7 @@ Hypothesis SAMETY: typeof a' = typeof a. Lemma wt_subexpr: forall from to C, - context from to C -> + context from to C -> wt_expr_kind cenv tenv to (C a) -> wt_expr_kind cenv tenv from a with wt_subexprlist: @@ -1756,10 +1756,10 @@ Lemma wt_arguments_context: forall k C, contextlist k C -> forall tyl, wt_arguments (C a) tyl -> wt_arguments (C a') tyl. Proof. - induction 1; intros. + induction 1; intros. - inv H0. constructor; auto. rewrite (typeof_context _ _ _ H); auto. constructor; auto. -- inv H0. constructor; auto. constructor; auto. +- inv H0. constructor; auto. constructor; auto. Qed. Lemma wt_context: @@ -1777,11 +1777,11 @@ with wt_contextlist: Proof. - induction 1; intros WT BASE; auto; - inv WT; + inv WT; try (pose (EQTY := typeof_context _ _ _ H); rewrite <- ? EQTY; econstructor; try (apply IHcontext; assumption); rewrite ? EQTY; eauto). -* red. econstructor; eauto. eapply wt_arguments_context; eauto. -* red. econstructor; eauto. eapply wt_arguments_context; eauto. +* red. econstructor; eauto. eapply wt_arguments_context; eauto. +* red. econstructor; eauto. eapply wt_arguments_context; eauto. - induction 1; intros WT BASE. * inv WT. constructor. apply (wt_context _ _ _ H); auto. auto. * inv WT. constructor; auto. @@ -1798,9 +1798,9 @@ Proof. unfold select_switch; intros. assert (A: wt_lblstmts ce e rt (select_switch_default sl)). { - revert sl H. induction 1; simpl; intros. + revert sl H. induction 1; simpl; intros. constructor. - destruct case. auto. constructor; auto. + destruct case. auto. constructor; auto. } assert (B: forall sl', select_switch_case n sl = Some sl' -> wt_lblstmts ce e rt sl'). { @@ -1812,7 +1812,7 @@ Proof. Qed. Lemma wt_seq_of_ls: - forall ce e rt sl, + forall ce e rt sl, wt_lblstmts ce e rt sl -> wt_stmt ce e rt (seq_of_labeled_statement sl). Proof. induction 1; simpl. @@ -1830,7 +1830,7 @@ Let ge := globalenv prog. Let gtenv := bind_globdef (PTree.empty _) prog.(prog_defs). Hypothesis WT_EXTERNAL: - forall id ef args res cc vargs m t vres m', + forall id ef args res cc vargs m t vres m', In (id, Gfun (External ef args res cc)) prog.(prog_defs) -> external_call ef ge vargs m t vres m' -> wt_val vres res. @@ -1916,7 +1916,7 @@ Qed. Lemma wt_call_cont_stmt_cont: forall te f k, wt_call_cont k f.(fn_return) -> wt_stmt_cont te f k. Proof. - intros. inversion H; subst. constructor. constructor; auto. + intros. inversion H; subst. constructor. constructor; auto. Qed. Lemma call_cont_wt: @@ -1984,7 +1984,7 @@ Scheme wt_stmt_ind2 := Minimality for wt_stmt Sort Prop Lemma wt_find_label: forall lbl e f s, wt_stmt ge e f.(fn_return) s -> - forall k s' k', + forall k s' k', find_label lbl s k = Some (s', k') -> wt_stmt_cont e f k -> wt_stmt ge e f.(fn_return) s' /\ wt_stmt_cont e f k'. @@ -1998,10 +1998,10 @@ Proof. wt_stmt ge e f.(fn_return) s' /\ wt_stmt_cont e f k'); simpl; intros; try discriminate. + destruct (find_label lbl s1 (Kseq s2 k)) as [[sx kx] | ] eqn:F. - inv H3. eauto with ty. + inv H3. eauto with ty. eauto with ty. + destruct (find_label lbl s1 k) as [[sx kx] | ] eqn:F. - inv H5. eauto with ty. + inv H5. eauto with ty. eauto with ty. + eauto with ty. + eauto with ty. @@ -2011,13 +2011,13 @@ Proof. inv H7. eauto with ty. eauto with ty. + eauto with ty. - + destruct (ident_eq lbl lbl0). - inv H1. auto. + + destruct (ident_eq lbl lbl0). + inv H1. auto. eauto. + destruct (find_label lbl s (Kseq (seq_of_labeled_statement ls) k)) as [[sx kx] | ] eqn:F. - inv H4. eapply H0; eauto. constructor. auto. apply wt_seq_of_ls; auto. + inv H4. eapply H0; eauto. constructor. auto. apply wt_seq_of_ls; auto. eauto. - + assumption. + + assumption. Qed. End WT_FIND_LABEL. @@ -2031,21 +2031,21 @@ Proof. econstructor; eauto. change (wt_expr_kind ge te RV (C a')). eapply wt_context with (a := a); eauto. eapply lred_same_type; eauto. - eapply wt_lred; eauto. change (wt_expr_kind ge te LV a). eapply wt_subexpr; eauto. + eapply wt_lred; eauto. change (wt_expr_kind ge te LV a). eapply wt_subexpr; eauto. - (* rred *) econstructor; eauto. change (wt_expr_kind ge te RV (C a')). eapply wt_context with (a := a); eauto. eapply rred_same_type; eauto. - eapply wt_rred; eauto. change (wt_expr_kind ge te RV a). eapply wt_subexpr; eauto. + eapply wt_rred; eauto. change (wt_expr_kind ge te RV a). eapply wt_subexpr; eauto. - (* call *) - assert (A: wt_expr_kind ge te RV a) by (eapply wt_subexpr; eauto). + assert (A: wt_expr_kind ge te RV a) by (eapply wt_subexpr; eauto). simpl in A. inv H. inv A. simpl in H9; rewrite H4 in H9; inv H9. assert (fundef_return fd = ty). { destruct fd; simpl in *. unfold type_of_function in H3. congruence. congruence. } econstructor. - rewrite H. econstructor; eauto. + rewrite H. econstructor; eauto. intros. change (wt_expr_kind ge te RV (C (Eval v ty))). eapply wt_context with (a := Ecall (Eval vf tyf) el ty); eauto. red; constructor; auto. @@ -2062,7 +2062,7 @@ Proof. - inv WTS; eauto with ty. - inv WTK; eauto with ty. - inv WTS; eauto with ty. -- inv WTK; eauto with ty. +- inv WTK; eauto with ty. - inv WTK; eauto with ty. - inv WTK; eauto with ty. - inv WTS; eauto with ty. @@ -2084,35 +2084,35 @@ Proof. - inv WTK; eauto with ty. - inv WTK; eauto with ty. - inv WTK; eauto with ty. -- econstructor. eapply call_cont_wt; eauto. constructor. -- inv WTS. eauto with ty. -- inv WTK. econstructor. eapply call_cont_wt; eauto. - inv WTE. eapply pres_sem_cast; eauto. -- econstructor. eapply is_wt_call_cont; eauto. constructor. -- inv WTS; eauto with ty. -- inv WTK. econstructor; eauto with ty. - apply wt_seq_of_ls. apply wt_select_switch; auto. +- econstructor. eapply call_cont_wt; eauto. constructor. +- inv WTS. eauto with ty. +- inv WTK. econstructor. eapply call_cont_wt; eauto. + inv WTE. eapply pres_sem_cast; eauto. +- econstructor. eapply is_wt_call_cont; eauto. constructor. +- inv WTS; eauto with ty. +- inv WTK. econstructor; eauto with ty. + apply wt_seq_of_ls. apply wt_select_switch; auto. - inv WTK; eauto with ty. - inv WTK; eauto with ty. - inv WTS; eauto with ty. -- exploit wt_find_label. eexact WTB. eauto. eapply call_cont_wt'; eauto. +- exploit wt_find_label. eexact WTB. eauto. eapply call_cont_wt'; eauto. intros [A B]. eauto with ty. -- simpl in WTFD; inv WTFD. econstructor; eauto. apply wt_call_cont_stmt_cont; auto. -- exploit (Genv.find_funct_inversion prog); eauto. intros (id & A). - econstructor; eauto. +- simpl in WTFD; inv WTFD. econstructor; eauto. apply wt_call_cont_stmt_cont; auto. +- exploit (Genv.find_funct_inversion prog); eauto. intros (id & A). + econstructor; eauto. - inv WTK. eauto with ty. Qed. Theorem preservation: forall S t S', step ge S t S' -> wt_state S -> wt_state S'. Proof. - intros. destruct H. eapply preservation_estep; eauto. eapply preservation_sstep; eauto. + intros. destruct H. eapply preservation_estep; eauto. eapply preservation_sstep; eauto. Qed. Theorem wt_initial_state: forall S, initial_state prog S -> wt_state S. Proof. - intros. inv H. econstructor. constructor. + intros. inv H. econstructor. constructor. apply Genv.find_funct_ptr_prop with (p := prog) (b := b); auto. intros. inv WTPROG. destruct f0; simpl; auto. apply H4 with id; auto. instantiate (1 := (Vptr b Int.zero)). rewrite Genv.find_funct_find_funct_ptr. auto. diff --git a/cfrontend/Initializersproof.v b/cfrontend/Initializersproof.v index 790877bd..3a7b5593 100644 --- a/cfrontend/Initializersproof.v +++ b/cfrontend/Initializersproof.v @@ -143,7 +143,7 @@ with eval_simple_rvalue: expr -> val -> Prop := eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some true -> eval_simple_rvalue (Eseqor r1 r2 ty) (Vint Int.one) | esr_condition: forall r1 r2 r3 ty v v1 b v', - eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some b -> + eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some b -> eval_simple_rvalue (if b then r2 else r3) v' -> sem_cast v' (typeof (if b then r2 else r3)) ty = Some v -> eval_simple_rvalue (Econdition r1 r2 r3 ty) v @@ -190,7 +190,7 @@ Qed. Lemma rred_simple: forall r m t r' m', rred ge r m t r' m' -> simple r -> simple r'. Proof. - induction 1; simpl; intuition. destruct b; auto. + induction 1; simpl; intuition. destruct b; auto. Qed. Lemma rred_compat: @@ -199,20 +199,20 @@ Lemma rred_compat: m = m' /\ compat_eval RV e r r' m. Proof. intros until m'; intros RED SIMP. inv RED; simpl in SIMP; try contradiction; split; auto; split; auto; intros vx EV. - inv EV. econstructor. constructor. auto. auto. + inv EV. econstructor. constructor. auto. auto. inv EV. econstructor. constructor. - inv EV. econstructor; eauto. constructor. + inv EV. econstructor; eauto. constructor. inv EV. econstructor; eauto. constructor. constructor. inv EV. econstructor; eauto. constructor. inv EV. eapply esr_seqand_true; eauto. constructor. inv EV. eapply esr_seqand_false; eauto. constructor. inv EV. eapply esr_seqor_true; eauto. constructor. inv EV. eapply esr_seqor_false; eauto. constructor. - inv EV. eapply esr_condition; eauto. constructor. + inv EV. eapply esr_condition; eauto. constructor. inv EV. constructor. inv EV. constructor. econstructor; eauto. constructor. - inv EV. econstructor. constructor. auto. + inv EV. econstructor. constructor. auto. Qed. Lemma compat_eval_context: @@ -225,19 +225,19 @@ Proof. try (generalize (IHcontext CE); intros [TY EV]; red; split; simpl; auto; intros). inv H0. constructor; auto. inv H0. - eapply esl_field_struct; eauto. rewrite TY; eauto. + eapply esl_field_struct; eauto. rewrite TY; eauto. eapply esl_field_union; eauto. rewrite TY; eauto. inv H0. econstructor. eauto. auto. auto. - inv H0. econstructor; eauto. + inv H0. econstructor; eauto. inv H0. econstructor; eauto. congruence. inv H0. econstructor; eauto. congruence. inv H0. econstructor; eauto. congruence. inv H0. econstructor; eauto. congruence. - inv H0. - eapply esr_seqand_true; eauto. rewrite TY; auto. + inv H0. + eapply esr_seqand_true; eauto. rewrite TY; auto. eapply esr_seqand_false; eauto. rewrite TY; auto. - inv H0. - eapply esr_seqor_false; eauto. rewrite TY; auto. + inv H0. + eapply esr_seqor_false; eauto. rewrite TY; auto. eapply esr_seqor_true; eauto. rewrite TY; auto. inv H0. eapply esr_condition; eauto. congruence. inv H0. @@ -249,19 +249,19 @@ Proof. red; split; intros. auto. inv H0. red; split; intros. auto. inv H0. inv H0. econstructor; eauto. - inv H0. econstructor; eauto. congruence. + inv H0. econstructor; eauto. congruence. Qed. Lemma simple_context_1: forall a from to C, context from to C -> simple (C a) -> simple a. Proof. - induction 1; simpl; tauto. + induction 1; simpl; tauto. Qed. Lemma simple_context_2: forall a a', simple a' -> forall from to C, context from to C -> simple (C a) -> simple (C a'). Proof. - induction 2; simpl; try tauto. + induction 2; simpl; try tauto. Qed. Lemma compat_eval_steps_aux f r e m r' m' s2 : @@ -296,16 +296,16 @@ Qed. Lemma compat_eval_steps: forall f r e m r' m', star step ge (ExprState f r Kstop e m) E0 (ExprState f r' Kstop e m') -> - simple r -> + simple r -> m' = m /\ compat_eval RV e r r' m. Proof. - intros. + intros. remember (ExprState f r Kstop e m) as S1. remember E0 as t. remember (ExprState f r' Kstop e m') as S2. revert S1 t S2 H r m r' m' HeqS1 Heqt HeqS2 H0. induction 1; intros; subst. - (* base case *) + (* base case *) inv HeqS2. split. auto. red; auto. (* inductive case *) destruct (app_eq_nil t1 t2); auto. subst. inv H. @@ -313,7 +313,7 @@ Proof. exploit compat_eval_steps_aux; eauto. intros [r1 [A [B C]]]. subst s2. exploit IHstar; eauto. intros [D E]. - split. auto. destruct B; destruct E. split. congruence. auto. + split. auto. destruct B; destruct E. split. congruence. auto. (* statement steps *) inv H1. Qed. @@ -324,7 +324,7 @@ Theorem eval_simple_steps: simple r -> m' = m /\ ty = typeof r /\ eval_simple_rvalue e m r v. Proof. - intros. exploit compat_eval_steps; eauto. intros [A [B C]]. + intros. exploit compat_eval_steps; eauto. intros [A [B C]]. intuition. apply C. constructor. Qed. @@ -344,7 +344,7 @@ Lemma mem_empty_not_valid_pointer: forall b ofs, Mem.valid_pointer Mem.empty b ofs = false. Proof. intros. unfold Mem.valid_pointer. destruct (Mem.perm_dec Mem.empty b ofs Cur Nonempty); auto. - eelim Mem.perm_empty; eauto. + eelim Mem.perm_empty; eauto. Qed. Lemma mem_empty_not_weak_valid_pointer: @@ -362,7 +362,7 @@ Lemma sem_cast_match: Val.inject inj v2' v2. Proof. intros. unfold do_cast in H0. destruct (sem_cast v1' ty1 ty2) as [v2''|] eqn:E; inv H0. - exploit sem_cast_inject. eexact E. eauto. + exploit sem_cast_inject. eexact E. eauto. intros [v' [A B]]. congruence. Qed. @@ -395,14 +395,14 @@ Proof. (* val *) destruct v; monadInv CV; constructor. (* rval *) - inv H1; rewrite H2 in CV; try congruence. eauto. eauto. + inv H1; rewrite H2 in CV; try congruence. eauto. eauto. (* addrof *) eauto. (* unop *) destruct (sem_unary_operation op x (typeof r1) Mem.empty) as [v1'|] eqn:E; inv EQ0. exploit (sem_unary_operation_inj inj Mem.empty m). intros. rewrite mem_empty_not_weak_valid_pointer in H2; discriminate. - eexact E. eauto. + eexact E. eauto. intros [v' [A B]]. congruence. (* binop *) destruct (sem_binary_operation ge op x (typeof r1) x0 (typeof r2) Mem.empty) as [v1'|] eqn:E; inv EQ2. @@ -411,34 +411,34 @@ Proof. intros. rewrite mem_empty_not_weak_valid_pointer in H3; discriminate. intros. rewrite mem_empty_not_weak_valid_pointer in H3; discriminate. intros. rewrite mem_empty_not_valid_pointer in H3; discriminate. - eauto. eauto. eauto. + eauto. eauto. eauto. intros [v' [A B]]. congruence. (* cast *) - eapply sem_cast_match; eauto. + eapply sem_cast_match; eauto. (* sizeof *) constructor. (* alignof *) constructor. (* seqand *) - destruct (bool_val x (typeof r1) Mem.empty) as [b|] eqn:E; inv EQ2. + destruct (bool_val x (typeof r1) Mem.empty) as [b|] eqn:E; inv EQ2. exploit bool_val_match. eexact E. eauto. instantiate (1 := m). intros E'. assert (b = true) by congruence. subst b. eapply sem_cast_match; eauto. - destruct (bool_val x (typeof r1) Mem.empty) as [b|] eqn:E; inv EQ2. + destruct (bool_val x (typeof r1) Mem.empty) as [b|] eqn:E; inv EQ2. exploit bool_val_match. eexact E. eauto. instantiate (1 := m). intros E'. assert (b = false) by congruence. subst b. inv H2. auto. (* seqor *) - destruct (bool_val x (typeof r1) Mem.empty) as [b|] eqn:E; inv EQ2. + destruct (bool_val x (typeof r1) Mem.empty) as [b|] eqn:E; inv EQ2. exploit bool_val_match. eexact E. eauto. instantiate (1 := m). intros E'. - assert (b = false) by congruence. subst b. + assert (b = false) by congruence. subst b. eapply sem_cast_match; eauto. - destruct (bool_val x (typeof r1) Mem.empty) as [b|] eqn:E; inv EQ2. + destruct (bool_val x (typeof r1) Mem.empty) as [b|] eqn:E; inv EQ2. exploit bool_val_match. eexact E. eauto. instantiate (1 := m). intros E'. assert (b = true) by congruence. subst b. inv H2. auto. (* conditional *) destruct (bool_val x (typeof r1) Mem.empty) as [b'|] eqn:E; inv EQ3. exploit bool_val_match. eexact E. eauto. instantiate (1 := m). intros E'. - assert (b' = b) by congruence. subst b'. + assert (b' = b) by congruence. subst b'. destruct b; eapply sem_cast_match; eauto. (* comma *) auto. @@ -450,14 +450,14 @@ Proof. (* var local *) unfold empty_env in H. rewrite PTree.gempty in H. congruence. (* var_global *) - econstructor. unfold inj. rewrite H0. eauto. auto. + econstructor. unfold inj. rewrite H0. eauto. auto. (* deref *) eauto. (* field struct *) - rewrite H0 in CV. monadInv CV. unfold lookup_composite in EQ; rewrite H1 in EQ; monadInv EQ. + rewrite H0 in CV. monadInv CV. unfold lookup_composite in EQ; rewrite H1 in EQ; monadInv EQ. exploit constval_rvalue; eauto. intro MV. inv MV. - simpl. replace x0 with delta by congruence. econstructor; eauto. - rewrite ! Int.add_assoc. f_equal. apply Int.add_commut. + simpl. replace x0 with delta by congruence. econstructor; eauto. + rewrite ! Int.add_assoc. f_equal. apply Int.add_commut. simpl. auto. (* field union *) rewrite H0 in CV. eauto. @@ -481,7 +481,7 @@ Theorem constval_steps: constval ge r = OK v -> m' = m /\ ty = typeof r /\ Val.inject inj v v'. Proof. - intros. exploit eval_simple_steps; eauto. eapply constval_simple; eauto. + intros. exploit eval_simple_steps; eauto. eapply constval_simple; eauto. intros [A [B C]]. intuition. eapply constval_rvalue; eauto. Qed. @@ -498,33 +498,33 @@ Theorem transl_init_single_steps: Mem.store chunk m' b ofs v = Some m'' -> Genv.store_init_data ge m b ofs data = Some m''. Proof. - intros. monadInv H. + intros. monadInv H. exploit constval_steps; eauto. intros [A [B C]]. subst m' ty1. exploit sem_cast_match; eauto. intros D. - unfold Genv.store_init_data. - inv D. + unfold Genv.store_init_data. + inv D. (* int *) - destruct ty; try discriminate. + destruct ty; try discriminate. destruct i0; inv EQ2. destruct s; simpl in H2; inv H2. rewrite <- Mem.store_signed_unsigned_8; auto. auto. destruct s; simpl in H2; inv H2. rewrite <- Mem.store_signed_unsigned_16; auto. auto. simpl in H2; inv H2. assumption. - simpl in H2; inv H2. assumption. + simpl in H2; inv H2. assumption. inv EQ2. simpl in H2; inv H2. assumption. (* long *) destruct ty; inv EQ2. simpl in H2; inv H2. assumption. (* float *) - destruct ty; try discriminate. + destruct ty; try discriminate. destruct f1; inv EQ2; simpl in H2; inv H2; assumption. (* single *) - destruct ty; try discriminate. + destruct ty; try discriminate. destruct f1; inv EQ2; simpl in H2; inv H2; assumption. (* pointer *) unfold inj in H. assert (data = Init_addrof b1 ofs1 /\ chunk = Mint32). destruct ty; inv EQ2; inv H2. destruct i; inv H5. intuition congruence. auto. - destruct H4; subst. destruct (Genv.find_symbol ge b1); inv H. + destruct H4; subst. destruct (Genv.find_symbol ge b1); inv H. rewrite Int.add_zero in H3. auto. (* undef *) discriminate. @@ -537,9 +537,9 @@ Lemma transl_init_single_size: transl_init_single ge ty a = OK data -> Genv.init_data_size data = sizeof ge ty. Proof. - intros. monadInv H. destruct x0. + intros. monadInv H. destruct x0. - monadInv EQ2. -- destruct ty; try discriminate. +- destruct ty; try discriminate. destruct i0; inv EQ2; auto. inv EQ2; auto. - destruct ty; inv EQ2; auto. @@ -557,15 +557,15 @@ Notation idlsize := Genv.init_data_list_size. Remark padding_size: forall frm to, frm <= to -> idlsize (padding frm to) = to - frm. Proof. - unfold padding; intros. destruct (zlt frm to). - simpl. xomega. + unfold padding; intros. destruct (zlt frm to). + simpl. xomega. simpl. omega. Qed. Remark idlsize_app: forall d1 d2, idlsize (d1 ++ d2) = idlsize d1 + idlsize d2. Proof. - induction d1; simpl; intros. + induction d1; simpl; intros. auto. rewrite IHd1. omega. Qed. @@ -573,11 +573,11 @@ Qed. Remark union_field_size: forall f ty fl, field_type f fl = OK ty -> sizeof ge ty <= sizeof_union ge fl. Proof. - induction fl as [|[i t]]; simpl; intros. + induction fl as [|[i t]]; simpl; intros. - inv H. -- destruct (ident_eq f i). - + inv H. xomega. - + specialize (IHfl H). xomega. +- destruct (ident_eq f i). + + inv H. xomega. + + specialize (IHfl H). xomega. Qed. Hypothesis ce_consistent: composite_env_consistent ge. @@ -599,9 +599,9 @@ with transl_init_list_size: idlsize data + pos = sizeof ge ty). Proof. -- induction i; intros. +- induction i; intros. + (* single *) - monadInv H. simpl. erewrite transl_init_single_size by eauto. omega. + monadInv H. simpl. erewrite transl_init_single_size by eauto. omega. + (* array *) simpl in H. destruct ty; try discriminate. simpl. eapply (proj1 (transl_init_list_size il)); eauto. @@ -611,19 +611,19 @@ Proof. replace (idlsize data) with (idlsize data + 0) by omega. eapply (proj2 (transl_init_list_size il)). eauto. unfold lookup_composite in EQ. simpl. destruct (ge.(genv_cenv)!i) as [co|] eqn:?; inv EQ. - erewrite co_consistent_sizeof by (eapply ce_consistent; eauto). + erewrite co_consistent_sizeof by (eapply ce_consistent; eauto). unfold sizeof_composite. rewrite Heqs. apply align_le. destruct (co_alignof_two_p x) as [n EQ]. rewrite EQ. apply two_power_nat_pos. + (* union *) simpl in H. destruct ty; try discriminate. monadInv H. destruct (co_su x) eqn:?; try discriminate. - monadInv EQ0. + monadInv EQ0. rewrite idlsize_app. rewrite (IHi _ _ EQ0). unfold lookup_composite in EQ. simpl. destruct (ge.(genv_cenv)!i0) as [co|] eqn:?; inv EQ. rewrite padding_size. omega. - apply Zle_trans with (sizeof_union ge (co_members x)). + apply Zle_trans with (sizeof_union ge (co_members x)). eapply union_field_size; eauto. - erewrite co_consistent_sizeof by (eapply ce_consistent; eauto). + erewrite co_consistent_sizeof by (eapply ce_consistent; eauto). unfold sizeof_composite. rewrite Heqs. apply align_le. destruct (co_alignof_two_p x) as [n EQ]. rewrite EQ. apply two_power_nat_pos. @@ -631,9 +631,9 @@ Proof. + (* base cases *) simpl. intuition auto. * (* arrays *) - destruct (zeq sz 0). inv H. simpl; ring. - destruct (zle 0 sz); inv H. simpl. - rewrite Z.mul_comm. + destruct (zeq sz 0). inv H. simpl; ring. + destruct (zle 0 sz); inv H. simpl. + rewrite Z.mul_comm. assert (0 <= sizeof ge ty * sz). { apply Zmult_gt_0_le_0_compat. omega. generalize (sizeof_pos ge ty); omega. } zify; omega. @@ -645,17 +645,17 @@ Proof. * (* arrays *) intros. monadInv H. rewrite idlsize_app. - rewrite (transl_init_size _ _ _ EQ). + rewrite (transl_init_size _ _ _ EQ). rewrite (A _ _ _ EQ1). ring. * (* structs *) intros. simpl in H. destruct fl as [|[i1 t1]]; monadInv H. - rewrite ! idlsize_app. - simpl in H0. + rewrite ! idlsize_app. + simpl in H0. rewrite padding_size. - rewrite (transl_init_size _ _ _ EQ). + rewrite (transl_init_size _ _ _ EQ). rewrite <- (B _ _ _ _ EQ1). omega. - auto. apply align_le. apply alignof_pos. + auto. apply align_le. apply alignof_pos. Qed. (** A semantics for general initializers *) @@ -671,7 +671,7 @@ Fixpoint fields_of_struct (fl: members) (pos: Z) : list (Z * type) := Inductive exec_init: mem -> block -> Z -> type -> initializer -> mem -> Prop := | exec_init_single: forall m b ofs ty a v1 ty1 chunk m' v m'', - star step ge (ExprState dummy_function a Kstop empty_env m) + star step ge (ExprState dummy_function a Kstop empty_env m) E0 (ExprState dummy_function (Eval v1 ty1) Kstop empty_env m') -> sem_cast v1 ty1 ty = Some v -> access_mode ty = By_value chunk -> @@ -713,7 +713,7 @@ Scheme exec_init_ind3 := Minimality for exec_init Sort Prop Combined Scheme exec_init_scheme from exec_init_ind3, exec_init_array_ind3, exec_init_list_ind3. Remark exec_init_array_length: - forall m b ofs ty sz il m', + forall m b ofs ty sz il m', exec_init_array m b ofs ty sz il m' -> sz >= 0. Proof. induction 1; omega. @@ -725,7 +725,7 @@ Lemma store_init_data_list_app: Genv.store_init_data_list ge m' b (ofs + idlsize data1) data2 = Some m'' -> Genv.store_init_data_list ge m b ofs (data1 ++ data2) = Some m''. Proof. - induction data1; simpl; intros. + induction data1; simpl; intros. inv H. rewrite Zplus_0_r in H0. auto. destruct (Genv.store_init_data ge m b ofs a); try discriminate. rewrite Zplus_assoc in H0. eauto. @@ -735,7 +735,7 @@ Remark store_init_data_list_padding: forall frm to b ofs m, Genv.store_init_data_list ge m b ofs (padding frm to) = Some m. Proof. - intros. unfold padding. destruct (zlt frm to); auto. + intros. unfold padding. destruct (zlt frm to); auto. Qed. Lemma transl_init_sound_gen: @@ -757,33 +757,33 @@ Local Opaque sizeof. monadInv H3. simpl. erewrite transl_init_single_steps by eauto. auto. - (* array *) replace (Z.max 0 sz) with sz in H1. eauto. - assert (sz >= 0) by (eapply exec_init_array_length; eauto). xomega. + assert (sz >= 0) by (eapply exec_init_array_length; eauto). xomega. - (* struct *) - unfold lookup_composite in H3. rewrite H in H3. simpl in H3. rewrite H0 in H3. + unfold lookup_composite in H3. rewrite H in H3. simpl in H3. rewrite H0 in H3. replace ofs with (ofs + 0) by omega. eauto. - (* union *) - unfold lookup_composite in H4. rewrite H in H4. simpl in H4. rewrite H0 in H4. - monadInv H4. assert (x = ty) by congruence. subst x. + unfold lookup_composite in H4. rewrite H in H4. simpl in H4. rewrite H0 in H4. + monadInv H4. assert (x = ty) by congruence. subst x. eapply store_init_data_list_app. eauto. - apply store_init_data_list_padding. + apply store_init_data_list_padding. - (* array, empty *) destruct (zeq sz 0). inv H0. auto. rewrite zle_true in H0 by omega. inv H0. auto. - (* array, nonempty *) - monadInv H3. + monadInv H3. eapply store_init_data_list_app. eauto. rewrite (transl_init_size _ _ _ EQ). eauto. - (* struct, empty *) - destruct fl as [|[i t]]; simpl in H0; inv H0. + destruct fl as [|[i t]]; simpl in H0; inv H0. apply store_init_data_list_padding. - (* struct, nonempty *) destruct fl as [|[i t]]; simpl in H4; monadInv H4. simpl in H3; inv H3. eapply store_init_data_list_app. apply store_init_data_list_padding. - rewrite padding_size. + rewrite padding_size. replace (ofs + pos0 + (align pos0 (alignof ge t) - pos0)) with (ofs + align pos0 (alignof ge t)) by omega. eapply store_init_data_list_app. @@ -801,7 +801,7 @@ Theorem transl_init_sound: transl_init (prog_comp_env p) ty i = OK data -> Genv.store_init_data_list (globalenv p) m b 0 data = Some m'. Proof. - intros. + intros. set (ge := globalenv p) in *. change (prog_comp_env p) with (genv_cenv ge) in H0. destruct (transl_init_sound_gen ge) as (A & B & C). diff --git a/cfrontend/PrintClight.ml b/cfrontend/PrintClight.ml index f1c3ef18..ed19e178 100644 --- a/cfrontend/PrintClight.ml +++ b/cfrontend/PrintClight.ml @@ -67,7 +67,7 @@ let rec expr p (prec, e) = if assoc = LtoR then (prec', prec' + 1) else (prec' + 1, prec') in - if prec' < prec + if prec' < prec then fprintf p "@[<hov 2>(" else fprintf p "@[<hov 2>"; begin match e with diff --git a/cfrontend/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml index ce912a8c..4f2a8d0c 100644 --- a/cfrontend/PrintCsyntax.ml +++ b/cfrontend/PrintCsyntax.ml @@ -80,7 +80,7 @@ let attributes a = sprintf " _Alignas(%Ld)%s" (Int64.shift_left 1L (N.to_int l)) s1 let attributes_space a = - let s = attributes a in + let s = attributes a in if String.length s = 0 then s else s ^ " " let name_optid id = @@ -202,7 +202,7 @@ let rec expr p (prec, e) = if assoc = LtoR then (prec', prec' + 1) else (prec' + 1, prec') in - if prec' < prec + if prec' < prec then fprintf p "@[<hov 2>(" else fprintf p "@[<hov 2>"; begin match e with diff --git a/cfrontend/SimplExpr.v b/cfrontend/SimplExpr.v index 097dc589..4fe8105d 100644 --- a/cfrontend/SimplExpr.v +++ b/cfrontend/SimplExpr.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Translation from Compcert C to Clight. +(** Translation from Compcert C to Clight. Side effects are pulled out of Compcert C expressions. *) Require Import Coqlib. @@ -82,11 +82,11 @@ Local Open Scope gensym_monad_scope. Parameter first_unused_ident: unit -> ident. -Definition initial_generator (x: unit) : generator := +Definition initial_generator (x: unit) : generator := mkgenerator (first_unused_ident x) nil. Definition gensym (ty: type): mon ident := - fun (g: generator) => + fun (g: generator) => Res (gen_next g) (mkgenerator (Psucc (gen_next g)) ((gen_next g, ty) :: gen_trail g)) (Ple_succ (gen_next g)). @@ -119,7 +119,7 @@ Function eval_simpl_expr (a: expr) : option val := | Econst_float n _ => Some(Vfloat n) | Econst_single n _ => Some(Vsingle n) | Econst_long n _ => Some(Vlong n) - | Ecast b ty => + | Ecast b ty => match eval_simpl_expr b with | None => None | Some v => sem_cast v (typeof b) ty @@ -149,7 +149,7 @@ Definition transl_incrdecr (id: incr_or_decr) (a: expr) (ty: type) : expr := to dereference a l-value [l] and store its result in temporary variable [id]. *) Definition chunk_for_volatile_type (ty: type) : option memory_chunk := - if type_is_volatile ty + if type_is_volatile ty then match access_mode ty with By_value chunk => Some chunk | _ => None end else None. @@ -201,7 +201,7 @@ Inductive set_destination : Type := | SDbase (tycast ty: type) (tmp: ident) | SDcons (tycast ty: type) (tmp: ident) (sd: set_destination). -Inductive destination : Type := +Inductive destination : Type := | For_val | For_effects | For_set (sd: set_destination). @@ -277,7 +277,7 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement | For_val => do t <- gensym ty; do (sl2, a2) <- transl_expr (For_set (sd_seqbool_val t ty)) r2; - ret (sl1 ++ + ret (sl1 ++ makeif a1 (makeseq sl2) (Sset t (Econst_int Int.zero ty)) :: nil, Etempvar t ty) | For_effects => @@ -285,7 +285,7 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement ret (sl1 ++ makeif a1 (makeseq sl2) Sskip :: nil, dummy_expr) | For_set sd => do (sl2, a2) <- transl_expr (For_set (sd_seqbool_set ty sd)) r2; - ret (sl1 ++ + ret (sl1 ++ makeif a1 (makeseq sl2) (makeseq (do_set sd (Econst_int Int.zero ty))) :: nil, dummy_expr) end @@ -295,7 +295,7 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement | For_val => do t <- gensym ty; do (sl2, a2) <- transl_expr (For_set (sd_seqbool_val t ty)) r2; - ret (sl1 ++ + ret (sl1 ++ makeif a1 (Sset t (Econst_int Int.one ty)) (makeseq sl2) :: nil, Etempvar t ty) | For_effects => @@ -303,7 +303,7 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement ret (sl1 ++ makeif a1 Sskip (makeseq sl2) :: nil, dummy_expr) | For_set sd => do (sl2, a2) <- transl_expr (For_set (sd_seqbool_set ty sd)) r2; - ret (sl1 ++ + ret (sl1 ++ makeif a1 (makeseq (do_set sd (Econst_int Int.one ty))) (makeseq sl2) :: nil, dummy_expr) end @@ -336,7 +336,7 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement match dst with | For_val | For_set _ => do t <- gensym ty2; - ret (finish dst + ret (finish dst (sl1 ++ sl2 ++ Sset t a2 :: make_assign a1 (Etempvar t ty2) :: nil) (Ecast (Etempvar t ty2) ty1)) | For_effects => diff --git a/cfrontend/SimplExprproof.v b/cfrontend/SimplExprproof.v index 7ef1cbe2..8f06e777 100644 --- a/cfrontend/SimplExprproof.v +++ b/cfrontend/SimplExprproof.v @@ -45,20 +45,20 @@ Let tge := Clight.globalenv tprog. Lemma comp_env_preserved: Clight.genv_cenv tge = Csem.genv_cenv ge. Proof. - monadInv TRANSL. unfold tge; rewrite <- H0; auto. + monadInv TRANSL. unfold tge; rewrite <- H0; auto. Qed. Lemma symbols_preserved: forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s. Proof. - intros. eapply Genv.find_symbol_match. eapply transl_program_spec; eauto. + intros. eapply Genv.find_symbol_match. eapply transl_program_spec; eauto. simpl. tauto. Qed. Lemma public_preserved: forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s. Proof. - intros. eapply Genv.public_symbol_match. eapply transl_program_spec; eauto. + intros. eapply Genv.public_symbol_match. eapply transl_program_spec; eauto. simpl. tauto. Qed. @@ -87,11 +87,11 @@ Qed. Lemma varinfo_preserved: forall b, Genv.find_var_info tge b = Genv.find_var_info ge b. Proof. - intros. destruct (Genv.find_var_info ge b) as [v|] eqn:V. -- exploit Genv.find_var_info_match. eapply transl_program_spec; eauto. eassumption. + intros. destruct (Genv.find_var_info ge b) as [v|] eqn:V. +- exploit Genv.find_var_info_match. eapply transl_program_spec; eauto. eassumption. intros [tv [A B]]. inv B. assumption. - destruct (Genv.find_var_info tge b) as [v'|] eqn:V'; auto. - exploit Genv.find_var_info_rev_match. eapply transl_program_spec; eauto. eassumption. + exploit Genv.find_var_info_rev_match. eapply transl_program_spec; eauto. eassumption. simpl. destruct (plt b (Genv.genv_next (Genv.globalenv prog))); try tauto. intros [v [A B]]. inv B. change (Genv.globalenv prog) with (Csem.genv_genv ge) in A. congruence. Qed. @@ -115,7 +115,7 @@ Lemma function_return_preserved: forall f tf, tr_function f tf -> fn_return tf = Csyntax.fn_return f. Proof. - intros. inv H; auto. + intros. inv H; auto. Qed. (** Translation of simple expressions. *) @@ -133,7 +133,7 @@ Proof. rewrite H0; auto. simpl; auto. destruct H1; congruence. destruct (andb_prop _ _ H6). inv H1. - rewrite H0; eauto. simpl; auto. + rewrite H0; eauto. simpl; auto. unfold chunk_for_volatile_type in H9. destruct (type_is_volatile (Csyntax.typeof e1)); simpl in H8; congruence. rewrite H0; auto. simpl; auto. @@ -163,7 +163,7 @@ Remark deref_loc_translated: | Some chunk => volatile_load tge chunk m b ofs t v end. Proof. - intros. unfold chunk_for_volatile_type. inv H. + intros. unfold chunk_for_volatile_type. inv H. (* By_value, not volatile *) rewrite H1. split; auto. eapply deref_loc_value; eauto. (* By_value, volatile *) @@ -183,14 +183,14 @@ Remark assign_loc_translated: | Some chunk => volatile_store tge chunk m b ofs v t m' end. Proof. - intros. unfold chunk_for_volatile_type. inv H. + intros. unfold chunk_for_volatile_type. inv H. (* By_value, not volatile *) rewrite H1. split; auto. eapply assign_loc_value; eauto. (* By_value, volatile *) rewrite H0; rewrite H1. eapply volatile_store_preserved with (ge1 := ge); auto. exact symbols_preserved. exact public_preserved. exact block_is_volatile_preserved. (* By copy *) - rewrite H0. rewrite <- comp_env_preserved in *. + rewrite H0. rewrite <- comp_env_preserved in *. destruct (type_is_volatile ty); split; auto; eapply assign_loc_copy; eauto. Qed. @@ -233,12 +233,12 @@ Opaque makeif. rewrite <- B. exploit deref_loc_translated; eauto. unfold chunk_for_volatile_type; rewrite H2. tauto. destruct dst; auto. - econstructor. split. simpl; eauto. auto. + econstructor. split. simpl; eauto. auto. (* addrof *) exploit H0; eauto. intros [A [B C]]. subst sl1; simpl. assert (eval_expr tge e le m (Eaddrof a1 ty) (Vptr b ofs)). econstructor; eauto. - destruct dst; auto. simpl; econstructor; eauto. + destruct dst; auto. simpl; econstructor; eauto. (* unop *) exploit H0; eauto. intros [A [B C]]. subst sl1; simpl. @@ -256,19 +256,19 @@ Opaque makeif. assert (eval_expr tge e le m (Ecast a1 ty) v). econstructor; eauto. congruence. destruct dst; auto. simpl; econstructor; eauto. (* sizeof *) - rewrite <- comp_env_preserved. + rewrite <- comp_env_preserved. destruct dst. split; auto. split; auto. constructor. auto. exists (Esizeof ty1 ty). split. auto. split. auto. constructor. (* alignof *) - rewrite <- comp_env_preserved. + rewrite <- comp_env_preserved. destruct dst. split; auto. split; auto. constructor. auto. exists (Ealignof ty1 ty). split. auto. split. auto. constructor. (* var local *) - split; auto. split; auto. apply eval_Evar_local; auto. + split; auto. split; auto. apply eval_Evar_local; auto. (* var global *) split; auto. split; auto. apply eval_Evar_global; auto. rewrite symbols_preserved; auto. @@ -302,7 +302,7 @@ Proof. intros e m. exact (proj1 (tr_simple e m)). Qed. -Lemma tr_simple_lvalue: +Lemma tr_simple_lvalue: forall e m l b ofs, eval_simple_lvalue ge e m l b ofs -> forall le sl a tmps, @@ -319,7 +319,7 @@ Lemma tr_simple_exprlist: eval_simple_list ge e m rl tyl vl -> sl = nil /\ eval_exprlist tge e le m al tyl vl. Proof. - induction 1; intros. + induction 1; intros. inv H. split. auto. constructor. inv H4. exploit tr_simple_rvalue; eauto. intros [A [B C]]. @@ -334,7 +334,7 @@ Lemma typeof_context: forall e1 e2, Csyntax.typeof e1 = Csyntax.typeof e2 -> Csyntax.typeof (C e1) = Csyntax.typeof (C e2). Proof. - induction 1; intros; auto. + induction 1; intros; auto. Qed. Scheme leftcontext_ind2 := Minimality for leftcontext Sort Prop @@ -395,131 +395,131 @@ Ltac UNCHANGED := (* base *) TR. rewrite <- app_nil_end; auto. red; auto. - intros. rewrite <- app_nil_end; auto. + intros. rewrite <- app_nil_end; auto. (* deref *) - inv H1. + inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1; rewrite app_ass; eauto. auto. - intros. rewrite <- app_ass. econstructor; eauto. + TR. subst sl1; rewrite app_ass; eauto. auto. + intros. rewrite <- app_ass. econstructor; eauto. (* field *) inv H1. exploit H0. eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1; rewrite app_ass; eauto. auto. + TR. subst sl1; rewrite app_ass; eauto. auto. intros. rewrite <- app_ass. econstructor; eauto. (* rvalof *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1; rewrite app_ass; eauto. red; eauto. - intros. rewrite <- app_ass; econstructor; eauto. + TR. subst sl1; rewrite app_ass; eauto. red; eauto. + intros. rewrite <- app_ass; econstructor; eauto. exploit typeof_context; eauto. congruence. (* addrof *) - inv H1. + inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1; rewrite app_ass; eauto. auto. + TR. subst sl1; rewrite app_ass; eauto. auto. intros. rewrite <- app_ass. econstructor; eauto. -(* unop *) - inv H1. +(* unop *) + inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1; rewrite app_ass; eauto. auto. - intros. rewrite <- app_ass. econstructor; eauto. + TR. subst sl1; rewrite app_ass; eauto. auto. + intros. rewrite <- app_ass. econstructor; eauto. (* binop left *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1. rewrite app_ass. eauto. - red; auto. + TR. subst sl1. rewrite app_ass. eauto. + red; auto. intros. rewrite <- app_ass. econstructor; eauto. - eapply tr_expr_invariant; eauto. UNCHANGED. + eapply tr_expr_invariant; eauto. UNCHANGED. (* binop right *) - inv H2. + inv H2. assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl2. rewrite app_ass. eauto. - red; auto. + TR. subst sl2. rewrite app_ass. eauto. + red; auto. intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor; eauto. - eapply tr_expr_invariant; eauto. UNCHANGED. + eapply tr_expr_invariant; eauto. UNCHANGED. (* cast *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1; rewrite app_ass; eauto. auto. + TR. subst sl1; rewrite app_ass; eauto. auto. intros. rewrite <- app_ass. econstructor; eauto. (* seqand *) inv H1. (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. - rewrite Q. rewrite app_ass. eauto. + TR. + rewrite Q. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. econstructor. apply S; auto. + intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. - rewrite Q. rewrite app_ass. eauto. + TR. + rewrite Q. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. econstructor. apply S; auto. + intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. (* for set *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. - rewrite Q. rewrite app_ass. eauto. + TR. + rewrite Q. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. econstructor. apply S; auto. + intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. (* seqor *) inv H1. (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. - rewrite Q. rewrite app_ass. eauto. + TR. + rewrite Q. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. econstructor. apply S; auto. + intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. - rewrite Q. rewrite app_ass. eauto. + TR. + rewrite Q. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. econstructor. apply S; auto. + intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. (* for set *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. - rewrite Q. rewrite app_ass. eauto. + TR. + rewrite Q. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. econstructor. apply S; auto. + intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. (* condition *) inv H1. (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. - rewrite Q. rewrite app_ass. eauto. + TR. + rewrite Q. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. econstructor. apply S; auto. + intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. auto. auto. (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. - rewrite Q. rewrite app_ass. eauto. + TR. + rewrite Q. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. eapply tr_condition_effects. apply S; auto. + intros. rewrite <- app_ass. eapply tr_condition_effects. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. auto. (* for set *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. - rewrite Q. rewrite app_ass. eauto. + TR. + rewrite Q. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. eapply tr_condition_set. apply S; auto. + intros. rewrite <- app_ass. eapply tr_condition_set. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. auto. auto. @@ -527,120 +527,120 @@ Ltac UNCHANGED := inv H1. (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1. rewrite app_ass. eauto. - red; auto. + TR. subst sl1. rewrite app_ass. eauto. + red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1. rewrite app_ass. eauto. - red; auto. + TR. subst sl1. rewrite app_ass. eauto. + red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. auto. auto. eapply typeof_context; eauto. - auto. + auto. (* assign right *) - inv H2. + inv H2. (* for effects *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl2. rewrite app_ass. eauto. - red; auto. - intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ (sl3 ++ sl2')). rewrite app_ass. - econstructor. + TR. subst sl2. rewrite app_ass. eauto. + red; auto. + intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ (sl3 ++ sl2')). rewrite app_ass. + econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. auto. auto. auto. (* for val *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl2. rewrite app_ass. eauto. - red; auto. - intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ (sl3 ++ sl2')). rewrite app_ass. - econstructor. + TR. subst sl2. rewrite app_ass. eauto. + red; auto. + intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ (sl3 ++ sl2')). rewrite app_ass. + econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. - apply S; auto. auto. auto. auto. auto. auto. auto. auto. + apply S; auto. auto. auto. auto. auto. auto. auto. auto. eapply typeof_context; eauto. (* assignop left *) inv H1. (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1. rewrite app_ass. eauto. - red; auto. + TR. subst sl1. rewrite app_ass. eauto. + red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. - eapply tr_expr_invariant; eauto. UNCHANGED. - symmetry; eapply typeof_context; eauto. eauto. + eapply tr_expr_invariant; eauto. UNCHANGED. + symmetry; eapply typeof_context; eauto. eauto. auto. auto. auto. auto. auto. auto. (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1. rewrite app_ass. eauto. - red; auto. + TR. subst sl1. rewrite app_ass. eauto. + red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. - eapply tr_expr_invariant; eauto. UNCHANGED. - eauto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. + eapply tr_expr_invariant; eauto. UNCHANGED. + eauto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. eapply typeof_context; eauto. (* assignop right *) inv H2. (* for effects *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl2. rewrite app_ass. eauto. + TR. subst sl2. rewrite app_ass. eauto. red; auto. - intros. rewrite <- app_ass. change (sl0 ++ sl2') with (nil ++ sl0 ++ sl2'). rewrite app_ass. econstructor. + intros. rewrite <- app_ass. change (sl0 ++ sl2') with (nil ++ sl0 ++ sl2'). rewrite app_ass. econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. - apply S; auto. auto. eauto. auto. auto. auto. auto. auto. auto. + apply S; auto. auto. eauto. auto. auto. auto. auto. auto. auto. (* for val *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl2. rewrite app_ass. eauto. - red; auto. - intros. rewrite <- app_ass. change (sl0 ++ sl2') with (nil ++ sl0 ++ sl2'). rewrite app_ass. econstructor. + TR. subst sl2. rewrite app_ass. eauto. + red; auto. + intros. rewrite <- app_ass. change (sl0 ++ sl2') with (nil ++ sl0 ++ sl2'). rewrite app_ass. econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. - apply S; auto. eauto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. + apply S; auto. eauto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. (* postincr *) inv H1. (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. rewrite Q; rewrite app_ass; eauto. red; auto. - intros. rewrite <- app_ass. econstructor; eauto. - symmetry; eapply typeof_context; eauto. + TR. rewrite Q; rewrite app_ass; eauto. red; auto. + intros. rewrite <- app_ass. econstructor; eauto. + symmetry; eapply typeof_context; eauto. (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. rewrite Q; rewrite app_ass; eauto. red; auto. - intros. rewrite <- app_ass. econstructor; eauto. + TR. rewrite Q; rewrite app_ass; eauto. red; auto. + intros. rewrite <- app_ass. econstructor; eauto. eapply typeof_context; eauto. (* call left *) inv H1. (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. rewrite Q; rewrite app_ass; eauto. red; auto. + TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_exprlist_invariant; eauto. UNCHANGED. auto. auto. auto. (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. rewrite Q; rewrite app_ass; eauto. red; auto. + TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. econstructor. auto. apply S; auto. eapply tr_exprlist_invariant; eauto. UNCHANGED. - auto. auto. auto. auto. + auto. auto. auto. auto. (* call right *) inv H2. (* for effects *) - assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. + assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. (*destruct dst'; constructor||contradiction.*) - red; auto. + red; auto. intros. rewrite <- app_ass. change (sl3++sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. auto. auto. auto. (* for val *) - assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. + assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. (*destruct dst'; constructor||contradiction.*) - red; auto. + red; auto. intros. rewrite <- app_ass. change (sl3++sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor. auto. eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. @@ -650,27 +650,27 @@ Ltac UNCHANGED := (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. - red; auto. + red; auto. intros. rewrite <- app_ass. change (sl3++sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor. apply S; auto. auto. (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. - red; auto. + red; auto. intros. rewrite <- app_ass. change (sl3++sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor. auto. apply S; auto. auto. auto. (* comma *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. rewrite Q; rewrite app_ass; eauto. red; auto. + TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. (* paren *) - inv H1. + inv H1. (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. rewrite Q. eauto. red; auto. + TR. rewrite Q. eauto. red; auto. intros. econstructor; eauto. (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. @@ -683,17 +683,17 @@ Ltac UNCHANGED := (* cons left *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1. rewrite app_ass. eauto. - red; auto. + TR. subst sl1. rewrite app_ass. eauto. + red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_exprlist_invariant; eauto. UNCHANGED. auto. auto. auto. (* cons right *) inv H2. - assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. + assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl2. eauto. - red; auto. + TR. subst sl2. eauto. + red; auto. intros. change sl3 with (nil ++ sl3). rewrite app_ass. econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. @@ -747,7 +747,7 @@ Proof. exists dst'; exists sl1; exists sl2; exists a'; exists tmp'. split. apply tr_top_base; auto. split. auto. split. auto. - intros. apply tr_top_base. apply S; auto. + intros. apply tr_top_base. apply S; auto. Qed. (** Semantics of smart constructors *) @@ -756,18 +756,18 @@ Lemma eval_simpl_expr_sound: forall e le m a v, eval_expr tge e le m a v -> match eval_simpl_expr a with Some v' => v' = v | None => True end. Proof. - induction 1; simpl; auto. - destruct (eval_simpl_expr a); auto. subst. rewrite H0. auto. + induction 1; simpl; auto. + destruct (eval_simpl_expr a); auto. subst. rewrite H0. auto. inv H; simpl; auto. Qed. Lemma static_bool_val_sound: forall v t m b, bool_val v t Mem.empty = Some b -> bool_val v t m = Some b. Proof. - intros until b; unfold bool_val. destruct (classify_bool t); destruct v; auto. - intros E. unfold Mem.weak_valid_pointer, Mem.valid_pointer, proj_sumbool in E. - rewrite ! pred_dec_false in E by (apply Mem.perm_empty). discriminate. -Qed. + intros until b; unfold bool_val. destruct (classify_bool t); destruct v; auto. + intros E. unfold Mem.weak_valid_pointer, Mem.valid_pointer, proj_sumbool in E. + rewrite ! pred_dec_false in E by (apply Mem.perm_empty). discriminate. +Qed. Lemma step_makeif: forall f a s1 s2 k e le m v1 b, @@ -778,13 +778,13 @@ Lemma step_makeif: Proof. intros. functional induction (makeif a s1 s2). - exploit eval_simpl_expr_sound; eauto. rewrite e0. intro EQ; subst v. - assert (bool_val v1 (typeof a) m = Some true) by (apply static_bool_val_sound; auto). + assert (bool_val v1 (typeof a) m = Some true) by (apply static_bool_val_sound; auto). replace b with true by congruence. constructor. - exploit eval_simpl_expr_sound; eauto. rewrite e0. intro EQ; subst v. - assert (bool_val v1 (typeof a) m = Some false) by (apply static_bool_val_sound; auto). + assert (bool_val v1 (typeof a) m = Some false) by (apply static_bool_val_sound; auto). replace b with false by congruence. constructor. -- apply star_one. eapply step_ifthenelse; eauto. -- apply star_one. eapply step_ifthenelse; eauto. +- apply star_one. eapply step_ifthenelse; eauto. +- apply star_one. eapply step_ifthenelse; eauto. Qed. Lemma step_make_set: @@ -801,7 +801,7 @@ Proof. intros. change (PTree.set id v le) with (set_opttemp (Some id) v le). econstructor. econstructor. constructor. eauto. simpl. unfold sem_cast. simpl. eauto. constructor. - simpl. econstructor; eauto. + simpl. econstructor; eauto. (* nonvolatile case *) intros [A B]. subst t. constructor. eapply eval_Elvalue; eauto. Qed. @@ -823,9 +823,9 @@ Proof. econstructor. constructor. eauto. simpl. unfold sem_cast. simpl. eauto. econstructor; eauto. rewrite H3; eauto. constructor. - simpl. econstructor; eauto. + simpl. econstructor; eauto. (* nonvolatile case *) - intros [A B]. subst t. econstructor; eauto. congruence. + intros [A B]. subst t. econstructor; eauto. congruence. Qed. Fixpoint Kseqlist (sl: list statement) (k: cont) := @@ -846,7 +846,7 @@ Lemma push_seq: star step1 tge (State f (makeseq sl) k e le m) E0 (State f Sskip (Kseqlist sl k) e le m). Proof. - intros. unfold makeseq. generalize Sskip. revert sl k. + intros. unfold makeseq. generalize Sskip. revert sl k. induction sl; simpl; intros. apply star_refl. eapply star_right. apply IHsl. constructor. traceEq. @@ -868,16 +868,16 @@ Proof. intros. inv H1. (* not volatile *) exploit deref_loc_translated; eauto. unfold chunk_for_volatile_type; rewrite H3. - intros [A B]. subst t. + intros [A B]. subst t. exists le; split. apply star_refl. split. eapply eval_Elvalue; eauto. auto. (* volatile *) intros. exists (PTree.set t0 v le); split. - simpl. eapply star_two. econstructor. eapply step_make_set; eauto. traceEq. + simpl. eapply star_two. econstructor. eapply step_make_set; eauto. traceEq. split. constructor. apply PTree.gss. split. auto. - intros. apply PTree.gso. congruence. + intros. apply PTree.gso. congruence. Qed. (** Matching between continuations *) @@ -980,7 +980,7 @@ Lemma match_cont_call: match_cont k tk -> match_cont (Csem.call_cont k) (call_cont tk). Proof. - induction 1; simpl; auto. constructor. econstructor; eauto. + induction 1; simpl; auto. constructor. econstructor; eauto. Qed. (** Matching between states *) @@ -1029,14 +1029,14 @@ Proof. | Some ls' => exists tls', select_switch_case n tls = Some tls' /\ tr_lblstmts ls' tls' end). - { induction 1; simpl; intros. + { induction 1; simpl; intros. auto. - destruct c; auto. destruct (zeq z n); auto. + destruct c; auto. destruct (zeq z n); auto. econstructor; split; eauto. constructor; auto. } intros. unfold Csem.select_switch, select_switch. - specialize (CASE n ls tls H). - destruct (Csem.select_switch_case n ls) as [ls'|]. - destruct CASE as [tls' [P Q]]. rewrite P. auto. + specialize (CASE n ls tls H). + destruct (Csem.select_switch_case n ls) as [ls'|]. + destruct CASE as [tls' [P Q]]. rewrite P. auto. rewrite CASE. apply DFL; auto. Qed. @@ -1066,22 +1066,22 @@ Fixpoint nolabel_list (sl: list statement) : Prop := Lemma nolabel_list_app: forall sl2 sl1, nolabel_list sl1 -> nolabel_list sl2 -> nolabel_list (sl1 ++ sl2). Proof. - induction sl1; simpl; intros. auto. tauto. + induction sl1; simpl; intros. auto. tauto. Qed. Lemma makeseq_nolabel: forall sl, nolabel_list sl -> nolabel (makeseq sl). Proof. assert (forall sl s, nolabel s -> nolabel_list sl -> nolabel (makeseq_rec s sl)). - induction sl; simpl; intros. auto. destruct H0. apply IHsl; auto. + induction sl; simpl; intros. auto. destruct H0. apply IHsl; auto. red. intros; simpl. rewrite H. apply H0. - intros. unfold makeseq. apply H; auto. red. auto. + intros. unfold makeseq. apply H; auto. red. auto. Qed. Lemma makeif_nolabel: forall a s1 s2, nolabel s1 -> nolabel s2 -> nolabel (makeif a s1 s2). Proof. - intros. functional induction (makeif a s1 s2); auto. + intros. functional induction (makeif a s1 s2); auto. red; simpl; intros. rewrite H; auto. red; simpl; intros. rewrite H; auto. Qed. @@ -1089,21 +1089,21 @@ Qed. Lemma make_set_nolabel: forall t a, nolabel (make_set t a). Proof. - unfold make_set; intros; red; intros. + unfold make_set; intros; red; intros. destruct (chunk_for_volatile_type (typeof a)); auto. Qed. Lemma make_assign_nolabel: forall l r, nolabel (make_assign l r). Proof. - unfold make_assign; intros; red; intros. + unfold make_assign; intros; red; intros. destruct (chunk_for_volatile_type (typeof l)); auto. Qed. Lemma tr_rvalof_nolabel: forall ty a sl a' tmp, tr_rvalof ty a sl a' tmp -> nolabel_list sl. Proof. - destruct 1; simpl; intuition. apply make_set_nolabel. + destruct 1; simpl; intuition. apply make_set_nolabel. Qed. Lemma nolabel_do_set: @@ -1115,8 +1115,8 @@ Qed. Lemma nolabel_final: forall dst a, nolabel_list (final dst a). Proof. - destruct dst; simpl; intros. auto. auto. apply nolabel_do_set. -Qed. + destruct dst; simpl; intros. auto. auto. apply nolabel_do_set. +Qed. Ltac NoLabelTac := match goal with @@ -1179,7 +1179,7 @@ Lemma tr_find_label_if: tr_if r Sskip Sbreak s -> forall k, find_label lbl s k = None. Proof. - intros. inv H. + intros. inv H. assert (nolabel (makeseq (sl ++ makeif a Sskip Sbreak :: nil))). apply makeseq_nolabel. apply nolabel_list_app. @@ -1223,28 +1223,28 @@ Proof. exploit (IHs1 (Csem.Kseq s2 k)); eauto. constructor; eauto. destruct (Csem.find_label lbl s1 (Csem.Kseq s2 k)) as [[s' k'] | ]. intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; auto. - intro EQ. rewrite EQ. eapply IHs2; eauto. + intro EQ. rewrite EQ. eapply IHs2; eauto. (* if *) - rename s' into sr. + rename s' into sr. rewrite (tr_find_label_expression _ _ _ H2). exploit (IHs1 k); eauto. destruct (Csem.find_label lbl s1 k) as [[s' k'] | ]. intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition. intro EQ. rewrite EQ. eapply IHs2; eauto. (* while *) - rename s' into sr. + rename s' into sr. rewrite (tr_find_label_if _ _ H1); auto. - exploit (IHs (Kwhile2 e s k)); eauto. econstructor; eauto. + exploit (IHs (Kwhile2 e s k)); eauto. econstructor; eauto. destruct (Csem.find_label lbl s (Kwhile2 e s k)) as [[s' k'] | ]. intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition. - intro EQ. rewrite EQ. auto. + intro EQ. rewrite EQ. auto. (* dowhile *) rename s' into sr. rewrite (tr_find_label_if _ _ H1); auto. exploit (IHs (Kdowhile1 e s k)); eauto. econstructor; eauto. destruct (Csem.find_label lbl s (Kdowhile1 e s k)) as [[s' k'] | ]. intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition. - intro EQ. rewrite EQ. auto. + intro EQ. rewrite EQ. auto. (* for skip *) rename s' into sr. rewrite (tr_find_label_if _ _ H4); auto. @@ -1256,8 +1256,8 @@ Proof. (* for not skip *) rename s' into sr. rewrite (tr_find_label_if _ _ H3); auto. - exploit (IHs1 (Csem.Kseq (Csyntax.Sfor Csyntax.Sskip e s2 s3) k)); eauto. - econstructor; eauto. econstructor; eauto. + exploit (IHs1 (Csem.Kseq (Csyntax.Sfor Csyntax.Sskip e s2 s3) k)); eauto. + econstructor; eauto. econstructor; eauto. destruct (Csem.find_label lbl s1 (Csem.Kseq (Csyntax.Sfor Csyntax.Sskip e s2 s3) k)) as [[s' k'] | ]. intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition. @@ -1265,7 +1265,7 @@ Proof. exploit (IHs3 (Csem.Kfor3 e s2 s3 k)); eauto. econstructor; eauto. destruct (Csem.find_label lbl s3 (Csem.Kfor3 e s2 s3 k)) as [[s'' k''] | ]. intros [ts' [tk' [A [B C]]]]. rewrite A. exists ts'; exists tk'; intuition. - intro EQ'. rewrite EQ'. + intro EQ'. rewrite EQ'. exploit (IHs2 (Csem.Kfor4 e s2 s3 k)); eauto. econstructor; eauto. (* break, continue, return 0 *) auto. auto. auto. @@ -1274,7 +1274,7 @@ Proof. (* switch *) rewrite (tr_find_label_expression _ _ _ H1). apply tr_find_label_ls. auto. constructor; auto. (* labeled stmt *) - destruct (ident_eq lbl l). exists ts0; exists tk; auto. apply IHs; auto. + destruct (ident_eq lbl l). exists ts0; exists tk; auto. apply IHs; auto. (* goto *) auto. @@ -1390,7 +1390,7 @@ Proof. induction 1; intros; inv MS. (* expr *) assert (tr_expr le dest r sl a tmps). - inv H9. contradiction. auto. + inv H9. contradiction. auto. exploit tr_simple_rvalue; eauto. destruct dest. (* for val *) intros [SL1 [TY1 EV1]]. subst sl. @@ -1412,15 +1412,15 @@ Proof. inv P. inv H2. inv H7; try congruence. exploit tr_simple_lvalue; eauto. intros [SL [TY EV]]. subst sl0; simpl. econstructor; split. - left. eapply plus_two. constructor. eapply step_make_set; eauto. traceEq. + left. eapply plus_two. constructor. eapply step_make_set; eauto. traceEq. econstructor; eauto. change (final dst' (Etempvar t0 (Csyntax.typeof l)) ++ sl2) with (nil ++ (final dst' (Etempvar t0 (Csyntax.typeof l)) ++ sl2)). - apply S. apply tr_val_gen. auto. + apply S. apply tr_val_gen. auto. intros. constructor. rewrite H5; auto. apply PTree.gss. - intros. apply PTree.gso. red; intros; subst; elim H5; auto. + intros. apply PTree.gso. red; intros; subst; elim H5; auto. auto. (* seqand true *) - exploit tr_top_leftcontext; eauto. clear H9. + exploit tr_top_leftcontext; eauto. clear H9. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H2. (* for val *) @@ -1432,7 +1432,7 @@ Proof. apply push_seq. reflexivity. reflexivity. rewrite <- Kseqlist_app. eapply match_exprstates; eauto. - apply S. apply tr_paren_val with (a1 := a2); auto. + apply S. apply tr_paren_val with (a1 := a2); auto. apply tr_expr_monotone with tmp2; eauto. auto. auto. (* for effects *) exploit tr_simple_rvalue; eauto. intros [SL [TY EV]]. @@ -1457,7 +1457,7 @@ Proof. apply S. apply tr_paren_set with (a1 := a2) (t := sd_temp sd); auto. apply tr_expr_monotone with tmp2; eauto. auto. auto. (* seqand false *) - exploit tr_top_leftcontext; eauto. clear H9. + exploit tr_top_leftcontext; eauto. clear H9. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H2. (* for val *) @@ -1466,19 +1466,19 @@ Proof. econstructor; split. left. eapply plus_left. constructor. eapply star_trans. apply step_makeif with (b := false) (v1 := v); auto. congruence. - apply star_one. constructor. constructor. reflexivity. reflexivity. + apply star_one. constructor. constructor. reflexivity. reflexivity. eapply match_exprstates; eauto. change sl2 with (nil ++ sl2). apply S. econstructor; eauto. - intros. constructor. rewrite H2. apply PTree.gss. auto. + intros. constructor. rewrite H2. apply PTree.gss. auto. intros. apply PTree.gso. congruence. - auto. + auto. (* for effects *) exploit tr_simple_rvalue; eauto. intros [SL [TY EV]]. subst sl0; simpl Kseqlist. econstructor; split. left. eapply plus_left. constructor. apply step_makeif with (b := false) (v1 := v); auto. congruence. - reflexivity. + reflexivity. eapply match_exprstates; eauto. change sl2 with (nil ++ sl2). apply S. econstructor; eauto. auto. auto. @@ -1493,7 +1493,7 @@ Proof. eapply match_exprstates; eauto. apply S. econstructor; eauto. intros. constructor. auto. auto. (* seqor true *) - exploit tr_top_leftcontext; eauto. clear H9. + exploit tr_top_leftcontext; eauto. clear H9. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H2. (* for val *) @@ -1502,19 +1502,19 @@ Proof. econstructor; split. left. eapply plus_left. constructor. eapply star_trans. apply step_makeif with (b := true) (v1 := v); auto. congruence. - apply star_one. constructor. constructor. reflexivity. reflexivity. + apply star_one. constructor. constructor. reflexivity. reflexivity. eapply match_exprstates; eauto. change sl2 with (nil ++ sl2). apply S. econstructor; eauto. - intros. constructor. rewrite H2. apply PTree.gss. auto. + intros. constructor. rewrite H2. apply PTree.gss. auto. intros. apply PTree.gso. congruence. - auto. + auto. (* for effects *) exploit tr_simple_rvalue; eauto. intros [SL [TY EV]]. subst sl0; simpl Kseqlist. econstructor; split. left. eapply plus_left. constructor. apply step_makeif with (b := true) (v1 := v); auto. congruence. - reflexivity. + reflexivity. eapply match_exprstates; eauto. change sl2 with (nil ++ sl2). apply S. econstructor; eauto. auto. auto. @@ -1529,7 +1529,7 @@ Proof. eapply match_exprstates; eauto. apply S. econstructor; eauto. intros. constructor. auto. auto. (* seqand false *) - exploit tr_top_leftcontext; eauto. clear H9. + exploit tr_top_leftcontext; eauto. clear H9. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H2. (* for val *) @@ -1541,7 +1541,7 @@ Proof. apply push_seq. reflexivity. reflexivity. rewrite <- Kseqlist_app. eapply match_exprstates; eauto. - apply S. apply tr_paren_val with (a1 := a2); auto. + apply S. apply tr_paren_val with (a1 := a2); auto. apply tr_expr_monotone with tmp2; eauto. auto. auto. (* for effects *) exploit tr_simple_rvalue; eauto. intros [SL [TY EV]]. @@ -1566,9 +1566,9 @@ Proof. apply S. apply tr_paren_set with (a1 := a2) (t := sd_temp sd); auto. apply tr_expr_monotone with tmp2; eauto. auto. auto. (* condition *) - exploit tr_top_leftcontext; eauto. clear H9. + exploit tr_top_leftcontext; eauto. clear H9. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. - inv P. inv H2. + inv P. inv H2. (* for value *) exploit tr_simple_rvalue; eauto. intros [SL [TY EV]]. subst sl0; simpl Kseqlist. destruct b. @@ -1592,22 +1592,22 @@ Proof. econstructor; split. left. eapply plus_left. constructor. eapply star_trans. apply step_makeif with (b := true) (v1 := v); auto. congruence. - apply push_seq. + apply push_seq. reflexivity. traceEq. rewrite <- Kseqlist_app. econstructor. eauto. apply S. - econstructor; eauto. apply tr_expr_monotone with tmp2; eauto. - econstructor; eauto. + econstructor; eauto. apply tr_expr_monotone with tmp2; eauto. + econstructor; eauto. auto. auto. econstructor; split. left. eapply plus_left. constructor. eapply star_trans. apply step_makeif with (b := false) (v1 := v); auto. congruence. - apply push_seq. + apply push_seq. reflexivity. traceEq. rewrite <- Kseqlist_app. econstructor. eauto. apply S. - econstructor; eauto. apply tr_expr_monotone with tmp3; eauto. - econstructor; eauto. + econstructor; eauto. apply tr_expr_monotone with tmp3; eauto. + econstructor; eauto. auto. auto. (* for set *) exploit tr_simple_rvalue; eauto. intros [SL [TY EV]]. @@ -1615,25 +1615,25 @@ Proof. econstructor; split. left. eapply plus_left. constructor. eapply star_trans. apply step_makeif with (b := true) (v1 := v); auto. congruence. - apply push_seq. + apply push_seq. reflexivity. traceEq. rewrite <- Kseqlist_app. econstructor. eauto. apply S. - econstructor; eauto. apply tr_expr_monotone with tmp2; eauto. - econstructor; eauto. + econstructor; eauto. apply tr_expr_monotone with tmp2; eauto. + econstructor; eauto. auto. auto. econstructor; split. left. eapply plus_left. constructor. eapply star_trans. apply step_makeif with (b := false) (v1 := v); auto. congruence. - apply push_seq. + apply push_seq. reflexivity. traceEq. rewrite <- Kseqlist_app. econstructor. eauto. apply S. - econstructor; eauto. apply tr_expr_monotone with tmp3; eauto. - econstructor; eauto. + econstructor; eauto. apply tr_expr_monotone with tmp3; eauto. + econstructor; eauto. auto. auto. (* assign *) - exploit tr_top_leftcontext; eauto. clear H12. + exploit tr_top_leftcontext; eauto. clear H12. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H4. (* for effects *) @@ -1642,44 +1642,44 @@ Proof. subst; simpl Kseqlist. econstructor; split. left. eapply plus_left. constructor. - apply star_one. eapply step_make_assign; eauto. + apply star_one. eapply step_make_assign; eauto. rewrite <- TY2; eauto. traceEq. econstructor. auto. change sl2 with (nil ++ sl2). apply S. constructor. auto. auto. auto. (* for value *) exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]]. exploit tr_simple_lvalue. eauto. - eapply tr_expr_invariant with (le' := PTree.set t0 v le). eauto. + eapply tr_expr_invariant with (le' := PTree.set t0 v le). eauto. intros. apply PTree.gso. intuition congruence. intros [SL1 [TY1 EV1]]. subst; simpl Kseqlist. econstructor; split. - left. eapply plus_left. constructor. - eapply star_left. constructor. eauto. + left. eapply plus_left. constructor. + eapply star_left. constructor. eauto. eapply star_left. constructor. - apply star_one. eapply step_make_assign; eauto. - constructor. apply PTree.gss. reflexivity. reflexivity. traceEq. + apply star_one. eapply step_make_assign; eauto. + constructor. apply PTree.gss. reflexivity. reflexivity. traceEq. econstructor. auto. apply S. - apply tr_val_gen. auto. intros. econstructor; eauto. constructor. - rewrite H4; auto. apply PTree.gss. + apply tr_val_gen. auto. intros. econstructor; eauto. constructor. + rewrite H4; auto. apply PTree.gss. intros. apply PTree.gso. intuition congruence. auto. auto. (* assignop *) - exploit tr_top_leftcontext; eauto. clear H15. + exploit tr_top_leftcontext; eauto. clear H15. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H6. (* for effects *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]]. - exploit tr_simple_lvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. + exploit tr_simple_lvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. intros. apply INV. NOTIN. intros [? [? EV1']]. - exploit tr_simple_rvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. + exploit tr_simple_rvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. intros. apply INV. NOTIN. simpl. intros [SL2 [TY2 EV2]]. - subst; simpl Kseqlist. + subst; simpl Kseqlist. econstructor; split. left. eapply star_plus_trans. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC. - eapply plus_two. simpl. econstructor. eapply step_make_assign; eauto. - econstructor. eexact EV3. eexact EV2. + eapply plus_two. simpl. econstructor. eapply step_make_assign; eauto. + econstructor. eexact EV3. eexact EV2. rewrite TY3; rewrite <- TY1; rewrite <- TY2; rewrite comp_env_preserved; auto. reflexivity. traceEq. econstructor. auto. change sl2 with (nil ++ sl2). apply S. @@ -1687,132 +1687,132 @@ Proof. (* for value *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]]. - exploit tr_simple_lvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. + exploit tr_simple_lvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. intros. apply INV. NOTIN. intros [? [? EV1']]. - exploit tr_simple_rvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. + exploit tr_simple_rvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. intros. apply INV. NOTIN. simpl. intros [SL2 [TY2 EV2]]. - exploit tr_simple_lvalue. eauto. - eapply tr_expr_invariant with (le := le) (le' := PTree.set t v3 le'). eauto. + exploit tr_simple_lvalue. eauto. + eapply tr_expr_invariant with (le := le) (le' := PTree.set t v3 le'). eauto. intros. rewrite PTree.gso. apply INV. NOTIN. intuition congruence. intros [? [? EV1'']]. subst; simpl Kseqlist. econstructor; split. - left. rewrite app_ass. rewrite Kseqlist_app. + left. rewrite app_ass. rewrite Kseqlist_app. eapply star_plus_trans. eexact EXEC. simpl. eapply plus_four. econstructor. econstructor. - econstructor. eexact EV3. eexact EV2. + econstructor. eexact EV3. eexact EV2. rewrite TY3; rewrite <- TY1; rewrite <- TY2; rewrite comp_env_preserved; eauto. - econstructor. eapply step_make_assign; eauto. - constructor. apply PTree.gss. + econstructor. eapply step_make_assign; eauto. + constructor. apply PTree.gss. reflexivity. traceEq. econstructor. auto. apply S. - apply tr_val_gen. auto. intros. econstructor; eauto. constructor. - rewrite H10; auto. apply PTree.gss. - intros. rewrite PTree.gso. apply INV. - red; intros; elim H10; auto. + apply tr_val_gen. auto. intros. econstructor; eauto. constructor. + rewrite H10; auto. apply PTree.gss. + intros. rewrite PTree.gso. apply INV. + red; intros; elim H10; auto. intuition congruence. auto. auto. (* assignop stuck *) - exploit tr_top_leftcontext; eauto. clear H12. + exploit tr_top_leftcontext; eauto. clear H12. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H4. (* for effects *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]]. exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]]. - subst; simpl Kseqlist. + subst; simpl Kseqlist. econstructor; split. - right; split. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC. + right; split. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC. simpl. omega. constructor. (* for value *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]]. exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]]. - subst; simpl Kseqlist. + subst; simpl Kseqlist. econstructor; split. - right; split. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC. + right; split. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC. simpl. omega. constructor. (* postincr *) - exploit tr_top_leftcontext; eauto. clear H14. + exploit tr_top_leftcontext; eauto. clear H14. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H5. (* for effects *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]]. - exploit tr_simple_lvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. + exploit tr_simple_lvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto. intros. apply INV. NOTIN. intros [? [? EV1']]. subst; simpl Kseqlist. econstructor; split. - left. rewrite app_ass; rewrite Kseqlist_app. - eapply star_plus_trans. eexact EXEC. + left. rewrite app_ass; rewrite Kseqlist_app. + eapply star_plus_trans. eexact EXEC. eapply plus_two. simpl. constructor. - eapply step_make_assign; eauto. - unfold transl_incrdecr. destruct id; simpl in H2. + eapply step_make_assign; eauto. + unfold transl_incrdecr. destruct id; simpl in H2. econstructor. eauto. constructor. rewrite TY3; rewrite <- TY1; rewrite comp_env_preserved. simpl; eauto. econstructor. eauto. constructor. rewrite TY3; rewrite <- TY1; rewrite comp_env_preserved. simpl; eauto. - destruct id; auto. + destruct id; auto. reflexivity. traceEq. econstructor. auto. change sl2 with (nil ++ sl2). apply S. constructor. auto. auto. auto. (* for value *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. exploit tr_simple_lvalue. eauto. - eapply tr_expr_invariant with (le' := PTree.set t v1 le). eauto. + eapply tr_expr_invariant with (le' := PTree.set t v1 le). eauto. intros. apply PTree.gso. intuition congruence. intros [SL2 [TY2 EV2]]. subst; simpl Kseqlist. econstructor; split. left. eapply plus_four. constructor. - eapply step_make_set; eauto. + eapply step_make_set; eauto. constructor. - eapply step_make_assign; eauto. - unfold transl_incrdecr. destruct id; simpl in H2. + eapply step_make_assign; eauto. + unfold transl_incrdecr. destruct id; simpl in H2. econstructor. constructor. apply PTree.gss. constructor. rewrite comp_env_preserved; simpl; eauto. econstructor. constructor. apply PTree.gss. constructor. rewrite comp_env_preserved; simpl; eauto. - destruct id; auto. + destruct id; auto. traceEq. econstructor. auto. apply S. apply tr_val_gen. auto. intros. econstructor; eauto. - rewrite H5; auto. apply PTree.gss. + rewrite H5; auto. apply PTree.gss. intros. apply PTree.gso. intuition congruence. auto. auto. (* postincr stuck *) - exploit tr_top_leftcontext; eauto. clear H11. + exploit tr_top_leftcontext; eauto. clear H11. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H3. (* for effects *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]]. - subst. simpl Kseqlist. + subst. simpl Kseqlist. econstructor; split. right; split. rewrite app_ass; rewrite Kseqlist_app. eexact EXEC. simpl; omega. constructor. (* for value *) exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]]. - subst. simpl Kseqlist. + subst. simpl Kseqlist. econstructor; split. - left. eapply plus_two. constructor. eapply step_make_set; eauto. + left. eapply plus_two. constructor. eapply step_make_set; eauto. traceEq. constructor. (* comma *) - exploit tr_top_leftcontext; eauto. clear H9. + exploit tr_top_leftcontext; eauto. clear H9. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H1. exploit tr_simple_rvalue; eauto. simpl; intro SL1. subst sl0; simpl Kseqlist. econstructor; split. - right; split. apply star_refl. simpl. apply plus_lt_compat_r. - apply (leftcontext_size _ _ _ H). simpl. omega. - econstructor; eauto. apply S. - eapply tr_expr_monotone; eauto. - auto. auto. + right; split. apply star_refl. simpl. apply plus_lt_compat_r. + apply (leftcontext_size _ _ _ H). simpl. omega. + econstructor; eauto. apply S. + eapply tr_expr_monotone; eauto. + auto. auto. (* paren *) - exploit tr_top_leftcontext; eauto. clear H9. + exploit tr_top_leftcontext; eauto. clear H9. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H2. (* for value *) @@ -1821,11 +1821,11 @@ Proof. econstructor; split. left. eapply plus_left. constructor. apply star_one. econstructor. econstructor; eauto. rewrite <- TY1; eauto. traceEq. - econstructor; eauto. + econstructor; eauto. change sl2 with (final For_val (Etempvar t (Csyntax.typeof r)) ++ sl2). apply S. constructor. auto. intros. constructor. rewrite H2; auto. apply PTree.gss. intros. apply PTree.gso. intuition congruence. - auto. + auto. (* for effects *) econstructor; split. right; split. apply star_refl. simpl. apply plus_lt_compat_r. @@ -1835,18 +1835,18 @@ Proof. apply S. constructor; auto. auto. auto. (* for set *) exploit tr_simple_rvalue; eauto. simpl. intros [b [SL1 [TY1 EV1]]]. subst sl1. - simpl Kseqlist. + simpl Kseqlist. econstructor; split. - left. eapply plus_left. constructor. apply star_one. econstructor. econstructor; eauto. + left. eapply plus_left. constructor. apply star_one. econstructor. econstructor; eauto. rewrite <- TY1; eauto. traceEq. econstructor; eauto. - apply S. constructor; auto. - intros. constructor. rewrite H2. apply PTree.gss. auto. + apply S. constructor; auto. + intros. constructor. rewrite H2. apply PTree.gss. auto. intros. apply PTree.gso. congruence. - auto. + auto. (* call *) - exploit tr_top_leftcontext; eauto. clear H12. + exploit tr_top_leftcontext; eauto. clear H12. intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]]. inv P. inv H5. (* for effects *) @@ -1854,20 +1854,20 @@ Proof. exploit tr_simple_exprlist; eauto. intros [SL2 EV2]. subst. simpl Kseqlist. exploit functions_translated; eauto. intros [tfd [J K]]. - econstructor; split. + econstructor; split. left. eapply plus_left. constructor. apply star_one. econstructor; eauto. rewrite <- TY1; eauto. exploit type_of_fundef_preserved; eauto. congruence. traceEq. constructor; auto. econstructor; eauto. intros. change sl2 with (nil ++ sl2). apply S. - constructor. auto. auto. + constructor. auto. auto. (* for value *) exploit tr_simple_rvalue; eauto. intros [SL1 [TY1 EV1]]. exploit tr_simple_exprlist; eauto. intros [SL2 EV2]. subst. simpl Kseqlist. exploit functions_translated; eauto. intros [tfd [J K]]. - econstructor; split. + econstructor; split. left. eapply plus_left. constructor. apply star_one. econstructor; eauto. rewrite <- TY1; eauto. exploit type_of_fundef_preserved; eauto. congruence. @@ -1875,10 +1875,10 @@ Proof. constructor; auto. econstructor; eauto. intros. apply S. destruct dst'; constructor. - auto. intros. constructor. rewrite H5; auto. apply PTree.gss. - auto. intros. constructor. rewrite H5; auto. apply PTree.gss. + auto. intros. constructor. rewrite H5; auto. apply PTree.gss. + auto. intros. constructor. rewrite H5; auto. apply PTree.gss. intros. apply PTree.gso. intuition congruence. - auto. + auto. (* builtin *) exploit tr_top_leftcontext; eauto. clear H9. @@ -1887,22 +1887,22 @@ Proof. (* for effects *) exploit tr_simple_exprlist; eauto. intros [SL EV]. subst. simpl Kseqlist. - econstructor; split. + econstructor; split. left. eapply plus_left. constructor. apply star_one. econstructor; eauto. - eapply external_call_symbols_preserved; eauto. - exact symbols_preserved. exact public_preserved. exact varinfo_preserved. + eapply external_call_symbols_preserved; eauto. + exact symbols_preserved. exact public_preserved. exact varinfo_preserved. traceEq. econstructor; eauto. - change sl2 with (nil ++ sl2). apply S. constructor. simpl; auto. auto. + change sl2 with (nil ++ sl2). apply S. constructor. simpl; auto. auto. (* for value *) exploit tr_simple_exprlist; eauto. intros [SL EV]. subst. simpl Kseqlist. - econstructor; split. + econstructor; split. left. eapply plus_left. constructor. apply star_one. econstructor; eauto. - eapply external_call_symbols_preserved; eauto. - exact symbols_preserved. exact public_preserved. exact varinfo_preserved. + eapply external_call_symbols_preserved; eauto. + exact symbols_preserved. exact public_preserved. exact varinfo_preserved. traceEq. econstructor; eauto. change sl2 with (nil ++ sl2). apply S. @@ -1918,7 +1918,7 @@ Lemma tr_top_val_for_val_inv: tr_top tge e le m For_val (Csyntax.Eval v ty) sl a tmps -> sl = nil /\ typeof a = ty /\ eval_expr tge e le m a v. Proof. - intros. inv H. auto. inv H0. auto. + intros. inv H. auto. inv H0. auto. Qed. Lemma alloc_variables_preserved: @@ -1934,7 +1934,7 @@ Lemma bind_parameters_preserved: Csem.bind_parameters ge e m params args m' -> bind_parameters tge e m params args m'. Proof. - induction 1; econstructor; eauto. inv H0. + induction 1; econstructor; eauto. inv H0. - eapply assign_loc_value; eauto. - inv H4. eapply assign_loc_value; eauto. - rewrite <- comp_env_preserved in *. eapply assign_loc_copy; eauto. @@ -1943,10 +1943,10 @@ Qed. Lemma blocks_of_env_preserved: forall e, blocks_of_env tge e = Csem.blocks_of_env ge e. Proof. - intros; unfold blocks_of_env, Csem.blocks_of_env. - unfold block_of_binding, Csem.block_of_binding. + intros; unfold blocks_of_env, Csem.blocks_of_env. + unfold block_of_binding, Csem.block_of_binding. rewrite comp_env_preserved. auto. -Qed. +Qed. Lemma sstep_simulation: forall S1 t S2, Csem.sstep ge S1 t S2 -> @@ -1958,14 +1958,14 @@ Lemma sstep_simulation: Proof. induction 1; intros; inv MS. (* do 1 *) - inv H6. inv H0. + inv H6. inv H0. econstructor; split. - right; split. apply push_seq. + right; split. apply push_seq. simpl. omega. econstructor; eauto. constructor. auto. (* do 2 *) - inv H7. inv H6. inv H. - econstructor; split. + inv H7. inv H6. inv H. + econstructor; split. right; split. apply star_refl. simpl. omega. econstructor; eauto. constructor. @@ -1992,8 +1992,8 @@ Proof. econstructor; eauto. econstructor; eauto. (* ifthenelse *) - inv H8. - exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. + inv H8. + exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. econstructor; split. left. eapply plus_two. constructor. apply step_ifthenelse with (v1 := v) (b := b); auto. traceEq. @@ -2007,68 +2007,68 @@ Proof. reflexivity. traceEq. rewrite Kseqlist_app. econstructor; eauto. simpl. econstructor; eauto. econstructor; eauto. (* while false *) - inv H8. - exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. + inv H8. + exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. econstructor; split. left. simpl. eapply plus_left. constructor. eapply star_trans. apply step_makeif with (v1 := v) (b := false); auto. - eapply star_two. constructor. apply step_break_loop1. + eapply star_two. constructor. apply step_break_loop1. reflexivity. reflexivity. traceEq. constructor; auto. constructor. (* while true *) - inv H8. - exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. + inv H8. + exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. econstructor; split. left. simpl. eapply plus_left. constructor. eapply star_right. apply step_makeif with (v1 := v) (b := true); auto. constructor. reflexivity. traceEq. - constructor; auto. constructor; auto. + constructor; auto. constructor; auto. (* skip-or-continue while *) assert (ts = Sskip \/ ts = Scontinue). destruct H; subst s0; inv H7; auto. inv H8. econstructor; split. left. eapply plus_two. apply step_skip_or_continue_loop1; auto. apply step_skip_loop2. traceEq. - constructor; auto. constructor; auto. + constructor; auto. constructor; auto. (* break while *) - inv H6. inv H7. + inv H6. inv H7. econstructor; split. left. apply plus_one. apply step_break_loop1. constructor; auto. constructor. (* dowhile *) - inv H6. + inv H6. econstructor; split. - left. apply plus_one. apply step_loop. + left. apply plus_one. apply step_loop. constructor; auto. constructor; auto. (* skip_or_continue dowhile *) assert (ts = Sskip \/ ts = Scontinue). destruct H; subst s0; inv H7; auto. inv H8. inv H4. econstructor; split. left. eapply plus_left. apply step_skip_or_continue_loop1. auto. - apply push_seq. + apply push_seq. traceEq. rewrite Kseqlist_app. - econstructor; eauto. simpl. econstructor; auto. econstructor; eauto. + econstructor; eauto. simpl. econstructor; auto. econstructor; eauto. (* dowhile false *) - inv H8. - exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. + inv H8. + exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. econstructor; split. - left. simpl. eapply plus_left. constructor. - eapply star_right. apply step_makeif with (v1 := v) (b := false); auto. - constructor. + left. simpl. eapply plus_left. constructor. + eapply star_right. apply step_makeif with (v1 := v) (b := false); auto. + constructor. reflexivity. traceEq. constructor; auto. constructor. (* dowhile true *) - inv H8. - exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. + inv H8. + exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. econstructor; split. - left. simpl. eapply plus_left. constructor. - eapply star_right. apply step_makeif with (v1 := v) (b := true); auto. - constructor. + left. simpl. eapply plus_left. constructor. + eapply star_right. apply step_makeif with (v1 := v) (b := true); auto. + constructor. reflexivity. traceEq. - constructor; auto. constructor; auto. + constructor; auto. constructor; auto. (* break dowhile *) inv H6. inv H7. econstructor; split. @@ -2076,14 +2076,14 @@ Proof. constructor; auto. constructor. (* for start *) - inv H7. congruence. - econstructor; split. + inv H7. congruence. + econstructor; split. left; apply plus_one. constructor. - econstructor; eauto. constructor; auto. econstructor; eauto. + econstructor; eauto. constructor; auto. econstructor; eauto. (* for *) - inv H6; try congruence. inv H2. + inv H6; try congruence. inv H2. econstructor; split. - left. eapply plus_left. apply step_loop. + left. eapply plus_left. apply step_loop. eapply star_left. constructor. apply push_seq. reflexivity. traceEq. rewrite Kseqlist_app. econstructor; eauto. simpl. constructor; auto. econstructor; eauto. @@ -2098,11 +2098,11 @@ Proof. (* for true *) inv H8. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. econstructor; split. - left. simpl. eapply plus_left. constructor. + left. simpl. eapply plus_left. constructor. eapply star_right. apply step_makeif with (v1 := v) (b := true); auto. constructor. reflexivity. traceEq. - constructor; auto. constructor; auto. + constructor; auto. constructor; auto. (* skip_or_continue for3 *) assert (ts = Sskip \/ ts = Scontinue). destruct H; subst x; inv H7; auto. inv H8. @@ -2110,21 +2110,21 @@ Proof. left. apply plus_one. apply step_skip_or_continue_loop1. auto. econstructor; eauto. econstructor; auto. (* break for3 *) - inv H6. inv H7. + inv H6. inv H7. econstructor; split. left. apply plus_one. apply step_break_loop1. econstructor; eauto. constructor. (* skip for4 *) - inv H6. inv H7. + inv H6. inv H7. econstructor; split. left. apply plus_one. constructor. - econstructor; eauto. constructor; auto. + econstructor; eauto. constructor; auto. (* return none *) inv H7. econstructor; split. - left. apply plus_one. econstructor; eauto. rewrite blocks_of_env_preserved; eauto. - constructor. apply match_cont_call; auto. + left. apply plus_one. econstructor; eauto. rewrite blocks_of_env_preserved; eauto. + constructor. apply match_cont_call; auto. (* return some 1 *) inv H6. inv H0. econstructor; split. left; eapply plus_left. constructor. apply push_seq. traceEq. @@ -2133,34 +2133,34 @@ Proof. inv H9. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. econstructor; split. left. eapply plus_two. constructor. econstructor. eauto. - erewrite function_return_preserved; eauto. rewrite blocks_of_env_preserved; eauto. + erewrite function_return_preserved; eauto. rewrite blocks_of_env_preserved; eauto. eauto. traceEq. constructor. apply match_cont_call; auto. (* skip return *) - inv H8. + inv H8. assert (is_call_cont tk). inv H9; simpl in *; auto. econstructor; split. - left. apply plus_one. apply step_skip_call; eauto. rewrite blocks_of_env_preserved; eauto. + left. apply plus_one. apply step_skip_call; eauto. rewrite blocks_of_env_preserved; eauto. constructor. auto. (* switch *) - inv H6. inv H1. - econstructor; split. + inv H6. inv H1. + econstructor; split. left; eapply plus_left. constructor. apply push_seq. traceEq. - econstructor; eauto. constructor; auto. + econstructor; eauto. constructor; auto. (* expr switch *) inv H8. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst. econstructor; split. left; eapply plus_two. constructor. econstructor; eauto. traceEq. econstructor; eauto. - apply tr_seq_of_labeled_statement. apply tr_select_switch. auto. + apply tr_seq_of_labeled_statement. apply tr_select_switch. auto. constructor; auto. (* skip-or-break switch *) assert (ts = Sskip \/ ts = Sbreak). destruct H; subst x; inv H7; auto. inv H8. econstructor; split. - left; apply plus_one. apply step_skip_break_switch. auto. + left; apply plus_one. apply step_skip_break_switch. auto. constructor; auto. constructor. (* continue switch *) @@ -2176,13 +2176,13 @@ Proof. (* goto *) inv H7. - inversion H6; subst. - exploit tr_find_label. eauto. apply match_cont_call. eauto. - instantiate (1 := lbl). rewrite H. - intros [ts' [tk' [P [Q R]]]]. - econstructor; split. + inversion H6; subst. + exploit tr_find_label. eauto. apply match_cont_call. eauto. + instantiate (1 := lbl). rewrite H. + intros [ts' [tk' [P [Q R]]]]. + econstructor; split. left. apply plus_one. econstructor; eauto. - econstructor; eauto. + econstructor; eauto. (* internal function *) inv H7. inversion H3; subst. @@ -2191,15 +2191,15 @@ Proof. rewrite H6; rewrite H7; auto. rewrite H6; rewrite H7. eapply alloc_variables_preserved; eauto. rewrite H6. eapply bind_parameters_preserved; eauto. - eauto. - constructor; auto. + eauto. + constructor; auto. (* external function *) inv H5. econstructor; split. left; apply plus_one. econstructor; eauto. - eapply external_call_symbols_preserved; eauto. - exact symbols_preserved. exact public_preserved. exact varinfo_preserved. + eapply external_call_symbols_preserved; eauto. + exact symbols_preserved. exact public_preserved. exact varinfo_preserved. constructor; auto. (* return *) @@ -2219,7 +2219,7 @@ Theorem simulation: (star step1 tge S1' t S2' /\ measure S2 < measure S1)%nat) /\ match_states S2 S2'. Proof. - intros S1 t S2 STEP. destruct STEP. + intros S1 t S2 STEP. destruct STEP. apply estep_simulation; auto. apply sstep_simulation; auto. Qed. @@ -2229,14 +2229,14 @@ Lemma transl_initial_states: Csem.initial_state prog S -> exists S', Clight.initial_state tprog S' /\ match_states S S'. Proof. - intros. inv H. generalize TRANSL; intros TR; monadInv TR. rewrite H4. + intros. inv H. generalize TRANSL; intros TR; monadInv TR. rewrite H4. exploit transl_program_spec; eauto. intros MP. exploit function_ptr_translated; eauto. intros [tf [FIND TR]]. econstructor; split. econstructor. exploit Genv.init_mem_match; eauto. change (Genv.globalenv tprog) with (genv_genv tge). rewrite symbols_preserved. - rewrite <- H4; simpl; eauto. + rewrite <- H4; simpl; eauto. eexact FIND. rewrite <- H3. apply type_of_fundef_preserved. auto. constructor. auto. constructor. diff --git a/cfrontend/SimplExprspec.v b/cfrontend/SimplExprspec.v index 9f9fb450..7003c78a 100644 --- a/cfrontend/SimplExprspec.v +++ b/cfrontend/SimplExprspec.v @@ -76,14 +76,14 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> (forall tge e le' m, (forall id, In id tmp -> le'!id = le!id) -> eval_expr tge e le' m a v) -> - tr_expr le For_val (Csyntax.Eval v ty) + tr_expr le For_val (Csyntax.Eval v ty) nil a tmp | tr_val_set: forall le sd v ty a any tmp, typeof a = ty -> (forall tge e le' m, (forall id, In id tmp -> le'!id = le!id) -> eval_expr tge e le' m a v) -> - tr_expr le (For_set sd) (Csyntax.Eval v ty) + tr_expr le (For_set sd) (Csyntax.Eval v ty) (do_set sd a) any tmp | tr_sizeof: forall le dst ty' ty tmp, tr_expr le dst (Csyntax.Esizeof ty' ty) @@ -102,7 +102,7 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> a2 tmp | tr_addrof: forall le dst e1 ty tmp sl1 a1, tr_expr le For_val e1 sl1 a1 tmp -> - tr_expr le dst (Csyntax.Eaddrof e1 ty) + tr_expr le dst (Csyntax.Eaddrof e1 ty) (sl1 ++ final dst (Eaddrof a1 ty)) (Eaddrof a1 ty) tmp | tr_unop: forall le dst op e1 ty tmp sl1 a1, @@ -207,7 +207,7 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> | tr_assign_effects: forall le e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 any tmp, tr_expr le For_val e1 sl1 a1 tmp1 -> tr_expr le For_val e2 sl2 a2 tmp2 -> - list_disjoint tmp1 tmp2 -> + list_disjoint tmp1 tmp2 -> incl tmp1 tmp -> incl tmp2 tmp -> tr_expr le For_effects (Csyntax.Eassign e1 e2 ty) (sl1 ++ sl2 ++ make_assign a1 a2 :: nil) @@ -216,12 +216,12 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> tr_expr le For_val e1 sl1 a1 tmp1 -> tr_expr le For_val e2 sl2 a2 tmp2 -> incl tmp1 tmp -> incl tmp2 tmp -> - list_disjoint tmp1 tmp2 -> + list_disjoint tmp1 tmp2 -> In t tmp -> ~In t tmp1 -> ~In t tmp2 -> ty1 = Csyntax.typeof e1 -> ty2 = Csyntax.typeof e2 -> tr_expr le dst (Csyntax.Eassign e1 e2 ty) - (sl1 ++ sl2 ++ + (sl1 ++ sl2 ++ Sset t a2 :: make_assign a1 (Etempvar t ty2) :: final dst (Ecast (Etempvar t ty2) ty1)) @@ -255,7 +255,7 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> tr_rvalof ty1 a1 sl2 a2 tmp2 -> ty1 = Csyntax.typeof e1 -> incl tmp1 tmp -> incl tmp2 tmp -> - list_disjoint tmp1 tmp2 -> + list_disjoint tmp1 tmp2 -> tr_expr le For_effects (Csyntax.Epostincr id e1 ty) (sl1 ++ sl2 ++ make_assign a1 (transl_incrdecr id a2 ty1) :: nil) any tmp @@ -271,7 +271,7 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> | tr_comma: forall le dst e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 tmp, tr_expr le For_effects e1 sl1 a1 tmp1 -> tr_expr le dst e2 sl2 a2 tmp2 -> - list_disjoint tmp1 tmp2 -> + list_disjoint tmp1 tmp2 -> incl tmp1 tmp -> incl tmp2 tmp -> tr_expr le dst (Csyntax.Ecomma e1 e2 ty) (sl1 ++ sl2) a2 tmp | tr_call_effects: forall le e1 el2 ty sl1 a1 tmp1 sl2 al2 tmp2 any tmp, @@ -306,7 +306,7 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> (Etempvar t ty) tmp | tr_paren_val: forall le e1 tycast ty sl1 a1 t tmp, tr_expr le (For_set (SDbase tycast ty t)) e1 sl1 a1 tmp -> - In t tmp -> + In t tmp -> tr_expr le For_val (Csyntax.Eparen e1 tycast ty) sl1 (Etempvar t ty) tmp @@ -499,7 +499,7 @@ Proof. intros until I. unfold bind. destruct (f z1). congruence. caseEq (g a g'); intros; inv H0. - econstructor; econstructor; econstructor; econstructor; eauto. + econstructor; econstructor; econstructor; econstructor; eauto. Qed. Remark bind2_inversion: @@ -508,9 +508,9 @@ Remark bind2_inversion: exists x1, exists x2, exists z2, exists I1, exists I2, f z1 = Res (x1,x2) z2 I1 /\ g x1 x2 z2 = Res y z3 I2. Proof. - unfold bind2. intros. - exploit bind_inversion; eauto. - intros [[x1 x2] [z2 [I1 [I2 [P Q]]]]]. simpl in Q. + unfold bind2. intros. + exploit bind_inversion; eauto. + intros [[x1 x2] [z2 [I1 [I2 [P Q]]]]]. simpl in Q. exists x1; exists x2; exists z2; exists I1; exists I2; auto. Qed. @@ -551,7 +551,7 @@ Ltac monadInv H := | (@error _ _ _ = Res _ _ _) => monadInv1 H | (bind ?F ?G ?Z = Res ?X ?Z' ?I) => monadInv1 H | (bind2 ?F ?G ?Z = Res ?X ?Z' ?I) => monadInv1 H - | (?F _ _ _ _ _ _ _ _ = Res _ _ _) => + | (?F _ _ _ _ _ _ _ _ = Res _ _ _) => ((progress simpl in H) || unfold F in H); monadInv1 H | (?F _ _ _ _ _ _ _ = Res _ _ _) => ((progress simpl in H) || unfold F in H); monadInv1 H @@ -588,7 +588,7 @@ Lemma within_widen: Ple (gen_next g2) (gen_next g2') -> within id g1' g2'. Proof. - intros. destruct H. split. + intros. destruct H. split. eapply Ple_trans; eauto. eapply Plt_Ple_trans; eauto. Qed. @@ -609,14 +609,14 @@ Lemma contained_widen: Ple (gen_next g2) (gen_next g2') -> contained l g1' g2'. Proof. - intros; red; intros. eapply within_widen; eauto. + intros; red; intros. eapply within_widen; eauto. Qed. Lemma contained_cons: forall id l g1 g2, within id g1 g2 -> contained l g1 g2 -> contained (id :: l) g1 g2. Proof. - intros; red; intros. simpl in H1; destruct H1. subst id0. auto. auto. + intros; red; intros. simpl in H1; destruct H1. subst id0. auto. auto. Qed. Lemma contained_app: @@ -630,7 +630,7 @@ Lemma contained_disjoint: forall g1 l1 g2 l2 g3, contained l1 g1 g2 -> contained l2 g2 g3 -> list_disjoint l1 l2. Proof. - intros; red; intros. red; intro; subst y. + intros; red; intros. red; intro; subst y. exploit H; eauto. intros [A B]. exploit H0; eauto. intros [Csyntax D]. elim (Plt_strict x). apply Plt_Ple_trans with (gen_next g2); auto. Qed. @@ -665,7 +665,7 @@ Qed. Lemma dest_for_set_seqbool_set: forall sd ty g, dest_below (For_set sd) g -> dest_below (For_set (sd_seqbool_set ty sd)) g. Proof. - intros. assumption. + intros. assumption. Qed. Lemma dest_for_set_condition_val: @@ -683,7 +683,7 @@ Qed. Lemma sd_temp_notin: forall sd g1 g2 l, dest_below (For_set sd) g1 -> contained l g1 g2 -> ~In (sd_temp sd) l. Proof. - intros. simpl in H. red; intros. exploit H0; eauto. intros [A B]. + intros. simpl in H. red; intros. exploit H0; eauto. intros [A B]. elim (Plt_strict (sd_temp sd)). apply Plt_Ple_trans with (gen_next g1); auto. Qed. @@ -701,7 +701,7 @@ Hint Resolve gensym_within within_widen contained_widen dest_for_set_condition_val dest_for_set_condition_set sd_temp_notin dest_below_le incl_refl incl_tl incl_app incl_appl incl_appr incl_same_head - in_eq in_cons + in_eq in_cons Ple_trans Ple_refl: gensym. Hint Resolve dest_for_val_below dest_for_effect_below. @@ -787,27 +787,27 @@ Proof. (* val *) simpl in H. destruct v; monadInv H; exists (@nil ident); split; auto with gensym. Opaque makeif. - intros. destruct dst; simpl in *; inv H2. + intros. destruct dst; simpl in *; inv H2. constructor. auto. intros; constructor. constructor. constructor. auto. intros; constructor. - intros. destruct dst; simpl in *; inv H2. + intros. destruct dst; simpl in *; inv H2. constructor. auto. intros; constructor. constructor. constructor. auto. intros; constructor. - intros. destruct dst; simpl in *; inv H2. + intros. destruct dst; simpl in *; inv H2. constructor. auto. intros; constructor. constructor. constructor. auto. intros; constructor. - intros. destruct dst; simpl in *; inv H2. + intros. destruct dst; simpl in *; inv H2. constructor. auto. intros; constructor. constructor. constructor. auto. intros; constructor. (* var *) monadInv H; econstructor; split; auto with gensym. UseFinish. constructor. (* field *) - monadInv H0. exploit H; eauto. auto. intros [tmp [A B]]. UseFinish. - econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. + monadInv H0. exploit H; eauto. auto. intros [tmp [A B]]. UseFinish. + econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. (* valof *) monadInv H0. exploit H; eauto. intros [tmp1 [A B]]. exploit transl_valof_meets_spec; eauto. intros [tmp2 [Csyntax D]]. UseFinish. @@ -815,22 +815,22 @@ Opaque makeif. intros; apply tr_expr_add_dest. econstructor; eauto with gensym. eauto with gensym. (* deref *) - monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. - econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. + monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. + econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. (* addrof *) - monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. + monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. econstructor; split; eauto. intros; apply tr_expr_add_dest. econstructor; eauto. (* unop *) - monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. - econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. + monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. + econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. (* binop *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. exploit H0; eauto. intros [tmp2 [Csyntax D]]. UseFinish. - exists (tmp1 ++ tmp2); split. + exists (tmp1 ++ tmp2); split. intros; apply tr_expr_add_dest. econstructor; eauto with gensym. eauto with gensym. (* cast *) - monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. + monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. (* seqand *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. @@ -841,7 +841,7 @@ Opaque makeif. exists (x0 :: tmp1 ++ tmp2); split. intros; eapply tr_seqand_val; eauto with gensym. apply list_disjoint_cons_r; eauto with gensym. - apply contained_cons. eauto with gensym. + apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. (* for effects *) exploit H0; eauto with gensym. intros [tmp2 [Csyntax D]]. @@ -880,18 +880,18 @@ Opaque makeif. intros; eapply tr_seqor_set; eauto with gensym. apply list_disjoint_cons_r; eauto with gensym. apply contained_app; eauto with gensym. -(* condition *) +(* condition *) monadInv H2. exploit H; eauto. intros [tmp1 [A B]]. destruct dst; monadInv EQ0. (* for value *) exploit H0; eauto with gensym. intros [tmp2 [C D]]. exploit H1; eauto with gensym. intros [tmp3 [E F]]. simpl add_dest in *. - exists (x0 :: tmp1 ++ tmp2 ++ tmp3); split. + exists (x0 :: tmp1 ++ tmp2 ++ tmp3); split. simpl; intros; eapply tr_condition_val; eauto with gensym. apply list_disjoint_cons_r; eauto with gensym. apply list_disjoint_cons_r; eauto with gensym. - apply contained_cons. eauto with gensym. + apply contained_cons. eauto with gensym. apply contained_app. eauto with gensym. apply contained_app; eauto with gensym. (* for effects *) @@ -899,7 +899,7 @@ Opaque makeif. exploit H1; eauto. intros [tmp3 [E F]]. simpl add_dest in *. exists (tmp1 ++ tmp2 ++ tmp3); split. - intros; eapply tr_condition_effects; eauto with gensym. + intros; eapply tr_condition_effects; eauto with gensym. apply contained_app; eauto with gensym. (* for test *) exploit H0; eauto with gensym. intros [tmp2 [C D]]. @@ -909,7 +909,7 @@ Opaque makeif. intros; eapply tr_condition_set; eauto with gensym. apply list_disjoint_cons_r; eauto with gensym. apply list_disjoint_cons_r; eauto with gensym. - apply contained_cons; eauto with gensym. + apply contained_cons; eauto with gensym. apply contained_app; eauto with gensym. apply contained_app; eauto with gensym. (* sizeof *) @@ -923,19 +923,19 @@ Opaque makeif. exploit H0; eauto. intros [tmp2 [Csyntax D]]. destruct dst; monadInv EQ2; simpl add_dest in *. (* for value *) - exists (x1 :: tmp1 ++ tmp2); split. + exists (x1 :: tmp1 ++ tmp2); split. intros. eapply tr_assign_val with (dst := For_val); eauto with gensym. - apply contained_cons. eauto with gensym. + apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. (* for effects *) - exists (tmp1 ++ tmp2); split. + exists (tmp1 ++ tmp2); split. econstructor; eauto with gensym. apply contained_app; eauto with gensym. (* for set *) exists (x1 :: tmp1 ++ tmp2); split. - repeat rewrite app_ass. simpl. + repeat rewrite app_ass. simpl. intros. eapply tr_assign_val with (dst := For_set sd); eauto with gensym. - apply contained_cons. eauto with gensym. + apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. (* assignop *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. @@ -945,43 +945,43 @@ Opaque makeif. (* for value *) exists (x2 :: tmp1 ++ tmp2 ++ tmp3); split. intros. eapply tr_assignop_val with (dst := For_val); eauto with gensym. - apply contained_cons. eauto with gensym. + apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. (* for effects *) - exists (tmp1 ++ tmp2 ++ tmp3); split. + exists (tmp1 ++ tmp2 ++ tmp3); split. econstructor; eauto with gensym. apply contained_app; eauto with gensym. (* for set *) exists (x2 :: tmp1 ++ tmp2 ++ tmp3); split. repeat rewrite app_ass. simpl. intros. eapply tr_assignop_val with (dst := For_set sd); eauto with gensym. - apply contained_cons. eauto with gensym. + apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. (* postincr *) monadInv H0. exploit H; eauto. intros [tmp1 [A B]]. destruct dst; monadInv EQ0; simpl add_dest in *. (* for value *) - exists (x0 :: tmp1); split. + exists (x0 :: tmp1); split. econstructor; eauto with gensym. - apply contained_cons; eauto with gensym. + apply contained_cons; eauto with gensym. (* for effects *) exploit transl_valof_meets_spec; eauto. intros [tmp2 [Csyntax D]]. - exists (tmp1 ++ tmp2); split. + exists (tmp1 ++ tmp2); split. econstructor; eauto with gensym. - eauto with gensym. + eauto with gensym. (* for set *) repeat rewrite app_ass; simpl. - exists (x0 :: tmp1); split. + exists (x0 :: tmp1); split. econstructor; eauto with gensym. - apply contained_cons; eauto with gensym. + apply contained_cons; eauto with gensym. (* comma *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. exploit H0; eauto with gensym. intros [tmp2 [Csyntax D]]. - exists (tmp1 ++ tmp2); split. + exists (tmp1 ++ tmp2); split. econstructor; eauto with gensym. - destruct dst; simpl; eauto with gensym. + destruct dst; simpl; eauto with gensym. apply list_disjoint_cons_r; eauto with gensym. - simpl. eapply incl_tran. 2: apply add_dest_incl. auto with gensym. + simpl. eapply incl_tran. 2: apply add_dest_incl. auto with gensym. destruct dst; simpl; auto with gensym. apply contained_app; eauto with gensym. (* call *) @@ -989,44 +989,44 @@ Opaque makeif. exploit H0; eauto. intros [tmp2 [Csyntax D]]. destruct dst; monadInv EQ2; simpl add_dest in *. (* for value *) - exists (x1 :: tmp1 ++ tmp2); split. + exists (x1 :: tmp1 ++ tmp2); split. econstructor; eauto with gensym. congruence. - apply contained_cons. eauto with gensym. + apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. (* for effects *) - exists (tmp1 ++ tmp2); split. + exists (tmp1 ++ tmp2); split. econstructor; eauto with gensym. apply contained_app; eauto with gensym. (* for set *) - exists (x1 :: tmp1 ++ tmp2); split. + exists (x1 :: tmp1 ++ tmp2); split. repeat rewrite app_ass. econstructor; eauto with gensym. congruence. - apply contained_cons. eauto with gensym. + apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. (* builtin *) monadInv H0. exploit H; eauto. intros [tmp1 [A B]]. destruct dst; monadInv EQ0; simpl add_dest in *. (* for value *) - exists (x0 :: tmp1); split. + exists (x0 :: tmp1); split. econstructor; eauto with gensym. congruence. - apply contained_cons; eauto with gensym. + apply contained_cons; eauto with gensym. (* for effects *) - exists tmp1; split. + exists tmp1; split. econstructor; eauto with gensym. auto. (* for set *) - exists (x0 :: tmp1); split. + exists (x0 :: tmp1); split. repeat rewrite app_ass. econstructor; eauto with gensym. congruence. - apply contained_cons; eauto with gensym. + apply contained_cons; eauto with gensym. (* loc *) monadInv H. (* paren *) - monadInv H0. + monadInv H0. (* nil *) monadInv H; exists (@nil ident); split; auto with gensym. constructor. (* cons *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. exploit H0; eauto. intros [tmp2 [Csyntax D]]. - exists (tmp1 ++ tmp2); split. + exists (tmp1 ++ tmp2); split. econstructor; eauto with gensym. eauto with gensym. Qed. @@ -1038,7 +1038,7 @@ Lemma transl_expr_meets_spec: exists tmps, forall ge e le m, tr_top ge e le m dst r sl a tmps. Proof. intros. exploit (proj1 transl_meets_spec); eauto. intros [tmps [A B]]. - exists (add_dest dst tmps); intros. apply tr_top_base. auto. + exists (add_dest dst tmps); intros. apply tr_top_base. auto. Qed. Lemma transl_expression_meets_spec: @@ -1046,8 +1046,8 @@ Lemma transl_expression_meets_spec: transl_expression r g = Res (s, a) g' I -> tr_expression r s a. Proof. - intros. monadInv H. exploit transl_expr_meets_spec; eauto. - intros [tmps A]. econstructor; eauto. + intros. monadInv H. exploit transl_expr_meets_spec; eauto. + intros [tmps A]. econstructor; eauto. Qed. Lemma transl_expr_stmt_meets_spec: @@ -1055,8 +1055,8 @@ Lemma transl_expr_stmt_meets_spec: transl_expr_stmt r g = Res s g' I -> tr_expr_stmt r s. Proof. - intros. monadInv H. exploit transl_expr_meets_spec; eauto. - intros [tmps A]. econstructor; eauto. + intros. monadInv H. exploit transl_expr_meets_spec; eauto. + intros [tmps A]. econstructor; eauto. Qed. Lemma transl_if_meets_spec: @@ -1064,8 +1064,8 @@ Lemma transl_if_meets_spec: transl_if r s1 s2 g = Res s g' I -> tr_if r s1 s2 s. Proof. - intros. monadInv H. exploit transl_expr_meets_spec; eauto. - intros [tmps A]. econstructor; eauto. + intros. monadInv H. exploit transl_expr_meets_spec; eauto. + intros [tmps A]. econstructor; eauto. Qed. Lemma transl_stmt_meets_spec: @@ -1076,11 +1076,11 @@ Proof. generalize transl_expression_meets_spec transl_expr_stmt_meets_spec transl_if_meets_spec; intros T1 T2 T3. Opaque transl_expression transl_expr_stmt. clear transl_stmt_meets_spec. - induction s; simpl; intros until I; intros TR; + induction s; simpl; intros until I; intros TR; try (monadInv TR); try (constructor; eauto). destruct (is_Sskip s1); monadInv EQ4. apply tr_for_1; eauto. - apply tr_for_2; eauto. + apply tr_for_2; eauto. destruct o; monadInv TR; constructor; eauto. clear transl_lblstmt_meets_spec. @@ -1112,7 +1112,7 @@ Lemma transl_function_spec: tr_function f tf. Proof. unfold transl_function; intros. monadInv H. - constructor; auto. simpl. eapply transl_stmt_meets_spec; eauto. + constructor; auto. simpl. eapply transl_stmt_meets_spec; eauto. Qed. Lemma transl_fundef_spec: @@ -1122,7 +1122,7 @@ Lemma transl_fundef_spec: Proof. unfold transl_fundef; intros. destruct fd; monadInv H. -+ constructor. eapply transl_function_spec; eauto. ++ constructor. eapply transl_function_spec; eauto. + constructor. Qed. @@ -1146,9 +1146,9 @@ Theorem transl_program_spec: transl_program p = OK tp -> match_program tr_fundef (fun v1 v2 => v1 = v2) nil (Csyntax.prog_main p) p tp. Proof. - unfold transl_program; intros. + unfold transl_program; intros. destruct (transl_globdefs (Csyntax.prog_defs p) (initial_generator tt)) eqn:E; simpl in H; inv H. - split; auto. exists l; split. eapply transl_globdefs_spec; eauto. + split; auto. exists l; split. eapply transl_globdefs_spec; eauto. rewrite <- app_nil_end; auto. Qed. diff --git a/cfrontend/SimplLocals.v b/cfrontend/SimplLocals.v index 7fc69324..c4b1054d 100644 --- a/cfrontend/SimplLocals.v +++ b/cfrontend/SimplLocals.v @@ -276,7 +276,7 @@ Definition transf_function (f: function) : res function := fn_params := f.(fn_params); fn_vars := vars'; fn_temps := temps'; - fn_body := add_debug_params f.(fn_params) + fn_body := add_debug_params f.(fn_params) (store_params cenv f.(fn_params) (add_debug_vars vars' body')) |}. diff --git a/cfrontend/SimplLocalsproof.v b/cfrontend/SimplLocalsproof.v index 73092ab9..a47036bf 100644 --- a/cfrontend/SimplLocalsproof.v +++ b/cfrontend/SimplLocalsproof.v @@ -45,13 +45,13 @@ Let tge := globalenv tprog. Lemma comp_env_preserved: genv_cenv tge = genv_cenv ge. Proof. - monadInv TRANSF. unfold tge; rewrite <- H0; auto. + monadInv TRANSF. unfold tge; rewrite <- H0; auto. Qed. Lemma transf_programs: AST.transform_partial_program transf_fundef (program_of_program prog) = OK (program_of_program tprog). Proof. - monadInv TRANSF. rewrite EQ. destruct x; reflexivity. + monadInv TRANSF. rewrite EQ. destruct x; reflexivity. Qed. Lemma symbols_preserved: @@ -84,7 +84,7 @@ Lemma function_ptr_translated: forall (b: block) (f: fundef), Genv.find_funct_ptr ge b = Some f -> exists tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = OK tf. -Proof. +Proof. exact (Genv.find_funct_ptr_transf_partial _ _ transf_programs). Qed. @@ -93,7 +93,7 @@ Lemma type_of_fundef_preserved: transf_fundef fd = OK tfd -> type_of_fundef tfd = type_of_fundef fd. Proof. intros. destruct fd; monadInv H; auto. - monadInv EQ. simpl; unfold type_of_function; simpl. auto. + monadInv EQ. simpl; unfold type_of_function; simpl. auto. Qed. (** Matching between environments before and after *) @@ -162,18 +162,18 @@ Lemma match_envs_invariant: (forall b b' delta, f' b = Some(b', delta) -> Ple tlo b' /\ Plt b' thi -> f' b = f b) -> match_envs f' cenv e le m' lo hi te tle tlo thi. Proof. - intros until m'; intros ME LD INCR INV1 INV2. - destruct ME; constructor; eauto. + intros until m'; intros ME LD INCR INV1 INV2. + destruct ME; constructor; eauto. (* vars *) intros. generalize (me_vars0 id); intros MV; inv MV. eapply match_var_lifted; eauto. - rewrite <- MAPPED; eauto. + rewrite <- MAPPED; eauto. eapply match_var_not_lifted; eauto. eapply match_var_not_local; eauto. (* temps *) - intros. exploit me_temps0; eauto. intros [[v' [A B]] C]. split; auto. exists v'; eauto. + intros. exploit me_temps0; eauto. intros [[v' [A B]] C]. split; auto. exists v'; eauto. (* mapped *) - intros. exploit me_mapped0; eauto. intros [b [A B]]. exists b; split; auto. + intros. exploit me_mapped0; eauto. intros [b [A B]]. exists b; split; auto. (* flat *) intros. eapply me_flat0; eauto. rewrite <- H0. symmetry. eapply INV2; eauto. Qed. @@ -189,14 +189,14 @@ Lemma match_envs_extcall: Ple hi (Mem.nextblock m) -> Ple thi (Mem.nextblock tm) -> match_envs f' cenv e le m' lo hi te tle tlo thi. Proof. - intros. eapply match_envs_invariant; eauto. - intros. eapply Mem.load_unchanged_on; eauto. - red in H2. intros. destruct (f b) as [[b' delta]|] eqn:?. + intros. eapply match_envs_invariant; eauto. + intros. eapply Mem.load_unchanged_on; eauto. + red in H2. intros. destruct (f b) as [[b' delta]|] eqn:?. eapply H1; eauto. - destruct (f' b) as [[b' delta]|] eqn:?; auto. + destruct (f' b) as [[b' delta]|] eqn:?; auto. exploit H2; eauto. unfold Mem.valid_block. intros [A B]. xomegaContradiction. - intros. destruct (f b) as [[b'' delta']|] eqn:?. eauto. + intros. destruct (f b) as [[b'' delta']|] eqn:?. eauto. exploit H2; eauto. unfold Mem.valid_block. intros [A B]. xomegaContradiction. Qed. @@ -229,7 +229,7 @@ Inductive val_casted: val -> type -> Prop := Remark cast_int_int_idem: forall sz sg i, cast_int_int sz sg (cast_int_int sz sg i) = cast_int_int sz sg i. Proof. - intros. destruct sz; simpl; auto. + intros. destruct sz; simpl; auto. destruct sg; [apply Int.sign_ext_idem|apply Int.zero_ext_idem]; compute; intuition congruence. destruct sg; [apply Int.sign_ext_idem|apply Int.zero_ext_idem]; compute; intuition congruence. destruct (Int.eq i Int.zero); auto. @@ -253,7 +253,7 @@ Proof. destruct (cast_float_int s f); inv H1. constructor. apply (cast_int_int_idem I16 s). constructor. auto. constructor. - constructor. auto. + constructor. auto. destruct (cast_single_int s f); inv H1. constructor. auto. destruct (cast_float_int s f); inv H1. constructor; auto. constructor; auto. @@ -303,7 +303,7 @@ Proof. destruct si; inversion H0; clear H0; subst chunk; simpl in *; congruence. destruct si; inversion H0; clear H0; subst chunk; simpl in *; congruence. clear H1. inv H0. auto. - inversion H0; clear H0; subst chunk. simpl in *. + inversion H0; clear H0; subst chunk. simpl in *. destruct (Int.eq n Int.zero); subst n; reflexivity. inv H0; auto. inv H0; auto. @@ -338,7 +338,7 @@ Lemma forall2_val_casted_inject: forall f vl vl', Val.inject_list f vl vl' -> forall tyl, list_forall2 val_casted vl tyl -> list_forall2 val_casted vl' tyl. Proof. - induction 1; intros tyl F; inv F; constructor; eauto. eapply val_casted_inject; eauto. + induction 1; intros tyl F; inv F; constructor; eauto. eapply val_casted_inject; eauto. Qed. Inductive val_casted_list: list val -> typelist -> Prop := @@ -353,9 +353,9 @@ Lemma val_casted_list_params: val_casted_list vl (type_of_params params) -> list_forall2 val_casted vl (map snd params). Proof. - induction params; simpl; intros. + induction params; simpl; intros. inv H. constructor. - destruct a as [id ty]. inv H. constructor; auto. + destruct a as [id ty]. inv H. constructor; auto. Qed. (** Correctness of [make_cast] *) @@ -369,7 +369,7 @@ Proof. intros. assert (DFL: eval_expr tge e le m (Ecast a tto) v2). econstructor; eauto. - unfold sem_cast, make_cast in *. + unfold sem_cast, make_cast in *. destruct (classify_cast (typeof a) tto); auto. destruct v1; inv H0; auto. destruct sz2; auto. destruct v1; inv H0; auto. @@ -390,8 +390,8 @@ Lemma cast_typeconv: val_casted v ty -> sem_cast v ty (typeconv ty) = Some v. Proof. - induction 1; simpl; auto. -- destruct sz; auto. + induction 1; simpl; auto. +- destruct sz; auto. - unfold sem_cast. simpl. rewrite dec_eq_true; auto. - unfold sem_cast. simpl. rewrite dec_eq_true; auto. Qed. @@ -405,7 +405,7 @@ Lemma step_Sdebug_temp: Proof. intros. unfold Sdebug_temp. eapply step_builtin with (optid := None). econstructor. constructor. eauto. simpl. eapply cast_typeconv; eauto. constructor. - simpl. constructor. + simpl. constructor. Qed. Lemma step_Sdebug_var: @@ -415,9 +415,9 @@ Lemma step_Sdebug_var: E0 (State f Sskip k e le m). Proof. intros. unfold Sdebug_var. eapply step_builtin with (optid := None). - econstructor. constructor. constructor. eauto. - simpl. reflexivity. constructor. - simpl. constructor. + econstructor. constructor. constructor. eauto. + simpl. reflexivity. constructor. + simpl. constructor. Qed. Lemma step_Sset_debug: @@ -427,16 +427,16 @@ Lemma step_Sset_debug: plus step2 tge (State f (Sset_debug id ty a) k e le m) E0 (State f Sskip k e (PTree.set id v' le) m). Proof. - intros; unfold Sset_debug. + intros; unfold Sset_debug. assert (forall k, step2 tge (State f (Sset id (make_cast a ty)) k e le m) E0 (State f Sskip k e (PTree.set id v' le) m)). { intros. apply step_set. eapply make_cast_correct; eauto. } destruct (Compopts.debug tt). -- eapply plus_left. constructor. +- eapply plus_left. constructor. eapply star_left. apply H1. eapply star_left. constructor. apply star_one. apply step_Sdebug_temp with (v := v'). - apply PTree.gss. eapply cast_val_is_casted; eauto. + apply PTree.gss. eapply cast_val_is_casted; eauto. reflexivity. reflexivity. reflexivity. - apply plus_one. apply H1. Qed. @@ -448,12 +448,12 @@ Lemma step_add_debug_vars: E0 (State f s k e le m). Proof. unfold add_debug_vars. destruct (Compopts.debug tt). -- induction vars; simpl; intros. +- induction vars; simpl; intros. + apply star_refl. + destruct a as [id ty]. - exploit H; eauto. intros (b & TE). - simpl. eapply star_left. constructor. - eapply star_left. eapply step_Sdebug_var; eauto. + exploit H; eauto. intros (b & TE). + simpl. eapply star_left. constructor. + eapply star_left. eapply step_Sdebug_var; eauto. eapply star_left. constructor. apply IHvars; eauto. reflexivity. reflexivity. reflexivity. @@ -466,11 +466,11 @@ Remark bind_parameter_temps_inv: ~In id (var_names params) -> le'!id = le!id. Proof. - induction params; simpl; intros. + induction params; simpl; intros. destruct args; inv H. auto. - destruct a as [id1 ty1]. destruct args; try discriminate. - transitivity ((PTree.set id1 v le)!id). - eapply IHparams; eauto. apply PTree.gso. intuition. + destruct a as [id1 ty1]. destruct args; try discriminate. + transitivity ((PTree.set id1 v le)!id). + eapply IHparams; eauto. apply PTree.gso. intuition. Qed. Lemma step_add_debug_params: @@ -485,8 +485,8 @@ Proof. - induction params as [ | [id ty] params ]; simpl; intros until le1; intros NR CAST BIND; inv CAST; inv NR. + apply star_refl. + assert (le!id = Some a1). { erewrite bind_parameter_temps_inv by eauto. apply PTree.gss. } - eapply star_left. constructor. - eapply star_left. eapply step_Sdebug_temp; eauto. + eapply star_left. constructor. + eapply star_left. eapply step_Sdebug_temp; eauto. eapply star_left. constructor. eapply IHparams; eauto. reflexivity. reflexivity. reflexivity. @@ -511,18 +511,18 @@ Proof. constructor; eauto; intros. (* vars *) destruct (peq id0 id). subst id0. - eapply match_var_lifted with (v := v); eauto. + eapply match_var_lifted with (v := v); eauto. exploit Mem.load_store_same; eauto. erewrite val_casted_load_result; eauto. - apply PTree.gss. + apply PTree.gss. generalize (me_vars0 id0); intros MV; inv MV. eapply match_var_lifted; eauto. - rewrite <- LOAD0. eapply Mem.load_store_other; eauto. + rewrite <- LOAD0. eapply Mem.load_store_other; eauto. rewrite PTree.gso; auto. - eapply match_var_not_lifted; eauto. + eapply match_var_not_lifted; eauto. eapply match_var_not_local; eauto. (* temps *) exploit me_temps0; eauto. intros [[tv1 [A B]] C]. split; auto. - rewrite PTree.gsspec. destruct (peq id0 id). + rewrite PTree.gsspec. destruct (peq id0 id). subst id0. exists tv; split; auto. rewrite C; auto. exists tv1; auto. Qed. @@ -536,18 +536,18 @@ Lemma match_envs_set_temp: check_temp cenv id = OK x -> match_envs f cenv e (PTree.set id v le) m lo hi te (PTree.set id tv tle) tlo thi. Proof. - intros. unfold check_temp in H1. + intros. unfold check_temp in H1. destruct (VSet.mem id cenv) eqn:?; monadInv H1. destruct H. constructor; eauto; intros. (* vars *) generalize (me_vars0 id0); intros MV; inv MV. eapply match_var_lifted; eauto. rewrite PTree.gso. eauto. congruence. - eapply match_var_not_lifted; eauto. - eapply match_var_not_local; eauto. + eapply match_var_not_lifted; eauto. + eapply match_var_not_local; eauto. (* temps *) - rewrite PTree.gsspec in *. destruct (peq id0 id). + rewrite PTree.gsspec in *. destruct (peq id0 id). inv H. split. exists tv; auto. intros; congruence. - eapply me_temps0; eauto. + eapply me_temps0; eauto. Qed. Lemma match_envs_set_opttemp: @@ -591,7 +591,7 @@ Proof. intros. destruct H. constructor; auto; intros. (* vars *) generalize (me_vars0 id0); intros MV; inv MV. - eapply match_var_lifted; eauto. rewrite PTree.gso; auto. congruence. + eapply match_var_lifted; eauto. rewrite PTree.gso; auto. congruence. eapply match_var_not_lifted; eauto. eapply match_var_not_local; eauto. (* temps *) @@ -608,7 +608,7 @@ Remark add_local_variable_charact: VSet.In id1 (add_local_variable atk (id, ty) cenv) <-> VSet.In id1 cenv \/ exists chunk, access_mode ty = By_value chunk /\ id = id1 /\ VSet.mem id atk = false. Proof. - intros. unfold add_local_variable. split; intros. + intros. unfold add_local_variable. split; intros. destruct (access_mode ty) eqn:?; auto. destruct (VSet.mem id atk) eqn:?; auto. rewrite VSF.add_iff in H. destruct H; auto. right; exists m; auto. @@ -622,7 +622,7 @@ Lemma cenv_for_gen_domain: Proof. induction vars; simpl; intros. rewrite VSF.empty_iff in H. auto. - destruct a as [id1 ty1]. rewrite add_local_variable_charact in H. + destruct a as [id1 ty1]. rewrite add_local_variable_charact in H. destruct H as [A | [chunk [A [B C]]]]; auto. Qed. @@ -635,13 +635,13 @@ Lemma cenv_for_gen_by_value: Proof. induction vars; simpl; intros. contradiction. - destruct a as [id1 ty1]. simpl in H0. inv H0. + destruct a as [id1 ty1]. simpl in H0. inv H0. rewrite add_local_variable_charact in H1. destruct H; destruct H1 as [A | [chunk [A [B C]]]]. - inv H. elim H4. eapply cenv_for_gen_domain; eauto. + inv H. elim H4. eapply cenv_for_gen_domain; eauto. inv H. exists chunk; auto. eauto. - subst id1. elim H4. change id with (fst (id, ty)). apply in_map; auto. + subst id1. elim H4. change id with (fst (id, ty)). apply in_map; auto. Qed. Lemma cenv_for_gen_compat: @@ -664,9 +664,9 @@ Definition compat_cenv (atk: VSet.t) (cenv: compilenv) : Prop := Lemma compat_cenv_for: forall f, compat_cenv (addr_taken_stmt f.(fn_body)) (cenv_for f). Proof. - intros; red; intros. + intros; red; intros. assert (VSet.mem id (addr_taken_stmt (fn_body f)) = false). - eapply cenv_for_gen_compat. eexact H0. + eapply cenv_for_gen_compat. eexact H0. rewrite VSF.mem_iff in H. congruence. Qed. @@ -674,20 +674,20 @@ Lemma compat_cenv_union_l: forall atk1 atk2 cenv, compat_cenv (VSet.union atk1 atk2) cenv -> compat_cenv atk1 cenv. Proof. - intros; red; intros. eapply H; eauto. apply VSet.union_2; auto. + intros; red; intros. eapply H; eauto. apply VSet.union_2; auto. Qed. Lemma compat_cenv_union_r: forall atk1 atk2 cenv, compat_cenv (VSet.union atk1 atk2) cenv -> compat_cenv atk2 cenv. Proof. - intros; red; intros. eapply H; eauto. apply VSet.union_3; auto. + intros; red; intros. eapply H; eauto. apply VSet.union_3; auto. Qed. Lemma compat_cenv_empty: forall cenv, compat_cenv VSet.empty cenv. Proof. - intros; red; intros. eapply VSet.empty_1; eauto. + intros; red; intros. eapply VSet.empty_1; eauto. Qed. Hint Resolve compat_cenv_union_l compat_cenv_union_r compat_cenv_empty: compat. @@ -700,7 +700,7 @@ Lemma alloc_variables_nextblock: Proof. induction 1. apply Ple_refl. - eapply Ple_trans; eauto. exploit Mem.nextblock_alloc; eauto. intros EQ; rewrite EQ. apply Ple_succ. + eapply Ple_trans; eauto. exploit Mem.nextblock_alloc; eauto. intros EQ; rewrite EQ. apply Ple_succ. Qed. Lemma alloc_variables_range: @@ -711,12 +711,12 @@ Proof. induction 1; intros. auto. exploit IHalloc_variables; eauto. rewrite PTree.gsspec. intros [A|A]. - destruct (peq id id0). inv A. + destruct (peq id id0). inv A. right. exploit Mem.alloc_result; eauto. exploit Mem.nextblock_alloc; eauto. - generalize (alloc_variables_nextblock _ _ _ _ _ _ H0). intros A B C. - subst b. split. apply Ple_refl. eapply Plt_le_trans; eauto. rewrite B. apply Plt_succ. + generalize (alloc_variables_nextblock _ _ _ _ _ _ H0). intros A B C. + subst b. split. apply Ple_refl. eapply Plt_le_trans; eauto. rewrite B. apply Plt_succ. auto. - right. exploit Mem.nextblock_alloc; eauto. intros B. rewrite B in A. xomega. + right. exploit Mem.nextblock_alloc; eauto. intros B. rewrite B in A. xomega. Qed. Lemma alloc_variables_injective: @@ -726,9 +726,9 @@ Lemma alloc_variables_injective: (forall id b ty, e!id = Some(b, ty) -> Plt b (Mem.nextblock m)) -> (e'!id1 = Some(b1, ty1) -> e'!id2 = Some(b2, ty2) -> id1 <> id2 -> b1 <> b2). Proof. - induction 1; intros. + induction 1; intros. eauto. - eapply IHalloc_variables; eauto. + eapply IHalloc_variables; eauto. repeat rewrite PTree.gsspec; intros. destruct (peq id1 id); destruct (peq id2 id). congruence. @@ -752,10 +752,10 @@ Lemma match_alloc_variables: /\ inject_incr j j' /\ (forall b, Mem.valid_block m b -> j' b = j b) /\ (forall b b' delta, j' b = Some(b', delta) -> Mem.valid_block tm b' -> j' b = j b) - /\ (forall b b' delta, j' b = Some(b', delta) -> ~Mem.valid_block tm b' -> + /\ (forall b b' delta, j' b = Some(b', delta) -> ~Mem.valid_block tm b' -> exists id, exists ty, e'!id = Some(b, ty) /\ te'!id = Some(b', ty) /\ delta = 0) /\ (forall id ty, In (id, ty) vars -> - exists b, + exists b, e'!id = Some(b, ty) /\ if VSet.mem id cenv then te'!id = te!id /\ j' b = None @@ -766,83 +766,83 @@ Proof. (* base case *) exists j; exists te; exists tm. simpl. split. constructor. - split. auto. split. auto. split. auto. split. auto. + split. auto. split. auto. split. auto. split. auto. split. intros. elim H2. eapply Mem.mi_mappedblocks; eauto. - split. tauto. auto. - + split. tauto. auto. + (* inductive case *) simpl in H1. inv H1. simpl. destruct (VSet.mem id cenv) eqn:?. simpl. (* variable is lifted out of memory *) - exploit Mem.alloc_left_unmapped_inject; eauto. + exploit Mem.alloc_left_unmapped_inject; eauto. intros [j1 [A [B [C D]]]]. exploit IHalloc_variables; eauto. instantiate (1 := te). intros [j' [te' [tm' [J [K [L [M [N [Q [O P]]]]]]]]]]. exists j'; exists te'; exists tm'. split. auto. split. auto. - split. eapply inject_incr_trans; eauto. - split. intros. transitivity (j1 b). apply M. eapply Mem.valid_block_alloc; eauto. - apply D. apply Mem.valid_not_valid_diff with m; auto. eapply Mem.fresh_block_alloc; eauto. + split. eapply inject_incr_trans; eauto. + split. intros. transitivity (j1 b). apply M. eapply Mem.valid_block_alloc; eauto. + apply D. apply Mem.valid_not_valid_diff with m; auto. eapply Mem.fresh_block_alloc; eauto. split. intros. transitivity (j1 b). eapply N; eauto. - destruct (eq_block b b1); auto. subst. - assert (j' b1 = j1 b1). apply M. eapply Mem.valid_new_block; eauto. + destruct (eq_block b b1); auto. subst. + assert (j' b1 = j1 b1). apply M. eapply Mem.valid_new_block; eauto. congruence. - split. exact Q. + split. exact Q. split. intros. destruct (ident_eq id0 id). (* same var *) subst id0. assert (ty0 = ty). destruct H1. congruence. elim H5. unfold var_names. change id with (fst (id, ty0)). apply in_map; auto. - subst ty0. - exploit P; eauto. intros [X Y]. rewrite Heqb. rewrite X. rewrite Y. + subst ty0. + exploit P; eauto. intros [X Y]. rewrite Heqb. rewrite X. rewrite Y. exists b1. split. apply PTree.gss. split. auto. - rewrite M. auto. eapply Mem.valid_new_block; eauto. + rewrite M. auto. eapply Mem.valid_new_block; eauto. (* other vars *) - eapply O; eauto. destruct H1. congruence. auto. - intros. exploit (P id0). tauto. intros [X Y]. rewrite X; rewrite Y. - split; auto. apply PTree.gso. intuition. + eapply O; eauto. destruct H1. congruence. auto. + intros. exploit (P id0). tauto. intros [X Y]. rewrite X; rewrite Y. + split; auto. apply PTree.gso. intuition. (* variable is not lifted out of memory *) exploit Mem.alloc_parallel_inject. - eauto. eauto. apply Zle_refl. apply Zle_refl. + eauto. eauto. apply Zle_refl. apply Zle_refl. intros [j1 [tm1 [tb1 [A [B [C [D E]]]]]]]. - exploit IHalloc_variables; eauto. instantiate (1 := PTree.set id (tb1, ty) te). + exploit IHalloc_variables; eauto. instantiate (1 := PTree.set id (tb1, ty) te). intros [j' [te' [tm' [J [K [L [M [N [Q [O P]]]]]]]]]]. exists j'; exists te'; exists tm'. - split. simpl. econstructor; eauto. rewrite comp_env_preserved; auto. + split. simpl. econstructor; eauto. rewrite comp_env_preserved; auto. split. auto. - split. eapply inject_incr_trans; eauto. - split. intros. transitivity (j1 b). apply M. eapply Mem.valid_block_alloc; eauto. - apply E. apply Mem.valid_not_valid_diff with m; auto. eapply Mem.fresh_block_alloc; eauto. - split. intros. transitivity (j1 b). eapply N; eauto. eapply Mem.valid_block_alloc; eauto. - destruct (eq_block b b1); auto. subst. + split. eapply inject_incr_trans; eauto. + split. intros. transitivity (j1 b). apply M. eapply Mem.valid_block_alloc; eauto. + apply E. apply Mem.valid_not_valid_diff with m; auto. eapply Mem.fresh_block_alloc; eauto. + split. intros. transitivity (j1 b). eapply N; eauto. eapply Mem.valid_block_alloc; eauto. + destruct (eq_block b b1); auto. subst. assert (j' b1 = j1 b1). apply M. eapply Mem.valid_new_block; eauto. rewrite H4 in H1. rewrite D in H1. inv H1. eelim Mem.fresh_block_alloc; eauto. - split. intros. destruct (eq_block b' tb1). + split. intros. destruct (eq_block b' tb1). subst b'. rewrite (N _ _ _ H1) in H1. - destruct (eq_block b b1). subst b. rewrite D in H1; inv H1. + destruct (eq_block b b1). subst b. rewrite D in H1; inv H1. exploit (P id); auto. intros [X Y]. exists id; exists ty. rewrite X; rewrite Y. repeat rewrite PTree.gss. auto. - rewrite E in H1; auto. elim H3. eapply Mem.mi_mappedblocks; eauto. + rewrite E in H1; auto. elim H3. eapply Mem.mi_mappedblocks; eauto. eapply Mem.valid_new_block; eauto. eapply Q; eauto. unfold Mem.valid_block in *. - exploit Mem.nextblock_alloc. eexact A. exploit Mem.alloc_result. eexact A. + exploit Mem.nextblock_alloc. eexact A. exploit Mem.alloc_result. eexact A. unfold block; xomega. split. intros. destruct (ident_eq id0 id). (* same var *) subst id0. assert (ty0 = ty). destruct H1. congruence. elim H5. unfold var_names. change id with (fst (id, ty0)). apply in_map; auto. - subst ty0. - exploit P; eauto. intros [X Y]. rewrite Heqb. rewrite X. rewrite Y. + subst ty0. + exploit P; eauto. intros [X Y]. rewrite Heqb. rewrite X. rewrite Y. exists b1. split. apply PTree.gss. - exists tb1; split. + exists tb1; split. apply PTree.gss. - rewrite M. auto. eapply Mem.valid_new_block; eauto. + rewrite M. auto. eapply Mem.valid_new_block; eauto. (* other vars *) - exploit (O id0 ty0). destruct H1. congruence. auto. + exploit (O id0 ty0). destruct H1. congruence. auto. rewrite PTree.gso; auto. intros. exploit (P id0). tauto. intros [X Y]. rewrite X; rewrite Y. split; apply PTree.gso; intuition. @@ -875,7 +875,7 @@ Qed. Definition env_initial_value (e: env) (m: mem) := forall id b ty chunk, e!id = Some(b, ty) -> access_mode ty = By_value chunk -> Mem.load chunk m b 0 = Some Vundef. - + Lemma alloc_variables_initial_value: forall e m vars e' m', alloc_variables ge e m vars e' m' -> @@ -884,12 +884,12 @@ Lemma alloc_variables_initial_value: Proof. induction 1; intros. auto. - apply IHalloc_variables. red; intros. rewrite PTree.gsspec in H2. - destruct (peq id0 id). inv H2. - eapply Mem.load_alloc_same'; eauto. - omega. rewrite Zplus_0_l. eapply sizeof_by_value; eauto. - apply Zdivide_0. - eapply Mem.load_alloc_other; eauto. + apply IHalloc_variables. red; intros. rewrite PTree.gsspec in H2. + destruct (peq id0 id). inv H2. + eapply Mem.load_alloc_same'; eauto. + omega. rewrite Zplus_0_l. eapply sizeof_by_value; eauto. + apply Zdivide_0. + eapply Mem.load_alloc_other; eauto. Qed. Lemma create_undef_temps_charact: @@ -897,14 +897,14 @@ Lemma create_undef_temps_charact: Proof. induction vars; simpl; intros. contradiction. - destruct H. subst a. apply PTree.gss. - destruct a as [id1 ty1]. rewrite PTree.gsspec. destruct (peq id id1); auto. + destruct H. subst a. apply PTree.gss. + destruct a as [id1 ty1]. rewrite PTree.gsspec. destruct (peq id id1); auto. Qed. Lemma create_undef_temps_inv: forall vars id v, (create_undef_temps vars)!id = Some v -> v = Vundef /\ In id (var_names vars). Proof. - induction vars; simpl; intros. + induction vars; simpl; intros. rewrite PTree.gempty in H; congruence. destruct a as [id1 ty1]. rewrite PTree.gsspec in H. destruct (peq id id1). inv H. auto. @@ -924,16 +924,16 @@ Proof. exploit list_in_map_inv. unfold var_names in H. apply H. eexact B. intros [[id1 ty1] [P Q]]. simpl in P; subst id1. right; symmetry; eapply create_undef_temps_charact; eauto. - intros. - exploit (H id l1 l2). tauto. - exploit (H id l2 l1). tauto. + intros. + exploit (H id l1 l2). tauto. + exploit (H id l2 l1). tauto. intuition congruence. Qed. Remark var_names_app: forall vars1 vars2, var_names (vars1 ++ vars2) = var_names vars1 ++ var_names vars2. Proof. - intros. apply map_app. + intros. apply map_app. Qed. Remark filter_app: @@ -949,8 +949,8 @@ Remark filter_charact: forall (A: Type) (f: A -> bool) x l, In x (List.filter f l) <-> In x l /\ f x = true. Proof. - induction l; simpl. tauto. - destruct (f a) eqn:?. + induction l; simpl. tauto. + destruct (f a) eqn:?. simpl. rewrite IHl. intuition congruence. intuition congruence. Qed. @@ -959,8 +959,8 @@ Remark filter_norepet: forall (A: Type) (f: A -> bool) l, list_norepet l -> list_norepet (List.filter f l). Proof. - induction 1; simpl. constructor. - destruct (f hd); auto. constructor; auto. rewrite filter_charact. tauto. + induction 1; simpl. constructor. + destruct (f hd); auto. constructor; auto. rewrite filter_charact. tauto. Qed. Remark filter_map: @@ -979,12 +979,12 @@ Lemma create_undef_temps_lifted: (create_undef_temps (add_lifted (cenv_for f) (fn_vars f) (fn_temps f))) ! id = (create_undef_temps (add_lifted (cenv_for f) (fn_params f ++ fn_vars f) (fn_temps f))) ! id. Proof. - intros. apply create_undef_temps_exten. - unfold add_lifted. rewrite filter_app. - unfold var_names in *. - repeat rewrite map_app. repeat rewrite in_app. intuition. - exploit list_in_map_inv; eauto. intros [[id1 ty1] [P Q]]. simpl in P. subst id. - rewrite filter_charact in Q. destruct Q. + intros. apply create_undef_temps_exten. + unfold add_lifted. rewrite filter_app. + unfold var_names in *. + repeat rewrite map_app. repeat rewrite in_app. intuition. + exploit list_in_map_inv; eauto. intros [[id1 ty1] [P Q]]. simpl in P. subst id. + rewrite filter_charact in Q. destruct Q. elim H. change id1 with (fst (id1, ty1)). apply List.in_map. auto. Qed. @@ -998,11 +998,11 @@ Lemma vars_and_temps_properties: Proof. intros. rewrite list_norepet_app in H. destruct H as [A [B C]]. split. auto. - split. unfold remove_lifted. unfold var_names. erewrite filter_map. + split. unfold remove_lifted. unfold var_names. erewrite filter_map. instantiate (1 := fun a => negb (VSet.mem a cenv)). 2: auto. apply filter_norepet. rewrite map_app. apply list_norepet_append; assumption. - unfold add_lifted. rewrite var_names_app. - unfold var_names at 2. erewrite filter_map. + unfold add_lifted. rewrite var_names_app. + unfold var_names at 2. erewrite filter_map. instantiate (1 := fun a => VSet.mem a cenv). 2: auto. change (map fst vars) with (var_names vars). red; intros. @@ -1029,9 +1029,9 @@ Theorem match_envs_alloc_variables: /\ (forall b b' delta, j' b = Some(b', delta) -> Mem.valid_block tm b' -> j' b = j b) /\ (forall id ty, In (id, ty) vars -> VSet.mem id cenv = false -> exists b, te!id = Some(b, ty)). Proof. - intros. - exploit (match_alloc_variables cenv); eauto. instantiate (1 := empty_env). - intros [j' [te [tm' [A [B [C [D [E [K [F G]]]]]]]]]]. + intros. + exploit (match_alloc_variables cenv); eauto. instantiate (1 := empty_env). + intros [j' [te [tm' [A [B [C [D [E [K [F G]]]]]]]]]]. exists j'; exists te; exists tm'. split. auto. split; auto. constructor; intros. @@ -1039,67 +1039,67 @@ Proof. destruct (In_dec ident_eq id (var_names vars)). unfold var_names in i. exploit list_in_map_inv; eauto. intros [[id' ty] [EQ IN]]; simpl in EQ; subst id'. - exploit F; eauto. intros [b [P R]]. + exploit F; eauto. intros [b [P R]]. destruct (VSet.mem id cenv) eqn:?. (* local var, lifted *) - destruct R as [U V]. exploit H2; eauto. intros [chunk X]. + destruct R as [U V]. exploit H2; eauto. intros [chunk X]. eapply match_var_lifted with (v := Vundef) (tv := Vundef); eauto. rewrite U; apply PTree.gempty. - eapply alloc_variables_initial_value; eauto. + eapply alloc_variables_initial_value; eauto. red. unfold empty_env; intros. rewrite PTree.gempty in H4; congruence. - apply create_undef_temps_charact with ty. + apply create_undef_temps_charact with ty. unfold add_lifted. apply in_or_app. left. rewrite filter_In. auto. (* local var, not lifted *) destruct R as [tb [U V]]. - eapply match_var_not_lifted; eauto. + eapply match_var_not_lifted; eauto. (* non-local var *) exploit G; eauto. unfold empty_env. rewrite PTree.gempty. intros [U V]. - eapply match_var_not_local; eauto. + eapply match_var_not_local; eauto. destruct (VSet.mem id cenv) eqn:?; auto. elim n; eauto. (* temps *) exploit create_undef_temps_inv; eauto. intros [P Q]. subst v. - unfold var_names in Q. exploit list_in_map_inv; eauto. - intros [[id1 ty] [EQ IN]]; simpl in EQ; subst id1. - split; auto. exists Vundef; split; auto. - apply create_undef_temps_charact with ty. unfold add_lifted. + unfold var_names in Q. exploit list_in_map_inv; eauto. + intros [[id1 ty] [EQ IN]]; simpl in EQ; subst id1. + split; auto. exists Vundef; split; auto. + apply create_undef_temps_charact with ty. unfold add_lifted. apply in_or_app; auto. (* injective *) - eapply alloc_variables_injective. eexact H. + eapply alloc_variables_injective. eexact H. rewrite PTree.gempty. congruence. intros. rewrite PTree.gempty in H7. congruence. - eauto. eauto. auto. + eauto. eauto. auto. (* range *) - exploit alloc_variables_range. eexact H. eauto. + exploit alloc_variables_range. eexact H. eauto. rewrite PTree.gempty. intuition congruence. (* trange *) - exploit alloc_variables_range. eexact A. eauto. + exploit alloc_variables_range. eexact A. eauto. rewrite PTree.gempty. intuition congruence. (* mapped *) destruct (In_dec ident_eq id (var_names vars)). - unfold var_names in i. exploit list_in_map_inv; eauto. + unfold var_names in i. exploit list_in_map_inv; eauto. intros [[id' ty'] [EQ IN]]; simpl in EQ; subst id'. exploit F; eauto. intros [b [P Q]]. - destruct (VSet.mem id cenv). + destruct (VSet.mem id cenv). rewrite PTree.gempty in Q. destruct Q; congruence. destruct Q as [tb [U V]]. exists b; split; congruence. exploit G; eauto. rewrite PTree.gempty. intuition congruence. (* flat *) - exploit alloc_variables_range. eexact A. eauto. - rewrite PTree.gempty. intros [P|P]. congruence. - exploit K; eauto. unfold Mem.valid_block. xomega. - intros [id0 [ty0 [U [V W]]]]. split; auto. + exploit alloc_variables_range. eexact A. eauto. + rewrite PTree.gempty. intros [P|P]. congruence. + exploit K; eauto. unfold Mem.valid_block. xomega. + intros [id0 [ty0 [U [V W]]]]. split; auto. destruct (ident_eq id id0). congruence. assert (b' <> b'). eapply alloc_variables_injective with (e' := te) (id1 := id) (id2 := id0); eauto. - rewrite PTree.gempty; congruence. + rewrite PTree.gempty; congruence. intros until ty1; rewrite PTree.gempty; congruence. congruence. @@ -1127,13 +1127,13 @@ Proof. intros. inv H. - (* by value *) exploit Mem.storev_mapped_inject; eauto. intros [tm' [A B]]. - exists tm'; split. eapply assign_loc_value; eauto. + exists tm'; split. eapply assign_loc_value; eauto. split. auto. intros. rewrite <- H5. eapply Mem.load_store_other; eauto. left. inv H0. congruence. - (* by copy *) inv H0. inv H1. - rename b' into bsrc. rename ofs'0 into osrc. + rename b' into bsrc. rename ofs'0 into osrc. rename loc into bdst. rename ofs into odst. rename loc' into bdst'. rename b2 into bsrc'. rewrite <- comp_env_preserved in *. @@ -1147,13 +1147,13 @@ Proof. as [tm' SB]. simpl. red; intros; omegaContradiction. exists tm'. - split. eapply assign_loc_copy; eauto. + split. eapply assign_loc_copy; eauto. intros; omegaContradiction. intros; omegaContradiction. rewrite e; right; omega. - apply Mem.loadbytes_empty. omega. - split. eapply Mem.storebytes_empty_inject; eauto. - intros. rewrite <- H0. eapply Mem.load_storebytes_other; eauto. + apply Mem.loadbytes_empty. omega. + split. eapply Mem.storebytes_empty_inject; eauto. + intros. rewrite <- H0. eapply Mem.load_storebytes_other; eauto. left. congruence. + (* general case size > 0 *) exploit Mem.loadbytes_length; eauto. intros LEN. @@ -1173,8 +1173,8 @@ Proof. exploit Mem.address_inject. eauto. eexact PDST. eauto. intros EQ2. exploit Mem.loadbytes_inject; eauto. intros [bytes2 [A B]]. exploit Mem.storebytes_mapped_inject; eauto. intros [tm' [C D]]. - exists tm'. - split. eapply assign_loc_copy; try rewrite EQ1; try rewrite EQ2; eauto. + exists tm'. + split. eapply assign_loc_copy; try rewrite EQ1; try rewrite EQ2; eauto. intros; eapply Mem.aligned_area_inject with (m := m); eauto. apply alignof_blockcopy_1248. apply sizeof_alignof_blockcopy_compat. @@ -1185,7 +1185,7 @@ Proof. apply Mem.range_perm_max with Cur; auto. apply Mem.range_perm_max with Cur; auto. split. auto. - intros. rewrite <- H0. eapply Mem.load_storebytes_other; eauto. + intros. rewrite <- H0. eapply Mem.load_storebytes_other; eauto. left. congruence. Qed. @@ -1193,7 +1193,7 @@ Lemma assign_loc_nextblock: forall ge ty m b ofs v m', assign_loc ge ty m b ofs v m' -> Mem.nextblock m' = Mem.nextblock m. Proof. - induction 1. + induction 1. simpl in H0. eapply Mem.nextblock_store; eauto. eapply Mem.nextblock_storebytes; eauto. Qed. @@ -1227,43 +1227,43 @@ Proof. destruct (VSet.mem id cenv) eqn:?. (* lifted to temp *) eapply IHbind_parameters with (tle1 := PTree.set id v' tle1); eauto. - eapply match_envs_assign_lifted; eauto. + eapply match_envs_assign_lifted; eauto. inv MV; try congruence. rewrite ENV in H; inv H. inv H0; try congruence. unfold Mem.storev in H2. eapply Mem.store_unmapped_inject; eauto. intros. repeat rewrite PTree.gsspec. destruct (peq id0 id). auto. - apply TLE. intuition. + apply TLE. intuition. (* still in memory *) inv MV; try congruence. rewrite ENV in H; inv H. - exploit assign_loc_inject; eauto. + exploit assign_loc_inject; eauto. intros [tm1 [A [B C]]]. exploit IHbind_parameters. eauto. eauto. eauto. instantiate (1 := PTree.set id v' tle1). - apply match_envs_change_temp. + apply match_envs_change_temp. eapply match_envs_invariant; eauto. apply LE; auto. auto. eauto. - instantiate (1 := PTree.set id v' tle2). + instantiate (1 := PTree.set id v' tle2). intros. repeat rewrite PTree.gsspec. destruct (peq id0 id). auto. apply TLE. intuition. intros. apply LE. auto. - instantiate (1 := s). + instantiate (1 := s). intros [tle [tm' [U [V [X [Y Z]]]]]]. exists tle; exists tm'; split. eapply star_trans. eapply star_left. econstructor. - eapply star_left. econstructor. - eapply eval_Evar_local. eauto. + eapply star_left. econstructor. + eapply eval_Evar_local. eauto. eapply eval_Etempvar. erewrite bind_parameter_temps_inv; eauto. - apply PTree.gss. + apply PTree.gss. simpl. instantiate (1 := v'). apply cast_val_casted. eapply val_casted_inject with (v := v1); eauto. - simpl. eexact A. + simpl. eexact A. apply star_one. constructor. - reflexivity. reflexivity. - eexact U. + reflexivity. reflexivity. + eexact U. traceEq. - rewrite (assign_loc_nextblock _ _ _ _ _ _ _ A) in Z. auto. + rewrite (assign_loc_nextblock _ _ _ _ _ _ _ A) in Z. auto. Qed. Lemma bind_parameters_nextblock: @@ -1272,7 +1272,7 @@ Lemma bind_parameters_nextblock: Proof. induction 1. auto. - rewrite IHbind_parameters. eapply assign_loc_nextblock; eauto. + rewrite IHbind_parameters. eapply assign_loc_nextblock; eauto. Qed. Lemma bind_parameters_load: @@ -1286,7 +1286,7 @@ Proof. auto. rewrite IHbind_parameters. assert (b <> b0) by eauto. - inv H1. + inv H1. simpl in H5. eapply Mem.load_store_other; eauto. eapply Mem.load_storebytes_other; eauto. Qed. @@ -1315,10 +1315,10 @@ Lemma free_list_perm': Proof. induction l; simpl; intros. contradiction. - destruct a as [[b1 lo1] hi1]. + destruct a as [[b1 lo1] hi1]. destruct (Mem.free m b1 lo1 hi1) as [m1|] eqn:?; try discriminate. - destruct H0. inv H0. eapply Mem.free_range_perm; eauto. - red; intros. eapply Mem.perm_free_3; eauto. eapply IHl; eauto. + destruct H0. inv H0. eapply Mem.free_range_perm; eauto. + red; intros. eapply Mem.perm_free_3; eauto. eapply IHl; eauto. Qed. Lemma free_blocks_of_env_perm_2: @@ -1327,7 +1327,7 @@ Lemma free_blocks_of_env_perm_2: e!id = Some(b, ty) -> Mem.range_perm m b 0 (sizeof ce ty) Cur Freeable. Proof. - intros. eapply free_list_perm'; eauto. + intros. eapply free_list_perm'; eauto. unfold blocks_of_env. change (b, 0, sizeof ce ty) with (block_of_binding ce (id, (b, ty))). apply in_map. apply PTree.elements_correct. auto. Qed. @@ -1350,18 +1350,18 @@ Proof. induction l; simpl; intros. - exists m; auto. - destruct a as [[b lo] hi]. destruct H0. - destruct (Mem.range_perm_free m b lo hi) as [m1 A]; auto. + destruct (Mem.range_perm_free m b lo hi) as [m1 A]; auto. rewrite A. apply IHl; auto. - intros. red; intros. eapply Mem.perm_free_1; eauto. - exploit H1; eauto. intros [B|B]. auto. right; omega. - eapply H; eauto. + intros. red; intros. eapply Mem.perm_free_1; eauto. + exploit H1; eauto. intros [B|B]. auto. right; omega. + eapply H; eauto. Qed. Lemma blocks_of_env_no_overlap: forall (ge: genv) j cenv e le m lo hi te tle tlo thi tm, match_envs j cenv e le m lo hi te tle tlo thi -> Mem.inject j m tm -> - (forall id b ty, + (forall id b ty, e!id = Some(b, ty) -> Mem.range_perm m b 0 (sizeof ge ty) Cur Freeable) -> forall l, list_norepet (List.map fst l) -> @@ -1373,20 +1373,20 @@ Proof. - destruct a as [id [b ty]]. simpl in *. inv H. split. + apply IHl; auto. + intros. exploit list_in_map_inv; eauto. intros [[id' [b'' ty']] [A B]]. - simpl in A. inv A. rename b'' into b'. - assert (TE: te!id = Some(b, ty)) by eauto. - assert (TE': te!id' = Some(b', ty')) by eauto. - exploit me_mapped. eauto. eexact TE. intros [b0 [INJ E]]. - exploit me_mapped. eauto. eexact TE'. intros [b0' [INJ' E']]. - destruct (zle (sizeof ge0 ty) 0); auto. - destruct (zle (sizeof ge0 ty') 0); auto. + simpl in A. inv A. rename b'' into b'. + assert (TE: te!id = Some(b, ty)) by eauto. + assert (TE': te!id' = Some(b', ty')) by eauto. + exploit me_mapped. eauto. eexact TE. intros [b0 [INJ E]]. + exploit me_mapped. eauto. eexact TE'. intros [b0' [INJ' E']]. + destruct (zle (sizeof ge0 ty) 0); auto. + destruct (zle (sizeof ge0 ty') 0); auto. assert (b0 <> b0'). { eapply me_inj; eauto. red; intros; subst; elim H3. change id' with (fst (id', (b', ty'))). apply List.in_map; auto. } - assert (Mem.perm m b0 0 Max Nonempty). + assert (Mem.perm m b0 0 Max Nonempty). { apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable. eapply PERMS; eauto. omega. auto with mem. } - assert (Mem.perm m b0' 0 Max Nonempty). + assert (Mem.perm m b0' 0 Max Nonempty). { apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable. eapply PERMS; eauto. omega. auto with mem. } exploit Mem.mi_no_overlap; eauto. intros [A|A]. auto. omegaContradiction. @@ -1405,14 +1405,14 @@ Proof. congruence. destruct a as [[b lo] hi]. destruct (Mem.free m2 b lo hi) as [m21|] eqn:?; try discriminate. eapply IHl with (m2 := m21); eauto. - eapply Mem.free_right_inject; eauto. + eapply Mem.free_right_inject; eauto. Qed. Lemma blocks_of_env_translated: forall e, blocks_of_env tge e = blocks_of_env ge e. Proof. - intros. unfold blocks_of_env, block_of_binding. - rewrite comp_env_preserved; auto. + intros. unfold blocks_of_env, block_of_binding. + rewrite comp_env_preserved; auto. Qed. Theorem match_envs_free_blocks: @@ -1424,7 +1424,7 @@ Theorem match_envs_free_blocks: Mem.free_list tm (blocks_of_env tge te) = Some tm' /\ Mem.inject j m' tm'. Proof. - intros. + intros. Local Opaque ge tge. assert (X: exists tm', Mem.free_list tm (blocks_of_env tge te) = Some tm'). { @@ -1433,26 +1433,26 @@ Local Opaque ge tge. intros. unfold blocks_of_env in H2. exploit list_in_map_inv; eauto. intros [[id [b' ty]] [EQ IN]]. unfold block_of_binding in EQ; inv EQ. - exploit me_mapped; eauto. eapply PTree.elements_complete; eauto. - intros [b [A B]]. + exploit me_mapped; eauto. eapply PTree.elements_complete; eauto. + intros [b [A B]]. change 0 with (0 + 0). replace (sizeof ge ty) with (sizeof ge ty + 0) by omega. - eapply Mem.range_perm_inject; eauto. + eapply Mem.range_perm_inject; eauto. eapply free_blocks_of_env_perm_2; eauto. - (* no overlap *) - unfold blocks_of_env; eapply blocks_of_env_no_overlap; eauto. + unfold blocks_of_env; eapply blocks_of_env_no_overlap; eauto. intros. eapply free_blocks_of_env_perm_2; eauto. apply PTree.elements_keys_norepet. - intros. apply PTree.elements_complete; auto. + intros. apply PTree.elements_complete; auto. } destruct X as [tm' FREE]. exists tm'; split; auto. - eapply free_list_right_inject; eauto. - eapply Mem.free_list_left_inject; eauto. - intros. unfold blocks_of_env in H3. exploit list_in_map_inv; eauto. + eapply free_list_right_inject; eauto. + eapply Mem.free_list_left_inject; eauto. + intros. unfold blocks_of_env in H3. exploit list_in_map_inv; eauto. intros [[id [b' ty]] [EQ IN]]. unfold block_of_binding in EQ. inv EQ. - exploit me_flat; eauto. apply PTree.elements_complete; eauto. + exploit me_flat; eauto. apply PTree.elements_complete; eauto. intros [P Q]. subst delta. eapply free_blocks_of_env_perm_1 with (m := m); eauto. - rewrite <- comp_env_preserved. omega. + rewrite <- comp_env_preserved. omega. Qed. (** Matching global environments *) @@ -1472,7 +1472,7 @@ Lemma match_globalenvs_preserves_globals: Proof. intros. destruct H as [bound MG]. inv MG. split; intros. eauto. split; intros. eauto. symmetry. eapply IMAGE; eauto. -Qed. +Qed. (** Evaluation of expressions *) @@ -1500,9 +1500,9 @@ Lemma deref_loc_inject: Val.inject f (Vptr loc ofs) (Vptr loc' ofs') -> exists tv, deref_loc ty tm loc' ofs' tv /\ Val.inject f v tv. Proof. - intros. inv H. + intros. inv H. (* by value *) - exploit Mem.loadv_inject; eauto. intros [tv [A B]]. + exploit Mem.loadv_inject; eauto. intros [tv [A B]]. exists tv; split; auto. eapply deref_loc_value; eauto. (* by reference *) exists (Vptr loc' ofs'); split; auto. eapply deref_loc_reference; eauto. @@ -1531,15 +1531,15 @@ Proof. exists (Vsingle f0); split; auto. constructor. exists (Vlong i); split; auto. constructor. (* tempvar *) - exploit me_temps; eauto. intros [[tv [A B]] C]. + exploit me_temps; eauto. intros [[tv [A B]] C]. exists tv; split; auto. constructor; auto. (* addrof *) - exploit eval_simpl_lvalue; eauto. + exploit eval_simpl_lvalue; eauto. destruct a; auto with compat. - destruct a; auto. destruct (VSet.mem i cenv) eqn:?; auto. + destruct a; auto. destruct (VSet.mem i cenv) eqn:?; auto. elim (H0 i). apply VSet.singleton_2. auto. apply VSet.mem_2. auto. - intros [b' [ofs' [A B]]]. - exists (Vptr b' ofs'); split; auto. constructor; auto. + intros [b' [ofs' [A B]]]. + exists (Vptr b' ofs'); split; auto. constructor; auto. (* unop *) exploit eval_simpl_expr; eauto. intros [tv1 [A B]]. exploit sem_unary_operation_inject; eauto. intros [tv [C D]]. @@ -1549,7 +1549,7 @@ Proof. exploit eval_simpl_expr. eexact H0. eauto with compat. intros [tv2 [C D]]. exploit sem_binary_operation_inject; eauto. intros [tv [E F]]. exists tv; split; auto. econstructor; eauto. - repeat rewrite typeof_simpl_expr; rewrite comp_env_preserved; auto. + repeat rewrite typeof_simpl_expr; rewrite comp_env_preserved; auto. (* cast *) exploit eval_simpl_expr; eauto. intros [tv1 [A B]]. exploit sem_cast_inject; eauto. intros [tv2 [C D]]. @@ -1561,15 +1561,15 @@ Proof. (* rval *) assert (EITHER: (exists id, exists ty, a = Evar id ty /\ VSet.mem id cenv = true) \/ (match a with Evar id _ => VSet.mem id cenv = false | _ => True end)). - destruct a; auto. destruct (VSet.mem i cenv) eqn:?; auto. left; exists i; exists t; auto. + destruct a; auto. destruct (VSet.mem i cenv) eqn:?; auto. left; exists i; exists t; auto. destruct EITHER as [ [id [ty [EQ OPT]]] | NONOPT ]. (* a variable pulled out of memory *) subst a. simpl. rewrite OPT. - exploit me_vars; eauto. instantiate (1 := id). intros MV. + exploit me_vars; eauto. instantiate (1 := id). intros MV. inv H; inv MV; try congruence. rewrite ENV in H6; inv H6. inv H0; try congruence. - assert (chunk0 = chunk). simpl in H. congruence. subst chunk0. + assert (chunk0 = chunk). simpl in H. congruence. subst chunk0. assert (v0 = v). unfold Mem.loadv in H2. rewrite Int.unsigned_zero in H2. congruence. subst v0. exists tv; split; auto. constructor; auto. simpl in H; congruence. @@ -1577,12 +1577,12 @@ Proof. (* any other l-value *) exploit eval_simpl_lvalue; eauto. intros [loc' [ofs' [A B]]]. exploit deref_loc_inject; eauto. intros [tv [C D]]. - exists tv; split; auto. econstructor. eexact A. rewrite typeof_simpl_expr; auto. + exists tv; split; auto. econstructor. eexact A. rewrite typeof_simpl_expr; auto. (* lvalues *) destruct 1; simpl; intros. (* local var *) - rewrite H1. + rewrite H1. exploit me_vars; eauto. instantiate (1 := id). intros MV. inv MV; try congruence. rewrite ENV in H; inv H. exists b'; exists Int.zero; split. @@ -1592,25 +1592,25 @@ Proof. rewrite H2. exploit me_vars; eauto. instantiate (1 := id). intros MV. inv MV; try congruence. exists l; exists Int.zero; split. - apply eval_Evar_global. auto. rewrite <- H0. apply symbols_preserved. + apply eval_Evar_global. auto. rewrite <- H0. apply symbols_preserved. destruct GLOB as [bound GLOB1]. inv GLOB1. - econstructor; eauto. + econstructor; eauto. (* deref *) - exploit eval_simpl_expr; eauto. intros [tv [A B]]. - inversion B. subst. - econstructor; econstructor; split; eauto. econstructor; eauto. + exploit eval_simpl_expr; eauto. intros [tv [A B]]. + inversion B. subst. + econstructor; econstructor; split; eauto. econstructor; eauto. (* field struct *) rewrite <- comp_env_preserved in *. - exploit eval_simpl_expr; eauto. intros [tv [A B]]. - inversion B. subst. - econstructor; econstructor; split. - eapply eval_Efield_struct; eauto. rewrite typeof_simpl_expr; eauto. + exploit eval_simpl_expr; eauto. intros [tv [A B]]. + inversion B. subst. + econstructor; econstructor; split. + eapply eval_Efield_struct; eauto. rewrite typeof_simpl_expr; eauto. econstructor; eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. (* field union *) rewrite <- comp_env_preserved in *. - exploit eval_simpl_expr; eauto. intros [tv [A B]]. - inversion B. subst. - econstructor; econstructor; split. + exploit eval_simpl_expr; eauto. intros [tv [A B]]. + inversion B. subst. + econstructor; econstructor; split. eapply eval_Efield_union; eauto. rewrite typeof_simpl_expr; eauto. auto. Qed. @@ -1628,7 +1628,7 @@ Proof. exploit eval_simpl_expr; eauto with compat. intros [tv1 [A B]]. exploit sem_cast_inject; eauto. intros [tv2 [C D]]. exploit IHeval_exprlist; eauto with compat. intros [E [tvl [F G]]]. - split. constructor; auto. eapply cast_val_is_casted; eauto. + split. constructor; auto. eapply cast_val_is_casted; eauto. exists (tv2 :: tvl); split. econstructor; eauto. rewrite typeof_simpl_expr; auto. econstructor; eauto. @@ -1689,11 +1689,11 @@ Proof. assert (f b1 = Some (b2, delta)). rewrite <- H; symmetry; eapply INJ2; eauto. xomega. eapply IMAGE; eauto. (* call *) - eapply match_envs_invariant; eauto. + eapply match_envs_invariant; eauto. intros. apply LOAD; auto. xomega. intros. apply INJ1; auto; xomega. intros. eapply INJ2; eauto; xomega. - eapply IHmatch_cont; eauto. + eapply IHmatch_cont; eauto. intros; apply LOAD; auto. inv H0; xomega. intros; apply INJ1. inv H0; xomega. intros; eapply INJ2; eauto. inv H0; xomega. @@ -1711,7 +1711,7 @@ Proof. intros. eapply match_cont_invariant; eauto. intros. rewrite <- H4. inv H0. (* scalar *) - simpl in H6. eapply Mem.load_store_other; eauto. left. unfold block; xomega. + simpl in H6. eapply Mem.load_store_other; eauto. left. unfold block; xomega. (* block copy *) eapply Mem.load_storebytes_other; eauto. left. unfold block; xomega. Qed. @@ -1727,12 +1727,12 @@ Lemma match_cont_extcall: Ple bound (Mem.nextblock m) -> Ple tbound (Mem.nextblock tm) -> match_cont f' cenv k tk m' bound tbound. Proof. - intros. eapply match_cont_invariant; eauto. - intros. eapply Mem.load_unchanged_on; eauto. - red in H2. intros. destruct (f b) as [[b' delta] | ] eqn:?. auto. - destruct (f' b) as [[b' delta] | ] eqn:?; auto. + intros. eapply match_cont_invariant; eauto. + intros. eapply Mem.load_unchanged_on; eauto. + red in H2. intros. destruct (f b) as [[b' delta] | ] eqn:?. auto. + destruct (f' b) as [[b' delta] | ] eqn:?; auto. exploit H2; eauto. unfold Mem.valid_block. intros [A B]. xomegaContradiction. - red in H2. intros. destruct (f b) as [[b'' delta''] | ] eqn:?. auto. + red in H2. intros. destruct (f b) as [[b'' delta''] | ] eqn:?. auto. exploit H2; eauto. unfold Mem.valid_block. intros [A B]. xomegaContradiction. Qed. @@ -1765,7 +1765,7 @@ Lemma match_cont_is_call_cont: is_call_cont k -> is_call_cont tk. Proof. - intros. inv H; auto. + intros. inv H; auto. Qed. Lemma match_cont_call_cont: @@ -1786,7 +1786,7 @@ Proof. induction l; simpl; intros. congruence. destruct a. destruct p. destruct (Mem.free m b z0 z) as [m1|] eqn:?; try discriminate. - transitivity (Mem.nextblock m1). eauto. eapply Mem.nextblock_free; eauto. + transitivity (Mem.nextblock m1). eauto. eapply Mem.nextblock_free; eauto. Qed. Remark free_list_load: @@ -1798,7 +1798,7 @@ Proof. induction l; simpl; intros. inv H; auto. destruct a. destruct p. destruct (Mem.free m b z0 z) as [m1|] eqn:?; try discriminate. - transitivity (Mem.load chunk m1 b' 0). eauto. + transitivity (Mem.load chunk m1 b' 0). eauto. eapply Mem.load_free. eauto. left. assert (Plt b' b) by eauto. unfold block; xomega. Qed. @@ -1813,10 +1813,10 @@ Lemma match_cont_free_env: match_cont f cenv k tk m' (Mem.nextblock m') (Mem.nextblock tm'). Proof. intros. apply match_cont_incr_bounds with lo tlo. - eapply match_cont_invariant; eauto. - intros. rewrite <- H7. eapply free_list_load; eauto. - unfold blocks_of_env; intros. exploit list_in_map_inv; eauto. - intros [[id [b1 ty]] [P Q]]. simpl in P. inv P. + eapply match_cont_invariant; eauto. + intros. rewrite <- H7. eapply free_list_load; eauto. + unfold blocks_of_env; intros. exploit list_in_map_inv; eauto. + intros [[id [b1 ty]] [P Q]]. simpl in P. inv P. exploit me_range; eauto. eapply PTree.elements_complete; eauto. xomega. rewrite (free_list_nextblock _ _ _ H3). inv H; xomega. rewrite (free_list_nextblock _ _ _ H4). inv H; xomega. @@ -1829,7 +1829,7 @@ Lemma match_cont_globalenv: match_cont f cenv k tk m bound tbound -> exists bound, match_globalenvs f bound. Proof. - induction 1; auto. exists hi; auto. + induction 1; auto. exists hi; auto. Qed. Hint Resolve match_cont_globalenv: compat. @@ -1844,8 +1844,8 @@ Proof. intros. exploit match_cont_globalenv; eauto. intros [bound1 MG]. destruct MG. inv H1; simpl in H0; try discriminate. destruct (Int.eq_dec ofs1 Int.zero); try discriminate. subst ofs1. - assert (f b1 = Some(b1, 0)). - apply DOMAIN. eapply FUNCTIONS; eauto. + assert (f b1 = Some(b1, 0)). + apply DOMAIN. eapply FUNCTIONS; eauto. rewrite H1 in H2; inv H2. rewrite Int.add_zero. simpl. rewrite dec_eq_true. apply function_ptr_translated; auto. Qed. @@ -1893,8 +1893,8 @@ Remark is_liftable_var_charact: end. Proof. intros. destruct a; simpl; auto. - destruct (VSet.mem i cenv) eqn:?. - exists t; auto. + destruct (VSet.mem i cenv) eqn:?. + exists t; auto. auto. Qed. @@ -1905,13 +1905,13 @@ Remark simpl_select_switch: Proof. intros cenv n. assert (DFL: - forall ls tls, + forall ls tls, simpl_lblstmt cenv ls = OK tls -> simpl_lblstmt cenv (select_switch_default ls) = OK (select_switch_default tls)). { - induction ls; simpl; intros; monadInv H. + induction ls; simpl; intros; monadInv H. auto. - simpl. destruct o. eauto. simpl; rewrite EQ, EQ1. auto. + simpl. destruct o. eauto. simpl; rewrite EQ, EQ1. auto. } assert (CASE: forall ls tls, @@ -1924,14 +1924,14 @@ Proof. { induction ls; simpl; intros; monadInv H; simpl. auto. - destruct o. + destruct o. destruct (zeq z n). econstructor; split; eauto. simpl; rewrite EQ, EQ1; auto. - apply IHls. auto. + apply IHls. auto. apply IHls. auto. } - intros; unfold select_switch. - specialize (CASE _ _ H). destruct (select_switch_case n ls) as [ls'|]. + intros; unfold select_switch. + specialize (CASE _ _ H). destruct (select_switch_case n ls) as [ls'|]. destruct CASE as [tls' [P Q]]. rewrite P, Q. auto. rewrite CASE. apply DFL; auto. Qed. @@ -1956,7 +1956,7 @@ Proof. compat_cenv (addr_taken_lblstmt ls) cenv -> compat_cenv (addr_taken_lblstmt (select_switch_default ls)) cenv). { - induction ls; simpl; intros. + induction ls; simpl; intros. eauto with compat. destruct o; simpl; eauto with compat. } @@ -1967,11 +1967,11 @@ Proof. { induction ls; simpl; intros. discriminate. - destruct o. destruct (zeq z n). inv H0. auto. eauto with compat. + destruct o. destruct (zeq z n). inv H0. auto. eauto with compat. eauto with compat. } - intros. specialize (CASE ls). unfold select_switch. - destruct (select_switch_case n ls) as [ls'|]; eauto. + intros. specialize (CASE ls). unfold select_switch. + destruct (select_switch_case n ls) as [ls'|]; eauto. Qed. Remark addr_taken_seq_of_labeled_statement: @@ -1997,7 +1997,7 @@ Lemma simpl_find_label: | None => find_label lbl ts tk = None | Some(s', k') => - exists ts', exists tk', + exists ts', exists tk', find_label lbl ts tk = Some(ts', tk') /\ compat_cenv (addr_taken_stmt s') cenv /\ simpl_stmt cenv s' = OK ts' @@ -2013,7 +2013,7 @@ with simpl_find_label_ls: | None => find_label_ls lbl tls tk = None | Some(s', k') => - exists ts', exists tk', + exists ts', exists tk', find_label_ls lbl tls tk = Some(ts', tk') /\ compat_cenv (addr_taken_stmt s') cenv /\ simpl_stmt cenv s' = OK ts' @@ -2025,8 +2025,8 @@ Proof. (* skip *) monadInv TS; auto. (* var *) - destruct (is_liftable_var cenv e); monadInv TS; auto. - unfold Sset_debug. destruct (Compopts.debug tt); auto. + destruct (is_liftable_var cenv e); monadInv TS; auto. + unfold Sset_debug. destruct (Compopts.debug tt); auto. (* set *) monadInv TS; auto. (* call *) @@ -2035,23 +2035,23 @@ Proof. monadInv TS; auto. (* seq *) monadInv TS. - exploit (IHs1 (Kseq s2 k) x (Kseq x0 tk)); eauto with compat. + exploit (IHs1 (Kseq s2 k) x (Kseq x0 tk)); eauto with compat. constructor; eauto with compat. - destruct (find_label lbl s1 (Kseq s2 k)) as [[s' k']|]. + destruct (find_label lbl s1 (Kseq s2 k)) as [[s' k']|]. intros [ts' [tk' [P [Q [R S]]]]]. exists ts'; exists tk'. simpl. rewrite P. auto. intros E. simpl. rewrite E. eapply IHs2; eauto with compat. (* ifthenelse *) monadInv TS. - exploit (IHs1 k x tk); eauto with compat. - destruct (find_label lbl s1 k) as [[s' k']|]. - intros [ts' [tk' [P [Q [R S]]]]]. exists ts'; exists tk'. simpl. rewrite P. auto. + exploit (IHs1 k x tk); eauto with compat. + destruct (find_label lbl s1 k) as [[s' k']|]. + intros [ts' [tk' [P [Q [R S]]]]]. exists ts'; exists tk'. simpl. rewrite P. auto. intros E. simpl. rewrite E. eapply IHs2; eauto with compat. (* loop *) monadInv TS. exploit (IHs1 (Kloop1 s1 s2 k) x (Kloop1 x x0 tk)); eauto with compat. constructor; eauto with compat. - destruct (find_label lbl s1 (Kloop1 s1 s2 k)) as [[s' k']|]. - intros [ts' [tk' [P [Q [R S]]]]]. exists ts'; exists tk'. simpl; rewrite P. auto. + destruct (find_label lbl s1 (Kloop1 s1 s2 k)) as [[s' k']|]. + intros [ts' [tk' [P [Q [R S]]]]]. exists ts'; exists tk'. simpl; rewrite P. auto. intros E. simpl; rewrite E. eapply IHs2; eauto with compat. econstructor; eauto with compat. (* break *) monadInv TS; auto. @@ -2078,7 +2078,7 @@ Proof. exploit (simpl_find_label s (Kseq (seq_of_labeled_statement ls) k)). eauto. constructor. eapply simpl_seq_of_labeled_statement; eauto. eauto. rewrite addr_taken_seq_of_labeled_statement. eauto with compat. - eauto with compat. + eauto with compat. destruct (find_label lbl s (Kseq (seq_of_labeled_statement ls) k)) as [[s' k']|]. intros [ts' [tk' [P [Q [R S]]]]]. exists ts'; exists tk'; split. simpl; rewrite P. auto. auto. intros E. simpl; rewrite E. eapply IHls; eauto with compat. @@ -2087,25 +2087,25 @@ Qed. Lemma find_label_store_params: forall s k params, find_label lbl (store_params cenv params s) k = find_label lbl s k. Proof. - induction params; simpl. auto. - destruct a as [id ty]. destruct (VSet.mem id cenv); auto. + induction params; simpl. auto. + destruct a as [id ty]. destruct (VSet.mem id cenv); auto. Qed. Lemma find_label_add_debug_vars: forall s k vars, find_label lbl (add_debug_vars vars s) k = find_label lbl s k. Proof. - unfold add_debug_vars. destruct (Compopts.debug tt); auto. - induction vars; simpl; auto. destruct a as [id ty]; simpl. auto. + unfold add_debug_vars. destruct (Compopts.debug tt); auto. + induction vars; simpl; auto. destruct a as [id ty]; simpl. auto. Qed. Lemma find_label_add_debug_params: forall s k vars, find_label lbl (add_debug_params vars s) k = find_label lbl s k. Proof. - unfold add_debug_params. destruct (Compopts.debug tt); auto. - induction vars; simpl; auto. destruct a as [id ty]; simpl. auto. + unfold add_debug_params. destruct (Compopts.debug tt); auto. + induction vars; simpl; auto. destruct a as [id ty]; simpl. auto. Qed. -End FIND_LABEL. +End FIND_LABEL. Lemma step_simulation: @@ -2120,40 +2120,40 @@ Proof. intros [ty [P Q]]; subst a1; simpl in *. exploit eval_simpl_expr; eauto with compat. intros [tv2 [A B]]. exploit sem_cast_inject; eauto. intros [tv [C D]]. - exploit me_vars; eauto. instantiate (1 := id). intros MV. + exploit me_vars; eauto. instantiate (1 := id). intros MV. inv H. (* local variable *) econstructor; split. - eapply step_Sset_debug. eauto. rewrite typeof_simpl_expr. eauto. - econstructor; eauto with compat. + eapply step_Sset_debug. eauto. rewrite typeof_simpl_expr. eauto. + econstructor; eauto with compat. eapply match_envs_assign_lifted; eauto. eapply cast_val_is_casted; eauto. eapply match_cont_assign_loc; eauto. exploit me_range; eauto. xomega. inv MV; try congruence. inv H2; try congruence. unfold Mem.storev in H3. - eapply Mem.store_unmapped_inject; eauto. congruence. + eapply Mem.store_unmapped_inject; eauto. congruence. erewrite assign_loc_nextblock; eauto. (* global variable *) inv MV; congruence. (* not liftable *) - intros P. - exploit eval_simpl_lvalue; eauto with compat. intros [tb [tofs [E F]]]. + intros P. + exploit eval_simpl_lvalue; eauto with compat. intros [tb [tofs [E F]]]. exploit eval_simpl_expr; eauto with compat. intros [tv2 [A B]]. exploit sem_cast_inject; eauto. intros [tv [C D]]. - exploit assign_loc_inject; eauto. intros [tm' [X [Y Z]]]. + exploit assign_loc_inject; eauto. intros [tm' [X [Y Z]]]. econstructor; split. - apply plus_one. econstructor. eexact E. eexact A. repeat rewrite typeof_simpl_expr. eexact C. + apply plus_one. econstructor. eexact E. eexact A. repeat rewrite typeof_simpl_expr. eexact C. rewrite typeof_simpl_expr; auto. eexact X. - econstructor; eauto with compat. - eapply match_envs_invariant; eauto. - eapply match_cont_invariant; eauto. + econstructor; eauto with compat. + eapply match_envs_invariant; eauto. + eapply match_cont_invariant; eauto. erewrite assign_loc_nextblock; eauto. erewrite assign_loc_nextblock; eauto. (* set temporary *) exploit eval_simpl_expr; eauto with compat. intros [tv [A B]]. econstructor; split. - apply plus_one. econstructor. eauto. - econstructor; eauto with compat. - eapply match_envs_set_temp; eauto. + apply plus_one. econstructor. eauto. + econstructor; eauto with compat. + eapply match_envs_set_temp; eauto. (* call *) exploit eval_simpl_expr; eauto with compat. intros [tvf [A B]]. @@ -2162,9 +2162,9 @@ Proof. econstructor; split. apply plus_one. eapply step_call with (fd := tfd). rewrite typeof_simpl_expr. eauto. - eauto. eauto. eauto. + eauto. eauto. eauto. erewrite type_of_fundef_preserved; eauto. - econstructor; eauto. + econstructor; eauto. intros. econstructor; eauto. (* builtin *) @@ -2172,13 +2172,13 @@ Proof. exploit external_call_mem_inject; eauto. apply match_globalenvs_preserves_globals; eauto with compat. intros [j' [tvres [tm' [P [Q [R [S [T [U V]]]]]]]]]. econstructor; split. - apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved; eauto. + apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. econstructor; eauto with compat. - eapply match_envs_set_opttemp; eauto. - eapply match_envs_extcall; eauto. + eapply match_envs_set_opttemp; eauto. + eapply match_envs_extcall; eauto. eapply match_cont_extcall; eauto. - inv MENV; xomega. inv MENV; xomega. + inv MENV; xomega. inv MENV; xomega. eapply Ple_trans; eauto. eapply external_call_nextblock; eauto. eapply Ple_trans; eauto. eapply external_call_nextblock; eauto. @@ -2187,11 +2187,11 @@ Proof. econstructor; eauto with compat. econstructor; eauto with compat. (* skip sequence *) - inv MCONT. econstructor; split. apply plus_one. econstructor. econstructor; eauto. + inv MCONT. econstructor; split. apply plus_one. econstructor. econstructor; eauto. (* continue sequence *) inv MCONT. econstructor; split. apply plus_one. econstructor. econstructor; eauto. - + (* break sequence *) inv MCONT. econstructor; split. apply plus_one. econstructor. econstructor; eauto. @@ -2207,25 +2207,25 @@ Proof. (* skip-or-continue loop *) inv MCONT. econstructor; split. - apply plus_one. econstructor. destruct H; subst x; simpl in *; intuition congruence. + apply plus_one. econstructor. destruct H; subst x; simpl in *; intuition congruence. econstructor; eauto with compat. econstructor; eauto with compat. (* break loop1 *) - inv MCONT. econstructor; split. apply plus_one. eapply step_break_loop1. + inv MCONT. econstructor; split. apply plus_one. eapply step_break_loop1. econstructor; eauto. (* skip loop2 *) - inv MCONT. econstructor; split. apply plus_one. eapply step_skip_loop2. - econstructor; eauto with compat. simpl; rewrite H2; rewrite H4; auto. + inv MCONT. econstructor; split. apply plus_one. eapply step_skip_loop2. + econstructor; eauto with compat. simpl; rewrite H2; rewrite H4; auto. (* break loop2 *) - inv MCONT. econstructor; split. apply plus_one. eapply step_break_loop2. + inv MCONT. econstructor; split. apply plus_one. eapply step_break_loop2. econstructor; eauto. (* return none *) exploit match_envs_free_blocks; eauto. intros [tm' [P Q]]. - econstructor; split. apply plus_one. econstructor; eauto. - econstructor; eauto. + econstructor; split. apply plus_one. econstructor; eauto. + econstructor; eauto. intros. eapply match_cont_call_cont. eapply match_cont_free_env; eauto. (* return some *) @@ -2234,7 +2234,7 @@ Proof. exploit match_envs_free_blocks; eauto. intros [tm' [P Q]]. econstructor; split. apply plus_one. econstructor; eauto. rewrite typeof_simpl_expr. monadInv TRF; simpl. eauto. - econstructor; eauto. + econstructor; eauto. intros. eapply match_cont_call_cont. eapply match_cont_free_env; eauto. (* skip call *) @@ -2242,29 +2242,29 @@ Proof. econstructor; split. apply plus_one. econstructor; eauto. eapply match_cont_is_call_cont; eauto. monadInv TRF; auto. - econstructor; eauto. + econstructor; eauto. intros. apply match_cont_change_cenv with (cenv_for f); auto. eapply match_cont_free_env; eauto. (* switch *) exploit eval_simpl_expr; eauto with compat. intros [tv [A B]]. econstructor; split. apply plus_one. econstructor; eauto. - rewrite typeof_simpl_expr. instantiate (1 := n). + rewrite typeof_simpl_expr. instantiate (1 := n). unfold sem_switch_arg in *; destruct (classify_switch (typeof a)); try discriminate; inv B; inv H0; auto. - econstructor; eauto. + econstructor; eauto. erewrite simpl_seq_of_labeled_statement. reflexivity. - eapply simpl_select_switch; eauto. - econstructor; eauto. rewrite addr_taken_seq_of_labeled_statement. + eapply simpl_select_switch; eauto. + econstructor; eauto. rewrite addr_taken_seq_of_labeled_statement. apply compat_cenv_select_switch. eauto with compat. (* skip-break switch *) - inv MCONT. econstructor; split. - apply plus_one. eapply step_skip_break_switch. destruct H; subst x; simpl in *; intuition congruence. + inv MCONT. econstructor; split. + apply plus_one. eapply step_skip_break_switch. destruct H; subst x; simpl in *; intuition congruence. econstructor; eauto with compat. (* continue switch *) - inv MCONT. econstructor; split. + inv MCONT. econstructor; split. apply plus_one. eapply step_continue_switch. econstructor; eauto with compat. @@ -2272,18 +2272,18 @@ Proof. econstructor; split. apply plus_one. econstructor. econstructor; eauto. (* goto *) - generalize TRF; intros TRF'. monadInv TRF'. + generalize TRF; intros TRF'. monadInv TRF'. exploit (simpl_find_label j (cenv_for f) m lo tlo lbl (fn_body f) (call_cont k) x (call_cont tk)). - eauto. eapply match_cont_call_cont. eauto. + eauto. eapply match_cont_call_cont. eauto. apply compat_cenv_for. - rewrite H. intros [ts' [tk' [A [B [C D]]]]]. + rewrite H. intros [ts' [tk' [A [B [C D]]]]]. econstructor; split. apply plus_one. econstructor; eauto. simpl. rewrite find_label_add_debug_params. rewrite find_label_store_params. rewrite find_label_add_debug_vars. eexact A. econstructor; eauto. (* internal function *) - monadInv TRFD. inv H. + monadInv TRFD. inv H. generalize EQ; intro EQ'; monadInv EQ'. assert (list_norepet (var_names (fn_params f ++ fn_vars f))). unfold var_names. rewrite map_app. auto. @@ -2295,10 +2295,10 @@ Proof. assert (K: list_forall2 val_casted vargs (map snd (fn_params f))). { apply val_casted_list_params. unfold type_of_function in FUNTY. congruence. } exploit store_params_correct. - eauto. + eauto. eapply list_norepet_append_left; eauto. eexact K. - apply val_inject_list_incr with j'; eauto. + apply val_inject_list_incr with j'; eauto. eexact B. eexact C. intros. apply (create_undef_temps_lifted id f). auto. intros. destruct (create_undef_temps (fn_temps f))!id as [v|] eqn:?; auto. @@ -2307,34 +2307,34 @@ Proof. change (cenv_for_gen (addr_taken_stmt (fn_body f)) (fn_params f ++ fn_vars f)) with (cenv_for f) in *. generalize (vars_and_temps_properties (cenv_for f) (fn_params f) (fn_vars f) (fn_temps f)). - intros [X [Y Z]]. auto. auto. - econstructor; split. - eapply plus_left. econstructor. + intros [X [Y Z]]. auto. auto. + econstructor; split. + eapply plus_left. econstructor. econstructor. exact Y. exact X. exact Z. simpl. eexact A. simpl. eexact Q. simpl. eapply star_trans. eapply step_add_debug_params. auto. eapply forall2_val_casted_inject; eauto. eexact Q. - eapply star_trans. eexact P. eapply step_add_debug_vars. - unfold remove_lifted; intros. rewrite List.filter_In in H3. destruct H3. - apply negb_true_iff in H4. eauto. + eapply star_trans. eexact P. eapply step_add_debug_vars. + unfold remove_lifted; intros. rewrite List.filter_In in H3. destruct H3. + apply negb_true_iff in H4. eauto. reflexivity. reflexivity. traceEq. - econstructor; eauto. - eapply match_cont_invariant; eauto. - intros. transitivity (Mem.load chunk m0 b 0). - eapply bind_parameters_load; eauto. intros. - exploit alloc_variables_range. eexact H1. eauto. - unfold empty_env. rewrite PTree.gempty. intros [?|?]. congruence. - red; intros; subst b'. xomega. + econstructor; eauto. + eapply match_cont_invariant; eauto. + intros. transitivity (Mem.load chunk m0 b 0). + eapply bind_parameters_load; eauto. intros. + exploit alloc_variables_range. eexact H1. eauto. + unfold empty_env. rewrite PTree.gempty. intros [?|?]. congruence. + red; intros; subst b'. xomega. eapply alloc_variables_load; eauto. - apply compat_cenv_for. + apply compat_cenv_for. rewrite (bind_parameters_nextblock _ _ _ _ _ _ H2). xomega. rewrite T; xomega. (* external function *) - monadInv TRFD. inv FUNTY. - exploit external_call_mem_inject; eauto. apply match_globalenvs_preserves_globals. - eapply match_cont_globalenv. eexact (MCONT VSet.empty). + monadInv TRFD. inv FUNTY. + exploit external_call_mem_inject; eauto. apply match_globalenvs_preserves_globals. + eapply match_cont_globalenv. eexact (MCONT VSet.empty). intros [j' [tvres [tm' [P [Q [R [S [T [U V]]]]]]]]]. econstructor; split. - apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved; eauto. + apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. econstructor; eauto. intros. apply match_cont_incr_bounds with (Mem.nextblock m) (Mem.nextblock tm). @@ -2343,9 +2343,9 @@ Proof. eapply external_call_nextblock; eauto. (* return *) - specialize (MCONT (cenv_for f)). inv MCONT. + specialize (MCONT (cenv_for f)). inv MCONT. econstructor; split. - apply plus_one. econstructor. + apply plus_one. econstructor. econstructor; eauto with compat. eapply match_envs_set_opttemp; eauto. Qed. @@ -2355,20 +2355,20 @@ Lemma initial_states_simulation: exists R, initial_state tprog R /\ match_states S R. Proof. intros. inv H. - exploit function_ptr_translated; eauto. intros [tf [A B]]. + exploit function_ptr_translated; eauto. intros [tf [A B]]. econstructor; split. econstructor. - eapply Genv.init_mem_transf_partial. eexact transf_programs. eauto. - change (prog_main tprog) with (AST.prog_main tprog). + eapply Genv.init_mem_transf_partial. eexact transf_programs. eauto. + change (prog_main tprog) with (AST.prog_main tprog). rewrite (transform_partial_program_main _ _ transf_programs). instantiate (1 := b). rewrite <- H1. apply symbols_preserved. eauto. rewrite <- H3; apply type_of_fundef_preserved; auto. - econstructor; eauto. - intros. instantiate (1 := Mem.flat_inj (Mem.nextblock m0)). - econstructor. instantiate (1 := Mem.nextblock m0). - constructor; intros. - unfold Mem.flat_inj. apply pred_dec_true; auto. + econstructor; eauto. + intros. instantiate (1 := Mem.flat_inj (Mem.nextblock m0)). + econstructor. instantiate (1 := Mem.nextblock m0). + constructor; intros. + unfold Mem.flat_inj. apply pred_dec_true; auto. unfold Mem.flat_inj in H. destruct (plt b1 (Mem.nextblock m0)); inv H. auto. eapply Genv.find_symbol_not_fresh; eauto. eapply Genv.find_funct_ptr_not_fresh; eauto. @@ -2383,7 +2383,7 @@ Lemma final_states_simulation: match_states S R -> final_state S r -> final_state R r. Proof. intros. inv H0. inv H. - specialize (MCONT VSet.empty). inv MCONT. + specialize (MCONT VSet.empty). inv MCONT. inv RINJ. constructor. Qed. diff --git a/checklink/Asm_printers.ml b/checklink/Asm_printers.ml index 38a420f6..112c72d0 100644 --- a/checklink/Asm_printers.ml +++ b/checklink/Asm_printers.ml @@ -303,7 +303,7 @@ let string_of_instruction = function | Pxoris (i0, i1, c2) -> "Pxoris(" ^ string_of_ireg i0 ^ ", " ^ string_of_ireg i1 ^ ", " ^ string_of_constant c2 ^ ")" | Plabel (l0) -> "Plabel(" ^ string_of_label l0 ^ ")" | Pbuiltin (e0, p1, p2) -> "Pbuiltin(" ^ string_of_external_function e0 ^ ", " ^ string_of_list string_of_preg ", " p1 ^ ", " ^ string_of_list string_of_preg ", " p2 ^ ")" -| Pannot (e0, a1) -> +| Pannot (e0, a1) -> let sp_reg_name = string_of_external_function e0 in "Pannot(" ^ string_of_external_function e0 ^ ", " ^ string_of_list (string_of_annot_param sp_reg_name) ", " a1 ^ ")" | Pcfi_adjust n -> "Pcfi_adjust(" ^ string_of_coq_Z n ^ ")" diff --git a/checklink/Check.ml b/checklink/Check.ml index 0e69ab72..b2b9077c 100644 --- a/checklink/Check.ml +++ b/checklink/Check.ml @@ -421,7 +421,7 @@ let match_csts (cc: constant) (ec: int32): checker = fun ffw -> ^ Hashtbl.find ffw.sf.ident_to_name ident) | Csymbol_rel_low (ident, i) | Csymbol_rel_high (ident, i) -> (* should be handled separately in places it occurs *) - ERR("Incorrect reference to far-data symbol " + ERR("Incorrect reference to far-data symbol " ^ Hashtbl.find ffw.sf.ident_to_name ident) let match_z_int32 (cz: Z.t) (ei: int32) = @@ -847,7 +847,7 @@ let rec compare_code ccode ecode pc: checker = fun fw -> let lblvaddr = Int32.(add pc (mul 4l (exts bd))) in OK(fw) >>= match_ints 0 bi - >>= lblmap_unify lbl lblvaddr + >>= lblmap_unify lbl lblvaddr >>= match_bools false aa >>= match_bools false lk >>= recur_simpl @@ -1719,7 +1719,7 @@ let rec compare_code ccode ecode pc: checker = fun fw -> >>= match_iregs rd rD0 >>= recur_simpl | _ -> error - end + end | Pmfcrbit(rd, bit) -> error | Pmflr(r) -> diff --git a/checklink/Fuzz.ml b/checklink/Fuzz.ml index dc984934..0d091c18 100644 --- a/checklink/Fuzz.ml +++ b/checklink/Fuzz.ml @@ -10,7 +10,7 @@ let string_of_byte = Printf.sprintf "0x%02x" let full_range_of_byte elfmap byte = let byte = Int32.of_int byte in - List.find (fun (a, b, _, _) -> a <= byte && byte <= b) elfmap + List.find (fun (a, b, _, _) -> a <= byte && byte <= b) elfmap let range_of_byte elfmap byte = let (_, _, _, r) = full_range_of_byte elfmap byte in diff --git a/common/AST.v b/common/AST.v index c62b0091..16673c47 100644 --- a/common/AST.v +++ b/common/AST.v @@ -121,7 +121,7 @@ Definition proj_sig_res (s: signature) : typ := Definition signature_eq: forall (s1 s2: signature), {s1=s2} + {s1<>s2}. Proof. generalize opt_typ_eq, list_typ_eq; intros; decide equality. - generalize bool_dec; intros. decide equality. + generalize bool_dec; intros. decide equality. Defined. Global Opaque signature_eq. @@ -255,14 +255,14 @@ Lemma transform_program_function: exists f, In (i, Gfun f) p.(prog_defs) /\ transf f = tf. Proof. simpl. unfold transform_program. intros. - exploit list_in_map_inv; eauto. - intros [[i' gd] [EQ IN]]. simpl in EQ. destruct gd; inv EQ. + exploit list_in_map_inv; eauto. + intros [[i' gd] [EQ IN]]. simpl in EQ. destruct gd; inv EQ. exists f; auto. Qed. End TRANSF_PROGRAM. -(** General iterator over program that applies a given code transfomration +(** General iterator over program that applies a given code transfomration function to all function descriptions with their identifers and leaves teh other parts of the program unchanged. *) @@ -289,18 +289,18 @@ Lemma tranforma_program_function_ident: exists f, In (i, Gfun f) p.(prog_defs) /\ transf i f = tf. Proof. simpl. unfold transform_program_ident. intros. - exploit list_in_map_inv; eauto. - intros [[i' gd] [EQ IN]]. simpl in EQ. destruct gd; inv EQ. + exploit list_in_map_inv; eauto. + intros [[i' gd] [EQ IN]]. simpl in EQ. destruct gd; inv EQ. exists f; auto. Qed. End TRANSF_PROGRAM_IDENT. -(** The following is a more general presentation of [transform_program] where +(** The following is a more general presentation of [transform_program] where global variable information can be transformed, in addition to function definitions. Moreover, the transformation functions can fail and return an error message. Also the transformation functions are defined - for the case the identifier of the function is passed as additional + for the case the identifier of the function is passed as additional argument *) Local Open Scope error_monad_scope. @@ -338,7 +338,7 @@ Fixpoint transf_globdefs (l: list (ident * globdef A V)) : res (list (ident * gl end end. -Fixpoint transf_globdefs_ident (l: list (ident * globdef A V)) : res (list (ident * globdef B W)) := +Fixpoint transf_globdefs_ident (l: list (ident * globdef A V)) : res (list (ident * globdef B W)) := match l with | nil => OK nil | (id, Gfun f) :: l' => @@ -369,12 +369,12 @@ Lemma transform_partial_program2_function: In (i, Gfun tf) tp.(prog_defs) -> exists f, In (i, Gfun f) p.(prog_defs) /\ transf_fun f = OK tf. Proof. - intros. monadInv H. simpl in H0. + intros. monadInv H. simpl in H0. revert x EQ H0. induction (prog_defs p); simpl; intros. inv EQ. contradiction. destruct a as [id [f|v]]. destruct (transf_fun f) as [tf1|msg] eqn:?; monadInv EQ. - simpl in H0; destruct H0. inv H. exists f; auto. + simpl in H0; destruct H0. inv H. exists f; auto. exploit IHl; eauto. intros [f' [P Q]]; exists f'; auto. destruct (transf_globvar v) as [tv1|msg] eqn:?; monadInv EQ. simpl in H0; destruct H0. inv H. @@ -387,12 +387,12 @@ Lemma transform_partial_ident_program2_function: In (i, Gfun tf) tp.(prog_defs) -> exists f, In (i, Gfun f) p.(prog_defs) /\ transf_fun_ident i f = OK tf. Proof. - intros. monadInv H. simpl in H0. + intros. monadInv H. simpl in H0. revert x EQ H0. induction (prog_defs p); simpl; intros. inv EQ. contradiction. destruct a as [id [f|v]]. destruct (transf_fun_ident id f) as [tf1|msg] eqn:?; monadInv EQ. - simpl in H0; destruct H0. inv H. exists f; auto. + simpl in H0; destruct H0. inv H. exists f; auto. exploit IHl; eauto. intros [f' [P Q]]; exists f'; auto. destruct (transf_globvar_ident id v) as [tv1|msg] eqn:?; monadInv EQ. simpl in H0; destruct H0. inv H. @@ -407,7 +407,7 @@ Lemma transform_partial_program2_variable: In (i, Gvar(mkglobvar v tv.(gvar_init) tv.(gvar_readonly) tv.(gvar_volatile))) p.(prog_defs) /\ transf_var v = OK tv.(gvar_info). Proof. - intros. monadInv H. simpl in H0. + intros. monadInv H. simpl in H0. revert x EQ H0. induction (prog_defs p); simpl; intros. inv EQ. contradiction. destruct a as [id [f|v]]. @@ -429,7 +429,7 @@ Lemma transform_partial_ident_program2_variable: In (i, Gvar(mkglobvar v tv.(gvar_init) tv.(gvar_readonly) tv.(gvar_volatile))) p.(prog_defs) /\ transf_var_ident i v = OK tv.(gvar_info). Proof. - intros. monadInv H. simpl in H0. + intros. monadInv H. simpl in H0. revert x EQ H0. induction (prog_defs p); simpl; intros. inv EQ. contradiction. destruct a as [id [f|v]]. @@ -451,11 +451,11 @@ Lemma transform_partial_program2_succeeds: | Gvar gv => exists tv, transf_var gv.(gvar_info) = OK tv end. Proof. - intros. monadInv H. + intros. monadInv H. revert x EQ H0. induction (prog_defs p); simpl; intros. contradiction. destruct a as [id1 g1]. destruct g1. - destruct (transf_fun f) eqn:TF; try discriminate. monadInv EQ. + destruct (transf_fun f) eqn:TF; try discriminate. monadInv EQ. destruct H0. inv H. econstructor; eauto. eapply IHl; eauto. destruct (transf_globvar v) eqn:TV; try discriminate. monadInv EQ. destruct H0. inv H. monadInv TV. econstructor; eauto. eapply IHl; eauto. @@ -470,11 +470,11 @@ Lemma transform_partial_ident_program2_succeeds: | Gvar gv => exists tv, transf_var_ident i gv.(gvar_info) = OK tv end. Proof. - intros. monadInv H. + intros. monadInv H. revert x EQ H0. induction (prog_defs p); simpl; intros. contradiction. destruct a as [id1 g1]. destruct g1. - destruct (transf_fun_ident id1 f) eqn:TF; try discriminate. monadInv EQ. + destruct (transf_fun_ident id1 f) eqn:TF; try discriminate. monadInv EQ. destruct H0. inv H. econstructor; eauto. eapply IHl; eauto. destruct (transf_globvar_ident id1 v) eqn:TV; try discriminate. monadInv EQ. destruct H0. inv H. monadInv TV. econstructor; eauto. eapply IHl; eauto. @@ -621,7 +621,7 @@ Lemma transform_partial_program_function: In (i, Gfun tf) tp.(prog_defs) -> exists f, In (i, Gfun f) p.(prog_defs) /\ transf_partial f = OK tf. Proof. - apply transform_partial_program2_function. + apply transform_partial_program2_function. Qed. Lemma transform_partial_ident_program_function: @@ -630,7 +630,7 @@ Lemma transform_partial_ident_program_function: In (i, Gfun tf) tp.(prog_defs) -> exists f, In (i, Gfun f) p.(prog_defs) /\ transf_partial_ident i f = OK tf. Proof. - apply transform_partial_ident_program2_function. + apply transform_partial_ident_program2_function. Qed. Lemma transform_partial_program_succeeds: @@ -639,8 +639,8 @@ Lemma transform_partial_program_succeeds: In (i, Gfun fd) p.(prog_defs) -> exists tfd, transf_partial fd = OK tfd. Proof. - unfold transform_partial_program; intros. - exploit transform_partial_program2_succeeds; eauto. + unfold transform_partial_program; intros. + exploit transform_partial_program2_succeeds; eauto. Qed. Lemma transform_partial_ident_program_succeeds: @@ -649,8 +649,8 @@ Lemma transform_partial_ident_program_succeeds: In (i, Gfun fd) p.(prog_defs) -> exists tfd, transf_partial_ident i fd = OK tfd. Proof. - unfold transform_partial_ident_program; intros. - exploit transform_partial_ident_program2_succeeds; eauto. + unfold transform_partial_ident_program; intros. + exploit transform_partial_ident_program2_succeeds; eauto. Qed. End TRANSF_PARTIAL_PROGRAM. @@ -663,7 +663,7 @@ Proof. unfold transform_partial_program, transform_partial_program2, transform_program; intros. replace (transf_globdefs (fun f => OK (transf f)) (fun v => OK v) p.(prog_defs)) with (OK (map (transform_program_globdef transf) p.(prog_defs))). - auto. + auto. induction (prog_defs p); simpl. auto. destruct a as [id [f|v]]; rewrite <- IHl. @@ -679,7 +679,7 @@ Proof. unfold transform_partial_ident_program, transform_partial_ident_program2, transform_program; intros. replace (transf_globdefs_ident (fun id f => OK (transf id f)) (fun _ v => OK v) p.(prog_defs)) with (OK (map (transform_program_globdef_ident transf) p.(prog_defs))). - auto. + auto. induction (prog_defs p); simpl. auto. destruct a as [id [f|v]]; rewrite <- IHl. @@ -687,11 +687,11 @@ Proof. destruct v; auto. Qed. -(** The following is a relational presentation of +(** The following is a relational presentation of [transform_partial_augment_preogram]. Given relations between function definitions and between variable information, it defines a relation between programs stating that the two programs have appropriately related - shapes (global names are preserved and possibly augmented, etc) + shapes (global names are preserved and possibly augmented, etc) and that identically-named function definitions and variable information are related. *) @@ -723,24 +723,24 @@ Lemma transform_partial_augment_program_match: forall (A B V W: Type) (transf_fun: A -> res B) (transf_var: V -> res W) - (p: program A V) + (p: program A V) (new_globs : list (ident * globdef B W)) (new_main : ident) (tp: program B W), transform_partial_augment_program transf_fun transf_var new_globs new_main p = OK tp -> - match_program + match_program (fun fd tfd => transf_fun fd = OK tfd) (fun info tinfo => transf_var info = OK tinfo) new_globs new_main p tp. Proof. - unfold transform_partial_augment_program; intros. monadInv H. + unfold transform_partial_augment_program; intros. monadInv H. red; simpl. split; auto. exists x; split; auto. revert x EQ. generalize (prog_defs p). induction l; simpl; intros. monadInv EQ. constructor. - destruct a as [id [f|v]]. + destruct a as [id [f|v]]. (* function *) - destruct (transf_fun f) as [tf|?] eqn:?; monadInv EQ. + destruct (transf_fun f) as [tf|?] eqn:?; monadInv EQ. constructor; auto. constructor; auto. (* variable *) unfold transf_globvar in EQ. @@ -890,7 +890,7 @@ End TRANSF_PARTIAL_FUNDEF. (** * Arguments and results to builtin functions *) -Set Contextual Implicit. +Set Contextual Implicit. Inductive builtin_arg (A: Type) : Type := | BA (x: A) @@ -948,7 +948,7 @@ Fixpoint map_builtin_arg (A B: Type) (f: A -> B) (a: builtin_arg A) : builtin_ar | BA_addrstack ofs => BA_addrstack ofs | BA_loadglobal chunk id ofs => BA_loadglobal chunk id ofs | BA_addrglobal id ofs => BA_addrglobal id ofs - | BA_splitlong hi lo => + | BA_splitlong hi lo => BA_splitlong (map_builtin_arg f hi) (map_builtin_arg f lo) end. @@ -956,7 +956,7 @@ Fixpoint map_builtin_res (A B: Type) (f: A -> B) (a: builtin_res A) : builtin_re match a with | BR x => BR (f x) | BR_none => BR_none - | BR_splitlong hi lo => + | BR_splitlong hi lo => BR_splitlong (map_builtin_res f hi) (map_builtin_res f lo) end. diff --git a/common/Behaviors.v b/common/Behaviors.v index 0a7ed171..1a6b8bd6 100644 --- a/common/Behaviors.v +++ b/common/Behaviors.v @@ -68,7 +68,7 @@ Lemma behavior_app_assoc: forall t1 t2 beh, behavior_app (t1 ** t2) beh = behavior_app t1 (behavior_app t2 beh). Proof. - intros. destruct beh; simpl; f_equal; traceEq. + intros. destruct beh; simpl; f_equal; traceEq. Qed. Lemma behavior_app_E0: @@ -90,14 +90,14 @@ Proof. Qed. Lemma behavior_improves_trans: - forall beh1 beh2 beh3, + forall beh1 beh2 beh3, behavior_improves beh1 beh2 -> behavior_improves beh2 beh3 -> behavior_improves beh1 beh3. Proof. - intros. red. destruct H; destruct H0; subst; auto. + intros. red. destruct H; destruct H0; subst; auto. destruct H as [t1 [EQ1 [beh2' EQ1']]]. destruct H0 as [t2 [EQ2 [beh3' EQ2']]]. - subst. destruct beh2'; simpl in EQ2; try discriminate. inv EQ2. + subst. destruct beh2'; simpl in EQ2; try discriminate. inv EQ2. right. exists t1; split; auto. exists (behavior_app t beh3'). apply behavior_app_assoc. Qed. @@ -112,7 +112,7 @@ Lemma behavior_improves_app: behavior_improves beh1 beh2 -> behavior_improves (behavior_app t beh1) (behavior_app t beh2). Proof. - intros. red; destruct H. left; congruence. + intros. red; destruct H. left; congruence. destruct H as [t' [A [beh' B]]]. subst. right; exists (t ** t'); split; auto. exists beh'. rewrite behavior_app_assoc; auto. Qed. @@ -152,7 +152,7 @@ Lemma state_behaves_app: forall s1 t s2 beh, Star L s1 t s2 -> state_behaves s2 beh -> state_behaves s1 (behavior_app t beh). Proof. - intros. inv H0; simpl; econstructor; eauto; try (eapply star_trans; eauto). + intros. inv H0; simpl; econstructor; eauto; try (eapply star_trans; eauto). eapply star_forever_reactive; eauto. Qed. @@ -177,7 +177,7 @@ Lemma reacts': forall s1 t1, Star L s0 t1 s1 -> { s2 : state L & { t2 : trace | Star L s1 t2 s2 /\ t2 <> E0 } }. Proof. - intros. + intros. destruct (constructive_indefinite_description _ (reacts H)) as [s2 A]. destruct (constructive_indefinite_description _ A) as [t2 [B C]]. exists s2; exists t2; auto. @@ -186,7 +186,7 @@ Qed. CoFixpoint build_traceinf' (s1: state L) (t1: trace) (ST: Star L s0 t1 s1) : traceinf' := match reacts' ST with | existT s2 (exist t2 (conj A B)) => - Econsinf' t2 + Econsinf' t2 (build_traceinf' (star_trans ST A (refl_equal _))) B end. @@ -196,10 +196,10 @@ Lemma reacts_forever_reactive_rec: Forever_reactive L s1 (traceinf_of_traceinf' (build_traceinf' ST)). Proof. cofix COINDHYP; intros. - rewrite (unroll_traceinf' (build_traceinf' ST)). simpl. - destruct (reacts' ST) as [s2 [t2 [A B]]]. - rewrite traceinf_traceinf'_app. - econstructor. eexact A. auto. apply COINDHYP. + rewrite (unroll_traceinf' (build_traceinf' ST)). simpl. + destruct (reacts' ST) as [s2 [t2 [A B]]]. + rewrite traceinf_traceinf'_app. + econstructor. eexact A. auto. apply COINDHYP. Qed. Lemma reacts_forever_reactive: @@ -216,9 +216,9 @@ Lemma diverges_forever_silent: (forall s1 t1, Star L s0 t1 s1 -> exists s2, Step L s1 E0 s2) -> Forever_silent L s0. Proof. - cofix COINDHYP; intros. - destruct (H s0 E0) as [s1 ST]. constructor. - econstructor. eexact ST. apply COINDHYP. + cofix COINDHYP; intros. + destruct (H s0 E0) as [s1 ST]. constructor. + econstructor. eexact ST. apply COINDHYP. intros. eapply H. eapply star_left; eauto. Qed. @@ -233,20 +233,20 @@ Proof. exists s3, Step L s2 E0 s3))). (* 1.1 Silent divergence *) destruct H0 as [s1 [t1 [A B]]]. - exists (Diverges t1); econstructor; eauto. + exists (Diverges t1); econstructor; eauto. apply diverges_forever_silent; auto. (* 1.2 Reactive divergence *) destruct (@reacts_forever_reactive s0) as [T FR]. intros. generalize (not_ex_all_not _ _ H0 s1). intro A; clear H0. generalize (not_ex_all_not _ _ A t1). intro B; clear A. - destruct (not_and_or _ _ B). contradiction. - destruct (not_all_ex_not _ _ H0) as [s2 C]; clear H0. + destruct (not_and_or _ _ B). contradiction. + destruct (not_all_ex_not _ _ H0) as [s2 C]; clear H0. destruct (not_all_ex_not _ _ C) as [t2 D]; clear C. destruct (imply_to_and _ _ D) as [E F]; clear D. - destruct (H s2 (t1 ** t2)) as [s3 [t3 G]]. eapply star_trans; eauto. + destruct (H s2 (t1 ** t2)) as [s3 [t3 G]]. eapply star_trans; eauto. exists s3; exists (t2 ** t3); split. - eapply star_right; eauto. + eapply star_right; eauto. red; intros. destruct (app_eq_nil t2 t3 H0). subst. elim F. exists s3; auto. exists (Reacts T); econstructor; eauto. (* 2 Termination (normal or by going wrong) *) @@ -257,9 +257,9 @@ Proof. (* 2.1 Normal termination *) exists (Terminates t1 r); econstructor; eauto. (* 2.2 Going wrong *) - exists (Goes_wrong t1); econstructor; eauto. red. intros. - generalize (not_ex_all_not _ _ D s'); intros. - generalize (not_ex_all_not _ _ H t); intros. + exists (Goes_wrong t1); econstructor; eauto. red. intros. + generalize (not_ex_all_not _ _ D s'); intros. + generalize (not_ex_all_not _ _ H t); intros. auto. Qed. @@ -269,10 +269,10 @@ Proof. destruct (classic (exists s, initial_state L s)) as [[s0 INIT] | NOTINIT]. (* 1. Initial state is defined. *) destruct (state_behaves_exists s0) as [beh SB]. - exists beh; econstructor; eauto. + exists beh; econstructor; eauto. (* 2. Initial state is undefined *) - exists (Goes_wrong E0). apply program_goes_initially_wrong. - intros. eapply not_ex_all_not; eauto. + exists (Goes_wrong E0). apply program_goes_initially_wrong. + intros. eapply not_ex_all_not; eauto. Qed. End PROGRAM_BEHAVIORS. @@ -290,7 +290,7 @@ Lemma forward_simulation_state_behaves: S i s1 s2 -> state_behaves L1 s1 beh1 -> exists beh2, state_behaves L2 s2 beh2 /\ behavior_improves beh1 beh2. Proof. - intros. inv H0. + intros. inv H0. (* termination *) exploit simulation_star; eauto. intros [i' [s2' [A B]]]. exists (Terminates t r); split. @@ -308,10 +308,10 @@ Proof. (* going wrong *) exploit simulation_star; eauto. intros [i' [s2' [A B]]]. destruct (state_behaves_exists L2 s2') as [beh' SB]. - exists (behavior_app t beh'); split. - eapply state_behaves_app; eauto. + exists (behavior_app t beh'); split. + eapply state_behaves_app; eauto. replace (Goes_wrong t) with (behavior_app t (Goes_wrong E0)). - apply behavior_improves_app. apply behavior_improves_bot. + apply behavior_improves_app. apply behavior_improves_bot. simpl. decEq. traceEq. Qed. @@ -326,11 +326,11 @@ Proof. exists beh2; split; auto. econstructor; eauto. (* initial state undefined *) destruct (classic (exists s', initial_state L2 s')). - destruct H as [s' INIT]. + destruct H as [s' INIT]. destruct (state_behaves_exists L2 s') as [beh' SB]. exists beh'; split. econstructor; eauto. apply behavior_improves_bot. exists (Goes_wrong E0); split. - apply program_goes_initially_wrong. + apply program_goes_initially_wrong. intros; red; intros. elim H; exists s; auto. apply behavior_improves_refl. Qed. @@ -340,8 +340,8 @@ Corollary forward_simulation_same_safe_behavior: program_behaves L1 beh -> not_wrong beh -> program_behaves L2 beh. Proof. - intros. exploit forward_simulation_behavior_improves; eauto. - intros [beh' [A B]]. destruct B. + intros. exploit forward_simulation_behavior_improves; eauto. + intros [beh' [A B]]. destruct B. congruence. destruct H1 as [t [C D]]. subst. contradiction. Qed. @@ -364,7 +364,7 @@ Definition safe_along_behavior (s: state L1) (b: program_behavior) : Prop := Remark safe_along_safe: forall s b, safe_along_behavior s b -> safe L1 s. Proof. - intros; red; intros. eapply H; eauto. symmetry; apply behavior_app_E0. + intros; red; intros. eapply H; eauto. symmetry; apply behavior_app_E0. Qed. Remark star_safe_along: @@ -381,21 +381,21 @@ Remark not_safe_along_behavior: forall s b, ~ safe_along_behavior s b -> exists t, exists s', - behavior_prefix t b + behavior_prefix t b /\ Star L1 s t s' /\ Nostep L1 s' /\ (forall r, ~(final_state L1 s' r)). Proof. - intros. + intros. destruct (not_all_ex_not _ _ H) as [t1 A]; clear H. destruct (not_all_ex_not _ _ A) as [s' B]; clear A. destruct (not_all_ex_not _ _ B) as [b2 C]; clear B. destruct (imply_to_and _ _ C) as [D E]; clear C. destruct (imply_to_and _ _ E) as [F G]; clear E. destruct (not_or_and _ _ G) as [P Q]; clear G. - exists t1; exists s'. - split. exists b2; auto. - split. auto. + exists t1; exists s'. + split. exists b2; auto. + split. auto. split. red; intros; red; intros. elim Q. exists t; exists s'0; auto. intros; red; intros. elim P. exists r; auto. Qed. @@ -407,7 +407,7 @@ Lemma backward_simulation_star: Proof. induction 1; intros. exists i; exists s1; split; auto. apply star_refl. - exploit (bsim_simulation S); eauto. eapply safe_along_safe; eauto. + exploit (bsim_simulation S); eauto. eapply safe_along_safe; eauto. intros [i' [s1' [A B]]]. assert (Star L1 s0 t1 s1'). intuition. apply plus_star; auto. exploit IHstar; eauto. eapply star_safe_along; eauto. @@ -439,9 +439,9 @@ Lemma backward_simulation_forever_reactive: Forever_reactive L2 s2 T -> S i s1 s2 -> safe_along_behavior s1 (Reacts T) -> Forever_reactive L1 s1 T. Proof. - cofix COINDHYP; intros. inv H. + cofix COINDHYP; intros. inv H. destruct (backward_simulation_star H2 _ (Reacts T0) H0) as [i' [s1' [A B]]]; eauto. - econstructor; eauto. eapply COINDHYP; eauto. eapply star_safe_along; eauto. + econstructor; eauto. eapply COINDHYP; eauto. eapply star_safe_along; eauto. Qed. Lemma backward_simulation_state_behaves: @@ -452,43 +452,43 @@ Proof. intros. destruct (classic (safe_along_behavior s1 beh2)). (* 1. Safe along *) exists beh2; split; [idtac|apply behavior_improves_refl]. - inv H0. + inv H0. (* termination *) assert (Terminates t r = behavior_app t (Terminates E0 r)). simpl. rewrite E0_right; auto. - rewrite H0 in H1. + rewrite H0 in H1. exploit backward_simulation_star; eauto. intros [i' [s1' [A B]]]. exploit (bsim_match_final_states S); eauto. - eapply safe_along_safe. eapply star_safe_along; eauto. + eapply safe_along_safe. eapply star_safe_along; eauto. intros [s1'' [C D]]. econstructor. eapply star_trans; eauto. traceEq. auto. (* silent divergence *) assert (Diverges t = behavior_app t (Diverges E0)). simpl. rewrite E0_right; auto. - rewrite H0 in H1. + rewrite H0 in H1. exploit backward_simulation_star; eauto. intros [i' [s1' [A B]]]. - econstructor. eauto. eapply backward_simulation_forever_silent; eauto. - eapply safe_along_safe. eapply star_safe_along; eauto. + econstructor. eauto. eapply backward_simulation_forever_silent; eauto. + eapply safe_along_safe. eapply star_safe_along; eauto. (* reactive divergence *) - econstructor. eapply backward_simulation_forever_reactive; eauto. + econstructor. eapply backward_simulation_forever_reactive; eauto. (* goes wrong *) assert (Goes_wrong t = behavior_app t (Goes_wrong E0)). simpl. rewrite E0_right; auto. - rewrite H0 in H1. + rewrite H0 in H1. exploit backward_simulation_star; eauto. intros [i' [s1' [A B]]]. - exploit (bsim_progress S); eauto. eapply safe_along_safe. eapply star_safe_along; eauto. - intros [[r FIN] | [t' [s2' STEP2]]]. + exploit (bsim_progress S); eauto. eapply safe_along_safe. eapply star_safe_along; eauto. + intros [[r FIN] | [t' [s2' STEP2]]]. elim (H4 _ FIN). elim (H3 _ _ STEP2). (* 2. Not safe along *) - exploit not_safe_along_behavior; eauto. + exploit not_safe_along_behavior; eauto. intros [t [s1' [PREF [STEPS [NOSTEP NOFIN]]]]]. exists (Goes_wrong t); split. - econstructor; eauto. + econstructor; eauto. right. exists t; auto. Qed. @@ -505,14 +505,14 @@ Proof. exists beh1; split; auto. econstructor; eauto. (* L1 has no initial state *) exists (Goes_wrong E0); split. - apply program_goes_initially_wrong. + apply program_goes_initially_wrong. intros; red; intros. elim NOINIT; exists s0; auto. apply behavior_improves_bot. (* L2 has no initial state *) exists (Goes_wrong E0); split. - apply program_goes_initially_wrong. + apply program_goes_initially_wrong. intros; red; intros. - exploit (bsim_initial_states_exist S); eauto. intros [s2 INIT2]. + exploit (bsim_initial_states_exist S); eauto. intros [s2 INIT2]. elim (H0 s2); auto. apply behavior_improves_refl. Qed. @@ -521,8 +521,8 @@ Corollary backward_simulation_same_safe_behavior: (forall beh, program_behaves L1 beh -> not_wrong beh) -> (forall beh, program_behaves L2 beh -> program_behaves L1 beh). Proof. - intros. exploit backward_simulation_behavior_improves; eauto. - intros [beh' [A B]]. destruct B. + intros. exploit backward_simulation_behavior_improves; eauto. + intros [beh' [A B]]. destruct B. congruence. destruct H1 as [t [C D]]. subst. elim (H (Goes_wrong t)). auto. Qed. @@ -549,7 +549,7 @@ Lemma step_atomic_plus: Proof. intros. destruct t. apply plus_one. simpl; apply atomic_step_silent; auto. - exploit Lwb; eauto. simpl; intros. + exploit Lwb; eauto. simpl; intros. eapply plus_left. eapply atomic_step_start; eauto. eapply atomic_finish; eauto. auto. Qed. @@ -559,14 +559,14 @@ Proof. induction 1. apply star_refl. eapply star_trans with (s2 := (E0,s2)). apply plus_star. eapply step_atomic_plus; eauto. eauto. auto. Qed. - + Lemma atomic_forward_simulation: forward_simulation L (atomic L). Proof. set (ms := fun (s: state L) (ts: state (atomic L)) => ts = (E0,s)). apply forward_simulation_plus with ms; intros. auto. - exists (E0,s1); split. simpl; auto. red; auto. - red in H. subst s2. simpl; auto. + exists (E0,s1); split. simpl; auto. red; auto. + red in H. subst s2. simpl; auto. red in H0. subst s2. exists (E0,s1'); split. apply step_atomic_plus; auto. red; auto. Qed. @@ -575,27 +575,27 @@ Lemma atomic_star_star_gen: forall ts1 t ts2, Star (atomic L) ts1 t ts2 -> exists t', Star L (snd ts1) t' (snd ts2) /\ fst ts1 ** t' = t ** fst ts2. Proof. - induction 1. + induction 1. exists E0; split. apply star_refl. traceEq. destruct IHstar as [t' [A B]]. simpl in H; inv H; simpl in *. exists t'; split. eapply star_left; eauto. auto. - exists (ev :: t0 ** t'); split. eapply star_left; eauto. rewrite B; auto. + exists (ev :: t0 ** t'); split. eapply star_left; eauto. rewrite B; auto. exists t'; split. auto. rewrite B; auto. Qed. Lemma atomic_star_star: forall s1 t s2, Star (atomic L) (E0,s1) t (E0,s2) -> Star L s1 t s2. Proof. - intros. exploit atomic_star_star_gen; eauto. intros [t' [A B]]. - simpl in *. replace t with t'. auto. subst; traceEq. + intros. exploit atomic_star_star_gen; eauto. intros [t' [A B]]. + simpl in *. replace t with t'. auto. subst; traceEq. Qed. Lemma atomic_forever_silent_forever_silent: forall s, Forever_silent (atomic L) s -> Forever_silent L (snd s). Proof. - cofix COINDHYP; intros. inv H. inv H0. - apply forever_silent_intro with (snd (E0, s')). auto. apply COINDHYP; auto. + cofix COINDHYP; intros. inv H. inv H0. + apply forever_silent_intro with (snd (E0, s')). auto. apply COINDHYP; auto. Qed. Remark star_atomic_output_trace: @@ -608,7 +608,7 @@ Proof. apply IHstar. auto. apply IHstar. exploit Lwb; eauto. destruct H2. apply IHstar. auto. - intros. change t' with (fst (t',s')). eapply H; eauto. simpl; auto. + intros. change t' with (fst (t',s')). eapply H; eauto. simpl; auto. Qed. Lemma atomic_forever_reactive_forever_reactive: @@ -617,15 +617,15 @@ Proof. assert (forall t s T, Forever_reactive (atomic L) (t,s) T -> exists T', Forever_reactive (atomic L) (E0,s) T' /\ T = t *** T'). induction t; intros. exists T; auto. - inv H. inv H0. congruence. simpl in H; inv H. + inv H. inv H0. congruence. simpl in H; inv H. destruct (IHt s (t2***T0)) as [T' [A B]]. eapply star_forever_reactive; eauto. - exists T'; split; auto. simpl. congruence. + exists T'; split; auto. simpl. congruence. - cofix COINDHYP; intros. inv H0. destruct s2 as [t2 s2]. - destruct (H _ _ _ H3) as [T' [A B]]. + cofix COINDHYP; intros. inv H0. destruct s2 as [t2 s2]. + destruct (H _ _ _ H3) as [T' [A B]]. assert (Star (atomic L) (E0, s) (t**t2) (E0, s2)). - eapply star_trans. eauto. apply atomic_finish. eapply star_atomic_output_trace; eauto. auto. - replace (t *** T0) with ((t ** t2) *** T'). apply forever_reactive_intro with s2. + eapply star_trans. eauto. apply atomic_finish. eapply star_atomic_output_trace; eauto. auto. + replace (t *** T0) with ((t ** t2) *** T'). apply forever_reactive_intro with s2. apply atomic_star_star; auto. destruct t; simpl in *; unfold E0 in *; congruence. apply COINDHYP. auto. subst T0; traceEq. @@ -636,44 +636,44 @@ Theorem atomic_behaviors: Proof. intros; split; intros. (* L -> atomic L *) - exploit forward_simulation_behavior_improves. eapply atomic_forward_simulation. eauto. + exploit forward_simulation_behavior_improves. eapply atomic_forward_simulation. eauto. intros [beh2 [A B]]. red in B. destruct B as [EQ | [t [C D]]]. congruence. subst beh. inv H. inv H1. - apply program_runs with (E0,s). simpl; auto. - apply state_goes_wrong with (E0,s'). apply star_atomic_star; auto. - red; intros; red; intros. inv H. eelim H3; eauto. eelim H3; eauto. - intros; red; intros. simpl in H. destruct H. eelim H4; eauto. - apply program_goes_initially_wrong. - intros; red; intros. simpl in H; destruct H. eelim H1; eauto. + apply program_runs with (E0,s). simpl; auto. + apply state_goes_wrong with (E0,s'). apply star_atomic_star; auto. + red; intros; red; intros. inv H. eelim H3; eauto. eelim H3; eauto. + intros; red; intros. simpl in H. destruct H. eelim H4; eauto. + apply program_goes_initially_wrong. + intros; red; intros. simpl in H; destruct H. eelim H1; eauto. (* atomic L -> L *) inv H. (* initial state defined *) - destruct s as [t s]. simpl in H0. destruct H0; subst t. - apply program_runs with s; auto. + destruct s as [t s]. simpl in H0. destruct H0; subst t. + apply program_runs with s; auto. inv H1. (* termination *) - destruct s' as [t' s']. simpl in H2; destruct H2; subst t'. - econstructor. eapply atomic_star_star; eauto. auto. + destruct s' as [t' s']. simpl in H2; destruct H2; subst t'. + econstructor. eapply atomic_star_star; eauto. auto. (* silent divergence *) destruct s' as [t' s']. - assert (t' = E0). inv H2. inv H1; auto. subst t'. - econstructor. eapply atomic_star_star; eauto. + assert (t' = E0). inv H2. inv H1; auto. subst t'. + econstructor. eapply atomic_star_star; eauto. change s' with (snd (E0,s')). apply atomic_forever_silent_forever_silent. auto. (* reactive divergence *) - econstructor. apply atomic_forever_reactive_forever_reactive. auto. + econstructor. apply atomic_forever_reactive_forever_reactive. auto. (* going wrong *) destruct s' as [t' s']. assert (t' = E0). destruct t'; auto. eelim H2. simpl. apply atomic_step_continue. eapply star_atomic_output_trace; eauto. - subst t'. econstructor. apply atomic_star_star; eauto. + subst t'. econstructor. apply atomic_star_star; eauto. red; intros; red; intros. destruct t0. - elim (H2 E0 (E0,s'0)). constructor; auto. + elim (H2 E0 (E0,s'0)). constructor; auto. elim (H2 (e::nil) (t0,s'0)). constructor; auto. - intros; red; intros. elim (H3 r). simpl; auto. + intros; red; intros. elim (H3 r). simpl; auto. (* initial state undefined *) - apply program_goes_initially_wrong. + apply program_goes_initially_wrong. intros; red; intros. elim (H0 (E0,s)); simpl; auto. Qed. @@ -722,7 +722,7 @@ Proof. Qed. Let treactive (S: tstate) : Prop := - forall S1, + forall S1, tsteps S S1 -> exists S2, exists S3, exists t, tsteps S1 S2 /\ tstep t S2 S3 /\ t <> E0. @@ -734,16 +734,16 @@ Lemma treactive_or_tsilent: Proof. intros. destruct (classic (exists S', tsteps S S' /\ tsilent S')). auto. - left. red; intros. + left. red; intros. generalize (not_ex_all_not _ _ H S1). intros. - destruct (not_and_or _ _ H1). contradiction. - unfold tsilent in H2. + destruct (not_and_or _ _ H1). contradiction. + unfold tsilent in H2. generalize (not_all_ex_not _ _ H2). intros [S2 A]. generalize (not_all_ex_not _ _ A). intros [t B]. generalize (not_all_ex_not _ _ B). intros [S3 C]. generalize (imply_to_and _ _ C). intros [D F]. generalize (imply_to_and _ _ F). intros [G J]. - exists S2; exists S3; exists t. auto. + exists S2; exists S3; exists t. auto. Qed. Lemma tsteps_star: @@ -765,14 +765,14 @@ Lemma tsilent_forever_silent: Proof. cofix COINDHYP; intro S. case S. intros until f. simpl. case f. intros. assert (tstep t (ST s1 (t *** T0) (forever_intro s1 t s0 f0)) - (ST s2 T0 f0)). + (ST s2 T0 f0)). constructor. - assert (t = E0). + assert (t = E0). red in H. eapply H; eauto. apply tsteps_refl. apply forever_silent_intro with (state_of_tstate (ST s2 T0 f0)). - rewrite <- H1. assumption. - apply COINDHYP. - red; intros. eapply H. eapply tsteps_left; eauto. eauto. + rewrite <- H1. assumption. + apply COINDHYP. + red; intros. eapply H. eapply tsteps_left; eauto. eauto. Qed. Lemma treactive_forever_reactive: @@ -780,14 +780,14 @@ Lemma treactive_forever_reactive: treactive S -> forever_reactive step ge (state_of_tstate S) (traceinf_of_tstate S). Proof. cofix COINDHYP; intros. - destruct (H S) as [S1 [S2 [t [A [B C]]]]]. apply tsteps_refl. + destruct (H S) as [S1 [S2 [t [A [B C]]]]]. apply tsteps_refl. destruct (tsteps_star _ _ A) as [t' [P Q]]. - inv B. simpl in *. rewrite Q. rewrite <- Eappinf_assoc. - apply forever_reactive_intro with s2. - eapply star_right; eauto. + inv B. simpl in *. rewrite Q. rewrite <- Eappinf_assoc. + apply forever_reactive_intro with s2. + eapply star_right; eauto. red; intros. destruct (Eapp_E0_inv _ _ H0). contradiction. change (forever_reactive step ge (state_of_tstate (ST s2 T F)) (traceinf_of_tstate (ST s2 T F))). - apply COINDHYP. + apply COINDHYP. red; intros. apply H. eapply tsteps_trans. eauto. eapply tsteps_left. constructor. eauto. @@ -800,15 +800,15 @@ Theorem forever_silent_or_reactive: exists t, exists s', exists T', star step ge s t s' /\ forever_silent step ge s' /\ T = t *** T'. Proof. - intros. + intros. destruct (treactive_or_tsilent (ST s T H)). - left. + left. change (forever_reactive step ge (state_of_tstate (ST s T H)) (traceinf_of_tstate (ST s T H))). apply treactive_forever_reactive. auto. destruct H0 as [S' [A B]]. exploit tsteps_star; eauto. intros [t [C D]]. simpl in *. right. exists t; exists (state_of_tstate S'); exists (traceinf_of_tstate S'). - split. auto. + split. auto. split. apply tsilent_forever_silent. auto. auto. Qed. @@ -829,7 +829,7 @@ Lemma behavior_bigstep_terminates: forall t r, bigstep_terminates B t r -> program_behaves L (Terminates t r). Proof. - intros. exploit (bigstep_terminates_sound sound); eauto. + intros. exploit (bigstep_terminates_sound sound); eauto. intros [s1 [s2 [P [Q R]]]]. econstructor; eauto. econstructor; eauto. Qed. diff --git a/common/Determinism.v b/common/Determinism.v index 2445398c..e68c363f 100644 --- a/common/Determinism.v +++ b/common/Determinism.v @@ -101,7 +101,7 @@ Lemma possible_trace_app_inv: Proof. induction t1; simpl; intros. exists w0; split. constructor. auto. - inv H. exploit IHt1; eauto. intros [w1 [A B]]. + inv H. exploit IHt1; eauto. intros [w1 [A B]]. exists w1; split. econstructor; eauto. auto. Qed. @@ -114,7 +114,7 @@ Proof. auto. inv H7; inv H6. inv H9; inv H10. split; congruence. inv H7; inv H6. inv H9; inv H10. split; congruence. - inv H4; inv H3. inv H6; inv H7. split; congruence. + inv H4; inv H3. inv H6; inv H7. split; congruence. inv H4; inv H3. inv H7; inv H6. auto. Qed. @@ -141,7 +141,7 @@ Lemma possible_traceinf_app_inv: Proof. induction t1; simpl; intros. exists w0; split. constructor. auto. - inv H. exploit IHt1; eauto. intros [w1 [A B]]. + inv H. exploit IHt1; eauto. intros [w1 [A B]]. exists w1; split. econstructor; eauto. auto. Qed. @@ -164,7 +164,7 @@ Ltac possibleTraceInv := intros w [P1 P2]; possibleTraceInv | [H: exists w, possible_trace _ _ w |- _] => - let P := fresh "P" in let w := fresh "w" in + let P := fresh "P" in let w := fresh "w" in destruct H as [w P]; possibleTraceInv | _ => idtac end. @@ -218,19 +218,19 @@ Ltac use_step_deterministic := (** Determinism for finite transition sequences. *) Lemma star_step_diamond: - forall s0 t1 s1, Star L s0 t1 s1 -> - forall t2 s2, Star L s0 t2 s2 -> + forall s0 t1 s1, Star L s0 t1 s1 -> + forall t2 s2, Star L s0 t2 s2 -> exists t, (Star L s1 t s2 /\ t2 = t1 ** t) \/ (Star L s2 t s1 /\ t1 = t2 ** t). Proof. - induction 1; intros. - exists t2; auto. - inv H2. exists (t1 ** t2); right. + induction 1; intros. + exists t2; auto. + inv H2. exists (t1 ** t2); right. split. econstructor; eauto. auto. - use_step_deterministic. + use_step_deterministic. exploit IHstar. eexact H4. intros [t A]. exists t. - destruct A. left; intuition. traceEq. right; intuition. traceEq. + destruct A. left; intuition. traceEq. right; intuition. traceEq. Qed. Ltac use_star_step_diamond := @@ -248,8 +248,8 @@ Ltac use_nostep := Lemma star_step_triangle: forall s0 t1 s1 t2 s2, - Star L s0 t1 s1 -> - Star L s0 t2 s2 -> + Star L s0 t1 s1 -> + Star L s0 t2 s2 -> Nostep L s2 -> exists t, Star L s1 t s2 /\ t2 = t1 ** t. @@ -270,7 +270,7 @@ Ltac use_star_step_triangle := Lemma steps_deterministic: forall s0 t1 s1 t2 s2, - Star L s0 t1 s1 -> Star L s0 t2 s2 -> + Star L s0 t1 s1 -> Star L s0 t2 s2 -> Nostep L s1 -> Nostep L s2 -> t1 = t2 /\ s1 = s2. Proof. @@ -285,8 +285,8 @@ Lemma terminates_not_goes_wrong: (forall r, ~final_state L s2 r) -> False. Proof. intros. - assert (t1 = t2 /\ s1 = s2). - eapply steps_deterministic; eauto. eapply det_final_nostep; eauto. + assert (t1 = t2 /\ s1 = s2). + eapply steps_deterministic; eauto. eapply det_final_nostep; eauto. destruct H4; subst. elim (H3 _ H0). Qed. @@ -297,8 +297,8 @@ Lemma star_final_not_forever_silent: Nostep L s' -> Forever_silent L s -> False. Proof. - induction 1; intros. - inv H0. use_nostep. + induction 1; intros. + inv H0. use_nostep. inv H3. use_step_deterministic. eauto. Qed. @@ -313,32 +313,32 @@ Proof. Qed. Lemma star_final_not_forever_reactive: - forall s t s', Star L s t s' -> + forall s t s', Star L s t s' -> forall T, Nostep L s' -> Forever_reactive L s T -> False. Proof. induction 1; intros. - inv H0. inv H1. congruence. use_nostep. + inv H0. inv H1. congruence. use_nostep. inv H3. inv H4. congruence. use_step_deterministic. - eapply IHstar with (T := t4 *** T0). eauto. - eapply star_forever_reactive; eauto. + eapply IHstar with (T := t4 *** T0). eauto. + eapply star_forever_reactive; eauto. Qed. Lemma star_forever_silent_inv: forall s t s', Star L s t s' -> - Forever_silent L s -> + Forever_silent L s -> t = E0 /\ Forever_silent L s'. Proof. induction 1; intros. auto. - subst. inv H2. use_step_deterministic. eauto. + subst. inv H2. use_step_deterministic. eauto. Qed. Lemma forever_silent_reactive_exclusive: forall s T, Forever_silent L s -> Forever_reactive L s T -> False. Proof. - intros. inv H0. exploit star_forever_silent_inv; eauto. + intros. inv H0. exploit star_forever_silent_inv; eauto. intros [A B]. contradiction. Qed. @@ -358,17 +358,17 @@ Lemma forever_reactive_inv2: Proof. induction 1; intros. congruence. - inv H2. congruence. use_step_deterministic. + inv H2. congruence. use_step_deterministic. destruct t3. (* inductive case *) - simpl in *. eapply IHstar; eauto. + simpl in *. eapply IHstar; eauto. (* base case *) exists s5; exists (e :: t3); exists (t2 *** T1); exists (t4 *** T2). split. unfold E0; congruence. - split. eapply star_forever_reactive; eauto. - split. eapply star_forever_reactive; eauto. - split; traceEq. + split. eapply star_forever_reactive; eauto. + split. eapply star_forever_reactive; eauto. + split; traceEq. Qed. Lemma forever_reactive_determ': @@ -381,8 +381,8 @@ Proof. inv H. inv H0. destruct (forever_reactive_inv2 _ _ _ H t s2 T0 T) as [s' [t' [T1' [T2' [A [B [C [D E]]]]]]]]; auto. - rewrite D; rewrite E. constructor. auto. - eapply COINDHYP; eauto. + rewrite D; rewrite E. constructor. auto. + eapply COINDHYP; eauto. Qed. Lemma forever_reactive_determ: @@ -399,12 +399,12 @@ Lemma star_forever_reactive_inv: forall T, Forever_reactive L s T -> exists T', Forever_reactive L s' T' /\ T = t *** T'. Proof. - induction 1; intros. + induction 1; intros. exists T; auto. inv H2. inv H3. congruence. - use_step_deterministic. + use_step_deterministic. exploit IHstar. eapply star_forever_reactive. 2: eauto. eauto. - intros [T' [A B]]. exists T'; intuition. traceEq. congruence. + intros [T' [A B]]. exists T'; intuition. traceEq. congruence. Qed. Lemma forever_silent_reactive_exclusive2: @@ -413,7 +413,7 @@ Lemma forever_silent_reactive_exclusive2: Forever_reactive L s T -> False. Proof. - intros. exploit star_forever_reactive_inv; eauto. + intros. exploit star_forever_reactive_inv; eauto. intros [T' [A B]]. subst T. eapply forever_silent_reactive_exclusive; eauto. Qed. @@ -438,7 +438,7 @@ Proof. inv BEH1; inv BEH2; red. (* terminates, terminates *) assert (t = t0 /\ s' = s'0). eapply steps_deterministic; eauto. - destruct H3. split; auto. subst. eapply det_final_state; eauto. + destruct H3. split; auto. subst. eapply det_final_state; eauto. (* terminates, diverges *) eapply star2_final_not_forever_silent with (s1 := s') (s2 := s'0); eauto. (* terminates, reacts *) @@ -449,9 +449,9 @@ Proof. eapply star2_final_not_forever_silent with (s2 := s') (s1 := s'0); eauto. (* diverges, diverges *) use_star_step_diamond. - exploit star_forever_silent_inv. eexact P. eauto. + exploit star_forever_silent_inv. eexact P. eauto. intros [A B]. subst; traceEq. - exploit star_forever_silent_inv. eexact P. eauto. + exploit star_forever_silent_inv. eexact P. eauto. intros [A B]. subst; traceEq. (* diverges, reacts *) eapply forever_silent_reactive_exclusive2; eauto. @@ -459,10 +459,10 @@ Proof. eapply star2_final_not_forever_silent with (s1 := s'0) (s2 := s'); eauto. (* reacts, terminates *) eapply star_final_not_forever_reactive; eauto. -(* reacts, diverges *) +(* reacts, diverges *) eapply forever_silent_reactive_exclusive2; eauto. (* reacts, reacts *) - eapply forever_reactive_determ; eauto. + eapply forever_reactive_determ; eauto. (* reacts, goes wrong *) eapply star_final_not_forever_reactive; eauto. (* goes wrong, terminate *) @@ -473,7 +473,7 @@ Proof. eapply star_final_not_forever_reactive; eauto. (* goes wrong, goes wrong *) assert (t = t0 /\ s' = s'0). eapply steps_deterministic; eauto. - tauto. + tauto. Qed. Theorem program_behaves_deterministic: @@ -483,7 +483,7 @@ Theorem program_behaves_deterministic: Proof. intros until beh2; intros BEH1 BEH2. inv BEH1; inv BEH2. (* both initial states defined *) - assert (s = s0) by (eapply det_initial_state; eauto). subst s0. + assert (s = s0) by (eapply det_initial_state; eauto). subst s0. eapply state_behaves_deterministic; eauto. (* one initial state defined, the other undefined *) elim (H1 _ H). @@ -533,13 +533,13 @@ Proof. rewrite (surjective_pairing s1). rewrite (surjective_pairing s2). intuition congruence. (* initial states *) destruct H; destruct H0. - rewrite (surjective_pairing s1). rewrite (surjective_pairing s2). decEq. - eapply (sd_initial_determ D); eauto. + rewrite (surjective_pairing s1). rewrite (surjective_pairing s2). decEq. + eapply (sd_initial_determ D); eauto. congruence. (* final states *) eapply (sd_final_determ D); eauto. (* final no step *) - red; simpl; intros. red; intros [A B]. exploit (sd_final_nostep D); eauto. + red; simpl; intros. red; intros [A B]. exploit (sd_final_nostep D); eauto. Qed. End WORLD_SEM. diff --git a/common/Errors.v b/common/Errors.v index 78e11999..338d777d 100644 --- a/common/Errors.v +++ b/common/Errors.v @@ -122,7 +122,7 @@ Proof. destruct (bind_inversion _ _ H) as [hd' [P Q]]. destruct (bind_inversion _ _ Q) as [tl' [R S]]. inversion_clear S. - constructor. auto. auto. + constructor. auto. auto. Qed. (** * Reasoning over monadic computations *) @@ -174,20 +174,20 @@ Ltac monadInv1 H := Ltac monadInv H := monadInv1 H || match type of H with - | (?F _ _ _ _ _ _ _ _ = OK _) => + | (?F _ _ _ _ _ _ _ _ = OK _) => ((progress simpl in H) || unfold F in H); monadInv1 H - | (?F _ _ _ _ _ _ _ = OK _) => + | (?F _ _ _ _ _ _ _ = OK _) => ((progress simpl in H) || unfold F in H); monadInv1 H - | (?F _ _ _ _ _ _ = OK _) => + | (?F _ _ _ _ _ _ = OK _) => ((progress simpl in H) || unfold F in H); monadInv1 H - | (?F _ _ _ _ _ = OK _) => + | (?F _ _ _ _ _ = OK _) => ((progress simpl in H) || unfold F in H); monadInv1 H - | (?F _ _ _ _ = OK _) => + | (?F _ _ _ _ = OK _) => ((progress simpl in H) || unfold F in H); monadInv1 H - | (?F _ _ _ = OK _) => + | (?F _ _ _ = OK _) => ((progress simpl in H) || unfold F in H); monadInv1 H - | (?F _ _ = OK _) => + | (?F _ _ = OK _) => ((progress simpl in H) || unfold F in H); monadInv1 H - | (?F _ = OK _) => + | (?F _ = OK _) => ((progress simpl in H) || unfold F in H); monadInv1 H end. diff --git a/common/Events.v b/common/Events.v index dc38b344..7029a984 100644 --- a/common/Events.v +++ b/common/Events.v @@ -31,7 +31,7 @@ Require Import Globalenvs. input/output events, which represent the actions of the program that the external world can observe. CompCert leaves much flexibility as to the exact content of events: the only requirement is that they - do not expose memory states nor pointer values + do not expose memory states nor pointer values (other than pointers to global variables), because these are not preserved literally during compilation. For concreteness, we use the following type for events. Each event represents either: @@ -40,10 +40,10 @@ Require Import Globalenvs. name of the system call, its parameters, and its result. - A volatile load from a global memory location, recording the chunk - and address being read and the value just read. + and address being read and the value just read. - A volatile store to a global memory location, recording the chunk - and address being written and the value stored there. + and address being written and the value stored there. - An annotation, recording the text of the annotation and the values of the arguments. @@ -102,7 +102,7 @@ Proof. intros. unfold Eapp, trace. apply app_ass. Qed. Lemma Eapp_E0_inv: forall t1 t2, t1 ** t2 = E0 -> t1 = E0 /\ t2 = E0. Proof (@app_eq_nil event). - + Lemma E0_left_inf: forall T, E0 *** T = T. Proof. auto. Qed. @@ -133,7 +133,7 @@ Ltac decomposeTraceEq := auto end. -Ltac traceEq := +Ltac traceEq := repeat substTraceHyp; autorewrite with trace_rewrite; decomposeTraceEq. (** Bisimilarity between infinite traces. *) @@ -149,7 +149,7 @@ Proof. cofix COINDHYP; intros. destruct T. constructor. apply COINDHYP. Qed. - + Lemma traceinf_sim_sym: forall T1 T2, traceinf_sim T1 T2 -> traceinf_sim T2 T1. Proof. @@ -157,7 +157,7 @@ Proof. Qed. Lemma traceinf_sim_trans: - forall T1 T2 T3, + forall T1 T2 T3, traceinf_sim T1 T2 -> traceinf_sim T2 T3 -> traceinf_sim T1 T3. Proof. cofix COINDHYP;intros. inv H; inv H0; constructor; eauto. @@ -170,11 +170,11 @@ CoInductive traceinf_sim': traceinf -> traceinf -> Prop := Lemma traceinf_sim'_sim: forall T1 T2, traceinf_sim' T1 T2 -> traceinf_sim T1 T2. Proof. - cofix COINDHYP; intros. inv H. + cofix COINDHYP; intros. inv H. destruct t. elim H0; auto. Transparent Eappinf. Transparent E0. - simpl. + simpl. destruct t. simpl. constructor. apply COINDHYP; auto. constructor. apply COINDHYP. constructor. unfold E0; congruence. auto. @@ -193,10 +193,10 @@ Program Definition split_traceinf' (t: trace) (T: traceinf') (NE: t <> E0): even | e :: t' => (e, Econsinf' t' T _) end. Next Obligation. - elimtype False. elim NE. auto. + elimtype False. elim NE. auto. Qed. Next Obligation. - red; intro. elim (H e). rewrite H0. auto. + red; intro. elim (H e). rewrite H0. auto. Qed. CoFixpoint traceinf_of_traceinf' (T': traceinf') : traceinf := @@ -224,11 +224,11 @@ Lemma traceinf_traceinf'_app: Proof. induction t. intros. elim NE. auto. - intros. simpl. + intros. simpl. rewrite (unroll_traceinf (traceinf_of_traceinf' (Econsinf' (a :: t) T NE))). simpl. destruct t. auto. Transparent Eappinf. - simpl. f_equal. apply IHt. + simpl. f_equal. apply IHt. Qed. (** Prefixes of traces. *) @@ -244,7 +244,7 @@ Lemma trace_prefix_app: trace_prefix t1 t2 -> trace_prefix (t ** t1) (t ** t2). Proof. - intros. destruct H as [t3 EQ]. exists t3. traceEq. + intros. destruct H as [t3 EQ]. exists t3. traceEq. Qed. Lemma traceinf_prefix_app: @@ -295,7 +295,7 @@ Lemma eventval_match_type: forall ev ty v, eventval_match ev ty v -> Val.has_type v ty. Proof. - intros. inv H; simpl; auto. + intros. inv H; simpl; auto. Qed. Lemma eventval_list_match_length: @@ -331,7 +331,7 @@ Lemma eventval_match_determ_2: forall ev1 ev2 ty v, eventval_match ev1 ty v -> eventval_match ev2 ty v -> ev1 = ev2. Proof. intros. inv H; inv H0; auto. - decEq. eapply Senv.find_symbol_injective; eauto. + decEq. eapply Senv.find_symbol_injective; eauto. Qed. Lemma eventval_list_match_determ_2: @@ -370,13 +370,13 @@ Lemma eventval_match_receptive: Proof. intros. inv H; destruct ev2; simpl in H2; try discriminate. - exists (Vint i0); constructor. -- simpl in H1; exploit Senv.public_symbol_exists; eauto. intros [b FS]. +- simpl in H1; exploit Senv.public_symbol_exists; eauto. intros [b FS]. exists (Vptr b i1); constructor; auto. - exists (Vlong i0); constructor. - exists (Vfloat f0); constructor. - exists (Vsingle f0); constructor; auto. - exists (Vint i); constructor. -- simpl in H1. exploit Senv.public_symbol_exists. eexact H1. intros [b' FS]. +- simpl in H1. exploit Senv.public_symbol_exists. eexact H1. intros [b' FS]. exists (Vptr b' i0); constructor; auto. Qed. @@ -390,7 +390,7 @@ Lemma eventval_match_same_type: forall ev1 ty v1 ev2 v2, eventval_match ev1 ty v1 -> eventval_match ev2 ty v2 -> eventval_type ev1 = eventval_type ev2. Proof. - destruct 1; intros EV; inv EV; auto. + destruct 1; intros EV; inv EV; auto. Qed. End EVENTVAL. @@ -407,7 +407,7 @@ Hypothesis public_preserved: Lemma eventval_valid_preserved: forall ev, eventval_valid ge1 ev -> eventval_valid ge2 ev. Proof. - intros. destruct ev; simpl in *; auto. rewrite <- H; auto. + intros. destruct ev; simpl in *; auto. rewrite <- H; auto. Qed. Hypothesis symbols_preserved: @@ -418,8 +418,8 @@ Lemma eventval_match_preserved: eventval_match ge1 ev ty v -> eventval_match ge2 ev ty v. Proof. induction 1; constructor; auto. - rewrite public_preserved; auto. - rewrite symbols_preserved; auto. + rewrite public_preserved; auto. + rewrite symbols_preserved; auto. Qed. Lemma eventval_list_match_preserved: @@ -463,12 +463,12 @@ Qed. Lemma eventval_match_inject_2: forall ev ty v1, - eventval_match ge1 ev ty v1 -> + eventval_match ge1 ev ty v1 -> exists v2, eventval_match ge2 ev ty v2 /\ Val.inject f v1 v2. Proof. intros. inv H; try (econstructor; split; eauto; constructor; fail). destruct symb_inj as (A & B & C & D). exploit C; eauto. intros [b2 [EQ FS]]. - exists (Vptr b2 ofs); split. econstructor; eauto. + exists (Vptr b2 ofs); split. econstructor; eauto. econstructor; eauto. rewrite Int.add_zero; auto. Qed. @@ -536,7 +536,7 @@ Definition output_event (ev: event) : Prop := | Event_vstore _ _ _ _ => True | Event_annot _ _ => True end. - + Fixpoint output_trace (t: trace) : Prop := match t with | nil => True @@ -584,7 +584,7 @@ Inductive volatile_store (ge: Senv.t): - the trace generated by the call (can be empty). *) -Definition extcall_sem : Type := +Definition extcall_sem : Type := Senv.t -> list val -> mem -> trace -> val -> mem -> Prop. (** We now specify the expected properties of this predicate. *) @@ -736,20 +736,20 @@ Lemma volatile_load_inject: Mem.inject f m m' -> exists v', volatile_load ge2 chunk m' b' ofs' t v' /\ Val.inject f v v'. Proof. - intros until m'; intros SI VL VI MI. generalize SI; intros (A & B & C & D). + intros until m'; intros SI VL VI MI. generalize SI; intros (A & B & C & D). inv VL. - (* volatile load *) - inv VI. exploit B; eauto. intros [U V]. subst delta. + inv VI. exploit B; eauto. intros [U V]. subst delta. exploit eventval_match_inject_2; eauto. intros (v2 & X & Y). rewrite Int.add_zero. exists (Val.load_result chunk v2); split. constructor; auto. erewrite D; eauto. apply Val.load_result_inject. auto. - (* normal load *) - exploit Mem.loadv_inject; eauto. simpl; eauto. simpl; intros (v2 & X & Y). - exists v2; split; auto. + exploit Mem.loadv_inject; eauto. simpl; eauto. simpl; intros (v2 & X & Y). + exists v2; split; auto. constructor; auto. - inv VI. erewrite D; eauto. + inv VI. erewrite D; eauto. Qed. Lemma volatile_load_receptive: @@ -765,15 +765,15 @@ Qed. Lemma volatile_load_ok: forall chunk, - extcall_properties (volatile_load_sem chunk) + extcall_properties (volatile_load_sem chunk) (mksignature (Tint :: nil) (Some (type_of_chunk chunk)) cc_default). Proof. intros; constructor; intros. (* well typed *) -- unfold proj_sig_res; simpl. inv H. inv H0. apply Val.load_result_type. - eapply Mem.load_type; eauto. +- unfold proj_sig_res; simpl. inv H. inv H0. apply Val.load_result_type. + eapply Mem.load_type; eauto. (* symbols *) -- inv H2. constructor. eapply volatile_load_preserved; eauto. +- inv H2. constructor. eapply volatile_load_preserved; eauto. (* valid blocks *) - inv H; auto. (* max perms *) @@ -781,12 +781,12 @@ Proof. (* readonly *) - inv H. apply Mem.unchanged_on_refl. (* mem extends *) -- inv H. inv H1. inv H6. inv H4. +- inv H. inv H1. inv H6. inv H4. exploit volatile_load_extends; eauto. intros [v' [A B]]. exists v'; exists m1'; intuition. constructor; auto. (* mem injects *) -- inv H0. inv H2. inv H7. inversion H5; subst. - exploit volatile_load_inject; eauto. intros [v' [A B]]. +- inv H0. inv H2. inv H7. inversion H5; subst. + exploit volatile_load_inject; eauto. intros [v' [A B]]. exists f; exists v'; exists m1'; intuition. constructor; auto. red; intros. congruence. (* trace length *) @@ -797,11 +797,11 @@ Proof. (* determ *) - inv H; inv H0. inv H1; inv H7; try congruence. assert (id = id0) by (eapply Senv.find_symbol_injective; eauto). subst id0. - split. constructor. + split. constructor. eapply eventval_match_valid; eauto. eapply eventval_match_valid; eauto. eapply eventval_match_same_type; eauto. - intros EQ; inv EQ. + intros EQ; inv EQ. assert (v = v0) by (eapply eventval_match_determ_1; eauto). subst v0. auto. split. constructor. intuition congruence. @@ -837,10 +837,10 @@ Lemma volatile_store_readonly: Proof. intros. inv H. apply Mem.unchanged_on_refl. - eapply Mem.store_unchanged_on; eauto. - exploit Mem.store_valid_access_3; eauto. intros [P Q]. - intros. unfold loc_not_writable. red; intros. elim H2. - apply Mem.perm_cur_max. apply P. auto. + eapply Mem.store_unchanged_on; eauto. + exploit Mem.store_valid_access_3; eauto. intros [P Q]. + intros. unfold loc_not_writable. red; intros. elim H2. + apply Mem.perm_cur_max. apply P. auto. Qed. Lemma volatile_store_extends: @@ -848,19 +848,19 @@ Lemma volatile_store_extends: volatile_store ge chunk m1 b ofs v t m2 -> Mem.extends m1 m1' -> Val.lessdef v v' -> - exists m2', + exists m2', volatile_store ge chunk m1' b ofs v' t m2' /\ Mem.extends m2 m2' /\ Mem.unchanged_on (loc_out_of_bounds m1) m1' m2'. Proof. intros. inv H. - econstructor; split. econstructor; eauto. - eapply eventval_match_lessdef; eauto. apply Val.load_result_lessdef; auto. + eapply eventval_match_lessdef; eauto. apply Val.load_result_lessdef; auto. auto with mem. - exploit Mem.store_within_extends; eauto. intros [m2' [A B]]. exists m2'; intuition. + econstructor; eauto. -+ eapply Mem.store_unchanged_on; eauto. ++ eapply Mem.store_unchanged_on; eauto. unfold loc_out_of_bounds; intros. assert (Mem.perm m1 b i Max Nonempty). { apply Mem.perm_cur_max. apply Mem.perm_implies with Writable; auto with mem. @@ -881,13 +881,13 @@ Lemma volatile_store_inject: /\ Mem.unchanged_on (loc_unmapped f) m1 m2 /\ Mem.unchanged_on (loc_out_of_reach f m1) m1' m2'. Proof. - intros until v'; intros SI VS AI VI MI. - generalize SI; intros (P & Q & R & S). + intros until v'; intros SI VS AI VI MI. + generalize SI; intros (P & Q & R & S). inv VS. - (* volatile store *) - inv AI. exploit Q; eauto. intros [A B]. subst delta. + inv AI. exploit Q; eauto. intros [A B]. subst delta. rewrite Int.add_zero. exists m1'; split. - constructor; auto. erewrite S; eauto. + constructor; auto. erewrite S; eauto. eapply eventval_match_inject; eauto. apply Val.load_result_inject. auto. intuition auto with mem. - (* normal store *) @@ -895,17 +895,17 @@ Proof. assert (Mem.storev chunk m1 (Vptr b ofs) v = Some m2). simpl; auto. exploit Mem.storev_mapped_inject; eauto. intros [m2' [A B]]. exists m2'; intuition auto. -+ constructor; auto. erewrite S; eauto. ++ constructor; auto. erewrite S; eauto. + eapply Mem.store_unchanged_on; eauto. unfold loc_unmapped; intros. inv AI; congruence. -+ eapply Mem.store_unchanged_on; eauto. - unfold loc_out_of_reach; intros. red; intros. simpl in A. ++ eapply Mem.store_unchanged_on; eauto. + unfold loc_out_of_reach; intros. red; intros. simpl in A. assert (EQ: Int.unsigned (Int.add ofs (Int.repr delta)) = Int.unsigned ofs + delta) by (eapply Mem.address_inject; eauto with mem). rewrite EQ in *. - eelim H3; eauto. - exploit Mem.store_valid_access_3. eexact H0. intros [X Y]. - apply Mem.perm_cur_max. apply Mem.perm_implies with Writable; auto with mem. + eelim H3; eauto. + exploit Mem.store_valid_access_3. eexact H0. intros [X Y]. + apply Mem.perm_cur_max. apply Mem.perm_implies with Writable; auto with mem. apply X. omega. Qed. @@ -913,29 +913,29 @@ Lemma volatile_store_receptive: forall ge chunk m b ofs v t1 m1 t2, volatile_store ge chunk m b ofs v t1 m1 -> match_traces ge t1 t2 -> t1 = t2. Proof. - intros. inv H; inv H0; auto. + intros. inv H; inv H0; auto. Qed. Lemma volatile_store_ok: forall chunk, - extcall_properties (volatile_store_sem chunk) + extcall_properties (volatile_store_sem chunk) (mksignature (Tint :: type_of_chunk chunk :: nil) None cc_default). Proof. intros; constructor; intros. (* well typed *) - unfold proj_sig_res; simpl. inv H; constructor. (* symbols preserved *) -- inv H2. constructor. eapply volatile_store_preserved; eauto. +- inv H2. constructor. eapply volatile_store_preserved; eauto. (* valid block *) - inv H. inv H1. auto. eauto with mem. (* perms *) -- inv H. inv H2. auto. eauto with mem. +- inv H. inv H2. auto. eauto with mem. (* readonly *) - inv H. eapply volatile_store_readonly; eauto. (* mem extends*) - inv H. inv H1. inv H6. inv H7. inv H4. - exploit volatile_store_extends; eauto. intros [m2' [A [B C]]]. - exists Vundef; exists m2'; intuition. constructor; auto. + exploit volatile_store_extends; eauto. intros [m2' [A [B C]]]. + exists Vundef; exists m2'; intuition. constructor; auto. (* mem inject *) - inv H0. inv H2. inv H7. inv H8. inversion H5; subst. exploit volatile_store_inject; eauto. intros [m2' [A [B [C D]]]]. @@ -963,7 +963,7 @@ Inductive extcall_malloc_sem (ge: Senv.t): extcall_malloc_sem ge (Vint n :: nil) m E0 (Vptr b Int.zero) m''. Lemma extcall_malloc_ok: - extcall_properties extcall_malloc_sem + extcall_properties extcall_malloc_sem (mksignature (Tint :: nil) (Some Tint) cc_default). Proof. assert (UNCHANGED: @@ -978,7 +978,7 @@ Proof. erewrite Mem.store_mem_contents; eauto. rewrite Maps.PMap.gso by auto. Local Transparent Mem.alloc. unfold Mem.alloc in H. injection H; intros A B. rewrite <- B; simpl. rewrite A. rewrite Maps.PMap.gso by auto. auto. - } + } constructor; intros. (* well typed *) @@ -989,34 +989,34 @@ Proof. - inv H. eauto with mem. (* perms *) - inv H. exploit Mem.perm_alloc_inv. eauto. eapply Mem.perm_store_2; eauto. - rewrite dec_eq_false. auto. + rewrite dec_eq_false. auto. apply Mem.valid_not_valid_diff with m1; eauto with mem. (* readonly *) -- inv H. eapply UNCHANGED; eauto. +- inv H. eapply UNCHANGED; eauto. (* mem extends *) -- inv H. inv H1. inv H5. inv H7. +- inv H. inv H1. inv H5. inv H7. exploit Mem.alloc_extends; eauto. apply Zle_refl. apply Zle_refl. intros [m3' [A B]]. - exploit Mem.store_within_extends. eexact B. eauto. - instantiate (1 := Vint n). auto. + exploit Mem.store_within_extends. eexact B. eauto. + instantiate (1 := Vint n). auto. intros [m2' [C D]]. exists (Vptr b Int.zero); exists m2'; intuition. econstructor; eauto. eapply UNCHANGED; eauto. (* mem injects *) - inv H0. inv H2. inv H6. inv H8. - exploit Mem.alloc_parallel_inject; eauto. apply Zle_refl. apply Zle_refl. + exploit Mem.alloc_parallel_inject; eauto. apply Zle_refl. apply Zle_refl. intros [f' [m3' [b' [ALLOC [A [B [C D]]]]]]]. - exploit Mem.store_mapped_inject. eexact A. eauto. eauto. - instantiate (1 := Vint n). auto. + exploit Mem.store_mapped_inject. eexact A. eauto. eauto. + instantiate (1 := Vint n). auto. intros [m2' [E G]]. exists f'; exists (Vptr b' Int.zero); exists m2'; intuition. econstructor; eauto. econstructor. eauto. auto. eapply UNCHANGED; eauto. eapply UNCHANGED; eauto. - red; intros. destruct (eq_block b1 b). - subst b1. rewrite C in H2. inv H2. eauto with mem. + red; intros. destruct (eq_block b1 b). + subst b1. rewrite C in H2. inv H2. eauto with mem. rewrite D in H2 by auto. congruence. (* trace length *) - inv H; simpl; omega. @@ -1024,7 +1024,7 @@ Proof. - assert (t1 = t2). inv H; inv H0; auto. subst t2. exists vres1; exists m1; auto. (* determ *) -- inv H; inv H0. split. constructor. intuition congruence. +- inv H; inv H0. split. constructor. intuition congruence. Qed. (** ** Semantics of dynamic memory deallocation (free) *) @@ -1038,7 +1038,7 @@ Inductive extcall_free_sem (ge: Senv.t): extcall_free_sem ge (Vptr b lo :: nil) m E0 Vundef m'. Lemma extcall_free_ok: - extcall_properties extcall_free_sem + extcall_properties extcall_free_sem (mksignature (Tint :: nil) None cc_default). Proof. constructor; intros. @@ -1049,22 +1049,22 @@ Proof. (* valid block *) - inv H. eauto with mem. (* perms *) -- inv H. eapply Mem.perm_free_3; eauto. +- inv H. eapply Mem.perm_free_3; eauto. (* readonly *) -- inv H. eapply Mem.free_unchanged_on; eauto. - intros. red; intros. elim H3. - apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. - eapply Mem.free_range_perm; eauto. +- inv H. eapply Mem.free_unchanged_on; eauto. + intros. red; intros. elim H3. + apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. + eapply Mem.free_range_perm; eauto. (* mem extends *) -- inv H. inv H1. inv H8. inv H6. - exploit Mem.load_extends; eauto. intros [vsz [A B]]. inv B. +- inv H. inv H1. inv H8. inv H6. + exploit Mem.load_extends; eauto. intros [vsz [A B]]. inv B. exploit Mem.free_parallel_extends; eauto. intros [m2' [C D]]. exists Vundef; exists m2'; intuition. econstructor; eauto. - eapply Mem.free_unchanged_on; eauto. - unfold loc_out_of_bounds; intros. + eapply Mem.free_unchanged_on; eauto. + unfold loc_out_of_bounds; intros. assert (Mem.perm m1 b i Max Nonempty). - { apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. + { apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. eapply Mem.free_range_perm. eexact H4. eauto. } tauto. (* mem inject *) @@ -1072,24 +1072,24 @@ Proof. exploit Mem.load_inject; eauto. intros [vsz [A B]]. inv B. assert (Mem.range_perm m1 b (Int.unsigned lo - 4) (Int.unsigned lo + Int.unsigned sz) Cur Freeable). eapply Mem.free_range_perm; eauto. - exploit Mem.address_inject; eauto. + exploit Mem.address_inject; eauto. apply Mem.perm_implies with Freeable; auto with mem. - apply H0. instantiate (1 := lo). omega. + apply H0. instantiate (1 := lo). omega. intro EQ. exploit Mem.free_parallel_inject; eauto. intros (m2' & C & D). exists f, Vundef, m2'; split. - apply extcall_free_sem_intro with (sz := sz) (m' := m2'). - rewrite EQ. rewrite <- A. f_equal. omega. + apply extcall_free_sem_intro with (sz := sz) (m' := m2'). + rewrite EQ. rewrite <- A. f_equal. omega. auto. rewrite ! EQ. rewrite <- C. f_equal; omega. - split. auto. + split. auto. split. auto. split. eapply Mem.free_unchanged_on; eauto. unfold loc_unmapped. intros; congruence. - split. eapply Mem.free_unchanged_on; eauto. unfold loc_out_of_reach. + split. eapply Mem.free_unchanged_on; eauto. unfold loc_out_of_reach. intros. red; intros. eelim H7; eauto. - apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. + apply Mem.perm_cur_max. apply Mem.perm_implies with Freeable; auto with mem. apply H0. omega. - split. auto. + split. auto. red; intros. congruence. (* trace length *) - inv H; simpl; omega. @@ -1122,19 +1122,19 @@ Lemma extcall_memcpy_ok: Proof. intros. constructor. - (* return type *) - intros. inv H. constructor. + intros. inv H. constructor. - (* change of globalenv *) intros. inv H2. econstructor; eauto. - (* valid blocks *) - intros. inv H. eauto with mem. + intros. inv H. eauto with mem. - (* perms *) - intros. inv H. eapply Mem.perm_storebytes_2; eauto. + intros. inv H. eapply Mem.perm_storebytes_2; eauto. - (* readonly *) - intros. inv H. eapply Mem.storebytes_unchanged_on; eauto. - intros; red; intros. elim H8. - apply Mem.perm_cur_max. eapply Mem.storebytes_range_perm; eauto. + intros. inv H. eapply Mem.storebytes_unchanged_on; eauto. + intros; red; intros. elim H8. + apply Mem.perm_cur_max. eapply Mem.storebytes_range_perm; eauto. - (* extensions *) - intros. inv H. + intros. inv H. inv H1. inv H13. inv H14. inv H10. inv H11. exploit Mem.loadbytes_length; eauto. intros LEN. exploit Mem.loadbytes_extends; eauto. intros [bytes2 [A B]]. @@ -1143,28 +1143,28 @@ Proof. split. econstructor; eauto. split. constructor. split. auto. - eapply Mem.storebytes_unchanged_on; eauto. unfold loc_out_of_bounds; intros. + eapply Mem.storebytes_unchanged_on; eauto. unfold loc_out_of_bounds; intros. assert (Mem.perm m1 bdst i Max Nonempty). apply Mem.perm_cur_max. apply Mem.perm_implies with Writable; auto with mem. - eapply Mem.storebytes_range_perm; eauto. - erewrite list_forall2_length; eauto. + eapply Mem.storebytes_range_perm; eauto. + erewrite list_forall2_length; eauto. tauto. - (* injections *) intros. inv H0. inv H2. inv H14. inv H15. inv H11. inv H12. destruct (zeq sz 0). + (* special case sz = 0 *) - assert (bytes = nil). + assert (bytes = nil). { exploit (Mem.loadbytes_empty m1 bsrc (Int.unsigned osrc) sz). omega. congruence. } subst. destruct (Mem.range_perm_storebytes m1' b0 (Int.unsigned (Int.add odst (Int.repr delta0))) nil) as [m2' SB]. simpl. red; intros; omegaContradiction. - exists f, Vundef, m2'. - split. econstructor; eauto. + exists f, Vundef, m2'. + split. econstructor; eauto. intros; omegaContradiction. intros; omegaContradiction. - right; omega. - apply Mem.loadbytes_empty. omega. + right; omega. + apply Mem.loadbytes_empty. omega. split. auto. split. eapply Mem.storebytes_empty_inject; eauto. split. eapply Mem.storebytes_unchanged_on; eauto. unfold loc_unmapped; intros. @@ -1190,7 +1190,7 @@ Proof. exploit Mem.loadbytes_inject; eauto. intros [bytes2 [A B]]. exploit Mem.storebytes_mapped_inject; eauto. intros [m2' [C D]]. exists f; exists Vundef; exists m2'. - split. econstructor; try rewrite EQ1; try rewrite EQ2; eauto. + split. econstructor; try rewrite EQ1; try rewrite EQ2; eauto. intros; eapply Mem.aligned_area_inject with (m := m1); eauto. intros; eapply Mem.aligned_area_inject with (m := m1); eauto. eapply Mem.disjoint_or_equal_inject with (m := m1); eauto. @@ -1201,17 +1201,17 @@ Proof. split. eapply Mem.storebytes_unchanged_on; eauto. unfold loc_unmapped; intros. congruence. split. eapply Mem.storebytes_unchanged_on; eauto. unfold loc_out_of_reach; intros. red; intros. - eelim H2; eauto. + eelim H2; eauto. apply Mem.perm_cur_max. apply Mem.perm_implies with Writable; auto with mem. - eapply Mem.storebytes_range_perm; eauto. - erewrite list_forall2_length; eauto. + eapply Mem.storebytes_range_perm; eauto. + erewrite list_forall2_length; eauto. omega. split. apply inject_incr_refl. red; intros; congruence. - (* trace length *) intros; inv H. simpl; omega. - (* receptive *) - intros. + intros. assert (t1 = t2). inv H; inv H0; auto. subst t2. exists vres1; exists m1; auto. - (* determ *) @@ -1235,7 +1235,7 @@ Proof. (* well typed *) - inv H. simpl. auto. (* symbols *) -- inv H2. econstructor; eauto. +- inv H2. econstructor; eauto. eapply eventval_list_match_preserved; eauto. (* valid blocks *) - inv H; auto. @@ -1257,7 +1257,7 @@ Proof. (* trace length *) - inv H; simpl; omega. (* receptive *) -- assert (t1 = t2). inv H; inv H0; auto. +- assert (t1 = t2). inv H; inv H0; auto. exists vres1; exists m1; congruence. (* determ *) - inv H; inv H0. @@ -1280,7 +1280,7 @@ Proof. (* well typed *) - inv H. unfold proj_sig_res; simpl. eapply eventval_match_type; eauto. (* symbols *) -- inv H2. econstructor; eauto. +- inv H2. econstructor; eauto. eapply eventval_match_preserved; eauto. (* valid blocks *) - inv H; auto. @@ -1289,7 +1289,7 @@ Proof. (* readonly *) - inv H. apply Mem.unchanged_on_refl. (* mem extends *) -- inv H. inv H1. inv H6. +- inv H. inv H1. inv H6. exists v2; exists m1'; intuition. econstructor; eauto. eapply eventval_match_lessdef; eauto. @@ -1324,7 +1324,7 @@ Proof. (* well typed *) - inv H. simpl. auto. (* symbols *) -- inv H2. econstructor; eauto. +- inv H2. econstructor; eauto. (* valid blocks *) - inv H; auto. (* perms *) @@ -1386,7 +1386,7 @@ Definition external_call (ef: external_function): extcall_sem := | EF_builtin name sg => external_functions_sem name sg | EF_vload chunk => volatile_load_sem chunk | EF_vstore chunk => volatile_store_sem chunk - | EF_malloc => extcall_malloc_sem + | EF_malloc => extcall_malloc_sem | EF_free => extcall_free_sem | EF_memcpy sz al => extcall_memcpy_sem sz al | EF_annot txt targs => extcall_annot_sem txt targs @@ -1396,7 +1396,7 @@ Definition external_call (ef: external_function): extcall_sem := end. Theorem external_call_spec: - forall ef, + forall ef, extcall_properties (external_call ef) (ef_sig ef). Proof. intros. unfold external_call, ef_sig; destruct ef. @@ -1473,7 +1473,7 @@ Lemma external_call_mem_inject: /\ inject_incr f f' /\ inject_separated f f' m1 m1'. Proof. - intros. destruct H as (A & B & C). eapply external_call_mem_inject_gen with (ge1 := ge); eauto. + intros. destruct H as (A & B & C). eapply external_call_mem_inject_gen with (ge1 := ge); eauto. repeat split; intros. + simpl in H3. exploit A; eauto. intros EQ; rewrite EQ in H; inv H. auto. + simpl in H3. exploit A; eauto. intros EQ; rewrite EQ in H; inv H. auto. @@ -1548,29 +1548,29 @@ Inductive external_call' Lemma decode_longs_lessdef: forall tyl vl1 vl2, Val.lessdef_list vl1 vl2 -> Val.lessdef_list (decode_longs tyl vl1) (decode_longs tyl vl2). Proof. - induction tyl; simpl; intros. + induction tyl; simpl; intros. auto. - destruct a; inv H; auto. inv H1; auto. constructor; auto. apply Val.longofwords_lessdef; auto. + destruct a; inv H; auto. inv H1; auto. constructor; auto. apply Val.longofwords_lessdef; auto. Qed. Lemma decode_longs_inject: forall f tyl vl1 vl2, Val.inject_list f vl1 vl2 -> Val.inject_list f (decode_longs tyl vl1) (decode_longs tyl vl2). Proof. - induction tyl; simpl; intros. + induction tyl; simpl; intros. auto. destruct a; inv H; auto. inv H1; auto. constructor; auto. apply Val.longofwords_inject; auto. Qed. Lemma encode_long_lessdef: forall oty v1 v2, Val.lessdef v1 v2 -> Val.lessdef_list (encode_long oty v1) (encode_long oty v2). Proof. - intros. destruct oty as [[]|]; simpl; auto. + intros. destruct oty as [[]|]; simpl; auto. constructor. apply Val.hiword_lessdef; auto. constructor. apply Val.loword_lessdef; auto. auto. Qed. Lemma encode_long_inject: forall f oty v1 v2, Val.inject f v1 v2 -> Val.inject_list f (encode_long oty v1) (encode_long oty v2). Proof. - intros. destruct oty as [[]|]; simpl; auto. + intros. destruct oty as [[]|]; simpl; auto. constructor. apply Val.hiword_inject; auto. constructor. apply Val.loword_inject; auto. auto. Qed. @@ -1589,8 +1589,8 @@ Lemma external_call_well_typed': external_call' ef ge vargs m1 t vres m2 -> Val.has_type_list vres (proj_sig_res' (ef_sig ef)). Proof. - intros. inv H. apply encode_long_has_type. - eapply external_call_well_typed; eauto. + intros. inv H. apply encode_long_has_type. + eapply external_call_well_typed; eauto. Qed. Lemma external_call_symbols_preserved': @@ -1631,9 +1631,9 @@ Lemma external_call_mem_extends': /\ Mem.extends m2 m2' /\ Mem.unchanged_on (loc_out_of_bounds m1) m1' m2'. Proof. - intros. inv H. + intros. inv H. exploit external_call_mem_extends; eauto. - eapply decode_longs_lessdef; eauto. + eapply decode_longs_lessdef; eauto. intros (v' & m2' & A & B & C & D). exists (encode_long (sig_res (ef_sig ef)) v'); exists m2'; intuition. econstructor; eauto. @@ -1655,7 +1655,7 @@ Lemma external_call_mem_inject': /\ inject_incr f f' /\ inject_separated f f' m1 m1'. Proof. - intros. inv H0. + intros. inv H0. exploit external_call_mem_inject; eauto. eapply decode_longs_inject; eauto. intros (f' & v' & m2' & A & B & C & D & E & P & Q). @@ -1670,8 +1670,8 @@ Lemma external_call_determ': external_call' ef ge vargs m t2 vres2 m2 -> match_traces ge t1 t2 /\ (t1 = t2 -> vres1 = vres2 /\ m1 = m2). Proof. - intros. inv H; inv H0. exploit external_call_determ. eexact H1. eexact H. - intros [A B]. split. auto. intros. destruct B as [C D]; auto. subst. auto. + intros. inv H; inv H0. exploit external_call_determ. eexact H1. eexact H. + intros [A B]. split. auto. intros. destruct B as [C D]; auto. subst. auto. Qed. Lemma external_call_match_traces': @@ -1689,7 +1689,7 @@ Lemma external_call_deterministic': external_call' ef ge vargs m t vres2 m2 -> vres1 = vres2 /\ m1 = m2. Proof. - intros. inv H; inv H0. + intros. inv H; inv H0. exploit external_call_deterministic. eexact H1. eexact H. intros [A B]. split; congruence. Qed. @@ -1768,13 +1768,13 @@ Lemma eval_builtin_arg_preserved: Proof. assert (EQ: forall id ofs, Senv.symbol_address ge2 id ofs = Senv.symbol_address ge1 id ofs). { unfold Senv.symbol_address; simpl; intros. rewrite symbols_preserved; auto. } - induction 1; eauto with barg. rewrite <- EQ in H; eauto with barg. rewrite <- EQ; eauto with barg. -Qed. + induction 1; eauto with barg. rewrite <- EQ in H; eauto with barg. rewrite <- EQ; eauto with barg. +Qed. Lemma eval_builtin_args_preserved: forall al vl, eval_builtin_args ge1 e sp m al vl -> eval_builtin_args ge2 e sp m al vl. Proof. - induction 1; constructor; auto; eapply eval_builtin_arg_preserved; eauto. + induction 1; constructor; auto; eapply eval_builtin_arg_preserved; eauto. Qed. End EVAL_BUILTIN_ARG_PRESERVED. @@ -1802,13 +1802,13 @@ Proof. - econstructor; eauto with barg. - econstructor; eauto with barg. - econstructor; eauto with barg. -- exploit Mem.loadv_extends; eauto. intros (v' & P & Q). exists v'; eauto with barg. +- exploit Mem.loadv_extends; eauto. intros (v' & P & Q). exists v'; eauto with barg. - econstructor; eauto with barg. - exploit Mem.loadv_extends; eauto. intros (v' & P & Q). exists v'; eauto with barg. - econstructor; eauto with barg. - destruct IHeval_builtin_arg1 as (vhi' & P & Q). destruct IHeval_builtin_arg2 as (vlo' & R & S). - econstructor; split; eauto with barg. apply Val.longofwords_lessdef; auto. + econstructor; split; eauto with barg. apply Val.longofwords_lessdef; auto. Qed. Lemma eval_builtin_args_lessdef: @@ -1817,7 +1817,7 @@ Lemma eval_builtin_args_lessdef: Proof. induction 1. - econstructor; split. constructor. auto. -- exploit eval_builtin_arg_lessdef; eauto. intros (v1' & P & Q). +- exploit eval_builtin_arg_lessdef; eauto. intros (v1' & P & Q). destruct IHlist_forall2 as (vl' & U & V). exists (v1'::vl'); split; constructor; auto. Qed. diff --git a/common/Globalenvs.v b/common/Globalenvs.v index 30f03654..5f78ea6b 100644 --- a/common/Globalenvs.v +++ b/common/Globalenvs.v @@ -14,11 +14,11 @@ (* *) (* *********************************************************************) -(** Global environments are a component of the dynamic semantics of +(** Global environments are a component of the dynamic semantics of all languages involved in the compiler. A global environment maps symbol names (names of functions and of global variables) to the corresponding memory addresses. It also maps memory addresses - of functions to the corresponding function descriptions. + of functions to the corresponding function descriptions. Global environments, along with the initial memory state at the beginning of program execution, are built from the program of interest, as follows: @@ -110,7 +110,7 @@ Theorem shift_symbol_address: forall ge id ofs n, symbol_address ge id (Int.add ofs n) = Val.add (symbol_address ge id ofs) (Vint n). Proof. - intros. unfold symbol_address. destruct (find_symbol ge id); auto. + intros. unfold symbol_address. destruct (find_symbol ge id); auto. Qed. End Senv. @@ -137,7 +137,7 @@ Record t: Type := mkgenv { genv_vars_range: forall b v, PTree.get b genv_vars = Some v -> Plt b genv_next; genv_funs_vars: forall b1 b2 f v, PTree.get b1 genv_funs = Some f -> PTree.get b2 genv_vars = Some v -> b1 <> b2; - genv_vars_inj: forall id1 id2 b, + genv_vars_inj: forall id1 id2 b, PTree.get id1 genv_symb = Some b -> PTree.get id2 genv_symb = Some b -> id1 = id2 }. @@ -225,18 +225,18 @@ Next Obligation. apply Plt_trans_succ; eauto. Qed. Next Obligation. - destruct ge; simpl in *. - destruct g. - rewrite PTree.gsspec in H. + destruct ge; simpl in *. + destruct g. + rewrite PTree.gsspec in H. destruct (peq b genv_next0). inv H. apply Plt_succ. apply Plt_trans_succ; eauto. apply Plt_trans_succ; eauto. Qed. Next Obligation. - destruct ge; simpl in *. + destruct ge; simpl in *. destruct g. apply Plt_trans_succ; eauto. - rewrite PTree.gsspec in H. + rewrite PTree.gsspec in H. destruct (peq b genv_next0). inv H. apply Plt_succ. apply Plt_trans_succ; eauto. Qed. @@ -253,8 +253,8 @@ Next Obligation. eauto. Qed. Next Obligation. - destruct ge; simpl in *. - rewrite PTree.gsspec in H. rewrite PTree.gsspec in H0. + destruct ge; simpl in *. + rewrite PTree.gsspec in H. rewrite PTree.gsspec in H0. destruct (peq id1 i); destruct (peq id2 i). congruence. inv H. eelim Plt_strict. eapply genv_symb_range0; eauto. @@ -304,9 +304,9 @@ Lemma add_globals_preserves: (forall ge id g, P ge -> In (id, g) gl -> P (add_global ge (id, g))) -> P ge -> P (add_globals ge gl). Proof. - induction gl; simpl; intros. + induction gl; simpl; intros. auto. - destruct a. apply IHgl; auto. + destruct a. apply IHgl; auto. Qed. Lemma add_globals_ensures: @@ -317,8 +317,8 @@ Lemma add_globals_ensures: Proof. induction gl; simpl; intros. contradiction. - destruct H1. subst a. apply add_globals_preserves; auto. - apply IHgl; auto. + destruct H1. subst a. apply add_globals_preserves; auto. + apply IHgl; auto. Qed. Lemma add_globals_unique_preserves: @@ -326,9 +326,9 @@ Lemma add_globals_unique_preserves: (forall ge id1 g, P ge -> In (id1, g) gl -> id1 <> id -> P (add_global ge (id1, g))) -> ~In id (map fst gl) -> P ge -> P (add_globals ge gl). Proof. - induction gl; simpl; intros. + induction gl; simpl; intros. auto. - destruct a. apply IHgl; auto. + destruct a. apply IHgl; auto. Qed. Lemma add_globals_unique_ensures: @@ -347,10 +347,10 @@ Remark in_norepet_unique: Proof. induction gl as [|[id1 g1] gl]; simpl; intros. contradiction. - inv H0. destruct H. - inv H. exists nil, gl. auto. - exploit IHgl; eauto. intros (gl1 & gl2 & X & Y). - exists ((id1, g1) :: gl1), gl2; split; auto. rewrite X; auto. + inv H0. destruct H. + inv H. exists nil, gl. auto. + exploit IHgl; eauto. intros (gl1 & gl2 & X & Y). + exists ((id1, g1) :: gl1), gl2; split; auto. rewrite X; auto. Qed. Lemma add_globals_norepet_ensures: @@ -359,8 +359,8 @@ Lemma add_globals_norepet_ensures: (forall ge, P (add_global ge (id, g))) -> In (id, g) gl -> list_norepet (map fst gl) -> P (add_globals ge gl). Proof. - intros. exploit in_norepet_unique; eauto. intros (gl1 & gl2 & X & Y). - subst gl. apply add_globals_unique_ensures; auto. intros. eapply H; eauto. + intros. exploit in_norepet_unique; eauto. intros (gl1 & gl2 & X & Y). + subst gl. apply add_globals_unique_ensures; auto. intros. eapply H; eauto. apply in_or_app; simpl; auto. Qed. @@ -371,7 +371,7 @@ End GLOBALENV_PRINCIPLES. Theorem public_symbol_exists: forall ge id, public_symbol ge id = true -> exists b, find_symbol ge id = Some b. Proof. - unfold public_symbol; intros. destruct (find_symbol ge id) as [b|]. + unfold public_symbol; intros. destruct (find_symbol ge id) as [b|]. exists b; auto. discriminate. Qed. @@ -380,15 +380,15 @@ Theorem shift_symbol_address: forall ge id ofs n, symbol_address ge id (Int.add ofs n) = Val.add (symbol_address ge id ofs) (Vint n). Proof. - intros. unfold symbol_address. destruct (find_symbol ge id); auto. + intros. unfold symbol_address. destruct (find_symbol ge id); auto. Qed. Theorem find_funct_inv: forall ge v f, find_funct ge v = Some f -> exists b, v = Vptr b Int.zero. Proof. - intros until f; unfold find_funct. - destruct v; try congruence. + intros until f; unfold find_funct. + destruct v; try congruence. destruct (Int.eq_dec i Int.zero); try congruence. intros. exists b; congruence. Qed. @@ -428,7 +428,7 @@ Proof. rewrite PTree.gso; auto. destruct g1 as [f1 | v1]. rewrite PTree.gso. auto. apply Plt_ne. eapply genv_funs_range; eauto. - auto. + auto. (* ensures *) intros. unfold find_symbol, find_funct_ptr in *; simpl. exists (genv_next ge); split. apply PTree.gss. apply PTree.gss. @@ -442,8 +442,8 @@ Corollary find_funct_ptr_exists: find_symbol (globalenv p) id = Some b /\ find_funct_ptr (globalenv p) b = Some f. Proof. - intros. exploit in_norepet_unique; eauto. intros (gl1 & gl2 & X & Y). - eapply find_funct_ptr_exists_2; eauto. + intros. exploit in_norepet_unique; eauto. intros (gl1 & gl2 & X & Y). + eapply find_funct_ptr_exists_2; eauto. Qed. Theorem find_var_exists_2: @@ -462,7 +462,7 @@ Proof. apply Plt_ne. eapply genv_vars_range; eauto. (* ensures *) intros. unfold find_symbol, find_var_info in *; simpl. - exists (genv_next ge); split. apply PTree.gss. apply PTree.gss. + exists (genv_next ge); split. apply PTree.gss. apply PTree.gss. Qed. Corollary find_var_exists: @@ -473,8 +473,8 @@ Corollary find_var_exists: find_symbol (globalenv p) id = Some b /\ find_var_info (globalenv p) b = Some v. Proof. - intros. exploit in_norepet_unique; eauto. intros (gl1 & gl2 & X & Y). - eapply find_var_exists_2; eauto. + intros. exploit in_norepet_unique; eauto. intros (gl1 & gl2 & X & Y). + eapply find_var_exists_2; eauto. Qed. Lemma find_symbol_inversion : forall p x b, @@ -483,7 +483,7 @@ Lemma find_symbol_inversion : forall p x b, Proof. intros until b; unfold globalenv. eapply add_globals_preserves. (* preserves *) - unfold find_symbol; simpl; intros. rewrite PTree.gsspec in H1. + unfold find_symbol; simpl; intros. rewrite PTree.gsspec in H1. destruct (peq x id). subst x. change id with (fst (id, g)). apply List.in_map; auto. auto. (* base *) @@ -495,9 +495,9 @@ Theorem find_funct_ptr_inversion: find_funct_ptr (globalenv p) b = Some f -> exists id, In (id, Gfun f) (prog_defs p). Proof. - intros until f. unfold globalenv. apply add_globals_preserves. + intros until f. unfold globalenv. apply add_globals_preserves. (* preserves *) - unfold find_funct_ptr; simpl; intros. destruct g; auto. + unfold find_funct_ptr; simpl; intros. destruct g; auto. rewrite PTree.gsspec in H1. destruct (peq b (genv_next ge)). inv H1. exists id; auto. auto. @@ -510,7 +510,7 @@ Theorem find_funct_inversion: find_funct (globalenv p) v = Some f -> exists id, In (id, Gfun f) (prog_defs p). Proof. - intros. exploit find_funct_inv; eauto. intros [b EQ]. subst v. + intros. exploit find_funct_inv; eauto. intros [b EQ]. subst v. rewrite find_funct_find_funct_ptr in H. eapply find_funct_ptr_inversion; eauto. Qed. @@ -539,9 +539,9 @@ Theorem find_funct_ptr_symbol_inversion: find_funct_ptr (globalenv p) b = Some f -> In (id, Gfun f) p.(prog_defs). Proof. - intros until f. unfold globalenv, find_symbol, find_funct_ptr. apply add_globals_preserves. + intros until f. unfold globalenv, find_symbol, find_funct_ptr. apply add_globals_preserves. (* preserves *) - intros. simpl in *. rewrite PTree.gsspec in H1. destruct (peq id id0). + intros. simpl in *. rewrite PTree.gsspec in H1. destruct (peq id id0). inv H1. destruct g as [f1|v1]. rewrite PTree.gss in H2. inv H2. auto. eelim Plt_strict. eapply genv_funs_range; eauto. destruct g as [f1|v1]. rewrite PTree.gso in H2. auto. @@ -559,7 +559,7 @@ Theorem global_addresses_distinct: find_symbol ge id2 = Some b2 -> b1 <> b2. Proof. - intros. red; intros; subst. elim H. destruct ge. eauto. + intros. red; intros; subst. elim H. destruct ge. eauto. Qed. Theorem invert_find_symbol: @@ -568,9 +568,9 @@ Theorem invert_find_symbol: Proof. intros until b; unfold find_symbol, invert_symbol. apply PTree_Properties.fold_rec. - intros. rewrite H in H0; auto. + intros. rewrite H in H0; auto. congruence. - intros. destruct (eq_block b v). inv H2. apply PTree.gss. + intros. destruct (eq_block b v). inv H2. apply PTree.gss. rewrite PTree.gsspec. destruct (peq id k). subst. assert (m!k = Some b) by auto. congruence. auto. @@ -588,9 +588,9 @@ Proof. rewrite PTree.gempty; congruence. intros. destruct (eq_block b v). exists k; auto. rewrite PTree.gsspec in H2. destruct (peq id k). - inv H2. congruence. auto. + inv H2. congruence. auto. - intros; exploit H; eauto. intros [id' A]. + intros; exploit H; eauto. intros [id' A]. assert (id = id'). eapply genv_vars_inj; eauto. apply invert_find_symbol; auto. congruence. Qed. @@ -604,14 +604,14 @@ Remark genv_next_add_globals: Proof. induction gl; simpl; intros. auto. - rewrite IHgl. auto. + rewrite IHgl. auto. Qed. Remark genv_public_add_globals: forall gl ge, genv_public (add_globals ge gl) = genv_public ge. Proof. - induction gl; simpl; intros. + induction gl; simpl; intros. auto. rewrite IHgl; auto. Qed. @@ -619,7 +619,7 @@ Qed. Theorem globalenv_public: forall p, genv_public (globalenv p) = prog_public p. Proof. - unfold globalenv; intros. rewrite genv_public_add_globals. auto. + unfold globalenv; intros. rewrite genv_public_add_globals. auto. Qed. Theorem block_is_volatile_below: @@ -765,11 +765,11 @@ Remark store_init_data_list_nextblock: Proof. induction idl; simpl; intros until m'. intros. congruence. - caseEq (store_init_data m b p a); try congruence. intros. - transitivity (Mem.nextblock m0). eauto. + caseEq (store_init_data m b p a); try congruence. intros. + transitivity (Mem.nextblock m0). eauto. destruct a; simpl in H; try (eapply Mem.nextblock_store; eauto; fail). congruence. - destruct (find_symbol ge i); try congruence. eapply Mem.nextblock_store; eauto. + destruct (find_symbol ge i); try congruence. eapply Mem.nextblock_store; eauto. Qed. Remark alloc_global_nextblock: @@ -778,10 +778,10 @@ Remark alloc_global_nextblock: Mem.nextblock m' = Psucc(Mem.nextblock m). Proof. unfold alloc_global. intros. - destruct g as [id [f|v]]. + destruct g as [id [f|v]]. (* function *) destruct (Mem.alloc m 0 1) as [m1 b] eqn:?. - erewrite Mem.nextblock_drop; eauto. erewrite Mem.nextblock_alloc; eauto. + erewrite Mem.nextblock_drop; eauto. erewrite Mem.nextblock_alloc; eauto. (* variable *) set (init := gvar_init v) in *. set (sz := init_data_list_size init) in *. @@ -824,13 +824,13 @@ Remark store_init_data_list_perm: (Mem.perm m b' q k prm <-> Mem.perm m' b' q k prm). Proof. induction idl; simpl; intros until m'. - intros. inv H. tauto. + intros. inv H. tauto. caseEq (store_init_data m b p a); try congruence. intros. rewrite <- (IHidl _ _ _ _ H0). assert (forall chunk v, Mem.store chunk m b p v = Some m0 -> (Mem.perm m b' q k prm <-> Mem.perm m0 b' q k prm)). - intros; split; eauto with mem. + intros; split; eauto with mem. destruct a; simpl in H; eauto. inv H; tauto. destruct (find_symbol ge i). eauto. discriminate. @@ -842,13 +842,13 @@ Remark alloc_global_perm: Mem.valid_block m b' -> (Mem.perm m b' q k prm <-> Mem.perm m' b' q k prm). Proof. - intros. destruct idg as [id [f|v]]; simpl in H. + intros. destruct idg as [id [f|v]]; simpl in H. (* function *) - destruct (Mem.alloc m 0 1) as [m1 b] eqn:?. + destruct (Mem.alloc m 0 1) as [m1 b] eqn:?. assert (b' <> b). apply Mem.valid_not_valid_diff with m; eauto with mem. split; intros. - eapply Mem.perm_drop_3; eauto. eapply Mem.perm_alloc_1; eauto. - eapply Mem.perm_alloc_4; eauto. eapply Mem.perm_drop_4; eauto. + eapply Mem.perm_drop_3; eauto. eapply Mem.perm_alloc_1; eauto. + eapply Mem.perm_alloc_4; eauto. eapply Mem.perm_drop_4; eauto. (* variable *) set (init := gvar_init v) in *. set (sz := init_data_list_size init) in *. @@ -860,11 +860,11 @@ Proof. eapply Mem.perm_drop_3; eauto. erewrite <- store_init_data_list_perm; [idtac|eauto]. erewrite <- store_zeros_perm; [idtac|eauto]. - eapply Mem.perm_alloc_1; eauto. + eapply Mem.perm_alloc_1; eauto. eapply Mem.perm_alloc_4; eauto. erewrite store_zeros_perm; [idtac|eauto]. - erewrite store_init_data_list_perm; [idtac|eauto]. - eapply Mem.perm_drop_4; eauto. + erewrite store_init_data_list_perm; [idtac|eauto]. + eapply Mem.perm_drop_4; eauto. Qed. Remark alloc_globals_perm: @@ -876,7 +876,7 @@ Proof. induction gl. simpl; intros. inv H. tauto. simpl; intros. destruct (alloc_global m a) as [m1|] eqn:?; try discriminate. - erewrite alloc_global_perm; eauto. eapply IHgl; eauto. + erewrite alloc_global_perm; eauto. eapply IHgl; eauto. unfold Mem.valid_block in *. erewrite alloc_global_nextblock; eauto. apply Plt_trans_succ; auto. Qed. @@ -892,9 +892,9 @@ Remark store_zeros_load_outside: Proof. intros until n. functional induction (store_zeros m b p n); intros. inv H; auto. - transitivity (Mem.load chunk m' b' p'). - apply IHo. auto. intuition omega. - eapply Mem.load_store_other; eauto. simpl. intuition omega. + transitivity (Mem.load chunk m' b' p'). + apply IHo. auto. intuition omega. + eapply Mem.load_store_other; eauto. simpl. intuition omega. discriminate. Qed. @@ -907,15 +907,15 @@ Remark store_zeros_loadbytes_outside: Proof. intros until n. functional induction (store_zeros m b p n); intros. inv H; auto. - transitivity (Mem.loadbytes m' b' p' n'). + transitivity (Mem.loadbytes m' b' p' n'). apply IHo. auto. intuition omega. - eapply Mem.loadbytes_store_other; eauto. simpl. intuition omega. + eapply Mem.loadbytes_store_other; eauto. simpl. intuition omega. discriminate. Qed. Definition read_as_zero (m: mem) (b: block) (ofs len: Z) : Prop := forall chunk p, - ofs <= p -> p + size_chunk chunk <= ofs + len -> + ofs <= p -> p + size_chunk chunk <= ofs + len -> (align_chunk chunk | p) -> Mem.load chunk m b p = Some (match chunk with @@ -938,18 +938,18 @@ Proof. rewrite inj_S in H1. omegaContradiction. - destruct (zeq p' p). + subst p'. destruct n'. simpl. apply Mem.loadbytes_empty. omega. - rewrite inj_S in H1. rewrite inj_S. + rewrite inj_S in H1. rewrite inj_S. replace (Z.succ (Z.of_nat n')) with (1 + Z.of_nat n') by omega. change (list_repeat (S n') (Byte Byte.zero)) with ((Byte Byte.zero :: nil) ++ list_repeat n' (Byte Byte.zero)). - apply Mem.loadbytes_concat. + apply Mem.loadbytes_concat. erewrite store_zeros_loadbytes_outside; eauto. change (Byte Byte.zero :: nil) with (encode_val Mint8unsigned Vzero). change 1 with (size_chunk Mint8unsigned). - eapply Mem.loadbytes_store_same; eauto. + eapply Mem.loadbytes_store_same; eauto. right; omega. - eapply IHo; eauto. omega. omega. omega. omega. - + eapply IHo; eauto. omega. omega. + eapply IHo; eauto. omega. omega. omega. omega. + + eapply IHo; eauto. omega. omega. - discriminate. Qed. @@ -960,9 +960,9 @@ Lemma store_zeros_read_as_zero: Proof. intros; red; intros. transitivity (Some(decode_val chunk (list_repeat (size_chunk_nat chunk) (Byte Byte.zero)))). - apply Mem.loadbytes_load; auto. rewrite size_chunk_conv. - eapply store_zeros_loadbytes; eauto. rewrite <- size_chunk_conv; auto. - f_equal. destruct chunk; reflexivity. + apply Mem.loadbytes_load; auto. rewrite size_chunk_conv. + eapply store_zeros_loadbytes; eauto. rewrite <- size_chunk_conv; auto. + f_equal. destruct chunk; reflexivity. Qed. Remark store_init_data_outside: @@ -974,8 +974,8 @@ Remark store_init_data_outside: Proof. intros. destruct i; simpl in *; try (eapply Mem.load_store_other; eauto; fail). - inv H; auto. - destruct (find_symbol ge i); try congruence. + inv H; auto. + destruct (find_symbol ge i); try congruence. eapply Mem.load_store_other; eauto; intuition. Qed. @@ -991,7 +991,7 @@ Proof. intros. destruct (store_init_data m b p a) as [m1|] eqn:?; try congruence. transitivity (Mem.load chunk m1 b' q). eapply IHil; eauto. generalize (init_data_size_pos a). intuition omega. - eapply store_init_data_outside; eauto. tauto. + eapply store_init_data_outside; eauto. tauto. Qed. Fixpoint load_store_init_data (m: mem) (b: block) (p: Z) (il: list init_data) {struct il} : Prop := @@ -1041,17 +1041,17 @@ Proof. Mem.load chunk m' b p = Some(Val.load_result chunk v)). { intros. transitivity (Mem.load chunk m1 b p). - eapply store_init_data_list_outside; eauto. right. omega. - eapply Mem.load_store_same; eauto. + eapply store_init_data_list_outside; eauto. right. omega. + eapply Mem.load_store_same; eauto. } induction il; simpl. auto. intros. destruct (store_init_data m b p a) as [m1|] eqn:?; try congruence. exploit IHil; eauto. - red; intros. transitivity (Mem.load chunk m b p0). - eapply store_init_data_outside. eauto. auto. - apply H0. generalize (init_data_size_pos a); omega. omega. auto. - intro D. + red; intros. transitivity (Mem.load chunk m b p0). + eapply store_init_data_outside. eauto. auto. + apply H0. generalize (init_data_size_pos a); omega. omega. auto. + intro D. destruct a; simpl in Heqo; intuition. eapply (A Mint8unsigned (Vint i)); eauto. eapply (A Mint16unsigned (Vint i)); eauto. @@ -1059,11 +1059,11 @@ Proof. eapply (A Mint64 (Vlong i)); eauto. eapply (A Mfloat32 (Vsingle f)); eauto. eapply (A Mfloat64 (Vfloat f)); eauto. - inv Heqo. red; intros. transitivity (Mem.load chunk m1 b p0). - eapply store_init_data_list_outside; eauto. right. simpl. xomega. + inv Heqo. red; intros. transitivity (Mem.load chunk m1 b p0). + eapply store_init_data_list_outside; eauto. right. simpl. xomega. apply H0; auto. simpl. generalize (init_data_list_size_pos il); xomega. - destruct (find_symbol ge i); try congruence. exists b0; split; auto. - eapply (A Mint32 (Vptr b0 i0)); eauto. + destruct (find_symbol ge i); try congruence. exists b0; split; auto. + eapply (A Mint32 (Vptr b0 i0)); eauto. Qed. Remark load_alloc_global: @@ -1074,10 +1074,10 @@ Remark load_alloc_global: Proof. intros. destruct g as [f|v]; simpl in H. (* function *) - destruct (Mem.alloc m 0 1) as [m1 b'] eqn:?. + destruct (Mem.alloc m 0 1) as [m1 b'] eqn:?. assert (b <> b'). apply Mem.valid_not_valid_diff with m; eauto with mem. - transitivity (Mem.load chunk m1 b p). - eapply Mem.load_drop; eauto. + transitivity (Mem.load chunk m1 b p). + eapply Mem.load_drop; eauto. eapply Mem.load_alloc_unchanged; eauto. (* variable *) set (init := gvar_init v) in *. @@ -1086,10 +1086,10 @@ Proof. destruct (store_zeros m1 b' 0 sz) as [m2|] eqn:?; try discriminate. destruct (store_init_data_list m2 b' 0 init) as [m3|] eqn:?; try discriminate. assert (b <> b'). apply Mem.valid_not_valid_diff with m; eauto with mem. - transitivity (Mem.load chunk m3 b p). + transitivity (Mem.load chunk m3 b p). eapply Mem.load_drop; eauto. transitivity (Mem.load chunk m2 b p). - eapply store_init_data_list_outside; eauto. + eapply store_init_data_list_outside; eauto. transitivity (Mem.load chunk m1 b p). eapply store_zeros_load_outside; eauto. eapply Mem.load_alloc_unchanged; eauto. @@ -1104,11 +1104,11 @@ Proof. induction gl; simpl; intros. congruence. destruct (alloc_global m a) as [m''|] eqn:?; try discriminate. - transitivity (Mem.load chunk m'' b p). - apply IHgl; auto. unfold Mem.valid_block in *. - erewrite alloc_global_nextblock; eauto. + transitivity (Mem.load chunk m'' b p). + apply IHgl; auto. unfold Mem.valid_block in *. + erewrite alloc_global_nextblock; eauto. apply Plt_trans with (Mem.nextblock m); auto. apply Plt_succ. - destruct a as [id g]. eapply load_alloc_global; eauto. + destruct a as [id g]. eapply load_alloc_global; eauto. Qed. Remark load_store_init_data_invariant: @@ -1119,7 +1119,7 @@ Remark load_store_init_data_invariant: Proof. induction il; intro p; simpl. auto. - repeat rewrite H. destruct a; intuition. red; intros; rewrite H; auto. + repeat rewrite H. destruct a; intuition. red; intros; rewrite H; auto. Qed. Definition variables_initialized (g: t) (m: mem) := @@ -1146,19 +1146,19 @@ Lemma alloc_global_initialized: /\ functions_initialized (add_global ge (id, g)) m' /\ genv_next (add_global ge (id, g)) = Mem.nextblock m'. Proof. - intros. + intros. exploit alloc_global_nextblock; eauto. intros NB. split. (* variables-initialized *) destruct g as [f|v]. (* function *) - red; intros. unfold find_var_info in H3. simpl in H3. + red; intros. unfold find_var_info in H3. simpl in H3. exploit H1; eauto. intros [A [B C]]. - assert (D: Mem.valid_block m b). + assert (D: Mem.valid_block m b). red. exploit genv_vars_range; eauto. rewrite H; auto. - split. red; intros. erewrite <- alloc_global_perm; eauto. - split. intros. eapply B. erewrite alloc_global_perm; eauto. - intros. apply load_store_init_data_invariant with m; auto. - intros. eapply load_alloc_global; eauto. + split. red; intros. erewrite <- alloc_global_perm; eauto. + split. intros. eapply B. erewrite alloc_global_perm; eauto. + intros. apply load_store_init_data_invariant with m; auto. + intros. eapply load_alloc_global; eauto. (* variable *) red; intros. unfold find_var_info in H3. simpl in H3. rewrite PTree.gsspec in H3. destruct (peq b (genv_next ge0)). @@ -1169,29 +1169,29 @@ Proof. destruct (Mem.alloc m 0 sz) as [m1 b'] eqn:?. destruct (store_zeros m1 b' 0 sz) as [m2|] eqn:?; try discriminate. destruct (store_init_data_list m2 b' 0 init) as [m3|] eqn:?; try discriminate. - exploit Mem.alloc_result; eauto. intro RES. + exploit Mem.alloc_result; eauto. intro RES. replace (genv_next ge0) with b' by congruence. split. red; intros. eapply Mem.perm_drop_1; eauto. split. intros. assert (0 <= ofs < sz). eapply Mem.perm_alloc_3; eauto. erewrite store_zeros_perm; [idtac|eauto]. - erewrite store_init_data_list_perm; [idtac|eauto]. + erewrite store_init_data_list_perm; [idtac|eauto]. eapply Mem.perm_drop_4; eauto. split. auto. eapply Mem.perm_drop_2; eauto. - intros. apply load_store_init_data_invariant with m3. - intros. eapply Mem.load_drop; eauto. - right; right; right. unfold perm_globvar. rewrite H3. + intros. apply load_store_init_data_invariant with m3. + intros. eapply Mem.load_drop; eauto. + right; right; right. unfold perm_globvar. rewrite H3. destruct (gvar_readonly gv); auto with mem. eapply store_init_data_list_charact; eauto. - eapply store_zeros_read_as_zero; eauto. + eapply store_zeros_read_as_zero; eauto. (* older var *) exploit H1; eauto. intros [A [B C]]. - assert (D: Mem.valid_block m b). - red. exploit genv_vars_range; eauto. rewrite H; auto. - split. red; intros. erewrite <- alloc_global_perm; eauto. - split. intros. eapply B. erewrite alloc_global_perm; eauto. - intros. apply load_store_init_data_invariant with m; auto. + assert (D: Mem.valid_block m b). + red. exploit genv_vars_range; eauto. rewrite H; auto. + split. red; intros. erewrite <- alloc_global_perm; eauto. + split. intros. eapply B. erewrite alloc_global_perm; eauto. + intros. apply load_store_init_data_invariant with m; auto. intros. eapply load_alloc_global; eauto. (* functions-initialized *) split. destruct g as [f|v]. @@ -1199,11 +1199,11 @@ Proof. red; intros. unfold find_funct_ptr in H3. simpl in H3. rewrite PTree.gsspec in H3. destruct (peq b (genv_next ge0)). (* same *) - inv H3. simpl in H0. - destruct (Mem.alloc m 0 1) as [m1 b'] eqn:?. - exploit Mem.alloc_result; eauto. intro RES. + inv H3. simpl in H0. + destruct (Mem.alloc m 0 1) as [m1 b'] eqn:?. + exploit Mem.alloc_result; eauto. intro RES. replace (genv_next ge0) with b' by congruence. - split. eapply Mem.perm_drop_1; eauto. omega. + split. eapply Mem.perm_drop_1; eauto. omega. intros. assert (0 <= ofs < 1). eapply Mem.perm_alloc_3; eauto. @@ -1211,16 +1211,16 @@ Proof. split. omega. eapply Mem.perm_drop_2; eauto. (* older function *) exploit H2; eauto. intros [A B]. - assert (D: Mem.valid_block m b). + assert (D: Mem.valid_block m b). red. exploit genv_funs_range; eauto. rewrite H; auto. - split. erewrite <- alloc_global_perm; eauto. + split. erewrite <- alloc_global_perm; eauto. intros. eapply B. erewrite alloc_global_perm; eauto. (* variables *) - red; intros. unfold find_funct_ptr in H3. simpl in H3. + red; intros. unfold find_funct_ptr in H3. simpl in H3. exploit H2; eauto. intros [A B]. - assert (D: Mem.valid_block m b). + assert (D: Mem.valid_block m b). red. exploit genv_funs_range; eauto. rewrite H; auto. - split. erewrite <- alloc_global_perm; eauto. + split. erewrite <- alloc_global_perm; eauto. intros. eapply B. erewrite alloc_global_perm; eauto. (* nextblock *) rewrite NB. simpl. rewrite H. auto. @@ -1238,7 +1238,7 @@ Proof. inv H0; auto. destruct a as [id g]. destruct (alloc_global m (id, g)) as [m1|] eqn:?; try discriminate. exploit alloc_global_initialized; eauto. intros [P [Q R]]. - eapply IHgl; eauto. + eapply IHgl; eauto. Qed. End INITMEM. @@ -1247,12 +1247,12 @@ Definition init_mem (p: program F V) := alloc_globals (globalenv p) Mem.empty p.(prog_defs). Lemma init_mem_genv_next: forall p m, - init_mem p = Some m -> + init_mem p = Some m -> genv_next (globalenv p) = Mem.nextblock m. Proof. unfold init_mem; intros. exploit alloc_globals_nextblock; eauto. rewrite Mem.nextblock_empty. intro. - generalize (genv_next_add_globals (prog_defs p) (empty_genv (prog_public p))). + generalize (genv_next_add_globals (prog_defs p) (empty_genv (prog_public p))). fold (globalenv p). simpl genv_next. intros. congruence. Qed. @@ -1261,7 +1261,7 @@ Theorem find_symbol_not_fresh: init_mem p = Some m -> find_symbol (globalenv p) id = Some b -> Mem.valid_block m b. Proof. - intros. red. erewrite <- init_mem_genv_next; eauto. + intros. red. erewrite <- init_mem_genv_next; eauto. eapply genv_symb_range; eauto. Qed. @@ -1270,7 +1270,7 @@ Theorem find_funct_ptr_not_fresh: init_mem p = Some m -> find_funct_ptr (globalenv p) b = Some f -> Mem.valid_block m b. Proof. - intros. red. erewrite <- init_mem_genv_next; eauto. + intros. red. erewrite <- init_mem_genv_next; eauto. eapply genv_funs_range; eauto. Qed. @@ -1279,7 +1279,7 @@ Theorem find_var_info_not_fresh: init_mem p = Some m -> find_var_info (globalenv p) b = Some gv -> Mem.valid_block m b. Proof. - intros. red. erewrite <- init_mem_genv_next; eauto. + intros. red. erewrite <- init_mem_genv_next; eauto. eapply genv_vars_range; eauto. Qed. @@ -1293,7 +1293,7 @@ Theorem init_mem_characterization: /\ (gv.(gvar_volatile) = false -> load_store_init_data (globalenv p) m b 0 gv.(gvar_init)). Proof. intros. eapply alloc_globals_initialized; eauto. - rewrite Mem.nextblock_empty. auto. + rewrite Mem.nextblock_empty. auto. red; intros. unfold find_var_info in H1. simpl in H1. rewrite PTree.gempty in H1. congruence. red; intros. unfold find_funct_ptr in H1. simpl in H1. rewrite PTree.gempty in H1. congruence. Qed. @@ -1328,7 +1328,7 @@ Lemma store_zeros_neutral: Proof. intros until n. functional induction (store_zeros m b p n); intros. inv H1; auto. - apply IHo; auto. eapply Mem.store_inject_neutral; eauto. constructor. + apply IHo; auto. eapply Mem.store_inject_neutral; eauto. constructor. inv H1. Qed. @@ -1343,9 +1343,9 @@ Proof. destruct id; simpl in H1; try (eapply Mem.store_inject_neutral; eauto; fail). congruence. destruct (find_symbol ge i) as [b'|] eqn:E; try discriminate. - eapply Mem.store_inject_neutral; eauto. - econstructor. unfold Mem.flat_inj. apply pred_dec_true; auto. eauto. - rewrite Int.add_zero. auto. + eapply Mem.store_inject_neutral; eauto. + econstructor. unfold Mem.flat_inj. apply pred_dec_true; auto. eauto. + rewrite Int.add_zero. auto. Qed. Lemma store_init_data_list_neutral: @@ -1358,7 +1358,7 @@ Proof. induction idl; simpl; intros. congruence. destruct (store_init_data ge m b p a) as [m1|] eqn:E; try discriminate. - eapply IHidl. eapply store_init_data_neutral; eauto. auto. eauto. + eapply IHidl. eapply store_init_data_neutral; eauto. auto. eauto. Qed. Lemma alloc_global_neutral: @@ -1372,7 +1372,7 @@ Proof. (* function *) destruct (Mem.alloc m 0 1) as [m1 b] eqn:?. assert (Plt b thr). rewrite (Mem.alloc_result _ _ _ _ _ Heqp). auto. - eapply Mem.drop_inject_neutral; eauto. + eapply Mem.drop_inject_neutral; eauto. eapply Mem.alloc_inject_neutral; eauto. (* variable *) set (init := gvar_init v) in *. @@ -1381,9 +1381,9 @@ Proof. destruct (store_zeros m1 b 0 sz) as [m2|] eqn:?; try discriminate. destruct (store_init_data_list ge m2 b 0 init) as [m3|] eqn:?; try discriminate. assert (Plt b thr). rewrite (Mem.alloc_result _ _ _ _ _ Heqp). auto. - eapply Mem.drop_inject_neutral; eauto. + eapply Mem.drop_inject_neutral; eauto. eapply store_init_data_list_neutral with (m := m2) (b := b); eauto. - eapply store_zeros_neutral with (m := m1); eauto. + eapply store_zeros_neutral with (m := m1); eauto. eapply Mem.alloc_inject_neutral; eauto. Qed. @@ -1403,7 +1403,7 @@ Lemma alloc_globals_neutral: Proof. induction gl; intros. simpl in *. congruence. - exploit alloc_globals_nextblock; eauto. intros EQ. + exploit alloc_globals_nextblock; eauto. intros EQ. simpl in *. destruct (alloc_global ge m a) as [m1|] eqn:E; try discriminate. exploit alloc_global_neutral; eauto. assert (Ple (Psucc (Mem.nextblock m)) (Mem.nextblock m')). @@ -1419,14 +1419,14 @@ Theorem initmem_inject: Mem.inject (Mem.flat_inj (Mem.nextblock m)) m m. Proof. unfold init_mem; intros. - apply Mem.neutral_inject. - eapply alloc_globals_neutral; eauto. + apply Mem.neutral_inject. + eapply alloc_globals_neutral; eauto. intros. exploit find_symbol_not_fresh; eauto. apply Mem.empty_inject_neutral. apply Ple_refl. Qed. -Section INITMEM_AUGMENT_INJ. +Section INITMEM_AUGMENT_INJ. Variable ge: t. Variable thr: block. @@ -1440,58 +1440,58 @@ Lemma store_zeros_augment: Proof. intros until n. functional induction (store_zeros m2 b p n); intros. inv H1; auto. - apply IHo; auto. exploit Mem.store_outside_inject; eauto. simpl. - intros. exfalso. unfold Mem.flat_inj in H2. destruct (plt b' thr). + apply IHo; auto. exploit Mem.store_outside_inject; eauto. simpl. + intros. exfalso. unfold Mem.flat_inj in H2. destruct (plt b' thr). inv H2. unfold Plt, Ple in *. zify; omega. discriminate. discriminate. Qed. -Lemma store_init_data_augment: - forall m1 m2 b p id m2', - Mem.inject (Mem.flat_inj thr) m1 m2 -> - Ple thr b -> +Lemma store_init_data_augment: + forall m1 m2 b p id m2', + Mem.inject (Mem.flat_inj thr) m1 m2 -> + Ple thr b -> store_init_data ge m2 b p id = Some m2' -> Mem.inject (Mem.flat_inj thr) m1 m2'. -Proof. - intros until m2'. intros INJ BND ST. - assert (P: forall chunk ofs v m2', - Mem.store chunk m2 b ofs v = Some m2' -> - Mem.inject (Mem.flat_inj thr) m1 m2'). - intros. eapply Mem.store_outside_inject; eauto. +Proof. + intros until m2'. intros INJ BND ST. + assert (P: forall chunk ofs v m2', + Mem.store chunk m2 b ofs v = Some m2' -> + Mem.inject (Mem.flat_inj thr) m1 m2'). + intros. eapply Mem.store_outside_inject; eauto. intros. unfold Mem.flat_inj in H0. destruct (plt b' thr); inv H0. unfold Plt, Ple in *. zify; omega. destruct id; simpl in ST; try (eapply P; eauto; fail). congruence. - revert ST. caseEq (find_symbol ge i); try congruence. intros; eapply P; eauto. + revert ST. caseEq (find_symbol ge i); try congruence. intros; eapply P; eauto. Qed. Lemma store_init_data_list_augment: - forall b idl m1 m2 p m2', - Mem.inject (Mem.flat_inj thr) m1 m2 -> - Ple thr b -> + forall b idl m1 m2 p m2', + Mem.inject (Mem.flat_inj thr) m1 m2 -> + Ple thr b -> store_init_data_list ge m2 b p idl = Some m2' -> Mem.inject (Mem.flat_inj thr) m1 m2'. -Proof. +Proof. induction idl; simpl. intros; congruence. intros until m2'; intros INJ FB. - caseEq (store_init_data ge m2 b p a); try congruence. intros. - eapply IHidl. eapply store_init_data_augment; eauto. auto. eauto. + caseEq (store_init_data ge m2 b p a); try congruence. intros. + eapply IHidl. eapply store_init_data_augment; eauto. auto. eauto. Qed. Lemma alloc_global_augment: forall idg m1 m2 m2', alloc_global ge m2 idg = Some m2' -> - Mem.inject (Mem.flat_inj thr) m1 m2 -> - Ple thr (Mem.nextblock m2) -> + Mem.inject (Mem.flat_inj thr) m1 m2 -> + Ple thr (Mem.nextblock m2) -> Mem.inject (Mem.flat_inj thr) m1 m2'. Proof. intros. destruct idg as [id [f|v]]; simpl in H. (* function *) destruct (Mem.alloc m2 0 1) as [m3 b] eqn:?. assert (Ple thr b). rewrite (Mem.alloc_result _ _ _ _ _ Heqp). auto. - eapply Mem.drop_outside_inject. 2: eauto. + eapply Mem.drop_outside_inject. 2: eauto. eapply Mem.alloc_right_inject; eauto. intros. unfold Mem.flat_inj in H3. destruct (plt b' thr); inv H3. unfold Plt, Ple in *. zify; omega. @@ -1502,7 +1502,7 @@ Proof. destruct (store_zeros m3 b 0 sz) as [m4|] eqn:?; try discriminate. destruct (store_init_data_list ge m4 b 0 init) as [m5|] eqn:?; try discriminate. assert (Ple thr b). rewrite (Mem.alloc_result _ _ _ _ _ Heqp). auto. - eapply Mem.drop_outside_inject. 2: eauto. + eapply Mem.drop_outside_inject. 2: eauto. eapply store_init_data_list_augment. 3: eauto. 2: eauto. eapply store_zeros_augment. 3: eauto. 2: eauto. eapply Mem.alloc_right_inject; eauto. @@ -1520,13 +1520,13 @@ Proof. induction gl; simpl. intros. congruence. intros until m2'. caseEq (alloc_global ge m2 a); try congruence. intros. - eapply IHgl with (m2 := m); eauto. - eapply alloc_global_augment; eauto. - rewrite (alloc_global_nextblock _ _ _ H). + eapply IHgl with (m2 := m); eauto. + eapply alloc_global_augment; eauto. + rewrite (alloc_global_nextblock _ _ _ H). apply Ple_trans with (Mem.nextblock m2); auto. apply Ple_succ. Qed. -End INITMEM_AUGMENT_INJ. +End INITMEM_AUGMENT_INJ. End GENV. @@ -1545,7 +1545,7 @@ Inductive match_globvar: globvar V -> globvar W -> Prop := match_varinfo info1 info2 -> match_globvar (mkglobvar info1 init ro vo) (mkglobvar info2 init ro vo). -Record match_genvs (new_globs : list (ident * globdef B W)) +Record match_genvs (new_globs : list (ident * globdef B W)) (ge1: t A V) (ge2: t B W): Prop := { mge_next: genv_next ge2 = advance_next new_globs (genv_next ge1); @@ -1557,9 +1557,9 @@ Record match_genvs (new_globs : list (ident * globdef B W)) exists tf, PTree.get b (genv_funs ge2) = Some tf /\ match_fun f tf; mge_rev_funs: forall b tf, PTree.get b (genv_funs ge2) = Some tf -> - if plt b (genv_next ge1) then + if plt b (genv_next ge1) then exists f, PTree.get b (genv_funs ge1) = Some f /\ match_fun f tf - else + else In (Gfun tf) (map snd new_globs); mge_vars: forall b v, PTree.get b (genv_vars ge1) = Some v -> @@ -1583,43 +1583,43 @@ Proof. (* two functions *) constructor; simpl. congruence. - intros. rewrite mge_next0. + intros. rewrite mge_next0. repeat rewrite PTree.gsspec. destruct (peq id0 id); auto. - rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec. - destruct (peq b (genv_next ge1)). + rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec. + destruct (peq b (genv_next ge1)). exists f2; split; congruence. eauto. - rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec. - destruct (peq b (genv_next ge1)). + rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec. + destruct (peq b (genv_next ge1)). subst b. rewrite pred_dec_true. exists f1; split; congruence. apply Plt_succ. - pose proof (mge_rev_funs0 b tf H0). + pose proof (mge_rev_funs0 b tf H0). destruct (plt b (genv_next ge1)). rewrite pred_dec_true. auto. apply Plt_trans_succ; auto. contradiction. eauto. intros. - pose proof (mge_rev_vars0 b tv H0). + pose proof (mge_rev_vars0 b tv H0). destruct (plt b (genv_next ge1)). rewrite pred_dec_true. auto. apply Plt_trans with (genv_next ge1); auto. apply Plt_succ. contradiction. (* two variables *) constructor; simpl. congruence. - intros. rewrite mge_next0. + intros. rewrite mge_next0. repeat rewrite PTree.gsspec. destruct (peq id0 id); auto. eauto. intros. - pose proof (mge_rev_funs0 b tf H0). + pose proof (mge_rev_funs0 b tf H0). destruct (plt b (genv_next ge1)). rewrite pred_dec_true. auto. apply Plt_trans_succ; auto. contradiction. - rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec. + rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec. destruct (peq b (genv_next ge1)). - econstructor; split. eauto. inv H0. constructor; auto. + econstructor; split. eauto. inv H0. constructor; auto. eauto. - rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec. - destruct (peq b (genv_next ge1)). + rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec. + destruct (peq b (genv_next ge1)). subst b. rewrite pred_dec_true. econstructor; split. eauto. inv H0. constructor; auto. apply Plt_succ. - pose proof (mge_rev_vars0 b tv H0). + pose proof (mge_rev_vars0 b tv H0). destruct (plt b (genv_next ge1)). rewrite pred_dec_true. auto. apply Plt_trans_succ; auto. contradiction. Qed. @@ -1629,56 +1629,56 @@ Lemma add_globals_match: forall ge1 ge2, match_genvs nil ge1 ge2 -> match_genvs nil (add_globals ge1 gl1) (add_globals ge2 gl2). Proof. - induction 1; intros; simpl. + induction 1; intros; simpl. auto. apply IHlist_forall2. apply add_global_match; auto. Qed. -Lemma add_global_augment_match: +Lemma add_global_augment_match: forall new_globs ge1 ge2 idg, match_genvs new_globs ge1 ge2 -> match_genvs (new_globs ++ (idg :: nil)) ge1 (add_global ge2 idg). Proof. - intros. destruct H. + intros. destruct H. assert (LE: Ple (genv_next ge1) (genv_next ge2)). { rewrite mge_next0; apply advance_next_le. } constructor; simpl. rewrite mge_next0. unfold advance_next. rewrite fold_left_app. simpl. auto. - intros. rewrite map_app in H. rewrite in_app in H. simpl in H. - destruct (peq id idg#1). subst. intuition. rewrite PTree.gso. - apply mge_symb0. intuition. auto. + intros. rewrite map_app in H. rewrite in_app in H. simpl in H. + destruct (peq id idg#1). subst. intuition. rewrite PTree.gso. + apply mge_symb0. intuition. auto. intros. destruct idg as [id1 [f1|v1]]; simpl; eauto. rewrite PTree.gso. eauto. exploit genv_funs_range; eauto. intros. unfold Plt, Ple in *; zify; omega. intros. rewrite map_app. destruct idg as [id1 [f1|v1]]; simpl in H. - rewrite PTree.gsspec in H. destruct (peq b (genv_next ge2)). + rewrite PTree.gsspec in H. destruct (peq b (genv_next ge2)). rewrite pred_dec_false. rewrite in_app. simpl; right; left. congruence. subst b. unfold Plt, Ple in *; zify; omega. - exploit mge_rev_funs0; eauto. destruct (plt b (genv_next ge1)); auto. + exploit mge_rev_funs0; eauto. destruct (plt b (genv_next ge1)); auto. rewrite in_app. tauto. - exploit mge_rev_funs0; eauto. destruct (plt b (genv_next ge1)); auto. + exploit mge_rev_funs0; eauto. destruct (plt b (genv_next ge1)); auto. rewrite in_app. tauto. intros. destruct idg as [id1 [f1|v1]]; simpl; eauto. - rewrite PTree.gso. eauto. exploit genv_vars_range; eauto. + rewrite PTree.gso. eauto. exploit genv_vars_range; eauto. unfold Plt, Ple in *; zify; omega. intros. rewrite map_app. destruct idg as [id1 [f1|v1]]; simpl in H. - exploit mge_rev_vars0; eauto. destruct (plt b (genv_next ge1)); auto. + exploit mge_rev_vars0; eauto. destruct (plt b (genv_next ge1)); auto. rewrite in_app. tauto. - rewrite PTree.gsspec in H. destruct (peq b (genv_next ge2)). + rewrite PTree.gsspec in H. destruct (peq b (genv_next ge2)). rewrite pred_dec_false. rewrite in_app. simpl; right; left. congruence. subst b. unfold Plt, Ple in *; zify; omega. - exploit mge_rev_vars0; eauto. destruct (plt b (genv_next ge1)); auto. + exploit mge_rev_vars0; eauto. destruct (plt b (genv_next ge1)); auto. rewrite in_app. tauto. Qed. -Lemma add_globals_augment_match: +Lemma add_globals_augment_match: forall gl new_globs ge1 ge2, match_genvs new_globs ge1 ge2 -> match_genvs (new_globs ++ gl) ge1 (add_globals ge2 gl). Proof. - induction gl; simpl. - intros. rewrite app_nil_r. auto. + induction gl; simpl. + intros. rewrite app_nil_r. auto. intros. change (a :: gl) with ((a :: nil) ++ gl). rewrite <- app_ass. apply IHgl. apply add_global_augment_match. auto. Qed. @@ -1688,15 +1688,15 @@ Variable new_main : ident. Variable p: program A V. Variable p': program B W. -Hypothesis progmatch: +Hypothesis progmatch: match_program match_fun match_varinfo new_globs new_main p p'. Lemma globalenvs_match: match_genvs new_globs (globalenv p) (globalenv p'). Proof. unfold globalenv. destruct progmatch as [[tglob [P Q]] R]. - rewrite Q. rewrite add_globals_app. - change new_globs with (nil ++ new_globs) at 1. + rewrite Q. rewrite add_globals_app. + change new_globs with (nil ++ new_globs) at 1. apply add_globals_augment_match. apply add_globals_match; auto. constructor; simpl; auto; intros; rewrite PTree.gempty in H; congruence. @@ -1712,9 +1712,9 @@ Proof (mge_funs globalenvs_match). Theorem find_funct_ptr_rev_match: forall (b : block) (tf : B), find_funct_ptr (globalenv p') b = Some tf -> - if plt b (genv_next (globalenv p)) then + if plt b (genv_next (globalenv p)) then exists f, find_funct_ptr (globalenv p) b = Some f /\ match_fun f tf - else + else In (Gfun tf) (map snd new_globs). Proof (mge_rev_funs globalenvs_match). @@ -1723,8 +1723,8 @@ Theorem find_funct_match: find_funct (globalenv p) v = Some f -> exists tf : B, find_funct (globalenv p') v = Some tf /\ match_fun f tf. Proof. - intros. exploit find_funct_inv; eauto. intros [b EQ]. subst v. - rewrite find_funct_find_funct_ptr in H. + intros. exploit find_funct_inv; eauto. intros [b EQ]. subst v. + rewrite find_funct_find_funct_ptr in H. rewrite find_funct_find_funct_ptr. apply find_funct_ptr_match. auto. Qed. @@ -1732,13 +1732,13 @@ Qed. Theorem find_funct_rev_match: forall (v : val) (tf : B), find_funct (globalenv p') v = Some tf -> - (exists f, find_funct (globalenv p) v = Some f /\ match_fun f tf) + (exists f, find_funct (globalenv p) v = Some f /\ match_fun f tf) \/ (In (Gfun tf) (map snd new_globs)). Proof. - intros. exploit find_funct_inv; eauto. intros [b EQ]. subst v. - rewrite find_funct_find_funct_ptr in H. + intros. exploit find_funct_inv; eauto. intros [b EQ]. subst v. + rewrite find_funct_find_funct_ptr in H. rewrite find_funct_find_funct_ptr. - apply find_funct_ptr_rev_match in H. + apply find_funct_ptr_rev_match in H. destruct (plt b (genv_next (globalenv p))); auto. Qed. @@ -1752,7 +1752,7 @@ Proof (mge_vars globalenvs_match). Theorem find_var_info_rev_match: forall (b : block) (tv : globvar W), find_var_info (globalenv p') b = Some tv -> - if plt b (genv_next (globalenv p)) then + if plt b (genv_next (globalenv p)) then exists v, find_var_info (globalenv p) b = Some v /\ match_globvar v tv else In (Gvar tv) (map snd new_globs). @@ -1763,7 +1763,7 @@ Theorem find_symbol_match: ~In s (map fst new_globs) -> find_symbol (globalenv p') s = find_symbol (globalenv p) s. Proof. - intros. destruct globalenvs_match. unfold find_symbol. auto. + intros. destruct globalenvs_match. unfold find_symbol. auto. Qed. Theorem public_symbol_match: @@ -1771,11 +1771,11 @@ Theorem public_symbol_match: ~In s (map fst new_globs) -> public_symbol (globalenv p') s = public_symbol (globalenv p) s. Proof. - intros. unfold public_symbol. rewrite find_symbol_match by auto. + intros. unfold public_symbol. rewrite find_symbol_match by auto. destruct (find_symbol (globalenv p) s); auto. - rewrite ! globalenv_public. - destruct progmatch as (P & Q & R). rewrite R. auto. -Qed. + rewrite ! globalenv_public. + destruct progmatch as (P & Q & R). rewrite R. auto. +Qed. Hypothesis new_ids_fresh: forall s, In s (prog_defs_names p) -> In s (map fst new_globs) -> False. @@ -1787,47 +1787,47 @@ Lemma store_init_data_list_match: store_init_data_list (globalenv p) m b ofs idl = Some m' -> store_init_data_list (globalenv p') m b ofs idl = Some m'. Proof. - induction idl; simpl; intros. + induction idl; simpl; intros. auto. assert (forall m', store_init_data (globalenv p) m b ofs a = Some m' -> store_init_data (globalenv p') m b ofs a = Some m'). destruct a; simpl; auto. rewrite find_symbol_match. auto. simpl in H. destruct (find_symbol (globalenv p) i) as [b'|] eqn:?; try discriminate. - red; intros. exploit find_symbol_inversion; eauto. - case_eq (store_init_data (globalenv p) m b ofs a); intros. - rewrite H1 in H. - pose proof (H0 _ H1). rewrite H2. auto. - rewrite H1 in H. inversion H. + red; intros. exploit find_symbol_inversion; eauto. + case_eq (store_init_data (globalenv p) m b ofs a); intros. + rewrite H1 in H. + pose proof (H0 _ H1). rewrite H2. auto. + rewrite H1 in H. inversion H. Qed. Lemma alloc_globals_match: forall gl1 gl2, list_forall2 (match_globdef match_fun match_varinfo) gl1 gl2 -> forall m m', - alloc_globals (globalenv p) m gl1 = Some m' -> + alloc_globals (globalenv p) m gl1 = Some m' -> alloc_globals (globalenv p') m gl2 = Some m'. Proof. induction 1; simpl; intros. auto. destruct (alloc_global (globalenv p) m a1) as [m1|] eqn:?; try discriminate. assert (alloc_global (globalenv p') m b1 = Some m1). - inv H; simpl in *. + inv H; simpl in *. auto. set (sz := init_data_list_size init) in *. destruct (Mem.alloc m 0 sz) as [m2 b] eqn:?. destruct (store_zeros m2 b 0 sz) as [m3|] eqn:?; try discriminate. destruct (store_init_data_list (globalenv p) m3 b 0 init) as [m4|] eqn:?; try discriminate. - erewrite store_init_data_list_match; eauto. + erewrite store_init_data_list_match; eauto. rewrite H2. eauto. Qed. Theorem init_mem_match: - forall m, init_mem p = Some m -> + forall m, init_mem p = Some m -> init_mem p' = alloc_globals (globalenv p') m new_globs. Proof. unfold init_mem; intros. destruct progmatch as [[tglob [P Q]] R]. - rewrite Q. erewrite <- alloc_globals_app; eauto. - eapply alloc_globals_match; eauto. + rewrite Q. erewrite <- alloc_globals_app; eauto. + eapply alloc_globals_match; eauto. Qed. Theorem find_new_funct_ptr_match: @@ -1838,9 +1838,9 @@ Theorem find_new_funct_ptr_match: Proof. intros. destruct progmatch as [[tglob [P Q]] R]. - exploit in_norepet_unique; eauto. intros (gl1 & gl2 & S & T). - rewrite S in Q. rewrite <- app_ass in Q. - eapply find_funct_ptr_exists_2; eauto. + exploit in_norepet_unique; eauto. intros (gl1 & gl2 & S & T). + rewrite S in Q. rewrite <- app_ass in Q. + eapply find_funct_ptr_exists_2; eauto. Qed. Theorem find_new_var_match: @@ -1851,9 +1851,9 @@ Theorem find_new_var_match: Proof. intros. destruct progmatch as [[tglob [P Q]] R]. - exploit in_norepet_unique; eauto. intros (gl1 & gl2 & S & T). - rewrite S in Q. rewrite <- app_ass in Q. - eapply find_var_exists_2; eauto. + exploit in_norepet_unique; eauto. intros (gl1 & gl2 & S & T). + rewrite S in Q. rewrite <- app_ass in Q. + eapply find_var_exists_2; eauto. Qed. End MATCH_PROGRAMS. @@ -1889,8 +1889,8 @@ Theorem find_funct_ptr_transf_augment: exists f', find_funct_ptr (globalenv p') b = Some f' /\ transf_fun f = OK f'. Proof. - intros. - exploit find_funct_ptr_match. eexact prog_match. eauto. + intros. + exploit find_funct_ptr_match. eexact prog_match. eauto. intros [tf [X Y]]. exists tf; auto. Qed. @@ -1899,10 +1899,10 @@ Theorem find_funct_ptr_rev_transf_augment: find_funct_ptr (globalenv p') b = Some tf -> if plt b (genv_next (globalenv p)) then (exists f, find_funct_ptr (globalenv p) b = Some f /\ transf_fun f = OK tf) - else + else In (Gfun tf) (map snd new_globs). Proof. - intros. + intros. exploit find_funct_ptr_rev_match; eauto. Qed. @@ -1912,18 +1912,18 @@ Theorem find_funct_transf_augment: exists f', find_funct (globalenv p') v = Some f' /\ transf_fun f = OK f'. Proof. - intros. - exploit find_funct_match. eexact prog_match. eauto. auto. + intros. + exploit find_funct_match. eexact prog_match. eauto. auto. Qed. -Theorem find_funct_rev_transf_augment: +Theorem find_funct_rev_transf_augment: forall (v: val) (tf: B), find_funct (globalenv p') v = Some tf -> (exists f, find_funct (globalenv p) v = Some f /\ transf_fun f = OK tf) \/ In (Gfun tf) (map snd new_globs). Proof. - intros. - exploit find_funct_rev_match. eexact prog_match. eauto. auto. + intros. + exploit find_funct_rev_match. eexact prog_match. eauto. auto. Qed. Theorem find_var_info_transf_augment: @@ -1932,8 +1932,8 @@ Theorem find_var_info_transf_augment: exists v', find_var_info (globalenv p') b = Some v' /\ transf_globvar transf_var v = OK v'. Proof. - intros. - exploit find_var_info_match. eexact prog_match. eauto. intros [tv [X Y]]. + intros. + exploit find_var_info_match. eexact prog_match. eauto. intros [tv [X Y]]. exists tv; split; auto. inv Y. unfold transf_globvar; simpl. rewrite H0; simpl. auto. Qed. @@ -1946,23 +1946,23 @@ Theorem find_var_info_rev_transf_augment: else (In (Gvar v') (map snd new_globs)). Proof. - intros. + intros. exploit find_var_info_rev_match. eexact prog_match. eauto. destruct (plt b (genv_next (globalenv p))); auto. - intros [v [X Y]]. exists v; split; auto. inv Y. unfold transf_globvar; simpl. + intros [v [X Y]]. exists v; split; auto. inv Y. unfold transf_globvar; simpl. rewrite H0; simpl. auto. Qed. -Theorem find_symbol_transf_augment: - forall (s: ident), +Theorem find_symbol_transf_augment: + forall (s: ident), ~ In s (map fst new_globs) -> find_symbol (globalenv p') s = find_symbol (globalenv p) s. Proof. intros. eapply find_symbol_match. eexact prog_match. auto. Qed. -Theorem public_symbol_transf_augment: - forall (s: ident), +Theorem public_symbol_transf_augment: + forall (s: ident), ~ In s (map fst new_globs) -> public_symbol (globalenv p') s = public_symbol (globalenv p) s. Proof. @@ -1974,38 +1974,38 @@ Hypothesis new_ids_fresh: Hypothesis new_ids_unique: list_norepet (map fst new_globs). -Theorem init_mem_transf_augment: - forall m, init_mem p = Some m -> +Theorem init_mem_transf_augment: + forall m, init_mem p = Some m -> init_mem p' = alloc_globals (globalenv p') m new_globs. Proof. intros. eapply init_mem_match. eexact prog_match. auto. auto. Qed. - + Theorem init_mem_inject_transf_augment: forall m, init_mem p = Some m -> - forall m', init_mem p' = Some m' -> + forall m', init_mem p' = Some m' -> Mem.inject (Mem.flat_inj (Mem.nextblock m)) m m'. Proof. - intros. - pose proof (initmem_inject p H). - erewrite init_mem_transf_augment in H0; eauto. - eapply alloc_globals_augment; eauto. apply Ple_refl. + intros. + pose proof (initmem_inject p H). + erewrite init_mem_transf_augment in H0; eauto. + eapply alloc_globals_augment; eauto. apply Ple_refl. Qed. -Theorem find_new_funct_ptr_exists: - forall id f, In (id, Gfun f) new_globs -> +Theorem find_new_funct_ptr_exists: + forall id f, In (id, Gfun f) new_globs -> exists b, find_symbol (globalenv p') id = Some b /\ find_funct_ptr (globalenv p') b = Some f. Proof. - intros. eapply find_new_funct_ptr_match; eauto. + intros. eapply find_new_funct_ptr_match; eauto. Qed. Theorem find_new_var_exists: - forall id gv, In (id, Gvar gv) new_globs -> + forall id gv, In (id, Gvar gv) new_globs -> exists b, find_symbol (globalenv p') id = Some b /\ find_var_info (globalenv p') b = Some gv. Proof. - intros. eapply find_new_var_match; eauto. + intros. eapply find_new_var_match; eauto. Qed. End TRANSF_PROGRAM_AUGMENT. @@ -2041,7 +2041,7 @@ Theorem find_funct_ptr_rev_transf_partial2: exists f, find_funct_ptr (globalenv p) b = Some f /\ transf_fun f = OK tf. Proof. pose proof (@find_funct_ptr_rev_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK). - intros. pose proof (H b tf H0). + intros. pose proof (H b tf H0). destruct (plt b (genv_next (globalenv p))). auto. contradiction. Qed. @@ -2060,7 +2060,7 @@ Theorem find_funct_rev_transf_partial2: exists f, find_funct (globalenv p) v = Some f /\ transf_fun f = OK tf. Proof. pose proof (@find_funct_rev_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK). - intros. pose proof (H v tf H0). + intros. pose proof (H v tf H0). destruct H1. auto. contradiction. Qed. @@ -2080,7 +2080,7 @@ Theorem find_var_info_rev_transf_partial2: find_var_info (globalenv p) b = Some v /\ transf_globvar transf_var v = OK v'. Proof. pose proof (@find_var_info_rev_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK). - intros. pose proof (H b v' H0). + intros. pose proof (H b v' H0). destruct (plt b (genv_next (globalenv p))). auto. contradiction. Qed. @@ -2104,10 +2104,10 @@ Theorem block_is_volatile_transf_partial2: forall (b: block), block_is_volatile (globalenv p') b = block_is_volatile (globalenv p) b. Proof. - unfold block_is_volatile; intros. + unfold block_is_volatile; intros. destruct (find_var_info (globalenv p) b) as [v|] eqn:FV. exploit find_var_info_transf_partial2; eauto. intros (v' & P & Q). - rewrite P. monadInv Q. auto. + rewrite P. monadInv Q. auto. destruct (find_var_info (globalenv p') b) as [v'|] eqn:FV'. exploit find_var_info_rev_transf_partial2; eauto. intros (v & P & Q). congruence. auto. @@ -2117,7 +2117,7 @@ Theorem init_mem_transf_partial2: forall m, init_mem p = Some m -> init_mem p' = Some m. Proof. pose proof (@init_mem_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK). - intros. simpl in H. apply H; auto. + intros. simpl in H. apply H; auto. Qed. End TRANSF_PROGRAM_PARTIAL2. @@ -2183,11 +2183,11 @@ Theorem find_var_info_transf_partial: find_var_info (globalenv p') b = find_var_info (globalenv p) b. Proof. intros. case_eq (find_var_info (globalenv p) b); intros. - exploit find_var_info_transf_partial2. eexact transf_OK. eauto. - intros [v' [P Q]]. monadInv Q. rewrite P. inv EQ. destruct g; auto. + exploit find_var_info_transf_partial2. eexact transf_OK. eauto. + intros [v' [P Q]]. monadInv Q. rewrite P. inv EQ. destruct g; auto. case_eq (find_var_info (globalenv p') b); intros. exploit find_var_info_rev_transf_partial2. eexact transf_OK. eauto. - intros [v' [P Q]]. monadInv Q. inv EQ. congruence. + intros [v' [P Q]]. monadInv Q. inv EQ. congruence. auto. Qed. @@ -2216,7 +2216,7 @@ Let tp := transform_program transf p. Remark transf_OK: transform_partial_program (fun x => OK (transf x)) p = OK tp. Proof. - unfold tp. apply transform_program_partial_program. + unfold tp. apply transform_program_partial_program. Qed. Theorem find_funct_ptr_transf: @@ -2224,7 +2224,7 @@ Theorem find_funct_ptr_transf: find_funct_ptr (globalenv p) b = Some f -> find_funct_ptr (globalenv tp) b = Some (transf f). Proof. - intros. + intros. destruct (@find_funct_ptr_transf_partial _ _ _ _ _ _ transf_OK _ _ H) as [f' [X Y]]. congruence. Qed. @@ -2243,7 +2243,7 @@ Theorem find_funct_transf: find_funct (globalenv p) v = Some f -> find_funct (globalenv tp) v = Some (transf f). Proof. - intros. + intros. destruct (@find_funct_transf_partial _ _ _ _ _ _ transf_OK _ _ H) as [f' [X Y]]. congruence. Qed. diff --git a/common/Memdata.v b/common/Memdata.v index 9c64563b..4ef7836b 100644 --- a/common/Memdata.v +++ b/common/Memdata.v @@ -61,8 +61,8 @@ Qed. Lemma size_chunk_nat_pos: forall chunk, exists n, size_chunk_nat chunk = S n. Proof. - intros. - generalize (size_chunk_pos chunk). rewrite size_chunk_conv. + intros. + generalize (size_chunk_pos chunk). rewrite size_chunk_conv. destruct (size_chunk_nat chunk). simpl; intros; omegaContradiction. intros; exists n; auto. @@ -71,14 +71,14 @@ Qed. (** Memory reads and writes must respect alignment constraints: the byte offset of the location being addressed should be an exact multiple of the natural alignment for the chunk being addressed. - This natural alignment is defined by the following + This natural alignment is defined by the following [align_chunk] function. Some target architectures (e.g. PowerPC and x86) have no alignment constraints, which we could reflect by taking [align_chunk chunk = 1]. However, other architectures have stronger alignment requirements. The following definition is appropriate for PowerPC, ARM and x86. *) -Definition align_chunk (chunk: memory_chunk) : Z := +Definition align_chunk (chunk: memory_chunk) : Z := match chunk with | Mint8signed => 1 | Mint8unsigned => 1 @@ -101,7 +101,7 @@ Qed. Lemma align_size_chunk_divides: forall chunk, (align_chunk chunk | size_chunk chunk). Proof. - intros. destruct chunk; simpl; try apply Zdivide_refl; exists 2; auto. + intros. destruct chunk; simpl; try apply Zdivide_refl; exists 2; auto. Qed. Lemma align_le_divides: @@ -206,40 +206,40 @@ Proof. Opaque Byte.wordsize. rewrite inj_S. simpl. replace (Zsucc (Z_of_nat n) * 8) with (Z_of_nat n * 8 + 8) by omega. - rewrite two_p_is_exp; try omega. - rewrite Zmod_recombine. rewrite IHn. rewrite Zplus_comm. - change (Byte.unsigned (Byte.repr x)) with (Byte.Z_mod_modulus x). - rewrite Byte.Z_mod_modulus_eq. reflexivity. + rewrite two_p_is_exp; try omega. + rewrite Zmod_recombine. rewrite IHn. rewrite Zplus_comm. + change (Byte.unsigned (Byte.repr x)) with (Byte.Z_mod_modulus x). + rewrite Byte.Z_mod_modulus_eq. reflexivity. apply two_p_gt_ZERO. omega. apply two_p_gt_ZERO. omega. Qed. Lemma rev_if_be_involutive: forall l, rev_if_be (rev_if_be l) = l. Proof. - intros; unfold rev_if_be; destruct Archi.big_endian. - apply List.rev_involutive. + intros; unfold rev_if_be; destruct Archi.big_endian. + apply List.rev_involutive. auto. Qed. Lemma decode_encode_int: forall n x, decode_int (encode_int n x) = x mod (two_p (Z_of_nat n * 8)). Proof. - unfold decode_int, encode_int; intros. rewrite rev_if_be_involutive. + unfold decode_int, encode_int; intros. rewrite rev_if_be_involutive. apply int_of_bytes_of_int. Qed. Lemma decode_encode_int_1: forall x, Int.repr (decode_int (encode_int 1 (Int.unsigned x))) = Int.zero_ext 8 x. Proof. - intros. rewrite decode_encode_int. + intros. rewrite decode_encode_int. rewrite <- (Int.repr_unsigned (Int.zero_ext 8 x)). - decEq. symmetry. apply Int.zero_ext_mod. compute. intuition congruence. + decEq. symmetry. apply Int.zero_ext_mod. compute. intuition congruence. Qed. Lemma decode_encode_int_2: forall x, Int.repr (decode_int (encode_int 2 (Int.unsigned x))) = Int.zero_ext 16 x. Proof. - intros. rewrite decode_encode_int. + intros. rewrite decode_encode_int. rewrite <- (Int.repr_unsigned (Int.zero_ext 16 x)). decEq. symmetry. apply Int.zero_ext_mod. compute; intuition congruence. Qed. @@ -268,15 +268,15 @@ Proof. induction n. intros; simpl; auto. intros until y. - rewrite inj_S. + rewrite inj_S. replace (Zsucc (Z_of_nat n) * 8) with (Z_of_nat n * 8 + 8) by omega. - rewrite two_p_is_exp; try omega. + rewrite two_p_is_exp; try omega. intro EQM. - simpl; decEq. - apply Byte.eqm_samerepr. red. + simpl; decEq. + apply Byte.eqm_samerepr. red. eapply Int.eqmod_divides; eauto. apply Zdivide_factor_l. apply IHn. - destruct EQM as [k EQ]. exists k. rewrite EQ. + destruct EQM as [k EQ]. exists k. rewrite EQ. rewrite <- Z_div_plus_full_l. decEq. change (two_p 8) with 256. ring. omega. Qed. @@ -312,7 +312,7 @@ Fixpoint proj_bytes (vl: list memval) : option (list byte) := Remark length_inj_bytes: forall bl, length (inj_bytes bl) = length bl. Proof. - intros. apply List.map_length. + intros. apply List.map_length. Qed. Remark proj_inj_bytes: @@ -324,7 +324,7 @@ Qed. Lemma inj_proj_bytes: forall cl bl, proj_bytes cl = Some bl -> cl = inj_bytes bl. Proof. - induction cl; simpl; intros. + induction cl; simpl; intros. inv H; auto. destruct a; try congruence. destruct (proj_bytes cl); inv H. simpl. decEq. auto. @@ -339,7 +339,7 @@ Fixpoint inj_value_rec (n: nat) (v: val) (q: quantity) {struct n}: list memval : Definition inj_value (q: quantity) (v: val): list memval := inj_value_rec (size_quantity_nat q) v q. -Fixpoint check_value (n: nat) (v: val) (q: quantity) (vl: list memval) +Fixpoint check_value (n: nat) (v: val) (q: quantity) (vl: list memval) {struct n} : bool := match n, vl with | O, nil => true @@ -395,7 +395,7 @@ Definition decode_val (chunk: memory_chunk) (vl: list memval) : val := Lemma encode_val_length: forall chunk v, length(encode_val chunk v) = size_chunk_nat chunk. Proof. - intros. destruct v; simpl; destruct chunk; + intros. destruct v; simpl; destruct chunk; solve [ reflexivity | apply length_list_repeat | rewrite length_inj_bytes; apply encode_int_length ]. @@ -404,15 +404,15 @@ Qed. Lemma check_inj_value: forall v q n, check_value n v q (inj_value_rec n v q) = true. Proof. - induction n; simpl. auto. - unfold proj_sumbool. rewrite dec_eq_true. rewrite dec_eq_true. + induction n; simpl. auto. + unfold proj_sumbool. rewrite dec_eq_true. rewrite dec_eq_true. rewrite <- beq_nat_refl. simpl; auto. Qed. Lemma proj_inj_value: forall q v, proj_value q (inj_value q v) = v. Proof. - intros. unfold proj_value, inj_value. destruct (size_quantity_nat_pos q) as [n EQ]. + intros. unfold proj_value, inj_value. destruct (size_quantity_nat_pos q) as [n EQ]. rewrite EQ at 1. simpl. rewrite check_inj_value. auto. Qed. @@ -422,14 +422,14 @@ Proof. Local Transparent inj_value. unfold inj_value; intros until q. generalize (size_quantity_nat q). induction n; simpl; intros. contradiction. - destruct H. exists n; auto. eauto. + destruct H. exists n; auto. eauto. Qed. Lemma proj_inj_value_mismatch: forall q1 q2 v, q1 <> q2 -> proj_value q1 (inj_value q2 v) = Vundef. Proof. intros. unfold proj_value. destruct (inj_value q2 v) eqn:V. auto. destruct m; auto. - destruct (in_inj_value (Fragment v0 q n) v q2) as [n' EQ]. + destruct (in_inj_value (Fragment v0 q n) v q2) as [n' EQ]. rewrite V; auto with coqlib. inv EQ. destruct (size_quantity_nat_pos q1) as [p EQ1]; rewrite EQ1; simpl. unfold proj_sumbool. rewrite dec_eq_true. rewrite dec_eq_false by congruence. auto. @@ -482,7 +482,7 @@ Qed. Remark proj_bytes_inj_value: forall q v, proj_bytes (inj_value q v) = None. Proof. - intros. destruct q; reflexivity. + intros. destruct q; reflexivity. Qed. Lemma decode_encode_val_general: @@ -492,7 +492,7 @@ Proof. Opaque inj_value. intros. destruct v; destruct chunk1 eqn:C1; simpl; try (apply decode_val_undef); - destruct chunk2 eqn:C2; unfold decode_val; auto; + destruct chunk2 eqn:C2; unfold decode_val; auto; try (rewrite proj_inj_bytes); try (rewrite proj_bytes_inj_value); try (rewrite proj_inj_value); try (rewrite proj_inj_value_mismatch by congruence); auto. @@ -521,7 +521,7 @@ Lemma decode_encode_val_similar: decode_encode_val v1 chunk1 chunk2 v2 -> v2 = Val.load_result chunk2 v1. Proof. - intros until v2; intros TY SZ DE. + intros until v2; intros TY SZ DE. destruct chunk1; destruct chunk2; simpl in TY; try discriminate; simpl in SZ; try omegaContradiction; destruct v1; auto. Qed. @@ -530,8 +530,8 @@ Lemma decode_val_type: forall chunk cl, Val.has_type (decode_val chunk cl) (type_of_chunk chunk). Proof. - intros. unfold decode_val. - destruct (proj_bytes cl). + intros. unfold decode_val. + destruct (proj_bytes cl). destruct chunk; simpl; auto. destruct chunk; exact I || apply Val.load_result_type. Qed. @@ -551,7 +551,7 @@ Qed. Lemma encode_val_int8_zero_ext: forall n, encode_val Mint8unsigned (Vint (Int.zero_ext 8 n)) = encode_val Mint8unsigned (Vint n). Proof. - intros; unfold encode_val. decEq. apply encode_int_8_mod. apply Int.eqmod_zero_ext. + intros; unfold encode_val. decEq. apply encode_int_8_mod. apply Int.eqmod_zero_ext. compute; intuition congruence. Qed. @@ -586,7 +586,7 @@ Lemma decode_val_cast: Proof. unfold decode_val; intros; destruct chunk; auto; destruct (proj_bytes l); auto. unfold Val.sign_ext. rewrite Int.sign_ext_idem; auto. omega. - unfold Val.zero_ext. rewrite Int.zero_ext_idem; auto. omega. + unfold Val.zero_ext. rewrite Int.zero_ext_idem; auto. omega. unfold Val.sign_ext. rewrite Int.sign_ext_idem; auto. omega. unfold Val.zero_ext. rewrite Int.zero_ext_idem; auto. omega. Qed. @@ -616,41 +616,41 @@ Inductive shape_encoding (chunk: memory_chunk) (v: val): list memval -> Prop := Lemma encode_val_shape: forall chunk v, shape_encoding chunk v (encode_val chunk v). Proof. - intros. - destruct (size_chunk_nat_pos chunk) as [sz EQ]. + intros. + destruct (size_chunk_nat_pos chunk) as [sz EQ]. assert (A: forall mv q n, (n < size_quantity_nat q)%nat -> In mv (inj_value_rec n v q) -> exists j, mv = Fragment v q j /\ S j <> size_quantity_nat q). { - induction n; simpl; intros. contradiction. destruct H0. - exists n; split; auto. omega. apply IHn; auto. omega. - } + induction n; simpl; intros. contradiction. destruct H0. + exists n; split; auto. omega. apply IHn; auto. omega. + } assert (B: forall q, - q = quantity_chunk chunk -> + q = quantity_chunk chunk -> (chunk = Mint32 \/ chunk = Many32 \/ chunk = Many64) -> shape_encoding chunk v (inj_value q v)). { Local Transparent inj_value. - intros. unfold inj_value. destruct (size_quantity_nat_pos q) as [sz' EQ']. + intros. unfold inj_value. destruct (size_quantity_nat_pos q) as [sz' EQ']. rewrite EQ'. simpl. constructor; auto. - intros; eapply A; eauto. omega. + intros; eapply A; eauto. omega. } assert (C: forall bl, match v with Vint _ => True | Vlong _ => True | Vfloat _ => True | Vsingle _ => True | _ => False end -> length (inj_bytes bl) = size_chunk_nat chunk -> shape_encoding chunk v (inj_bytes bl)). { - intros. destruct bl as [|b1 bl]. simpl in H0; congruence. simpl. - constructor; auto. unfold inj_bytes; intros. exploit list_in_map_inv; eauto. + intros. destruct bl as [|b1 bl]. simpl in H0; congruence. simpl. + constructor; auto. unfold inj_bytes; intros. exploit list_in_map_inv; eauto. intros (b & P & Q); exists b; auto. } assert (D: shape_encoding chunk v (list_repeat (size_chunk_nat chunk) Undef)). { - intros. rewrite EQ; simpl; constructor; auto. - intros. eapply in_list_repeat; eauto. + intros. rewrite EQ; simpl; constructor; auto. + intros. eapply in_list_repeat; eauto. } - generalize (encode_val_length chunk v). intros LEN. + generalize (encode_val_length chunk v). intros LEN. unfold encode_val; unfold encode_val in LEN; destruct v; destruct chunk; (apply B || apply C || apply D); auto; red; auto. Qed. @@ -671,14 +671,14 @@ Inductive shape_decoding (chunk: memory_chunk): list memval -> val -> Prop := Lemma decode_val_shape: forall chunk mv1 mvl, shape_decoding chunk (mv1 :: mvl) (decode_val chunk (mv1 :: mvl)). Proof. - intros. + intros. assert (A: forall mv mvs bs, proj_bytes mvs = Some bs -> In mv mvs -> exists b, mv = Byte b). { - induction mvs; simpl; intros. + induction mvs; simpl; intros. contradiction. - destruct a; try discriminate. destruct H0. exists i; auto. - destruct (proj_bytes mvs); try discriminate. eauto. + destruct a; try discriminate. destruct H0. exists i; auto. + destruct (proj_bytes mvs); try discriminate. eauto. } assert (B: forall v q mv n mvs, check_value n v q mvs = true -> In mv mvs -> (n < size_quantity_nat q)%nat -> @@ -686,13 +686,13 @@ Proof. { induction n; destruct mvs; simpl; intros; try discriminate. contradiction. - destruct m; try discriminate. InvBooleans. apply beq_nat_true in H4. subst. - destruct H0. subst mv. exists n0; split; auto. omega. - eapply IHn; eauto. omega. + destruct m; try discriminate. InvBooleans. apply beq_nat_true in H4. subst. + destruct H0. subst mv. exists n0; split; auto. omega. + eapply IHn; eauto. omega. } assert (U: forall mvs, shape_decoding chunk mvs (Val.load_result chunk Vundef)). { - intros. replace (Val.load_result chunk Vundef) with Vundef. constructor. + intros. replace (Val.load_result chunk Vundef) with Vundef. constructor. destruct chunk; auto. } assert (C: forall q, size_quantity_nat q = size_chunk_nat chunk -> @@ -700,21 +700,21 @@ Proof. shape_decoding chunk (mv1 :: mvl) (Val.load_result chunk (proj_value q (mv1 :: mvl)))). { intros. unfold proj_value. destruct mv1; auto. - destruct (size_quantity_nat_pos q) as [sz EQ]. rewrite EQ. + destruct (size_quantity_nat_pos q) as [sz EQ]. rewrite EQ. simpl. unfold proj_sumbool. rewrite dec_eq_true. - destruct (quantity_eq q q0); auto. + destruct (quantity_eq q q0); auto. destruct (beq_nat sz n) eqn:EQN; auto. - destruct (check_value sz v q mvl) eqn:CHECK; auto. - simpl. apply beq_nat_true in EQN. subst n q0. constructor. auto. + destruct (check_value sz v q mvl) eqn:CHECK; auto. + simpl. apply beq_nat_true in EQN. subst n q0. constructor. auto. destruct H0 as [E|[E|E]]; subst chunk; destruct q; auto || discriminate. - congruence. - intros. eapply B; eauto. omega. + congruence. + intros. eapply B; eauto. omega. } - unfold decode_val. - destruct (proj_bytes (mv1 :: mvl)) as [bl|] eqn:PB. - exploit (A mv1); eauto with coqlib. intros [b1 EQ1]; subst mv1. + unfold decode_val. + destruct (proj_bytes (mv1 :: mvl)) as [bl|] eqn:PB. + exploit (A mv1); eauto with coqlib. intros [b1 EQ1]; subst mv1. destruct chunk; (apply shape_decoding_u || apply shape_decoding_b); eauto with coqlib. - destruct chunk; (apply shape_decoding_u || apply C); auto. + destruct chunk; (apply shape_decoding_u || apply C); auto. Qed. (** * Compatibility with memory injections *) @@ -734,7 +734,7 @@ Inductive memval_inject (f: meminj): memval -> memval -> Prop := Lemma memval_inject_incr: forall f f' v1 v2, memval_inject f v1 v2 -> inject_incr f f' -> memval_inject f' v1 v2. Proof. - intros. inv H; econstructor. eapply val_inject_incr; eauto. + intros. inv H; econstructor. eapply val_inject_incr; eauto. Qed. (** [decode_val], applied to lists of memory values that are pairwise @@ -749,8 +749,8 @@ Lemma proj_bytes_inject: Proof. induction 1; simpl. congruence. inv H; try congruence. - destruct (proj_bytes al); intros. - inv H. rewrite (IHlist_forall2 l); auto. + destruct (proj_bytes al); intros. + inv H. rewrite (IHlist_forall2 l); auto. congruence. Qed. @@ -762,11 +762,11 @@ Lemma check_value_inject: Val.inject f v v' -> v <> Vundef -> check_value n v' q vl' = true. Proof. - induction 1; intros; destruct n; simpl in *; auto. + induction 1; intros; destruct n; simpl in *; auto. inv H; auto. InvBooleans. assert (n = n0) by (apply beq_nat_true; auto). subst v1 q0 n0. - replace v2 with v'. - unfold proj_sumbool; rewrite ! dec_eq_true. rewrite <- beq_nat_refl. simpl; eauto. + replace v2 with v'. + unfold proj_sumbool; rewrite ! dec_eq_true. rewrite <- beq_nat_refl. simpl; eauto. inv H2; try discriminate; inv H4; congruence. discriminate. Qed. @@ -776,10 +776,10 @@ Lemma proj_value_inject: list_forall2 (memval_inject f) vl1 vl2 -> Val.inject f (proj_value q vl1) (proj_value q vl2). Proof. - intros. unfold proj_value. + intros. unfold proj_value. inversion H; subst. auto. inversion H0; subst; auto. destruct (check_value (size_quantity_nat q) v1 q (Fragment v1 q0 n :: al)) eqn:B; auto. - destruct (Val.eq v1 Vundef). subst; auto. + destruct (Val.eq v1 Vundef). subst; auto. erewrite check_value_inject by eauto. auto. Qed. @@ -790,7 +790,7 @@ Lemma proj_bytes_not_inject: Proof. induction 1; simpl; intros. congruence. - inv H; try congruence. + inv H; try congruence. right. apply IHlist_forall2. destruct (proj_bytes al); congruence. destruct (proj_bytes bl); congruence. @@ -801,18 +801,18 @@ Lemma check_value_undef: forall n q v vl, In Undef vl -> check_value n v q vl = false. Proof. - induction n; intros; simpl. + induction n; intros; simpl. destruct vl. elim H. auto. destruct vl. auto. destruct m; auto. simpl in H; destruct H. congruence. - rewrite IHn; auto. apply andb_false_r. + rewrite IHn; auto. apply andb_false_r. Qed. Lemma proj_value_undef: forall q vl, In Undef vl -> proj_value q vl = Vundef. Proof. intros; unfold proj_value. - destruct vl; auto. destruct m; auto. + destruct vl; auto. destruct m; auto. rewrite check_value_undef. auto. auto. Qed. @@ -821,9 +821,9 @@ Theorem decode_val_inject: list_forall2 (memval_inject f) vl1 vl2 -> Val.inject f (decode_val chunk vl1) (decode_val chunk vl2). Proof. - intros. unfold decode_val. + intros. unfold decode_val. destruct (proj_bytes vl1) as [bl1|] eqn:PB1. - exploit proj_bytes_inject; eauto. intros PB2. rewrite PB2. + exploit proj_bytes_inject; eauto. intros PB2. rewrite PB2. destruct chunk; constructor. assert (A: forall q fn, Val.inject f (Val.load_result chunk (proj_value q vl1)) @@ -852,8 +852,8 @@ Lemma repeat_Undef_inject_any: forall f vl, list_forall2 (memval_inject f) (list_repeat (length vl) Undef) vl. Proof. - induction vl; simpl; constructor; auto. constructor. -Qed. + induction vl; simpl; constructor; auto. constructor. +Qed. Lemma repeat_Undef_inject_encode_val: forall f chunk v, @@ -867,7 +867,7 @@ Lemma repeat_Undef_inject_self: list_forall2 (memval_inject f) (list_repeat n Undef) (list_repeat n Undef). Proof. induction n; simpl; constructor; auto. constructor. -Qed. +Qed. Lemma inj_value_inject: forall f v1 v2 q, Val.inject f v1 v2 -> list_forall2 (memval_inject f) (inj_value q v1) (inj_value q v2). @@ -875,7 +875,7 @@ Proof. intros. Local Transparent inj_value. unfold inj_value. generalize (size_quantity_nat q). induction n; simpl; constructor; auto. - constructor; auto. + constructor; auto. Qed. Theorem encode_val_inject: @@ -907,19 +907,19 @@ Proof. intros. inv H. inv H0. constructor. inv H0. econstructor. - eapply val_inject_compose; eauto. + eapply val_inject_compose; eauto. constructor. -Qed. +Qed. (** * Breaking 64-bit memory accesses into two 32-bit accesses *) Lemma int_of_bytes_append: - forall l2 l1, + forall l2 l1, int_of_bytes (l1 ++ l2) = int_of_bytes l1 + int_of_bytes l2 * two_p (Z_of_nat (length l1) * 8). Proof. induction l1; simpl int_of_bytes; intros. simpl. ring. - simpl length. rewrite inj_S. + simpl length. rewrite inj_S. replace (Z.succ (Z.of_nat (length l1)) * 8) with (Z_of_nat (length l1) * 8 + 8) by omega. rewrite two_p_is_exp. change (two_p 8) with 256. rewrite IHl1. ring. omega. omega. @@ -928,23 +928,23 @@ Qed. Lemma int_of_bytes_range: forall l, 0 <= int_of_bytes l < two_p (Z_of_nat (length l) * 8). Proof. - induction l; intros. + induction l; intros. simpl. omega. - simpl length. rewrite inj_S. + simpl length. rewrite inj_S. replace (Z.succ (Z.of_nat (length l)) * 8) with (Z.of_nat (length l) * 8 + 8) by omega. - rewrite two_p_is_exp. change (two_p 8) with 256. - simpl int_of_bytes. generalize (Byte.unsigned_range a). - change Byte.modulus with 256. omega. - omega. omega. + rewrite two_p_is_exp. change (two_p 8) with 256. + simpl int_of_bytes. generalize (Byte.unsigned_range a). + change Byte.modulus with 256. omega. + omega. omega. Qed. Lemma length_proj_bytes: forall l b, proj_bytes l = Some b -> length b = length l. Proof. - induction l; simpl; intros. + induction l; simpl; intros. inv H; auto. - destruct a; try discriminate. - destruct (proj_bytes l) eqn:E; inv H. + destruct a; try discriminate. + destruct (proj_bytes l) eqn:E; inv H. simpl. f_equal. auto. Qed. @@ -958,8 +958,8 @@ Lemma proj_bytes_append: Proof. induction l1; simpl. destruct (proj_bytes l2); auto. - destruct a; auto. rewrite IHl1. - destruct (proj_bytes l1); auto. destruct (proj_bytes l2); auto. + destruct a; auto. rewrite IHl1. + destruct (proj_bytes l1); auto. destruct (proj_bytes l2); auto. Qed. Lemma decode_val_int64: @@ -971,26 +971,26 @@ Lemma decode_val_int64: (decode_val Mint32 (if Archi.big_endian then l2 else l1))). Proof. intros. unfold decode_val. - rewrite proj_bytes_append. + rewrite proj_bytes_append. destruct (proj_bytes l1) as [b1|] eqn:B1; destruct (proj_bytes l2) as [b2|] eqn:B2; auto. exploit length_proj_bytes. eexact B1. rewrite H; intro L1. exploit length_proj_bytes. eexact B2. rewrite H0; intro L2. assert (UR: forall l, length l = 4%nat -> Int.unsigned (Int.repr (int_of_bytes l)) = int_of_bytes l). - intros. apply Int.unsigned_repr. - generalize (int_of_bytes_range l). rewrite H1. - change (two_p (Z.of_nat 4 * 8)) with (Int.max_unsigned + 1). + intros. apply Int.unsigned_repr. + generalize (int_of_bytes_range l). rewrite H1. + change (two_p (Z.of_nat 4 * 8)) with (Int.max_unsigned + 1). omega. apply Val.lessdef_same. unfold decode_int, rev_if_be. destruct Archi.big_endian; rewrite B1; rewrite B2. - + rewrite <- (rev_length b1) in L1. + + rewrite <- (rev_length b1) in L1. rewrite <- (rev_length b2) in L2. rewrite rev_app_distr. set (b1' := rev b1) in *; set (b2' := rev b2) in *. unfold Val.longofwords. f_equal. rewrite Int64.ofwords_add. f_equal. - rewrite !UR by auto. rewrite int_of_bytes_append. + rewrite !UR by auto. rewrite int_of_bytes_append. rewrite L2. change (Z.of_nat 4 * 8) with 32. ring. + unfold Val.longofwords. f_equal. rewrite Int64.ofwords_add. f_equal. - rewrite !UR by auto. rewrite int_of_bytes_append. + rewrite !UR by auto. rewrite int_of_bytes_append. rewrite L1. change (Z.of_nat 4 * 8) with 32. ring. Qed. @@ -1001,17 +1001,17 @@ Lemma bytes_of_int_append: bytes_of_int n1 x1 ++ bytes_of_int n2 x2. Proof. induction n1; intros. -- simpl in *. f_equal. omega. +- simpl in *. f_equal. omega. - assert (E: two_p (Z.of_nat (S n1) * 8) = two_p (Z.of_nat n1 * 8) * 256). { - rewrite inj_S. change 256 with (two_p 8). rewrite <- two_p_is_exp. - f_equal. omega. omega. omega. + rewrite inj_S. change 256 with (two_p 8). rewrite <- two_p_is_exp. + f_equal. omega. omega. omega. } rewrite E in *. simpl. f_equal. - apply Byte.eqm_samerepr. exists (x2 * two_p (Z.of_nat n1 * 8)). + apply Byte.eqm_samerepr. exists (x2 * two_p (Z.of_nat n1 * 8)). change Byte.modulus with 256. ring. rewrite Zmult_assoc. rewrite Z_div_plus. apply IHn1. - apply Zdiv_interval_1. omega. apply two_p_gt_ZERO; omega. omega. + apply Zdiv_interval_1. omega. apply two_p_gt_ZERO; omega. omega. assumption. omega. Qed. @@ -1023,8 +1023,8 @@ Proof. intros. transitivity (bytes_of_int (4 + 4) (Int64.unsigned (Int64.ofwords (Int64.hiword i) (Int64.loword i)))). f_equal. f_equal. rewrite Int64.ofwords_recompose. auto. rewrite Int64.ofwords_add'. - change 32 with (Z_of_nat 4 * 8). - rewrite Zplus_comm. apply bytes_of_int_append. apply Int.unsigned_range. + change 32 with (Z_of_nat 4 * 8). + rewrite Zplus_comm. apply bytes_of_int_append. apply Int.unsigned_range. Qed. Lemma encode_val_int64: @@ -1035,10 +1035,10 @@ Lemma encode_val_int64: Proof. intros. destruct v; destruct Archi.big_endian eqn:BI; try reflexivity; unfold Val.loword, Val.hiword, encode_val. - unfold inj_bytes. rewrite <- map_app. f_equal. + unfold inj_bytes. rewrite <- map_app. f_equal. unfold encode_int, rev_if_be. rewrite BI. rewrite <- rev_app_distr. f_equal. - apply bytes_of_int64. - unfold inj_bytes. rewrite <- map_app. f_equal. + apply bytes_of_int64. + unfold inj_bytes. rewrite <- map_app. f_equal. unfold encode_int, rev_if_be. rewrite BI. apply bytes_of_int64. Qed. diff --git a/common/Memory.v b/common/Memory.v index 3d781cac..93d0e432 100644 --- a/common/Memory.v +++ b/common/Memory.v @@ -47,13 +47,13 @@ Local Notation "a # b" := (PMap.get b a) (at level 1). Module Mem <: MEM. -Definition perm_order' (po: option permission) (p: permission) := +Definition perm_order' (po: option permission) (p: permission) := match po with | Some p' => perm_order p' p | None => False end. -Definition perm_order'' (po1 po2: option permission) := +Definition perm_order'' (po1 po2: option permission) := match po1, po2 with | Some p1, Some p2 => perm_order p1 p2 | _, None => True @@ -65,7 +65,7 @@ Record mem' : Type := mkmem { mem_access: PMap.t (Z -> perm_kind -> option permission); (**r [block -> offset -> kind -> option permission] *) nextblock: block; - access_max: + access_max: forall b ofs, perm_order'' (mem_access#b ofs Max) (mem_access#b ofs Cur); nextblock_noaccess: forall b ofs k, ~(Plt b nextblock) -> mem_access#b ofs k = None; @@ -118,12 +118,12 @@ Theorem perm_cur_max: Proof. assert (forall po1 po2 p, perm_order' po2 p -> perm_order'' po1 po2 -> perm_order' po1 p). - unfold perm_order', perm_order''. intros. + unfold perm_order', perm_order''. intros. destruct po2; try contradiction. - destruct po1; try contradiction. + destruct po1; try contradiction. eapply perm_order_trans; eauto. unfold perm; intros. - generalize (access_max m b ofs). eauto. + generalize (access_max m b ofs). eauto. Qed. Theorem perm_cur: @@ -143,11 +143,11 @@ Hint Local Resolve perm_cur perm_max: mem. Theorem perm_valid_block: forall m b ofs k p, perm m b ofs k p -> valid_block m b. Proof. - unfold perm; intros. + unfold perm; intros. destruct (plt b m.(nextblock)). auto. assert (m.(mem_access)#b ofs k = None). - eapply nextblock_noaccess; eauto. + eapply nextblock_noaccess; eauto. rewrite H0 in H. contradiction. Qed. @@ -204,14 +204,14 @@ Hint Local Resolve range_perm_implies range_perm_cur range_perm_max: mem. Lemma range_perm_dec: forall m b lo hi k p, {range_perm m b lo hi k p} + {~ range_perm m b lo hi k p}. Proof. - intros. + intros. induction lo using (well_founded_induction_type (Zwf_up_well_founded hi)). destruct (zlt lo hi). destruct (perm_dec m b lo k p). - destruct (H (lo + 1)). red. omega. - left; red; intros. destruct (zeq lo ofs). congruence. apply r. omega. + destruct (H (lo + 1)). red. omega. + left; red; intros. destruct (zeq lo ofs). congruence. apply r. omega. right; red; intros. elim n. red; intros; apply H0; omega. - right; red; intros. elim n. apply H0. omega. + right; red; intros. elim n. apply H0. omega. left; red; intros. omegaContradiction. Defined. @@ -282,7 +282,7 @@ Lemma valid_access_dec: forall m chunk b ofs p, {valid_access m chunk b ofs p} + {~ valid_access m chunk b ofs p}. Proof. - intros. + intros. destruct (range_perm_dec m b ofs (ofs + size_chunk chunk) Cur p). destruct (Zdivide_dec (align_chunk chunk) ofs (align_chunk_pos chunk)). left; constructor; auto. @@ -299,7 +299,7 @@ Theorem valid_pointer_nonempty_perm: forall m b ofs, valid_pointer m b ofs = true <-> perm m b ofs Cur Nonempty. Proof. - intros. unfold valid_pointer. + intros. unfold valid_pointer. destruct (perm_dec m b ofs Cur Nonempty); simpl; intuition congruence. Qed. @@ -308,10 +308,10 @@ Theorem valid_pointer_valid_access: forall m b ofs, valid_pointer m b ofs = true <-> valid_access m Mint8unsigned b ofs Nonempty. Proof. - intros. rewrite valid_pointer_nonempty_perm. + intros. rewrite valid_pointer_nonempty_perm. split; intros. split. simpl; red; intros. replace ofs0 with ofs by omega. auto. - simpl. apply Zone_divide. + simpl. apply Zone_divide. destruct H. apply H. simpl. omega. Qed. @@ -361,7 +361,7 @@ Qed. infinite memory. *) Program Definition alloc (m: mem) (lo hi: Z) := - (mkmem (PMap.set m.(nextblock) + (mkmem (PMap.set m.(nextblock) (ZMap.init Undef) m.(mem_contents)) (PMap.set m.(nextblock) @@ -371,18 +371,18 @@ Program Definition alloc (m: mem) (lo hi: Z) := _ _ _, m.(nextblock)). Next Obligation. - repeat rewrite PMap.gsspec. destruct (peq b (nextblock m)). - subst b. destruct (zle lo ofs && zlt ofs hi); red; auto with mem. - apply access_max. + repeat rewrite PMap.gsspec. destruct (peq b (nextblock m)). + subst b. destruct (zle lo ofs && zlt ofs hi); red; auto with mem. + apply access_max. Qed. Next Obligation. - rewrite PMap.gsspec. destruct (peq b (nextblock m)). - subst b. elim H. apply Plt_succ. - apply nextblock_noaccess. red; intros; elim H. + rewrite PMap.gsspec. destruct (peq b (nextblock m)). + subst b. elim H. apply Plt_succ. + apply nextblock_noaccess. red; intros; elim H. apply Plt_trans_succ; auto. Qed. Next Obligation. - rewrite PMap.gsspec. destruct (peq b (nextblock m)). auto. apply contents_default. + rewrite PMap.gsspec. destruct (peq b (nextblock m)). auto. apply contents_default. Qed. (** Freeing a block between the given bounds. @@ -392,13 +392,13 @@ Qed. Program Definition unchecked_free (m: mem) (b: block) (lo hi: Z): mem := mkmem m.(mem_contents) - (PMap.set b + (PMap.set b (fun ofs k => if zle lo ofs && zlt ofs hi then None else m.(mem_access)#b ofs k) m.(mem_access)) m.(nextblock) _ _ _. Next Obligation. repeat rewrite PMap.gsspec. destruct (peq b0 b). - destruct (zle lo ofs && zlt ofs hi). red; auto. apply access_max. + destruct (zle lo ofs && zlt ofs hi). red; auto. apply access_max. apply access_max. Qed. Next Obligation. @@ -411,7 +411,7 @@ Next Obligation. Qed. Definition free (m: mem) (b: block) (lo hi: Z): option mem := - if range_perm_dec m b lo hi Cur Freeable + if range_perm_dec m b lo hi Cur Freeable then Some(unchecked_free m b lo hi) else None. @@ -479,11 +479,11 @@ Remark setN_other: ZMap.get q (setN vl p c) = ZMap.get q c. Proof. induction vl; intros; simpl. - auto. + auto. simpl length in H. rewrite inj_S in H. transitivity (ZMap.get q (ZMap.set p a c)). apply IHvl. intros. apply H. omega. - apply ZMap.gso. apply not_eq_sym. apply H. omega. + apply ZMap.gso. apply not_eq_sym. apply H. omega. Qed. Remark setN_outside: @@ -491,8 +491,8 @@ Remark setN_outside: q < p \/ q >= p + Z_of_nat (length vl) -> ZMap.get q (setN vl p c) = ZMap.get q c. Proof. - intros. apply setN_other. - intros. omega. + intros. apply setN_other. + intros. omega. Qed. Remark getN_setN_same: @@ -501,9 +501,9 @@ Remark getN_setN_same: Proof. induction vl; intros; simpl. auto. - decEq. - rewrite setN_outside. apply ZMap.gss. omega. - apply IHvl. + decEq. + rewrite setN_outside. apply ZMap.gss. omega. + apply IHvl. Qed. Remark getN_exten: @@ -511,7 +511,7 @@ Remark getN_exten: (forall i, p <= i < p + Z_of_nat n -> ZMap.get i c1 = ZMap.get i c2) -> getN n p c1 = getN n p c2. Proof. - induction n; intros. auto. rewrite inj_S in H. simpl. decEq. + induction n; intros. auto. rewrite inj_S in H. simpl. decEq. apply H. omega. apply IHn. intros. apply H. omega. Qed. @@ -521,7 +521,7 @@ Remark getN_setN_disjoint: getN n p (setN vl q c) = getN n p c. Proof. intros. apply getN_exten. intros. apply setN_other. - intros; red; intros; subst r. eelim H; eauto. + intros; red; intros; subst r. eelim H; eauto. Qed. Remark getN_setN_outside: @@ -529,13 +529,13 @@ Remark getN_setN_outside: p + Z_of_nat n <= q \/ q + Z_of_nat (length vl) <= p -> getN n p (setN vl q c) = getN n p c. Proof. - intros. apply getN_setN_disjoint. apply Intv.disjoint_range. auto. + intros. apply getN_setN_disjoint. apply Intv.disjoint_range. auto. Qed. Remark setN_default: forall vl q c, fst (setN vl q c) = fst c. Proof. - induction vl; simpl; intros. auto. rewrite IHvl. auto. + induction vl; simpl; intros. auto. rewrite IHvl. auto. Qed. (** [store chunk m b ofs v] perform a write in memory state [m]. @@ -545,7 +545,7 @@ Qed. Program Definition store (chunk: memory_chunk) (m: mem) (b: block) (ofs: Z) (v: val): option mem := if valid_access_dec m chunk b ofs Writable then - Some (mkmem (PMap.set b + Some (mkmem (PMap.set b (setN (encode_val chunk v) ofs (m.(mem_contents)#b)) m.(mem_contents)) m.(mem_access) @@ -555,9 +555,9 @@ Program Definition store (chunk: memory_chunk) (m: mem) (b: block) (ofs: Z) (v: None. Next Obligation. apply access_max. Qed. Next Obligation. apply nextblock_noaccess; auto. Qed. -Next Obligation. +Next Obligation. rewrite PMap.gsspec. destruct (peq b0 b). - rewrite setN_default. apply contents_default. + rewrite setN_default. apply contents_default. apply contents_default. Qed. @@ -585,9 +585,9 @@ Program Definition storebytes (m: mem) (b: block) (ofs: Z) (bytes: list memval) None. Next Obligation. apply access_max. Qed. Next Obligation. apply nextblock_noaccess; auto. Qed. -Next Obligation. +Next Obligation. rewrite PMap.gsspec. destruct (peq b0 b). - rewrite setN_default. apply contents_default. + rewrite setN_default. apply contents_default. apply contents_default. Qed. @@ -606,16 +606,16 @@ Program Definition drop_perm (m: mem) (b: block) (lo hi: Z) (p: permission): opt else None. Next Obligation. repeat rewrite PMap.gsspec. destruct (peq b0 b). subst b0. - destruct (zle lo ofs && zlt ofs hi). red; auto with mem. apply access_max. + destruct (zle lo ofs && zlt ofs hi). red; auto with mem. apply access_max. apply access_max. Qed. Next Obligation. - specialize (nextblock_noaccess m b0 ofs k H0). intros. + specialize (nextblock_noaccess m b0 ofs k H0). intros. rewrite PMap.gsspec. destruct (peq b0 b). subst b0. destruct (zle lo ofs). destruct (zlt ofs hi). - assert (perm m b ofs k Freeable). apply perm_cur. apply H; auto. + assert (perm m b ofs k Freeable). apply perm_cur. apply H; auto. unfold perm in H2. rewrite H1 in H2. contradiction. - auto. auto. auto. + auto. auto. auto. Qed. Next Obligation. apply contents_default. @@ -629,13 +629,13 @@ Theorem nextblock_empty: nextblock empty = 1%positive. Proof. reflexivity. Qed. Theorem perm_empty: forall b ofs k p, ~perm empty b ofs k p. -Proof. - intros. unfold perm, empty; simpl. rewrite PMap.gi. simpl. tauto. +Proof. + intros. unfold perm, empty; simpl. rewrite PMap.gi. simpl. tauto. Qed. Theorem valid_access_empty: forall chunk b ofs p, ~valid_access empty chunk b ofs p. Proof. - intros. red; intros. elim (perm_empty b ofs Cur p). apply H. + intros. red; intros. elim (perm_empty b ofs Cur p). apply H. generalize (size_chunk_pos chunk); omega. Qed. @@ -646,7 +646,7 @@ Theorem valid_access_load: valid_access m chunk b ofs Readable -> exists v, load chunk m b ofs = Some v. Proof. - intros. econstructor. unfold load. rewrite pred_dec_true; eauto. + intros. econstructor. unfold load. rewrite pred_dec_true; eauto. Qed. Theorem load_valid_access: @@ -654,9 +654,9 @@ Theorem load_valid_access: load chunk m b ofs = Some v -> valid_access m chunk b ofs Readable. Proof. - intros until v. unfold load. + intros until v. unfold load. destruct (valid_access_dec m chunk b ofs Readable); intros. - auto. + auto. congruence. Qed. @@ -665,7 +665,7 @@ Lemma load_result: load chunk m b ofs = Some v -> v = decode_val chunk (getN (size_chunk_nat chunk) ofs (m.(mem_contents)#b)). Proof. - intros until v. unfold load. + intros until v. unfold load. destruct (valid_access_dec m chunk b ofs Readable); intros. congruence. congruence. @@ -678,8 +678,8 @@ Theorem load_type: load chunk m b ofs = Some v -> Val.has_type v (type_of_chunk chunk). Proof. - intros. exploit load_result; eauto; intros. rewrite H0. - apply decode_val_type. + intros. exploit load_result; eauto; intros. rewrite H0. + apply decode_val_type. Qed. Theorem load_cast: @@ -695,7 +695,7 @@ Theorem load_cast: Proof. intros. exploit load_result; eauto. set (l := getN (size_chunk_nat chunk) ofs m.(mem_contents)#b). - intros. subst v. apply decode_val_cast. + intros. subst v. apply decode_val_cast. Qed. Theorem load_int8_signed_unsigned: @@ -706,7 +706,7 @@ Proof. change (size_chunk_nat Mint8signed) with (size_chunk_nat Mint8unsigned). set (cl := getN (size_chunk_nat Mint8unsigned) ofs m.(mem_contents)#b). destruct (valid_access_dec m Mint8signed b ofs Readable). - rewrite pred_dec_true; auto. unfold decode_val. + rewrite pred_dec_true; auto. unfold decode_val. destruct (proj_bytes cl); auto. simpl. decEq. decEq. rewrite Int.sign_ext_zero_ext. auto. compute; auto. rewrite pred_dec_false; auto. @@ -720,7 +720,7 @@ Proof. change (size_chunk_nat Mint16signed) with (size_chunk_nat Mint16unsigned). set (cl := getN (size_chunk_nat Mint16unsigned) ofs m.(mem_contents)#b). destruct (valid_access_dec m Mint16signed b ofs Readable). - rewrite pred_dec_true; auto. unfold decode_val. + rewrite pred_dec_true; auto. unfold decode_val. destruct (proj_bytes cl); auto. simpl. decEq. decEq. rewrite Int.sign_ext_zero_ext. auto. compute; auto. rewrite pred_dec_false; auto. @@ -733,7 +733,7 @@ Theorem range_perm_loadbytes: range_perm m b ofs (ofs + len) Cur Readable -> exists bytes, loadbytes m b ofs len = Some bytes. Proof. - intros. econstructor. unfold loadbytes. rewrite pred_dec_true; eauto. + intros. econstructor. unfold loadbytes. rewrite pred_dec_true; eauto. Qed. Theorem loadbytes_range_perm: @@ -751,10 +751,10 @@ Theorem loadbytes_load: (align_chunk chunk | ofs) -> load chunk m b ofs = Some(decode_val chunk bytes). Proof. - unfold loadbytes, load; intros. + unfold loadbytes, load; intros. destruct (range_perm_dec m b ofs (ofs + size_chunk chunk) Cur Readable); try congruence. - inv H. rewrite pred_dec_true. auto. + inv H. rewrite pred_dec_true. auto. split; auto. Qed. @@ -765,9 +765,9 @@ Theorem load_loadbytes: /\ v = decode_val chunk bytes. Proof. intros. exploit load_valid_access; eauto. intros [A B]. - exploit load_result; eauto. intros. + exploit load_result; eauto. intros. exists (getN (size_chunk_nat chunk) ofs m.(mem_contents)#b); split. - unfold loadbytes. rewrite pred_dec_true; auto. + unfold loadbytes. rewrite pred_dec_true; auto. auto. Qed. @@ -794,7 +794,7 @@ Proof. intros. unfold loadbytes. rewrite pred_dec_true. rewrite nat_of_Z_neg; auto. red; intros. omegaContradiction. Qed. - + Lemma getN_concat: forall c n1 n2 p, getN (n1 + n2)%nat p c = getN n1 p c ++ getN n2 (p + Z_of_nat n1) c. @@ -803,7 +803,7 @@ Proof. simpl. decEq. omega. rewrite inj_S. simpl. decEq. replace (p + Zsucc (Z_of_nat n1)) with ((p + 1) + Z_of_nat n1) by omega. - auto. + auto. Qed. Theorem loadbytes_concat: @@ -819,7 +819,7 @@ Proof. rewrite pred_dec_true. rewrite nat_of_Z_plus; auto. rewrite getN_concat. rewrite nat_of_Z_eq; auto. congruence. - red; intros. + red; intros. assert (ofs0 < ofs + n1 \/ ofs0 >= ofs + n1) by omega. destruct H4. apply r; omega. apply r0; omega. Qed. @@ -829,15 +829,15 @@ Theorem loadbytes_split: loadbytes m b ofs (n1 + n2) = Some bytes -> n1 >= 0 -> n2 >= 0 -> exists bytes1, exists bytes2, - loadbytes m b ofs n1 = Some bytes1 + loadbytes m b ofs n1 = Some bytes1 /\ loadbytes m b (ofs + n1) n2 = Some bytes2 /\ bytes = bytes1 ++ bytes2. Proof. - unfold loadbytes; intros. + unfold loadbytes; intros. destruct (range_perm_dec m b ofs (ofs + (n1 + n2)) Cur Readable); try congruence. rewrite nat_of_Z_plus in H; auto. rewrite getN_concat in H. - rewrite nat_of_Z_eq in H; auto. + rewrite nat_of_Z_eq in H; auto. repeat rewrite pred_dec_true. econstructor; econstructor. split. reflexivity. split. reflexivity. congruence. @@ -846,7 +846,7 @@ Proof. Qed. Theorem load_rep: - forall ch m1 m2 b ofs v1 v2, + forall ch m1 m2 b ofs v1 v2, (forall z, 0 <= z < size_chunk ch -> ZMap.get (ofs + z) m1.(mem_contents)#b = ZMap.get (ofs + z) m2.(mem_contents)#b) -> load ch m1 b ofs = Some v1 -> load ch m2 b ofs = Some v2 -> @@ -879,11 +879,11 @@ Theorem load_int64_split: /\ load Mint32 m b (ofs + 4) = Some (if Archi.big_endian then v2 else v1) /\ Val.lessdef v (Val.longofwords v1 v2). Proof. - intros. + intros. exploit load_valid_access; eauto. intros [A B]. simpl in *. exploit load_loadbytes. eexact H. simpl. intros [bytes [LB EQ]]. - change 8 with (4 + 4) in LB. - exploit loadbytes_split. eexact LB. omega. omega. + change 8 with (4 + 4) in LB. + exploit loadbytes_split. eexact LB. omega. omega. intros (bytes1 & bytes2 & LB1 & LB2 & APP). change 4 with (size_chunk Mint32) in LB1. exploit loadbytes_load. eexact LB1. @@ -898,8 +898,8 @@ Proof. split. destruct Archi.big_endian; auto. split. destruct Archi.big_endian; auto. rewrite EQ. rewrite APP. apply decode_val_int64. - erewrite loadbytes_length; eauto. reflexivity. - erewrite loadbytes_length; eauto. reflexivity. + erewrite loadbytes_length; eauto. reflexivity. + erewrite loadbytes_length; eauto. reflexivity. Qed. Theorem loadv_int64_split: @@ -916,12 +916,12 @@ Proof. rewrite Int.add_unsigned. apply Int.unsigned_repr. exploit load_valid_access. eexact H. intros [P Q]. simpl in Q. exploit (Zdivide_interval (Int.unsigned i) Int.modulus 8). - omega. apply Int.unsigned_range. auto. exists (two_p (32-3)); reflexivity. + omega. apply Int.unsigned_range. auto. exists (two_p (32-3)); reflexivity. unfold Int.max_unsigned. omega. exists v1; exists v2. Opaque Int.repr. split. auto. - split. simpl. rewrite NV. auto. + split. simpl. rewrite NV. auto. auto. Qed. @@ -933,7 +933,7 @@ Theorem valid_access_store: { m2: mem | store chunk m1 b ofs v = Some m2 }. Proof. intros. - unfold store. + unfold store. destruct (valid_access_dec m1 chunk b ofs Writable). eauto. contradiction. @@ -956,7 +956,7 @@ Proof. auto. Qed. -Lemma store_mem_contents: +Lemma store_mem_contents: mem_contents m2 = PMap.set b (setN (encode_val chunk v) ofs m1.(mem_contents)#b) m1.(mem_contents). Proof. unfold store in STORE. destruct (valid_access_dec m1 chunk b ofs Writable); inv STORE. @@ -966,7 +966,7 @@ Qed. Theorem perm_store_1: forall b' ofs' k p, perm m1 b' ofs' k p -> perm m2 b' ofs' k p. Proof. - intros. + intros. unfold perm in *. rewrite store_access; auto. Qed. @@ -1018,7 +1018,7 @@ Theorem store_valid_access_3: valid_access m1 chunk b ofs Writable. Proof. unfold store in STORE. destruct (valid_access_dec m1 chunk b ofs Writable). - auto. + auto. congruence. Qed. @@ -1032,15 +1032,15 @@ Theorem load_store_similar: Proof. intros. exploit (valid_access_load m2 chunk'). - eapply valid_access_compat. symmetry; eauto. auto. eauto with mem. + eapply valid_access_compat. symmetry; eauto. auto. eauto with mem. intros [v' LOAD]. exists v'; split; auto. - exploit load_result; eauto. intros B. - rewrite B. rewrite store_mem_contents; simpl. + exploit load_result; eauto. intros B. + rewrite B. rewrite store_mem_contents; simpl. rewrite PMap.gss. replace (size_chunk_nat chunk') with (length (encode_val chunk v)). - rewrite getN_setN_same. apply decode_encode_val_general. - rewrite encode_val_length. repeat rewrite size_chunk_conv in H. + rewrite getN_setN_same. apply decode_encode_val_general. + rewrite encode_val_length. repeat rewrite size_chunk_conv in H. apply inj_eq_rev; auto. Qed. @@ -1068,9 +1068,9 @@ Theorem load_store_other: \/ ofs + size_chunk chunk <= ofs' -> load chunk' m2 b' ofs' = load chunk' m1 b' ofs'. Proof. - intros. unfold load. + intros. unfold load. destruct (valid_access_dec m1 chunk' b' ofs' Readable). - rewrite pred_dec_true. + rewrite pred_dec_true. decEq. decEq. rewrite store_mem_contents; simpl. rewrite PMap.gsspec. destruct (peq b' b). subst b'. apply getN_setN_outside. rewrite encode_val_length. repeat rewrite <- size_chunk_conv. @@ -1078,7 +1078,7 @@ Proof. auto. eauto with mem. rewrite pred_dec_false. auto. - eauto with mem. + eauto with mem. Qed. Theorem loadbytes_store_same: @@ -1086,12 +1086,12 @@ Theorem loadbytes_store_same: Proof. intros. assert (valid_access m2 chunk b ofs Readable) by eauto with mem. - unfold loadbytes. rewrite pred_dec_true. rewrite store_mem_contents; simpl. + unfold loadbytes. rewrite pred_dec_true. rewrite store_mem_contents; simpl. rewrite PMap.gss. replace (nat_of_Z (size_chunk chunk)) with (length (encode_val chunk v)). rewrite getN_setN_same. auto. rewrite encode_val_length. auto. - apply H. + apply H. Qed. Theorem loadbytes_store_other: @@ -1102,9 +1102,9 @@ Theorem loadbytes_store_other: \/ ofs + size_chunk chunk <= ofs' -> loadbytes m2 b' ofs' n = loadbytes m1 b' ofs' n. Proof. - intros. unfold loadbytes. + intros. unfold loadbytes. destruct (range_perm_dec m1 b' ofs' (ofs' + n) Cur Readable). - rewrite pred_dec_true. + rewrite pred_dec_true. decEq. rewrite store_mem_contents; simpl. rewrite PMap.gsspec. destruct (peq b' b). subst b'. destruct H. congruence. @@ -1112,7 +1112,7 @@ Proof. rewrite (nat_of_Z_neg _ z). auto. destruct H. omegaContradiction. apply getN_setN_outside. rewrite encode_val_length. rewrite <- size_chunk_conv. - rewrite nat_of_Z_eq. auto. omega. + rewrite nat_of_Z_eq. auto. omega. auto. red; intros. eauto with mem. rewrite pred_dec_false. auto. @@ -1126,8 +1126,8 @@ Lemma setN_in: Proof. induction vl; intros. simpl in H. omegaContradiction. - simpl length in H. rewrite inj_S in H. simpl. - destruct (zeq p q). subst q. rewrite setN_outside. rewrite ZMap.gss. + simpl length in H. rewrite inj_S in H. simpl. + destruct (zeq p q). subst q. rewrite setN_outside. rewrite ZMap.gss. auto with coqlib. omega. right. apply IHvl. omega. Qed. @@ -1141,7 +1141,7 @@ Proof. simpl in H; omegaContradiction. rewrite inj_S in H. simpl. destruct (zeq p q). subst q. auto. - right. apply IHn. omega. + right. apply IHn. omega. Qed. End STORE. @@ -1164,20 +1164,20 @@ Lemma load_store_overlap: \/ (ofs' > ofs /\ In mv1' mvl) \/ (ofs' < ofs /\ In mv1 mvl')). Proof. - intros. + intros. exploit load_result; eauto. erewrite store_mem_contents by eauto; simpl. - rewrite PMap.gss. - set (c := (mem_contents m1)#b). intros V'. - destruct (size_chunk_nat_pos chunk) as [sz SIZE]. + rewrite PMap.gss. + set (c := (mem_contents m1)#b). intros V'. + destruct (size_chunk_nat_pos chunk) as [sz SIZE]. destruct (size_chunk_nat_pos chunk') as [sz' SIZE']. destruct (encode_val chunk v) as [ | mv1 mvl] eqn:ENC. generalize (encode_val_length chunk v); rewrite ENC; simpl; congruence. set (c' := setN (mv1::mvl) ofs c) in *. exists mv1, mvl, (ZMap.get ofs' c'), (getN sz' (ofs' + 1) c'). split. rewrite <- ENC. apply encode_val_shape. - split. rewrite V', SIZE'. apply decode_val_shape. + split. rewrite V', SIZE'. apply decode_val_shape. destruct (zeq ofs' ofs). -- subst ofs'. left; split. auto. unfold c'. simpl. +- subst ofs'. left; split. auto. unfold c'. simpl. rewrite setN_outside by omega. apply ZMap.gss. - right. destruct (zlt ofs ofs'). (* If ofs < ofs': the load reads (at ofs') a continuation byte from the write. @@ -1185,7 +1185,7 @@ Proof. [-------------------] write [-------------------] read *) -+ left; split. omega. unfold c'. simpl. apply setN_in. ++ left; split. omega. unfold c'. simpl. apply setN_in. assert (Z.of_nat (length (mv1 :: mvl)) = size_chunk chunk). { rewrite <- ENC; rewrite encode_val_length. rewrite size_chunk_conv; auto. } simpl length in H3. rewrite inj_S in H3. omega. @@ -1194,8 +1194,8 @@ Proof. [-------------------] write [----------------] read *) -+ right; split. omega. replace mv1 with (ZMap.get ofs c'). - apply getN_in. ++ right; split. omega. replace mv1 with (ZMap.get ofs c'). + apply getN_in. assert (size_chunk chunk' = Zsucc (Z.of_nat sz')). { rewrite size_chunk_conv. rewrite SIZE'. rewrite inj_S; auto. } omega. @@ -1231,20 +1231,20 @@ Proof. destruct (peq b' b); auto. subst b'. destruct (zle (ofs' + size_chunk chunk') ofs); auto. destruct (zle (ofs + size_chunk chunk) ofs'); auto. - exploit load_store_overlap; eauto. + exploit load_store_overlap; eauto. intros (mv1 & mvl & mv1' & mvl' & ENC & DEC & CASES). inv DEC; try contradiction. destruct CASES as [(A & B) | [(A & B) | (A & B)]]. - (* Same offset *) - subst. inv ENC. + subst. inv ENC. assert (chunk = Mint32 \/ chunk = Many32 \/ chunk = Many64) - by (destruct chunk; auto || contradiction). + by (destruct chunk; auto || contradiction). left; split. rewrite H3. destruct H4 as [P|[P|P]]; subst chunk'; destruct v0; simpl in H3; congruence. split. apply compat_pointer_chunks_true; auto. auto. - (* ofs' > ofs *) - inv ENC. + inv ENC. + exploit H10; eauto. intros (j & P & Q). inv P. congruence. + exploit H8; eauto. intros (n & P); congruence. + exploit H2; eauto. congruence. @@ -1261,18 +1261,18 @@ Theorem load_store_pointer_overlap: ofs + size_chunk chunk > ofs' -> v = Vundef. Proof. - intros. - exploit load_store_overlap; eauto. + intros. + exploit load_store_overlap; eauto. intros (mv1 & mvl & mv1' & mvl' & ENC & DEC & CASES). destruct CASES as [(A & B) | [(A & B) | (A & B)]]. - congruence. -- inv ENC. +- inv ENC. + exploit H9; eauto. intros (j & P & Q). subst mv1'. inv DEC. congruence. auto. + contradiction. + exploit H5; eauto. intros; subst. inv DEC; auto. -- inv DEC. - + exploit H10; eauto. intros (j & P & Q). subst mv1. inv ENC. congruence. - + exploit H8; eauto. intros (n & P). subst mv1. inv ENC. contradiction. +- inv DEC. + + exploit H10; eauto. intros (j & P & Q). subst mv1. inv ENC. congruence. + + exploit H8; eauto. intros (n & P). subst mv1. inv ENC. contradiction. + auto. Qed. @@ -1284,7 +1284,7 @@ Theorem load_store_pointer_mismatch: v = Vundef. Proof. intros. - exploit load_store_overlap; eauto. + exploit load_store_overlap; eauto. generalize (size_chunk_pos chunk'); omega. generalize (size_chunk_pos chunk); omega. intros (mv1 & mvl & mv1' & mvl' & ENC & DEC & CASES). @@ -1300,7 +1300,7 @@ Lemma store_similar_chunks: align_chunk chunk1 = align_chunk chunk2 -> store chunk1 m b ofs v1 = store chunk2 m b ofs v2. Proof. - intros. unfold store. + intros. unfold store. assert (size_chunk chunk1 = size_chunk chunk2). repeat rewrite size_chunk_conv. rewrite <- (encode_val_length chunk1 v1). @@ -1353,7 +1353,7 @@ Theorem store_float64al32: forall m b ofs v m', store Mfloat64 m b ofs v = Some m' -> store Mfloat64al32 m b ofs v = Some m'. Proof. - unfold store; intros. + unfold store; intros. destruct (valid_access_dec m Mfloat64 b ofs Writable); try discriminate. destruct (valid_access_dec m Mfloat64al32 b ofs Writable). rewrite <- H. f_equal. apply mkmem_ext; auto. @@ -1377,7 +1377,7 @@ Theorem range_perm_storebytes: Proof. intros. unfold storebytes. destruct (range_perm_dec m1 b ofs (ofs + Z_of_nat (length bytes)) Cur Writable). - econstructor; reflexivity. + econstructor; reflexivity. contradiction. Defined. @@ -1387,11 +1387,11 @@ Theorem storebytes_store: (align_chunk chunk | ofs) -> store chunk m1 b ofs v = Some m2. Proof. - unfold storebytes, store. intros. + unfold storebytes, store. intros. destruct (range_perm_dec m1 b ofs (ofs + Z_of_nat (length (encode_val chunk v))) Cur Writable); inv H. destruct (valid_access_dec m1 chunk b ofs Writable). f_equal. apply mkmem_ext; auto. - elim n. constructor; auto. + elim n. constructor; auto. rewrite encode_val_length in r. rewrite size_chunk_conv. auto. Qed. @@ -1400,14 +1400,14 @@ Theorem store_storebytes: store chunk m1 b ofs v = Some m2 -> storebytes m1 b ofs (encode_val chunk v) = Some m2. Proof. - unfold storebytes, store. intros. + unfold storebytes, store. intros. destruct (valid_access_dec m1 chunk b ofs Writable); inv H. destruct (range_perm_dec m1 b ofs (ofs + Z_of_nat (length (encode_val chunk v))) Cur Writable). f_equal. apply mkmem_ext; auto. - destruct v0. elim n. + destruct v0. elim n. rewrite encode_val_length. rewrite <- size_chunk_conv. auto. Qed. - + Section STOREBYTES. Variable m1: mem. Variable b: block. @@ -1418,7 +1418,7 @@ Hypothesis STORE: storebytes m1 b ofs bytes = Some m2. Lemma storebytes_access: mem_access m2 = mem_access m1. Proof. - unfold storebytes in STORE. + unfold storebytes in STORE. destruct (range_perm_dec m1 b ofs (ofs + Z_of_nat (length bytes)) Cur Writable); inv STORE. auto. @@ -1427,7 +1427,7 @@ Qed. Lemma storebytes_mem_contents: mem_contents m2 = PMap.set b (setN bytes ofs m1.(mem_contents)#b) m1.(mem_contents). Proof. - unfold storebytes in STORE. + unfold storebytes in STORE. destruct (range_perm_dec m1 b ofs (ofs + Z_of_nat (length bytes)) Cur Writable); inv STORE. auto. @@ -1467,7 +1467,7 @@ Theorem nextblock_storebytes: nextblock m2 = nextblock m1. Proof. intros. - unfold storebytes in STORE. + unfold storebytes in STORE. destruct (range_perm_dec m1 b ofs (ofs + Z_of_nat (length bytes)) Cur Writable); inv STORE. auto. @@ -1490,8 +1490,8 @@ Local Hint Resolve storebytes_valid_block_1 storebytes_valid_block_2: mem. Theorem storebytes_range_perm: range_perm m1 b ofs (ofs + Z_of_nat (length bytes)) Cur Writable. Proof. - intros. - unfold storebytes in STORE. + intros. + unfold storebytes in STORE. destruct (range_perm_dec m1 b ofs (ofs + Z_of_nat (length bytes)) Cur Writable); inv STORE. auto. @@ -1500,13 +1500,13 @@ Qed. Theorem loadbytes_storebytes_same: loadbytes m2 b ofs (Z_of_nat (length bytes)) = Some bytes. Proof. - intros. unfold storebytes in STORE. unfold loadbytes. + intros. unfold storebytes in STORE. unfold loadbytes. destruct (range_perm_dec m1 b ofs (ofs + Z_of_nat (length bytes)) Cur Writable); try discriminate. - rewrite pred_dec_true. - decEq. inv STORE; simpl. rewrite PMap.gss. rewrite nat_of_Z_of_nat. - apply getN_setN_same. - red; eauto with mem. + rewrite pred_dec_true. + decEq. inv STORE; simpl. rewrite PMap.gss. rewrite nat_of_Z_of_nat. + apply getN_setN_same. + red; eauto with mem. Qed. Theorem loadbytes_storebytes_disjoint: @@ -1517,13 +1517,13 @@ Theorem loadbytes_storebytes_disjoint: Proof. intros. unfold loadbytes. destruct (range_perm_dec m1 b' ofs' (ofs' + len) Cur Readable). - rewrite pred_dec_true. - rewrite storebytes_mem_contents. decEq. - rewrite PMap.gsspec. destruct (peq b' b). subst b'. + rewrite pred_dec_true. + rewrite storebytes_mem_contents. decEq. + rewrite PMap.gsspec. destruct (peq b' b). subst b'. apply getN_setN_disjoint. rewrite nat_of_Z_eq; auto. intuition congruence. auto. red; auto with mem. - apply pred_dec_false. + apply pred_dec_false. red; intros; elim n. red; auto with mem. Qed. @@ -1535,8 +1535,8 @@ Theorem loadbytes_storebytes_other: \/ ofs + Z_of_nat (length bytes) <= ofs' -> loadbytes m2 b' ofs' len = loadbytes m1 b' ofs' len. Proof. - intros. apply loadbytes_storebytes_disjoint; auto. - destruct H0; auto. right. apply Intv.disjoint_range; auto. + intros. apply loadbytes_storebytes_disjoint; auto. + destruct H0; auto. right. apply Intv.disjoint_range; auto. Qed. Theorem load_storebytes_other: @@ -1548,13 +1548,13 @@ Theorem load_storebytes_other: Proof. intros. unfold load. destruct (valid_access_dec m1 chunk b' ofs' Readable). - rewrite pred_dec_true. + rewrite pred_dec_true. rewrite storebytes_mem_contents. decEq. rewrite PMap.gsspec. destruct (peq b' b). subst b'. rewrite getN_setN_outside. auto. rewrite <- size_chunk_conv. intuition congruence. auto. destruct v; split; auto. red; auto with mem. - apply pred_dec_false. + apply pred_dec_false. red; intros; elim n. destruct H0. split; auto. red; auto with mem. Qed. @@ -1582,10 +1582,10 @@ Proof. destruct (range_perm_dec m b ofs (ofs + Z_of_nat (length (bytes1 ++ bytes2))) Cur Writable). inv ST1; inv ST2; simpl. decEq. apply mkmem_ext; auto. rewrite PMap.gss. rewrite setN_concat. symmetry. apply PMap.set2. - elim n. + elim n. rewrite app_length. rewrite inj_plus. red; intros. destruct (zlt ofs0 (ofs + Z_of_nat(length bytes1))). - apply r. omega. + apply r. omega. eapply perm_storebytes_2; eauto. apply r0. omega. Qed. @@ -1596,18 +1596,18 @@ Theorem storebytes_split: storebytes m b ofs bytes1 = Some m1 /\ storebytes m1 b (ofs + Z_of_nat(length bytes1)) bytes2 = Some m2. Proof. - intros. + intros. destruct (range_perm_storebytes m b ofs bytes1) as [m1 ST1]. - red; intros. exploit storebytes_range_perm; eauto. rewrite app_length. + red; intros. exploit storebytes_range_perm; eauto. rewrite app_length. rewrite inj_plus. omega. destruct (range_perm_storebytes m1 b (ofs + Z_of_nat (length bytes1)) bytes2) as [m2' ST2]. - red; intros. eapply perm_storebytes_1; eauto. exploit storebytes_range_perm. + red; intros. eapply perm_storebytes_1; eauto. exploit storebytes_range_perm. eexact H. instantiate (1 := ofs0). rewrite app_length. rewrite inj_plus. omega. auto. assert (Some m2 = Some m2'). rewrite <- H. eapply storebytes_concat; eauto. inv H0. - exists m1; split; auto. + exists m1; split; auto. Qed. Theorem store_int64_split: @@ -1617,16 +1617,16 @@ Theorem store_int64_split: store Mint32 m b ofs (if Archi.big_endian then Val.hiword v else Val.loword v) = Some m1 /\ store Mint32 m1 b (ofs + 4) (if Archi.big_endian then Val.loword v else Val.hiword v) = Some m'. Proof. - intros. + intros. exploit store_valid_access_3; eauto. intros [A B]. simpl in *. exploit store_storebytes. eexact H. intros SB. - rewrite encode_val_int64 in SB. - exploit storebytes_split. eexact SB. intros [m1 [SB1 SB2]]. - rewrite encode_val_length in SB2. simpl in SB2. - exists m1; split. + rewrite encode_val_int64 in SB. + exploit storebytes_split. eexact SB. intros [m1 [SB1 SB2]]. + rewrite encode_val_length in SB2. simpl in SB2. + exists m1; split. apply storebytes_store. exact SB1. simpl. apply Zdivides_trans with 8; auto. exists 2; auto. - apply storebytes_store. exact SB2. + apply storebytes_store. exact SB2. simpl. apply Zdivide_plus_r. apply Zdivides_trans with 8; auto. exists 2; auto. exists 1; auto. Qed. @@ -1644,8 +1644,8 @@ Proof. unfold storev, Val.add. rewrite Int.add_unsigned. rewrite Int.unsigned_repr. exact B. exploit store_valid_access_3. eexact H. intros [P Q]. simpl in Q. exploit (Zdivide_interval (Int.unsigned i) Int.modulus 8). - omega. apply Int.unsigned_range. auto. exists (two_p (32-3)); reflexivity. - change (Int.unsigned (Int.repr 4)) with 4. unfold Int.max_unsigned. omega. + omega. apply Int.unsigned_range. auto. exists (two_p (32-3)); reflexivity. + change (Int.unsigned (Int.repr 4)) with 4. unfold Int.max_unsigned. omega. Qed. (** ** Properties related to [alloc]. *) @@ -1673,14 +1673,14 @@ Qed. Theorem valid_block_alloc: forall b', valid_block m1 b' -> valid_block m2 b'. Proof. - unfold valid_block; intros. rewrite nextblock_alloc. + unfold valid_block; intros. rewrite nextblock_alloc. apply Plt_trans_succ; auto. Qed. Theorem fresh_block_alloc: ~(valid_block m1 b). Proof. - unfold valid_block. rewrite alloc_result. apply Plt_strict. + unfold valid_block. rewrite alloc_result. apply Plt_strict. Qed. Theorem valid_new_block: @@ -1694,8 +1694,8 @@ Local Hint Resolve valid_block_alloc fresh_block_alloc valid_new_block: mem. Theorem valid_block_alloc_inv: forall b', valid_block m2 b' -> b' = b \/ valid_block m1 b'. Proof. - unfold valid_block; intros. - rewrite nextblock_alloc in H. rewrite alloc_result. + unfold valid_block; intros. + rewrite nextblock_alloc in H. rewrite alloc_result. exploit Plt_succ_inv; eauto. tauto. Qed. @@ -1704,7 +1704,7 @@ Theorem perm_alloc_1: Proof. unfold perm; intros. injection ALLOC; intros. rewrite <- H1; simpl. subst b. rewrite PMap.gsspec. destruct (peq b' (nextblock m1)); auto. - rewrite nextblock_noaccess in H. contradiction. subst b'. apply Plt_strict. + rewrite nextblock_noaccess in H. contradiction. subst b'. apply Plt_strict. Qed. Theorem perm_alloc_2: @@ -1716,21 +1716,21 @@ Proof. Qed. Theorem perm_alloc_inv: - forall b' ofs k p, + forall b' ofs k p, perm m2 b' ofs k p -> if eq_block b' b then lo <= ofs < hi else perm m1 b' ofs k p. Proof. - intros until p; unfold perm. inv ALLOC. simpl. + intros until p; unfold perm. inv ALLOC. simpl. rewrite PMap.gsspec. unfold eq_block. destruct (peq b' (nextblock m1)); intros. destruct (zle lo ofs); try contradiction. destruct (zlt ofs hi); try contradiction. - split; auto. + split; auto. auto. Qed. Theorem perm_alloc_3: forall ofs k p, perm m2 b ofs k p -> lo <= ofs < hi. Proof. - intros. exploit perm_alloc_inv; eauto. rewrite dec_eq_true; auto. + intros. exploit perm_alloc_inv; eauto. rewrite dec_eq_true; auto. Qed. Theorem perm_alloc_4: @@ -1756,7 +1756,7 @@ Theorem valid_access_alloc_same: valid_access m2 chunk b ofs Freeable. Proof. intros. constructor; auto with mem. - red; intros. apply perm_alloc_2. omega. + red; intros. apply perm_alloc_2. omega. Qed. Local Hint Resolve valid_access_alloc_other valid_access_alloc_same: mem. @@ -1771,13 +1771,13 @@ Proof. intros. inv H. generalize (size_chunk_pos chunk); intro. destruct (eq_block b' b). subst b'. - assert (perm m2 b ofs Cur p). apply H0. omega. - assert (perm m2 b (ofs + size_chunk chunk - 1) Cur p). apply H0. omega. + assert (perm m2 b ofs Cur p). apply H0. omega. + assert (perm m2 b (ofs + size_chunk chunk - 1) Cur p). apply H0. omega. exploit perm_alloc_inv. eexact H2. rewrite dec_eq_true. intro. - exploit perm_alloc_inv. eexact H3. rewrite dec_eq_true. intro. - intuition omega. - split; auto. red; intros. - exploit perm_alloc_inv. apply H0. eauto. rewrite dec_eq_false; auto. + exploit perm_alloc_inv. eexact H3. rewrite dec_eq_true. intro. + intuition omega. + split; auto. red; intros. + exploit perm_alloc_inv. apply H0. eauto. rewrite dec_eq_false; auto. Qed. Theorem load_alloc_unchanged: @@ -1809,7 +1809,7 @@ Theorem load_alloc_same: load chunk m2 b ofs = Some v -> v = Vundef. Proof. - intros. exploit load_result; eauto. intro. rewrite H0. + intros. exploit load_result; eauto. intro. rewrite H0. injection ALLOC; intros. rewrite <- H2; simpl. rewrite <- H1. rewrite PMap.gss. destruct chunk; simpl; repeat rewrite ZMap.gi; reflexivity. Qed. @@ -1831,14 +1831,14 @@ Theorem loadbytes_alloc_unchanged: valid_block m1 b' -> loadbytes m2 b' ofs n = loadbytes m1 b' ofs n. Proof. - intros. unfold loadbytes. + intros. unfold loadbytes. destruct (range_perm_dec m1 b' ofs (ofs + n) Cur Readable). rewrite pred_dec_true. - injection ALLOC; intros A B. rewrite <- B; simpl. + injection ALLOC; intros A B. rewrite <- B; simpl. rewrite PMap.gso. auto. rewrite A. eauto with mem. - red; intros. eapply perm_alloc_1; eauto. + red; intros. eapply perm_alloc_1; eauto. rewrite pred_dec_false; auto. - red; intros; elim n0. red; intros. eapply perm_alloc_4; eauto. eauto with mem. + red; intros; elim n0. red; intros. eapply perm_alloc_4; eauto. eauto with mem. Qed. Theorem loadbytes_alloc_same: @@ -1848,9 +1848,9 @@ Theorem loadbytes_alloc_same: Proof. unfold loadbytes; intros. destruct (range_perm_dec m2 b ofs (ofs + n) Cur Readable); inv H. revert H0. - injection ALLOC; intros A B. rewrite <- A; rewrite <- B; simpl. rewrite PMap.gss. - generalize (nat_of_Z n) ofs. induction n0; simpl; intros. - contradiction. + injection ALLOC; intros A B. rewrite <- A; rewrite <- B; simpl. rewrite PMap.gss. + generalize (nat_of_Z n) ofs. induction n0; simpl; intros. + contradiction. rewrite ZMap.gi in H0. destruct H0; eauto. Qed. @@ -1919,7 +1919,7 @@ Theorem perm_free_1: Proof. intros. rewrite free_result. unfold perm, unchecked_free; simpl. rewrite PMap.gsspec. destruct (peq b bf). subst b. - destruct (zle lo ofs); simpl. + destruct (zle lo ofs); simpl. destruct (zlt ofs hi); simpl. elimtype False; intuition. auto. auto. @@ -1930,7 +1930,7 @@ Theorem perm_free_2: forall ofs k p, lo <= ofs < hi -> ~ perm m2 bf ofs k p. Proof. intros. rewrite free_result. unfold perm, unchecked_free; simpl. - rewrite PMap.gss. unfold proj_sumbool. rewrite zle_true. rewrite zlt_true. + rewrite PMap.gss. unfold proj_sumbool. rewrite zle_true. rewrite zlt_true. simpl. tauto. omega. omega. Qed. @@ -1940,9 +1940,9 @@ Theorem perm_free_3: Proof. intros until p. rewrite free_result. unfold perm, unchecked_free; simpl. rewrite PMap.gsspec. destruct (peq b bf). subst b. - destruct (zle lo ofs); simpl. - destruct (zlt ofs hi); simpl. tauto. - auto. auto. auto. + destruct (zle lo ofs); simpl. + destruct (zlt ofs hi); simpl. tauto. + auto. auto. auto. Qed. Theorem perm_free_inv: @@ -1958,13 +1958,13 @@ Qed. Theorem valid_access_free_1: forall chunk b ofs p, - valid_access m1 chunk b ofs p -> + valid_access m1 chunk b ofs p -> b <> bf \/ lo >= hi \/ ofs + size_chunk chunk <= lo \/ hi <= ofs -> valid_access m2 chunk b ofs p. Proof. intros. inv H. constructor; auto with mem. red; intros. eapply perm_free_1; eauto. - destruct (zlt lo hi). intuition. right. omega. + destruct (zlt lo hi). intuition. right. omega. Qed. Theorem valid_access_free_2: @@ -1972,13 +1972,13 @@ Theorem valid_access_free_2: lo < hi -> ofs + size_chunk chunk > lo -> ofs < hi -> ~(valid_access m2 chunk bf ofs p). Proof. - intros; red; intros. inv H2. + intros; red; intros. inv H2. generalize (size_chunk_pos chunk); intros. destruct (zlt ofs lo). elim (perm_free_2 lo Cur p). - omega. apply H3. omega. + omega. apply H3. omega. elim (perm_free_2 ofs Cur p). - omega. apply H3. omega. + omega. apply H3. omega. Qed. Theorem valid_access_free_inv_1: @@ -1986,13 +1986,13 @@ Theorem valid_access_free_inv_1: valid_access m2 chunk b ofs p -> valid_access m1 chunk b ofs p. Proof. - intros. destruct H. split; auto. - red; intros. generalize (H ofs0 H1). - rewrite free_result. unfold perm, unchecked_free; simpl. + intros. destruct H. split; auto. + red; intros. generalize (H ofs0 H1). + rewrite free_result. unfold perm, unchecked_free; simpl. rewrite PMap.gsspec. destruct (peq b bf). subst b. destruct (zle lo ofs0); simpl. destruct (zlt ofs0 hi); simpl. - tauto. auto. auto. auto. + tauto. auto. auto. auto. Qed. Theorem valid_access_free_inv_2: @@ -2001,7 +2001,7 @@ Theorem valid_access_free_inv_2: lo >= hi \/ ofs + size_chunk chunk <= lo \/ hi <= ofs. Proof. intros. - destruct (zlt lo hi); auto. + destruct (zlt lo hi); auto. destruct (zle (ofs + size_chunk chunk) lo); auto. destruct (zle hi ofs); auto. elim (valid_access_free_2 chunk ofs p); auto. omega. @@ -2014,19 +2014,19 @@ Theorem load_free: Proof. intros. unfold load. destruct (valid_access_dec m2 chunk b ofs Readable). - rewrite pred_dec_true. + rewrite pred_dec_true. rewrite free_result; auto. - eapply valid_access_free_inv_1; eauto. + eapply valid_access_free_inv_1; eauto. rewrite pred_dec_false; auto. - red; intro; elim n. eapply valid_access_free_1; eauto. + red; intro; elim n. eapply valid_access_free_1; eauto. Qed. Theorem load_free_2: forall chunk b ofs v, load chunk m2 b ofs = Some v -> load chunk m1 b ofs = Some v. Proof. - intros. unfold load. rewrite pred_dec_true. - rewrite (load_result _ _ _ _ _ H). rewrite free_result; auto. + intros. unfold load. rewrite pred_dec_true. + rewrite (load_result _ _ _ _ _ H). rewrite free_result; auto. apply valid_access_free_inv_1. eauto with mem. Qed. @@ -2035,14 +2035,14 @@ Theorem loadbytes_free: b <> bf \/ lo >= hi \/ ofs + n <= lo \/ hi <= ofs -> loadbytes m2 b ofs n = loadbytes m1 b ofs n. Proof. - intros. unfold loadbytes. + intros. unfold loadbytes. destruct (range_perm_dec m2 b ofs (ofs + n) Cur Readable). - rewrite pred_dec_true. - rewrite free_result; auto. - red; intros. eapply perm_free_3; eauto. - rewrite pred_dec_false; auto. - red; intros. elim n0; red; intros. - eapply perm_free_1; eauto. destruct H; auto. right; omega. + rewrite pred_dec_true. + rewrite free_result; auto. + red; intros. eapply perm_free_3; eauto. + rewrite pred_dec_false; auto. + red; intros. elim n0; red; intros. + eapply perm_free_1; eauto. destruct H; auto. right; omega. Qed. Theorem loadbytes_free_2: @@ -2052,13 +2052,13 @@ Proof. intros. unfold loadbytes in *. destruct (range_perm_dec m2 b ofs (ofs + n) Cur Readable); inv H. rewrite pred_dec_true. rewrite free_result; auto. - red; intros. apply perm_free_3; auto. + red; intros. apply perm_free_3; auto. Qed. End FREE. Local Hint Resolve valid_block_free_1 valid_block_free_2 - perm_free_1 perm_free_2 perm_free_3 + perm_free_1 perm_free_2 perm_free_3 valid_access_free_1 valid_access_free_inv_1: mem. (** ** Properties related to [drop_perm] *) @@ -2066,7 +2066,7 @@ Local Hint Resolve valid_block_free_1 valid_block_free_2 Theorem range_perm_drop_1: forall m b lo hi p m', drop_perm m b lo hi p = Some m' -> range_perm m b lo hi Cur Freeable. Proof. - unfold drop_perm; intros. + unfold drop_perm; intros. destruct (range_perm_dec m b lo hi Cur Freeable). auto. discriminate. Qed. @@ -2074,7 +2074,7 @@ Theorem range_perm_drop_2: forall m b lo hi p, range_perm m b lo hi Cur Freeable -> {m' | drop_perm m b lo hi p = Some m' }. Proof. - unfold drop_perm; intros. + unfold drop_perm; intros. destruct (range_perm_dec m b lo hi Cur Freeable). econstructor. eauto. contradiction. Defined. @@ -2110,19 +2110,19 @@ Theorem perm_drop_1: Proof. intros. unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. - unfold perm. simpl. rewrite PMap.gss. unfold proj_sumbool. + unfold perm. simpl. rewrite PMap.gss. unfold proj_sumbool. rewrite zle_true. rewrite zlt_true. simpl. constructor. - omega. omega. + omega. omega. Qed. - + Theorem perm_drop_2: forall ofs k p', lo <= ofs < hi -> perm m' b ofs k p' -> perm_order p p'. Proof. intros. unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. - revert H0. unfold perm; simpl. rewrite PMap.gss. unfold proj_sumbool. - rewrite zle_true. rewrite zlt_true. simpl. auto. - omega. omega. + revert H0. unfold perm; simpl. rewrite PMap.gss. unfold proj_sumbool. + rewrite zle_true. rewrite zlt_true. simpl. auto. + omega. omega. Qed. Theorem perm_drop_3: @@ -2130,8 +2130,8 @@ Theorem perm_drop_3: Proof. intros. unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. - unfold perm; simpl. rewrite PMap.gsspec. destruct (peq b' b). subst b'. - unfold proj_sumbool. destruct (zle lo ofs). destruct (zlt ofs hi). + unfold perm; simpl. rewrite PMap.gsspec. destruct (peq b' b). subst b'. + unfold proj_sumbool. destruct (zle lo ofs). destruct (zlt ofs hi). byContradiction. intuition omega. auto. auto. auto. Qed. @@ -2149,30 +2149,30 @@ Proof. Qed. Lemma valid_access_drop_1: - forall chunk b' ofs p', + forall chunk b' ofs p', b' <> b \/ ofs + size_chunk chunk <= lo \/ hi <= ofs \/ perm_order p p' -> valid_access m chunk b' ofs p' -> valid_access m' chunk b' ofs p'. Proof. - intros. destruct H0. split; auto. + intros. destruct H0. split; auto. red; intros. destruct (eq_block b' b). subst b'. - destruct (zlt ofs0 lo). eapply perm_drop_3; eauto. + destruct (zlt ofs0 lo). eapply perm_drop_3; eauto. destruct (zle hi ofs0). eapply perm_drop_3; eauto. - apply perm_implies with p. eapply perm_drop_1; eauto. omega. + apply perm_implies with p. eapply perm_drop_1; eauto. omega. generalize (size_chunk_pos chunk); intros. intuition. eapply perm_drop_3; eauto. Qed. Lemma valid_access_drop_2: - forall chunk b' ofs p', + forall chunk b' ofs p', valid_access m' chunk b' ofs p' -> valid_access m chunk b' ofs p'. Proof. - intros. destruct H; split; auto. - red; intros. eapply perm_drop_4; eauto. + intros. destruct H; split; auto. + red; intros. eapply perm_drop_4; eauto. Qed. Theorem load_drop: - forall chunk b' ofs, + forall chunk b' ofs, b' <> b \/ ofs + size_chunk chunk <= lo \/ hi <= ofs \/ perm_order p Readable -> load chunk m' b' ofs = load chunk m b' ofs. Proof. @@ -2181,13 +2181,13 @@ Proof. destruct (valid_access_dec m chunk b' ofs Readable). rewrite pred_dec_true. unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. simpl. auto. - eapply valid_access_drop_1; eauto. + eapply valid_access_drop_1; eauto. rewrite pred_dec_false. auto. red; intros; elim n. eapply valid_access_drop_2; eauto. Qed. Theorem loadbytes_drop: - forall b' ofs n, + forall b' ofs n, b' <> b \/ ofs + n <= lo \/ hi <= ofs \/ perm_order p Readable -> loadbytes m' b' ofs n = loadbytes m b' ofs n. Proof. @@ -2198,13 +2198,13 @@ Proof. unfold drop_perm in DROP. destruct (range_perm_dec m b lo hi Cur Freeable); inv DROP. simpl. auto. red; intros. destruct (eq_block b' b). subst b'. - destruct (zlt ofs0 lo). eapply perm_drop_3; eauto. + destruct (zlt ofs0 lo). eapply perm_drop_3; eauto. destruct (zle hi ofs0). eapply perm_drop_3; eauto. apply perm_implies with p. eapply perm_drop_1; eauto. omega. intuition. - eapply perm_drop_3; eauto. - rewrite pred_dec_false; eauto. - red; intros; elim n0; red; intros. - eapply perm_drop_4; eauto. + eapply perm_drop_3; eauto. + rewrite pred_dec_false; eauto. + red; intros; elim n0; red; intros. + eapply perm_drop_4; eauto. Qed. End DROP. @@ -2247,7 +2247,7 @@ Lemma perm_inj: f b1 = Some(b2, delta) -> perm m2 b2 (ofs + delta) k p. Proof. - intros. eapply mi_perm; eauto. + intros. eapply mi_perm; eauto. Qed. Lemma range_perm_inj: @@ -2284,18 +2284,18 @@ Lemma getN_inj: f b1 = Some(b2, delta) -> forall n ofs, range_perm m1 b1 ofs (ofs + Z_of_nat n) Cur Readable -> - list_forall2 (memval_inject f) + list_forall2 (memval_inject f) (getN n ofs (m1.(mem_contents)#b1)) (getN n (ofs + delta) (m2.(mem_contents)#b2)). Proof. induction n; intros; simpl. constructor. - rewrite inj_S in H1. - constructor. + rewrite inj_S in H1. + constructor. eapply mi_memval; eauto. - apply H1. omega. + apply H1. omega. replace (ofs + delta + 1) with ((ofs + 1) + delta) by omega. - apply IHn. red; intros; apply H1; omega. + apply IHn. red; intros; apply H1; omega. Qed. Lemma load_inj: @@ -2307,10 +2307,10 @@ Lemma load_inj: Proof. intros. exists (decode_val chunk (getN (size_chunk_nat chunk) (ofs + delta) (m2.(mem_contents)#b2))). - split. unfold load. apply pred_dec_true. + split. unfold load. apply pred_dec_true. eapply valid_access_inj; eauto with mem. - exploit load_result; eauto. intro. rewrite H2. - apply decode_val_inject. apply getN_inj; auto. + exploit load_result; eauto. intro. rewrite H2. + apply decode_val_inject. apply getN_inj; auto. rewrite <- size_chunk_conv. exploit load_valid_access; eauto. intros [A B]. auto. Qed. @@ -2322,14 +2322,14 @@ Lemma loadbytes_inj: exists bytes2, loadbytes m2 b2 (ofs + delta) len = Some bytes2 /\ list_forall2 (memval_inject f) bytes1 bytes2. Proof. - intros. unfold loadbytes in *. + intros. unfold loadbytes in *. destruct (range_perm_dec m1 b1 ofs (ofs + len) Cur Readable); inv H0. exists (getN (nat_of_Z len) (ofs + delta) (m2.(mem_contents)#b2)). - split. apply pred_dec_true. + split. apply pred_dec_true. replace (ofs + delta + len) with ((ofs + len) + delta) by omega. - eapply range_perm_inj; eauto with mem. - apply getN_inj; auto. - destruct (zle 0 len). rewrite nat_of_Z_eq; auto. omega. + eapply range_perm_inj; eauto with mem. + apply getN_inj; auto. + destruct (zle 0 len). rewrite nat_of_Z_eq; auto. omega. rewrite nat_of_Z_neg. simpl. red; intros; omegaContradiction. omega. Qed. @@ -2340,15 +2340,15 @@ Lemma setN_inj: list_forall2 (memval_inject f) vl1 vl2 -> forall p c1 c2, (forall q, access q -> memval_inject f (ZMap.get q c1) (ZMap.get (q + delta) c2)) -> - (forall q, access q -> memval_inject f (ZMap.get q (setN vl1 p c1)) + (forall q, access q -> memval_inject f (ZMap.get q (setN vl1 p c1)) (ZMap.get (q + delta) (setN vl2 (p + delta) c2))). Proof. - induction 1; intros; simpl. + induction 1; intros; simpl. auto. replace (p + delta + 1) with ((p + 1) + delta) by omega. - apply IHlist_forall2; auto. + apply IHlist_forall2; auto. intros. rewrite ZMap.gsspec at 1. destruct (ZIndexed.eq q0 p). subst q0. - rewrite ZMap.gss. auto. + rewrite ZMap.gss. auto. rewrite ZMap.gso. auto. unfold ZIndexed.t in *. omega. Qed. @@ -2375,13 +2375,13 @@ Proof. intros. assert (valid_access m2 chunk b2 (ofs + delta) Writable). eapply valid_access_inj; eauto with mem. - destruct (valid_access_store _ _ _ _ v2 H4) as [n2 STORE]. + destruct (valid_access_store _ _ _ _ v2 H4) as [n2 STORE]. exists n2; split. auto. constructor. (* perm *) intros. eapply perm_store_1; [eexact STORE|]. eapply mi_perm; eauto. - eapply perm_store_2; eauto. + eapply perm_store_2; eauto. (* align *) intros. eapply mi_align with (ofs := ofs0) (p := p); eauto. red; intros; eauto with mem. @@ -2389,25 +2389,25 @@ Proof. intros. rewrite (store_mem_contents _ _ _ _ _ _ H0). rewrite (store_mem_contents _ _ _ _ _ _ STORE). - rewrite ! PMap.gsspec. + rewrite ! PMap.gsspec. destruct (peq b0 b1). subst b0. (* block = b1, block = b2 *) assert (b3 = b2) by congruence. subst b3. assert (delta0 = delta) by congruence. subst delta0. rewrite peq_true. apply setN_inj with (access := fun ofs => perm m1 b1 ofs Cur Readable). - apply encode_val_inject; auto. intros. eapply mi_memval; eauto. eauto with mem. + apply encode_val_inject; auto. intros. eapply mi_memval; eauto. eauto with mem. destruct (peq b3 b2). subst b3. (* block <> b1, block = b2 *) - rewrite setN_other. eapply mi_memval; eauto. eauto with mem. - rewrite encode_val_length. rewrite <- size_chunk_conv. intros. + rewrite setN_other. eapply mi_memval; eauto. eauto with mem. + rewrite encode_val_length. rewrite <- size_chunk_conv. intros. assert (b2 <> b2 \/ ofs0 + delta0 <> (r - delta) + delta). eapply H1; eauto. eauto 6 with mem. exploit store_valid_access_3. eexact H0. intros [A B]. eapply perm_implies. apply perm_cur_max. apply A. omega. auto with mem. destruct H8. congruence. omega. (* block <> b1, block <> b2 *) - eapply mi_memval; eauto. eauto with mem. + eapply mi_memval; eauto. eauto with mem. Qed. Lemma store_unmapped_inj: @@ -2424,9 +2424,9 @@ Proof. intros. eapply mi_align with (ofs := ofs0) (p := p); eauto. red; intros; eauto with mem. (* mem_contents *) - intros. + intros. rewrite (store_mem_contents _ _ _ _ _ _ H0). - rewrite PMap.gso. eapply mi_memval; eauto with mem. + rewrite PMap.gso. eapply mi_memval; eauto with mem. congruence. Qed. @@ -2435,7 +2435,7 @@ Lemma store_outside_inj: mem_inj f m1 m2 -> (forall b' delta ofs', f b' = Some(b, delta) -> - perm m1 b' ofs' Cur Readable -> + perm m1 b' ofs' Cur Readable -> ofs <= ofs' + delta < ofs + size_chunk chunk -> False) -> store chunk m2 b ofs v = Some m2' -> mem_inj f m1 m2'. @@ -2446,14 +2446,14 @@ Proof. (* access *) intros; eapply mi_align0; eauto. (* mem_contents *) - intros. + intros. rewrite (store_mem_contents _ _ _ _ _ _ H1). - rewrite PMap.gsspec. destruct (peq b2 b). subst b2. - rewrite setN_outside. auto. - rewrite encode_val_length. rewrite <- size_chunk_conv. + rewrite PMap.gsspec. destruct (peq b2 b). subst b2. + rewrite setN_outside. auto. + rewrite encode_val_length. rewrite <- size_chunk_conv. destruct (zlt (ofs0 + delta) ofs); auto. - destruct (zle (ofs + size_chunk chunk) (ofs0 + delta)). omega. - byContradiction. eapply H0; eauto. omega. + destruct (zle (ofs + size_chunk chunk) (ofs0 + delta)). omega. + byContradiction. eapply H0; eauto. omega. eauto with mem. Qed. @@ -2468,14 +2468,14 @@ Lemma storebytes_mapped_inj: storebytes m2 b2 (ofs + delta) bytes2 = Some n2 /\ mem_inj f n1 n2. Proof. - intros. inversion H. + intros. inversion H. assert (range_perm m2 b2 (ofs + delta) (ofs + delta + Z_of_nat (length bytes2)) Cur Writable). replace (ofs + delta + Z_of_nat (length bytes2)) with ((ofs + Z_of_nat (length bytes1)) + delta). - eapply range_perm_inj; eauto with mem. + eapply range_perm_inj; eauto with mem. eapply storebytes_range_perm; eauto. rewrite (list_forall2_length H3). omega. - destruct (range_perm_storebytes _ _ _ _ H4) as [n2 STORE]. + destruct (range_perm_storebytes _ _ _ _ H4) as [n2 STORE]. exists n2; split. eauto. constructor. (* perm *) @@ -2485,10 +2485,10 @@ Proof. eapply perm_storebytes_2; eauto. (* align *) intros. eapply mi_align with (ofs := ofs0) (p := p); eauto. - red; intros. eapply perm_storebytes_2; eauto. + red; intros. eapply perm_storebytes_2; eauto. (* mem_contents *) intros. - assert (perm m1 b0 ofs0 Cur Readable). eapply perm_storebytes_2; eauto. + assert (perm m1 b0 ofs0 Cur Readable). eapply perm_storebytes_2; eauto. rewrite (storebytes_mem_contents _ _ _ _ _ H0). rewrite (storebytes_mem_contents _ _ _ _ _ STORE). rewrite ! PMap.gsspec. destruct (peq b0 b1). subst b0. @@ -2503,8 +2503,8 @@ Proof. intros. assert (b2 <> b2 \/ ofs0 + delta0 <> (r - delta) + delta). eapply H1; eauto 6 with mem. - exploit storebytes_range_perm. eexact H0. - instantiate (1 := r - delta). + exploit storebytes_range_perm. eexact H0. + instantiate (1 := r - delta). rewrite (list_forall2_length H3). omega. eauto 6 with mem. destruct H9. congruence. omega. @@ -2522,12 +2522,12 @@ Proof. intros. inversion H. constructor. (* perm *) - intros. eapply mi_perm0; eauto. eapply perm_storebytes_2; eauto. + intros. eapply mi_perm0; eauto. eapply perm_storebytes_2; eauto. (* align *) intros. eapply mi_align with (ofs := ofs0) (p := p); eauto. - red; intros. eapply perm_storebytes_2; eauto. + red; intros. eapply perm_storebytes_2; eauto. (* mem_contents *) - intros. + intros. rewrite (storebytes_mem_contents _ _ _ _ _ H0). rewrite PMap.gso. eapply mi_memval0; eauto. eapply perm_storebytes_2; eauto. congruence. @@ -2538,7 +2538,7 @@ Lemma storebytes_outside_inj: mem_inj f m1 m2 -> (forall b' delta ofs', f b' = Some(b, delta) -> - perm m1 b' ofs' Cur Readable -> + perm m1 b' ofs' Cur Readable -> ofs <= ofs' + delta < ofs + Z_of_nat (length bytes2) -> False) -> storebytes m2 b ofs bytes2 = Some m2' -> mem_inj f m1 m2'. @@ -2549,13 +2549,13 @@ Proof. (* align *) eauto. (* mem_contents *) - intros. + intros. rewrite (storebytes_mem_contents _ _ _ _ _ H1). rewrite PMap.gsspec. destruct (peq b2 b). subst b2. - rewrite setN_outside. auto. + rewrite setN_outside. auto. destruct (zlt (ofs0 + delta) ofs); auto. - destruct (zle (ofs + Z_of_nat (length bytes2)) (ofs0 + delta)). omega. - byContradiction. eapply H0; eauto. omega. + destruct (zle (ofs + Z_of_nat (length bytes2)) (ofs0 + delta)). omega. + byContradiction. eapply H0; eauto. omega. eauto with mem. Qed. @@ -2566,21 +2566,21 @@ Lemma storebytes_empty_inj: storebytes m2 b2 ofs2 nil = Some m2' -> mem_inj f m1' m2'. Proof. - intros. destruct H. constructor. + intros. destruct H. constructor. (* perm *) intros. - eapply perm_storebytes_1; eauto. + eapply perm_storebytes_1; eauto. eapply mi_perm0; eauto. eapply perm_storebytes_2; eauto. (* align *) intros. eapply mi_align0 with (ofs := ofs) (p := p); eauto. - red; intros. eapply perm_storebytes_2; eauto. + red; intros. eapply perm_storebytes_2; eauto. (* mem_contents *) intros. - assert (perm m1 b0 ofs Cur Readable). eapply perm_storebytes_2; eauto. + assert (perm m1 b0 ofs Cur Readable). eapply perm_storebytes_2; eauto. rewrite (storebytes_mem_contents _ _ _ _ _ H0). rewrite (storebytes_mem_contents _ _ _ _ _ H1). - simpl. rewrite ! PMap.gsspec. + simpl. rewrite ! PMap.gsspec. destruct (peq b0 b1); destruct (peq b3 b2); subst; eapply mi_memval0; eauto. Qed. @@ -2595,16 +2595,16 @@ Proof. intros. injection H0. intros NEXT MEM. inversion H. constructor. (* perm *) - intros. eapply perm_alloc_1; eauto. + intros. eapply perm_alloc_1; eauto. (* align *) eauto. (* mem_contents *) intros. - assert (perm m2 b0 (ofs + delta) Cur Readable). + assert (perm m2 b0 (ofs + delta) Cur Readable). eapply mi_perm0; eauto. assert (valid_block m2 b0) by eauto with mem. rewrite <- MEM; simpl. rewrite PMap.gso. eauto with mem. - rewrite NEXT. eauto with mem. + rewrite NEXT. eauto with mem. Qed. Lemma alloc_left_unmapped_inj: @@ -2616,18 +2616,18 @@ Lemma alloc_left_unmapped_inj: Proof. intros. inversion H. constructor. (* perm *) - intros. exploit perm_alloc_inv; eauto. intros. - destruct (eq_block b0 b1). congruence. eauto. + intros. exploit perm_alloc_inv; eauto. intros. + destruct (eq_block b0 b1). congruence. eauto. (* align *) intros. eapply mi_align0 with (ofs := ofs) (p := p); eauto. red; intros. exploit perm_alloc_inv; eauto. - destruct (eq_block b0 b1); auto. congruence. + destruct (eq_block b0 b1); auto. congruence. (* mem_contents *) - injection H0; intros NEXT MEM. intros. + injection H0; intros NEXT MEM. intros. rewrite <- MEM; simpl. rewrite NEXT. exploit perm_alloc_inv; eauto. intros. rewrite PMap.gsspec. unfold eq_block in H4. destruct (peq b0 b1). - rewrite ZMap.gi. constructor. eauto. + rewrite ZMap.gi. constructor. eauto. Qed. Definition inj_offset_aligned (delta: Z) (size: Z) : Prop := @@ -2645,9 +2645,9 @@ Lemma alloc_left_mapped_inj: Proof. intros. inversion H. constructor. (* perm *) - intros. + intros. exploit perm_alloc_inv; eauto. intros. destruct (eq_block b0 b1). subst b0. - rewrite H4 in H5; inv H5. eauto. eauto. + rewrite H4 in H5; inv H5. eauto. eauto. (* align *) intros. destruct (eq_block b0 b1). subst b0. assert (delta0 = delta) by congruence. subst delta0. @@ -2655,14 +2655,14 @@ Proof. { eapply perm_alloc_3; eauto. apply H6. generalize (size_chunk_pos chunk); omega. } assert (lo <= ofs + size_chunk chunk - 1 < hi). { eapply perm_alloc_3; eauto. apply H6. generalize (size_chunk_pos chunk); omega. } - apply H2. omega. + apply H2. omega. eapply mi_align0 with (ofs := ofs) (p := p); eauto. - red; intros. eapply perm_alloc_4; eauto. + red; intros. eapply perm_alloc_4; eauto. (* mem_contents *) - injection H0; intros NEXT MEM. + injection H0; intros NEXT MEM. intros. rewrite <- MEM; simpl. rewrite NEXT. exploit perm_alloc_inv; eauto. intros. - rewrite PMap.gsspec. unfold eq_block in H7. + rewrite PMap.gsspec. unfold eq_block in H7. destruct (peq b0 b1). rewrite ZMap.gi. constructor. eauto. Qed. @@ -2696,10 +2696,10 @@ Proof. forall b1 b2 delta ofs k p, f b1 = Some (b2, delta) -> perm m1 b1 ofs k p -> perm m2' b2 (ofs + delta) k p). - intros. - intros. eapply perm_free_1; eauto. - destruct (eq_block b2 b); auto. subst b. right. - assert (~ (lo <= ofs + delta < hi)). red; intros; eapply H1; eauto. + intros. + intros. eapply perm_free_1; eauto. + destruct (eq_block b2 b); auto. subst b. right. + assert (~ (lo <= ofs + delta < hi)). red; intros; eapply H1; eauto. omega. constructor. (* perm *) @@ -2707,7 +2707,7 @@ Proof. (* align *) eapply mi_align0; eauto. (* mem_contents *) - intros. rewrite FREE; simpl. eauto. + intros. rewrite FREE; simpl. eauto. Qed. (** Preservation of [drop_perm] operations. *) @@ -2719,16 +2719,16 @@ Lemma drop_unmapped_inj: f b = None -> mem_inj f m1' m2. Proof. - intros. inv H. constructor. + intros. inv H. constructor. (* perm *) - intros. eapply mi_perm0; eauto. eapply perm_drop_4; eauto. + intros. eapply mi_perm0; eauto. eapply perm_drop_4; eauto. (* align *) intros. eapply mi_align0 with (ofs := ofs) (p := p0); eauto. red; intros; eapply perm_drop_4; eauto. (* contents *) intros. replace (ZMap.get ofs m1'.(mem_contents)#b1) with (ZMap.get ofs m1.(mem_contents)#b1). - apply mi_memval0; auto. eapply perm_drop_4; eauto. + apply mi_memval0; auto. eapply perm_drop_4; eauto. unfold drop_perm in H0; destruct (range_perm_dec m1 b lo hi Cur Freeable); inv H0; auto. Qed. @@ -2742,26 +2742,26 @@ Lemma drop_mapped_inj: drop_perm m2 b2 (lo + delta) (hi + delta) p = Some m2' /\ mem_inj f m1' m2'. Proof. - intros. + intros. assert ({ m2' | drop_perm m2 b2 (lo + delta) (hi + delta) p = Some m2' }). - apply range_perm_drop_2. red; intros. + apply range_perm_drop_2. red; intros. replace ofs with ((ofs - delta) + delta) by omega. - eapply perm_inj; eauto. eapply range_perm_drop_1; eauto. omega. + eapply perm_inj; eauto. eapply range_perm_drop_1; eauto. omega. destruct X as [m2' DROP]. exists m2'; split; auto. inv H. constructor. (* perm *) - intros. + intros. assert (perm m2 b3 (ofs + delta0) k p0). - eapply mi_perm0; eauto. eapply perm_drop_4; eauto. + eapply mi_perm0; eauto. eapply perm_drop_4; eauto. destruct (eq_block b1 b0). (* b1 = b0 *) subst b0. rewrite H2 in H; inv H. destruct (zlt (ofs + delta0) (lo + delta0)). eapply perm_drop_3; eauto. destruct (zle (hi + delta0) (ofs + delta0)). eapply perm_drop_3; eauto. assert (perm_order p p0). - eapply perm_drop_2. eexact H0. instantiate (1 := ofs). omega. eauto. - apply perm_implies with p; auto. + eapply perm_drop_2. eexact H0. instantiate (1 := ofs). omega. eauto. + apply perm_implies with p; auto. eapply perm_drop_1. eauto. omega. (* b1 <> b0 *) eapply perm_drop_3; eauto. @@ -2769,10 +2769,10 @@ Proof. destruct (zlt (ofs + delta0) (lo + delta)); auto. destruct (zle (hi + delta) (ofs + delta0)); auto. exploit H1; eauto. - instantiate (1 := ofs + delta0 - delta). + instantiate (1 := ofs + delta0 - delta). apply perm_cur_max. apply perm_implies with Freeable. - eapply range_perm_drop_1; eauto. omega. auto with mem. - eapply perm_drop_4; eauto. eapply perm_max. apply perm_implies with p0. eauto. + eapply range_perm_drop_1; eauto. omega. auto with mem. + eapply perm_drop_4; eauto. eapply perm_max. apply perm_implies with p0. eauto. eauto with mem. intuition. (* align *) @@ -2782,31 +2782,31 @@ Proof. intros. replace (m1'.(mem_contents)#b0) with (m1.(mem_contents)#b0). replace (m2'.(mem_contents)#b3) with (m2.(mem_contents)#b3). - apply mi_memval0; auto. eapply perm_drop_4; eauto. + apply mi_memval0; auto. eapply perm_drop_4; eauto. unfold drop_perm in DROP; destruct (range_perm_dec m2 b2 (lo + delta) (hi + delta) Cur Freeable); inv DROP; auto. unfold drop_perm in H0; destruct (range_perm_dec m1 b1 lo hi Cur Freeable); inv H0; auto. Qed. Lemma drop_outside_inj: forall f m1 m2 b lo hi p m2', - mem_inj f m1 m2 -> - drop_perm m2 b lo hi p = Some m2' -> + mem_inj f m1 m2 -> + drop_perm m2 b lo hi p = Some m2' -> (forall b' delta ofs' k p, f b' = Some(b, delta) -> - perm m1 b' ofs' k p -> + perm m1 b' ofs' k p -> lo <= ofs' + delta < hi -> False) -> mem_inj f m1 m2'. Proof. intros. inv H. constructor. (* perm *) - intros. eapply perm_drop_3; eauto. - destruct (eq_block b2 b); auto. subst b2. right. + intros. eapply perm_drop_3; eauto. + destruct (eq_block b2 b); auto. subst b2. right. destruct (zlt (ofs + delta) lo); auto. destruct (zle hi (ofs + delta)); auto. byContradiction. exploit H1; eauto. omega. (* align *) eapply mi_align0; eauto. (* contents *) - intros. + intros. replace (m2'.(mem_contents)#b2) with (m2.(mem_contents)#b2). apply mi_memval0; auto. unfold drop_perm in H0; destruct (range_perm_dec m2 b lo hi Cur Freeable); inv H0; auto. @@ -2833,8 +2833,8 @@ Theorem extends_refl: Proof. intros. constructor. auto. constructor. intros. unfold inject_id in H; inv H. replace (ofs + 0) with ofs by omega. auto. - intros. unfold inject_id in H; inv H. apply Z.divide_0_r. - intros. unfold inject_id in H; inv H. replace (ofs + 0) with ofs by omega. + intros. unfold inject_id in H; inv H. apply Z.divide_0_r. + intros. unfold inject_id in H; inv H. replace (ofs + 0) with ofs by omega. apply memval_lessdef_refl. Qed. @@ -2844,7 +2844,7 @@ Theorem load_extends: load chunk m1 b ofs = Some v1 -> exists v2, load chunk m2 b ofs = Some v2 /\ Val.lessdef v1 v2. Proof. - intros. inv H. exploit load_inj; eauto. unfold inject_id; reflexivity. + intros. inv H. exploit load_inj; eauto. unfold inject_id; reflexivity. intros [v2 [A B]]. exists v2; split. replace (ofs + 0) with ofs in A by omega. auto. rewrite val_inject_id in B. auto. @@ -2857,8 +2857,8 @@ Theorem loadv_extends: Val.lessdef addr1 addr2 -> exists v2, loadv chunk m2 addr2 = Some v2 /\ Val.lessdef v1 v2. Proof. - unfold loadv; intros. inv H1. - destruct addr2; try congruence. eapply load_extends; eauto. + unfold loadv; intros. inv H1. + destruct addr2; try congruence. eapply load_extends; eauto. congruence. Qed. @@ -2870,7 +2870,7 @@ Theorem loadbytes_extends: /\ list_forall2 memval_lessdef bytes1 bytes2. Proof. intros. inv H. - replace ofs with (ofs + 0) by omega. eapply loadbytes_inj; eauto. + replace ofs with (ofs + 0) by omega. eapply loadbytes_inj; eauto. Qed. Theorem store_within_extends: @@ -2883,7 +2883,7 @@ Theorem store_within_extends: /\ extends m1' m2'. Proof. intros. inversion H. - exploit store_mapped_inj; eauto. + exploit store_mapped_inj; eauto. unfold inject_id; red; intros. inv H3; inv H4. auto. unfold inject_id; reflexivity. rewrite val_inject_id. eauto. @@ -2906,7 +2906,7 @@ Proof. intros. inversion H. constructor. rewrite (nextblock_store _ _ _ _ _ _ H0). auto. eapply store_outside_inj; eauto. - unfold inject_id; intros. inv H2. eapply H1; eauto. omega. + unfold inject_id; intros. inv H2. eapply H1; eauto. omega. Qed. Theorem storev_extends: @@ -2919,8 +2919,8 @@ Theorem storev_extends: storev chunk m2 addr2 v2 = Some m2' /\ extends m1' m2'. Proof. - unfold storev; intros. inv H1. - destruct addr2; try congruence. eapply store_within_extends; eauto. + unfold storev; intros. inv H1. + destruct addr2; try congruence. eapply store_within_extends; eauto. congruence. Qed. @@ -2934,7 +2934,7 @@ Theorem storebytes_within_extends: /\ extends m1' m2'. Proof. intros. inversion H. - exploit storebytes_mapped_inj; eauto. + exploit storebytes_mapped_inj; eauto. unfold inject_id; red; intros. inv H3; inv H4. auto. unfold inject_id; reflexivity. intros [m2' [A B]]. @@ -2956,7 +2956,7 @@ Proof. intros. inversion H. constructor. rewrite (nextblock_storebytes _ _ _ _ _ H0). auto. eapply storebytes_outside_inj; eauto. - unfold inject_id; intros. inv H2. eapply H1; eauto. omega. + unfold inject_id; intros. inv H2. eapply H1; eauto. omega. Qed. Theorem alloc_extends: @@ -2968,17 +2968,17 @@ Theorem alloc_extends: alloc m2 lo2 hi2 = (m2', b) /\ extends m1' m2'. Proof. - intros. inv H. - case_eq (alloc m2 lo2 hi2); intros m2' b' ALLOC. + intros. inv H. + case_eq (alloc m2 lo2 hi2); intros m2' b' ALLOC. assert (b' = b). - rewrite (alloc_result _ _ _ _ _ H0). + rewrite (alloc_result _ _ _ _ _ H0). rewrite (alloc_result _ _ _ _ _ ALLOC). auto. subst b'. exists m2'; split; auto. - constructor. + constructor. rewrite (nextblock_alloc _ _ _ _ _ H0). - rewrite (nextblock_alloc _ _ _ _ _ ALLOC). + rewrite (nextblock_alloc _ _ _ _ _ ALLOC). congruence. eapply alloc_left_mapped_inj with (m1 := m1) (m2 := m2') (b2 := b) (delta := 0); eauto. eapply alloc_right_inj; eauto. @@ -3012,7 +3012,7 @@ Proof. rewrite (nextblock_free _ _ _ _ _ H0). auto. eapply free_right_inj; eauto. unfold inject_id; intros. inv H. eapply H1; eauto. omega. -Qed. +Qed. Theorem free_parallel_extends: forall m1 m2 b lo hi m1', @@ -3022,9 +3022,9 @@ Theorem free_parallel_extends: free m2 b lo hi = Some m2' /\ extends m1' m2'. Proof. - intros. inversion H. + intros. inversion H. assert ({ m2': mem | free m2 b lo hi = Some m2' }). - apply range_perm_free. red; intros. + apply range_perm_free. red; intros. replace ofs with (ofs + 0) by omega. eapply perm_inj with (b1 := b); eauto. eapply free_range_perm; eauto. @@ -3032,10 +3032,10 @@ Proof. inv H. constructor. rewrite (nextblock_free _ _ _ _ _ H0). rewrite (nextblock_free _ _ _ _ _ FREE). auto. - eapply free_right_inj with (m1 := m1'); eauto. - eapply free_left_inj; eauto. + eapply free_right_inj with (m1 := m1'); eauto. + eapply free_left_inj; eauto. unfold inject_id; intros. inv H. - eapply perm_free_2. eexact H0. instantiate (1 := ofs); omega. eauto. + eapply perm_free_2. eexact H0. instantiate (1 := ofs); omega. eauto. Qed. Theorem valid_block_extends: @@ -3043,31 +3043,31 @@ Theorem valid_block_extends: extends m1 m2 -> (valid_block m1 b <-> valid_block m2 b). Proof. - intros. inv H. unfold valid_block. rewrite mext_next0. tauto. + intros. inv H. unfold valid_block. rewrite mext_next0. tauto. Qed. Theorem perm_extends: forall m1 m2 b ofs k p, extends m1 m2 -> perm m1 b ofs k p -> perm m2 b ofs k p. Proof. - intros. inv H. replace ofs with (ofs + 0) by omega. - eapply perm_inj; eauto. + intros. inv H. replace ofs with (ofs + 0) by omega. + eapply perm_inj; eauto. Qed. Theorem valid_access_extends: forall m1 m2 chunk b ofs p, extends m1 m2 -> valid_access m1 chunk b ofs p -> valid_access m2 chunk b ofs p. Proof. - intros. inv H. replace ofs with (ofs + 0) by omega. - eapply valid_access_inj; eauto. auto. + intros. inv H. replace ofs with (ofs + 0) by omega. + eapply valid_access_inj; eauto. auto. Qed. Theorem valid_pointer_extends: forall m1 m2 b ofs, extends m1 m2 -> valid_pointer m1 b ofs = true -> valid_pointer m2 b ofs = true. Proof. - intros. - rewrite valid_pointer_valid_access in *. + intros. + rewrite valid_pointer_valid_access in *. eapply valid_access_extends; eauto. Qed. @@ -3124,7 +3124,7 @@ Theorem valid_block_inject_1: inject f m1 m2 -> valid_block m1 b1. Proof. - intros. inv H. destruct (plt b1 (nextblock m1)). auto. + intros. inv H. destruct (plt b1 (nextblock m1)). auto. assert (f b1 = None). eapply mi_freeblocks; eauto. congruence. Qed. @@ -3134,7 +3134,7 @@ Theorem valid_block_inject_2: inject f m1 m2 -> valid_block m2 b2. Proof. - intros. eapply mi_mappedblocks; eauto. + intros. eapply mi_mappedblocks; eauto. Qed. Local Hint Resolve valid_block_inject_1 valid_block_inject_2: mem. @@ -3145,7 +3145,7 @@ Theorem perm_inject: inject f m1 m2 -> perm m1 b1 ofs k p -> perm m2 b2 (ofs + delta) k p. Proof. - intros. inv H0. eapply perm_inj; eauto. + intros. inv H0. eapply perm_inj; eauto. Qed. Theorem range_perm_inject: @@ -3164,7 +3164,7 @@ Theorem valid_access_inject: valid_access m1 chunk b1 ofs p -> valid_access m2 chunk b2 (ofs + delta) p. Proof. - intros. eapply valid_access_inj; eauto. apply mi_inj; auto. + intros. eapply valid_access_inj; eauto. apply mi_inj; auto. Qed. Theorem valid_pointer_inject: @@ -3174,7 +3174,7 @@ Theorem valid_pointer_inject: valid_pointer m1 b1 ofs = true -> valid_pointer m2 b2 (ofs + delta) = true. Proof. - intros. + intros. rewrite valid_pointer_valid_access in H1. rewrite valid_pointer_valid_access. eapply valid_access_inject; eauto. @@ -3217,8 +3217,8 @@ Lemma address_inject': f b1 = Some (b2, delta) -> Int.unsigned (Int.add ofs1 (Int.repr delta)) = Int.unsigned ofs1 + delta. Proof. - intros. destruct H0. eapply address_inject; eauto. - apply H0. generalize (size_chunk_pos chunk). omega. + intros. destruct H0. eapply address_inject; eauto. + apply H0. generalize (size_chunk_pos chunk). omega. Qed. Theorem weak_valid_pointer_inject_no_overflow: @@ -3228,7 +3228,7 @@ Theorem weak_valid_pointer_inject_no_overflow: f b = Some(b', delta) -> 0 <= Int.unsigned ofs + Int.unsigned (Int.repr delta) <= Int.max_unsigned. Proof. - intros. rewrite weak_valid_pointer_spec in H0. + intros. rewrite weak_valid_pointer_spec in H0. rewrite ! valid_pointer_nonempty_perm in H0. exploit mi_representable; eauto. destruct H0; eauto with mem. intros [A B]. @@ -3254,7 +3254,7 @@ Theorem valid_pointer_inject_val: valid_pointer m2 b' (Int.unsigned ofs') = true. Proof. intros. inv H1. - erewrite address_inject'; eauto. + erewrite address_inject'; eauto. eapply valid_pointer_inject; eauto. rewrite valid_pointer_valid_access in H0. eauto. Qed. @@ -3268,9 +3268,9 @@ Theorem weak_valid_pointer_inject_val: Proof. intros. inv H1. exploit weak_valid_pointer_inject; eauto. intros W. - rewrite weak_valid_pointer_spec in H0. + rewrite weak_valid_pointer_spec in H0. rewrite ! valid_pointer_nonempty_perm in H0. - exploit mi_representable; eauto. destruct H0; eauto with mem. + exploit mi_representable; eauto. destruct H0; eauto with mem. intros [A B]. pose proof (Int.unsigned_range ofs). unfold Int.add. repeat rewrite Int.unsigned_repr; auto; omega. @@ -3301,11 +3301,11 @@ Theorem different_pointers_inject: Int.unsigned (Int.add ofs1 (Int.repr delta1)) <> Int.unsigned (Int.add ofs2 (Int.repr delta2)). Proof. - intros. - rewrite valid_pointer_valid_access in H1. - rewrite valid_pointer_valid_access in H2. - rewrite (address_inject' _ _ _ _ _ _ _ _ H H1 H3). - rewrite (address_inject' _ _ _ _ _ _ _ _ H H2 H4). + intros. + rewrite valid_pointer_valid_access in H1. + rewrite valid_pointer_valid_access in H2. + rewrite (address_inject' _ _ _ _ _ _ _ _ H H1 H3). + rewrite (address_inject' _ _ _ _ _ _ _ _ H H2 H4). inv H1. simpl in H5. inv H2. simpl in H1. eapply mi_no_overlap; eauto. apply perm_cur_max. apply (H5 (Int.unsigned ofs1)). omega. @@ -3324,23 +3324,23 @@ Theorem disjoint_or_equal_inject: sz > 0 -> b1 <> b2 \/ ofs1 = ofs2 \/ ofs1 + sz <= ofs2 \/ ofs2 + sz <= ofs1 -> b1' <> b2' \/ ofs1 + delta1 = ofs2 + delta2 - \/ ofs1 + delta1 + sz <= ofs2 + delta2 + \/ ofs1 + delta1 + sz <= ofs2 + delta2 \/ ofs2 + delta2 + sz <= ofs1 + delta1. Proof. - intros. + intros. destruct (eq_block b1 b2). assert (b1' = b2') by congruence. assert (delta1 = delta2) by congruence. subst. destruct H5. congruence. right. destruct H5. left; congruence. right. omega. - destruct (eq_block b1' b2'); auto. subst. right. right. + destruct (eq_block b1' b2'); auto. subst. right. right. set (i1 := (ofs1 + delta1, ofs1 + delta1 + sz)). set (i2 := (ofs2 + delta2, ofs2 + delta2 + sz)). change (snd i1 <= fst i2 \/ snd i2 <= fst i1). apply Intv.range_disjoint'; simpl; try omega. - unfold Intv.disjoint, Intv.In; simpl; intros. red; intros. - exploit mi_no_overlap; eauto. + unfold Intv.disjoint, Intv.In; simpl; intros. red; intros. + exploit mi_no_overlap; eauto. instantiate (1 := x - delta1). apply H2. omega. instantiate (1 := x - delta2). apply H3. omega. - intuition. + intuition. Qed. Theorem aligned_area_inject: @@ -3353,7 +3353,7 @@ Theorem aligned_area_inject: f b = Some(b', delta) -> (al | ofs + delta). Proof. - intros. + intros. assert (P: al > 0) by omega. assert (Q: Zabs al <= Zabs sz). apply Zdivide_bounds; auto. omega. rewrite Zabs_eq in Q; try omega. rewrite Zabs_eq in Q; try omega. @@ -3365,7 +3365,7 @@ Proof. destruct R as [chunk [A B]]. assert (valid_access m chunk b ofs Nonempty). split. red; intros; apply H3. omega. congruence. - exploit valid_access_inject; eauto. intros [C D]. + exploit valid_access_inject; eauto. intros [C D]. congruence. Qed. @@ -3378,7 +3378,7 @@ Theorem load_inject: f b1 = Some (b2, delta) -> exists v2, load chunk m2 b2 (ofs + delta) = Some v2 /\ Val.inject f v1 v2. Proof. - intros. inv H. eapply load_inj; eauto. + intros. inv H. eapply load_inj; eauto. Qed. Theorem loadv_inject: @@ -3390,7 +3390,7 @@ Theorem loadv_inject: Proof. intros. inv H1; simpl in H0; try discriminate. exploit load_inject; eauto. intros [v2 [LOAD INJ]]. - exists v2; split; auto. unfold loadv. + exists v2; split; auto. unfold loadv. replace (Int.unsigned (Int.add ofs1 (Int.repr delta))) with (Int.unsigned ofs1 + delta). auto. symmetry. eapply address_inject'; eauto with mem. @@ -3404,7 +3404,7 @@ Theorem loadbytes_inject: exists bytes2, loadbytes m2 b2 (ofs + delta) len = Some bytes2 /\ list_forall2 (memval_inject f) bytes1 bytes2. Proof. - intros. inv H. eapply loadbytes_inj; eauto. + intros. inv H. eapply loadbytes_inj; eauto. Qed. (** Preservation of stores *) @@ -3425,7 +3425,7 @@ Proof. (* inj *) auto. (* freeblocks *) - eauto with mem. + eauto with mem. (* mappedblocks *) eauto with mem. (* no overlap *) @@ -3447,7 +3447,7 @@ Proof. (* inj *) eapply store_unmapped_inj; eauto. (* freeblocks *) - eauto with mem. + eauto with mem. (* mappedblocks *) eauto with mem. (* no overlap *) @@ -3515,12 +3515,12 @@ Proof. (* freeblocks *) intros. apply mi_freeblocks0. red; intros; elim H3; eapply storebytes_valid_block_1; eauto. (* mappedblocks *) - intros. eapply storebytes_valid_block_1; eauto. + intros. eapply storebytes_valid_block_1; eauto. (* no overlap *) - red; intros. eapply mi_no_overlap0; eauto; eapply perm_storebytes_2; eauto. + red; intros. eapply mi_no_overlap0; eauto; eapply perm_storebytes_2; eauto. (* representable *) intros. eapply mi_representable0; eauto. - destruct H4; eauto using perm_storebytes_2. + destruct H4; eauto using perm_storebytes_2. Qed. Theorem storebytes_unmapped_inject: @@ -3539,7 +3539,7 @@ Proof. (* mappedblocks *) eauto with mem. (* no overlap *) - red; intros. eapply mi_no_overlap0; eauto; eapply perm_storebytes_2; eauto. + red; intros. eapply mi_no_overlap0; eauto; eapply perm_storebytes_2; eauto. (* representable *) intros. eapply mi_representable0; eauto. destruct H3; eauto using perm_storebytes_2. @@ -3561,7 +3561,7 @@ Proof. (* freeblocks *) auto. (* mappedblocks *) - intros. eapply storebytes_valid_block_1; eauto. + intros. eapply storebytes_valid_block_1; eauto. (* no overlap *) auto. (* representable *) @@ -3581,12 +3581,12 @@ Proof. (* freeblocks *) intros. apply mi_freeblocks0. red; intros; elim H2; eapply storebytes_valid_block_1; eauto. (* mappedblocks *) - intros. eapply storebytes_valid_block_1; eauto. + intros. eapply storebytes_valid_block_1; eauto. (* no overlap *) - red; intros. eapply mi_no_overlap0; eauto; eapply perm_storebytes_2; eauto. + red; intros. eapply mi_no_overlap0; eauto; eapply perm_storebytes_2; eauto. (* representable *) intros. eapply mi_representable0; eauto. - destruct H3; eauto using perm_storebytes_2. + destruct H3; eauto using perm_storebytes_2. Qed. (* Preservation of allocations *) @@ -3631,31 +3631,31 @@ Proof. inversion mi_inj0; constructor; eauto with mem. unfold f'; intros. destruct (eq_block b0 b1). congruence. eauto. unfold f'; intros. destruct (eq_block b0 b1). congruence. eauto. - unfold f'; intros. destruct (eq_block b0 b1). congruence. - apply memval_inject_incr with f; auto. + unfold f'; intros. destruct (eq_block b0 b1). congruence. + apply memval_inject_incr with f; auto. exists f'; split. constructor. (* inj *) - eapply alloc_left_unmapped_inj; eauto. unfold f'; apply dec_eq_true. + eapply alloc_left_unmapped_inj; eauto. unfold f'; apply dec_eq_true. (* freeblocks *) - intros. unfold f'. destruct (eq_block b b1). auto. - apply mi_freeblocks0. red; intro; elim H3. eauto with mem. + intros. unfold f'. destruct (eq_block b b1). auto. + apply mi_freeblocks0. red; intro; elim H3. eauto with mem. (* mappedblocks *) - unfold f'; intros. destruct (eq_block b b1). congruence. eauto. + unfold f'; intros. destruct (eq_block b b1). congruence. eauto. (* no overlap *) unfold f'; red; intros. destruct (eq_block b0 b1); destruct (eq_block b2 b1); try congruence. eapply mi_no_overlap0. eexact H3. eauto. eauto. - exploit perm_alloc_inv. eauto. eexact H6. rewrite dec_eq_false; auto. - exploit perm_alloc_inv. eauto. eexact H7. rewrite dec_eq_false; auto. + exploit perm_alloc_inv. eauto. eexact H6. rewrite dec_eq_false; auto. + exploit perm_alloc_inv. eauto. eexact H7. rewrite dec_eq_false; auto. (* representable *) unfold f'; intros. destruct (eq_block b b1); try discriminate. eapply mi_representable0; try eassumption. destruct H4; eauto using perm_alloc_4. (* incr *) - split. auto. + split. auto. (* image *) - split. unfold f'; apply dec_eq_true. + split. unfold f'; apply dec_eq_true. (* incr *) intros; unfold f'; apply dec_eq_false; auto. Qed. @@ -3670,7 +3670,7 @@ Theorem alloc_left_mapped_inject: (forall ofs k p, lo <= ofs < hi -> perm m2 b2 (ofs + delta) k p) -> inj_offset_aligned delta (hi-lo) -> (forall b delta' ofs k p, - f b = Some (b2, delta') -> + f b = Some (b2, delta') -> perm m1 b ofs k p -> lo + delta <= ofs + delta' < hi + delta -> False) -> exists f', @@ -3688,7 +3688,7 @@ Proof. assert (mem_inj f' m1 m2). inversion mi_inj0; constructor; eauto with mem. unfold f'; intros. destruct (eq_block b0 b1). - inversion H8. subst b0 b3 delta0. + inversion H8. subst b0 b3 delta0. elim (fresh_block_alloc _ _ _ _ _ H0). eauto with mem. eauto. unfold f'; intros. destruct (eq_block b0 b1). @@ -3697,14 +3697,14 @@ Proof. eapply perm_valid_block with (ofs := ofs). apply H9. generalize (size_chunk_pos chunk); omega. eauto. unfold f'; intros. destruct (eq_block b0 b1). - inversion H8. subst b0 b3 delta0. + inversion H8. subst b0 b3 delta0. elim (fresh_block_alloc _ _ _ _ _ H0). eauto with mem. - apply memval_inject_incr with f; auto. + apply memval_inject_incr with f; auto. exists f'. split. constructor. (* inj *) - eapply alloc_left_mapped_inj; eauto. unfold f'; apply dec_eq_true. + eapply alloc_left_mapped_inj; eauto. unfold f'; apply dec_eq_true. (* freeblocks *) - unfold f'; intros. destruct (eq_block b b1). subst b. + unfold f'; intros. destruct (eq_block b b1). subst b. elim H9. eauto with mem. eauto with mem. (* mappedblocks *) @@ -3715,10 +3715,10 @@ Proof. exploit perm_alloc_inv. eauto. eexact H13. intros P2. destruct (eq_block b0 b1); destruct (eq_block b3 b1). congruence. - inversion H10; subst b0 b1' delta1. + inversion H10; subst b0 b1' delta1. destruct (eq_block b2 b2'); auto. subst b2'. right; red; intros. eapply H6; eauto. omega. - inversion H11; subst b3 b2' delta2. + inversion H11; subst b3 b2' delta2. destruct (eq_block b1' b2); auto. subst b1'. right; red; intros. eapply H6; eauto. omega. eauto. @@ -3737,9 +3737,9 @@ Proof. (* incr *) split. auto. (* image of b1 *) - split. unfold f'; apply dec_eq_true. + split. unfold f'; apply dec_eq_true. (* image of others *) - intros. unfold f'; apply dec_eq_false; auto. + intros. unfold f'; apply dec_eq_false; auto. Qed. Theorem alloc_parallel_inject: @@ -3756,7 +3756,7 @@ Theorem alloc_parallel_inject: Proof. intros. case_eq (alloc m2 lo2 hi2). intros m2' b2 ALLOC. - exploit alloc_left_mapped_inject. + exploit alloc_left_mapped_inject. eapply alloc_right_inject; eauto. eauto. instantiate (1 := b2). eauto with mem. @@ -3786,7 +3786,7 @@ Proof. (* mappedblocks *) auto. (* no overlap *) - red; intros. eauto with mem. + red; intros. eauto with mem. (* representable *) intros. eapply mi_representable0; try eassumption. destruct H2; eauto with mem. @@ -3798,7 +3798,7 @@ Lemma free_list_left_inject: free_list m1 l = Some m1' -> inject f m1' m2. Proof. - induction l; simpl; intros. + induction l; simpl; intros. inv H0. auto. destruct a as [[b lo] hi]. destruct (free m1 b lo hi) as [m11|] eqn:E; try discriminate. @@ -3831,11 +3831,11 @@ Lemma perm_free_list: forall l m m' b ofs k p, free_list m l = Some m' -> perm m' b ofs k p -> - perm m b ofs k p /\ + perm m b ofs k p /\ (forall lo hi, In (b, lo, hi) l -> lo <= ofs < hi -> False). Proof. induction l; simpl; intros. - inv H. auto. + inv H. auto. destruct a as [[b1 lo1] hi1]. destruct (free m b1 lo1 hi1) as [m1|] eqn:E; try discriminate. exploit IHl; eauto. intros [A B]. @@ -3851,13 +3851,13 @@ Theorem free_inject: free_list m1 l = Some m1' -> free m2 b lo hi = Some m2' -> (forall b1 delta ofs k p, - f b1 = Some(b, delta) -> + f b1 = Some(b, delta) -> perm m1 b1 ofs k p -> lo <= ofs + delta < hi -> exists lo1, exists hi1, In (b1, lo1, hi1) l /\ lo1 <= ofs < hi1) -> inject f m1' m2'. Proof. - intros. - eapply free_right_inject; eauto. + intros. + eapply free_right_inject; eauto. eapply free_list_left_inject; eauto. intros. exploit perm_free_list; eauto. intros [A B]. exploit H2; eauto. intros [lo1 [hi1 [C D]]]. eauto. @@ -3872,26 +3872,26 @@ Theorem free_parallel_inject: free m2 b' (lo + delta) (hi + delta) = Some m2' /\ inject f m1' m2'. Proof. - intros. + intros. destruct (range_perm_free m2 b' (lo + delta) (hi + delta)) as [m2' FREE]. eapply range_perm_inject; eauto. eapply free_range_perm; eauto. exists m2'; split; auto. - eapply free_inject with (m1 := m1) (l := (b,lo,hi)::nil); eauto. + eapply free_inject with (m1 := m1) (l := (b,lo,hi)::nil); eauto. simpl; rewrite H0; auto. intros. destruct (eq_block b1 b). - subst b1. rewrite H1 in H2; inv H2. + subst b1. rewrite H1 in H2; inv H2. exists lo, hi; split; auto with coqlib. omega. exploit mi_no_overlap. eexact H. eexact n. eauto. eauto. - eapply perm_max. eapply perm_implies. eauto. auto with mem. - instantiate (1 := ofs + delta0 - delta). - apply perm_cur_max. apply perm_implies with Freeable; auto with mem. + eapply perm_max. eapply perm_implies. eauto. auto with mem. + instantiate (1 := ofs + delta0 - delta). + apply perm_cur_max. apply perm_implies with Freeable; auto with mem. eapply free_range_perm; eauto. omega. intros [A|A]. congruence. omega. Qed. Lemma drop_outside_inject: forall f m1 m2 b lo hi p m2', - inject f m1 m2 -> - drop_perm m2 b lo hi p = Some m2' -> + inject f m1 m2 -> + drop_perm m2 b lo hi p = Some m2' -> (forall b' delta ofs k p, f b' = Some(b, delta) -> perm m1 b' ofs k p -> lo <= ofs + delta < hi -> False) -> @@ -3899,7 +3899,7 @@ Lemma drop_outside_inject: forall f m1 m2 b lo hi p m2', Proof. intros. destruct H. constructor; eauto. eapply drop_outside_inj; eauto. - intros. unfold valid_block in *. erewrite nextblock_drop; eauto. + intros. unfold valid_block in *. erewrite nextblock_drop; eauto. Qed. (** Composing two memory injections. *) @@ -3911,23 +3911,23 @@ Proof. intros. unfold compose_meminj. inv H; inv H0; constructor; intros. (* perm *) destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate. - destruct (f' b') as [[b'' delta''] |] eqn:?; inv H. + destruct (f' b') as [[b'' delta''] |] eqn:?; inv H. replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') by omega. eauto. (* align *) destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate. - destruct (f' b') as [[b'' delta''] |] eqn:?; inv H. + destruct (f' b') as [[b'' delta''] |] eqn:?; inv H. apply Z.divide_add_r. eapply mi_align0; eauto. eapply mi_align1 with (ofs := ofs + delta') (p := p); eauto. red; intros. replace ofs0 with ((ofs0 - delta') + delta') by omega. - eapply mi_perm0; eauto. apply H0. omega. + eapply mi_perm0; eauto. apply H0. omega. (* memval *) destruct (f b1) as [[b' delta'] |] eqn:?; try discriminate. - destruct (f' b') as [[b'' delta''] |] eqn:?; inv H. + destruct (f' b') as [[b'' delta''] |] eqn:?; inv H. replace (ofs + (delta' + delta'')) with ((ofs + delta') + delta'') by omega. eapply memval_inject_compose; eauto. -Qed. +Qed. Theorem inject_compose: forall f f' m1 m2 m3, @@ -3937,35 +3937,35 @@ Proof. unfold compose_meminj; intros. inv H; inv H0. constructor. (* inj *) - eapply mem_inj_compose; eauto. + eapply mem_inj_compose; eauto. (* unmapped *) - intros. erewrite mi_freeblocks0; eauto. + intros. erewrite mi_freeblocks0; eauto. (* mapped *) - intros. + intros. destruct (f b) as [[b1 delta1] |] eqn:?; try discriminate. - destruct (f' b1) as [[b2 delta2] |] eqn:?; inv H. + destruct (f' b1) as [[b2 delta2] |] eqn:?; inv H. eauto. (* no overlap *) - red; intros. + red; intros. destruct (f b1) as [[b1x delta1x] |] eqn:?; try discriminate. - destruct (f' b1x) as [[b1y delta1y] |] eqn:?; inv H0. + destruct (f' b1x) as [[b1y delta1y] |] eqn:?; inv H0. destruct (f b2) as [[b2x delta2x] |] eqn:?; try discriminate. destruct (f' b2x) as [[b2y delta2y] |] eqn:?; inv H1. exploit mi_no_overlap0; eauto. intros A. - destruct (eq_block b1x b2x). - subst b1x. destruct A. congruence. + destruct (eq_block b1x b2x). + subst b1x. destruct A. congruence. assert (delta1y = delta2y) by congruence. right; omega. exploit mi_no_overlap1. eauto. eauto. eauto. - eapply perm_inj. eauto. eexact H2. eauto. - eapply perm_inj. eauto. eexact H3. eauto. + eapply perm_inj. eauto. eexact H2. eauto. + eapply perm_inj. eauto. eexact H3. eauto. intuition omega. (* representable *) - intros. + intros. destruct (f b) as [[b1 delta1] |] eqn:?; try discriminate. - destruct (f' b1) as [[b2 delta2] |] eqn:?; inv H. + destruct (f' b1) as [[b2 delta2] |] eqn:?; inv H. exploit mi_representable0; eauto. intros [A B]. set (ofs' := Int.repr (Int.unsigned ofs + delta1)). - assert (Int.unsigned ofs' = Int.unsigned ofs + delta1). + assert (Int.unsigned ofs' = Int.unsigned ofs + delta1). unfold ofs'; apply Int.unsigned_repr. auto. exploit mi_representable1. eauto. instantiate (1 := ofs'). rewrite H. @@ -3996,10 +3996,10 @@ Proof. intros. inversion H; inv H0. constructor; intros. (* inj *) replace f with (compose_meminj inject_id f). eapply mem_inj_compose; eauto. - apply extensionality; intros. unfold compose_meminj, inject_id. + apply extensionality; intros. unfold compose_meminj, inject_id. destruct (f x) as [[y delta] | ]; auto. (* unmapped *) - eapply mi_freeblocks0. erewrite <- valid_block_extends; eauto. + eapply mi_freeblocks0. erewrite <- valid_block_extends; eauto. (* mapped *) eauto. (* no overlap *) @@ -4016,12 +4016,12 @@ Proof. intros. inv H; inversion H0. constructor; intros. (* inj *) replace f with (compose_meminj f inject_id). eapply mem_inj_compose; eauto. - apply extensionality; intros. unfold compose_meminj, inject_id. + apply extensionality; intros. unfold compose_meminj, inject_id. destruct (f x) as [[y delta] | ]; auto. decEq. decEq. omega. (* unmapped *) eauto. (* mapped *) - erewrite <- valid_block_extends; eauto. + erewrite <- valid_block_extends; eauto. (* no overlap *) red; intros. eapply mi_no_overlap0; eauto. (* representable *) @@ -4037,7 +4037,7 @@ Proof. congruence. (* meminj *) replace inject_id with (compose_meminj inject_id inject_id). - eapply mem_inj_compose; eauto. + eapply mem_inj_compose; eauto. apply extensionality; intros. unfold compose_meminj, inject_id. auto. Qed. @@ -4066,9 +4066,9 @@ Proof. auto. (* freeblocks *) unfold flat_inj, valid_block; intros. - apply pred_dec_false. auto. + apply pred_dec_false. auto. (* mappedblocks *) - unfold flat_inj, valid_block; intros. + unfold flat_inj, valid_block; intros. destruct (plt b (nextblock m)); inversion H0; subst. auto. (* no overlap *) apply flat_inj_no_overlap. @@ -4097,14 +4097,14 @@ Theorem alloc_inject_neutral: Plt (nextblock m) thr -> inject_neutral thr m'. Proof. - intros; red. - eapply alloc_left_mapped_inj with (m1 := m) (b2 := b) (delta := 0). - eapply alloc_right_inj; eauto. eauto. eauto with mem. - red. intros. apply Zdivide_0. + intros; red. + eapply alloc_left_mapped_inj with (m1 := m) (b2 := b) (delta := 0). + eapply alloc_right_inj; eauto. eauto. eauto with mem. + red. intros. apply Zdivide_0. intros. apply perm_implies with Freeable; auto with mem. - eapply perm_alloc_2; eauto. omega. - unfold flat_inj. apply pred_dec_true. + eapply perm_alloc_2; eauto. omega. + unfold flat_inj. apply pred_dec_true. rewrite (alloc_result _ _ _ _ _ H). auto. Qed. @@ -4117,11 +4117,11 @@ Theorem store_inject_neutral: inject_neutral thr m'. Proof. intros; red. - exploit store_mapped_inj. eauto. eauto. apply flat_inj_no_overlap. + exploit store_mapped_inj. eauto. eauto. apply flat_inj_no_overlap. unfold flat_inj. apply pred_dec_true; auto. eauto. - replace (ofs + 0) with ofs by omega. + replace (ofs + 0) with ofs by omega. intros [m'' [A B]]. congruence. -Qed. +Qed. Theorem drop_inject_neutral: forall m b lo hi p m' thr, @@ -4131,8 +4131,8 @@ Theorem drop_inject_neutral: inject_neutral thr m'. Proof. unfold inject_neutral; intros. - exploit drop_mapped_inj; eauto. apply flat_inj_no_overlap. - unfold flat_inj. apply pred_dec_true; eauto. + exploit drop_mapped_inj; eauto. apply flat_inj_no_overlap. + unfold flat_inj. apply pred_dec_true; eauto. repeat rewrite Zplus_0_r. intros [m'' [A B]]. congruence. Qed. @@ -4165,7 +4165,7 @@ Lemma perm_unchanged_on: unchanged_on m m' -> P b ofs -> valid_block m b -> perm m b ofs k p -> perm m' b ofs k p. Proof. - intros. destruct H. apply unchanged_on_perm0; auto. + intros. destruct H. apply unchanged_on_perm0; auto. Qed. Lemma perm_unchanged_on_2: @@ -4173,7 +4173,7 @@ Lemma perm_unchanged_on_2: unchanged_on m m' -> P b ofs -> valid_block m b -> perm m' b ofs k p -> perm m b ofs k p. Proof. - intros. destruct H. apply unchanged_on_perm0; auto. + intros. destruct H. apply unchanged_on_perm0; auto. Qed. Lemma loadbytes_unchanged_on_1: @@ -4183,7 +4183,7 @@ Lemma loadbytes_unchanged_on_1: (forall i, ofs <= i < ofs + n -> P b i) -> loadbytes m' b ofs n = loadbytes m b ofs n. Proof. - intros. + intros. destruct (zle n 0). + erewrite ! loadbytes_empty by assumption. auto. + unfold loadbytes. destruct H. @@ -4191,7 +4191,7 @@ Proof. rewrite pred_dec_true. f_equal. apply getN_exten. intros. rewrite nat_of_Z_eq in H by omega. apply unchanged_on_contents0; auto. - red; intros. apply unchanged_on_perm0; auto. + red; intros. apply unchanged_on_perm0; auto. rewrite pred_dec_false. auto. red; intros; elim n0; red; intros. apply <- unchanged_on_perm0; auto. Qed. @@ -4203,11 +4203,11 @@ Lemma loadbytes_unchanged_on: loadbytes m b ofs n = Some bytes -> loadbytes m' b ofs n = Some bytes. Proof. - intros. + intros. destruct (zle n 0). + erewrite loadbytes_empty in * by assumption. auto. -+ rewrite <- H1. apply loadbytes_unchanged_on_1; auto. - exploit loadbytes_range_perm; eauto. instantiate (1 := ofs). omega. ++ rewrite <- H1. apply loadbytes_unchanged_on_1; auto. + exploit loadbytes_range_perm; eauto. instantiate (1 := ofs). omega. intros. eauto with mem. Qed. @@ -4219,11 +4219,11 @@ Lemma load_unchanged_on_1: load chunk m' b ofs = load chunk m b ofs. Proof. intros. unfold load. destruct (valid_access_dec m chunk b ofs Readable). - destruct v. rewrite pred_dec_true. f_equal. f_equal. apply getN_exten. intros. + destruct v. rewrite pred_dec_true. f_equal. f_equal. apply getN_exten. intros. rewrite <- size_chunk_conv in H4. eapply unchanged_on_contents; eauto. split; auto. red; intros. eapply perm_unchanged_on; eauto. - rewrite pred_dec_false. auto. - red; intros [A B]; elim n; split; auto. red; intros; eapply perm_unchanged_on_2; eauto. + rewrite pred_dec_false. auto. + red; intros [A B]; elim n; split; auto. red; intros; eapply perm_unchanged_on_2; eauto. Qed. Lemma load_unchanged_on: @@ -4244,10 +4244,10 @@ Lemma store_unchanged_on: Proof. intros; constructor; intros. - split; intros; eauto with mem. -- erewrite store_mem_contents; eauto. rewrite PMap.gsspec. - destruct (peq b0 b); auto. subst b0. apply setN_outside. - rewrite encode_val_length. rewrite <- size_chunk_conv. - destruct (zlt ofs0 ofs); auto. +- erewrite store_mem_contents; eauto. rewrite PMap.gsspec. + destruct (peq b0 b); auto. subst b0. apply setN_outside. + rewrite encode_val_length. rewrite <- size_chunk_conv. + destruct (zlt ofs0 ofs); auto. destruct (zlt ofs0 (ofs + size_chunk chunk)); auto. elim (H0 ofs0). omega. auto. Qed. @@ -4259,23 +4259,23 @@ Lemma storebytes_unchanged_on: unchanged_on m m'. Proof. intros; constructor; intros. -- split; intros. eapply perm_storebytes_1; eauto. eapply perm_storebytes_2; eauto. -- erewrite storebytes_mem_contents; eauto. rewrite PMap.gsspec. - destruct (peq b0 b); auto. subst b0. apply setN_outside. - destruct (zlt ofs0 ofs); auto. +- split; intros. eapply perm_storebytes_1; eauto. eapply perm_storebytes_2; eauto. +- erewrite storebytes_mem_contents; eauto. rewrite PMap.gsspec. + destruct (peq b0 b); auto. subst b0. apply setN_outside. + destruct (zlt ofs0 ofs); auto. destruct (zlt ofs0 (ofs + Z_of_nat (length bytes))); auto. elim (H0 ofs0). omega. auto. Qed. Lemma alloc_unchanged_on: - forall m lo hi m' b, + forall m lo hi m' b, alloc m lo hi = (m', b) -> unchanged_on m m'. Proof. intros; constructor; intros. - split; intros. eapply perm_alloc_1; eauto. - eapply perm_alloc_4; eauto. + eapply perm_alloc_4; eauto. eapply valid_not_valid_diff; eauto with mem. - injection H; intros A B. rewrite <- B; simpl. rewrite PMap.gso; auto. rewrite A. eapply valid_not_valid_diff; eauto with mem. @@ -4288,9 +4288,9 @@ Lemma free_unchanged_on: unchanged_on m m'. Proof. intros; constructor; intros. -- split; intros. - eapply perm_free_1; eauto. - destruct (eq_block b0 b); auto. destruct (zlt ofs lo); auto. destruct (zle hi ofs); auto. +- split; intros. + eapply perm_free_1; eauto. + destruct (eq_block b0 b); auto. destruct (zlt ofs lo); auto. destruct (zle hi ofs); auto. subst b0. elim (H0 ofs). omega. auto. eapply perm_free_3; eauto. - unfold free in H. destruct (range_perm_dec m b lo hi Cur Freeable); inv H. diff --git a/common/Memtype.v b/common/Memtype.v index 43fc708f..5dbb66dc 100644 --- a/common/Memtype.v +++ b/common/Memtype.v @@ -376,7 +376,7 @@ Axiom loadbytes_split: loadbytes m b ofs (n1 + n2) = Some bytes -> n1 >= 0 -> n2 >= 0 -> exists bytes1, exists bytes2, - loadbytes m b ofs n1 = Some bytes1 + loadbytes m b ofs n1 = Some bytes1 /\ loadbytes m b (ofs + n1) n2 = Some bytes2 /\ bytes = bytes1 ++ bytes2. @@ -636,7 +636,7 @@ Axiom perm_alloc_4: forall b' ofs k p, perm m2 b' ofs k p -> b' <> b -> perm m1 b' ofs k p. Axiom perm_alloc_inv: forall m1 lo hi m2 b, alloc m1 lo hi = (m2, b) -> - forall b' ofs k p, + forall b' ofs k p, perm m2 b' ofs k p -> if eq_block b' b then lo <= ofs < hi else perm m1 b' ofs k p. @@ -729,7 +729,7 @@ Axiom perm_free_3: Axiom valid_access_free_1: forall m1 bf lo hi m2, free m1 bf lo hi = Some m2 -> forall chunk b ofs p, - valid_access m1 chunk b ofs p -> + valid_access m1 chunk b ofs p -> b <> bf \/ lo >= hi \/ ofs + size_chunk chunk <= lo \/ hi <= ofs -> valid_access m2 chunk b ofs p. Axiom valid_access_free_2: @@ -790,7 +790,7 @@ Axiom perm_drop_4: Axiom load_drop: forall m b lo hi p m', drop_perm m b lo hi p = Some m' -> - forall chunk b' ofs, + forall chunk b' ofs, b' <> b \/ ofs + size_chunk chunk <= lo \/ hi <= ofs \/ perm_order p Readable -> load chunk m' b' ofs = load chunk m b' ofs. @@ -928,10 +928,10 @@ Axiom weak_valid_pointer_extends: a sub-block at offset [ofs] of the block [b'] in [m2]. A memory injection [f] defines a relation [Val.inject] between values -that is the identity for integer and float values, and relocates pointer +that is the identity for integer and float values, and relocates pointer values as prescribed by [f]. (See module [Values].) -Likewise, a memory injection [f] defines a relation between memory states +Likewise, a memory injection [f] defines a relation between memory states that we now axiomatize. *) Parameter inject: meminj -> mem -> mem -> Prop. @@ -1146,7 +1146,7 @@ Axiom alloc_left_mapped_inject: (forall ofs k p, lo <= ofs < hi -> perm m2 b2 (ofs + delta) k p) -> inj_offset_aligned delta (hi-lo) -> (forall b delta' ofs k p, - f b = Some (b2, delta') -> + f b = Some (b2, delta') -> perm m1 b ofs k p -> lo + delta <= ofs + delta' < hi + delta -> False) -> exists f', @@ -1188,8 +1188,8 @@ Axiom free_parallel_inject: Axiom drop_outside_inject: forall f m1 m2 b lo hi p m2', - inject f m1 m2 -> - drop_perm m2 b lo hi p = Some m2' -> + inject f m1 m2 -> + drop_perm m2 b lo hi p = Some m2' -> (forall b' delta ofs k p, f b' = Some(b, delta) -> perm m1 b' ofs k p -> lo <= ofs + delta < hi -> False) -> diff --git a/common/PrintAST.ml b/common/PrintAST.ml index 67b5eb9d..39481bfb 100644 --- a/common/PrintAST.ml +++ b/common/PrintAST.ml @@ -57,17 +57,17 @@ let rec print_builtin_arg px oc = function | BA_long n -> fprintf oc "long %Ld" (camlint64_of_coqint n) | BA_float n -> fprintf oc "float %F" (camlfloat_of_coqfloat n) | BA_single n -> fprintf oc "single %F" (camlfloat_of_coqfloat32 n) - | BA_loadstack(chunk, ofs) -> + | BA_loadstack(chunk, ofs) -> fprintf oc "%s[sp + %ld]" (name_of_chunk chunk) (camlint_of_coqint ofs) | BA_addrstack(ofs) -> fprintf oc "sp + %ld" (camlint_of_coqint ofs) - | BA_loadglobal(chunk, id, ofs) -> + | BA_loadglobal(chunk, id, ofs) -> fprintf oc "%s[&%s + %ld]" (name_of_chunk chunk) (extern_atom id) (camlint_of_coqint ofs) | BA_addrglobal(id, ofs) -> fprintf oc "&%s + %ld" (extern_atom id) (camlint_of_coqint ofs) | BA_splitlong(hi, lo) -> - fprintf oc "splitlong(%a, %a)" + fprintf oc "splitlong(%a, %a)" (print_builtin_arg px) hi (print_builtin_arg px) lo let rec print_builtin_args px oc = function @@ -80,6 +80,6 @@ let rec print_builtin_res px oc = function | BR x -> px oc x | BR_none -> fprintf oc "_" | BR_splitlong(hi, lo) -> - fprintf oc "splitlong(%a, %a)" + fprintf oc "splitlong(%a, %a)" (print_builtin_res px) hi (print_builtin_res px) lo diff --git a/common/Sections.ml b/common/Sections.ml index cc8b0758..0400bbc4 100644 --- a/common/Sections.ml +++ b/common/Sections.ml @@ -57,7 +57,7 @@ let default_section_info = { let builtin_sections = [ "CODE", - {sec_name_init = Section_text; + {sec_name_init = Section_text; sec_name_uninit = Section_text; sec_writable = false; sec_executable = true; sec_access = Access_default}; @@ -118,7 +118,7 @@ let initialize () = (* Define or update a given section. *) let define_section name ?iname ?uname ?writable ?executable ?access () = - let si = + let si = try Hashtbl.find current_section_table name with Not_found -> default_section_info in let writable = @@ -217,7 +217,7 @@ let for_function env id ty_res = with Not_found -> assert false in [si_code.sec_name_init; si_literal.sec_name_init; si_jumptbl.sec_name_init] - + (* Determine section for a string literal *) let for_stringlit() = diff --git a/common/Smallstep.v b/common/Smallstep.v index ab41d327..71cef35f 100644 --- a/common/Smallstep.v +++ b/common/Smallstep.v @@ -62,7 +62,7 @@ Inductive star (ge: genv): state -> trace -> state -> Prop := Lemma star_one: forall ge s1 t s2, step ge s1 t s2 -> star ge s1 t s2. Proof. - intros. eapply star_step; eauto. apply star_refl. traceEq. + intros. eapply star_step; eauto. apply star_refl. traceEq. Qed. Lemma star_two: @@ -70,7 +70,7 @@ Lemma star_two: step ge s1 t1 s2 -> step ge s2 t2 s3 -> t = t1 ** t2 -> star ge s1 t s3. Proof. - intros. eapply star_step; eauto. apply star_one; auto. + intros. eapply star_step; eauto. apply star_one; auto. Qed. Lemma star_three: @@ -78,7 +78,7 @@ Lemma star_three: step ge s1 t1 s2 -> step ge s2 t2 s3 -> step ge s3 t3 s4 -> t = t1 ** t2 ** t3 -> star ge s1 t s4. Proof. - intros. eapply star_step; eauto. eapply star_two; eauto. + intros. eapply star_step; eauto. eapply star_two; eauto. Qed. Lemma star_four: @@ -87,7 +87,7 @@ Lemma star_four: step ge s3 t3 s4 -> step ge s4 t4 s5 -> t = t1 ** t2 ** t3 ** t4 -> star ge s1 t s5. Proof. - intros. eapply star_step; eauto. eapply star_three; eauto. + intros. eapply star_step; eauto. eapply star_three; eauto. Qed. Lemma star_trans: @@ -119,13 +119,13 @@ Lemma star_E0_ind: (forall s1 s2 s3, step ge s1 E0 s2 -> P s2 s3 -> P s1 s3) -> forall s1 s2, star ge s1 E0 s2 -> P s1 s2. Proof. - intros ge P BASE REC. + intros ge P BASE REC. assert (forall s1 t s2, star ge s1 t s2 -> t = E0 -> P s1 s2). induction 1; intros; subst. auto. destruct (Eapp_E0_inv _ _ H2). subst. eauto. eauto. -Qed. +Qed. (** One or several transitions. Also known as the transitive closure. *) @@ -146,7 +146,7 @@ Lemma plus_two: step ge s1 t1 s2 -> step ge s2 t2 s3 -> t = t1 ** t2 -> plus ge s1 t s3. Proof. - intros. eapply plus_left; eauto. apply star_one; auto. + intros. eapply plus_left; eauto. apply star_one; auto. Qed. Lemma plus_three: @@ -154,7 +154,7 @@ Lemma plus_three: step ge s1 t1 s2 -> step ge s2 t2 s3 -> step ge s3 t3 s4 -> t = t1 ** t2 ** t3 -> plus ge s1 t s4. Proof. - intros. eapply plus_left; eauto. eapply star_two; eauto. + intros. eapply plus_left; eauto. eapply star_two; eauto. Qed. Lemma plus_four: @@ -163,14 +163,14 @@ Lemma plus_four: step ge s3 t3 s4 -> step ge s4 t4 s5 -> t = t1 ** t2 ** t3 ** t4 -> plus ge s1 t s5. Proof. - intros. eapply plus_left; eauto. eapply star_three; eauto. + intros. eapply plus_left; eauto. eapply star_three; eauto. Qed. Lemma plus_star: forall ge s1 t s2, plus ge s1 t s2 -> star ge s1 t s2. Proof. intros. inversion H; subst. - eapply star_step; eauto. + eapply star_step; eauto. Qed. Lemma plus_right: @@ -180,7 +180,7 @@ Lemma plus_right: Proof. intros. inversion H; subst. simpl. apply plus_one. auto. rewrite Eapp_assoc. eapply plus_left; eauto. - eapply star_right; eauto. + eapply star_right; eauto. Qed. Lemma plus_left': @@ -203,7 +203,7 @@ Lemma plus_star_trans: forall ge s1 t1 s2 t2 s3 t, plus ge s1 t1 s2 -> star ge s2 t2 s3 -> t = t1 ** t2 -> plus ge s1 t s3. Proof. - intros. inversion H; subst. + intros. inversion H; subst. econstructor; eauto. eapply star_trans; eauto. traceEq. Qed. @@ -214,8 +214,8 @@ Lemma star_plus_trans: Proof. intros. inversion H; subst. simpl; auto. - rewrite Eapp_assoc. - econstructor. eauto. eapply star_trans. eauto. + rewrite Eapp_assoc. + econstructor. eauto. eapply star_trans. eauto. apply plus_star. eauto. eauto. auto. Qed. @@ -227,7 +227,7 @@ Proof. Qed. Lemma plus_inv: - forall ge s1 t s2, + forall ge s1 t s2, plus ge s1 t s2 -> step ge s1 t s2 \/ exists s', exists t1, exists t2, step ge s1 t1 s' /\ plus ge s' t2 s2 /\ t = t1 ** t2. Proof. @@ -248,7 +248,7 @@ Qed. Lemma plus_ind2: forall ge (P: state -> trace -> state -> Prop), (forall s1 t s2, step ge s1 t s2 -> P s1 t s2) -> - (forall s1 t1 s2 t2 s3 t, + (forall s1 t1 s2 t2 s3 t, step ge s1 t1 s2 -> plus ge s2 t2 s3 -> P s2 t2 s3 -> t = t1 ** t2 -> P s1 t s3) -> forall s1 t s2, plus ge s1 t s2 -> P s1 t s2. @@ -261,7 +261,7 @@ Proof. rewrite E0_right. apply BASE; auto. eapply IND. eauto. econstructor; eauto. subst t. eapply IHstar; eauto. auto. - intros. inv H0. eauto. + intros. inv H0. eauto. Qed. Lemma plus_E0_ind: @@ -290,7 +290,7 @@ Qed. Remark star_starN: forall ge s t s', star ge s t s' -> exists n, starN ge n s t s'. Proof. - induction 1. + induction 1. exists O; constructor. destruct IHstar as [n P]. exists (S n); econstructor; eauto. Qed. @@ -308,9 +308,9 @@ Lemma star_forever: forever ge s1 (t *** T). Proof. induction 1; intros. simpl. auto. - subst t. rewrite Eappinf_assoc. + subst t. rewrite Eappinf_assoc. econstructor; eauto. -Qed. +Qed. (** An alternate, equivalent definition of [forever] that is useful for coinductive reasoning. *) @@ -320,7 +320,7 @@ Variable order: A -> A -> Prop. CoInductive forever_N (ge: genv) : A -> state -> traceinf -> Prop := | forever_N_star: forall s1 t s2 a1 a2 T1 T2, - star ge s1 t s2 -> + star ge s1 t s2 -> order a2 a1 -> forever_N ge a2 s2 T2 -> T1 = t *** T2 -> @@ -344,7 +344,7 @@ Proof. (* star case *) inv H1. (* no transition *) - change (E0 *** T2) with T2. apply H with a2. auto. auto. + change (E0 *** T2) with T2. apply H with a2. auto. auto. (* at least one transition *) exists t1; exists s0; exists x; exists (t2 *** T2). split. auto. split. eapply forever_N_star; eauto. @@ -353,7 +353,7 @@ Proof. inv H1. exists t1; exists s0; exists a2; exists (t2 *** T2). split. auto. - split. inv H3. auto. + split. inv H3. auto. eapply forever_N_plus. econstructor; eauto. eauto. auto. apply Eappinf_assoc. Qed. @@ -363,7 +363,7 @@ Lemma forever_N_forever: Proof. cofix COINDHYP; intros. destruct (forever_N_inv H) as [t [s' [a' [T' [P [Q R]]]]]]. - rewrite R. apply forever_intro with s'. auto. + rewrite R. apply forever_intro with s'. auto. apply COINDHYP with a'; auto. Qed. @@ -371,7 +371,7 @@ Qed. CoInductive forever_plus (ge: genv) : state -> traceinf -> Prop := | forever_plus_intro: forall s1 t s2 T1 T2, - plus ge s1 t s2 -> + plus ge s1 t s2 -> forever_plus ge s2 T2 -> T1 = t *** T2 -> forever_plus ge s1 T1. @@ -384,8 +384,8 @@ Lemma forever_plus_inv: Proof. intros. inv H. inv H0. exists s0; exists t1; exists (t2 *** T2). split. auto. - split. exploit star_inv; eauto. intros [[P Q] | R]. - subst. simpl. auto. econstructor; eauto. + split. exploit star_inv; eauto. intros [[P Q] | R]. + subst. simpl. auto. econstructor; eauto. traceEq. Qed. @@ -408,7 +408,7 @@ CoInductive forever_silent (ge: genv): state -> Prop := CoInductive forever_silent_N (ge: genv) : A -> state -> Prop := | forever_silent_N_star: forall s1 s2 a1 a2, - star ge s1 E0 s2 -> + star ge s1 E0 s2 -> order a2 a1 -> forever_silent_N ge a2 s2 -> forever_silent_N ge a1 s1 @@ -428,15 +428,15 @@ Proof. (* star case *) inv H1. (* no transition *) - apply H with a2. auto. auto. + apply H with a2. auto. auto. (* at least one transition *) - exploit Eapp_E0_inv; eauto. intros [P Q]. subst. + exploit Eapp_E0_inv; eauto. intros [P Q]. subst. exists s0; exists x. split. auto. eapply forever_silent_N_star; eauto. (* plus case *) - inv H1. exploit Eapp_E0_inv; eauto. intros [P Q]. subst. + inv H1. exploit Eapp_E0_inv; eauto. intros [P Q]. subst. exists s0; exists a2. - split. auto. inv H3. auto. + split. auto. inv H3. auto. eapply forever_silent_N_plus. econstructor; eauto. eauto. Qed. @@ -445,7 +445,7 @@ Lemma forever_silent_N_forever: Proof. cofix COINDHYP; intros. destruct (forever_silent_N_inv H) as [s' [a' [P Q]]]. - apply forever_silent_intro with s'. auto. + apply forever_silent_intro with s'. auto. apply COINDHYP with a'; auto. Qed. @@ -461,8 +461,8 @@ Lemma star_forever_reactive: star ge s1 t s2 -> forever_reactive ge s2 T -> forever_reactive ge s1 (t *** T). Proof. - intros. inv H0. rewrite <- Eappinf_assoc. econstructor. - eapply star_trans; eauto. + intros. inv H0. rewrite <- Eappinf_assoc. econstructor. + eapply star_trans; eauto. red; intro. exploit Eapp_E0_inv; eauto. intros [P Q]. contradiction. auto. Qed. @@ -523,7 +523,7 @@ Record forward_simulation (L1 L2: semantics) : Type := forall s1, initial_state L1 s1 -> exists i, exists s2, initial_state L2 s2 /\ fsim_match_states i s1 s2; fsim_match_final_states: - forall i s1 s2 r, + forall i s1 s2 r, fsim_match_states i s1 s2 -> final_state L1 s1 r -> final_state L2 s2 r; fsim_simulation: forall s1 t s1', Step L1 s1 t s1' -> @@ -546,12 +546,12 @@ Lemma fsim_simulation': (exists i', exists s2', Plus L2 s2 t s2' /\ S i' s1' s2') \/ (exists i', fsim_order S i' i /\ t = E0 /\ S i' s1' s2). Proof. - intros. exploit fsim_simulation; eauto. - intros [i' [s2' [A B]]]. intuition. + intros. exploit fsim_simulation; eauto. + intros [i' [s2' [A B]]]. intuition. left; exists i'; exists s2'; auto. - inv H2. + inv H2. right; exists i'; auto. - left; exists i'; exists s2'; split; auto. econstructor; eauto. + left; exists i'; exists s2'; split; auto. econstructor; eauto. Qed. (** ** Forward simulation diagrams. *) @@ -618,7 +618,7 @@ End SIMULATION_STAR_WF. Section SIMULATION_STAR. (** We now consider the case where we have a nonnegative integer measure - associated with states of the first semantics. It must decrease when we take + associated with states of the first semantics. It must decrease when we take a stuttering step. *) Variable measure: state L1 -> nat. @@ -670,7 +670,7 @@ Hypothesis simulation: Lemma forward_simulation_step: forward_simulation L1 L2. Proof. - apply forward_simulation_plus. + apply forward_simulation_plus. intros. exploit simulation; eauto. intros [s2' [A B]]. exists s2'; split; auto. apply plus_one; auto. Qed. @@ -723,7 +723,7 @@ Proof. exploit fsim_simulation; eauto. intros [i' [s2' [A B]]]. exploit IHstar; eauto. intros [i'' [s2'' [C D]]]. exists i''; exists s2''; split; auto. eapply star_trans; eauto. - intuition. apply plus_star; auto. + intuition. apply plus_star; auto. Qed. Lemma simulation_plus: @@ -736,10 +736,10 @@ Proof. (* base case *) exploit fsim_simulation'; eauto. intros [A | [i' A]]. left; auto. - right; exists i'; intuition. + right; exists i'; intuition. (* inductive case *) exploit fsim_simulation'; eauto. intros [[i' [s2' [A B]]] | [i' [A [B C]]]]. - exploit simulation_star. apply plus_star; eauto. eauto. + exploit simulation_star. apply plus_star; eauto. eauto. intros [i'' [s2'' [P Q]]]. left; exists i''; exists s2''; split; auto. eapply plus_star_trans; eauto. exploit IHplus; eauto. intros [[i'' [s2'' [P Q]]] | [i'' [P [Q R]]]]. @@ -770,7 +770,7 @@ Lemma simulation_forever_reactive: Forever_reactive L2 s2 T. Proof. cofix COINDHYP; intros. - inv H. + inv H. destruct (simulation_star H1 i _ H0) as [i' [st2' [A B]]]. econstructor; eauto. Qed. @@ -803,7 +803,7 @@ Proof. (* initial states *) intros. exploit (fsim_match_initial_states S12); eauto. intros [i [s2 [A B]]]. exploit (fsim_match_initial_states S23); eauto. intros [i' [s3 [C D]]]. - exists (i', i); exists s3; split; auto. exists s2; auto. + exists (i', i); exists s3; split; auto. exists s2; auto. (* final states *) intros. destruct H as [s3 [A B]]. eapply (fsim_match_final_states S23); eauto. @@ -816,12 +816,12 @@ Proof. (* L3 makes one or several steps *) exists (i2', i1'); exists s2'; split. auto. exists s3'; auto. (* L3 makes no step *) - exists (i2', i1'); exists s2; split. + exists (i2', i1'); exists s2; split. right; split. subst t; apply star_refl. red. left. auto. - exists s3'; auto. + exists s3'; auto. (* L2 makes no step *) exists (i2, i1'); exists s2; split. - right; split. subst t; apply star_refl. red. right. auto. + right; split. subst t; apply star_refl. red. right. auto. exists s3; auto. (* symbols *) intros. transitivity (Senv.public_symbol (symbolenv L2) id); apply fsim_public_preserved; auto. @@ -867,7 +867,7 @@ Lemma sd_determ_1: Step L s t1 s1 -> Step L s t2 s2 -> match_traces (symbolenv L) t1 t2. Proof. intros. eapply sd_determ; eauto. -Qed. +Qed. Lemma sd_determ_2: forall s t s1 s2, @@ -880,7 +880,7 @@ Lemma star_determinacy: forall s t s', Star L s t s' -> forall s'', Star L s t s'' -> Star L s' E0 s'' \/ Star L s'' E0 s'. Proof. - induction 1; intros. + induction 1; intros. auto. inv H2. right. eapply star_step; eauto. @@ -888,12 +888,12 @@ Proof. exploit (sd_traces DET). eexact H. intros L1. exploit (sd_traces DET). eexact H3. intros L2. assert (t1 = t0 /\ t2 = t3). - destruct t1. inv MT. auto. - destruct t1; simpl in L1; try omegaContradiction. + destruct t1. inv MT. auto. + destruct t1; simpl in L1; try omegaContradiction. destruct t0. inv MT. destruct t0; simpl in L2; try omegaContradiction. simpl in H5. split. congruence. congruence. destruct H1; subst. - assert (s2 = s4) by (eapply sd_determ_2; eauto). subst s4. + assert (s2 = s4) by (eapply sd_determ_2; eauto). subst s4. auto. Qed. @@ -903,7 +903,7 @@ End DETERMINACY. Definition safe (L: semantics) (s: state L) : Prop := forall s', - Star L s E0 s' -> + Star L s E0 s' -> (exists r, final_state L s' r) \/ (exists t, exists s'', Step L s' t s''). @@ -912,7 +912,7 @@ Lemma star_safe: Star L s E0 s' -> safe L s -> safe L s'. Proof. intros; red; intros. apply H0. eapply star_trans; eauto. -Qed. +Qed. (** The general form of a backward simulation. *) @@ -928,11 +928,11 @@ Record backward_simulation (L1 L2: semantics) : Type := forall s1 s2, initial_state L1 s1 -> initial_state L2 s2 -> exists i, exists s1', initial_state L1 s1' /\ bsim_match_states i s1' s2; bsim_match_final_states: - forall i s1 s2 r, - bsim_match_states i s1 s2 -> safe L1 s1 -> final_state L2 s2 r -> + forall i s1 s2 r, + bsim_match_states i s1 s2 -> safe L1 s1 -> final_state L2 s2 r -> exists s1', Star L1 s1 E0 s1' /\ final_state L1 s1' r; bsim_progress: - forall i s1 s2, + forall i s1 s2, bsim_match_states i s1 s2 -> safe L1 s1 -> (exists r, final_state L2 s2 r) \/ (exists t, exists s2', Step L2 s2 t s2'); @@ -955,12 +955,12 @@ Lemma bsim_simulation': (exists i', exists s1', Plus L1 s1 t s1' /\ S i' s1' s2') \/ (exists i', bsim_order S i' i /\ t = E0 /\ S i' s1 s2'). Proof. - intros. exploit bsim_simulation; eauto. - intros [i' [s1' [A B]]]. intuition. + intros. exploit bsim_simulation; eauto. + intros [i' [s1' [A B]]]. intuition. left; exists i'; exists s1'; auto. - inv H3. + inv H3. right; exists i'; auto. - left; exists i'; exists s1'; split; auto. econstructor; eauto. + left; exists i'; exists s1'; split; auto. econstructor; eauto. Qed. (** ** Backward simulation diagrams. *) @@ -985,11 +985,11 @@ Hypothesis match_initial_states: exists s1', initial_state L1 s1' /\ match_states s1' s2. Hypothesis match_final_states: - forall s1 s2 r, + forall s1 s2 r, match_states s1 s2 -> final_state L2 s2 r -> final_state L1 s1 r. Hypothesis progress: - forall s1 s2, + forall s1 s2, match_states s1 s2 -> safe L1 s1 -> (exists r, final_state L2 s2 r) \/ (exists t, exists s2', Step L2 s2 t s2'). @@ -1009,8 +1009,8 @@ Proof. auto. red; intros; constructor; intros. contradiction. intros. exists tt; eauto. - intros. exists s1; split. apply star_refl. eauto. - intros. exploit simulation; eauto. intros [s1' [A B]]. + intros. exists s1; split. apply star_refl. eauto. + intros. exploit simulation; eauto. intros [s1' [A B]]. exists tt; exists s1'; auto. Qed. @@ -1036,7 +1036,7 @@ Proof. intros. exists i; exists s1; split; auto. apply star_refl. (* inductive case *) intros. exploit bsim_simulation; eauto. intros [i' [s1' [A B]]]. - assert (Star L1 s0 E0 s1'). intuition. apply plus_star; auto. + assert (Star L1 s0 E0 s1'). intuition. apply plus_star; auto. exploit H0. eauto. eapply star_safe; eauto. intros [i'' [s1'' [C D]]]. exists i''; exists s1''; split; auto. eapply star_trans; eauto. Qed. @@ -1045,7 +1045,7 @@ Lemma bsim_safe: forall i s1 s2, S i s1 s2 -> safe L1 s1 -> safe L2 s2. Proof. - intros; red; intros. + intros; red; intros. exploit bsim_E0_star; eauto. intros [i' [s1' [A B]]]. eapply bsim_progress; eauto. eapply star_safe; eauto. Qed. @@ -1065,8 +1065,8 @@ Proof. exploit Eapp_E0_inv; eauto. intros [EQ1 EQ2]; subst. exploit bsim_simulation'; eauto. intros [[i' [s1' [A B]]] | [i' [A [B C]]]]. exploit bsim_E0_star. apply plus_star; eauto. eauto. eapply star_safe; eauto. apply plus_star; auto. - intros [i'' [s1'' [P Q]]]. - left; exists i''; exists s1''; intuition. eapply plus_star_trans; eauto. + intros [i'' [s1'' [P Q]]]. + left; exists i''; exists s1''; intuition. eapply plus_star_trans; eauto. exploit IHplus; eauto. intros [P | [i'' [P Q]]]. left; auto. right; exists i''; intuition. eapply t_trans; eauto. apply t_step; auto. @@ -1079,12 +1079,12 @@ Proof. induction 1; intros. simpl in H; discriminate. subst t. - assert (EITHER: t1 = E0 \/ t2 = E0). - unfold Eapp in H2; rewrite app_length in H2. + assert (EITHER: t1 = E0 \/ t2 = E0). + unfold Eapp in H2; rewrite app_length in H2. destruct t1; auto. destruct t2; auto. simpl in H2; omegaContradiction. - destruct EITHER; subst. - exploit IHstar; eauto. intros [s2x [s2y [A [B C]]]]. - exists s2x; exists s2y; intuition. eapply star_left; eauto. + destruct EITHER; subst. + exploit IHstar; eauto. intros [s2x [s2y [A [B C]]]]. + exists s2x; exists s2y; intuition. eapply star_left; eauto. rewrite E0_right. exists s1; exists s2; intuition. apply star_refl. Qed. @@ -1116,7 +1116,7 @@ Lemma bb_match_at: forall i1 i2 s1 s3 s2, bb_match_states (i1, i2) s1 s3. Proof. intros. econstructor; eauto. apply star_refl. -Qed. +Qed. Lemma bb_simulation_base: forall s3 t s3', Step L3 s3 t s3' -> @@ -1130,29 +1130,29 @@ Proof. intros [ [i2' [s2' [PLUS2 MATCH2]]] | [i2' [ORD2 [EQ MATCH2]]]]. (* 1 L2 makes one or several transitions *) assert (EITHER: t = E0 \/ (length t = 1)%nat). - exploit L3_single_events; eauto. + exploit L3_single_events; eauto. destruct t; auto. destruct t; auto. simpl. intros. omegaContradiction. destruct EITHER. (* 1.1 these are silent transitions *) - subst t. exploit bsim_E0_plus; eauto. + subst t. exploit bsim_E0_plus; eauto. intros [ [i1' [s1' [PLUS1 MATCH1]]] | [i1' [ORD1 MATCH1]]]. (* 1.1.1 L1 makes one or several transitions *) - exists (i1', i2'); exists s1'; split. auto. eapply bb_match_at; eauto. + exists (i1', i2'); exists s1'; split. auto. eapply bb_match_at; eauto. (* 1.1.2 L1 makes no transitions *) - exists (i1', i2'); exists s1; split. - right; split. apply star_refl. left; auto. - eapply bb_match_at; eauto. + exists (i1', i2'); exists s1; split. + right; split. apply star_refl. left; auto. + eapply bb_match_at; eauto. (* 1.2 non-silent transitions *) - exploit star_non_E0_split. apply plus_star; eauto. auto. + exploit star_non_E0_split. apply plus_star; eauto. auto. intros [s2x [s2y [P [Q R]]]]. exploit bsim_E0_star. eexact P. eauto. auto. intros [i1' [s1x [X Y]]]. - exploit bsim_simulation'. eexact Q. eauto. eapply star_safe; eauto. + exploit bsim_simulation'. eexact Q. eauto. eapply star_safe; eauto. intros [[i1'' [s1y [U V]]] | [i1'' [U [V W]]]]; try (subst t; discriminate). exists (i1'', i2'); exists s1y; split. left. eapply star_plus_trans; eauto. eapply bb_match_later; eauto. (* 2. L2 makes no transitions *) subst. exists (i1, i2'); exists s1; split. - right; split. apply star_refl. right; auto. + right; split. apply star_refl. right; auto. eapply bb_match_at; eauto. Qed. @@ -1163,12 +1163,12 @@ Lemma bb_simulation: (Plus L1 s1 t s1' \/ (Star L1 s1 t s1' /\ bb_order i' i)) /\ bb_match_states i' s1' s3'. Proof. - intros. inv H0. + intros. inv H0. exploit star_inv; eauto. intros [[EQ1 EQ2] | PLUS]. (* 1. match at *) subst. eapply bb_simulation_base; eauto. (* 2. match later *) - exploit bsim_E0_plus; eauto. + exploit bsim_E0_plus; eauto. intros [[i1' [s1' [A B]]] | [i1' [A B]]]. (* 2.1 one or several silent transitions *) exploit bb_simulation_base. eauto. auto. eexact B. eauto. @@ -1176,13 +1176,13 @@ Proof. intros [i'' [s1'' [C D]]]. exists i''; exists s1''; split; auto. left. eapply plus_star_trans; eauto. - destruct C as [P | [P Q]]. apply plus_star; eauto. eauto. + destruct C as [P | [P Q]]. apply plus_star; eauto. eauto. traceEq. (* 2.2 no silent transition *) exploit bb_simulation_base. eauto. auto. eexact B. eauto. auto. intros [i'' [s1'' [C D]]]. exists i''; exists s1''; split; auto. - intuition. right; intuition. + intuition. right; intuition. inv H6. left. eapply t_trans; eauto. left; auto. Qed. @@ -1202,17 +1202,17 @@ Proof. exists (i1, i2); exists s1'; intuition. eapply bb_match_at; eauto. (* match final states *) intros i s1 s3 r MS SAFE FIN. inv MS. - exploit (bsim_match_final_states S23); eauto. - eapply star_safe; eauto. eapply bsim_safe; eauto. + exploit (bsim_match_final_states S23); eauto. + eapply star_safe; eauto. eapply bsim_safe; eauto. intros [s2' [A B]]. exploit bsim_E0_star. eapply star_trans. eexact H0. eexact A. auto. eauto. auto. intros [i1' [s1' [C D]]]. - exploit (bsim_match_final_states S12); eauto. eapply star_safe; eauto. - intros [s1'' [P Q]]. + exploit (bsim_match_final_states S12); eauto. eapply star_safe; eauto. + intros [s1'' [P Q]]. exists s1''; split; auto. eapply star_trans; eauto. (* progress *) intros i s1 s3 MS SAFE. inv MS. - eapply (bsim_progress S23). eauto. eapply star_safe; eauto. eapply bsim_safe; eauto. + eapply (bsim_progress S23). eauto. eapply star_safe; eauto. eapply bsim_safe; eauto. (* simulation *) exact bb_simulation. (* symbols *) @@ -1243,21 +1243,21 @@ Inductive f2b_transitions: state L1 -> state L2 -> Prop := Star L1 s1 E0 s1' -> Step L1 s1' t s1'' -> Plus L2 s2 t s2' -> - FS i' s1' s2 -> + FS i' s1' s2 -> FS i'' s1'' s2' -> f2b_transitions s1 s2. Lemma f2b_progress: forall i s1 s2, FS i s1 s2 -> safe L1 s1 -> f2b_transitions s1 s2. Proof. - intros i0; pattern i0. apply well_founded_ind with (R := fsim_order FS). + intros i0; pattern i0. apply well_founded_ind with (R := fsim_order FS). apply fsim_order_wf. intros i REC s1 s2 MATCH SAFE. destruct (SAFE s1) as [[r FINAL] | [t [s1' STEP1]]]. apply star_refl. (* final state reached *) - eapply f2b_trans_final; eauto. + eapply f2b_trans_final; eauto. apply star_refl. - eapply fsim_match_final_states; eauto. + eapply fsim_match_final_states; eauto. (* L1 can make one step *) exploit (fsim_simulation FS); eauto. intros [i' [s2' [A MATCH']]]. assert (B: Plus L2 s2 t s2' \/ (s2' = s2 /\ t = E0 /\ fsim_order FS i' i)). @@ -1267,7 +1267,7 @@ Proof. eapply f2b_trans_step; eauto. apply star_refl. subst. exploit REC; eauto. eapply star_safe; eauto. apply star_one; auto. intros TRANS; inv TRANS. - eapply f2b_trans_final; eauto. eapply star_left; eauto. + eapply f2b_trans_final; eauto. eapply star_left; eauto. eapply f2b_trans_step; eauto. eapply star_left; eauto. Qed. @@ -1293,7 +1293,7 @@ Qed. Remark not_silent_length: forall t1 t2, (length (t1 ** t2) <= 1)%nat -> t1 = E0 \/ t2 = E0. Proof. - unfold Eapp, E0; intros. rewrite app_length in H. + unfold Eapp, E0; intros. rewrite app_length in H. destruct t1; destruct t2; auto. simpl in H. omegaContradiction. Qed. @@ -1303,21 +1303,21 @@ Lemma f2b_determinacy_inv: (t' = E0 /\ t'' = E0 /\ s2' = s2'') \/ (t' <> E0 /\ t'' <> E0 /\ match_traces (symbolenv L1) t' t''). Proof. - intros. + intros. assert (match_traces (symbolenv L2) t' t''). - eapply sd_determ_1; eauto. + eapply sd_determ_1; eauto. destruct (silent_or_not_silent t'). - subst. inv H1. + subst. inv H1. left; intuition. eapply sd_determ_2; eauto. destruct (silent_or_not_silent t''). - subst. inv H1. elim H2; auto. - right; intuition. - eapply match_traces_preserved with (ge1 := (symbolenv L2)); auto. - intros; symmetry; apply (fsim_public_preserved FS). + subst. inv H1. elim H2; auto. + right; intuition. + eapply match_traces_preserved with (ge1 := (symbolenv L2)); auto. + intros; symmetry; apply (fsim_public_preserved FS). Qed. Lemma f2b_determinacy_star: - forall s s1, Star L2 s E0 s1 -> + forall s s1, Star L2 s E0 s1 -> forall t s2 s3, Step L2 s1 t s2 -> t <> E0 -> Star L2 s t s3 -> @@ -1327,7 +1327,7 @@ Proof. intros. inv H3. congruence. exploit f2b_determinacy_inv. eexact H. eexact H4. intros [[EQ1 [EQ2 EQ3]] | [NEQ1 [NEQ2 MT]]]. - subst. simpl in *. eauto. + subst. simpl in *. eauto. congruence. Qed. @@ -1352,10 +1352,10 @@ Lemma wf_f2b_order: Proof. assert (ACC1: forall n, Acc f2b_order (F2BI_before n)). intros n0; pattern n0; apply lt_wf_ind; intros. - constructor; intros. inv H0. auto. + constructor; intros. inv H0. auto. assert (ACC2: forall n, Acc f2b_order (F2BI_after n)). intros n0; pattern n0; apply lt_wf_ind; intros. - constructor; intros. inv H0. auto. auto. + constructor; intros. inv H0. auto. auto. red; intros. destruct a; auto. Qed. @@ -1382,7 +1382,7 @@ Remark f2b_match_after': FS i s1 s2a -> f2b_match_states (F2BI_after n) s1 s2. Proof. - intros. inv H. + intros. inv H. econstructor; eauto. econstructor; eauto. econstructor; eauto. Qed. @@ -1403,7 +1403,7 @@ Proof. (* 1.1 L1 can reach final state and L2 is at final state: impossible! *) exploit (sd_final_nostep L2_determinate); eauto. contradiction. (* 1.2 L1 can make 0 or several steps; L2 can make 1 or several matching steps. *) - inv H2. + inv H2. exploit f2b_determinacy_inv. eexact H5. eexact STEP2. intros [[EQ1 [EQ2 EQ3]] | [NOT1 [NOT2 MT]]]. (* 1.2.1 L2 makes a silent transition *) @@ -1417,24 +1417,24 @@ Proof. subst. simpl in *. destruct (star_starN H6) as [n STEPS2]. exists (F2BI_before n); exists s1'; split. right; split. auto. constructor. - econstructor. eauto. auto. apply star_one; eauto. eauto. eauto. + econstructor. eauto. auto. apply star_one; eauto. eauto. eauto. (* 1.2.2 L2 makes a non-silent transition, and so does L1 *) exploit not_silent_length. eapply (sr_traces L1_receptive); eauto. intros [EQ | EQ]. congruence. - subst t2. rewrite E0_right in H1. + subst t2. rewrite E0_right in H1. (* Use receptiveness to equate the traces *) exploit (sr_receptive L1_receptive); eauto. intros [s1''' STEP1]. - exploit fsim_simulation_not_E0. eexact STEP1. auto. eauto. + exploit fsim_simulation_not_E0. eexact STEP1. auto. eauto. intros [i''' [s2''' [P Q]]]. inv P. (* Exploit determinacy *) exploit not_silent_length. eapply (sr_traces L1_receptive); eauto. intros [EQ | EQ]. - subst t0. simpl in *. exploit sd_determ_1. eauto. eexact STEP2. eexact H2. + subst t0. simpl in *. exploit sd_determ_1. eauto. eexact STEP2. eexact H2. intros. elim NOT2. inv H8. auto. - subst t2. rewrite E0_right in *. - assert (s4 = s2'). eapply sd_determ_2; eauto. subst s4. + subst t2. rewrite E0_right in *. + assert (s4 = s2'). eapply sd_determ_2; eauto. subst s4. (* Perform transition now and go to "after" state *) destruct (star_starN H7) as [n STEPS2]. exists (F2BI_after n); exists s1'''; split. - left. eapply plus_right; eauto. + left. eapply plus_right; eauto. eapply f2b_match_after'; eauto. (* 2. Before *) @@ -1444,22 +1444,22 @@ Proof. (* 2.1 L2 makes a silent transition: remain in "before" state *) subst. simpl in *. exists (F2BI_before n0); exists s1; split. right; split. apply star_refl. constructor. omega. - econstructor; eauto. eapply star_right; eauto. + econstructor; eauto. eapply star_right; eauto. (* 2.2 L2 make a non-silent transition *) exploit not_silent_length. eapply (sr_traces L1_receptive); eauto. intros [EQ | EQ]. congruence. subst. rewrite E0_right in *. (* Use receptiveness to equate the traces *) exploit (sr_receptive L1_receptive); eauto. intros [s1''' STEP1]. - exploit fsim_simulation_not_E0. eexact STEP1. auto. eauto. + exploit fsim_simulation_not_E0. eexact STEP1. auto. eauto. intros [i''' [s2''' [P Q]]]. (* Exploit determinacy *) - exploit f2b_determinacy_star. eauto. eexact STEP2. auto. apply plus_star; eauto. - intro R. inv R. congruence. + exploit f2b_determinacy_star. eauto. eexact STEP2. auto. apply plus_star; eauto. + intro R. inv R. congruence. exploit not_silent_length. eapply (sr_traces L1_receptive); eauto. intros [EQ | EQ]. - subst. simpl in *. exploit sd_determ_1. eauto. eexact STEP2. eexact H2. - intros. elim NOT2. inv H7; auto. - subst. rewrite E0_right in *. + subst. simpl in *. exploit sd_determ_1. eauto. eexact STEP2. eexact H2. + intros. elim NOT2. inv H7; auto. + subst. rewrite E0_right in *. assert (s3 = s2'). eapply sd_determ_2; eauto. subst s3. (* Perform transition now and go to "after" state *) destruct (star_starN H6) as [n STEPS2]. exists (F2BI_after n); exists s1'''; split. @@ -1467,7 +1467,7 @@ Proof. eapply f2b_match_after'; eauto. (* 3. After *) - inv H. exploit Eapp_E0_inv; eauto. intros [EQ1 EQ2]; subst. + inv H. exploit Eapp_E0_inv; eauto. intros [EQ1 EQ2]; subst. exploit f2b_determinacy_inv. eexact H2. eexact STEP2. intros [[EQ1 [EQ2 EQ3]] | [NOT1 [NOT2 MT]]]. subst. exists (F2BI_after n); exists s1; split. @@ -1498,9 +1498,9 @@ Proof. inv H5. congruence. exploit (sd_final_nostep L2_determinate); eauto. contradiction. inv H2. exploit (sd_final_nostep L2_determinate); eauto. contradiction. (* progress *) - intros. inv H. - exploit f2b_progress; eauto. intros TRANS; inv TRANS. - left; exists r; auto. + intros. inv H. + exploit f2b_progress; eauto. intros TRANS; inv TRANS. + left; exists r; auto. inv H3. right; econstructor; econstructor; eauto. inv H4. congruence. right; econstructor; econstructor; eauto. inv H1. right; econstructor; econstructor; eauto. @@ -1566,20 +1566,20 @@ Inductive ffs_match: fsim_index sim -> (trace * state L1) -> state L2 -> Prop := ffs_match i (ev :: t, s1) s2. Lemma star_non_E0_split': - forall s2 t s2', Star L2 s2 t s2' -> + forall s2 t s2', Star L2 s2 t s2' -> match t with | nil => True | ev :: t' => exists s2x, Plus L2 s2 (ev :: nil) s2x /\ Star L2 s2x t' s2' end. Proof. induction 1. simpl. auto. - exploit L2single; eauto. intros LEN. - destruct t1. simpl in *. subst. destruct t2. auto. + exploit L2single; eauto. intros LEN. + destruct t1. simpl in *. subst. destruct t2. auto. destruct IHstar as [s2x [A B]]. exists s2x; split; auto. - eapply plus_left. eauto. apply plus_star; eauto. auto. + eapply plus_left. eauto. apply plus_star; eauto. auto. destruct t1. simpl in *. subst t. exists s2; split; auto. apply plus_one; auto. simpl in LEN. omegaContradiction. -Qed. +Qed. Lemma ffs_simulation: forall s1 t s1', Step (atomic L1) s1 t s1' -> @@ -1590,27 +1590,27 @@ Lemma ffs_simulation: Proof. induction 1; intros. (* silent step *) - inv H0. - exploit (fsim_simulation sim); eauto. - intros [i' [s2' [A B]]]. + inv H0. + exploit (fsim_simulation sim); eauto. + intros [i' [s2' [A B]]]. exists i'; exists s2'; split. auto. constructor; auto. (* start step *) - inv H0. - exploit (fsim_simulation sim); eauto. + inv H0. + exploit (fsim_simulation sim); eauto. intros [i' [s2' [A B]]]. - destruct t as [ | ev' t]. + destruct t as [ | ev' t]. (* single event *) exists i'; exists s2'; split. auto. constructor; auto. (* multiple events *) - assert (C: Star L2 s2 (ev :: ev' :: t) s2'). intuition. apply plus_star; auto. - exploit star_non_E0_split'. eauto. simpl. intros [s2x [P Q]]. + assert (C: Star L2 s2 (ev :: ev' :: t) s2'). intuition. apply plus_star; auto. + exploit star_non_E0_split'. eauto. simpl. intros [s2x [P Q]]. exists i'; exists s2x; split. auto. econstructor; eauto. (* continue step *) - inv H0. - exploit star_non_E0_split'. eauto. simpl. intros [s2x [P Q]]. - destruct t. - exists i; exists s2'; split. left. eapply plus_star_trans; eauto. constructor; auto. - exists i; exists s2x; split. auto. econstructor; eauto. + inv H0. + exploit star_non_E0_split'. eauto. simpl. intros [s2x [P Q]]. + destruct t. + exists i; exists s2'; split. left. eapply plus_star_trans; eauto. constructor; auto. + exists i; exists s2x; split. auto. econstructor; eauto. Qed. Theorem factor_forward_simulation: @@ -1620,11 +1620,11 @@ Proof. (* wf *) apply fsim_order_wf. (* initial states *) - intros. destruct s1 as [t1 s1]. simpl in H. destruct H. subst. - exploit (fsim_match_initial_states sim); eauto. intros [i [s2 [A B]]]. + intros. destruct s1 as [t1 s1]. simpl in H. destruct H. subst. + exploit (fsim_match_initial_states sim); eauto. intros [i [s2 [A B]]]. exists i; exists s2; split; auto. constructor; auto. (* final states *) - intros. destruct s1 as [t1 s1]. simpl in H0; destruct H0; subst. inv H. + intros. destruct s1 as [t1 s1]. simpl in H0; destruct H0; subst. inv H. eapply (fsim_match_final_states sim); eauto. (* simulation *) exact ffs_simulation. @@ -1661,47 +1661,47 @@ Proof. induction 1; intros. (* silent step *) inv H0. - exploit (bsim_simulation sim); eauto. eapply star_safe; eauto. + exploit (bsim_simulation sim); eauto. eapply star_safe; eauto. intros [i' [s1'' [A B]]]. exists i'; exists s1''; split. - destruct A as [P | [P Q]]. left. eapply star_plus_trans; eauto. right; split; auto. eapply star_trans; eauto. + destruct A as [P | [P Q]]. left. eapply star_plus_trans; eauto. right; split; auto. eapply star_trans; eauto. econstructor. apply star_refl. auto. auto. (* start step *) inv H0. - exploit (bsim_simulation sim); eauto. eapply star_safe; eauto. + exploit (bsim_simulation sim); eauto. eapply star_safe; eauto. intros [i' [s1'' [A B]]]. assert (C: Star L1 s1 (ev :: t) s1''). - eapply star_trans. eauto. destruct A as [P | [P Q]]. apply plus_star; eauto. eauto. auto. + eapply star_trans. eauto. destruct A as [P | [P Q]]. apply plus_star; eauto. eauto. auto. exploit star_non_E0_split'; eauto. simpl. intros [s1x [P Q]]. exists i'; exists s1x; split. left; auto. econstructor; eauto. - exploit L2wb; eauto. + exploit L2wb; eauto. (* continue step *) inv H0. unfold E0 in H8; destruct H8; try congruence. exploit star_non_E0_split'; eauto. simpl. intros [s1x [P Q]]. - exists i; exists s1x; split. left; auto. econstructor; eauto. simpl in H0; tauto. + exists i; exists s1x; split. left; auto. econstructor; eauto. simpl in H0; tauto. Qed. Lemma fbs_progress: - forall i s1 s2, + forall i s1 s2, fbs_match i s1 s2 -> safe L1 s1 -> (exists r, final_state (atomic L2) s2 r) \/ (exists t, exists s2', Step (atomic L2) s2 t s2'). Proof. - intros. inv H. destruct t. + intros. inv H. destruct t. (* 1. no buffered events *) exploit (bsim_progress sim); eauto. eapply star_safe; eauto. - intros [[r A] | [t [s2' A]]]. + intros [[r A] | [t [s2' A]]]. (* final state *) left; exists r; simpl; auto. -(* L2 can step *) - destruct t. +(* L2 can step *) + destruct t. right; exists E0; exists (nil, s2'). constructor. auto. right; exists (e :: nil); exists (t, s2'). constructor. auto. (* 2. some buffered events *) - unfold E0 in H3; destruct H3. congruence. - right; exists (e :: nil); exists (t, s3). constructor. auto. + unfold E0 in H3; destruct H3. congruence. + right; exists (e :: nil); exists (t, s3). constructor. auto. Qed. Theorem factor_backward_simulation: @@ -1712,14 +1712,14 @@ Proof. apply bsim_order_wf. (* initial states exist *) intros. exploit (bsim_initial_states_exist sim); eauto. intros [s2 A]. - exists (E0, s2). simpl; auto. + exists (E0, s2). simpl; auto. (* initial states match *) intros. destruct s2 as [t s2]; simpl in H0; destruct H0; subst. - exploit (bsim_match_initial_states sim); eauto. intros [i [s1' [A B]]]. + exploit (bsim_match_initial_states sim); eauto. intros [i [s1' [A B]]]. exists i; exists s1'; split. auto. econstructor. apply star_refl. auto. auto. (* final states match *) intros. destruct s2 as [t s2]; simpl in H1; destruct H1; subst. - inv H. exploit (bsim_match_final_states sim); eauto. eapply star_safe; eauto. + inv H. exploit (bsim_match_final_states sim); eauto. eapply star_safe; eauto. intros [s1'' [A B]]. exists s1''; split; auto. eapply star_trans; eauto. (* progress *) exact fbs_progress. @@ -1748,19 +1748,19 @@ Theorem atomic_receptive: Proof. intros. constructor; intros. (* receptive *) - inv H0. + inv H0. (* silent step *) inv H1. exists (E0, s'). constructor; auto. (* start step *) - assert (exists ev2, t2 = ev2 :: nil). inv H1; econstructor; eauto. + assert (exists ev2, t2 = ev2 :: nil). inv H1; econstructor; eauto. destruct H0 as [ev2 EQ]; subst t2. exploit ssr_receptive; eauto. intros [s2 [t2 P]]. - exploit ssr_well_behaved. eauto. eexact P. simpl; intros Q. + exploit ssr_well_behaved. eauto. eexact P. simpl; intros Q. exists (t2, s2). constructor; auto. (* continue step *) - simpl in H2; destruct H2. + simpl in H2; destruct H2. assert (t2 = ev :: nil). inv H1; simpl in H0; tauto. - subst t2. exists (t, s0). constructor; auto. simpl; auto. + subst t2. exists (t, s0). constructor; auto. simpl; auto. (* single-event *) red. intros. inv H0; simpl; omega. Qed. diff --git a/common/Subtyping.v b/common/Subtyping.v index e1bf61af..c09226e0 100644 --- a/common/Subtyping.v +++ b/common/Subtyping.v @@ -207,7 +207,7 @@ Definition type_move (e: typenv) (r1 r2: positive) : res (bool * typenv) := (** Solve the remaining subtyping constraints by iteration. *) Fixpoint solve_rec (e: typenv) (changed: bool) (q: list constraint) : res (typenv * bool) := - match q with + match q with | nil => OK (e, changed) | (r1, r2) :: q' => @@ -222,7 +222,7 @@ Definition weight_bounds (ob: option bounds) : nat := Lemma weight_bounds_1: forall lo hi s, weight_bounds (Some (B lo hi s)) < weight_bounds None. Proof. - intros; simpl. generalize (T.weight_range hi); omega. + intros; simpl. generalize (T.weight_range hi); omega. Qed. Lemma weight_bounds_2: @@ -230,7 +230,7 @@ Lemma weight_bounds_2: T.sub lo2 lo1 -> T.sub hi1 hi2 -> lo1 <> lo2 \/ hi1 <> hi2 -> weight_bounds (Some (B lo1 hi1 s1)) < weight_bounds (Some (B lo2 hi2 s2)). Proof. - intros; simpl. + intros; simpl. generalize (T.weight_sub _ _ s1) (T.weight_sub _ _ s2) (T.weight_sub _ _ H) (T.weight_sub _ _ H0); intros. destruct H1. assert (T.weight lo2 < T.weight lo1) by (apply T.weight_sub_strict; auto). omega. @@ -245,7 +245,7 @@ Lemma weight_type_move: (e'.(te_sub) = e.(te_sub) \/ e'.(te_sub) = (r1, r2) :: e.(te_sub)) /\ (forall r, weight_bounds e'.(te_typ)!r <= weight_bounds e.(te_typ)!r) /\ (changed = true -> - weight_bounds e'.(te_typ)!r1 + weight_bounds e'.(te_typ)!r2 + weight_bounds e'.(te_typ)!r1 + weight_bounds e'.(te_typ)!r2 < weight_bounds e.(te_typ)!r1 + weight_bounds e.(te_typ)!r2). Proof. unfold type_move; intros. @@ -267,22 +267,22 @@ Local Opaque weight_bounds. + split; auto. split; intros. omega. discriminate. + assert (weight_bounds (Some b1) < weight_bounds (Some (B lo1 hi1 s1))) by (apply weight_bounds_2; auto with ty). - split; auto. split; intros. + split; auto. split; intros. rewrite PTree.gsspec. destruct (peq r r1). subst r. rewrite E1. omega. omega. - rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E2. omega. + rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E2. omega. + assert (weight_bounds (Some b2) < weight_bounds (Some (B lo2 hi2 s2))) by (apply weight_bounds_2; auto with ty). - split; auto. split; intros. + split; auto. split; intros. rewrite PTree.gsspec. destruct (peq r r2). subst r. rewrite E2. omega. omega. rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E1. omega. + assert (weight_bounds (Some b1) < weight_bounds (Some (B lo1 hi1 s1))) by (apply weight_bounds_2; auto with ty). assert (weight_bounds (Some b2) < weight_bounds (Some (B lo2 hi2 s2))) by (apply weight_bounds_2; auto with ty). - split; auto. split; intros. + split; auto. split; intros. rewrite ! PTree.gsspec. destruct (peq r r2). subst r. rewrite E2. omega. - destruct (peq r r1). subst r. rewrite E1. omega. + destruct (peq r r1). subst r. rewrite E1. omega. omega. rewrite PTree.gss. rewrite PTree.gso by auto. rewrite PTree.gss. omega. @@ -290,15 +290,15 @@ Local Opaque weight_bounds. assert (weight_bounds (Some b2) < weight_bounds None) by (apply weight_bounds_1). inv H; simpl. split. destruct (T.sub_dec hi1 lo1); auto. - split; intros. + split; intros. rewrite PTree.gsspec. destruct (peq r r2). subst r; rewrite E2; omega. omega. - rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E1. omega. + rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E1. omega. - set (b1 := B (T.low_bound hi2) hi2 (T.low_bound_sub hi2)) in *. assert (weight_bounds (Some b1) < weight_bounds None) by (apply weight_bounds_1). inv H; simpl. split. destruct (T.sub_dec hi2 lo2); auto. - split; intros. + split; intros. rewrite PTree.gsspec. destruct (peq r r1). subst r; rewrite E1; omega. omega. rewrite PTree.gss. rewrite PTree.gso by auto. rewrite E2. omega. @@ -323,7 +323,7 @@ Lemma weight_solve_rec: <= weight_constraints e.(te_typ) e.(te_sub) + weight_constraints e.(te_typ) q. Proof. induction q; simpl; intros. -- inv H. split. intros; omega. replace (changed' && negb changed') with false. +- inv H. split. intros; omega. replace (changed' && negb changed') with false. omega. destruct changed'; auto. - destruct a as [r1 r2]; monadInv H; simpl. rename x into changed1. rename x0 into e1. @@ -334,7 +334,7 @@ Proof. weight_constraints (te_typ e) (te_sub e)) by (apply weight_constraints_tighter; auto). assert (Q: weight_constraints (te_typ e1) (te_sub e1) <= - weight_constraints (te_typ e1) (te_sub e) + + weight_constraints (te_typ e1) (te_sub e) + weight_bounds (te_typ e1)!r1 + weight_bounds (te_typ e1)!r2). { destruct A as [Q|Q]; rewrite Q. omega. simpl. omega. } assert (R: weight_constraints (te_typ e1) q <= weight_constraints (te_typ e) q) @@ -342,16 +342,16 @@ Proof. set (ch1 := if changed' && negb (changed || changed1) then 1 else 0) in *. set (ch2 := if changed' && negb changed then 1 else 0) in *. destruct changed1. - assert (ch2 <= ch1 + 1). - { unfold ch2, ch1. rewrite orb_true_r. simpl. rewrite andb_false_r. + assert (ch2 <= ch1 + 1). + { unfold ch2, ch1. rewrite orb_true_r. simpl. rewrite andb_false_r. destruct (changed' && negb changed); omega. } exploit C; eauto. omega. assert (ch2 <= ch1). { unfold ch2, ch1. rewrite orb_false_r. omega. } - generalize (B r1) (B r2); omega. + generalize (B r1) (B r2); omega. Qed. -Definition weight_typenv (e: typenv) : nat := +Definition weight_typenv (e: typenv) : nat := weight_constraints e.(te_typ) e.(te_sub). (** Iterative solving of the remaining constraints *) @@ -364,7 +364,7 @@ Function solve_constraints (e: typenv) {measure weight_typenv e}: res typenv := end. Proof. intros. exploit weight_solve_rec; eauto. simpl. intros [A B]. - unfold weight_typenv. omega. + unfold weight_typenv. omega. Qed. Definition typassign := positive -> T.t. @@ -383,7 +383,7 @@ Definition satisf (te: typassign) (e: typenv) : Prop := Lemma satisf_initial: forall te, satisf te initial. Proof. - unfold initial; intros; split; simpl; intros. + unfold initial; intros; split; simpl; intros. rewrite PTree.gempty in H; discriminate. contradiction. Qed. @@ -398,11 +398,11 @@ Proof. destruct (T.eq lo (T.lub lo ty)); monadInv H. subst e'; auto. destruct H0 as [P Q]; split; auto; intros. - destruct (peq x x0). + destruct (peq x x0). + subst x0. rewrite E in H; inv H. - exploit (P x); simpl. rewrite PTree.gss; eauto. intuition. - apply T.sub_trans with (T.lub lo0 ty); auto. eapply T.lub_left; eauto. - + eapply P; simpl. rewrite PTree.gso; eauto. + exploit (P x); simpl. rewrite PTree.gss; eauto. intuition. + apply T.sub_trans with (T.lub lo0 ty); auto. eapply T.lub_left; eauto. + + eapply P; simpl. rewrite PTree.gso; eauto. - inv H. destruct H0 as [P Q]; split; auto; intros. eapply P; simpl. rewrite PTree.gso; eauto. congruence. Qed. @@ -416,12 +416,12 @@ Proof. destruct (te_typ e)!x as [[lo hi s1]|] eqn:E. - destruct (T.sub_dec ty hi); try discriminate. destruct (T.eq lo (T.lub lo ty)); monadInv H. - + subst e'. apply T.sub_trans with lo. + + subst e'. apply T.sub_trans with lo. rewrite e0. eapply T.lub_right; eauto. eapply P; eauto. - + apply T.sub_trans with (T.lub lo ty). - eapply T.lub_right; eauto. - eapply (P x). simpl. rewrite PTree.gss; eauto. -- inv H. eapply (P x); simpl. rewrite PTree.gss; eauto. + + apply T.sub_trans with (T.lub lo ty). + eapply T.lub_right; eauto. + eapply (P x). simpl. rewrite PTree.gss; eauto. +- inv H. eapply (P x); simpl. rewrite PTree.gss; eauto. Qed. Lemma type_defs_incr: @@ -448,11 +448,11 @@ Proof. destruct (T.eq hi (T.glb hi ty)); monadInv H. subst e'; auto. destruct H0 as [P Q]; split; auto; intros. - destruct (peq x x0). + destruct (peq x x0). + subst x0. rewrite E in H; inv H. - exploit (P x); simpl. rewrite PTree.gss; eauto. intuition. - apply T.sub_trans with (T.glb hi0 ty); auto. eapply T.glb_left; eauto. - + eapply P; simpl. rewrite PTree.gso; eauto. + exploit (P x); simpl. rewrite PTree.gss; eauto. intuition. + apply T.sub_trans with (T.glb hi0 ty); auto. eapply T.glb_left; eauto. + + eapply P; simpl. rewrite PTree.gso; eauto. - inv H. destruct H0 as [P Q]; split; auto; intros. eapply P; simpl. rewrite PTree.gso; eauto. congruence. Qed. @@ -466,12 +466,12 @@ Proof. destruct (te_typ e)!x as [[lo hi s1]|] eqn:E. - destruct (T.sub_dec lo ty); try discriminate. destruct (T.eq hi (T.glb hi ty)); monadInv H. - + subst e'. apply T.sub_trans with hi. - eapply P; eauto. rewrite e0. eapply T.glb_right; eauto. - + apply T.sub_trans with (T.glb hi ty). - eapply (P x). simpl. rewrite PTree.gss; eauto. - eapply T.glb_right; eauto. -- inv H. eapply (P x); simpl. rewrite PTree.gss; eauto. + + subst e'. apply T.sub_trans with hi. + eapply P; eauto. rewrite e0. eapply T.glb_right; eauto. + + apply T.sub_trans with (T.glb hi ty). + eapply (P x). simpl. rewrite PTree.gss; eauto. + eapply T.glb_right; eauto. +- inv H. eapply (P x); simpl. rewrite PTree.gss; eauto. Qed. Lemma type_uses_incr: @@ -502,27 +502,27 @@ Proof. destruct (T.sub_dec lo1 hi2); try discriminate. set (lo := T.lub lo1 lo2) in *. set (hi := T.glb hi1 hi2) in *. destruct (T.eq lo2 lo); destruct (T.eq hi1 hi); monadInv H; simpl in *. - + subst e'; simpl in *. split; auto. + + subst e'; simpl in *. split; auto. + subst e'; simpl in *. split; auto. intros. destruct (peq x r1). - subst x. - rewrite E1 in H. injection H; intros; subst lo0 hi0. - exploit (P r1). rewrite PTree.gss; eauto. intuition. + subst x. + rewrite E1 in H. injection H; intros; subst lo0 hi0. + exploit (P r1). rewrite PTree.gss; eauto. intuition. apply T.sub_trans with (T.glb hi1 hi2); auto. eapply T.glb_left; eauto. eapply P. rewrite PTree.gso; eauto. + subst e'; simpl in *. split; auto. intros. destruct (peq x r2). - subst x. - rewrite E2 in H. injection H; intros; subst lo0 hi0. - exploit (P r2). rewrite PTree.gss; eauto. intuition. + subst x. + rewrite E2 in H. injection H; intros; subst lo0 hi0. + exploit (P r2). rewrite PTree.gss; eauto. intuition. apply T.sub_trans with (T.lub lo1 lo2); auto. eapply T.lub_right; eauto. eapply P. rewrite PTree.gso; eauto. - + split; auto. intros. - destruct (peq x r1). subst x. - rewrite E1 in H. injection H; intros; subst lo0 hi0. - exploit (P r1). rewrite PTree.gso; eauto. rewrite PTree.gss; eauto. intuition. + + split; auto. intros. + destruct (peq x r1). subst x. + rewrite E1 in H. injection H; intros; subst lo0 hi0. + exploit (P r1). rewrite PTree.gso; eauto. rewrite PTree.gss; eauto. intuition. apply T.sub_trans with (T.glb hi1 hi2); auto. eapply T.glb_left; eauto. - destruct (peq x r2). subst x. - rewrite E2 in H. injection H; intros; subst lo0 hi0. - exploit (P r2). rewrite PTree.gss; eauto. intuition. + destruct (peq x r2). subst x. + rewrite E2 in H. injection H; intros; subst lo0 hi0. + exploit (P r2). rewrite PTree.gss; eauto. intuition. apply T.sub_trans with (T.lub lo1 lo2); auto. eapply T.lub_right; eauto. eapply P. rewrite ! PTree.gso; eauto. - inv H; simpl in *. split; intros. @@ -531,7 +531,7 @@ Proof. - inv H; simpl in *. split; intros. eapply P. rewrite PTree.gso; eauto. congruence. apply Q. destruct (T.sub_dec hi2 lo2); auto with coqlib. -- inv H; simpl in *. split; auto. +- inv H; simpl in *. split; auto. Qed. Hint Resolve type_move_incr: ty. @@ -544,24 +544,24 @@ Proof. destruct (peq r1 r2). subst r2. apply T.sub_refl. destruct (te_typ e)!r1 as [[lo1 hi1 s1]|] eqn:E1; destruct (te_typ e)!r2 as [[lo2 hi2 s2]|] eqn:E2. -- destruct (T.sub_dec hi1 lo2). +- destruct (T.sub_dec hi1 lo2). inv H. apply T.sub_trans with hi1. eapply P; eauto. apply T.sub_trans with lo2; auto. eapply P; eauto. destruct (T.sub_dec lo1 hi2); try discriminate. set (lo := T.lub lo1 lo2) in *. set (hi := T.glb hi1 hi2) in *. destruct (T.eq lo2 lo); destruct (T.eq hi1 hi); monadInv H; simpl in *. + subst e'; simpl in *. apply Q; auto. - + subst e'; simpl in *. apply Q; auto. - + subst e'; simpl in *. apply Q; auto. + + subst e'; simpl in *. apply Q; auto. + + subst e'; simpl in *. apply Q; auto. + apply Q; auto. - inv H; simpl in *. destruct (T.sub_dec hi1 lo1). - + apply T.sub_trans with hi1. eapply P; eauto. rewrite PTree.gso; eauto. - apply T.sub_trans with lo1; auto. eapply P. rewrite PTree.gss; eauto. + + apply T.sub_trans with hi1. eapply P; eauto. rewrite PTree.gso; eauto. + apply T.sub_trans with lo1; auto. eapply P. rewrite PTree.gss; eauto. + auto with coqlib. - inv H; simpl in *. destruct (T.sub_dec hi2 lo2). - + apply T.sub_trans with hi2. eapply P. rewrite PTree.gss; eauto. - apply T.sub_trans with lo2; auto. eapply P. rewrite PTree.gso; eauto. + + apply T.sub_trans with hi2. eapply P. rewrite PTree.gss; eauto. + apply T.sub_trans with lo2; auto. eapply P. rewrite PTree.gso; eauto. + auto with coqlib. -- inv H. simpl in Q; auto. +- inv H. simpl in Q; auto. Qed. Lemma solve_rec_incr: @@ -575,12 +575,12 @@ Qed. Lemma solve_rec_sound: forall te r1 r2 q e changed e' changed', - solve_rec e changed q = OK(e', changed') -> In (r1, r2) q -> satisf te e' -> + solve_rec e changed q = OK(e', changed') -> In (r1, r2) q -> satisf te e' -> T.sub (te r1) (te r2). Proof. induction q; simpl; intros. - contradiction. -- destruct a as [r3 r4]; monadInv H. destruct H0. +- destruct a as [r3 r4]; monadInv H. destruct H0. + inv H. eapply type_move_sound; eauto. eapply solve_rec_incr; eauto. + eapply IHq; eauto with ty. Qed. @@ -590,12 +590,12 @@ Lemma type_move_false: type_move e r1 r2 = OK(false, e') -> te_typ e' = te_typ e /\ T.sub (makeassign e r1) (makeassign e r2). Proof. - unfold type_move; intros. + unfold type_move; intros. destruct (peq r1 r2). inv H. split; auto. apply T.sub_refl. unfold makeassign; destruct (te_typ e)!r1 as [[lo1 hi1 s1]|] eqn:E1; destruct (te_typ e)!r2 as [[lo2 hi2 s2]|] eqn:E2. -- destruct (T.sub_dec hi1 lo2). +- destruct (T.sub_dec hi1 lo2). inv H. split; auto. eapply T.sub_trans; eauto. destruct (T.sub_dec lo1 hi2); try discriminate. set (lo := T.lub lo1 lo2) in *. set (hi := T.glb hi1 hi2) in *. @@ -609,17 +609,17 @@ Qed. Lemma solve_rec_false: forall r1 r2 q e changed e', solve_rec e changed q = OK(e', false) -> - changed = false /\ + changed = false /\ (In (r1, r2) q -> T.sub (makeassign e r1) (makeassign e r2)). Proof. induction q; simpl; intros. -- inv H. tauto. +- inv H. tauto. - destruct a as [r3 r4]; monadInv H. exploit IHq; eauto. intros [P Q]. destruct changed; try discriminate. destruct x; try discriminate. exploit type_move_false; eauto. intros [U V]. - split. auto. intros [A|A]. inv A. auto. exploit Q; auto. - unfold makeassign; rewrite U; auto. + split. auto. intros [A|A]. inv A. auto. exploit Q; auto. + unfold makeassign; rewrite U; auto. Qed. Lemma solve_constraints_incr: @@ -638,7 +638,7 @@ Proof. intros e0; functional induction (solve_constraints e0); intros. - inv H. split; intros. unfold makeassign; rewrite H. split; auto with ty. - exploit solve_rec_false. eauto. intros [A B]. eapply B; eauto. + exploit solve_rec_false. eauto. intros [A B]. eapply B; eauto. - eauto. - discriminate. Qed. @@ -646,7 +646,7 @@ Qed. Theorem solve_sound: forall e te, solve e = OK te -> satisf te e. Proof. - unfold solve; intros. monadInv H. + unfold solve; intros. monadInv H. eapply solve_constraints_incr. eauto. eapply solve_constraints_sound; eauto. Qed. @@ -657,17 +657,17 @@ Lemma type_def_complete: satisf te e -> T.sub ty (te x) -> exists e', type_def e x ty = OK e' /\ satisf te e'. Proof. unfold type_def; intros. destruct H as [P Q]. - destruct (te_typ e)!x as [[lo hi s1]|] eqn:E. -- destruct (T.sub_dec ty hi). + destruct (te_typ e)!x as [[lo hi s1]|] eqn:E. +- destruct (T.sub_dec ty hi). destruct (T.eq lo (T.lub lo ty)). exists e; split; auto. split; auto. - econstructor; split; eauto. split; simpl; auto; intros. - rewrite PTree.gsspec in H. destruct (peq x0 x). - inv H. exploit P; eauto. intuition. eapply T.lub_min; eauto. + econstructor; split; eauto. split; simpl; auto; intros. + rewrite PTree.gsspec in H. destruct (peq x0 x). + inv H. exploit P; eauto. intuition. eapply T.lub_min; eauto. eapply P; eauto. elim n. apply T.sub_trans with (te x); auto. eapply P; eauto. - econstructor; split; eauto. split; simpl; auto; intros. - rewrite PTree.gsspec in H. destruct (peq x0 x). + rewrite PTree.gsspec in H. destruct (peq x0 x). inv H. split; auto. apply T.high_bound_majorant; auto. eapply P; eauto. Qed. @@ -689,17 +689,17 @@ Lemma type_use_complete: satisf te e -> T.sub (te x) ty -> exists e', type_use e x ty = OK e' /\ satisf te e'. Proof. unfold type_use; intros. destruct H as [P Q]. - destruct (te_typ e)!x as [[lo hi s1]|] eqn:E. -- destruct (T.sub_dec lo ty). + destruct (te_typ e)!x as [[lo hi s1]|] eqn:E. +- destruct (T.sub_dec lo ty). destruct (T.eq hi (T.glb hi ty)). exists e; split; auto. split; auto. - econstructor; split; eauto. split; simpl; auto; intros. - rewrite PTree.gsspec in H. destruct (peq x0 x). - inv H. exploit P; eauto. intuition. eapply T.glb_max; eauto. + econstructor; split; eauto. split; simpl; auto; intros. + rewrite PTree.gsspec in H. destruct (peq x0 x). + inv H. exploit P; eauto. intuition. eapply T.glb_max; eauto. eapply P; eauto. elim n. apply T.sub_trans with (te x); auto. eapply P; eauto. - econstructor; split; eauto. split; simpl; auto; intros. - rewrite PTree.gsspec in H. destruct (peq x0 x). + rewrite PTree.gsspec in H. destruct (peq x0 x). inv H. split; auto. apply T.low_bound_minorant; auto. eapply P; eauto. Qed. @@ -730,15 +730,15 @@ Proof. - exploit (P r1); eauto. intros [L1 U1]. exploit (P r2); eauto. intros [L2 U2]. destruct (T.sub_dec hi1 lo2). econstructor; econstructor; eauto. - destruct (T.sub_dec lo1 hi2). + destruct (T.sub_dec lo1 hi2). destruct (T.eq lo2 (T.lub lo1 lo2)); destruct (T.eq hi1 (T.glb hi1 hi2)); econstructor; econstructor; split; eauto; split; auto; simpl; intros. - + rewrite PTree.gsspec in H1. destruct (peq x r1). - clear e0. inv H1. split; auto. + + rewrite PTree.gsspec in H1. destruct (peq x r1). + clear e0. inv H1. split; auto. apply T.glb_max. auto. apply T.sub_trans with (te r2); auto. eapply P; eauto. - + rewrite PTree.gsspec in H1. destruct (peq x r2). - clear e0. inv H1. split; auto. + + rewrite PTree.gsspec in H1. destruct (peq x r2). + clear e0. inv H1. split; auto. apply T.lub_min. apply T.sub_trans with (te r1); auto. auto. eapply P; eauto. + rewrite ! PTree.gsspec in H1. destruct (peq x r2). @@ -746,18 +746,18 @@ Proof. destruct (peq x r1). inv H1. split; auto. apply T.glb_max; auto. apply T.sub_trans with (te r2); auto. eapply P; eauto. - + elim n1. apply T.sub_trans with (te r1); auto. - apply T.sub_trans with (te r2); auto. + + elim n1. apply T.sub_trans with (te r1); auto. + apply T.sub_trans with (te r2); auto. - econstructor; econstructor; split; eauto; split. + simpl; intros. rewrite PTree.gsspec in H1. destruct (peq x r2). - inv H1. exploit P; eauto. intuition. + inv H1. exploit P; eauto. intuition. apply T.sub_trans with (te r1); auto. apply T.high_bound_majorant. apply T.sub_trans with (te r1); auto. eapply P; eauto. + destruct (T.sub_dec hi1 lo1); auto. - econstructor; econstructor; split; eauto; split. + simpl; intros. rewrite PTree.gsspec in H1. destruct (peq x r1). - inv H1. exploit P; eauto. intuition. + inv H1. exploit P; eauto. intuition. apply T.low_bound_minorant. apply T.sub_trans with (te r2); auto. apply T.sub_trans with (te r2); auto. eapply P; eauto. @@ -773,7 +773,7 @@ Lemma solve_rec_complete: Proof. induction q; simpl; intros. - econstructor; econstructor; eauto. -- destruct a as [r1 r2]. +- destruct a as [r1 r2]. exploit (type_move_complete te e r1 r2); auto. intros (changed1 & e1 & A & B). exploit (IHq e1 (changed || changed1)); auto. intros (e' & changed' & C & D). exists e'; exists changed'. rewrite A; simpl; rewrite C; auto. @@ -782,26 +782,26 @@ Qed. Lemma solve_constraints_complete: forall te e, satisf te e -> exists e', solve_constraints e = OK e' /\ satisf te e'. Proof. - intros te e. functional induction (solve_constraints e); intros. + intros te e. functional induction (solve_constraints e); intros. - exists e; auto. - exploit (solve_rec_complete te (te_sub e) {| te_typ := te_typ e; te_sub := nil |} false). destruct H; split; auto. simpl; tauto. destruct H; auto. - intros (e1 & changed1 & P & Q). - apply IHr. congruence. + intros (e1 & changed1 & P & Q). + apply IHr. congruence. - exploit (solve_rec_complete te (te_sub e) {| te_typ := te_typ e; te_sub := nil |} false). destruct H; split; auto. simpl; tauto. destruct H; auto. - intros (e1 & changed1 & P & Q). + intros (e1 & changed1 & P & Q). congruence. Qed. Lemma solve_complete: forall te e, satisf te e -> exists te', solve e = OK te'. Proof. - intros. unfold solve. - destruct (solve_constraints_complete te e H) as (e' & P & Q). - econstructor. rewrite P. simpl. eauto. + intros. unfold solve. + destruct (solve_constraints_complete te e H) as (e' & P & Q). + econstructor. rewrite P. simpl. eauto. Qed. End SubSolver. diff --git a/common/Switch.v b/common/Switch.v index e5b3827e..0df2bbc8 100644 --- a/common/Switch.v +++ b/common/Switch.v @@ -118,7 +118,7 @@ Definition refine_low_bound (v lo: Z) := Definition refine_high_bound (v hi: Z) := if zeq v hi then hi - 1 else hi. -Fixpoint validate_jumptable (cases: ZMap.t nat) +Fixpoint validate_jumptable (cases: ZMap.t nat) (tbl: list nat) (n: Z) {struct tbl} : bool := match tbl with | nil => true @@ -143,7 +143,7 @@ Fixpoint validate (default: nat) (cases: table) (t: comptree) | (None, _) => false | (Some act', others) => - beq_nat act act' + beq_nat act act' && validate default others t' (refine_low_bound pivot lo) (refine_high_bound pivot hi) @@ -192,10 +192,10 @@ Proof. induction t; simpl; intros; InvBooleans. - constructor. - destruct (split_eq key cases) as [[act'|] others]; try discriminate; InvBooleans. - constructor; eauto. + constructor; eauto. - destruct (split_lt key cases) as [lc rc]; InvBooleans. constructor; eauto. -- destruct (split_between default ofs sz cases) as [ins out]; InvBooleans. +- destruct (split_between default ofs sz cases) as [ins out]; InvBooleans. constructor; eauto. Qed. @@ -213,10 +213,10 @@ Proof. - intros. inv H. simpl. destruct (zeq v n); auto. - destruct a as [key act]. destruct (split_eq n cases) as [same other] eqn:SEQ. - rewrite (IHcases same other) by auto. + rewrite (IHcases same other) by auto. destruct (zeq key n); intros EQ; inv EQ. -+ destruct (zeq v n); auto. -+ simpl. destruct (zeq v key). ++ destruct (zeq v n); auto. ++ simpl. destruct (zeq v key). * subst v. rewrite zeq_false by auto. auto. * auto. Qed. @@ -231,7 +231,7 @@ Lemma split_lt_prop: Proof. induction cases; intros until rcases; simpl. - intros. inv H. simpl. destruct (zlt v n); auto. -- destruct a as [key act]. +- destruct a as [key act]. destruct (split_lt n cases) as [lc rc] eqn:SEQ. rewrite (IHcases lc rc) by auto. destruct (zlt key n); intros EQ; inv EQ; simpl. @@ -249,7 +249,7 @@ Lemma split_between_prop: Proof. induction cases; intros until outside; simpl; intros SEQ. - inv SEQ. rewrite ZMap.gi. simpl. destruct (zlt ((v - ofs) mod modulus) sz); auto. -- destruct a as [key act]. +- destruct a as [key act]. destruct (split_between default ofs sz cases) as [ins outs]. erewrite IHcases; eauto. destruct (zlt ((key - ofs) mod modulus) sz); inv SEQ. @@ -257,7 +257,7 @@ Proof. destruct (zeq v key). subst v. rewrite zlt_true by auto. auto. auto. -+ simpl. destruct (zeq v key). ++ simpl. destruct (zeq v key). subst v. rewrite zlt_false by auto. auto. auto. Qed. @@ -270,11 +270,11 @@ Lemma validate_jumptable_correct_rec: Proof. induction tbl; simpl; intros. - unfold list_length_z in H0. simpl in H0. omegaContradiction. -- InvBooleans. rewrite list_length_z_cons in H0. apply beq_nat_true in H1. +- InvBooleans. rewrite list_length_z_cons in H0. apply beq_nat_true in H1. destruct (zeq v 0). + replace (base + v) with base by omega. congruence. - + replace (base + v) with (Z.succ base + Z.pred v) by omega. - apply IHtbl. auto. omega. + + replace (base + v) with (Z.succ base + Z.pred v) by omega. + apply IHtbl. auto. omega. Qed. Lemma validate_jumptable_correct: @@ -288,12 +288,12 @@ Lemma validate_jumptable_correct: Proof. intros. rewrite (validate_jumptable_correct_rec cases tbl ofs); auto. -- f_equal. f_equal. rewrite Zmod_small. omega. - destruct (zle ofs v). omega. +- f_equal. f_equal. rewrite Zmod_small. omega. + destruct (zle ofs v). omega. assert (M: ((v - ofs) + 1 * modulus) mod modulus = (v - ofs) + modulus). { rewrite Zmod_small. omega. omega. } rewrite Z_mod_plus in M by auto. rewrite M in H0. omega. -- generalize (Z_mod_lt (v - ofs) modulus modulus_pos). omega. +- generalize (Z_mod_lt (v - ofs) modulus modulus_pos). omega. Qed. Lemma validate_correct_rec: @@ -307,23 +307,23 @@ Proof. intros default v VRANGE. induction t; simpl; intros until hi. - (* base case *) destruct cases as [ | [key1 act1] cases1]; intros. -+ apply beq_nat_true in H. subst act. reflexivity. -+ InvBooleans. apply beq_nat_true in H2. subst. simpl. ++ apply beq_nat_true in H. subst act. reflexivity. ++ InvBooleans. apply beq_nat_true in H2. subst. simpl. destruct (zeq v hi). auto. omegaContradiction. - (* eq node *) destruct (split_eq key cases) as [optact others] eqn:EQ. intros. destruct optact as [act1|]; InvBooleans; try discriminate. apply beq_nat_true in H. rewrite (split_eq_prop v default _ _ _ _ EQ). - destruct (zeq v key). + destruct (zeq v key). + congruence. - + eapply IHt; eauto. + + eapply IHt; eauto. unfold refine_low_bound, refine_high_bound. split. - destruct (zeq key lo); omega. + destruct (zeq key lo); omega. destruct (zeq key hi); omega. - (* lt node *) destruct (split_lt key cases) as [lcases rcases] eqn:EQ; intros; InvBooleans. - rewrite (split_lt_prop v default _ _ _ _ EQ). destruct (zlt v key). + rewrite (split_lt_prop v default _ _ _ _ EQ). destruct (zlt v key). eapply IHt1. eauto. omega. eapply IHt2. eauto. omega. - (* jumptable node *) @@ -331,8 +331,8 @@ Proof. rewrite (split_between_prop v _ _ _ _ _ _ EQ). assert (0 <= (v - ofs) mod modulus < modulus) by (apply Z_mod_lt; omega). destruct (zlt ((v - ofs) mod modulus) sz). - rewrite Zmod_small by omega. eapply validate_jumptable_correct; eauto. - eapply IHt; eauto. + rewrite Zmod_small by omega. eapply validate_jumptable_correct; eauto. + eapply IHt; eauto. Qed. Definition table_tree_agree @@ -345,8 +345,8 @@ Theorem validate_switch_correct: wf_comptree t /\ table_tree_agree default cases t. Proof. unfold validate_switch, table_tree_agree; split. - eapply validate_wf; eauto. - intros; eapply validate_correct_rec; eauto. omega. + eapply validate_wf; eauto. + intros; eapply validate_correct_rec; eauto. omega. Qed. End COMPTREE. diff --git a/common/Switchaux.ml b/common/Switchaux.ml index 39b484c7..0d4901bf 100644 --- a/common/Switchaux.ml +++ b/common/Switchaux.ml @@ -50,7 +50,7 @@ let compile_switch_as_tree modulus default tbl = let (key1, act1) = sw.(lo) and (key2, act2) = sw.(lo+1) and (key3, act3) = sw.(lo+2) in - CTifeq(key1, act1, + CTifeq(key1, act1, CTifeq(key2, act2, if Z.sub maxval minval = Z.of_uint 2 then CTaction act3 diff --git a/common/Unityping.v b/common/Unityping.v index d108c870..f9c9d72c 100644 --- a/common/Unityping.v +++ b/common/Unityping.v @@ -96,7 +96,7 @@ Definition move (e: typenv) (r1 r2: positive) : res (bool * typenv) := (** Solve the remaining subtyping constraints by iteration. *) Fixpoint solve_rec (e: typenv) (changed: bool) (q: list constraint) : res (typenv * bool) := - match q with + match q with | nil => OK (e, changed) | (r1, r2) :: q' => @@ -112,7 +112,7 @@ Lemma move_shape: /\ (changed = true -> e'.(te_equ) = e.(te_equ)). Proof. unfold move; intros. - destruct (peq r1 r2). inv H. auto. + destruct (peq r1 r2). inv H. auto. destruct e.(te_typ)!r1 as [ty1|]; destruct e.(te_typ)!r2 as [ty2|]; inv H; simpl. destruct (T.eq ty1 ty2); inv H1. auto. auto. @@ -163,8 +163,8 @@ Function solve_constraints (e: typenv) {measure weight_typenv e}: res typenv := | Error msg => Error msg end. Proof. - intros. exploit length_solve_rec; eauto. simpl. intros. - unfold weight_typenv. omega. + intros. exploit length_solve_rec; eauto. simpl. intros. + unfold weight_typenv. omega. Qed. Definition typassign := positive -> T.t. @@ -183,7 +183,7 @@ Definition satisf (te: typassign) (e: typenv) : Prop := Lemma satisf_initial: forall te, satisf te initial. Proof. - unfold initial; intros; split; simpl; intros. + unfold initial; intros; split; simpl; intros. rewrite PTree.gempty in H; discriminate. contradiction. Qed. @@ -235,11 +235,11 @@ Proof. destruct (te_typ e)!r1 as [ty1|] eqn:E1; destruct (te_typ e)!r2 as [ty2|] eqn:E2. - destruct (T.eq ty1 ty2); inv H. split; auto. -- inv H; simpl in *; split; auto. intros. apply P. +- inv H; simpl in *; split; auto. intros. apply P. rewrite PTree.gso by congruence. auto. -- inv H; simpl in *; split; auto. intros. apply P. +- inv H; simpl in *; split; auto. intros. apply P. rewrite PTree.gso by congruence. auto. -- inv H; simpl in *; split; auto. +- inv H; simpl in *; split; auto. Qed. Hint Resolve move_incr: ty. @@ -253,11 +253,11 @@ Proof. destruct (te_typ e)!r1 as [ty1|] eqn:E1; destruct (te_typ e)!r2 as [ty2|] eqn:E2. - destruct (T.eq ty1 ty2); inv H. erewrite ! P by eauto. auto. -- inv H; simpl in *. rewrite (P r1 ty1). rewrite (P r2 ty1). auto. +- inv H; simpl in *. rewrite (P r1 ty1). rewrite (P r2 ty1). auto. apply PTree.gss. rewrite PTree.gso by congruence. auto. -- inv H; simpl in *. rewrite (P r1 ty2). rewrite (P r2 ty2). auto. +- inv H; simpl in *. rewrite (P r1 ty2). rewrite (P r2 ty2). auto. rewrite PTree.gso by congruence. auto. apply PTree.gss. -- inv H; simpl in *. apply Q; auto. +- inv H; simpl in *. apply Q; auto. Qed. Lemma solve_rec_incr: @@ -271,12 +271,12 @@ Qed. Lemma solve_rec_sound: forall te r1 r2 q e changed e' changed', - solve_rec e changed q = OK(e', changed') -> In (r1, r2) q -> satisf te e' -> + solve_rec e changed q = OK(e', changed') -> In (r1, r2) q -> satisf te e' -> te r1 = te r2. Proof. induction q; simpl; intros. - contradiction. -- destruct a as [r3 r4]; monadInv H. destruct H0. +- destruct a as [r3 r4]; monadInv H. destruct H0. + inv H. eapply move_sound; eauto. eapply solve_rec_incr; eauto. + eapply IHq; eauto with ty. Qed. @@ -286,7 +286,7 @@ Lemma move_false: move e r1 r2 = OK(false, e') -> te_typ e' = te_typ e /\ makeassign e r1 = makeassign e r2. Proof. - unfold move; intros. + unfold move; intros. destruct (peq r1 r2). inv H. split; auto. unfold makeassign; destruct (te_typ e)!r1 as [ty1|] eqn:E1; @@ -300,17 +300,17 @@ Qed. Lemma solve_rec_false: forall r1 r2 q e changed e', solve_rec e changed q = OK(e', false) -> - changed = false /\ + changed = false /\ (In (r1, r2) q -> makeassign e r1 = makeassign e r2). Proof. induction q; simpl; intros. -- inv H. tauto. +- inv H. tauto. - destruct a as [r3 r4]; monadInv H. exploit IHq; eauto. intros [P Q]. destruct changed; try discriminate. destruct x; try discriminate. exploit move_false; eauto. intros [U V]. - split. auto. intros [A|A]. inv A. auto. exploit Q; auto. - unfold makeassign; rewrite U; auto. + split. auto. intros [A|A]. inv A. auto. exploit Q; auto. + unfold makeassign; rewrite U; auto. Qed. Lemma solve_constraints_incr: @@ -329,7 +329,7 @@ Proof. intros e0; functional induction (solve_constraints e0); intros. - inv H. split; intros. unfold makeassign; rewrite H. split; auto with ty. - exploit solve_rec_false. eauto. intros [A B]. eapply B; eauto. + exploit solve_rec_false. eauto. intros [A B]. eapply B; eauto. - eauto. - discriminate. Qed. @@ -337,7 +337,7 @@ Qed. Theorem solve_sound: forall e te, solve e = OK te -> satisf te e. Proof. - unfold solve; intros. monadInv H. + unfold solve; intros. monadInv H. eapply solve_constraints_incr. eauto. eapply solve_constraints_sound; eauto. Qed. @@ -347,12 +347,12 @@ Lemma set_complete: forall te e x ty, satisf te e -> te x = ty -> exists e', set e x ty = OK e' /\ satisf te e'. Proof. - unfold set; intros. generalize H; intros [P Q]. - destruct (te_typ e)!x as [ty1|] eqn:E. -- replace ty1 with ty. rewrite dec_eq_true. exists e; auto. - exploit P; eauto. congruence. -- econstructor; split; eauto. split; simpl; intros; auto. - rewrite PTree.gsspec in H1. destruct (peq x0 x). congruence. eauto. + unfold set; intros. generalize H; intros [P Q]. + destruct (te_typ e)!x as [ty1|] eqn:E. +- replace ty1 with ty. rewrite dec_eq_true. exists e; auto. + exploit P; eauto. congruence. +- econstructor; split; eauto. split; simpl; intros; auto. + rewrite PTree.gsspec in H1. destruct (peq x0 x). congruence. eauto. Qed. Lemma set_list_complete: @@ -379,16 +379,16 @@ Proof. destruct (te_typ e)!r1 as [ty1|] eqn:E1; destruct (te_typ e)!r2 as [ty2|] eqn:E2. - replace ty2 with ty1. rewrite dec_eq_true. econstructor; econstructor; eauto. - exploit (P r1); eauto. exploit (P r2); eauto. congruence. -- econstructor; econstructor; split; eauto. - split; simpl; intros; auto. rewrite PTree.gsspec in H1. destruct (peq x r2). - inv H1. rewrite <- H0. eauto. + exploit (P r1); eauto. exploit (P r2); eauto. congruence. +- econstructor; econstructor; split; eauto. + split; simpl; intros; auto. rewrite PTree.gsspec in H1. destruct (peq x r2). + inv H1. rewrite <- H0. eauto. eauto. -- econstructor; econstructor; split; eauto. - split; simpl; intros; auto. rewrite PTree.gsspec in H1. destruct (peq x r1). - inv H1. rewrite H0. eauto. +- econstructor; econstructor; split; eauto. + split; simpl; intros; auto. rewrite PTree.gsspec in H1. destruct (peq x r1). + inv H1. rewrite H0. eauto. eauto. -- econstructor; econstructor; split; eauto. +- econstructor; econstructor; split; eauto. split; eauto. Qed. @@ -400,7 +400,7 @@ Lemma solve_rec_complete: Proof. induction q; simpl; intros. - econstructor; econstructor; eauto. -- destruct a as [r1 r2]. +- destruct a as [r1 r2]. exploit (move_complete te e r1 r2); auto. intros (changed1 & e1 & A & B). exploit (IHq e1 (changed || changed1)); auto. intros (e' & changed' & C & D). exists e'; exists changed'. rewrite A; simpl; rewrite C; auto. @@ -409,26 +409,26 @@ Qed. Lemma solve_constraints_complete: forall te e, satisf te e -> exists e', solve_constraints e = OK e' /\ satisf te e'. Proof. - intros te e. functional induction (solve_constraints e); intros. + intros te e. functional induction (solve_constraints e); intros. - exists e; auto. - exploit (solve_rec_complete te (te_equ e) {| te_typ := te_typ e; te_equ := nil |} false). destruct H; split; auto. simpl; tauto. destruct H; auto. - intros (e1 & changed1 & P & Q). - apply IHr. congruence. + intros (e1 & changed1 & P & Q). + apply IHr. congruence. - exploit (solve_rec_complete te (te_equ e) {| te_typ := te_typ e; te_equ := nil |} false). destruct H; split; auto. simpl; tauto. destruct H; auto. - intros (e1 & changed1 & P & Q). + intros (e1 & changed1 & P & Q). congruence. Qed. Lemma solve_complete: forall te e, satisf te e -> exists te', solve e = OK te'. Proof. - intros. unfold solve. - destruct (solve_constraints_complete te e H) as (e' & P & Q). - econstructor. rewrite P. simpl. eauto. + intros. unfold solve. + destruct (solve_constraints_complete te e H) as (e' & P & Q). + econstructor. rewrite P. simpl. eauto. Qed. End UniSolver. diff --git a/common/Values.v b/common/Values.v index 8877f9a7..688e63ed 100644 --- a/common/Values.v +++ b/common/Values.v @@ -58,7 +58,7 @@ Module Val. Definition eq (x y: val): {x=y} + {x<>y}. Proof. - decide equality. + decide equality. apply Int.eq_dec. apply Int64.eq_dec. apply Float.eq_dec. @@ -809,14 +809,14 @@ Qed. Theorem cast8unsigned_and: forall x, zero_ext 8 x = and x (Vint(Int.repr 255)). Proof. - destruct x; simpl; auto. decEq. - change 255 with (two_p 8 - 1). apply Int.zero_ext_and. omega. + destruct x; simpl; auto. decEq. + change 255 with (two_p 8 - 1). apply Int.zero_ext_and. omega. Qed. Theorem cast16unsigned_and: forall x, zero_ext 16 x = and x (Vint(Int.repr 65535)). Proof. - destruct x; simpl; auto. decEq. + destruct x; simpl; auto. decEq. change 65535 with (two_p 16 - 1). apply Int.zero_ext_and. omega. Qed. @@ -829,7 +829,7 @@ Qed. Theorem bool_of_val_of_optbool: forall ob b, bool_of_val (of_optbool ob) b -> ob = Some b. Proof. - intros. destruct ob; simpl in H. + intros. destruct ob; simpl in H. destruct b0; simpl in H; inv H; auto. inv H. Qed. @@ -861,7 +861,7 @@ Qed. Theorem notbool_idem3: forall x, notbool(notbool(notbool x)) = notbool x. Proof. - destruct x; simpl; auto. + destruct x; simpl; auto. case (Int.eq i Int.zero); reflexivity. Qed. @@ -883,7 +883,7 @@ Proof. rewrite Int.add_assoc; auto. rewrite Int.add_assoc; auto. decEq. decEq. apply Int.add_commut. - decEq. rewrite Int.add_commut. rewrite <- Int.add_assoc. + decEq. rewrite Int.add_commut. rewrite <- Int.add_assoc. decEq. apply Int.add_commut. decEq. rewrite Int.add_assoc. auto. Qed. @@ -896,8 +896,8 @@ Qed. Theorem add_permut_4: forall x y z t, add (add x y) (add z t) = add (add x z) (add y t). Proof. - intros. rewrite add_permut. rewrite add_assoc. - rewrite add_permut. symmetry. apply add_assoc. + intros. rewrite add_permut. rewrite add_assoc. + rewrite add_permut. symmetry. apply add_assoc. Qed. Theorem neg_zero: neg Vzero = Vzero. @@ -912,7 +912,7 @@ Qed. Theorem sub_zero_r: forall x, sub Vzero x = neg x. Proof. - destruct x; simpl; auto. + destruct x; simpl; auto. Qed. Theorem sub_add_opp: forall x y, sub x (Vint y) = add x (Vint (Int.neg y)). @@ -940,11 +940,11 @@ Theorem sub_add_r: Proof. destruct v1; destruct v2; intros; simpl; auto. rewrite Int.sub_add_r. auto. - repeat rewrite Int.sub_add_opp. decEq. + repeat rewrite Int.sub_add_opp. decEq. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - decEq. repeat rewrite Int.sub_add_opp. + decEq. repeat rewrite Int.sub_add_opp. rewrite Int.add_assoc. decEq. apply Int.neg_add_distr. - case (eq_block b b0); intro. simpl. decEq. + case (eq_block b b0); intro. simpl. decEq. repeat rewrite Int.sub_add_opp. rewrite Int.add_assoc. decEq. apply Int.neg_add_distr. reflexivity. @@ -984,7 +984,7 @@ Proof. intros; destruct x; simpl; auto. change 32 with Int.zwordsize. rewrite (Int.is_power2_range _ _ H). decEq. apply Int.mul_pow2. auto. -Qed. +Qed. Theorem mods_divs: forall x y z, @@ -993,7 +993,7 @@ Proof. intros. destruct x; destruct y; simpl in *; try discriminate. destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H. - exists (Vint (Int.divs i i0)); split; auto. + exists (Vint (Int.divs i i0)); split; auto. simpl. rewrite Int.mods_divs. auto. Qed. @@ -1002,10 +1002,10 @@ Theorem modu_divu: modu x y = Some z -> exists v, divu x y = Some v /\ z = sub x (mul v y). Proof. intros. destruct x; destruct y; simpl in *; try discriminate. - destruct (Int.eq i0 Int.zero) eqn:?; inv H. - exists (Vint (Int.divu i i0)); split; auto. + destruct (Int.eq i0 Int.zero) eqn:?; inv H. + exists (Vint (Int.divu i i0)); split; auto. simpl. rewrite Int.modu_divu. auto. - generalize (Int.eq_spec i0 Int.zero). rewrite Heqb; auto. + generalize (Int.eq_spec i0 Int.zero). rewrite Heqb; auto. Qed. Theorem divs_pow2: @@ -1027,8 +1027,8 @@ Theorem divu_pow2: shru x (Vint logn) = y. Proof. intros; destruct x; simpl in H0; inv H0. - destruct (Int.eq n Int.zero); inv H2. - simpl. + destruct (Int.eq n Int.zero); inv H2. + simpl. rewrite (Int.is_power2_range _ _ H). decEq. symmetry. apply Int.divu_pow2. auto. Qed. @@ -1040,7 +1040,7 @@ Theorem modu_pow2: and x (Vint (Int.sub n Int.one)) = y. Proof. intros; destruct x; simpl in H0; inv H0. - destruct (Int.eq n Int.zero); inv H2. + destruct (Int.eq n Int.zero); inv H2. simpl. decEq. symmetry. eapply Int.modu_and; eauto. Qed. @@ -1079,12 +1079,12 @@ Qed. Theorem not_xor: forall x, notint x = xor x (Vint Int.mone). Proof. - destruct x; simpl; auto. + destruct x; simpl; auto. Qed. Theorem shl_mul: forall x y, mul x (shl Vone y) = shl x y. Proof. - destruct x; destruct y; simpl; auto. + destruct x; destruct y; simpl; auto. case (Int.ltu i0 Int.iwordsize); auto. decEq. symmetry. apply Int.shl_mul. Qed. @@ -1112,11 +1112,11 @@ Theorem shrx_carry: shrx x y = Some z -> add (shr x y) (shr_carry x y) = z. Proof. - intros. destruct x; destruct y; simpl in H; inv H. + intros. destruct x; destruct y; simpl in H; inv H. destruct (Int.ltu i0 (Int.repr 31)) eqn:?; inv H1. exploit Int.ltu_inv; eauto. change (Int.unsigned (Int.repr 31)) with 31. intros. - assert (Int.ltu i0 Int.iwordsize = true). - unfold Int.ltu. apply zlt_true. change (Int.unsigned Int.iwordsize) with 32. omega. + assert (Int.ltu i0 Int.iwordsize = true). + unfold Int.ltu. apply zlt_true. change (Int.unsigned Int.iwordsize) with 32. omega. simpl. rewrite H0. simpl. decEq. rewrite Int.shrx_carry; auto. Qed. @@ -1127,12 +1127,12 @@ Theorem shrx_shr: x = Vint p /\ y = Vint q /\ z = shr (if Int.lt p Int.zero then add x (Vint (Int.sub (Int.shl Int.one q) Int.one)) else x) (Vint q). Proof. - intros. destruct x; destruct y; simpl in H; inv H. + intros. destruct x; destruct y; simpl in H; inv H. destruct (Int.ltu i0 (Int.repr 31)) eqn:?; inv H1. exploit Int.ltu_inv; eauto. change (Int.unsigned (Int.repr 31)) with 31. intros. - assert (Int.ltu i0 Int.iwordsize = true). - unfold Int.ltu. apply zlt_true. change (Int.unsigned Int.iwordsize) with 32. omega. - exists i; exists i0; intuition. + assert (Int.ltu i0 Int.iwordsize = true). + unfold Int.ltu. apply zlt_true. change (Int.unsigned Int.iwordsize) with 32. omega. + exists i; exists i0; intuition. rewrite Int.shrx_shr; auto. destruct (Int.lt i Int.zero); simpl; rewrite H0; auto. Qed. @@ -1151,7 +1151,7 @@ Theorem rolm_rolm: (Int.and (Int.rol m1 n2) m2). Proof. intros; destruct x; simpl; auto. - decEq. + decEq. apply Int.rolm_rolm. apply int_wordsize_divides_modulus. Qed. @@ -1174,10 +1174,10 @@ Theorem negate_cmpu_bool: Proof. assert (forall c, cmp_different_blocks (negate_comparison c) = option_map negb (cmp_different_blocks c)). - destruct c; auto. + destruct c; auto. destruct x; destruct y; simpl; auto. rewrite Int.negate_cmpu. auto. - destruct (Int.eq i Int.zero && (valid_ptr b (Int.unsigned i0) || valid_ptr b (Int.unsigned i0 - 1))); auto. + destruct (Int.eq i Int.zero && (valid_ptr b (Int.unsigned i0) || valid_ptr b (Int.unsigned i0 - 1))); auto. destruct (Int.eq i0 Int.zero && (valid_ptr b (Int.unsigned i) || valid_ptr b (Int.unsigned i - 1))); auto. destruct (eq_block b b0). destruct ((valid_ptr b (Int.unsigned i) || valid_ptr b (Int.unsigned i - 1)) && @@ -1190,7 +1190,7 @@ Qed. Lemma not_of_optbool: forall ob, of_optbool (option_map negb ob) = notbool (of_optbool ob). Proof. - destruct ob; auto. destruct b; auto. + destruct ob; auto. destruct b; auto. Qed. Theorem negate_cmp: @@ -1240,21 +1240,21 @@ Qed. Theorem negate_cmpf_eq: forall v1 v2, notbool (cmpf Cne v1 v2) = cmpf Ceq v1 v2. Proof. - destruct v1; destruct v2; auto. unfold cmpf, cmpf_bool. + destruct v1; destruct v2; auto. unfold cmpf, cmpf_bool. rewrite Float.cmp_ne_eq. destruct (Float.cmp Ceq f f0); auto. Qed. Theorem negate_cmpf_ne: forall v1 v2, notbool (cmpf Ceq v1 v2) = cmpf Cne v1 v2. Proof. - destruct v1; destruct v2; auto. unfold cmpf, cmpf_bool. + destruct v1; destruct v2; auto. unfold cmpf, cmpf_bool. rewrite Float.cmp_ne_eq. destruct (Float.cmp Ceq f f0); auto. Qed. Theorem cmpf_le: forall v1 v2, cmpf Cle v1 v2 = or (cmpf Clt v1 v2) (cmpf Ceq v1 v2). Proof. - destruct v1; destruct v2; auto. unfold cmpf, cmpf_bool. + destruct v1; destruct v2; auto. unfold cmpf, cmpf_bool. rewrite Float.cmp_le_lt_eq. destruct (Float.cmp Clt f f0); destruct (Float.cmp Ceq f f0); auto. Qed. @@ -1262,7 +1262,7 @@ Qed. Theorem cmpf_ge: forall v1 v2, cmpf Cge v1 v2 = or (cmpf Cgt v1 v2) (cmpf Ceq v1 v2). Proof. - destruct v1; destruct v2; auto. unfold cmpf, cmpf_bool. + destruct v1; destruct v2; auto. unfold cmpf, cmpf_bool. rewrite Float.cmp_ge_gt_eq. destruct (Float.cmp Cgt f f0); destruct (Float.cmp Ceq f f0); auto. Qed. @@ -1270,57 +1270,57 @@ Qed. Theorem cmp_ne_0_optbool: forall ob, cmp Cne (of_optbool ob) (Vint Int.zero) = of_optbool ob. Proof. - intros. destruct ob; simpl; auto. destruct b; auto. + intros. destruct ob; simpl; auto. destruct b; auto. Qed. Theorem cmp_eq_1_optbool: forall ob, cmp Ceq (of_optbool ob) (Vint Int.one) = of_optbool ob. Proof. - intros. destruct ob; simpl; auto. destruct b; auto. + intros. destruct ob; simpl; auto. destruct b; auto. Qed. Theorem cmp_eq_0_optbool: forall ob, cmp Ceq (of_optbool ob) (Vint Int.zero) = of_optbool (option_map negb ob). Proof. - intros. destruct ob; simpl; auto. destruct b; auto. + intros. destruct ob; simpl; auto. destruct b; auto. Qed. Theorem cmp_ne_1_optbool: forall ob, cmp Cne (of_optbool ob) (Vint Int.one) = of_optbool (option_map negb ob). Proof. - intros. destruct ob; simpl; auto. destruct b; auto. + intros. destruct ob; simpl; auto. destruct b; auto. Qed. Theorem cmpu_ne_0_optbool: forall valid_ptr ob, cmpu valid_ptr Cne (of_optbool ob) (Vint Int.zero) = of_optbool ob. Proof. - intros. destruct ob; simpl; auto. destruct b; auto. + intros. destruct ob; simpl; auto. destruct b; auto. Qed. Theorem cmpu_eq_1_optbool: forall valid_ptr ob, cmpu valid_ptr Ceq (of_optbool ob) (Vint Int.one) = of_optbool ob. Proof. - intros. destruct ob; simpl; auto. destruct b; auto. + intros. destruct ob; simpl; auto. destruct b; auto. Qed. Theorem cmpu_eq_0_optbool: forall valid_ptr ob, cmpu valid_ptr Ceq (of_optbool ob) (Vint Int.zero) = of_optbool (option_map negb ob). Proof. - intros. destruct ob; simpl; auto. destruct b; auto. + intros. destruct ob; simpl; auto. destruct b; auto. Qed. Theorem cmpu_ne_1_optbool: forall valid_ptr ob, cmpu valid_ptr Cne (of_optbool ob) (Vint Int.one) = of_optbool (option_map negb ob). Proof. - intros. destruct ob; simpl; auto. destruct b; auto. + intros. destruct ob; simpl; auto. destruct b; auto. Qed. Lemma zero_ext_and: - forall n v, + forall n v, 0 < n < Int.zwordsize -> Val.zero_ext n v = Val.and v (Vint (Int.repr (two_p n - 1))). Proof. @@ -1332,8 +1332,8 @@ Lemma rolm_lt_zero: Proof. intros. unfold cmp, cmp_bool; destruct v; simpl; auto. transitivity (Vint (Int.shru i (Int.repr (Int.zwordsize - 1)))). - decEq. symmetry. rewrite Int.shru_rolm. auto. auto. - rewrite Int.shru_lt_zero. destruct (Int.lt i Int.zero); auto. + decEq. symmetry. rewrite Int.shru_rolm. auto. auto. + rewrite Int.shru_lt_zero. destruct (Int.lt i Int.zero); auto. Qed. Lemma rolm_ge_zero: @@ -1344,7 +1344,7 @@ Proof. unfold cmp; simpl. destruct (Int.lt i Int.zero); auto. Qed. -(** The ``is less defined'' relation between values. +(** The ``is less defined'' relation between values. A value is less defined than itself, and [Vundef] is less defined than any value. *) @@ -1379,7 +1379,7 @@ Lemma lessdef_list_inv: Proof. induction 1; simpl. tauto. - inv H. destruct IHlessdef_list. + inv H. destruct IHlessdef_list. left; congruence. tauto. tauto. Qed. @@ -1430,7 +1430,7 @@ Lemma cmpu_bool_lessdef: cmpu_bool valid_ptr c v1 v2 = Some b -> cmpu_bool valid_ptr' c v1' v2' = Some b. Proof. - intros. + intros. assert (A: forall b ofs, valid_ptr b ofs || valid_ptr b (ofs - 1) = true -> valid_ptr' b ofs || valid_ptr' b (ofs - 1) = true). { intros until ofs. rewrite ! orb_true_iff. intuition. } @@ -1438,9 +1438,9 @@ Proof. destruct v2; simpl in H2; try discriminate; inv H0; inv H1; simpl; auto. destruct (Int.eq i Int.zero && (valid_ptr b0 (Int.unsigned i0) || valid_ptr b0 (Int.unsigned i0 - 1))) eqn:E; try discriminate. - InvBooleans. rewrite H0, A by auto. auto. + InvBooleans. rewrite H0, A by auto. auto. destruct (Int.eq i0 Int.zero && (valid_ptr b0 (Int.unsigned i) || valid_ptr b0 (Int.unsigned i - 1))) eqn:E; try discriminate. - InvBooleans. rewrite H0, A by auto. auto. + InvBooleans. rewrite H0, A by auto. auto. destruct (eq_block b0 b1). destruct (valid_ptr b0 (Int.unsigned i) || valid_ptr b0 (Int.unsigned i - 1)) eqn:?; try discriminate. destruct (valid_ptr b1 (Int.unsigned i0) || valid_ptr b1 (Int.unsigned i0 - 1)) eqn:?; try discriminate. @@ -1455,7 +1455,7 @@ Lemma of_optbool_lessdef: (forall b, ob = Some b -> ob' = Some b) -> lessdef (of_optbool ob) (of_optbool ob'). Proof. - intros. destruct ob; simpl; auto. rewrite (H b); auto. + intros. destruct ob; simpl; auto. rewrite (H b); auto. Qed. Lemma longofwords_lessdef: @@ -1468,13 +1468,13 @@ Qed. Lemma loword_lessdef: forall v v', lessdef v v' -> lessdef (loword v) (loword v'). Proof. - intros. inv H; auto. + intros. inv H; auto. Qed. Lemma hiword_lessdef: forall v v', lessdef v v' -> lessdef (hiword v) (hiword v'). Proof. - intros. inv H; auto. + intros. inv H; auto. Qed. (** * Values and memory injections *) @@ -1513,12 +1513,12 @@ Inductive inject (mi: meminj): val -> val -> Prop := Hint Constructors inject. -Inductive inject_list (mi: meminj): list val -> list val-> Prop:= +Inductive inject_list (mi: meminj): list val -> list val-> Prop:= | inject_list_nil : inject_list mi nil nil - | inject_list_cons : forall v v' vl vl' , + | inject_list_cons : forall v v' vl vl' , inject mi v v' -> inject_list mi vl vl'-> - inject_list mi (v :: vl) (v' :: vl'). + inject_list mi (v :: vl) (v' :: vl'). Hint Resolve inject_list_nil inject_list_cons. @@ -1553,7 +1553,7 @@ Remark sub_inject: Proof. intros. inv H; inv H0; simpl; auto. econstructor; eauto. rewrite Int.sub_add_l. auto. - destruct (eq_block b1 b0); auto. subst. rewrite H1 in H. inv H. rewrite dec_eq_true. + destruct (eq_block b1 b0); auto. subst. rewrite H1 in H. inv H. rewrite dec_eq_true. rewrite Int.sub_shifted. auto. Qed. @@ -1613,16 +1613,16 @@ Proof. fold (weak_valid_ptr2 b2 (Int.unsigned (Int.add ofs1 (Int.repr delta)))). destruct (Int.eq i Int.zero); auto. destruct (weak_valid_ptr1 b1 (Int.unsigned ofs1)) eqn:E; try discriminate. - erewrite weak_valid_ptr_inj by eauto. auto. + erewrite weak_valid_ptr_inj by eauto. auto. - fold (weak_valid_ptr1 b1 (Int.unsigned ofs1)) in H1. fold (weak_valid_ptr2 b2 (Int.unsigned (Int.add ofs1 (Int.repr delta)))). destruct (Int.eq i Int.zero); auto. destruct (weak_valid_ptr1 b1 (Int.unsigned ofs1)) eqn:E; try discriminate. - erewrite weak_valid_ptr_inj by eauto. auto. + erewrite weak_valid_ptr_inj by eauto. auto. - fold (weak_valid_ptr1 b1 (Int.unsigned ofs1)) in H1. fold (weak_valid_ptr1 b0 (Int.unsigned ofs0)) in H1. fold (weak_valid_ptr2 b2 (Int.unsigned (Int.add ofs1 (Int.repr delta)))). - fold (weak_valid_ptr2 b3 (Int.unsigned (Int.add ofs0 (Int.repr delta0)))). + fold (weak_valid_ptr2 b3 (Int.unsigned (Int.add ofs0 (Int.repr delta0)))). destruct (eq_block b1 b0); subst. rewrite H in H2. inv H2. rewrite dec_eq_true. destruct (weak_valid_ptr1 b0 (Int.unsigned ofs1)) eqn:?; try discriminate. @@ -1633,7 +1633,7 @@ Proof. destruct (valid_ptr1 b0 (Int.unsigned ofs0)) eqn:?; try discriminate. destruct (eq_block b2 b3); subst. assert (valid_ptr_implies: forall b ofs, valid_ptr1 b ofs = true -> weak_valid_ptr1 b ofs = true). - intros. unfold weak_valid_ptr1. rewrite H0; auto. + intros. unfold weak_valid_ptr1. rewrite H0; auto. erewrite !weak_valid_ptr_inj by eauto using valid_ptr_implies. simpl. exploit valid_different_ptrs_inj; eauto. intros [?|?]; [congruence |]. destruct c; simpl in H1; inv H1. @@ -1652,13 +1652,13 @@ Qed. Lemma loword_inject: forall v v', inject f v v' -> inject f (Val.loword v) (Val.loword v'). Proof. - intros. unfold Val.loword; inv H; auto. + intros. unfold Val.loword; inv H; auto. Qed. Lemma hiword_inject: forall v v', inject f v v' -> inject f (Val.hiword v) (Val.hiword v'). Proof. - intros. unfold Val.hiword; inv H; auto. + intros. unfold Val.hiword; inv H; auto. Qed. End VAL_INJ_OPS. @@ -1677,10 +1677,10 @@ Lemma inject_incr_refl : Proof. unfold inject_incr. auto. Qed. Lemma inject_incr_trans : - forall f1 f2 f3, + forall f1 f2 f3, inject_incr f1 f2 -> inject_incr f2 f3 -> inject_incr f1 f3 . Proof. - unfold inject_incr; intros. eauto. + unfold inject_incr; intros. eauto. Qed. Lemma val_inject_incr: @@ -1707,7 +1707,7 @@ Lemma val_inject_lessdef: forall v1 v2, Val.lessdef v1 v2 <-> Val.inject (fun b => Some(b, 0)) v1 v2. Proof. intros; split; intros. - inv H; auto. destruct v2; econstructor; eauto. rewrite Int.add_zero; auto. + inv H; auto. destruct v2; econstructor; eauto. rewrite Int.add_zero; auto. inv H; auto. inv H0. rewrite Int.add_zero; auto. Qed. @@ -1728,7 +1728,7 @@ Lemma val_inject_id: Val.inject inject_id v1 v2 <-> Val.lessdef v1 v2. Proof. intros; split; intros. - inv H; auto. + inv H; auto. unfold inject_id in H0. inv H0. rewrite Int.add_zero. constructor. inv H. destruct v2; econstructor. unfold inject_id; reflexivity. rewrite Int.add_zero; auto. constructor. @@ -1753,6 +1753,6 @@ Lemma val_inject_compose: Val.inject (compose_meminj f f') v1 v3. Proof. intros. inv H; auto; inv H0; auto. econstructor. - unfold compose_meminj; rewrite H1; rewrite H3; eauto. + unfold compose_meminj; rewrite H1; rewrite H3; eauto. rewrite Int.add_assoc. decEq. unfold Int.add. apply Int.eqm_samerepr. auto with ints. -Qed. +Qed. diff --git a/cparser/Bitfields.ml b/cparser/Bitfields.ml index d064f4b1..223ee3ca 100644 --- a/cparser/Bitfields.ml +++ b/cparser/Bitfields.ml @@ -191,12 +191,12 @@ let transf_composite env su id attr ml = (* Bitfield manipulation expressions *) let left_shift_count bf = - intconst + intconst (Int64.of_int (8 * !config.sizeof_int - (bf.bf_pos + bf.bf_size))) IInt let right_shift_count bf = - intconst + intconst (Int64.of_int (8 * !config.sizeof_int - bf.bf_size)) IInt @@ -303,7 +303,7 @@ let bitfield_initializer bf i = (* Associate to the left so that it prints more nicely *) let or_expr_list = function - | [] -> intconst 0L IUInt + | [] -> intconst 0L IUInt | [e] -> e | e1 :: el -> List.fold_left @@ -409,7 +409,7 @@ let rec transf_exp env ctx e = | Some(ex, bf) -> transf_post env ctx (op_for_incr_decr op) ex bf e1.etyp end - | EUnop(op, e1) -> + | EUnop(op, e1) -> {edesc = EUnop(op, transf_exp env Val e1); etyp = e.etyp} | EBinop(Oassign, e1, e2, ty) -> @@ -433,7 +433,7 @@ let rec transf_exp env ctx e = transf_assignop env ctx (op_for_assignop op) ex bf e2 ty end | EBinop(Ocomma, e1, e2, ty) -> - {edesc = EBinop(Ocomma, transf_exp env Effects e1, + {edesc = EBinop(Ocomma, transf_exp env Effects e1, transf_exp env Val e2, ty); etyp = e.etyp} | EBinop(op, e1, e2, ty) -> @@ -534,5 +534,5 @@ let program p = Transform.program ~composite:transf_composite ~decl: transf_decl - ~fundef:transf_fundef + ~fundef:transf_fundef p diff --git a/cparser/C.mli b/cparser/C.mli index 72e1f787..8d8f2805 100644 --- a/cparser/C.mli +++ b/cparser/C.mli @@ -27,7 +27,7 @@ type ident = (* Kinds of integers *) -type ikind = +type ikind = | IBool (** [_Bool] *) | IChar (** [char] *) | ISChar (** [signed char] *) @@ -39,12 +39,12 @@ type ikind = | ILong (** [long] *) | IULong (** [unsigned long] *) | ILongLong (** [long long] (or [_int64] on Microsoft Visual C) *) - | IULongLong (** [unsigned long long] (or [unsigned _int64] on Microsoft + | IULongLong (** [unsigned long long] (or [unsigned _int64] on Microsoft Visual C) *) (** Kinds of floating-point numbers*) -type fkind = +type fkind = FFloat (** [float] *) | FDouble (** [double] *) | FLongDouble (** [long double] *) @@ -73,7 +73,7 @@ type attr_arg = | AInt of int64 | AString of string -type attribute = +type attribute = | AConst | AVolatile | ARestrict @@ -216,7 +216,7 @@ and stmt_desc = | Sdecl of decl | Sasm of attributes * string * asm_operand list * asm_operand list * string list -and slabel = +and slabel = | Slabel of string | Scase of exp | Sdefault diff --git a/cparser/Cabs.v b/cparser/Cabs.v index 6d9e95d5..e15f8694 100644 --- a/cparser/Cabs.v +++ b/cparser/Cabs.v @@ -86,18 +86,18 @@ with parameter := | PARAM : list spec_elem -> option string -> decl_type -> list attribute -> cabsloc -> parameter (* The optional expression is the bitfield *) -with field_group := +with field_group := | Field_group : list spec_elem -> list (option name * option expression) -> cabsloc -> field_group (* The decl_type is in the order in which they are printed. Only the name of * the declared identifier is pulled out. *) (* e.g: in "int *x", "*x" is the declarator; "x" will be pulled out as *) (* the string, and decl_type will be PTR([], JUSTBASE) *) -with name := +with name := | Name : string -> decl_type -> list attribute -> cabsloc -> name (* A variable declarator ("name") with an initializer *) -with init_name := +with init_name := | Init_name : name -> init_expression -> init_name (* diff --git a/cparser/Cabshelper.ml b/cparser/Cabshelper.ml index 5e6a19d0..890679b4 100644 --- a/cparser/Cabshelper.ml +++ b/cparser/Cabshelper.ml @@ -16,8 +16,8 @@ open Cabs -let cabslu = {lineno = -10; - filename = "cabs loc unknown"; +let cabslu = {lineno = -10; + filename = "cabs loc unknown"; byteno = -10; ident = 0} diff --git a/cparser/Ceval.ml b/cparser/Ceval.ml index ba7cdabc..74b535d4 100644 --- a/cparser/Ceval.ml +++ b/cparser/Ceval.ml @@ -124,7 +124,7 @@ let comparison env direction ptraction tyop ty1 v1 ty2 v2 = (* tyop = type at which the comparison is done *) let b = match cast env tyop ty1 v1, cast env tyop ty2 v2 with - | I n1, I n2 -> + | I n1, I n2 -> if is_signed env tyop then direction (compare n1 n2) 0 else direction (int64_unsigned_compare n1 n2) 0 (* including pointers *) @@ -162,7 +162,7 @@ let binop env op tyop tyres ty1 v1 ty2 v2 = end | Odiv -> begin match cast env tyop ty1 v1, cast env tyop ty2 v2 with - | I n1, I n2 -> + | I n1, I n2 -> if n2 = 0L then raise Notconst else if is_signed env tyop then I (Int64.div n1 n2) else I (int64_unsigned_div n1 n2) @@ -170,7 +170,7 @@ let binop env op tyop tyres ty1 v1 ty2 v2 = end | Omod -> begin match v1, v2 with - | I n1, I n2 -> + | I n1, I n2 -> if n2 = 0L then raise Notconst else if is_signed env tyop then I (Int64.rem n1 n2) else I (int64_unsigned_mod n1 n2) @@ -220,11 +220,11 @@ let binop env op tyop tyres ty1 v1 ty2 v2 = | Ocomma -> v2 | Ologand -> - if boolean_value v1 + if boolean_value v1 then if boolean_value v2 then I 1L else I 0L else I 0L | Ologor -> - if boolean_value v1 + if boolean_value v1 then I 1L else if boolean_value v2 then I 1L else I 0L | _ -> raise Notconst diff --git a/cparser/Cleanup.ml b/cparser/Cleanup.ml index c81fd498..c8a900d5 100644 --- a/cparser/Cleanup.ml +++ b/cparser/Cleanup.ml @@ -92,7 +92,7 @@ let rec add_stmt s = | Sbreak -> () | Scontinue -> () | Sswitch(e, s1) -> add_exp e; add_stmt s1 - | Slabeled(lbl, s) -> + | Slabeled(lbl, s) -> begin match lbl with Scase e -> add_exp e | _ -> () end; add_stmt s | Sgoto lbl -> () @@ -187,7 +187,7 @@ let saturate p = let remove_unused_debug = function | Gdecl (_,id,_,_) -> Debug.remove_unused id | Gfundef f -> Debug.remove_unused f.fd_name - | _ -> () + | _ -> () let rec simpl_globdecls accu = function | [] -> accu @@ -212,6 +212,6 @@ let program p = let p' = simpl_globdecls [] p in referenced := IdentSet.empty; p' - + diff --git a/cparser/Cprint.ml b/cparser/Cprint.ml index 1af5af1e..e80a4c8e 100644 --- a/cparser/Cprint.ml +++ b/cparser/Cprint.ml @@ -81,7 +81,7 @@ let const pp = function if c >= 32L && c <= 126L && c <> 34L && c <>92L then fprintf pp "%c" (Char.chr (Int64.to_int c)) else fprintf pp "\" \"\\x%02Lx\" \"" c) - l; + l; fprintf pp "\"" | CEnum(id, v) -> ident pp id @@ -216,7 +216,7 @@ let rec exp pp (prec, a) = if assoc = LtoR then (prec', prec' + 1) else (prec' + 1, prec') in - if prec' < prec + if prec' < prec then fprintf pp "@[<hov 2>(" else fprintf pp "@[<hov 2>"; begin match a.edesc with @@ -329,7 +329,7 @@ let rec exp pp (prec, a) = begin match al with | [] -> () | a1 :: al -> - fprintf pp "%a" exp (2, a1); + fprintf pp "%a" exp (2, a1); List.iter (fun a -> fprintf pp ",@ %a" exp (2, a)) al end; fprintf pp ")@]" @@ -394,7 +394,7 @@ exception Not_expr let rec exp_of_stmt s = match s.sdesc with | Sdo e -> e - | Sseq(s1, s2) -> + | Sseq(s1, s2) -> {edesc = EBinop(Ocomma, exp_of_stmt s1, exp_of_stmt s2, TVoid []); etyp = TVoid []} | Sif(e, s1, s2) -> diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 0def347f..074a0802 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -44,7 +44,7 @@ let rec add_attributes (al1: attributes) (al2: attributes) = else if a1 > a2 then a2 :: add_attributes al1 al2' else a1 :: add_attributes al1' al2' -let rec remove_attributes (al1: attributes) (al2: attributes) = +let rec remove_attributes (al1: attributes) (al2: attributes) = (* viewed as sets: al1 \ al2 *) match al1, al2 with | [], _ -> [] @@ -91,7 +91,7 @@ let attr_is_type_related = function | Attr(("packed" | "__packed__"), _) -> true | _ -> false -(* Is an attribute applicable to a whole array (true) or only to +(* Is an attribute applicable to a whole array (true) or only to array elements (false)? *) let attr_array_applicable = function @@ -114,10 +114,10 @@ let rec add_attributes_type attr t = | TInt(ik, a) -> TInt(ik, add_attributes attr a) | TFloat(fk, a) -> TFloat(fk, add_attributes attr a) | TPtr(ty, a) -> TPtr(ty, add_attributes attr a) - | TArray(ty, sz, a) -> + | TArray(ty, sz, a) -> let (attr_arr, attr_elt) = List.partition attr_array_applicable attr in TArray(add_attributes_type attr_elt ty, sz, add_attributes attr_arr a) - | TFun(ty, params, vararg, a) -> TFun(ty, params, vararg, add_attributes attr + | TFun(ty, params, vararg, a) -> TFun(ty, params, vararg, add_attributes attr a) | TNamed(s, a) -> TNamed(s, add_attributes attr a) | TStruct(s, a) -> TStruct(s, add_attributes attr a) @@ -144,7 +144,7 @@ let rec attributes_of_type env t = | TArray(ty, sz, a) -> add_attributes a (attributes_of_type env ty) | TFun(ty, params, vararg, a) -> a | TNamed(s, a) -> attributes_of_type env (unroll env t) - | TStruct(s, a) -> + | TStruct(s, a) -> let ci = Env.find_struct env s in add_attributes ci.ci_attr a | TUnion(s, a) -> let ci = Env.find_union env s in add_attributes ci.ci_attr a @@ -264,9 +264,9 @@ let combine_types mode env t1 t2 = | _, TNamed _ -> comp m t1 (unroll env t2) | TStruct(s1, a1), TStruct(s2, a2) -> TStruct(comp_base s1 s2, comp_attr m a1 a2) - | TUnion(s1, a1), TUnion(s2, a2) -> + | TUnion(s1, a1), TUnion(s2, a2) -> TUnion(comp_base s1 s2, comp_attr m a1 a2) - | TEnum(s1, a1), TEnum(s2, a2) -> + | TEnum(s1, a1), TEnum(s2, a2) -> TEnum(comp_base s1 s2, comp_attr m a1 a2) | _, _ -> raise Incompat @@ -334,7 +334,7 @@ let pack_bitfields ml = in let (nbits, ml') = pack 0 ml in let (sz, al) = - (* A lone bitfield of width 0 consumes no space and aligns to 1 *) + (* A lone bitfield of width 0 consumes no space and aligns to 1 *) if nbits = 0 then (0, 1) else if nbits <= 8 then (1, 1) else if nbits <= 16 then (2, 2) else @@ -445,7 +445,7 @@ let rec sizeof env t = | TEnum(_, _) -> Some(sizeof_ikind enum_ikind) (* Compute the size of a union. - It is the size is the max of the sizes of fields. + It is the size is the max of the sizes of fields. Not done here but in composite_info_decl: rounding size to alignment. *) let sizeof_union env members = @@ -497,7 +497,7 @@ let struct_layout env members = end | m :: rem -> match alignof env m.fld_typ, sizeof env m.fld_typ with - | Some a, Some s -> + | Some a, Some s -> let offset = align ofs a in struct_layout_rec ((m.fld_name,offset)::mem) (offset + s) rem | _, _ -> [] @@ -538,11 +538,11 @@ let composite_info_def env su attr m = let int_representable v nbits sgn = if nbits >= 64 then true else - if sgn then + if sgn then let p = Int64.shift_left 1L (nbits - 1) in Int64.neg p <= v && v < p else 0L <= v && v < Int64.shift_left 1L nbits - + (* Type of a function definition *) let fundef_typ fd = @@ -667,9 +667,9 @@ let pointer_decay env t = | TFun _ as ty -> TPtr(ty, []) | t -> t -(* The usual unary conversions (H&S 6.3.3) *) +(* The usual unary conversions (H&S 6.3.3) *) -let unary_conversion env t = +let unary_conversion env t = match unroll env t with (* Promotion of small integer types *) | TInt(kind, attr) -> @@ -732,7 +732,7 @@ let binary_conversion env t1 t2 = (* Conversion on function arguments (with protoypes) *) -let argument_conversion env t = +let argument_conversion env t = (* Arrays and functions degrade automatically to pointers *) (* Other types are not changed *) match unroll env t with @@ -928,7 +928,7 @@ let rec eaddrof e = match e.edesc with | EUnop(Oderef, e1) -> e1 | EBinop(Ocomma, e1, e2, _) -> ecomma e1 (eaddrof e2) - | EConditional(e1, e2, e3) -> + | EConditional(e1, e2, e3) -> { edesc = EConditional(e1, eaddrof e2, eaddrof e3); etyp = TPtr(e.etyp, []) } | _ -> { edesc = EUnop(Oaddrof, e); etyp = TPtr(e.etyp, []) } @@ -1050,7 +1050,7 @@ let rec subst_stmt phi s = | Sblock sl -> Sblock (List.map (subst_stmt phi) sl) | Sdecl d -> Sdecl (subst_decl phi d) | Sasm(attr, template, outputs, inputs, clob) -> - let subst_asm_operand (lbl, cstr, e) = + let subst_asm_operand (lbl, cstr, e) = (lbl, cstr, subst_expr phi e) in Sasm(attr, template, List.map subst_asm_operand outputs, diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli index a322bfb1..ef1266d5 100644 --- a/cparser/Cutil.mli +++ b/cparser/Cutil.mli @@ -65,7 +65,7 @@ type attr_handling = | AttrIgnoreAll val compatible_types : attr_handling -> Env.t -> typ -> typ -> bool - (* Check that the two given types are compatible. + (* Check that the two given types are compatible. The attributes in the types are compared according to the first argument: - [AttrCompat]: the types must have the same standard attributes ([const], [volatile], [restrict]) but may differ on custom attributes. @@ -225,7 +225,7 @@ val ecommalist : exp list -> exp -> exp val sskip: stmt (* The [skip] statement. No location. *) val sseq : location -> stmt -> stmt -> stmt - (* Return the statement [s1; s2], optimizing the cases + (* Return the statement [s1; s2], optimizing the cases where [s1] or [s2] is [skip], or [s2] is a block. *) val sassign : location -> exp -> exp -> stmt (* Return the statement [exp1 = exp2;] *) diff --git a/cparser/Elab.ml b/cparser/Elab.ml index 4d3d1d02..0e445b9d 100644 --- a/cparser/Elab.ml +++ b/cparser/Elab.ml @@ -103,7 +103,7 @@ let elab_funbody_f : (C.typ -> Env.t -> statement -> C.stmt) ref (** * Elaboration of constants - C99 section 6.4.4 *) -let has_suffix s suff = +let has_suffix s suff = let ls = String.length s and lsuff = String.length suff in ls >= lsuff && String.sub s (ls - lsuff) lsuff = suff @@ -111,7 +111,7 @@ let chop_last s n = assert (String.length s >= n); String.sub s 0 (String.length s - n) -let has_prefix s pref = +let has_prefix s pref = let ls = String.length s and lpref = String.length pref in ls >= lpref && String.sub s 0 lpref = pref @@ -195,7 +195,7 @@ let elab_int_constant loc s0 = in (* Find smallest allowable type that fits *) let ty = - try List.find (fun ty -> integer_representable v ty) + try List.find (fun ty -> integer_representable v ty) (if base = 10 then dec_kinds else hex_kinds) with Not_found -> error loc "integer literal '%s' cannot be represented" s0; @@ -224,7 +224,7 @@ let elab_char_constant loc wide chars = let max_digit = Int64.shift_left 1L nbits in let max_val = Int64.shift_left 1L (64 - nbits) in let v = - List.fold_left + List.fold_left (fun acc d -> if acc < 0L || acc >= max_val then error loc "character constant overflows"; @@ -243,7 +243,7 @@ let elab_char_constant loc wide chars = IInt) let elab_string_literal loc wide chars = - let nbits = if wide then 8 * !config.sizeof_wchar else 8 in + let nbits = if wide then 8 * !config.sizeof_wchar else 8 in let char_max = Int64.shift_left 1L nbits in List.iter (fun c -> @@ -390,7 +390,7 @@ let rec elab_specifier ?(only = false) loc env specifier = let sto = ref Storage_default and inline = ref false and attr = ref [] - and tyspecs = ref [] + and tyspecs = ref [] and typedef = ref false in let do_specifier = function @@ -404,7 +404,7 @@ let rec elab_specifier ?(only = false) loc env specifier = | STATIC -> sto := Storage_static | EXTERN -> sto := Storage_extern | REGISTER -> sto := Storage_register - | TYPEDEF -> + | TYPEDEF -> if !typedef then error loc "multiple uses of 'typedef'"; typedef := true @@ -590,7 +590,7 @@ and elab_name env spec (Name (id, decl, attr, loc)) = let (sto, inl, tydef, bty, env') = elab_specifier loc env spec in if tydef then error loc "'typedef' is forbidden here"; - let (ty, env'') = elab_type_declarator loc env' bty decl in + let (ty, env'') = elab_type_declarator loc env' bty decl in let a = elab_attributes env attr in (id, sto, inl, add_attributes_type a ty, env'') @@ -605,7 +605,7 @@ and elab_name_group loc env (spec, namelist) = error loc "'inline' is forbidden here"; let elab_one_name env (Name (id, decl, attr, loc)) = let (ty, env1) = - elab_type_declarator loc env bty decl in + elab_type_declarator loc env bty decl in let a = elab_attributes env attr in ((id, add_attributes_type a ty), env1) in (mmap elab_one_name env' namelist, sto) @@ -617,7 +617,7 @@ and elab_init_name_group loc env (spec, namelist) = elab_specifier ~only:(namelist=[]) loc env spec in let elab_one_name env (Init_name (Name (id, decl, attr, loc), init)) = let (ty, env1) = - elab_type_declarator loc env bty decl in + elab_type_declarator loc env bty decl in let a = elab_attributes env attr in if inl && not (is_function_type env ty) then error loc "'inline' can only appear on functions"; @@ -681,7 +681,7 @@ and elab_field_group env (Field_group (spec, fieldlist, loc)) = error loc "bit size of '%s' is not a compile-time constant" id; None end in - { fld_name = id; fld_typ = ty; fld_bitfield = optbitsize' } + { fld_name = id; fld_typ = ty; fld_bitfield = optbitsize' } in (List.map2 elab_bitfield fieldlist names, env') @@ -818,7 +818,7 @@ and elab_enum only loc tag optmembers attrs env = let elab_type loc env spec decl = let (sto, inl, tydef, bty, env') = elab_specifier loc env spec in - let (ty, env'') = elab_type_declarator loc env' bty decl in + let (ty, env'') = elab_type_declarator loc env' bty decl in if sto <> Storage_default || inl || tydef then error loc "'typedef', 'extern', 'static', 'register' and 'inline' are meaningless in cast"; (ty, env'') @@ -977,7 +977,7 @@ module I = struct if fld.fld_name = fld1.fld_name then i else default_init env fld1.fld_typ) - end + end | (TStruct _ | TUnion _), Init_single a -> (* This is a previous whole-struct initialization that we are going to overwrite. Revert to the default initializer. *) @@ -990,7 +990,7 @@ module I = struct let index env (z, i as zi) n = match unroll env (typeof zi), i with | TArray(ty, sz, _), Init_array il -> - if n >= 0L && index_below n sz then begin + if n >= 0L && index_below n sz then begin let dfl = default_init env ty in let rec loop p before after = if p = n then @@ -1044,7 +1044,7 @@ end let rec elab_designator loc env zi desig = match desig with - | [] -> + | [] -> zi | INFIELD_INIT name :: desig' -> begin match I.member env zi name with @@ -1103,7 +1103,7 @@ let rec elab_list zi il first = and elab_item zi item il = let ty = I.typeof zi in match item, unroll env ty with - (* Special case char array = "string literal" + (* Special case char array = "string literal" or wchar array = L"wide string literal" *) | (SINGLE_INIT (CONSTANT (CONST_STRING(w, s))) | COMPOUND_INIT [_, SINGLE_INIT(CONSTANT (CONST_STRING(w, s)))]), @@ -1737,8 +1737,8 @@ let elab_expr loc env a = match args, params with | [], [] -> [] | [], _::_ -> err "not enough arguments in function call"; [] - | _::_, [] -> - if vararg + | _::_, [] -> + if vararg then args else (err "too many arguments in function call"; args) | arg1 :: argl, (_, ty_p) :: paraml -> @@ -1773,7 +1773,7 @@ let elab_for_expr loc env = function (* Handling of __func__ (section 6.4.2.2) *) -let __func__type_and_init s = +let __func__type_and_init s = (TArray(TInt(IChar, [AConst]), Some(Int64.of_int (String.length s + 1)), []), init_char_array_string None s) @@ -1894,7 +1894,7 @@ let elab_fundef env spec name body loc = (* Extract info from type *) let (ty_ret, params, vararg, attr) = match ty with - | TFun(ty_ret, Some params, vararg, attr) -> + | TFun(ty_ret, Some params, vararg, attr) -> if wrap incomplete_type loc env1 ty_ret && not (is_void_type env ty_ret) then fatal_error loc "return type is an incomplete type"; (ty_ret, params, vararg, attr) @@ -1997,7 +1997,7 @@ let rec elab_definition (local: bool) (env: Env.t) (def: Cabs.definition) (* "int x = 12, y[10], *z" *) | DECDEF(init_name_group, loc) -> - let ((dl, env1), sto, tydef) = + let ((dl, env1), sto, tydef) = elab_init_name_group loc env init_name_group in if tydef then let env2 = enter_typedefs loc env1 sto dl @@ -2101,7 +2101,7 @@ let rec elab_stmt env ctx s = if not (is_scalar_type env a'.etyp) then error loc "the condition of 'if' does not have scalar type"; let s1' = elab_stmt env ctx s1 in - let s2' = + let s2' = match s2 with | None -> sskip | Some s2 -> elab_stmt env ctx s2 @@ -2134,12 +2134,12 @@ let rec elab_stmt env ctx s = | Some (FC_DECL def) -> let (dcl, env') = elab_definition true (Env.new_scope env) def in let loc = elab_loc (get_definitionloc def) in - (sskip, env', + (sskip, env', Some(List.map (fun d -> {sdesc = Sdecl d; sloc = loc}) dcl)) in let a2' = match a2 with | None -> intconst 1L IInt - | Some a2 -> elab_expr loc env' a2 + | Some a2 -> elab_expr loc env' a2 in if not (is_scalar_type env' a2'.etyp) then error loc "the condition of 'for' does not have scalar type"; diff --git a/cparser/Env.ml b/cparser/Env.ml index 6610c159..65df6cb9 100644 --- a/cparser/Env.ml +++ b/cparser/Env.ml @@ -132,7 +132,7 @@ let lookup_struct env s = res with Not_found -> raise(Error(Unbound_tag(s, "struct"))) - + let lookup_union env s = try let (id, ci as res) = IdentMap.lookup s env.env_tag in @@ -141,7 +141,7 @@ let lookup_union env s = res with Not_found -> raise(Error(Unbound_tag(s, "union"))) - + let lookup_composite env s = try Some (IdentMap.lookup s env.env_tag) with Not_found -> None @@ -191,7 +191,7 @@ let find_union env id = ci with Not_found -> raise(Error(Unbound_tag(id.name, "union"))) - + let find_member ci m = List.find (fun f -> f.fld_name = m) ci @@ -258,7 +258,7 @@ let add_typedef env id info = let add_enum env id info = let add_enum_item env (id, v, exp) = { env with env_ident = IdentMap.add id (II_enum v) env.env_ident } in - List.fold_left add_enum_item + List.fold_left add_enum_item { env with env_enum = IdentMap.add id info env.env_enum } info.ei_members @@ -270,12 +270,12 @@ let composite_tag_name name = if name = "" then "<anonymous>" else name let error_message = function - | Unbound_identifier name -> + | Unbound_identifier name -> sprintf "Unbound identifier '%s'" name | Unbound_tag(name, kind) -> sprintf "Unbound %s '%s'" kind (composite_tag_name name) | Tag_mismatch(name, expected, actual) -> - sprintf "'%s' was declared as a %s but is used as a %s" + sprintf "'%s' was declared as a %s but is used as a %s" (composite_tag_name name) actual expected | Unbound_typedef name -> sprintf "Unbound typedef '%s'" name diff --git a/cparser/ExtendedAsm.ml b/cparser/ExtendedAsm.ml index 05084561..94fcda31 100644 --- a/cparser/ExtendedAsm.ml +++ b/cparser/ExtendedAsm.ml @@ -18,7 +18,7 @@ (* The [transf_asm] function in this module takes a full GCC-style extended asm statement and puts it in the form supported by CompCert, namely: - - 0 or 1 output of kind "r" + - 0 or 1 output of kind "r" - 0, 1 or several inputs of kind "r". Inputs and outputs of kind "m" (memory location) are emulated by taking the address of the operand and treating it as @@ -116,7 +116,7 @@ let rec transf_inputs loc env accu pos pos' subst = function transf_inputs loc env (e :: accu) (pos + 1) (pos' + 1) (set_label_reg lbl pos pos' subst) inputs end - + (* Transform the output operands: - outputs of kind "=m" become an input (equal to the address of the output) *) @@ -147,7 +147,7 @@ let transf_outputs loc env = function | outputs -> error "%aUnsupported feature: asm statement with 2 or more outputs" formatloc loc; - (* Bind the outputs so that we don't get another error + (* Bind the outputs so that we don't get another error when substituting the text *) let rec bind_outputs pos subst = function | [] -> (None, [], subst, pos, pos) @@ -165,7 +165,7 @@ let check_clobbers loc clob = || List.mem c' Machregsaux.scratch_register_names || c' = "MEMORY" || c' = "CC" then () - else error "%aError: unrecognized asm register clobber '%s'" + else error "%aError: unrecognized asm register clobber '%s'" formatloc loc c) clob @@ -174,7 +174,7 @@ let check_clobbers loc clob = let re_asm_placeholder = Str.regexp "\\(%[QR]?\\([0-9]+\\|\\[[a-zA-Z_][a-zA-Z_0-9]*\\]\\)\\|%%\\)" -let rename_placeholders loc template subst = +let rename_placeholders loc template subst = let rename p = if p = "%%" then p else try diff --git a/cparser/GCC.ml b/cparser/GCC.ml index 030f300b..f7f64a4e 100644 --- a/cparser/GCC.ml +++ b/cparser/GCC.ml @@ -65,7 +65,7 @@ let builtins = { "__builtin_acosl", (longDoubleType, [ longDoubleType ], false); "__builtin_alloca", (voidPtrType, [ uintType ], false); - + "__builtin_asin", (doubleType, [ doubleType ], false); "__builtin_asinf", (floatType, [ floatType ], false); "__builtin_asinl", (longDoubleType, [ longDoubleType ], false); @@ -76,7 +76,7 @@ let builtins = { "__builtin_atan2", (doubleType, [ doubleType; doubleType ], false); "__builtin_atan2f", (floatType, [ floatType; floatType ], false); - "__builtin_atan2l", (longDoubleType, [ longDoubleType; + "__builtin_atan2l", (longDoubleType, [ longDoubleType; longDoubleType ], false); "__builtin_ceil", (doubleType, [ doubleType ], false); @@ -133,12 +133,12 @@ let builtins = { "__builtin_frexp", (doubleType, [ doubleType; intPtrType ], false); "__builtin_frexpf", (floatType, [ floatType; intPtrType ], false); - "__builtin_frexpl", (longDoubleType, [ longDoubleType; + "__builtin_frexpl", (longDoubleType, [ longDoubleType; intPtrType ], false); "__builtin_ldexp", (doubleType, [ doubleType; intType ], false); "__builtin_ldexpf", (floatType, [ floatType; intType ], false); - "__builtin_ldexpl", (longDoubleType, [ longDoubleType; + "__builtin_ldexpl", (longDoubleType, [ longDoubleType; intType ], false); "__builtin_log", (doubleType, [ doubleType ], false); @@ -149,10 +149,10 @@ let builtins = { "__builtin_log10f", (floatType, [ floatType ], false); "__builtin_log10l", (longDoubleType, [ longDoubleType ], false); - "__builtin_modff", (floatType, [ floatType; + "__builtin_modff", (floatType, [ floatType; TPtr(floatType,[]) ], false); - "__builtin_modfl", (longDoubleType, [ longDoubleType; - TPtr(longDoubleType, []) ], + "__builtin_modfl", (longDoubleType, [ longDoubleType; + TPtr(longDoubleType, []) ], false); "__builtin_nan", (doubleType, [ charConstPtrType ], false); @@ -210,7 +210,7 @@ let builtins = { "__builtin_tanhl", (longDoubleType, [ longDoubleType ], false); "__builtin_va_end", (voidType, [ voidPtrType ], false); - "__builtin_varargs_start", + "__builtin_varargs_start", (voidType, [ voidPtrType ], false); (* When we elaborate builtin_stdarg_start/builtin_va_start, second argument is passed by address *) diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml index ca6c9da5..c163989e 100644 --- a/cparser/PackedStructs.ml +++ b/cparser/PackedStructs.ml @@ -190,7 +190,7 @@ let bswap_write loc env lhs rhs = let (id, fty) = lookup_function loc env (sprintf "__builtin_write%d_reversed" bsize) in let fn = {edesc = EVar id; etyp = fty} in - let args = [ecast_opt env (TPtr(aty,[])) (eaddrof lhs); + let args = [ecast_opt env (TPtr(aty,[])) (eaddrof lhs); ecast_opt env aty rhs] in {edesc = ECall(fn, args); etyp = TVoid[]} end else begin @@ -216,7 +216,7 @@ let transf_expr loc env ctx e = let is_byteswapped_ptr ty fieldname = match unroll env ty with | TPtr(ty', _) -> is_byteswapped ty' fieldname - | _ -> false in + | _ -> false in (* Transformation of l-values. Return transformed expr plus [true] if l-value is a byte-swapped field and [false] otherwise. *) @@ -232,7 +232,7 @@ let transf_expr loc env ctx e = let (e1', swap) = lvalue e1 in ({edesc = EBinop(Oindex, e1', e2, tyres); etyp = e.etyp}, swap) | _ -> - (texp Val e, false) + (texp Val e, false) and texp ctx e = match e.edesc with @@ -401,7 +401,7 @@ let rec transf_globdecls env accu = function let attr' = match su with | Union -> attr - | Struct -> remove_custom_attributes ["packed";"__packed__"] attr in + | Struct -> remove_custom_attributes ["packed";"__packed__"] attr in transf_globdecls (Env.add_composite env id (composite_info_decl env su attr')) ({g with gdesc = Gcompositedecl(su, id, attr')} :: accu) diff --git a/cparser/Rename.ml b/cparser/Rename.ml index b0dc120f..4b387b0d 100644 --- a/cparser/Rename.ml +++ b/cparser/Rename.ml @@ -42,20 +42,20 @@ let enter_public env id = { re_id = IdentMap.add id id env.re_id; re_public = StringMap.add id.name id env.re_public; re_used = StringSet.add id.name env.re_used } - + let enter_static env id file = try let id' = StringMap.find id.name env.re_public in { env with re_id = IdentMap.add id id' env.re_id } with Not_found -> let file = String.map (fun a -> match a with 'a'..'z' | 'A'..'Z' | '0'..'9' -> a | _ -> '_') file in - let id' = {id with name = Printf.sprintf "_%s_%s" file id.name} in + let id' = {id with name = Printf.sprintf "_%s_%s" file id.name} in { re_id = IdentMap.add id id' env.re_id; re_public = env.re_public; re_used = StringSet.add id'.name env.re_used } (* For static or local identifiers, we make up a new name if needed *) -(* If the same identifier has already been declared, +(* If the same identifier has already been declared, don't rename a second time *) let rename env id = @@ -94,7 +94,7 @@ let ident env id = try IdentMap.find id env.re_id with Not_found -> - Cerrors.fatal_error "Internal error: Rename: %s__%d unbound" + Cerrors.fatal_error "Internal error: Rename: %s__%d unbound" id.name id.stamp let rec typ env = function @@ -111,7 +111,7 @@ let rec typ env = function | ty -> ty and param env (id, ty) = - if id.name = "" then + if id.name = "" then ((id, typ env ty), env) else let (id', env') = rename env id in ((id', typ env' ty), env') @@ -216,7 +216,7 @@ let fundef env f = fd_body = stmt env2 f.fd_body }, env0 ) -let enum env (id, v, opte) = +let enum env (id, v, opte) = let (id', env') = rename env id in ((id', v, optexp env' opte), env') @@ -269,7 +269,7 @@ let rec reserve_public env file = function begin match sto with | Storage_default | Storage_extern -> enter_public env id | Storage_static -> if !Clflags.option_rename_static then - enter_static env id file + enter_static env id file else env | _ -> assert false @@ -292,4 +292,4 @@ let program p file = globdecls (reserve_public (reserve_builtins()) file p) [] p - + diff --git a/cparser/StructReturn.ml b/cparser/StructReturn.ml index 5e5602f3..2c6fd1d2 100644 --- a/cparser/StructReturn.ml +++ b/cparser/StructReturn.ml @@ -71,7 +71,7 @@ let classify_param env ty = | SP_ref_caller -> Param_ref_caller | _ -> match sizeof env ty, alignof env ty with - | Some sz, Some al -> + | Some sz, Some al -> Param_flattened ((sz + 3) / 4, sz, al) | _, _ -> Param_unchanged (* should not happen *) @@ -306,7 +306,7 @@ let rec transf_expr env ctx e = We used to do a copy optimization: ctx = Effects: lv = f(...) -> f(&lv, ...) - but it is not correct in case of overlap (see test/regression/struct12.c) + but it is not correct in case of overlap (see test/regression/struct12.c) Function calls returning a composite by value: ctx = Effects: lv = f(...) -> newtemp = f(...), lv = newtemp @@ -521,8 +521,8 @@ let rec transf_funparams loc env params = let tpx = TPtr(tx', []) in let ex = { edesc = EVar x; etyp = tpx } in let estarx = { edesc = EUnop(Oderef, ex); etyp = tx' } in - ((x, tpx) :: params', - actions, + ((x, tpx) :: params', + actions, IdentMap.add x estarx subst) | Param_flattened(n, sz, al) -> let y = new_temp ~name:x.name (ty_buffer n) in @@ -562,7 +562,7 @@ let transf_fundef env f = | Ret_value(ty, sz, al) -> (f.fd_attrib, ty, - params, + params, transf_funbody env (subst_stmt subst f.fd_body) None) in let temps = get_temps() in {f with fd_attrib = attr1; diff --git a/cparser/Transform.ml b/cparser/Transform.ml index 6cdd8a6b..840234b8 100644 --- a/cparser/Transform.ml +++ b/cparser/Transform.ml @@ -81,7 +81,7 @@ let op_for_assignop = function | Odiv_assign -> Odiv | Omod_assign -> Omod | Oand_assign -> Oand - | Oor_assign -> Oor + | Oor_assign -> Oor | Oxor_assign -> Oxor | Oshl_assign -> Oshl | Oshr_assign -> Oshr @@ -118,7 +118,7 @@ let expand_assignop ~read ~write env ctx op l r ty = ecomma (eassign tmp res) (ecomma (write l tmp) tmp)) let expand_preincrdecr ~read ~write env ctx op l = - expand_assignop ~read ~write env ctx (assignop_for_incr_decr op) + expand_assignop ~read ~write env ctx (assignop_for_incr_decr op) l (intconst 1L IInt) (unary_conversion env l.etyp) let expand_postincrdecr ~read ~write env ctx op l = @@ -147,7 +147,7 @@ let stmt ~expr ?(decl = fun env decl -> assert false) env s = | Sskip -> s | Sdo e -> {s with sdesc = Sdo(expr s.sloc env Effects e)} - | Sseq(s1, s2) -> + | Sseq(s1, s2) -> {s with sdesc = Sseq(stm s1, stm s2)} | Sif(e, s1, s2) -> {s with sdesc = Sif(expr s.sloc env Val e, stm s1, stm s2)} diff --git a/cparser/Transform.mli b/cparser/Transform.mli index 57a4737b..a04896a9 100644 --- a/cparser/Transform.mli +++ b/cparser/Transform.mli @@ -64,11 +64,11 @@ val fundef : (Env.t -> C.stmt -> C.stmt) -> Env.t -> C.fundef -> C.fundef val program : ?decl:(Env.t -> C.decl -> C.decl) -> ?fundef:(Env.t -> C.fundef -> C.fundef) -> - ?composite:(Env.t -> C.struct_or_union -> - C.ident -> C.attributes -> C.field list -> + ?composite:(Env.t -> C.struct_or_union -> + C.ident -> C.attributes -> C.field list -> C.attributes * C.field list) -> ?typedef:(Env.t -> C.ident -> C.typ -> C.typ) -> - ?enum:(Env.t -> C.ident -> C.attributes -> C.enumerator list -> + ?enum:(Env.t -> C.ident -> C.attributes -> C.enumerator list -> C.attributes * C.enumerator list) -> ?pragma:(Env.t -> string -> string) -> C.program -> diff --git a/cparser/Unblock.ml b/cparser/Unblock.ml index c6646b5c..405cf755 100644 --- a/cparser/Unblock.ml +++ b/cparser/Unblock.ml @@ -49,7 +49,7 @@ let rec local_initializer env path init k = | Init_struct(id, fil) -> let field_init (fld, i) k = local_initializer env - { edesc = EUnop(Odot fld.fld_name, path); etyp = fld.fld_typ } + { edesc = EUnop(Odot fld.fld_name, path); etyp = fld.fld_typ } i k in List.fold_right field_init fil k | Init_union(id, fld, i) -> @@ -80,7 +80,7 @@ let add_inits_expr inits e = let local_variables = ref ([]: decl list) let global_variables = ref ([]: decl list) -(* Note: "const int x = y - 1;" is legal, but we turn it into +(* Note: "const int x = y - 1;" is legal, but we turn it into "const int x; x = y - 1;", which is not. Therefore, remove top-level 'const' attribute. Also remove it on element type of array type. *) @@ -128,7 +128,7 @@ let rec expand_expr islocal env e = let e2' = match op with | Ocomma | Ologand | Ologor -> expand_expr islocal env e2 - (* Make sure the initializers of [e2] are performed in + (* Make sure the initializers of [e2] are performed in sequential order, i.e. just before [e2] but after [e1]. *) | _ -> expand e2 in {edesc = EBinop(op, e1', e2', ty); etyp = e.etyp} @@ -148,7 +148,7 @@ let rec expand_expr islocal env e = e' | ECall(e1, el) -> {edesc = ECall(expand e1, List.map expand el); etyp = e.etyp} - in + in let e' = expand e in ecommalist !inits e' (* Elimination of compound literals within an initializer. *) @@ -185,7 +185,7 @@ let debug_ty = let debug_annot kind args = { sloc = no_loc; - sdesc = Sdo { + sdesc = Sdo { etyp = TVoid []; edesc = ECall({edesc = EVar debug_id; etyp = debug_ty}, intconst kind IInt :: args) @@ -276,12 +276,12 @@ let rec unblock_stmt env ctx ploc s = | Sseq(s1, s2) -> {s with sdesc = Sseq(unblock_stmt env ctx ploc s1, unblock_stmt env ctx s1.sloc s2)} - | Sif(e, s1, s2) -> + | Sif(e, s1, s2) -> add_lineno ctx ploc s.sloc {s with sdesc = Sif(expand_expr true env e, unblock_stmt env ctx s.sloc s1, unblock_stmt env ctx s.sloc s2)} - | Swhile(e, s1) -> + | Swhile(e, s1) -> add_lineno ctx ploc s.sloc {s with sdesc = Swhile(expand_expr true env e, unblock_stmt env ctx s.sloc s1)} @@ -301,7 +301,7 @@ let rec unblock_stmt env ctx ploc s = add_lineno ctx ploc s.sloc {s with sdesc = Sswitch(expand_expr true env e, unblock_stmt env ctx s.sloc s1)} - | Slabeled(lbl, s1) -> + | Slabeled(lbl, s1) -> add_lineno ctx ploc s.sloc {s with sdesc = Slabeled(lbl, unblock_stmt env ctx s.sloc s1)} | Sgoto lbl -> @@ -309,7 +309,7 @@ let rec unblock_stmt env ctx ploc s = | Sreturn None -> add_lineno ctx ploc s.sloc s | Sreturn (Some e) -> - add_lineno ctx ploc s.sloc + add_lineno ctx ploc s.sloc {s with sdesc = Sreturn(Some (expand_expr true env e))} | Sblock sl -> let ctx' = @@ -327,7 +327,7 @@ let rec unblock_stmt env ctx ploc s = | Sasm(attr, template, outputs, inputs, clob) -> let expand_asm_operand (lbl, cstr, e) = (lbl, cstr, expand_expr true env e) in - add_lineno ctx ploc s.sloc + add_lineno ctx ploc s.sloc {s with sdesc = Sasm(attr, template, List.map expand_asm_operand outputs, List.map expand_asm_operand inputs, clob)} diff --git a/cparser/validator/Alphabet.v b/cparser/validator/Alphabet.v index 85a1689d..13718cd5 100644 --- a/cparser/validator/Alphabet.v +++ b/cparser/validator/Alphabet.v @@ -193,7 +193,7 @@ Program Instance NumberedAlphabet {A:Type} (N:Numbered A) : Alphabet A := { AlphabetComparable := {| compare := fun x y => compare31 (inj x) (inj y) |}; AlphabetFinite := - {| all_list := fst (iter_int31 inj_bound _ + {| all_list := fst (iter_int31 inj_bound _ (fun p => (cons (surj (snd p)) (fst p), incr (snd p))) ([], 0%int31)) |} }. Next Obligation. apply Zcompare_antisym. Qed. Next Obligation. @@ -229,7 +229,7 @@ rewrite <- surj_inj_compat, <- phi_inv_phi with (inj x0), H0, phi_inv_phi; refle replace (Zsucc (phi i)) with (2 ^ Z_of_nat size)%Z in H0 by omega. rewrite Z_mod_same_full in H0. exfalso; omega. -exfalso; inversion Heqp; subst; +exfalso; inversion Heqp; subst; pose proof (phi_bounded (inj x)); change (phi 0) with 0%Z in H; omega. clear H. rewrite <- phi_inv_phi with i, <- phi_inv_phi with inj_bound; f_equal. diff --git a/cparser/validator/Automaton.v b/cparser/validator/Automaton.v index b15f87d2..98ab1246 100644 --- a/cparser/validator/Automaton.v +++ b/cparser/validator/Automaton.v @@ -113,7 +113,7 @@ Module Types(Import Init:AutInit). (** Types used for the annotations of the automaton. **) (** An item is a part of the annotations given to the validator. - It is acually a set of LR(1) items sharing the same core. It is needed + It is acually a set of LR(1) items sharing the same core. It is needed to validate completeness. **) Record item := { (** The pseudo-production of the item. **) @@ -136,7 +136,7 @@ Module Type T. Parameter start_nt: initstate -> nonterminal. (** The action table maps a state to either a map terminal -> action. **) - Parameter action_table: + Parameter action_table: state -> action. (** The goto table of an LR(1) automaton. **) Parameter goto_table: state -> forall nt:nonterminal, diff --git a/cparser/validator/Grammar.v b/cparser/validator/Grammar.v index d162892d..0768d647 100644 --- a/cparser/validator/Grammar.v +++ b/cparser/validator/Grammar.v @@ -96,8 +96,8 @@ Module Defs(Import G:T). Definition token := {t:terminal & symbol_semantic_type (T t)}. (** A grammar creates a relation between word of tokens and semantic values. - This relation is parametrized by the head symbol. It defines the - "semantics" of the grammar. This relation is defined by a notion of + This relation is parametrized by the head symbol. It defines the + "semantics" of the grammar. This relation is defined by a notion of parse tree. **) Inductive parse_tree: forall (head_symbol:symbol) (word:list token) @@ -110,9 +110,9 @@ Module Defs(Import G:T). parse_tree (T t) [existT (fun t => symbol_semantic_type (T t)) t sem] sem - (** Given a production, if a word has a list of semantic values for the - right hand side as head symbols, then this word has the semantic value - given by the semantic action of the production for the left hand side + (** Given a production, if a word has a list of semantic values for the + right hand side as head symbols, then this word has the semantic value + given by the semantic action of the production for the left hand side as head symbol.**) | Non_terminal_pt: forall {p:production} {word:list token} @@ -152,7 +152,7 @@ Module Defs(Import G:T). Fixpoint pt_size {head_symbol word sem} (tree:parse_tree head_symbol word sem) := - match tree with + match tree with | Terminal_pt _ _ => 1 | Non_terminal_pt _ _ _ l => S (ptl_size l) end diff --git a/cparser/validator/Interpreter.v b/cparser/validator/Interpreter.v index 16be3859..2242065c 100644 --- a/cparser/validator/Interpreter.v +++ b/cparser/validator/Interpreter.v @@ -98,7 +98,7 @@ Fixpoint pop (symbols_to_pop:list symbol) (stack_cur:stack): result (stack * A) := match symbols_to_pop return forall {A:Type} (action:arrows_right A (map _ symbols_to_pop)), _ with | [] => fun A action => OK (stack_cur, action) - | t::q => fun A action => + | t::q => fun A action => match stack_cur with | existT state_cur sem::stack_rec => match compare_eqdec (last_symb_of_non_init_state state_cur) t with diff --git a/cparser/validator/Interpreter_complete.v b/cparser/validator/Interpreter_complete.v index 3b922f7d..3d564c11 100644 --- a/cparser/validator/Interpreter_complete.v +++ b/cparser/validator/Interpreter_complete.v @@ -102,7 +102,7 @@ Variable buffer_end: Stream token. Variable full_sem: symbol_semantic_type (NT (start_nt init)). Inductive pt_zipper: - forall (hole_symb:symbol) (hole_word:list token) + forall (hole_symb:symbol) (hole_word:list token) (hole_sem:symbol_semantic_type hole_symb), Type := | Top_ptz: pt_zipper (NT (start_nt init)) (full_word) (full_sem) @@ -115,7 +115,7 @@ Inductive pt_zipper: {wordq:list token} {semantic_valuesq:tuple (map symbol_semantic_type head_symbolsq)}, parse_tree_list head_symbolsq wordq semantic_valuesq -> - + ptl_zipper (head_symbolt::head_symbolsq) (wordt++wordq) (semantic_valuet,semantic_valuesq) -> @@ -134,11 +134,11 @@ with ptl_zipper: {wordt:list token} {semantic_valuet:symbol_semantic_type head_symbolt}, parse_tree head_symbolt wordt semantic_valuet -> - + forall {head_symbolsq:list symbol} {wordq:list token} {semantic_valuesq:tuple (map symbol_semantic_type head_symbolsq)}, - + ptl_zipper (head_symbolt::head_symbolsq) (wordt++wordq) (semantic_valuet,semantic_valuesq) -> @@ -275,7 +275,7 @@ Fixpoint build_pt_dot {hole_symbs hole_word hole_sems} (ptlz:ptl_zipper hole_symbs hole_word hole_sems) :pt_dot := match ptl in parse_tree_list hole_symbs hole_word hole_sems - return ptl_zipper hole_symbs hole_word hole_sems -> _ + return ptl_zipper hole_symbs hole_word hole_sems -> _ with | Nil_ptl => fun ptlz => Reduce_ptd ptlz @@ -292,7 +292,7 @@ Fixpoint build_pt_dot {hole_symbs hole_word hole_sems} end ptlz. Lemma build_pt_dot_cost: - forall hole_symbs hole_word hole_sems + forall hole_symbs hole_word hole_sems (ptl:parse_tree_list hole_symbs hole_word hole_sems) (ptlz:ptl_zipper hole_symbs hole_word hole_sems), ptd_cost (build_pt_dot ptl ptlz) = ptl_size ptl + ptlz_cost ptlz. @@ -307,7 +307,7 @@ simpl; rewrite <- plus_n_Sm, plus_assoc; reflexivity. Qed. Lemma build_pt_dot_buffer: - forall hole_symbs hole_word hole_sems + forall hole_symbs hole_word hole_sems (ptl:parse_tree_list hole_symbs hole_word hole_sems) (ptlz:ptl_zipper hole_symbs hole_word hole_sems), ptd_buffer (build_pt_dot ptl ptlz) = hole_word ++ ptlz_buffer ptlz. @@ -321,7 +321,7 @@ simpl; rewrite build_pt_dot_buffer. apply app_str_app_assoc. Qed. -Lemma ptd_stack_compat_build_pt_dot: +Lemma ptd_stack_compat_build_pt_dot: forall hole_symbs hole_word hole_sems (ptl:parse_tree_list hole_symbs hole_word hole_sems) (ptlz:ptl_zipper hole_symbs hole_word hole_sems) @@ -354,8 +354,8 @@ Program Fixpoint pop_ptlz {hole_symbs hole_word hole_sems} { word:_ & { sem:_ & (pt_zipper (NT (prod_lhs (ptlz_prod ptlz))) word sem * parse_tree (NT (prod_lhs (ptlz_prod ptlz))) word sem)%type } } := - match ptlz in ptl_zipper hole_symbs hole_word hole_sems - return parse_tree_list hole_symbs hole_word hole_sems -> + match ptlz in ptl_zipper hole_symbs hole_word hole_sems + return parse_tree_list hole_symbs hole_word hole_sems -> { word:_ & { sem:_ & (pt_zipper (NT (prod_lhs (ptlz_prod ptlz))) word sem * parse_tree (NT (prod_lhs (ptlz_prod ptlz))) word sem)%type } } @@ -368,7 +368,7 @@ Program Fixpoint pop_ptlz {hole_symbs hole_word hole_sems} end ptl. Lemma pop_ptlz_cost: - forall hole_symbs hole_word hole_sems + forall hole_symbs hole_word hole_sems (ptl:parse_tree_list hole_symbs hole_word hole_sems) (ptlz:ptl_zipper hole_symbs hole_word hole_sems), let 'existT word (existT sem (ptz, pt)) := pop_ptlz ptl ptlz in @@ -381,7 +381,7 @@ simpl; apply pop_ptlz_cost. Qed. Lemma pop_ptlz_buffer: - forall hole_symbs hole_word hole_sems + forall hole_symbs hole_word hole_sems (ptl:parse_tree_list hole_symbs hole_word hole_sems) (ptlz:ptl_zipper hole_symbs hole_word hole_sems), let 'existT word (existT sem (ptz, pt)) := pop_ptlz ptl ptlz in @@ -414,14 +414,14 @@ Lemma pop_ptlz_pop_stack_compat: (stack:stack), ptlz_stack_compat ptlz stack -> - - let action' := - eq_rect _ (fun x=>x) (prod_action (ptlz_prod ptlz)) _ + + let action' := + eq_rect _ (fun x=>x) (prod_action (ptlz_prod ptlz)) _ (pop_ptlz_pop_stack_compat_converter _ _ _ _ _) in let 'existT word (existT sem (ptz, pt)) := pop_ptlz ptl ptlz in match pop (ptlz_past ptlz) stack (uncurry action' hole_sems) with - | OK (stack', sem') => + | OK (stack', sem') => ptz_stack_compat ptz stack' /\ sem = sem' | Err => True end. @@ -503,8 +503,8 @@ pose proof (pop_ptlz_buffer _ _ _ Nil_ptl ptlz). destruct (pop_ptlz Nil_ptl ptlz) as [word [sem [ptz pt]]]. rewrite H0; clear H0. revert H. -match goal with - |- match ?p1 with Err => _ | OK _ => _ end -> match bind2 ?p2 _ with Err => _ | OK _ => _ end => +match goal with + |- match ?p1 with Err => _ | OK _ => _ end -> match bind2 ?p2 _ with Err => _ | OK _ => _ end => replace p1 with p2; [destruct p2 as [|[]]; intros|] end. assumption. @@ -610,8 +610,8 @@ Qed. Variable full_pt: parse_tree (NT (start_nt init)) full_word full_sem. Definition init_ptd := - match full_pt in parse_tree head full_word full_sem return - pt_zipper head full_word full_sem -> + match full_pt in parse_tree head full_word full_sem return + pt_zipper head full_word full_sem -> match head return Type with | T _ => unit | NT _ => pt_dot end with | Terminal_pt _ _ => fun _ => () @@ -668,7 +668,7 @@ Qed. Theorem parse_complete n_steps: match parse init (full_word ++ buffer_end) n_steps with | OK (Parsed_pr sem_res buffer_end_res) => - sem_res = full_sem /\ buffer_end_res = buffer_end /\ + sem_res = full_sem /\ buffer_end_res = buffer_end /\ pt_size full_pt <= n_steps | OK Fail_pr => False | OK Timeout_pr => n_steps < pt_size full_pt diff --git a/cparser/validator/Interpreter_correct.v b/cparser/validator/Interpreter_correct.v index 095b26ca..3a285158 100644 --- a/cparser/validator/Interpreter_correct.v +++ b/cparser/validator/Interpreter_correct.v @@ -68,7 +68,7 @@ Qed. Lemma pop_invariant: forall (symbols_to_pop symbols_popped:list symbol) (stack_cur:stack) - (A:Type) + (A:Type) (action:arrows_left (map symbol_semantic_type (rev_append symbols_to_pop symbols_popped)) A), forall word_stack word_popped, forall sem_popped, @@ -96,12 +96,12 @@ destruct e; simpl. dependent destruction H. destruct H0, H1. apply (Cons_ptl X), inhabits in X0. specialize (IHsymbols_to_pop _ _ _ action0 _ _ _ H X0). -match goal with +match goal with IHsymbols_to_pop:match ?p1 with Err => _ | OK _ => _ end |- match ?p2 with Err => _ | OK _ => _ end => replace p2 with p1; [destruct p1 as [|[]]|]; intuition end. destruct IHsymbols_to_pop as [word1res [word2res [sem_full []]]]; intuition; subst. -exists word1res. +exists word1res. eexists. exists sem_full. intuition. diff --git a/cparser/validator/Validator_complete.v b/cparser/validator/Validator_complete.v index 98559305..90ab1b0c 100644 --- a/cparser/validator/Validator_complete.v +++ b/cparser/validator/Validator_complete.v @@ -497,7 +497,7 @@ Qed. (** The automaton is complete **) Definition complete := - nullable_stable /\ first_stable /\ start_future /\ terminal_shift + nullable_stable /\ first_stable /\ start_future /\ terminal_shift /\ end_reduce /\ non_terminal_goto /\ start_goto /\ non_terminal_closed. Definition is_complete (_:unit) := diff --git a/cparser/validator/Validator_safe.v b/cparser/validator/Validator_safe.v index 119f7337..c5229ac9 100644 --- a/cparser/validator/Validator_safe.v +++ b/cparser/validator/Validator_safe.v @@ -121,7 +121,7 @@ Qed. Definition goto_head_symbs := forall s nt, match goto_table s nt with - | Some (exist s2 _) => + | Some (exist s2 _) => prefix (past_symb_of_non_init_state s2) (head_symbs_of_state s) | None => True end. diff --git a/debug/Debug.ml b/debug/Debug.ml index 161ee3ed..21f8d9fd 100644 --- a/debug/Debug.ml +++ b/debug/Debug.ml @@ -20,7 +20,7 @@ open DwarfTypes (* Interface for generating and printing debug information *) (* Record used for stroring references to the actual implementation functions *) -type implem = +type implem = { mutable init: string -> unit; mutable atom_function: ident -> atom -> unit; diff --git a/debug/Debug.mli b/debug/Debug.mli index 577b0ef8..aa702971 100644 --- a/debug/Debug.mli +++ b/debug/Debug.mli @@ -18,7 +18,7 @@ open BinNums (* Record used for stroring references to the actual implementation functions *) -type implem = +type implem = { mutable init: string -> unit; mutable atom_function: ident -> atom -> unit; diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml index d1747f8e..9c5a92ba 100644 --- a/debug/DebugInformation.ml +++ b/debug/DebugInformation.ml @@ -17,7 +17,7 @@ open Camlcoq open Cutil open DebugTypes -(* This implements an interface for the collection of debugging +(* This implements an interface for the collection of debugging information. *) (* Simple id generator *) @@ -61,7 +61,7 @@ let typ_to_string (ty: typ) = (* Helper functions for the attributes *) let strip_attributes typ = - let strip = List.filter (fun a -> a = AConst || a = AVolatile) in + let strip = List.filter (fun a -> a = AConst || a = AVolatile) in match typ with | TVoid at -> TVoid (strip at) | TInt (k,at) -> TInt (k,strip at) @@ -74,11 +74,11 @@ let strip_attributes typ = | TUnion (n,at) -> TUnion(n,strip at) | TEnum (n,at) -> TEnum(n,strip at) -let strip_last_attribute typ = +let strip_last_attribute typ = let rec hd_opt l = match l with [] -> None,[] | AConst::rest -> Some AConst,rest - | AVolatile::rest -> Some AVolatile,rest + | AVolatile::rest -> Some AVolatile,rest | _::rest -> hd_opt rest in match typ with | TVoid at -> let l,r = hd_opt at in @@ -117,20 +117,20 @@ let find_type (ty: typ) = (* Add type and information *) let insert_type (ty: typ) = let insert d_ty ty = - let id = next_id () + let id = next_id () and name = typ_to_string ty in Hashtbl.add types id d_ty; Hashtbl.add lookup_types name id; id in (* We are only interrested in Const and Volatile *) let ty = strip_attributes ty in - let rec typ_aux ty = + let rec typ_aux ty = try find_type ty with | Not_found -> let d_ty = match ty with | TVoid _ -> Void - | TInt (k,_) -> + | TInt (k,_) -> IntegerType ({int_kind = k }) | TFloat (k,_) -> FloatType ({float_kind = k}) @@ -150,14 +150,14 @@ let insert_type (ty: typ) = } in ArrayType arr | TFun (t,param,va,_) -> - let param,prot = (match param with + let param,prot = (match param with | None -> [],false - | Some p -> List.map (fun (i,t) -> let t = attr_aux t in + | Some p -> List.map (fun (i,t) -> let t = attr_aux t in { param_type = t; - param_name = i.name; + param_name = i.name; }) p,true) in - let ret = (match t with + let ret = (match t with | TVoid _ -> None | _ -> Some (attr_aux t)) in let ftype = { @@ -201,7 +201,7 @@ let insert_type (ty: typ) = } in CompositeType union | TEnum (id,_) -> - let enum = + let enum = { enum_name = id.name; enum_byte_size = None; @@ -210,13 +210,13 @@ let insert_type (ty: typ) = } in EnumType enum in insert d_ty ty - and attr_aux ty = + and attr_aux ty = try find_type ty with Not_found -> match strip_last_attribute ty with - | Some AConst,t -> + | Some AConst,t -> let id = attr_aux t in let const = { cst_type = id} in insert (ConstType const) ty @@ -333,7 +333,7 @@ let replace_scope id var = let var = Scope var in Hashtbl.replace local_variables id var -let gen_comp_typ sou id at = +let gen_comp_typ sou id at = if sou = Struct then TStruct (id,at) else @@ -377,11 +377,11 @@ let insert_global_declaration env dec= end end else begin (* Implict declarations need special handling *) - let id' = try Hashtbl.find name_to_definition id.name with Not_found -> + let id' = try Hashtbl.find name_to_definition id.name with Not_found -> let id' = next_id () in Hashtbl.add name_to_definition id.name id';id' in Hashtbl.add stamp_to_definition id.stamp id' - end + end | Gfundef f -> let ret = (match f.fd_ret with | TVoid _ -> None @@ -398,7 +398,7 @@ let insert_global_declaration env dec= parameter_type = ty; }) f.fd_params in let fd = - { + { fun_name = f.fd_name.name; fun_atom = None; fun_file_loc = dec.gloc; @@ -411,19 +411,19 @@ let insert_global_declaration env dec= fun_scope = None; } in begin - let id' = try Hashtbl.find name_to_definition f.fd_name.name with Not_found -> + let id' = try Hashtbl.find name_to_definition f.fd_name.name with Not_found -> let id' = next_id () in Hashtbl.add name_to_definition f.fd_name.name id';id' in Hashtbl.add stamp_to_definition f.fd_name.stamp id'; Hashtbl.add definitions id' (Function fd) end - | Gcompositedecl (sou,id,at) -> + | Gcompositedecl (sou,id,at) -> ignore (insert_type (gen_comp_typ sou id at)); let id = find_type (gen_comp_typ sou id []) in replace_composite id (fun comp -> if comp.ct_file_loc = None then {comp with ct_file_loc = Some (dec.gloc);} else comp) - | Gcompositedef (sou,id,at,fi) -> + | Gcompositedef (sou,id,at,fi) -> ignore (insert_type (gen_comp_typ sou id at)); let id = find_type (gen_comp_typ sou id []) in let fi = List.filter (fun f -> f.fld_name <> "") fi in (* Fields without names need no info *) @@ -440,15 +440,15 @@ let insert_global_declaration env dec= replace_composite id (fun comp -> let loc = if comp.ct_file_loc = None then Some dec.gloc else comp.ct_file_loc in {comp with ct_file_loc = loc; ct_members = fields; ct_declaration = false;}) - | Gtypedef (id,t) -> + | Gtypedef (id,t) -> let id = insert_type (TNamed (id,[])) in let tid = insert_type t in replace_typedef id (fun typ -> {typ with typedef_file_loc = Some dec.gloc; typ = Some tid;}); - | Genumdef (n,at,e) -> + | Genumdef (n,at,e) -> ignore(insert_type (TEnum (n,at))); let id = find_type (TEnum (n,[])) in let enumerator = List.map (fun (i,c,_) -> - { + { enumerator_name = i.name; enumerator_const = c; }) e in @@ -459,36 +459,36 @@ let insert_global_declaration env dec= let set_member_offset str field offset = let id = find_type (TStruct (str,[])) in replace_composite id (fun comp -> - let name f = f.cfd_name = field || match f.cfd_bitfield with Some n -> n = field | _ -> false in + let name f = f.cfd_name = field || match f.cfd_bitfield with Some n -> n = field | _ -> false in let members = list_replace name (fun a -> {a with cfd_byte_offset = Some offset;}) comp.ct_members in {comp with ct_members = members;}) let set_composite_size comp sou size = let id = find_type (gen_comp_typ sou comp []) in - replace_composite id (fun comp -> {comp with ct_sizeof = size;}) + replace_composite id (fun comp -> {comp with ct_sizeof = size;}) let set_bitfield_offset str field offset underlying size = let id = find_type (TStruct (str,[])) in replace_composite id (fun comp -> let name f = f.cfd_name = field in - let members = list_replace name (fun a -> + let members = list_replace name (fun a -> {a with cfd_bit_offset = Some offset; cfd_bitfield = Some underlying; cfd_byte_size = Some size}) comp.ct_members in {comp with ct_members = members;}) -let atom_global_variable id atom = +let atom_global_variable id atom = try let id,var = find_gvar_stamp id.stamp in replace_var id ({var with gvar_atom = Some atom;}); - Hashtbl.add atom_to_definition atom id + Hashtbl.add atom_to_definition atom id with Not_found -> () - + let atom_function id atom = try let id',f = find_fun_stamp id.stamp in replace_fun id' ({f with fun_atom = Some atom;}); Hashtbl.add atom_to_definition atom id'; - Hashtbl.iter (fun (fid,sid) tid -> if fid = id.stamp then + Hashtbl.iter (fun (fid,sid) tid -> if fid = id.stamp then Hashtbl.add atom_to_scope (atom,sid) tid) scope_to_local with Not_found -> () @@ -499,7 +499,7 @@ let atom_parameter fid id atom = let params = list_replace name (fun p -> {p with parameter_atom = Some atom;}) f.fun_parameter in replace_fun fid' ({f with fun_parameter = params;}) with Not_found -> () - + let add_fun_addr atom (high,low) = try let id,f = find_fun_atom atom in @@ -516,7 +516,7 @@ let atom_local_variable id atom = let add_lvar_scope f_id var_id s_id = try let s_id',scope = find_scope_id f_id s_id in - let var_id,_ = find_lvar_stamp var_id.stamp in + let var_id,_ = find_lvar_stamp var_id.stamp in replace_scope s_id' ({scope_variables = var_id::scope.scope_variables;}) with Not_found -> () @@ -604,7 +604,7 @@ let close_scope atom s_id lbl = try let s_id = Hashtbl.find atom_to_scope (atom,s_id) in let old_r = try Hashtbl.find scope_ranges s_id with Not_found -> [] in - let last_r,rest = + let last_r,rest = begin match old_r with | a::rest -> a,rest diff --git a/debug/DebugInit.ml b/debug/DebugInit.ml index 7ee56ff1..1ab529df 100644 --- a/debug/DebugInit.ml +++ b/debug/DebugInit.ml @@ -27,7 +27,7 @@ let init_debug () = implem.set_bitfield_offset <- DebugInformation.set_bitfield_offset; implem.insert_global_declaration <- DebugInformation.insert_global_declaration; implem.add_fun_addr <- DebugInformation.add_fun_addr; - implem.generate_debug_info <- + implem.generate_debug_info <- if Configuration.system = "diab" then (fun a b -> Some (Dwarfgen.gen_diab_debug_info a b)) else diff --git a/debug/DebugTypes.mli b/debug/DebugTypes.mli index 6a4f619c..b2f19f7a 100644 --- a/debug/DebugTypes.mli +++ b/debug/DebugTypes.mli @@ -68,7 +68,7 @@ type enum_type = { enum_name: string; enum_byte_size: int option; enum_file_loc: location option; - enum_enumerators: enumerator list; + enum_enumerators: enumerator list; } type int_type = { @@ -115,7 +115,7 @@ type global_variable_information = { gvar_type: int; } -type parameter_information = +type parameter_information = { parameter_name: string; parameter_ident: int; @@ -150,7 +150,7 @@ type local_variable_information = { lvar_static: bool; (* Static variable are mapped to symbols *) } -type scope_information = +type scope_information = { scope_variables: int list; (* Variable and Scope ids *) } diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml index 1bd54470..8740d9c4 100644 --- a/debug/DwarfPrinter.ml +++ b/debug/DwarfPrinter.ml @@ -319,7 +319,7 @@ module DwarfPrinter(Target: DWARF_TARGET): print_uleb128 oc col | Some (Gnu_file_loc (file,col)) -> fprintf oc " .4byte %l\n" file; - print_uleb128 oc col + print_uleb128 oc col | None -> () let print_loc_expr oc = function @@ -407,12 +407,12 @@ module DwarfPrinter(Target: DWARF_TARGET): print_string oc bt.base_type_name let print_compilation_unit oc tag = - let version_string = + let version_string = if Version.buildnr <> "" && Version.tag <> "" then sprintf "%s, Build: %s, Tag: %s" Version.version Version.buildnr Version.tag else Version.version in - let prod_name = sprintf "AbsInt Angewandte Informatik GmbH:CompCert Version %s:(%s,%s,%s,%s)" + let prod_name = sprintf "AbsInt Angewandte Informatik GmbH:CompCert Version %s:(%s,%s,%s,%s)" version_string Configuration.arch Configuration.system Configuration.abi Configuration.model in print_string oc (Sys.getcwd ()); print_addr oc tag.compile_unit_low_pc; @@ -476,7 +476,7 @@ module DwarfPrinter(Target: DWARF_TARGET): let print_subprogram_addr oc (s,e) = fprintf oc " .4byte %a\n" label e; fprintf oc " .4byte %a\n" label s - + let print_subprogram oc sp = print_file_loc oc (Some sp.subprogram_file_loc); print_opt_value oc sp.subprogram_external print_flag; @@ -608,10 +608,10 @@ module DwarfPrinter(Target: DWARF_TARGET): let print_diab_entries oc entries = let abbrev_start = new_label () in - abbrev_start_addr := abbrev_start; + abbrev_start_addr := abbrev_start; print_debug_abbrev oc entries; List.iter (fun (s,d,l,e,_) -> - section oc (Section_debug_info s); + section oc (Section_debug_info s); print_debug_info oc d l e) entries; section oc Section_debug_loc; List.iter (fun (_,_,_,_,l) -> print_location_list oc l) entries diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli index 8f03eb8d..73588ad2 100644 --- a/debug/DwarfTypes.mli +++ b/debug/DwarfTypes.mli @@ -49,7 +49,7 @@ type location_value = | LocRef of address | LocSimple of location_expression | LocList of location_expression list - + type data_location_value = | DataLocBlock of location_expression | DataLocRef of reference @@ -60,10 +60,10 @@ type bound_value = (* Types representing the attribute information per tag value *) -type file_loc = +type file_loc = | Diab_file_loc of int * constant | Gnu_file_loc of int * constant - + type dw_tag_array_type = { array_type_file_loc: file_loc option; diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml index eff80110..ef0a6c4e 100644 --- a/debug/Dwarfgen.ml +++ b/debug/Dwarfgen.ml @@ -56,9 +56,9 @@ let int_type_to_entry id i = (match i.int_kind with | IBool -> DW_ATE_boolean | IChar -> - if !Machine.config.Machine.char_signed then - DW_ATE_signed_char - else + if !Machine.config.Machine.char_signed then + DW_ATE_signed_char + else DW_ATE_unsigned_char | IInt | ILong | ILongLong | IShort | ISChar -> DW_ATE_signed | _ -> DW_ATE_unsigned)in @@ -68,7 +68,7 @@ let int_type_to_entry id i = base_type_name = typ_to_string (TInt (i.int_kind,[]));} in new_entry id (DW_TAG_base_type int) -let float_type_to_entry id f = +let float_type_to_entry id f = let byte_size = sizeof_fkind f.float_kind in let float = { base_type_byte_size = byte_size; @@ -88,7 +88,7 @@ let void_to_entry id = let file_loc_opt file = function | None -> None | Some (f,l) -> - try + try Some (file (f,l)) with Not_found -> None @@ -99,7 +99,7 @@ let typedef_to_entry file id t = typedef_name = t.typedef_name; typedef_type = i; } in - new_entry id (DW_TAG_typedef td) + new_entry id (DW_TAG_typedef td) let pointer_to_entry id p = let p = {pointer_type = p.pts} in @@ -183,8 +183,8 @@ let member_to_entry mem = member_bit_offset = mem.cfd_bit_offset; member_bit_size = mem.cfd_bit_size; member_data_member_location = - (match mem.cfd_byte_offset with - | None -> None + (match mem.cfd_byte_offset with + | None -> None | Some s -> Some (DataLocBlock (DW_OP_plus_uconst s))); member_declaration = None; member_name = Some (mem.cfd_name); @@ -236,19 +236,19 @@ let needs_types id d = let add_type id d = if not (IntSet.mem id d) then IntSet.add id d,true - else + else d,false in let t = Hashtbl.find types id in match t with - | IntegerType _ + | IntegerType _ | FloatType _ | Void | EnumType _ -> d,false | Typedef t -> add_type (get_opt_val t.typ) d - | PointerType p -> + | PointerType p -> add_type p.pts d - | ArrayType arr -> + | ArrayType arr -> add_type arr.arr_type d | ConstType c -> add_type c.cst_type d @@ -256,12 +256,12 @@ let needs_types id d = add_type v.vol_type d | FunctionType f -> let d,c = match f.fun_return_type with - | Some t -> add_type t d + | Some t -> add_type t d | None -> d,false in List.fold_left (fun (d,c) p -> let d,c' = add_type p.param_type d in d,c||c') (d,c) f.fun_params - | CompositeType c -> + | CompositeType c -> List.fold_left (fun (d,c) f -> let d,c' = add_type f.cfd_typ d in d,c||c') (d,false) c.ct_members @@ -276,10 +276,10 @@ let gen_types file needed = else d in let typs = aux needed in - List.rev (Hashtbl.fold (fun id t acc -> + List.rev (Hashtbl.fold (fun id t acc -> if IntSet.mem id typs then (infotype_to_entry file id t)::acc - else + else acc) types []) let global_variable_to_entry file acc id v = @@ -300,13 +300,13 @@ let global_variable_to_entry file acc id v = let gen_splitlong op_hi op_lo = let op_piece = DW_OP_piece 4 in op_piece::op_hi@(op_piece::op_lo) - -let translate_function_loc a = function + +let translate_function_loc a = function | BA_addrstack (ofs) -> let ofs = camlint_of_coqint ofs in Some (LocSimple (DW_OP_bregx (a,ofs))),[] | BA_splitlong (BA_addrstack hi,BA_addrstack lo)-> - let hi = camlint_of_coqint hi + let hi = camlint_of_coqint hi and lo = camlint_of_coqint lo in if lo = Int32.add hi 4l then Some (LocSimple (DW_OP_bregx (a,hi))),[] @@ -315,11 +315,11 @@ let translate_function_loc a = function and op_lo = [DW_OP_bregx (a,lo)] in Some (LocList (gen_splitlong op_hi op_lo)),[] | _ -> None,[] - + let range_entry_loc (sp,l) = let rec aux = function | BA i -> [DW_OP_reg i] - | BA_addrstack ofs -> + | BA_addrstack ofs -> let ofs = camlint_of_coqint ofs in [DW_OP_bregx (sp,ofs)] | BA_splitlong (hi,lo) -> @@ -334,12 +334,12 @@ let range_entry_loc (sp,l) = let location_entry f_id atom = try - begin + begin match (Hashtbl.find var_locations (f_id,atom)) with | FunctionLoc (a,r) -> translate_function_loc a r | RangeLoc l -> - let l = List.rev_map (fun i -> + let l = List.rev_map (fun i -> let hi = get_opt_val i.range_start and lo = get_opt_val i.range_end in let hi = Hashtbl.find label_translation (f_id,hi) @@ -380,8 +380,8 @@ let rec local_variable_to_entry file f_id (acc,bcc) v id = and scope_to_entry file f_id acc sc id = let l_pc,h_pc = try let r = Hashtbl.find scope_ranges id in - let lbl l = match l with - | Some l -> Some (Hashtbl.find label_translation (f_id,l)) + let lbl l = match l with + | Some l -> Some (Hashtbl.find label_translation (f_id,l)) | None -> None in begin match r with @@ -401,8 +401,8 @@ and scope_to_entry file f_id acc sc id = and local_to_entry file f_id acc id = match Hashtbl.find local_variables id with | LocalVariable v -> local_variable_to_entry file f_id acc v id - | Scope v -> let s,acc = - (scope_to_entry file f_id acc v id) in + | Scope v -> let s,acc = + (scope_to_entry file f_id acc v id) in Some s,acc let fun_scope_to_entries file f_id acc id = @@ -430,7 +430,7 @@ let function_to_entry file (acc,bcc) id f = let params,(acc,bcc) = mmap (function_parameter_to_entry f_id) (acc,bcc) f.fun_parameter in let vars,(acc,bcc) = fun_scope_to_entries file f_id (acc,bcc) f.fun_scope in add_children f_entry (params@vars),(acc,bcc) - + let definition_to_entry file (acc,bcc) id t = match t with | GlobalVariable g -> let e,acc = global_variable_to_entry file acc id g in @@ -450,7 +450,7 @@ let gen_diab_debug_info sec_name var_section : debug_entries = let old = try StringMap.find s acc with Not_found -> [] in StringMap.add s ((id,t)::old) acc) definitions StringMap.empty in let entries = StringMap.fold (fun s defs acc -> - let defs,(ty,locs) = List.fold_left (fun (acc,bcc) (id,t) -> + let defs,(ty,locs) = List.fold_left (fun (acc,bcc) (id,t) -> let t,bcc = definition_to_entry (diab_file_loc s) bcc id t in t::acc,bcc) ([],(IntSet.empty,[])) defs in let low_pc = Hashtbl.find compilation_section_start s @@ -459,7 +459,7 @@ let gen_diab_debug_info sec_name var_section : debug_entries = let cp = { compile_unit_name = !file_name; compile_unit_low_pc = low_pc; - compile_unit_high_pc = high_pc; + compile_unit_high_pc = high_pc; } in let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in let cp = add_children cp ((gen_types (diab_file_loc s) ty) @ defs) in @@ -472,7 +472,7 @@ let gnu_file_loc (f,l) = let gen_gnu_debug_info sec_name var_section : debug_entries = let low_pc = Hashtbl.find compilation_section_start ".text" and high_pc = Hashtbl.find compilation_section_end ".text" in - let defs,(ty,locs),sec = Hashtbl.fold (fun id t (acc,bcc,sec) -> + let defs,(ty,locs),sec = Hashtbl.fold (fun id t (acc,bcc,sec) -> let s = match t with | GlobalVariable _ -> var_section | Function f -> sec_name (get_opt_val f.fun_atom) in @@ -482,7 +482,7 @@ let gen_gnu_debug_info sec_name var_section : debug_entries = let cp = { compile_unit_name = !file_name; compile_unit_low_pc = low_pc; - compile_unit_high_pc = high_pc; + compile_unit_high_pc = high_pc; } in let cp = new_entry (next_id ()) (DW_TAG_compile_unit cp) in let cp = add_children cp (types@defs) in diff --git a/doc/coq2html.mll b/doc/coq2html.mll index 2f1bfdbc..7dd93842 100644 --- a/doc/coq2html.mll +++ b/doc/coq2html.mll @@ -157,7 +157,7 @@ let rec set_enum_depth d = fprintf !oc "<ul>\n"; fprintf !oc "<li>\n"; incr enum_depth; - end + end else if !enum_depth > d then begin fprintf !oc "</li>\n"; fprintf !oc "</ul>\n"; @@ -290,7 +290,7 @@ rule coq_bol = parse | eof { () } | space* as s - { space s; + { space s; coq lexbuf } and skip_newline = parse @@ -337,7 +337,7 @@ and comment = parse | "*)" { if !in_proof then end_comment() } | "(*" - { if !in_proof then start_comment(); + { if !in_proof then start_comment(); comment lexbuf; comment lexbuf } | eof { () } @@ -345,7 +345,7 @@ and comment = parse { if !in_proof then newline(); comment lexbuf } | space* as s - { if !in_proof then space s; + { if !in_proof then space s; comment lexbuf } | eof { () } @@ -422,7 +422,7 @@ let process_file f = if Filename.check_suffix f ".v" then begin let pref_f = Filename.chop_suffix f ".v" in let base_f = Filename.basename pref_f in - current_module := + current_module := "compcert." ^ Str.global_replace (Str.regexp "/") "." pref_f; let ic = open_in f in if !output_name = "-" then diff --git a/driver/Clflags.ml b/driver/Clflags.ml index d9c21a9c..9d3697bd 100644 --- a/driver/Clflags.ml +++ b/driver/Clflags.ml @@ -52,7 +52,7 @@ let option_S = ref false let option_c = ref false let option_v = ref false let option_interp = ref false -let option_small_data = +let option_small_data = ref (if Configuration.arch = "powerpc" && Configuration.abi = "eabi" && Configuration.system = "diab" diff --git a/driver/Compiler.v b/driver/Compiler.v index 3920665e..ea5849ec 100644 --- a/driver/Compiler.v +++ b/driver/Compiler.v @@ -159,7 +159,7 @@ Definition transf_cminor_program (p: Cminor.program) : res Asm.program := @@@ transf_rtl_program. Definition transf_clight_program (p: Clight.program) : res Asm.program := - OK p + OK p @@ print print_Clight @@@ time "Simplification of locals" SimplLocals.transf_program @@@ time "C#minor generation" Cshmgen.transl_program @@ -167,7 +167,7 @@ Definition transf_clight_program (p: Clight.program) : res Asm.program := @@@ transf_cminor_program. Definition transf_c_program (p: Csyntax.program) : res Asm.program := - OK p + OK p @@@ time "Clight generation" SimplExpr.transl_program @@@ transf_clight_program. @@ -182,14 +182,14 @@ Lemma print_identity: forall (A: Type) (printer: A -> unit) (prog: A), print printer prog = prog. Proof. - intros; unfold print. destruct (printer prog); auto. + intros; unfold print. destruct (printer prog); auto. Qed. Lemma compose_print_identity: - forall (A: Type) (x: res A) (f: A -> unit), + forall (A: Type) (x: res A) (f: A -> unit), x @@ print f = x. Proof. - intros. destruct x; simpl. rewrite print_identity. auto. auto. + intros. destruct x; simpl. rewrite print_identity. auto. auto. Qed. Remark forward_simulation_identity: @@ -199,8 +199,8 @@ Proof. - auto. - exists s1; auto. - subst s2; auto. -- subst s2. exists s1'; auto. -Qed. +- subst s2. exists s1'; auto. +Qed. Lemma total_if_simulation: forall (A: Type) (sem: A -> semantics) (flag: unit -> bool) (f: A -> A) (prog: A), @@ -259,15 +259,15 @@ Proof. destruct (partial_if debug Debugvar.transf_program p7) as [p71|] eqn:?; simpl in H; try discriminate. destruct (Stacking.transf_program p71) as [p8|] eqn:?; simpl in H; try discriminate. apply compose_forward_simulation with (RTL.semantics p1). - apply total_if_simulation. apply Tailcallproof.transf_program_correct. + apply total_if_simulation. apply Tailcallproof.transf_program_correct. apply compose_forward_simulation with (RTL.semantics p11). apply Inliningproof.transf_program_correct; auto. apply compose_forward_simulation with (RTL.semantics p12). - apply Renumberproof.transf_program_correct. + apply Renumberproof.transf_program_correct. apply compose_forward_simulation with (RTL.semantics p2). apply total_if_simulation. apply Constpropproof.transf_program_correct. apply compose_forward_simulation with (RTL.semantics p21). - apply total_if_simulation. apply Renumberproof.transf_program_correct. + apply total_if_simulation. apply Renumberproof.transf_program_correct. apply compose_forward_simulation with (RTL.semantics p3). eapply partial_if_simulation; eauto. apply CSEproof.transf_program_correct. apply compose_forward_simulation with (RTL.semantics p31). @@ -281,7 +281,7 @@ Proof. apply compose_forward_simulation with (Linear.semantics p6). apply Linearizeproof.transf_program_correct; auto. apply compose_forward_simulation with (Linear.semantics p7). - apply CleanupLabelsproof.transf_program_correct. + apply CleanupLabelsproof.transf_program_correct. apply compose_forward_simulation with (Linear.semantics p71). eapply partial_if_simulation; eauto. apply Debugvarproof.transf_program_correct. apply compose_forward_simulation with (Mach.semantics Asmgenproof0.return_address_offset p8). @@ -289,8 +289,8 @@ Proof. exact Asmgenproof.return_address_exists. auto. apply Asmgenproof.transf_program_correct; eauto. - split. auto. - apply forward_to_backward_simulation. auto. + split. auto. + apply forward_to_backward_simulation. auto. apply RTL.semantics_receptive. apply Asm.semantics_determinate. Qed. @@ -305,15 +305,15 @@ Proof. assert (F: forward_simulation (Cminor.semantics p) (Asm.semantics tp)). unfold transf_cminor_program, time in H. repeat rewrite compose_print_identity in H. - simpl in H. + simpl in H. destruct (Selection.sel_program p) as [p1|] eqn:?; simpl in H; try discriminate. destruct (RTLgen.transl_program p1) as [p2|] eqn:?; simpl in H; try discriminate. eapply compose_forward_simulation. apply Selectionproof.transf_program_correct. eauto. eapply compose_forward_simulation. apply RTLgenproof.transf_program_correct. eassumption. exact (fst (transf_rtl_program_correct _ _ H)). - split. auto. - apply forward_to_backward_simulation. auto. + split. auto. + apply forward_to_backward_simulation. auto. apply Cminor.semantics_receptive. apply Asm.semantics_determinate. Qed. @@ -324,7 +324,7 @@ Theorem transf_clight_program_correct: forward_simulation (Clight.semantics1 p) (Asm.semantics tp) * backward_simulation (Clight.semantics1 p) (Asm.semantics tp). Proof. - intros. + intros. assert (F: forward_simulation (Clight.semantics1 p) (Asm.semantics tp)). revert H; unfold transf_clight_program, time; simpl. rewrite print_identity. @@ -335,10 +335,10 @@ Proof. eapply compose_forward_simulation. apply SimplLocalsproof.transf_program_correct. eauto. eapply compose_forward_simulation. apply Cshmgenproof.transl_program_correct. eauto. eapply compose_forward_simulation. apply Cminorgenproof.transl_program_correct. eauto. - exact (fst (transf_cminor_program_correct _ _ EQ3)). + exact (fst (transf_cminor_program_correct _ _ EQ3)). - split. auto. - apply forward_to_backward_simulation. auto. + split. auto. + apply forward_to_backward_simulation. auto. apply Clight.semantics_receptive. apply Asm.semantics_determinate. Qed. @@ -355,9 +355,9 @@ Proof. caseEq (SimplExpr.transl_program p); simpl; try congruence; intros p0 EQ0. intros EQ1. eapply compose_forward_simulation. apply SimplExprproof.transl_program_correct. eauto. - exact (fst (transf_clight_program_correct _ _ EQ1)). + exact (fst (transf_clight_program_correct _ _ EQ1)). - split. auto. + split. auto. apply forward_to_backward_simulation. apply factor_forward_simulation. auto. eapply sd_traces. eapply Asm.semantics_determinate. apply atomic_receptive. apply Cstrategy.semantics_strongly_receptive. @@ -369,10 +369,10 @@ Theorem transf_c_program_correct: transf_c_program p = OK tp -> backward_simulation (Csem.semantics p) (Asm.semantics tp). Proof. - intros. + intros. apply compose_backward_simulation with (atomic (Cstrategy.semantics p)). eapply sd_traces; eapply Asm.semantics_determinate. - apply factor_backward_simulation. + apply factor_backward_simulation. apply Cstrategy.strategy_simulation. apply Csem.semantics_single_events. eapply ssr_well_behaved; eapply Cstrategy.semantics_strongly_receptive. diff --git a/driver/Complements.v b/driver/Complements.v index 57351a2a..8651f2ff 100644 --- a/driver/Complements.v +++ b/driver/Complements.v @@ -44,7 +44,7 @@ Theorem transf_c_program_preservation: program_behaves (Asm.semantics tp) beh -> exists beh', program_behaves (Csem.semantics p) beh' /\ behavior_improves beh' beh. Proof. - intros. eapply backward_simulation_behavior_improves; eauto. + intros. eapply backward_simulation_behavior_improves; eauto. apply transf_c_program_correct; auto. Qed. @@ -81,7 +81,7 @@ Proof. assert (WBT: forall p, well_behaved_traces (Cstrategy.semantics p)). intros. eapply ssr_well_behaved. apply Cstrategy.semantics_strongly_receptive. intros. intuition. - eapply forward_simulation_behavior_improves; eauto. + eapply forward_simulation_behavior_improves; eauto. apply (fst (transf_cstrategy_program_correct _ _ H)). exploit backward_simulation_behavior_improves. apply (snd (transf_cstrategy_program_correct _ _ H)). @@ -92,7 +92,7 @@ Proof. exploit backward_simulation_same_safe_behavior. apply (snd (transf_cstrategy_program_correct _ _ H)). intros. rewrite <- atomic_behaviors in H2; eauto. eauto. - intros. rewrite atomic_behaviors; auto. + intros. rewrite atomic_behaviors; auto. Qed. (** We can also use the alternate big-step semantics for [Cstrategy] @@ -114,7 +114,7 @@ Proof. apply behavior_bigstep_terminates with (Cstrategy.bigstep_semantics p); auto. apply Cstrategy.bigstep_semantics_sound. exploit (behavior_bigstep_diverges (Cstrategy.bigstep_semantics_sound p)). eassumption. - intros [A | [t [A B]]]. + intros [A | [t [A B]]]. left. apply transf_cstrategy_program_preservation with p; auto. red; auto. right; exists t; split; auto. apply transf_cstrategy_program_preservation with p; auto. red; auto. Qed. @@ -125,10 +125,10 @@ Qed. of the source C program satisfies a given specification (a predicate on the observable behavior of the program), then all executions of the produced Asm program satisfy - this specification as well. + this specification as well. We first show this result for specifications that are stable - under the [behavior_improves] relation. *) + under the [behavior_improves] relation. *) Section SPECS_PRESERVED. @@ -145,7 +145,7 @@ Theorem transf_c_program_preserves_spec: Proof. intros. exploit transf_c_program_preservation; eauto. intros [beh' [A B]]. - apply spec_stable with beh'; auto. + apply spec_stable with beh'; auto. Qed. End SPECS_PRESERVED. @@ -166,9 +166,9 @@ Theorem transf_c_program_preserves_safety_spec: (forall beh, program_behaves (Csem.semantics p) beh -> spec beh) -> (forall beh, program_behaves (Asm.semantics tp) beh -> spec beh). Proof. - intros. eapply transf_c_program_preserves_spec; eauto. - intros. destruct H2. congruence. destruct H2 as [t [EQ1 EQ2]]. - subst beh1. elim (spec_safety _ H3). + intros. eapply transf_c_program_preserves_spec; eauto. + intros. destruct H2. congruence. destruct H2 as [t [EQ1 EQ2]]. + subst beh1. elim (spec_safety _ H3). Qed. End SAFETY_PRESERVED. @@ -196,8 +196,8 @@ Proof. destruct H2 as [t [C D]]. subst. destruct A as [b1 E]. destruct D as [b2 F]. destruct b1; simpl in E; inv E. - exists t1; split; auto. - exists (behavior_app t0 b2); apply behavior_app_assoc. + exists t1; split; auto. + exists (behavior_app t0 b2); apply behavior_app_assoc. Qed. End LIVENESS_PRESERVED. diff --git a/driver/Configuration.ml b/driver/Configuration.ml index 41325368..1f05afd8 100644 --- a/driver/Configuration.ml +++ b/driver/Configuration.ml @@ -30,7 +30,7 @@ let ini_file_name = try List.find Sys.file_exists files with Not_found -> - begin + begin eprintf "Cannot find compcert.ini configuration file.\n"; exit 2 end @@ -73,19 +73,19 @@ let get_config_list key = let prepro = get_config_list "prepro" let asm = get_config_list "asm" let linker = get_config_list "linker" -let arch = +let arch = match get_config_string "arch" with | "powerpc"|"arm"|"ia32" as a -> a | v -> bad_config "arch" [v] let model = get_config_string "model" let abi = get_config_string "abi" let system = get_config_string "system" -let has_runtime_lib = +let has_runtime_lib = match get_config_string "has_runtime_lib" with | "true" -> true | "false" -> false | v -> bad_config "has_runtime_lib" [v] -let has_standard_headers = +let has_standard_headers = match get_config_string "has_standard_headers" with | "true" -> true | "false" -> false @@ -95,7 +95,7 @@ let stdlib_path = get_config_string "stdlib_path" else "" -let asm_supports_cfi = +let asm_supports_cfi = match get_config_string "asm_supports_cfi" with | "true" -> true | "false" -> false @@ -117,7 +117,7 @@ type struct_return_style = | SR_int1248 (* return by content if size is 1, 2, 4 or 8 bytes *) | SR_int1to4 (* return by content if size is <= 4 *) | SR_int1to8 (* return by content if size is <= 8 *) - | SR_ref (* always return by assignment to a reference + | SR_ref (* always return by assignment to a reference given as extra argument *) let struct_passing_style = diff --git a/driver/Configuration.mli b/driver/Configuration.mli index f82ce213..1d048ac4 100644 --- a/driver/Configuration.mli +++ b/driver/Configuration.mli @@ -46,7 +46,7 @@ type struct_return_style = | SR_int1248 (* return by content if size is 1, 2, 4 or 8 bytes *) | SR_int1to4 (* return by content if size is <= 4 *) | SR_int1to8 (* return by content if size is <= 8 *) - | SR_ref (* always return by assignment to a reference + | SR_ref (* always return by assignment to a reference given as extra argument *) val struct_passing_style: struct_passing_style diff --git a/driver/Driver.ml b/driver/Driver.ml index c7d9984e..4b58fb4d 100644 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -188,7 +188,7 @@ let compile_c_ast sourcename csyntax ofile debug = | Errors.Error msg -> eprintf "%s: %a" sourcename print_error msg; exit 2 in - (* Dump Asm in binary and JSON format *) + (* Dump Asm in binary and JSON format *) if !option_sdump then begin dump_asm asm (output_filename sourcename ".c" ".sdump"); @@ -518,7 +518,7 @@ let unset_all opts = List.iter (fun r -> r := false) opts let num_source_files = ref 0 let num_input_files = ref 0 - + let cmdline_actions = let f_opt name ref = [Exact("-f" ^ name), Set ref; Exact("-fno-" ^ name), Unset ref] in @@ -570,8 +570,8 @@ let cmdline_actions = (* Linking options *) Prefix "-l", Self push_linker_arg; Prefix "-L", Self push_linker_arg; - Exact "-T", String (fun s -> if Configuration.system = "diab" then - push_linker_arg ("-Wm"^s) + Exact "-T", String (fun s -> if Configuration.system = "diab" then + push_linker_arg ("-Wm"^s) else begin push_linker_arg ("-T"); push_linker_arg(s) diff --git a/driver/Interp.ml b/driver/Interp.ml index 579b936d..fb1c85f0 100644 --- a/driver/Interp.ml +++ b/driver/Interp.ml @@ -98,7 +98,7 @@ let name_of_function prog fn = in find_name prog.prog_defs let invert_local_variable e b = - Maps.PTree.fold + Maps.PTree.fold (fun res id (b', _) -> if b = b' then Some id else res) e None @@ -176,7 +176,7 @@ let rec compare_cont k1 k2 = match k1, k2 with | Kstop, Kstop -> 0 | Kdo k1, Kdo k2 -> compare_cont k1 k2 - | Kseq(s1, k1), Kseq(s2, k2) -> + | Kseq(s1, k1), Kseq(s2, k2) -> let c = compare s1 s2 in if c <> 0 then c else compare_cont k1 k2 | Kifthenelse(s1, s1', k1), Kifthenelse(s2, s2', k2) -> let c = compare (s1,s1') (s2,s2') in @@ -273,7 +273,7 @@ let extract_string m blk ofs = if c = '\000' then begin Some(Buffer.contents b) end else begin - Buffer.add_char b c; + Buffer.add_char b c; extract blk (Z.succ ofs) end | _ -> @@ -325,7 +325,7 @@ let format_value m flags length conv arg = | 'p', "", _ -> "<int or pointer argument expected>" | _, _, _ -> - "<unrecognized format>" + "<unrecognized format>" let do_printf m fmt args = @@ -374,7 +374,7 @@ let convert_external_arg ge v t = | Vfloat f, AST.Tfloat -> Some (EVfloat f) | Vsingle f, AST.Tsingle -> Some (EVsingle f) | Vlong n, AST.Tlong -> Some (EVlong n) - | Vptr(b, ofs), AST.Tint -> + | Vptr(b, ofs), AST.Tint -> Senv.invert_symbol ge b >>= fun id -> Some (EVptr_global(id, ofs)) | _, _ -> None @@ -565,7 +565,7 @@ let rec explore_all p prog ge time states = if nextstates <> [] then explore_all p prog ge (time + 1) nextstates (* The variant of the source program used to build the world for - executing events. + executing events. Volatile variables are turned into non-volatile ones, so that reads and writes can be performed. Other variables are turned into empty vars, so that diff --git a/exportclight/Clightgen.ml b/exportclight/Clightgen.ml index c1009b4f..5e8d77a7 100644 --- a/exportclight/Clightgen.ml +++ b/exportclight/Clightgen.ml @@ -75,7 +75,7 @@ let print_error oc msg = let output_filename ?(final = false) source_file source_suffix output_suffix = match !option_o with | Some file when final -> file - | _ -> + | _ -> Filename.basename (Filename.chop_suffix source_file source_suffix) ^ output_suffix @@ -253,7 +253,7 @@ let cmdline_actions = Exact "-dparse", Set option_dparse; Exact "-dc", Set option_dcmedium; Exact "-dclight", Set option_dclight; -(* General options *) +(* General options *) Exact "-v", Set option_v; Exact "-stdlib", String(fun s -> stdlib_path := s); ] diff --git a/exportclight/ExportClight.ml b/exportclight/ExportClight.ml index 01e9037f..96c7398f 100644 --- a/exportclight/ExportClight.ml +++ b/exportclight/ExportClight.ml @@ -234,9 +234,9 @@ let name_of_chunk = function | Many64 -> "Many64" let signatur p sg = - fprintf p "@[<hov 2>(mksignature@ %a@ %a@ %a)@]" + fprintf p "@[<hov 2>(mksignature@ %a@ %a@ %a)@]" (print_list asttype) sg.sig_args - (print_option asttype) sg.sig_res + (print_option asttype) sg.sig_res callconv sg.sig_cc let assertions = ref ([]: (string * typ list) list) @@ -254,13 +254,13 @@ let external_function p = function | EF_free -> fprintf p "EF_free" | EF_memcpy(sz, al) -> fprintf p "(EF_memcpy %ld %ld)" (Z.to_int32 sz) (Z.to_int32 al) - | EF_annot(text, targs) -> + | EF_annot(text, targs) -> assertions := (camlstring_of_coqstring text, targs) :: !assertions; fprintf p "(EF_annot %a %a)" coqstring text (print_list asttype) targs | EF_annot_val(text, targ) -> assertions := (camlstring_of_coqstring text, [targ]) :: !assertions; fprintf p "(EF_annot_val %a %a)" coqstring text asttype targ - | EF_debug(kind, text, targs) -> + | EF_debug(kind, text, targs) -> fprintf p "(EF_debug %ld%%positive %ld%%positive %a)" (P.to_int32 kind) (P.to_int32 text) (print_list asttype) targs | EF_inline_asm(text, sg, clob) -> fprintf p "@[<hov 2>(EF_inline_asm %a@ %a@ %a)@]" @@ -340,7 +340,7 @@ let rec stmt p = function (print_option ident) optid expr e1 (print_list expr) el | Sbuiltin(optid, ef, tyl, el) -> fprintf p "@[<hov 2>(Sbuiltin %a@ %a@ %a@ %a)@]" - (print_option ident) optid + (print_option ident) optid external_function ef typlist tyl (print_list expr) el @@ -414,7 +414,7 @@ let print_globdef p (id, gd) = | Gvar v -> print_variable p (id, v) let print_ident_globdef p = function - | (id, Gfun(Internal f)) -> + | (id, Gfun(Internal f)) -> fprintf p "(%a, Gfun(Internal f_%s))" ident id (extern_atom id) | (id, Gfun(External(ef, targs, tres, cc))) -> fprintf p "@[<hov 2>(%a,@ @[<hov 2>Gfun(External %a@ %a@ %a@ %a))@]@]" diff --git a/extraction/extraction.v b/extraction/extraction.v index aca7102d..0f0a8637 100644 --- a/extraction/extraction.v +++ b/extraction/extraction.v @@ -111,7 +111,7 @@ Extract Constant Compiler.time => "Timing.time_coq". (*Extraction Inline Compiler.apply_total Compiler.apply_partial.*) (* Cabs *) -Extract Constant Cabs.cabsloc => +Extract Constant Cabs.cabsloc => "{ lineno : int; filename: string; byteno: int; diff --git a/ia32/Archi.v b/ia32/Archi.v index 674b2761..267c0eee 100644 --- a/ia32/Archi.v +++ b/ia32/Archi.v @@ -25,13 +25,13 @@ Definition big_endian := false. Notation align_int64 := 4%Z (only parsing). Notation align_float64 := 4%Z (only parsing). -Program Definition default_pl_64 : bool * nan_pl 53 := +Program Definition default_pl_64 : bool * nan_pl 53 := (true, nat_iter 51 xO xH). Definition choose_binop_pl_64 (s1: bool) (pl1: nan_pl 53) (s2: bool) (pl2: nan_pl 53) := false. (**r always choose first NaN *) -Program Definition default_pl_32 : bool * nan_pl 24 := +Program Definition default_pl_32 : bool * nan_pl 24 := (true, nat_iter 22 xO xH). Definition choose_binop_pl_32 (s1: bool) (pl1: nan_pl 24) (s2: bool) (pl2: nan_pl 24) := @@ -50,7 +50,7 @@ Proof. decide equality. Defined. (** Bits of the flags register. *) -Inductive crbit: Type := +Inductive crbit: Type := | ZF | CF | PF | SF | OF. (** All registers modeled here. *) @@ -169,7 +169,7 @@ Inductive instruction: Type := | Psar_ri (rd: ireg) (n: int) | Pshld_ri (rd: ireg) (r1: ireg) (n: int) | Pror_ri (rd: ireg) (n: int) - | Pcmp_rr (r1 r2: ireg) + | Pcmp_rr (r1 r2: ireg) | Pcmp_ri (r1: ireg) (n: int) | Ptest_rr (r1 r2: ireg) | Ptest_ri (r1: ireg) (n: int) @@ -517,7 +517,7 @@ Definition exec_store (chunk: memory_chunk) (m: mem) that correspond to actual IA32 instructions, the cases are straightforward transliterations of the informal descriptions given in the IA32 reference manuals. For pseudo-instructions, - refer to the informal descriptions given above. + refer to the informal descriptions given above. Note that we set to [Vundef] the registers used as temporaries by the expansions of the pseudo-instructions, so that the IA32 code @@ -735,7 +735,7 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out end | Pjmptbl r tbl => match rs#r with - | Vint n => + | Vint n => match list_nth_z tbl (Int.unsigned n) with | None => Stuck | Some lbl => goto_label f lbl rs m @@ -818,14 +818,14 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out | Pminsd _ _ | Pmovb_rm _ _ | Pmovq_rm _ _ - | Pmovq_mr _ _ + | Pmovq_mr _ _ | Pmovsb | Pmovsw - | Pmovw_rm _ _ + | Pmovw_rm _ _ | Prep_movsl | Psbb_rr _ _ | Psqrtsd _ _ - | Psub_ri _ _ => Stuck + | Psub_ri _ _ => Stuck end. (** Translation of the LTL/Linear/Mach view of machine registers @@ -891,7 +891,7 @@ Inductive step: state -> trace -> state -> Prop := find_instr (Int.unsigned ofs) f.(fn_code) = Some (Pbuiltin ef args res) -> eval_builtin_args ge rs (rs ESP) m args vargs -> external_call ef ge vargs m t vres m' -> - rs' = nextinstr_nf + rs' = nextinstr_nf (set_res res vres (undef_regs (map preg_of (destroyed_by_builtin ef)) rs)) -> step (State rs m) t (State rs' m') @@ -924,7 +924,7 @@ Inductive final_state: state -> int -> Prop := rs#PC = Vzero -> rs#EAX = Vint r -> final_state (State rs m) r. - + Definition semantics (p: program) := Semantics step (initial_state p) final_state (Genv.globalenv p). @@ -939,9 +939,9 @@ Proof. forall vl2, list_forall2 (extcall_arg rs m) ll vl2 -> vl1 = vl2). induction 1; intros vl2 EA; inv EA. auto. - f_equal; auto. + f_equal; auto. inv H; inv H3; congruence. - intros. red in H0; red in H1. eauto. + intros. red in H0; red in H1. eauto. Qed. Lemma semantics_determinate: forall p, determinate (semantics p). diff --git a/ia32/Asmexpand.ml b/ia32/Asmexpand.ml index 99babeb4..d11d9d23 100644 --- a/ia32/Asmexpand.ml +++ b/ia32/Asmexpand.ml @@ -21,7 +21,7 @@ open AST open Camlcoq open Datatypes open Integers - + exception Error of string (* Useful constants and helper functions *) @@ -35,14 +35,14 @@ let _8 = coqint_of_camlint 8l let stack_alignment () = if Configuration.system = "macoxs" then 16 else 8 - + (* SP adjustment to allocate or free a stack frame *) - + let int32_align n a = if n >= 0l then Int32.logand (Int32.add n (Int32.of_int (a-1))) (Int32.of_int (-a)) else Int32.logand n (Int32.of_int (-a)) - + let sp_adjustment sz = let sz = camlint_of_coqint sz in (* Preserve proper alignment of the stack *) @@ -50,9 +50,9 @@ let sp_adjustment sz = (* The top 4 bytes have already been allocated by the "call" instruction. *) let sz = Int32.sub sz 4l in sz - - -(* Built-ins. They come in two flavors: + + +(* Built-ins. They come in two flavors: - annotation statements: take their arguments in registers or stack locations; generate no code; - inlined by the compiler: take their arguments in arbitrary @@ -88,7 +88,7 @@ let offset_addressing (Addrmode(base, ofs, cst)) delta = let linear_addr reg ofs = Addrmode(Some reg, None, Coq_inl ofs) let global_addr id ofs = Addrmode(None, None, Coq_inr(id, ofs)) - + (* Handling of memcpy *) (* Unaligned memory accesses are quite fast on IA32, so use large @@ -128,7 +128,7 @@ let expand_builtin_memcpy sz al args = if sz <= 32 then expand_builtin_memcpy_small sz al src dst else expand_builtin_memcpy_big sz al src dst - + (* Handling of volatile reads and writes *) let expand_builtin_vload_common chunk addr res = @@ -197,9 +197,9 @@ let expand_builtin_vstore chunk args = expand_builtin_vstore_common chunk addr src (if Asmgen.addressing_mentions addr EAX then ECX else EAX) | _ -> assert false - + (* Handling of varargs *) - + let expand_builtin_va_start r = if not !current_function.fn_sig.sig_cc.cc_vararg then invalid_arg "Fatal error: va_start used in non-vararg function"; @@ -231,7 +231,7 @@ let expand_fma args res i132 i213 i231 = end | _ -> invalid_arg ("ill-formed fma builtin") - + (* Handling of compiler-inlined builtins *) let expand_builtin_inline name args res = @@ -348,7 +348,7 @@ let expand_builtin_inline name args res = raise (Error ("unrecognized builtin " ^ name)) (* Expansion of instructions *) - + let expand_instruction instr = match instr with | Pallocframe (sz, ofs_ra, ofs_link) -> @@ -379,14 +379,14 @@ let expand_instruction instr = (Int32.to_int (camlint_of_coqint al)) args | EF_annot_val(txt, targ) -> - expand_annot_val txt targ args res + expand_annot_val txt targ args res | EF_annot _ | EF_debug _ | EF_inline_asm _ -> emit instr | _ -> assert false end | _ -> emit instr - + let int_reg_to_dwarf = function | EAX -> 0 | EBX -> 3 diff --git a/ia32/Asmgen.v b/ia32/Asmgen.v index 1ccde43b..91122898 100644 --- a/ia32/Asmgen.v +++ b/ia32/Asmgen.v @@ -78,7 +78,7 @@ Definition addressing_mentions (addr: addrmode) (r: ireg) : bool := || match displ with Some(r', sc) => ireg_eq r r' | None => false end end. -Definition mk_smallstore (sto: addrmode -> ireg ->instruction) +Definition mk_smallstore (sto: addrmode -> ireg ->instruction) (addr: addrmode) (rs: ireg) (k: code) := if low_ireg rs then OK (sto addr rs :: k) @@ -252,7 +252,7 @@ Definition mk_setcc_base (cond: extcond) (rd: ireg) (k: code) := if ireg_eq rd EAX then Psetcc c1 EAX :: Psetcc c2 ECX :: Pand_rr EAX ECX :: k else Psetcc c1 EAX :: Psetcc c2 rd :: Pand_rr rd EAX :: k - | Cond_or c1 c2 => + | Cond_or c1 c2 => if ireg_eq rd EAX then Psetcc c1 EAX :: Psetcc c2 ECX :: Por_rr EAX ECX :: k else Psetcc c1 EAX :: Psetcc c2 rd :: Por_rr rd EAX :: k @@ -282,10 +282,10 @@ Definition transl_op do r <- ireg_of res; OK ((if Int.eq_dec n Int.zero then Pxor_r r else Pmov_ri r n) :: k) | Ofloatconst f, nil => - do r <- freg_of res; + do r <- freg_of res; OK ((if Float.eq_dec f Float.zero then Pxorpd_f r else Pmovsd_fi r f) :: k) | Osingleconst f, nil => - do r <- freg_of res; + do r <- freg_of res; OK ((if Float32.eq_dec f Float32.zero then Pxorps_f r else Pmovss_fi r f) :: k) | Oindirectsymbol id, nil => do r <- ireg_of res; @@ -518,11 +518,11 @@ Definition transl_instr (f: Mach.function) (i: Mach.instruction) | Mcall sig (inr symb) => OK (Pcall_s symb sig :: k) | Mtailcall sig (inl reg) => - do r <- ireg_of reg; - OK (Pfreeframe f.(fn_stacksize) f.(fn_retaddr_ofs) f.(fn_link_ofs) :: + do r <- ireg_of reg; + OK (Pfreeframe f.(fn_stacksize) f.(fn_retaddr_ofs) f.(fn_link_ofs) :: Pjmp_r r sig :: k) | Mtailcall sig (inr symb) => - OK (Pfreeframe f.(fn_stacksize) f.(fn_retaddr_ofs) f.(fn_link_ofs) :: + OK (Pfreeframe f.(fn_stacksize) f.(fn_retaddr_ofs) f.(fn_link_ofs) :: Pjmp_s symb sig :: k) | Mlabel lbl => OK(Plabel lbl :: k) @@ -533,7 +533,7 @@ Definition transl_instr (f: Mach.function) (i: Mach.instruction) | Mjumptable arg tbl => do r <- ireg_of arg; OK (Pjmptbl r tbl :: k) | Mreturn => - OK (Pfreeframe f.(fn_stacksize) f.(fn_retaddr_ofs) f.(fn_link_ofs) :: + OK (Pfreeframe f.(fn_stacksize) f.(fn_retaddr_ofs) f.(fn_link_ofs) :: Pret :: k) | Mbuiltin ef args res => OK (Pbuiltin ef (List.map (map_builtin_arg preg_of) args) (map_builtin_res preg_of res) :: k) diff --git a/ia32/Asmgenproof.v b/ia32/Asmgenproof.v index d91e17a2..105347e7 100644 --- a/ia32/Asmgenproof.v +++ b/ia32/Asmgenproof.v @@ -43,17 +43,17 @@ Let tge := Genv.globalenv tprog. Lemma symbols_preserved: forall id, Genv.find_symbol tge id = Genv.find_symbol ge id. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.find_symbol_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma public_preserved: forall id, Genv.public_symbol tge id = Genv.public_symbol ge id. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.public_symbol_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma functions_translated: @@ -70,15 +70,15 @@ Lemma functions_transl: Genv.find_funct_ptr tge fb = Some (Internal tf). Proof. intros. exploit functions_translated; eauto. intros [tf' [A B]]. - monadInv B. rewrite H0 in EQ; inv EQ; auto. + monadInv B. rewrite H0 in EQ; inv EQ; auto. Qed. Lemma varinfo_preserved: forall b, Genv.find_var_info tge b = Genv.find_var_info ge b. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.find_var_info_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. (** * Properties of control flow *) @@ -88,7 +88,7 @@ Lemma transf_function_no_overflow: transf_function f = OK tf -> list_length_z (fn_code tf) <= Int.max_unsigned. Proof. intros. monadInv H. destruct (zlt Int.max_unsigned (list_length_z (fn_code x))); monadInv EQ0. - omega. + omega. Qed. Lemma exec_straight_exec: @@ -100,7 +100,7 @@ Proof. intros. inv H. eapply exec_straight_steps_1; eauto. eapply transf_function_no_overflow; eauto. - eapply functions_transl; eauto. + eapply functions_transl; eauto. Qed. Lemma exec_straight_at: @@ -110,8 +110,8 @@ Lemma exec_straight_at: exec_straight tge tf tc rs m tc' rs' m' -> transl_code_at_pc ge (rs' PC) fb f c' ep' tf tc'. Proof. - intros. inv H. - exploit exec_straight_steps_2; eauto. + intros. inv H. + exploit exec_straight_steps_2; eauto. eapply transf_function_no_overflow; eauto. eapply functions_transl; eauto. intros [ofs' [PC' CT']]. @@ -141,7 +141,7 @@ Section TRANSL_LABEL. Remark mk_mov_label: forall rd rs k c, mk_mov rd rs k = OK c -> tail_nolabel k c. Proof. - unfold mk_mov; intros. + unfold mk_mov; intros. destruct rd; try discriminate; destruct rs; TailNoLabel. Qed. Hint Resolve mk_mov_label: labels. @@ -154,20 +154,20 @@ Qed. Hint Resolve mk_shrximm_label: labels. Remark mk_intconv_label: - forall f r1 r2 k c, mk_intconv f r1 r2 k = OK c -> + forall f r1 r2 k c, mk_intconv f r1 r2 k = OK c -> (forall r r', nolabel (f r r')) -> tail_nolabel k c. Proof. - unfold mk_intconv; intros. TailNoLabel. + unfold mk_intconv; intros. TailNoLabel. Qed. Hint Resolve mk_intconv_label: labels. Remark mk_smallstore_label: - forall f addr r k c, mk_smallstore f addr r k = OK c -> + forall f addr r k c, mk_smallstore f addr r k = OK c -> (forall r addr, nolabel (f r addr)) -> tail_nolabel k c. Proof. - unfold mk_smallstore; intros. TailNoLabel. + unfold mk_smallstore; intros. TailNoLabel. Qed. Hint Resolve mk_smallstore_label: labels. @@ -233,7 +233,7 @@ Proof. destruct (Int.eq_dec i Int.zero); TailNoLabel. destruct (Float.eq_dec f Float.zero); TailNoLabel. destruct (Float32.eq_dec f Float32.zero); TailNoLabel. - eapply tail_nolabel_trans. eapply transl_cond_label; eauto. eapply mk_setcc_label. + eapply tail_nolabel_trans. eapply transl_cond_label; eauto. eapply mk_setcc_label. Qed. Remark transl_load_label: @@ -262,13 +262,13 @@ Opaque loadind. eapply loadind_label; eauto. eapply storeind_label; eauto. eapply loadind_label; eauto. - eapply tail_nolabel_trans; eapply loadind_label; eauto. + eapply tail_nolabel_trans; eapply loadind_label; eauto. eapply transl_op_label; eauto. eapply transl_load_label; eauto. eapply transl_store_label; eauto. destruct s0; TailNoLabel. destruct s0; TailNoLabel. - eapply tail_nolabel_trans. eapply transl_cond_label; eauto. eapply mk_jcc_label. + eapply tail_nolabel_trans. eapply transl_cond_label; eauto. eapply mk_jcc_label. Qed. Lemma transl_instr_label': @@ -277,7 +277,7 @@ Lemma transl_instr_label': find_label lbl c = if Mach.is_label lbl i then Some k else find_label lbl k. Proof. intros. exploit transl_instr_label; eauto. - destruct i; try (intros [A B]; apply B). + destruct i; try (intros [A B]; apply B). intros. subst c. simpl. auto. Qed. @@ -292,7 +292,7 @@ Proof. induction c; simpl; intros. inv H. auto. monadInv H. rewrite (transl_instr_label' lbl _ _ _ _ _ EQ0). - generalize (Mach.is_label_correct lbl a). + generalize (Mach.is_label_correct lbl a). destruct (Mach.is_label lbl a); intros. subst a. simpl in EQ. exists x; auto. eapply IHc; eauto. @@ -307,7 +307,7 @@ Lemma transl_find_label: end. Proof. intros. monadInv H. destruct (zlt Int.max_unsigned (list_length_z (fn_code x))); inv EQ0. - monadInv EQ. simpl. eapply transl_code_label; eauto. rewrite transl_code'_transl_code in EQ0; eauto. + monadInv EQ. simpl. eapply transl_code_label; eauto. rewrite transl_code'_transl_code in EQ0; eauto. Qed. End TRANSL_LABEL. @@ -322,17 +322,17 @@ Lemma find_label_goto_label: rs PC = Vptr b ofs -> Mach.find_label lbl f.(Mach.fn_code) = Some c' -> exists tc', exists rs', - goto_label tf lbl rs m = Next rs' m + goto_label tf lbl rs m = Next rs' m /\ transl_code_at_pc ge (rs' PC) b f c' false tf tc' /\ forall r, r <> PC -> rs'#r = rs#r. Proof. - intros. exploit (transl_find_label lbl f tf); eauto. rewrite H2. + intros. exploit (transl_find_label lbl f tf); eauto. rewrite H2. intros [tc [A B]]. exploit label_pos_code_tail; eauto. instantiate (1 := 0). intros [pos' [P [Q R]]]. exists tc; exists (rs#PC <- (Vptr b (Int.repr pos'))). split. unfold goto_label. rewrite P. rewrite H1. auto. - split. rewrite Pregmap.gss. constructor; auto. + split. rewrite Pregmap.gss. constructor; auto. rewrite Int.unsigned_repr. replace (pos' - 0) with pos' in Q. auto. omega. generalize (transf_function_no_overflow _ _ H0). omega. @@ -345,10 +345,10 @@ Lemma return_address_exists: forall f sg ros c, is_tail (Mcall sg ros :: c) f.(Mach.fn_code) -> exists ra, return_address_offset f c ra. Proof. - intros. eapply Asmgenproof0.return_address_exists; eauto. -- intros. exploit transl_instr_label; eauto. + intros. eapply Asmgenproof0.return_address_exists; eauto. +- intros. exploit transl_instr_label; eauto. destruct i; try (intros [A B]; apply A). intros. subst c0. repeat constructor. -- intros. monadInv H0. +- intros. monadInv H0. destruct (zlt Int.max_unsigned (list_length_z (fn_code x))); inv EQ0. monadInv EQ. rewrite transl_code'_transl_code in EQ0. exists x; exists true; split; auto. unfold fn_code. repeat constructor. @@ -417,10 +417,10 @@ Lemma exec_straight_steps: plus step tge (State rs1 m1') E0 st' /\ match_states (Mach.State s fb sp c ms2 m2) st'. Proof. - intros. inversion H2. subst. monadInv H7. - exploit H3; eauto. intros [rs2 [A [B C]]]. + intros. inversion H2. subst. monadInv H7. + exploit H3; eauto. intros [rs2 [A [B C]]]. exists (State rs2 m2'); split. - eapply exec_straight_exec; eauto. + eapply exec_straight_exec; eauto. econstructor; eauto. eapply exec_straight_at; eauto. Qed. @@ -445,15 +445,15 @@ Proof. exploit H5; eauto. intros [jmp [k' [rs2 [A [B C]]]]]. generalize (functions_transl _ _ _ H7 H8); intro FN. generalize (transf_function_no_overflow _ _ H8); intro NOOV. - exploit exec_straight_steps_2; eauto. + exploit exec_straight_steps_2; eauto. intros [ofs' [PC2 CT2]]. - exploit find_label_goto_label; eauto. + exploit find_label_goto_label; eauto. intros [tc' [rs3 [GOTO [AT' OTH]]]]. exists (State rs3 m2'); split. eapply plus_right'. - eapply exec_straight_steps_1; eauto. + eapply exec_straight_steps_1; eauto. econstructor; eauto. - eapply find_instr_tail. eauto. + eapply find_instr_tail. eauto. rewrite C. eexact GOTO. traceEq. econstructor; eauto. @@ -487,8 +487,8 @@ Proof. induction 1; intros; inv MS. - (* Mlabel *) - left; eapply exec_straight_steps; eauto; intros. - monadInv TR. econstructor; split. apply exec_straight_one. simpl; eauto. auto. + left; eapply exec_straight_steps; eauto; intros. + monadInv TR. econstructor; split. apply exec_straight_one. simpl; eauto. auto. split. apply agree_nextinstr; auto. simpl; congruence. - (* Mgetstack *) @@ -504,88 +504,88 @@ Proof. - (* Msetstack *) unfold store_stack in H. assert (Val.lessdef (rs src) (rs0 (preg_of src))). eapply preg_val; eauto. - exploit Mem.storev_extends; eauto. intros [m2' [A B]]. + exploit Mem.storev_extends; eauto. intros [m2' [A B]]. left; eapply exec_straight_steps; eauto. rewrite (sp_val _ _ _ AG) in A. intros. simpl in TR. exploit storeind_correct; eauto. intros [rs' [P Q]]. exists rs'; split. eauto. - split. eapply agree_undef_regs; eauto. + split. eapply agree_undef_regs; eauto. simpl; intros. rewrite Q; auto with asmgen. Local Transparent destroyed_by_setstack. destruct ty; simpl; intuition congruence. - (* Mgetparam *) assert (f0 = f) by congruence; subst f0. - unfold load_stack in *. - exploit Mem.loadv_extends. eauto. eexact H0. auto. + unfold load_stack in *. + exploit Mem.loadv_extends. eauto. eexact H0. auto. intros [parent' [A B]]. rewrite (sp_val _ _ _ AG) in A. exploit lessdef_parent_sp; eauto. clear B; intros B; subst parent'. - exploit Mem.loadv_extends. eauto. eexact H1. auto. + exploit Mem.loadv_extends. eauto. eexact H1. auto. intros [v' [C D]]. Opaque loadind. - left; eapply exec_straight_steps; eauto; intros. + left; eapply exec_straight_steps; eauto; intros. assert (DIFF: negb (mreg_eq dst DX) = true -> IR EDX <> preg_of dst). - intros. change (IR EDX) with (preg_of DX). red; intros. + intros. change (IR EDX) with (preg_of DX). red; intros. unfold proj_sumbool in H1. destruct (mreg_eq dst DX); try discriminate. elim n. eapply preg_of_injective; eauto. destruct ep; simpl in TR. (* EDX contains parent *) exploit loadind_correct. eexact TR. - instantiate (2 := rs0). rewrite DXP; eauto. + instantiate (2 := rs0). rewrite DXP; eauto. intros [rs1 [P [Q R]]]. - exists rs1; split. eauto. + exists rs1; split. eauto. split. eapply agree_set_mreg. eapply agree_set_mreg; eauto. congruence. auto. simpl; intros. rewrite R; auto. (* EDX does not contain parent *) monadInv TR. exploit loadind_correct. eexact EQ0. eauto. intros [rs1 [P [Q R]]]. simpl in Q. exploit loadind_correct. eexact EQ. instantiate (2 := rs1). rewrite Q. eauto. - intros [rs2 [S [T U]]]. + intros [rs2 [S [T U]]]. exists rs2; split. eapply exec_straight_trans; eauto. split. eapply agree_set_mreg. eapply agree_set_mreg; eauto. congruence. auto. simpl; intros. rewrite U; auto. - (* Mop *) - assert (eval_operation tge sp op rs##args m = Some v). + assert (eval_operation tge sp op rs##args m = Some v). rewrite <- H. apply eval_operation_preserved. exact symbols_preserved. exploit eval_operation_lessdef. eapply preg_vals; eauto. eauto. eexact H0. - intros [v' [A B]]. rewrite (sp_val _ _ _ AG) in A. + intros [v' [A B]]. rewrite (sp_val _ _ _ AG) in A. left; eapply exec_straight_steps; eauto; intros. simpl in TR. - exploit transl_op_correct; eauto. intros [rs2 [P [Q R]]]. + exploit transl_op_correct; eauto. intros [rs2 [P [Q R]]]. assert (S: Val.lessdef v (rs2 (preg_of res))) by (eapply Val.lessdef_trans; eauto). exists rs2; split. eauto. split. eapply agree_set_undef_mreg; eauto. simpl; congruence. - (* Mload *) - assert (eval_addressing tge sp addr rs##args = Some a). + assert (eval_addressing tge sp addr rs##args = Some a). rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1. intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A. exploit Mem.loadv_extends; eauto. intros [v' [C D]]. left; eapply exec_straight_steps; eauto; intros. simpl in TR. - exploit transl_load_correct; eauto. intros [rs2 [P [Q R]]]. + exploit transl_load_correct; eauto. intros [rs2 [P [Q R]]]. exists rs2; split. eauto. split. eapply agree_set_undef_mreg; eauto. congruence. simpl; congruence. - (* Mstore *) - assert (eval_addressing tge sp addr rs##args = Some a). + assert (eval_addressing tge sp addr rs##args = Some a). rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1. intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A. assert (Val.lessdef (rs src) (rs0 (preg_of src))). eapply preg_val; eauto. exploit Mem.storev_extends; eauto. intros [m2' [C D]]. left; eapply exec_straight_steps; eauto. - intros. simpl in TR. - exploit transl_store_correct; eauto. intros [rs2 [P Q]]. + intros. simpl in TR. + exploit transl_store_correct; eauto. intros [rs2 [P Q]]. exists rs2; split. eauto. - split. eapply agree_undef_regs; eauto. + split. eapply agree_undef_regs; eauto. simpl; congruence. - (* Mcall *) assert (f0 = f) by congruence. subst f0. - inv AT. + inv AT. assert (NOOV: list_length_z tf.(fn_code) <= Int.max_unsigned). eapply transf_function_no_overflow; eauto. destruct ros as [rf|fid]; simpl in H; monadInv H5. @@ -601,13 +601,13 @@ Opaque loadind. exploit return_address_offset_correct; eauto. intros; subst ra. left; econstructor; split. apply plus_one. eapply exec_step_internal. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. - simpl. eauto. - econstructor; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. + simpl. eauto. + econstructor; eauto. econstructor; eauto. eapply agree_sp_def; eauto. simpl. eapply agree_exten; eauto. intros. Simplifs. - Simplifs. rewrite <- H2. auto. + Simplifs. rewrite <- H2. auto. + (* Direct call *) generalize (code_tail_next_int _ _ _ _ NOOV H6). intro CT1. assert (TCA: transl_code_at_pc ge (Vptr fb (Int.add ofs Int.one)) fb f c false tf x). @@ -615,9 +615,9 @@ Opaque loadind. exploit return_address_offset_correct; eauto. intros; subst ra. left; econstructor; split. apply plus_one. eapply exec_step_internal. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. eauto. - econstructor; eauto. + econstructor; eauto. econstructor; eauto. eapply agree_sp_def; eauto. simpl. eapply agree_exten; eauto. intros. Simplifs. @@ -625,7 +625,7 @@ Opaque loadind. - (* Mtailcall *) assert (f0 = f) by congruence. subst f0. - inv AT. + inv AT. assert (NOOV: list_length_z tf.(fn_code) <= Int.max_unsigned). eapply transf_function_no_overflow; eauto. rewrite (sp_val _ _ _ AG) in *. unfold load_stack in *. @@ -633,7 +633,7 @@ Opaque loadind. exploit Mem.loadv_extends. eauto. eexact H2. auto. simpl. intros [ra' [C D]]. exploit lessdef_parent_sp; eauto. intros. subst parent'. clear B. exploit lessdef_parent_ra; eauto. intros. subst ra'. clear D. - exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. + exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. destruct ros as [rf|fid]; simpl in H; monadInv H7. + (* Indirect call *) assert (rs rf = Vptr f' Int.zero). @@ -644,26 +644,26 @@ Opaque loadind. generalize (code_tail_next_int _ _ _ _ NOOV H8). intro CT1. left; econstructor; split. eapply plus_left. eapply exec_step_internal. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. rewrite C. rewrite A. rewrite <- (sp_val _ _ _ AG). rewrite E. eauto. - apply star_one. eapply exec_step_internal. + apply star_one. eapply exec_step_internal. transitivity (Val.add rs0#PC Vone). auto. rewrite <- H4. simpl. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. eauto. traceEq. econstructor; eauto. apply agree_set_other; auto. apply agree_nextinstr. apply agree_set_other; auto. eapply agree_change_sp; eauto. eapply parent_sp_def; eauto. - Simplifs. rewrite Pregmap.gso; auto. + Simplifs. rewrite Pregmap.gso; auto. generalize (preg_of_not_SP rf). rewrite (ireg_of_eq _ _ EQ1). congruence. + (* Direct call *) generalize (code_tail_next_int _ _ _ _ NOOV H8). intro CT1. left; econstructor; split. eapply plus_left. eapply exec_step_internal. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. rewrite C. rewrite A. rewrite <- (sp_val _ _ _ AG). rewrite E. eauto. - apply star_one. eapply exec_step_internal. + apply star_one. eapply exec_step_internal. transitivity (Val.add rs0#PC Vone). auto. rewrite <- H4. simpl. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. eauto. traceEq. econstructor; eauto. apply agree_set_other; auto. apply agree_nextinstr. apply agree_set_other; auto. @@ -671,16 +671,16 @@ Opaque loadind. rewrite Pregmap.gss. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. auto. - (* Mbuiltin *) - inv AT. monadInv H4. + inv AT. monadInv H4. exploit functions_transl; eauto. intro FN. generalize (transf_function_no_overflow _ _ H3); intro NOOV. - exploit builtin_args_match; eauto. intros [vargs' [P Q]]. + exploit builtin_args_match; eauto. intros [vargs' [P Q]]. exploit external_call_mem_extends; eauto. intros [vres' [m2' [A [B [C D]]]]]. - left. econstructor; split. apply plus_one. + left. econstructor; split. apply plus_one. eapply exec_step_builtin. eauto. eauto. eapply find_instr_tail; eauto. - erewrite <- sp_val by eauto. + erewrite <- sp_val by eauto. eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. @@ -695,12 +695,12 @@ Opaque loadind. auto with asmgen. simpl; intros. intuition congruence. apply agree_nextinstr_nf. eapply agree_set_res; auto. - eapply agree_undef_regs; eauto. intros; apply undef_regs_other_2; auto. + eapply agree_undef_regs; eauto. intros; apply undef_regs_other_2; auto. congruence. - (* Mgoto *) assert (f0 = f) by congruence. subst f0. - inv AT. monadInv H4. + inv AT. monadInv H4. exploit find_label_goto_label; eauto. intros [tc' [rs' [GOTO [AT2 INV]]]]. left; exists (State rs' m'); split. apply plus_one. econstructor; eauto. @@ -717,26 +717,26 @@ Opaque loadind. left; eapply exec_straight_steps_goto; eauto. intros. simpl in TR. destruct (transl_cond_correct tge tf cond args _ _ rs0 m' TR) - as [rs' [A [B C]]]. + as [rs' [A [B C]]]. rewrite EC in B. destruct (testcond_for_condition cond); simpl in *. (* simple jcc *) exists (Pjcc c1 lbl); exists k; exists rs'. split. eexact A. - split. eapply agree_exten; eauto. + split. eapply agree_exten; eauto. simpl. rewrite B. auto. (* jcc; jcc *) destruct (eval_testcond c1 rs') as [b1|] eqn:TC1; destruct (eval_testcond c2 rs') as [b2|] eqn:TC2; inv B. - destruct b1. + destruct b1. (* first jcc jumps *) exists (Pjcc c1 lbl); exists (Pjcc c2 lbl :: k); exists rs'. split. eexact A. - split. eapply agree_exten; eauto. + split. eapply agree_exten; eauto. simpl. rewrite TC1. auto. (* second jcc jumps *) exists (Pjcc c2 lbl); exists k; exists (nextinstr rs'). - split. eapply exec_straight_trans. eexact A. + split. eapply exec_straight_trans. eexact A. eapply exec_straight_one. simpl. rewrite TC1. auto. auto. split. eapply agree_exten; eauto. intros; Simplifs. @@ -745,23 +745,23 @@ Opaque loadind. (* jcc2 *) destruct (eval_testcond c1 rs') as [b1|] eqn:TC1; destruct (eval_testcond c2 rs') as [b2|] eqn:TC2; inv B. - destruct (andb_prop _ _ H3). subst. + destruct (andb_prop _ _ H3). subst. exists (Pjcc2 c1 c2 lbl); exists k; exists rs'. split. eexact A. - split. eapply agree_exten; eauto. + split. eapply agree_exten; eauto. simpl. rewrite TC1; rewrite TC2; auto. - (* Mcond false *) exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros EC. - left; eapply exec_straight_steps; eauto. intros. simpl in TR. + left; eapply exec_straight_steps; eauto. intros. simpl in TR. destruct (transl_cond_correct tge tf cond args _ _ rs0 m' TR) - as [rs' [A [B C]]]. + as [rs' [A [B C]]]. rewrite EC in B. destruct (testcond_for_condition cond); simpl in *. (* simple jcc *) econstructor; split. - eapply exec_straight_trans. eexact A. - apply exec_straight_one. simpl. rewrite B. eauto. auto. + eapply exec_straight_trans. eexact A. + apply exec_straight_one. simpl. rewrite B. eauto. auto. split. apply agree_nextinstr. eapply agree_exten; eauto. simpl; congruence. (* jcc ; jcc *) @@ -769,8 +769,8 @@ Opaque loadind. destruct (eval_testcond c2 rs') as [b2|] eqn:TC2; inv B. destruct (orb_false_elim _ _ H1); subst. econstructor; split. - eapply exec_straight_trans. eexact A. - eapply exec_straight_two. simpl. rewrite TC1. eauto. auto. + eapply exec_straight_trans. eexact A. + eapply exec_straight_two. simpl. rewrite TC1. eauto. auto. simpl. rewrite eval_testcond_nextinstr. rewrite TC2. eauto. auto. auto. split. apply agree_nextinstr. apply agree_nextinstr. eapply agree_exten; eauto. simpl; congruence. @@ -778,9 +778,9 @@ Opaque loadind. destruct (eval_testcond c1 rs') as [b1|] eqn:TC1; destruct (eval_testcond c2 rs') as [b2|] eqn:TC2; inv B. exists (nextinstr rs'); split. - eapply exec_straight_trans. eexact A. - apply exec_straight_one. simpl. - rewrite TC1; rewrite TC2. + eapply exec_straight_trans. eexact A. + apply exec_straight_one. simpl. + rewrite TC1; rewrite TC2. destruct b1. simpl in *. subst b2. auto. auto. auto. split. apply agree_nextinstr. eapply agree_exten; eauto. @@ -788,41 +788,41 @@ Opaque loadind. - (* Mjumptable *) assert (f0 = f) by congruence. subst f0. - inv AT. monadInv H6. + inv AT. monadInv H6. exploit functions_transl; eauto. intro FN. generalize (transf_function_no_overflow _ _ H5); intro NOOV. - exploit find_label_goto_label; eauto. + exploit find_label_goto_label; eauto. intros [tc' [rs' [A [B C]]]]. exploit ireg_val; eauto. rewrite H. intros LD; inv LD. left; econstructor; split. - apply plus_one. econstructor; eauto. - eapply find_instr_tail; eauto. + apply plus_one. econstructor; eauto. + eapply find_instr_tail; eauto. simpl. rewrite <- H9. unfold Mach.label in H0; unfold label; rewrite H0. eauto. - econstructor; eauto. -Transparent destroyed_by_jumptable. + econstructor; eauto. +Transparent destroyed_by_jumptable. simpl. eapply agree_exten; eauto. intros. rewrite C; auto with asmgen. congruence. - (* Mreturn *) assert (f0 = f) by congruence. subst f0. - inv AT. + inv AT. assert (NOOV: list_length_z tf.(fn_code) <= Int.max_unsigned). eapply transf_function_no_overflow; eauto. rewrite (sp_val _ _ _ AG) in *. unfold load_stack in *. - exploit Mem.loadv_extends. eauto. eexact H0. auto. simpl. intros [parent' [A B]]. + exploit Mem.loadv_extends. eauto. eexact H0. auto. simpl. intros [parent' [A B]]. exploit lessdef_parent_sp; eauto. intros. subst parent'. clear B. - exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [ra' [C D]]. + exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [ra' [C D]]. exploit lessdef_parent_ra; eauto. intros. subst ra'. clear D. exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. monadInv H6. exploit code_tail_next_int; eauto. intro CT1. left; econstructor; split. eapply plus_left. eapply exec_step_internal. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. rewrite C. rewrite A. rewrite <- (sp_val _ _ _ AG). rewrite E. eauto. - apply star_one. eapply exec_step_internal. + apply star_one. eapply exec_step_internal. transitivity (Val.add rs0#PC Vone). auto. rewrite <- H3. simpl. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. eauto. traceEq. constructor; auto. apply agree_set_other; auto. apply agree_nextinstr. apply agree_set_other; auto. @@ -833,40 +833,40 @@ Transparent destroyed_by_jumptable. generalize EQ; intros EQ'. monadInv EQ'. destruct (zlt Int.max_unsigned (list_length_z (fn_code x0))); inv EQ1. monadInv EQ0. rewrite transl_code'_transl_code in EQ1. - unfold store_stack in *. - exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. + unfold store_stack in *. + exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. intros [m1' [C D]]. - exploit Mem.storev_extends. eexact D. eexact H1. eauto. eauto. + exploit Mem.storev_extends. eexact D. eexact H1. eauto. eauto. intros [m2' [F G]]. - exploit Mem.storev_extends. eexact G. eexact H2. eauto. eauto. + exploit Mem.storev_extends. eexact G. eexact H2. eauto. eauto. intros [m3' [P Q]]. left; econstructor; split. - apply plus_one. econstructor; eauto. + apply plus_one. econstructor; eauto. simpl. rewrite Int.unsigned_zero. simpl. eauto. simpl. rewrite C. simpl in F. rewrite (sp_val _ _ _ AG) in F. rewrite F. simpl in P. rewrite ATLR. rewrite P. eauto. econstructor; eauto. - unfold nextinstr. rewrite Pregmap.gss. repeat rewrite Pregmap.gso; auto with asmgen. + unfold nextinstr. rewrite Pregmap.gss. repeat rewrite Pregmap.gso; auto with asmgen. rewrite ATPC. simpl. constructor; eauto. - unfold fn_code. eapply code_tail_next_int. simpl in g. omega. - constructor. + unfold fn_code. eapply code_tail_next_int. simpl in g. omega. + constructor. apply agree_nextinstr. eapply agree_change_sp; eauto. Transparent destroyed_at_function_entry. apply agree_undef_regs with rs0; eauto. - simpl; intros. apply Pregmap.gso; auto with asmgen. tauto. - congruence. + simpl; intros. apply Pregmap.gso; auto with asmgen. tauto. + congruence. intros. Simplifs. eapply agree_sp; eauto. - (* external function *) exploit functions_translated; eauto. intros [tf [A B]]. simpl in B. inv B. - exploit extcall_arguments_match; eauto. + exploit extcall_arguments_match; eauto. intros [args' [C D]]. exploit external_call_mem_extends'; eauto. intros [res' [m2' [P [Q [R S]]]]]. left; econstructor; split. - apply plus_one. eapply exec_step_external; eauto. - eapply external_call_symbols_preserved'; eauto. + apply plus_one. eapply exec_step_external; eauto. + eapply external_call_symbols_preserved'; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. econstructor; eauto. unfold loc_external_result. @@ -891,19 +891,19 @@ Proof. econstructor; eauto. constructor. apply Mem.extends_refl. - split. auto. simpl. unfold Vzero; congruence. intros. rewrite Regmap.gi. auto. + split. auto. simpl. unfold Vzero; congruence. intros. rewrite Regmap.gi. auto. unfold Genv.symbol_address. rewrite (transform_partial_program_main _ _ TRANSF). - rewrite symbols_preserved. + rewrite symbols_preserved. unfold ge; rewrite H1. auto. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> Mach.final_state st1 r -> Asm.final_state st2 r. Proof. - intros. inv H0. inv H. constructor. auto. - compute in H1. inv H1. + intros. inv H0. inv H. constructor. auto. + compute in H1. inv H1. generalize (preg_val _ _ _ AX AG). rewrite H2. intros LD; inv LD. auto. Qed. diff --git a/ia32/Asmgenproof1.v b/ia32/Asmgenproof1.v index 0ca343fb..d2a8206e 100644 --- a/ia32/Asmgenproof1.v +++ b/ia32/Asmgenproof1.v @@ -36,19 +36,19 @@ Lemma agree_nextinstr_nf: forall ms sp rs, agree ms sp rs -> agree ms sp (nextinstr_nf rs). Proof. - intros. unfold nextinstr_nf. apply agree_nextinstr. + intros. unfold nextinstr_nf. apply agree_nextinstr. apply agree_undef_nondata_regs. auto. - intro. simpl. ElimOrEq; auto. + intro. simpl. ElimOrEq; auto. Qed. (** Useful properties of the PC register. *) Lemma nextinstr_nf_inv: - forall r rs, + forall r rs, match r with PC => False | CR _ => False | _ => True end -> (nextinstr_nf rs)#r = rs#r. Proof. - intros. unfold nextinstr_nf. rewrite nextinstr_inv. + intros. unfold nextinstr_nf. rewrite nextinstr_inv. simpl. repeat rewrite Pregmap.gso; auto; red; intro; subst; contradiction. red; intro; subst; contradiction. @@ -109,13 +109,13 @@ Lemma mk_mov_correct: /\ rs2#rd = rs1#rs /\ forall r, data_preg r = true -> r <> rd -> rs2#r = rs1#r. Proof. - unfold mk_mov; intros. + unfold mk_mov; intros. destruct rd; try (monadInv H); destruct rs; monadInv H. (* mov *) - econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. Simplifs. intros; Simplifs. + econstructor. split. apply exec_straight_one. simpl. eauto. auto. + split. Simplifs. intros; Simplifs. (* movd *) - econstructor. split. apply exec_straight_one. simpl. eauto. auto. + econstructor. split. apply exec_straight_one. simpl. eauto. auto. split. Simplifs. intros; Simplifs. Qed. @@ -130,7 +130,7 @@ Remark divs_mods_exist: end. Proof. intros. unfold Val.divs, Val.mods. destruct v1; auto. destruct v2; auto. - destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); auto. + destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); auto. Qed. Remark divu_modu_exist: @@ -142,7 +142,7 @@ Remark divu_modu_exist: end. Proof. intros. unfold Val.divu, Val.modu. destruct v1; auto. destruct v2; auto. - destruct (Int.eq i0 Int.zero); auto. + destruct (Int.eq i0 Int.zero); auto. Qed. (** Smart constructor for [shrx] *) @@ -167,10 +167,10 @@ Proof. set (rs5 := nextinstr_nf (rs4#EAX <- (Val.shr rs4#EAX (Vint n)))). assert (rs3#EAX = Vint x). unfold rs3. Simplifs. assert (rs3#ECX = Vint x'). unfold rs3. Simplifs. - exists rs5. split. + exists rs5. split. apply exec_straight_step with rs2 m. simpl. rewrite A. simpl. rewrite Int.and_idem. auto. auto. - apply exec_straight_step with rs3 m. simpl. - change (rs2 EAX) with (rs1 EAX). rewrite A. simpl. + apply exec_straight_step with rs3 m. simpl. + change (rs2 EAX) with (rs1 EAX). rewrite A. simpl. rewrite (Int.add_commut Int.zero tnm1). rewrite Int.add_zero. auto. auto. apply exec_straight_step with rs4 m. simpl. rewrite Int.lt_sub_overflow. unfold rs4. destruct (Int.lt x Int.zero); simpl; auto. @@ -178,10 +178,10 @@ Proof. apply exec_straight_one. auto. auto. split. unfold rs5. Simplifs. unfold rs4. rewrite nextinstr_inv; auto with asmgen. destruct (Int.lt x Int.zero). rewrite Pregmap.gss. rewrite A; auto. rewrite A; rewrite H; auto. - intros. unfold rs5. Simplifs. unfold rs4. Simplifs. - transitivity (rs3#r). destruct (Int.lt x Int.zero). Simplifs. auto. - unfold rs3. Simplifs. unfold rs2. Simplifs. - unfold compare_ints. Simplifs. + intros. unfold rs5. Simplifs. unfold rs4. Simplifs. + transitivity (rs3#r). destruct (Int.lt x Int.zero). Simplifs. auto. + unfold rs3. Simplifs. unfold rs2. Simplifs. + unfold compare_ints. Simplifs. Qed. (** Smart constructor for integer conversions *) @@ -197,11 +197,11 @@ Lemma mk_intconv_correct: /\ forall r, data_preg r = true -> r <> rd -> r <> EAX -> rs2#r = rs1#r. Proof. unfold mk_intconv; intros. destruct (low_ireg rs); monadInv H. - econstructor. split. apply exec_straight_one. rewrite H0. eauto. auto. + econstructor. split. apply exec_straight_one. rewrite H0. eauto. auto. + split. Simplifs. intros. Simplifs. + econstructor. split. eapply exec_straight_two. + simpl. eauto. apply H0. auto. auto. split. Simplifs. intros. Simplifs. - econstructor. split. eapply exec_straight_two. - simpl. eauto. apply H0. auto. auto. - split. Simplifs. intros. Simplifs. Qed. (** Smart constructor for small stores *) @@ -228,40 +228,40 @@ Lemma mk_smallstore_correct: exec_straight ge fn c rs1 m1 k rs2 m2 /\ forall r, data_preg r = true -> r <> EAX /\ r <> ECX -> rs2#r = rs1#r. Proof. - unfold mk_smallstore; intros. + unfold mk_smallstore; intros. remember (low_ireg r) as low. destruct low. (* low reg *) - monadInv H. econstructor; split. apply exec_straight_one. rewrite H1. + monadInv H. econstructor; split. apply exec_straight_one. rewrite H1. unfold exec_store. rewrite H0. eauto. auto. intros; Simplifs. (* high reg *) remember (addressing_mentions addr EAX) as mentions. destruct mentions; monadInv H. (* EAX is mentioned. *) - assert (r <> ECX). red; intros; subst r; discriminate. + assert (r <> ECX). red; intros; subst r; discriminate. set (rs2 := nextinstr (rs1#ECX <- (eval_addrmode ge addr rs1))). set (rs3 := nextinstr (rs2#EAX <- (rs1 r))). econstructor; split. - apply exec_straight_three with rs2 m1 rs3 m1. - simpl. auto. - simpl. replace (rs2 r) with (rs1 r). auto. symmetry. unfold rs2; Simplifs. - rewrite H1. unfold exec_store. simpl. rewrite Int.add_zero. + apply exec_straight_three with rs2 m1 rs3 m1. + simpl. auto. + simpl. replace (rs2 r) with (rs1 r). auto. symmetry. unfold rs2; Simplifs. + rewrite H1. unfold exec_store. simpl. rewrite Int.add_zero. change (rs3 EAX) with (rs1 r). change (rs3 ECX) with (eval_addrmode ge addr rs1). replace (Val.add (eval_addrmode ge addr rs1) (Vint Int.zero)) with (eval_addrmode ge addr rs1). rewrite H0. eauto. destruct (eval_addrmode ge addr rs1); simpl in H0; try discriminate. - simpl. rewrite Int.add_zero; auto. - auto. auto. auto. - intros. destruct H3. Simplifs. unfold rs3; Simplifs. unfold rs2; Simplifs. + simpl. rewrite Int.add_zero; auto. + auto. auto. auto. + intros. destruct H3. Simplifs. unfold rs3; Simplifs. unfold rs2; Simplifs. (* EAX is not mentioned *) set (rs2 := nextinstr (rs1#EAX <- (rs1 r))). econstructor; split. apply exec_straight_two with rs2 m1. simpl. auto. - rewrite H1. unfold exec_store. + rewrite H1. unfold exec_store. rewrite (addressing_mentions_correct addr EAX rs2 rs1); auto. - change (rs2 EAX) with (rs1 r). rewrite H0. eauto. + change (rs2 EAX) with (rs1 r). rewrite H0. eauto. intros. unfold rs2; Simplifs. auto. auto. intros. destruct H2. simpl. Simplifs. unfold rs2; Simplifs. @@ -281,7 +281,7 @@ Proof. unfold loadind; intros. set (addr := Addrmode (Some base) None (inl (ident * int) ofs)) in *. assert (eval_addrmode ge addr rs = Val.add rs#base (Vint ofs)). - unfold addr. simpl. rewrite Int.add_commut; rewrite Int.add_zero; auto. + unfold addr. simpl. rewrite Int.add_commut; rewrite Int.add_zero; auto. exists (nextinstr_nf (rs#(preg_of dst) <- v)); split. - destruct ty; try discriminate; destruct (preg_of dst); inv H; simpl in H0; apply exec_straight_one; auto; simpl; unfold exec_load; rewrite H1, H0; auto. @@ -300,7 +300,7 @@ Local Transparent destroyed_by_setstack. unfold storeind; intros. set (addr := Addrmode (Some base) None (inl (ident * int) ofs)) in *. assert (eval_addrmode ge addr rs = Val.add rs#base (Vint ofs)). - unfold addr. simpl. rewrite Int.add_commut; rewrite Int.add_zero; auto. + unfold addr. simpl. rewrite Int.add_commut; rewrite Int.add_zero; auto. destruct ty; try discriminate; destruct (preg_of src); inv H; simpl in H0; (econstructor; split; [apply exec_straight_one; [simpl; unfold exec_store; rewrite H1, H0; eauto|auto] @@ -315,10 +315,10 @@ Lemma transl_addressing_mode_correct: eval_addressing ge (rs ESP) addr (List.map rs (List.map preg_of args)) = Some v -> Val.lessdef v (eval_addrmode ge am rs). Proof. - assert (A: forall n, Int.add Int.zero n = n). + assert (A: forall n, Int.add Int.zero n = n). intros. rewrite Int.add_commut. apply Int.add_zero. assert (B: forall n i, (if Int.eq i Int.one then Vint n else Vint (Int.mul n i)) = Vint (Int.mul n i)). - intros. predSpec Int.eq Int.eq_spec i Int.one. + intros. predSpec Int.eq Int.eq_spec i Int.one. subst i. rewrite Int.mul_one. auto. auto. assert (C: forall v i, Val.lessdef (Val.mul v (Vint i)) @@ -332,22 +332,22 @@ Proof. monadInv H. rewrite (ireg_of_eq _ _ EQ). simpl. rewrite A; auto. (* indexed2 *) monadInv H. rewrite (ireg_of_eq _ _ EQ); rewrite (ireg_of_eq _ _ EQ1). simpl. - rewrite Val.add_assoc; auto. + rewrite Val.add_assoc; auto. (* scaled *) - monadInv H. rewrite (ireg_of_eq _ _ EQ). unfold eval_addrmode. - rewrite Val.add_permut. simpl. rewrite A. apply Val.add_lessdef; auto. + monadInv H. rewrite (ireg_of_eq _ _ EQ). unfold eval_addrmode. + rewrite Val.add_permut. simpl. rewrite A. apply Val.add_lessdef; auto. (* indexed2scaled *) monadInv H. rewrite (ireg_of_eq _ _ EQ); rewrite (ireg_of_eq _ _ EQ1); simpl. - apply Val.add_lessdef; auto. apply Val.add_lessdef; auto. + apply Val.add_lessdef; auto. apply Val.add_lessdef; auto. (* global *) inv H. simpl. unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); simpl; auto. repeat rewrite Int.add_zero. auto. (* based *) monadInv H. rewrite (ireg_of_eq _ _ EQ). simpl. unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); simpl; auto. - rewrite Int.add_zero. rewrite Val.add_commut. auto. + rewrite Int.add_zero. rewrite Val.add_commut. auto. (* basedscaled *) - monadInv H. rewrite (ireg_of_eq _ _ EQ). unfold eval_addrmode. + monadInv H. rewrite (ireg_of_eq _ _ EQ). unfold eval_addrmode. rewrite (Val.add_commut Vzero). rewrite Val.add_assoc. rewrite Val.add_permut. apply Val.add_lessdef; auto. destruct (rs x); simpl; auto. rewrite B. simpl. rewrite Int.add_zero. auto. @@ -367,7 +367,7 @@ Lemma compare_ints_spec: /\ (forall r, data_preg r = true -> rs'#r = rs#r). Proof. intros. unfold rs'; unfold compare_ints. - split. auto. + split. auto. split. auto. split. auto. split. auto. @@ -377,13 +377,13 @@ Qed. Lemma int_signed_eq: forall x y, Int.eq x y = zeq (Int.signed x) (Int.signed y). Proof. - intros. unfold Int.eq. unfold proj_sumbool. + intros. unfold Int.eq. unfold proj_sumbool. destruct (zeq (Int.unsigned x) (Int.unsigned y)); destruct (zeq (Int.signed x) (Int.signed y)); auto. elim n. unfold Int.signed. rewrite e; auto. - elim n. apply Int.eqm_small_eq; auto with ints. + elim n. apply Int.eqm_small_eq; auto with ints. eapply Int.eqm_trans. apply Int.eqm_sym. apply Int.eqm_signed_unsigned. - rewrite e. apply Int.eqm_signed_unsigned. + rewrite e. apply Int.eqm_signed_unsigned. Qed. Lemma int_not_lt: @@ -392,8 +392,8 @@ Proof. intros. unfold Int.lt. rewrite int_signed_eq. unfold proj_sumbool. destruct (zlt (Int.signed y) (Int.signed x)). rewrite zlt_false. rewrite zeq_false. auto. omega. omega. - destruct (zeq (Int.signed x) (Int.signed y)). - rewrite zlt_false. auto. omega. + destruct (zeq (Int.signed x) (Int.signed y)). + rewrite zlt_false. auto. omega. rewrite zlt_true. auto. omega. Qed. @@ -409,8 +409,8 @@ Proof. intros. unfold Int.ltu, Int.eq. destruct (zlt (Int.unsigned y) (Int.unsigned x)). rewrite zlt_false. rewrite zeq_false. auto. omega. omega. - destruct (zeq (Int.unsigned x) (Int.unsigned y)). - rewrite zlt_false. auto. omega. + destruct (zeq (Int.unsigned x) (Int.unsigned y)). + rewrite zlt_false. auto. omega. rewrite zlt_true. auto. omega. Qed. @@ -465,16 +465,16 @@ Proof. destruct (Int.eq i Int.zero && (Mem.valid_pointer m b0 (Int.unsigned i0) || Mem.valid_pointer m b0 (Int.unsigned i0 - 1))) eqn:?; try discriminate. destruct c; simpl in *; inv H1. - rewrite Heqb1; reflexivity. + rewrite Heqb1; reflexivity. rewrite Heqb1; reflexivity. (* ptr int *) destruct (Int.eq i0 Int.zero && (Mem.valid_pointer m b0 (Int.unsigned i) || Mem.valid_pointer m b0 (Int.unsigned i - 1))) eqn:?; try discriminate. destruct c; simpl in *; inv H1. - rewrite Heqb1; reflexivity. + rewrite Heqb1; reflexivity. rewrite Heqb1; reflexivity. (* ptr ptr *) - simpl. + simpl. fold (Mem.weak_valid_pointer m b0 (Int.unsigned i)) in *. fold (Mem.weak_valid_pointer m b1 (Int.unsigned i0)) in *. destruct (eq_block b0 b1). @@ -501,7 +501,7 @@ Lemma compare_floats_spec: /\ (forall r, data_preg r = true -> rs'#r = rs#r). Proof. intros. unfold rs'; unfold compare_floats. - split. auto. + split. auto. split. auto. split. auto. intros. Simplifs. @@ -516,7 +516,7 @@ Lemma compare_floats32_spec: /\ (forall r, data_preg r = true -> rs'#r = rs#r). Proof. intros. unfold rs'; unfold compare_floats32. - split. auto. + split. auto. split. auto. split. auto. intros. Simplifs. @@ -574,19 +574,19 @@ Proof. simpl. rewrite Float.cmp_ne_eq. rewrite Float.cmp_le_lt_eq. caseEq (Float.cmp Clt n1 n2); intros; simpl. - caseEq (Float.cmp Ceq n1 n2); intros; simpl. - elimtype False. eapply Float.cmp_lt_eq_false; eauto. - auto. + caseEq (Float.cmp Ceq n1 n2); intros; simpl. + elimtype False. eapply Float.cmp_lt_eq_false; eauto. + auto. destruct (Float.cmp Ceq n1 n2); auto. (* le *) rewrite <- (Float.cmp_swap Cge n1 n2). simpl. destruct (Float.cmp Cle n1 n2); auto. (* gt *) - rewrite Float.cmp_ne_eq. rewrite Float.cmp_ge_gt_eq. + rewrite Float.cmp_ne_eq. rewrite Float.cmp_ge_gt_eq. caseEq (Float.cmp Cgt n1 n2); intros; simpl. - caseEq (Float.cmp Ceq n1 n2); intros; simpl. - elimtype False. eapply Float.cmp_gt_eq_false; eauto. - auto. + caseEq (Float.cmp Ceq n1 n2); intros; simpl. + elimtype False. eapply Float.cmp_gt_eq_false; eauto. + auto. destruct (Float.cmp Ceq n1 n2); auto. (* ge *) destruct (Float.cmp Cge n1 n2); auto. @@ -622,19 +622,19 @@ Proof. simpl. rewrite Float.cmp_ne_eq. rewrite Float.cmp_le_lt_eq. caseEq (Float.cmp Clt n1 n2); intros; simpl. - caseEq (Float.cmp Ceq n1 n2); intros; simpl. + caseEq (Float.cmp Ceq n1 n2); intros; simpl. elimtype False. eapply Float.cmp_lt_eq_false; eauto. - auto. + auto. destruct (Float.cmp Ceq n1 n2); auto. (* le *) rewrite <- (Float.cmp_swap Cge n1 n2). simpl. destruct (Float.cmp Cle n1 n2); auto. (* gt *) - rewrite Float.cmp_ne_eq. rewrite Float.cmp_ge_gt_eq. + rewrite Float.cmp_ne_eq. rewrite Float.cmp_ge_gt_eq. caseEq (Float.cmp Cgt n1 n2); intros; simpl. - caseEq (Float.cmp Ceq n1 n2); intros; simpl. - elimtype False. eapply Float.cmp_gt_eq_false; eauto. - auto. + caseEq (Float.cmp Ceq n1 n2); intros; simpl. + elimtype False. eapply Float.cmp_gt_eq_false; eauto. + auto. destruct (Float.cmp Ceq n1 n2); auto. (* ge *) destruct (Float.cmp Cge n1 n2); auto. @@ -670,19 +670,19 @@ Proof. simpl. rewrite Float32.cmp_ne_eq. rewrite Float32.cmp_le_lt_eq. caseEq (Float32.cmp Clt n1 n2); intros; simpl. - caseEq (Float32.cmp Ceq n1 n2); intros; simpl. - elimtype False. eapply Float32.cmp_lt_eq_false; eauto. - auto. + caseEq (Float32.cmp Ceq n1 n2); intros; simpl. + elimtype False. eapply Float32.cmp_lt_eq_false; eauto. + auto. destruct (Float32.cmp Ceq n1 n2); auto. (* le *) rewrite <- (Float32.cmp_swap Cge n1 n2). simpl. destruct (Float32.cmp Cle n1 n2); auto. (* gt *) - rewrite Float32.cmp_ne_eq. rewrite Float32.cmp_ge_gt_eq. + rewrite Float32.cmp_ne_eq. rewrite Float32.cmp_ge_gt_eq. caseEq (Float32.cmp Cgt n1 n2); intros; simpl. - caseEq (Float32.cmp Ceq n1 n2); intros; simpl. - elimtype False. eapply Float32.cmp_gt_eq_false; eauto. - auto. + caseEq (Float32.cmp Ceq n1 n2); intros; simpl. + elimtype False. eapply Float32.cmp_gt_eq_false; eauto. + auto. destruct (Float32.cmp Ceq n1 n2); auto. (* ge *) destruct (Float32.cmp Cge n1 n2); auto. @@ -718,19 +718,19 @@ Proof. simpl. rewrite Float32.cmp_ne_eq. rewrite Float32.cmp_le_lt_eq. caseEq (Float32.cmp Clt n1 n2); intros; simpl. - caseEq (Float32.cmp Ceq n1 n2); intros; simpl. + caseEq (Float32.cmp Ceq n1 n2); intros; simpl. elimtype False. eapply Float32.cmp_lt_eq_false; eauto. - auto. + auto. destruct (Float32.cmp Ceq n1 n2); auto. (* le *) rewrite <- (Float32.cmp_swap Cge n1 n2). simpl. destruct (Float32.cmp Cle n1 n2); auto. (* gt *) - rewrite Float32.cmp_ne_eq. rewrite Float32.cmp_ge_gt_eq. + rewrite Float32.cmp_ne_eq. rewrite Float32.cmp_ge_gt_eq. caseEq (Float32.cmp Cgt n1 n2); intros; simpl. - caseEq (Float32.cmp Ceq n1 n2); intros; simpl. - elimtype False. eapply Float32.cmp_gt_eq_false; eauto. - auto. + caseEq (Float32.cmp Ceq n1 n2); intros; simpl. + elimtype False. eapply Float32.cmp_gt_eq_false; eauto. + auto. destruct (Float32.cmp Ceq n1 n2); auto. (* ge *) destruct (Float32.cmp Cge n1 n2); auto. @@ -739,7 +739,7 @@ Qed. Remark swap_floats_commut: forall (A B: Type) c (f: A -> B) x y, swap_floats c (f x) (f y) = f (swap_floats c x y). Proof. - intros. destruct c; auto. + intros. destruct c; auto. Qed. Remark compare_floats_inv: @@ -747,10 +747,10 @@ Remark compare_floats_inv: r <> CR ZF -> r <> CR CF -> r <> CR PF -> r <> CR SF -> r <> CR OF -> compare_floats vx vy rs r = rs r. Proof. - intros. + intros. assert (DFL: undef_regs (CR ZF :: CR CF :: CR PF :: CR SF :: CR OF :: nil) rs r = rs r). - simpl. Simplifs. - unfold compare_floats; destruct vx; destruct vy; auto. Simplifs. + simpl. Simplifs. + unfold compare_floats; destruct vx; destruct vy; auto. Simplifs. Qed. Remark compare_floats32_inv: @@ -758,10 +758,10 @@ Remark compare_floats32_inv: r <> CR ZF -> r <> CR CF -> r <> CR PF -> r <> CR SF -> r <> CR OF -> compare_floats32 vx vy rs r = rs r. Proof. - intros. + intros. assert (DFL: undef_regs (CR ZF :: CR CF :: CR PF :: CR SF :: CR OF :: nil) rs r = rs r). - simpl. Simplifs. - unfold compare_floats32; destruct vx; destruct vy; auto. Simplifs. + simpl. Simplifs. + unfold compare_floats32; destruct vx; destruct vy; auto. Simplifs. Qed. Lemma transl_cond_correct: @@ -775,83 +775,83 @@ Lemma transl_cond_correct: end /\ forall r, data_preg r = true -> rs'#r = rs r. Proof. - unfold transl_cond; intros. + unfold transl_cond; intros. destruct cond; repeat (destruct args; try discriminate); monadInv H. (* comp *) simpl. rewrite (ireg_of_eq _ _ EQ). rewrite (ireg_of_eq _ _ EQ1). econstructor. split. apply exec_straight_one. simpl. eauto. auto. split. destruct (Val.cmp_bool c0 (rs x) (rs x0)) eqn:?; auto. - eapply testcond_for_signed_comparison_correct; eauto. + eapply testcond_for_signed_comparison_correct; eauto. intros. unfold compare_ints. Simplifs. (* compu *) simpl. rewrite (ireg_of_eq _ _ EQ). rewrite (ireg_of_eq _ _ EQ1). econstructor. split. apply exec_straight_one. simpl. eauto. auto. split. destruct (Val.cmpu_bool (Mem.valid_pointer m) c0 (rs x) (rs x0)) eqn:?; auto. - eapply testcond_for_unsigned_comparison_correct; eauto. + eapply testcond_for_unsigned_comparison_correct; eauto. intros. unfold compare_ints. Simplifs. (* compimm *) simpl. rewrite (ireg_of_eq _ _ EQ). destruct (Int.eq_dec i Int.zero). - econstructor; split. apply exec_straight_one. simpl; eauto. auto. + econstructor; split. apply exec_straight_one. simpl; eauto. auto. split. destruct (rs x); simpl; auto. subst. rewrite Int.and_idem. - eapply testcond_for_signed_comparison_correct; eauto. + eapply testcond_for_signed_comparison_correct; eauto. intros. unfold compare_ints. Simplifs. - econstructor; split. apply exec_straight_one. simpl; eauto. auto. + econstructor; split. apply exec_straight_one. simpl; eauto. auto. split. destruct (Val.cmp_bool c0 (rs x) (Vint i)) eqn:?; auto. - eapply testcond_for_signed_comparison_correct; eauto. + eapply testcond_for_signed_comparison_correct; eauto. intros. unfold compare_ints. Simplifs. (* compuimm *) simpl. rewrite (ireg_of_eq _ _ EQ). econstructor. split. apply exec_straight_one. simpl. eauto. auto. split. destruct (Val.cmpu_bool (Mem.valid_pointer m) c0 (rs x) (Vint i)) eqn:?; auto. - eapply testcond_for_unsigned_comparison_correct; eauto. + eapply testcond_for_unsigned_comparison_correct; eauto. intros. unfold compare_ints. Simplifs. (* compf *) simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1). exists (nextinstr (compare_floats (swap_floats c0 (rs x) (rs x0)) (swap_floats c0 (rs x0) (rs x)) rs)). - split. apply exec_straight_one. + split. apply exec_straight_one. destruct c0; simpl; auto. - unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats_inv; auto with asmgen. + unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats_inv; auto with asmgen. split. destruct (rs x); destruct (rs x0); simpl; auto. repeat rewrite swap_floats_commut. apply testcond_for_float_comparison_correct. - intros. Simplifs. apply compare_floats_inv; auto with asmgen. + intros. Simplifs. apply compare_floats_inv; auto with asmgen. (* notcompf *) simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1). exists (nextinstr (compare_floats (swap_floats c0 (rs x) (rs x0)) (swap_floats c0 (rs x0) (rs x)) rs)). - split. apply exec_straight_one. + split. apply exec_straight_one. destruct c0; simpl; auto. - unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats_inv; auto with asmgen. + unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats_inv; auto with asmgen. split. destruct (rs x); destruct (rs x0); simpl; auto. repeat rewrite swap_floats_commut. apply testcond_for_neg_float_comparison_correct. - intros. Simplifs. apply compare_floats_inv; auto with asmgen. + intros. Simplifs. apply compare_floats_inv; auto with asmgen. (* compfs *) simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1). exists (nextinstr (compare_floats32 (swap_floats c0 (rs x) (rs x0)) (swap_floats c0 (rs x0) (rs x)) rs)). - split. apply exec_straight_one. + split. apply exec_straight_one. destruct c0; simpl; auto. - unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats32_inv; auto with asmgen. + unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats32_inv; auto with asmgen. split. destruct (rs x); destruct (rs x0); simpl; auto. repeat rewrite swap_floats_commut. apply testcond_for_float32_comparison_correct. - intros. Simplifs. apply compare_floats32_inv; auto with asmgen. + intros. Simplifs. apply compare_floats32_inv; auto with asmgen. (* notcompfs *) simpl. rewrite (freg_of_eq _ _ EQ). rewrite (freg_of_eq _ _ EQ1). exists (nextinstr (compare_floats32 (swap_floats c0 (rs x) (rs x0)) (swap_floats c0 (rs x0) (rs x)) rs)). - split. apply exec_straight_one. + split. apply exec_straight_one. destruct c0; simpl; auto. - unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats32_inv; auto with asmgen. + unfold nextinstr. rewrite Pregmap.gss. rewrite compare_floats32_inv; auto with asmgen. split. destruct (rs x); destruct (rs x0); simpl; auto. repeat rewrite swap_floats_commut. apply testcond_for_neg_float32_comparison_correct. - intros. Simplifs. apply compare_floats32_inv; auto with asmgen. + intros. Simplifs. apply compare_floats32_inv; auto with asmgen. (* maskzero *) simpl. rewrite (ireg_of_eq _ _ EQ). econstructor. split. apply exec_straight_one. simpl; eauto. auto. - split. destruct (rs x); simpl; auto. + split. destruct (rs x); simpl; auto. generalize (compare_ints_spec rs (Vint (Int.and i0 i)) Vzero m). intros [A B]. rewrite A. unfold Val.cmpu; simpl. destruct (Int.eq (Int.and i0 i) Int.zero); auto. intros. unfold compare_ints. Simplifs. (* masknotzero *) simpl. rewrite (ireg_of_eq _ _ EQ). econstructor. split. apply exec_straight_one. simpl; eauto. auto. - split. destruct (rs x); simpl; auto. + split. destruct (rs x); simpl; auto. generalize (compare_ints_spec rs (Vint (Int.and i0 i)) Vzero m). intros [A B]. rewrite A. unfold Val.cmpu; simpl. destruct (Int.eq (Int.and i0 i) Int.zero); auto. intros. unfold compare_ints. Simplifs. @@ -879,8 +879,8 @@ Proof. intros. destruct cond; simpl in *. - (* base *) econstructor; split. - apply exec_straight_one. simpl; eauto. auto. - split. Simplifs. intros; Simplifs. + apply exec_straight_one. simpl; eauto. auto. + split. Simplifs. intros; Simplifs. - (* or *) assert (Val.of_optbool match eval_testcond c1 rs1 with @@ -892,7 +892,7 @@ Proof. | None => None end = Val.or (Val.of_optbool (eval_testcond c1 rs1)) (Val.of_optbool (eval_testcond c2 rs1))). - destruct (eval_testcond c1 rs1). destruct (eval_testcond c2 rs1). + destruct (eval_testcond c1 rs1). destruct (eval_testcond c2 rs1). destruct b; destruct b0; auto. destruct b; auto. auto. @@ -908,11 +908,11 @@ Proof. econstructor; split. eapply exec_straight_three. simpl; eauto. - simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg. eauto. - simpl. eauto. + simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg. eauto. + simpl. eauto. auto. auto. auto. split. Simplifs. rewrite Val.or_commut. decEq; Simplifs. - intros. destruct H0; Simplifs. + intros. destruct H0; Simplifs. - (* and *) assert (Val.of_optbool match eval_testcond c1 rs1 with @@ -925,7 +925,7 @@ Proof. end = Val.and (Val.of_optbool (eval_testcond c1 rs1)) (Val.of_optbool (eval_testcond c2 rs1))). { - destruct (eval_testcond c1 rs1). destruct (eval_testcond c2 rs1). + destruct (eval_testcond c1 rs1). destruct (eval_testcond c2 rs1). destruct b; destruct b0; auto. destruct b; auto. auto. @@ -942,11 +942,11 @@ Proof. econstructor; split. eapply exec_straight_three. simpl; eauto. - simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg. eauto. - simpl. eauto. + simpl. rewrite eval_testcond_nextinstr. repeat rewrite eval_testcond_set_ireg. eauto. + simpl. eauto. auto. auto. auto. split. Simplifs. rewrite Val.and_commut. decEq; Simplifs. - intros. destruct H0; Simplifs. + intros. destruct H0; Simplifs. Qed. Lemma mk_setcc_correct: @@ -959,10 +959,10 @@ Proof. intros. unfold mk_setcc. destruct (low_ireg rd). - apply mk_setcc_base_correct. - exploit mk_setcc_base_correct. intros [rs2 [A [B C]]]. - econstructor; split. eapply exec_straight_trans. eexact A. apply exec_straight_one. + econstructor; split. eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl. eauto. simpl. auto. - intuition Simplifs. -Qed. + intuition Simplifs. +Qed. (** Translation of arithmetic operations. *) @@ -980,7 +980,7 @@ Ltac ArgsInv := Ltac TranslOp := econstructor; split; - [ apply exec_straight_one; [ simpl; eauto | auto ] + [ apply exec_straight_one; [ simpl; eauto | auto ] | split; [ Simplifs | intros; Simplifs ]]. Lemma transl_op_correct: @@ -1005,12 +1005,12 @@ Transparent destroyed_by_op. /\ forall r, data_preg r = true -> r <> preg_of res -> preg_notin r (destroyed_by_op op) -> rs' r = rs r). { intros [rs' [A [B C]]]. subst v. exists rs'; auto. - } + } destruct op; simpl in TR; ArgsInv; simpl in EV; try (inv EV); try (apply SAME; TranslOp; fail). (* move *) - exploit mk_mov_correct; eauto. intros [rs2 [A [B C]]]. - apply SAME. exists rs2. eauto. + exploit mk_mov_correct; eauto. intros [rs2 [A [B C]]]. + apply SAME. exists rs2. eauto. (* intconst *) apply SAME. destruct (Int.eq_dec i Int.zero). subst i. TranslOp. TranslOp. (* floatconst *) @@ -1020,39 +1020,39 @@ Transparent destroyed_by_op. (* cast8signed *) apply SAME. eapply mk_intconv_correct; eauto. (* cast8unsigned *) - apply SAME. eapply mk_intconv_correct; eauto. + apply SAME. eapply mk_intconv_correct; eauto. (* cast16signed *) apply SAME. eapply mk_intconv_correct; eauto. (* cast16unsigned *) apply SAME. eapply mk_intconv_correct; eauto. (* mulhs *) - apply SAME. TranslOp. destruct H1. Simplifs. + apply SAME. TranslOp. destruct H1. Simplifs. (* mulhu *) - apply SAME. TranslOp. destruct H1. Simplifs. + apply SAME. TranslOp. destruct H1. Simplifs. (* div *) apply SAME. - specialize (divs_mods_exist (rs EAX) (rs ECX)). rewrite H0. + specialize (divs_mods_exist (rs EAX) (rs ECX)). rewrite H0. destruct (Val.mods (rs EAX) (rs ECX)) as [vr|] eqn:?; intros; try contradiction. TranslOp. change (rs#EDX<-Vundef ECX) with (rs#ECX). rewrite H0; rewrite Heqo. eauto. auto. auto. simpl in H3. destruct H3; Simplifs. (* divu *) apply SAME. - specialize (divu_modu_exist (rs EAX) (rs ECX)). rewrite H0. + specialize (divu_modu_exist (rs EAX) (rs ECX)). rewrite H0. destruct (Val.modu (rs EAX) (rs ECX)) as [vr|] eqn:?; intros; try contradiction. TranslOp. change (rs#EDX<-Vundef ECX) with (rs#ECX). rewrite H0; rewrite Heqo. eauto. auto. auto. simpl in H3. destruct H3; Simplifs. (* mod *) apply SAME. - specialize (divs_mods_exist (rs EAX) (rs ECX)). rewrite H0. + specialize (divs_mods_exist (rs EAX) (rs ECX)). rewrite H0. destruct (Val.divs (rs EAX) (rs ECX)) as [vr|] eqn:?; intros; try contradiction. TranslOp. change (rs#EDX<-Vundef ECX) with (rs#ECX). rewrite H0; rewrite Heqo. eauto. auto. auto. simpl in H3. destruct H3; Simplifs. (* modu *) apply SAME. - specialize (divu_modu_exist (rs EAX) (rs ECX)). rewrite H0. + specialize (divu_modu_exist (rs EAX) (rs ECX)). rewrite H0. destruct (Val.divu (rs EAX) (rs ECX)) as [vr|] eqn:?; intros; try contradiction. TranslOp. change (rs#EDX<-Vundef ECX) with (rs#ECX). rewrite H0; rewrite Heqo. eauto. auto. auto. @@ -1093,7 +1093,7 @@ Lemma transl_load_correct: /\ rs'#(preg_of dest) = v /\ forall r, data_preg r = true -> r <> preg_of dest -> rs'#r = rs#r. Proof. - unfold transl_load; intros. monadInv H. + unfold transl_load; intros. monadInv H. exploit transl_addressing_mode_correct; eauto. intro EA. assert (EA': eval_addrmode ge x rs = a). destruct a; simpl in H1; try discriminate; inv EA; auto. set (rs2 := nextinstr_nf (rs#(preg_of dest) <- v)). @@ -1102,10 +1102,10 @@ Proof. assert (rs2 PC = Val.add (rs PC) Vone). transitivity (Val.add ((rs#(preg_of dest) <- v) PC) Vone). auto. decEq. apply Pregmap.gso; auto with asmgen. - exists rs2. split. + exists rs2. split. destruct chunk; ArgsInv; apply exec_straight_one; auto. split. unfold rs2. rewrite nextinstr_nf_inv1. Simplifs. apply preg_of_data. - intros. unfold rs2. Simplifs. + intros. unfold rs2. Simplifs. Qed. Lemma transl_store_correct: @@ -1117,7 +1117,7 @@ Lemma transl_store_correct: exec_straight ge fn c rs m k rs' m' /\ forall r, data_preg r = true -> preg_notin r (destroyed_by_store chunk addr) -> rs'#r = rs#r. Proof. - unfold transl_store; intros. monadInv H. + unfold transl_store; intros. monadInv H. exploit transl_addressing_mode_correct; eauto. intro EA. assert (EA': eval_addrmode ge x rs = a). destruct a; simpl in H1; try discriminate; inv EA; auto. rewrite <- EA' in H1. destruct chunk; ArgsInv. @@ -1129,7 +1129,7 @@ Proof. eapply mk_smallstore_correct; eauto. (* int16signed *) econstructor; split. - apply exec_straight_one. simpl. unfold exec_store. + apply exec_straight_one. simpl. unfold exec_store. replace (Mem.storev Mint16unsigned m (eval_addrmode ge x rs) (rs x0)) with (Mem.storev Mint16signed m (eval_addrmode ge x rs) (rs x0)). rewrite H1. eauto. diff --git a/ia32/CBuiltins.ml b/ia32/CBuiltins.ml index b1be612b..125e71d5 100644 --- a/ia32/CBuiltins.ml +++ b/ia32/CBuiltins.ml @@ -41,19 +41,19 @@ let builtins = { "__builtin_fmin", (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, [])], false); "__builtin_fmadd", - (TFloat(FDouble, []), + (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); "__builtin_fmsub", - (TFloat(FDouble, []), + (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); "__builtin_fnmadd", - (TFloat(FDouble, []), + (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); "__builtin_fnmsub", - (TFloat(FDouble, []), + (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); (* Memory accesses *) diff --git a/ia32/CombineOp.v b/ia32/CombineOp.v index ca54ba1b..cdd16071 100644 --- a/ia32/CombineOp.v +++ b/ia32/CombineOp.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Recognition of combined operations, addressing modes and conditions +(** Recognition of combined operations, addressing modes and conditions during the [CSE] phase. *) Require Import Coqlib. diff --git a/ia32/CombineOpproof.v b/ia32/CombineOpproof.v index 1e5b9321..8f600054 100644 --- a/ia32/CombineOpproof.v +++ b/ia32/CombineOpproof.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Recognition of combined operations, addressing modes and conditions +(** Recognition of combined operations, addressing modes and conditions during the [CSE] phase. *) Require Import Coqlib. @@ -34,7 +34,7 @@ Hypothesis get_sound: forall v rhs, get v = Some rhs -> rhs_eval_to valu ge sp m Lemma get_op_sound: forall v op vl, get v = Some (Op op vl) -> eval_operation ge sp op (map valu vl) m = Some (valu v). Proof. - intros. exploit get_sound; eauto. intros REV; inv REV; auto. + intros. exploit get_sound; eauto. intros REV; inv REV; auto. Qed. Ltac UseGetSound := @@ -42,7 +42,7 @@ Ltac UseGetSound := | [ H: get _ = Some _ |- _ ] => let x := fresh "EQ" in (generalize (get_op_sound _ _ _ H); intros x; simpl in x; FuncInv) end. - + Lemma combine_compimm_ne_0_sound: forall x cond args, combine_compimm_ne_0 get x = Some(cond, args) -> @@ -51,11 +51,11 @@ Lemma combine_compimm_ne_0_sound: Proof. intros until args. functional induction (combine_compimm_ne_0 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. + UseGetSound. rewrite <- H. destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto. (* of and *) - UseGetSound. rewrite <- H. - destruct v; simpl; auto. + UseGetSound. rewrite <- H. + destruct v; simpl; auto. Qed. Lemma combine_compimm_eq_0_sound: @@ -67,10 +67,10 @@ Proof. intros until args. functional induction (combine_compimm_eq_0 get x); intros EQ; inv EQ. (* of cmp *) UseGetSound. rewrite <- H. - rewrite eval_negate_condition. + rewrite eval_negate_condition. destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto. (* of and *) - UseGetSound. rewrite <- H. destruct v; auto. + UseGetSound. rewrite <- H. destruct v; auto. Qed. Lemma combine_compimm_eq_1_sound: @@ -81,7 +81,7 @@ Lemma combine_compimm_eq_1_sound: Proof. intros until args. functional induction (combine_compimm_eq_1 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. + UseGetSound. rewrite <- H. destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto. Qed. @@ -93,7 +93,7 @@ Lemma combine_compimm_ne_1_sound: Proof. intros until args. functional induction (combine_compimm_ne_1 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. + UseGetSound. rewrite <- H. rewrite eval_negate_condition. destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto. Qed. @@ -129,7 +129,7 @@ Theorem combine_addr_sound: Proof. intros. functional inversion H; subst. (* indexed - lea *) - UseGetSound. simpl. eapply eval_offset_addressing_total; eauto. + UseGetSound. simpl. eapply eval_offset_addressing_total; eauto. Qed. Theorem combine_op_sound: @@ -139,7 +139,7 @@ Theorem combine_op_sound: Proof. intros. functional inversion H; subst. (* lea-lea *) - simpl. eapply combine_addr_sound; eauto. + simpl. eapply combine_addr_sound; eauto. (* andimm - andimm *) UseGetSound; simpl. rewrite <- H0. rewrite Val.and_assoc. auto. (* orimm - orimm *) diff --git a/ia32/ConstpropOpproof.v b/ia32/ConstpropOpproof.v index 47a6c536..3dfb8ccf 100644 --- a/ia32/ConstpropOpproof.v +++ b/ia32/ConstpropOpproof.v @@ -48,7 +48,7 @@ Lemma match_G: forall r id ofs, AE.get r ae = Ptr(Gl id ofs) -> Val.lessdef e#r (Genv.symbol_address ge id ofs). Proof. - intros. apply vmatch_ptr_gl with bc; auto. rewrite <- H. apply MATCH. + intros. apply vmatch_ptr_gl with bc; auto. rewrite <- H. apply MATCH. Qed. Lemma match_S: @@ -60,9 +60,9 @@ Qed. Ltac InvApproxRegs := match goal with - | [ H: _ :: _ = _ :: _ |- _ ] => + | [ H: _ :: _ = _ :: _ |- _ ] => injection H; clear H; intros; InvApproxRegs - | [ H: ?v = AE.get ?r ae |- _ ] => + | [ H: ?v = AE.get ?r ae |- _ ] => generalize (MATCH r); rewrite <- H; clear H; intro; InvApproxRegs | _ => idtac end. @@ -83,11 +83,11 @@ Ltac SimplVM := rewrite E in *; clear H; SimplVM | [ H: vmatch _ ?v (Ptr(Gl ?id ?ofs)) |- _ ] => let E := fresh in - assert (E: Val.lessdef v (Genv.symbol_address ge id ofs)) by (eapply vmatch_ptr_gl; eauto); + assert (E: Val.lessdef v (Genv.symbol_address ge id ofs)) by (eapply vmatch_ptr_gl; eauto); clear H; SimplVM | [ H: vmatch _ ?v (Ptr(Stk ?ofs)) |- _ ] => let E := fresh in - assert (E: Val.lessdef v (Vptr sp ofs)) by (eapply vmatch_ptr_stk; eauto); + assert (E: Val.lessdef v (Vptr sp ofs)) by (eapply vmatch_ptr_stk; eauto); clear H; SimplVM | _ => idtac end. @@ -120,35 +120,35 @@ Proof. - rewrite Genv.shift_symbol_address. econstructor; split. eauto. apply Val.add_lessdef; auto. - econstructor; split; eauto. rewrite Int.add_zero_l. change (Vptr sp (Int.add n ofs)) with (Val.add (Vptr sp n) (Vint ofs)). apply Val.add_lessdef; auto. -- econstructor; split; eauto. rewrite Int.add_assoc. rewrite Genv.shift_symbol_address. +- econstructor; split; eauto. rewrite Int.add_assoc. rewrite Genv.shift_symbol_address. rewrite Val.add_assoc. apply Val.add_lessdef; auto. - econstructor; split; eauto. fold (Val.add (Vint n1) e#r2). rewrite (Val.add_commut (Vint n1)). rewrite Genv.shift_symbol_address. apply Val.add_lessdef; auto. - rewrite Int.add_commut. rewrite Genv.shift_symbol_address. apply Val.add_lessdef; auto. -- econstructor; split; eauto. rewrite Int.add_zero_l. rewrite Int.add_assoc. + rewrite Int.add_commut. rewrite Genv.shift_symbol_address. apply Val.add_lessdef; auto. +- econstructor; split; eauto. rewrite Int.add_zero_l. rewrite Int.add_assoc. change (Vptr sp (Int.add n1 (Int.add n2 ofs))) with (Val.add (Vptr sp n1) (Vint (Int.add n2 ofs))). - rewrite Val.add_assoc. apply Val.add_lessdef; auto. -- econstructor; split; eauto. rewrite Int.add_zero_l. - fold (Val.add (Vint n1) e#r2). rewrite (Int.add_commut n1). + rewrite Val.add_assoc. apply Val.add_lessdef; auto. +- econstructor; split; eauto. rewrite Int.add_zero_l. + fold (Val.add (Vint n1) e#r2). rewrite (Int.add_commut n1). change (Vptr sp (Int.add (Int.add n2 n1) ofs)) with (Val.add (Val.add (Vint n1) (Vptr sp n2)) (Vint ofs)). - apply Val.add_lessdef; auto. apply Val.add_lessdef; auto. -- econstructor; split; eauto. rewrite Genv.shift_symbol_address. - rewrite ! Val.add_assoc. apply Val.add_lessdef; auto. - rewrite Val.add_commut. apply Val.add_lessdef; auto. + apply Val.add_lessdef; auto. apply Val.add_lessdef; auto. +- econstructor; split; eauto. rewrite Genv.shift_symbol_address. + rewrite ! Val.add_assoc. apply Val.add_lessdef; auto. + rewrite Val.add_commut. apply Val.add_lessdef; auto. - econstructor; split; eauto. rewrite Genv.shift_symbol_address. rewrite (Val.add_commut e#r1). rewrite ! Val.add_assoc. apply Val.add_lessdef; auto. rewrite Val.add_commut. apply Val.add_lessdef; auto. -- fold (Val.add (Vint n1) e#r2). econstructor; split; eauto. - rewrite (Val.add_commut (Vint n1)). rewrite Val.add_assoc. - apply Val.add_lessdef; eauto. +- fold (Val.add (Vint n1) e#r2). econstructor; split; eauto. + rewrite (Val.add_commut (Vint n1)). rewrite Val.add_assoc. + apply Val.add_lessdef; eauto. - econstructor; split; eauto. rewrite ! Val.add_assoc. - apply Val.add_lessdef; eauto. -- econstructor; split; eauto. rewrite Int.add_assoc. - rewrite Genv.shift_symbol_address. apply Val.add_lessdef; auto. -- econstructor; split; eauto. + apply Val.add_lessdef; eauto. +- econstructor; split; eauto. rewrite Int.add_assoc. + rewrite Genv.shift_symbol_address. apply Val.add_lessdef; auto. +- econstructor; split; eauto. rewrite Genv.shift_symbol_address. rewrite ! Val.add_assoc. apply Val.add_lessdef; auto. rewrite Val.add_commut; auto. - econstructor; split; eauto. @@ -161,20 +161,20 @@ Lemma make_cmp_base_correct: forall c args vl, vl = map (fun r => AE.get r ae) args -> let (op', args') := make_cmp_base c args vl in - exists v, eval_operation ge (Vptr sp Int.zero) op' e##args' m = Some v + exists v, eval_operation ge (Vptr sp Int.zero) op' e##args' m = Some v /\ Val.lessdef (Val.of_optbool (eval_condition c e##args m)) v. Proof. - intros. unfold make_cmp_base. - generalize (cond_strength_reduction_correct c args vl H). + intros. unfold make_cmp_base. + generalize (cond_strength_reduction_correct c args vl H). destruct (cond_strength_reduction c args vl) as [c' args']. intros EQ. - econstructor; split. simpl; eauto. rewrite EQ. auto. + econstructor; split. simpl; eauto. rewrite EQ. auto. Qed. Lemma make_cmp_correct: forall c args vl, vl = map (fun r => AE.get r ae) args -> let (op', args') := make_cmp c args vl in - exists v, eval_operation ge (Vptr sp Int.zero) op' e##args' m = Some v + exists v, eval_operation ge (Vptr sp Int.zero) op' e##args' m = Some v /\ Val.lessdef (Val.of_optbool (eval_condition c e##args m)) v. Proof. intros c args vl. @@ -183,20 +183,20 @@ Proof. { intros. apply vmatch_Uns_1 with bc Ptop. eapply vmatch_ge. eapply vincl_ge; eauto. apply MATCH. } unfold make_cmp. case (make_cmp_match c args vl); intros. - destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (e#r1); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (Val.xor e#r1 (Vint Int.one)); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. apply make_cmp_base_correct; auto. - destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (e#r1); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (Val.xor e#r1 (Vint Int.one)); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. apply make_cmp_base_correct; auto. @@ -209,11 +209,11 @@ Lemma make_addimm_correct: exists v, eval_operation ge (Vptr sp Int.zero) op e##args m = Some v /\ Val.lessdef (Val.add e#r (Vint n)) v. Proof. intros. unfold make_addimm. - predSpec Int.eq Int.eq_spec n Int.zero; intros. + predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (e#r); split; auto. destruct (e#r); simpl; auto; rewrite Int.add_zero; auto. exists (Val.add e#r (Vint n)); auto. Qed. - + Lemma make_shlimm_correct: forall n r1 r2, e#r2 = Vint n -> @@ -223,7 +223,7 @@ Proof. intros; unfold make_shlimm. predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (e#r1); split; auto. destruct (e#r1); simpl; auto. rewrite Int.shl_zero. auto. - destruct (Int.ltu n Int.iwordsize). + destruct (Int.ltu n Int.iwordsize). econstructor; split. simpl. eauto. auto. econstructor; split. simpl. eauto. rewrite H; auto. Qed. @@ -237,7 +237,7 @@ Proof. intros; unfold make_shrimm. predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (e#r1); split; auto. destruct (e#r1); simpl; auto. rewrite Int.shr_zero. auto. - destruct (Int.ltu n Int.iwordsize). + destruct (Int.ltu n Int.iwordsize). econstructor; split. simpl. eauto. auto. econstructor; split. simpl. eauto. rewrite H; auto. Qed. @@ -251,7 +251,7 @@ Proof. intros; unfold make_shruimm. predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (e#r1); split; auto. destruct (e#r1); simpl; auto. rewrite Int.shru_zero. auto. - destruct (Int.ltu n Int.iwordsize). + destruct (Int.ltu n Int.iwordsize). econstructor; split. simpl. eauto. auto. econstructor; split. simpl. eauto. rewrite H; auto. Qed. @@ -268,7 +268,7 @@ Proof. exists (e#r1); split; auto. destruct (e#r1); simpl; auto. rewrite Int.mul_one; auto. destruct (Int.is_power2 n) eqn:?; intros. rewrite (Val.mul_pow2 e#r1 _ _ Heqo). econstructor; split. simpl; eauto. auto. - econstructor; split; eauto. auto. + econstructor; split; eauto. auto. Qed. Lemma make_divimm_correct: @@ -281,7 +281,7 @@ Proof. intros; unfold make_divimm. destruct (Int.is_power2 n) eqn:?. destruct (Int.ltu i (Int.repr 31)) eqn:?. - exists v; split; auto. simpl. eapply Val.divs_pow2; eauto. congruence. + exists v; split; auto. simpl. eapply Val.divs_pow2; eauto. congruence. exists v; auto. exists v; auto. Qed. @@ -295,7 +295,7 @@ Lemma make_divuimm_correct: Proof. intros; unfold make_divuimm. destruct (Int.is_power2 n) eqn:?. - econstructor; split. simpl; eauto. + econstructor; split. simpl; eauto. rewrite H0 in H. erewrite Val.divu_pow2 by eauto. auto. exists v; auto. Qed. @@ -326,17 +326,17 @@ Proof. subst n. exists (e#r); split; auto. destruct (e#r); simpl; auto. rewrite Int.and_mone; auto. destruct (match x with Uns _ k => Int.eq (Int.zero_ext k (Int.not n)) Int.zero | _ => false end) eqn:UNS. - destruct x; try congruence. + destruct x; try congruence. exists (e#r); split; auto. inv H; auto. simpl. replace (Int.and i n) with i; auto. generalize (Int.eq_spec (Int.zero_ext n0 (Int.not n)) Int.zero); rewrite UNS; intro EQ. Int.bit_solve. destruct (zlt i0 n0). replace (Int.testbit n i0) with (negb (Int.testbit Int.zero i0)). - rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. - rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. - rewrite Int.bits_not by auto. apply negb_involutive. - rewrite H6 by auto. auto. - econstructor; split; eauto. auto. + rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. + rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. + rewrite Int.bits_not by auto. apply negb_involutive. + rewrite H6 by auto. auto. + econstructor; split; eauto. auto. Qed. Lemma make_orimm_correct: @@ -349,7 +349,7 @@ Proof. subst n. exists (e#r); split; auto. destruct (e#r); simpl; auto. rewrite Int.or_zero; auto. predSpec Int.eq Int.eq_spec n Int.mone; intros. subst n. exists (Vint Int.mone); split; auto. destruct (e#r); simpl; auto. rewrite Int.or_mone; auto. - econstructor; split; eauto. auto. + econstructor; split; eauto. auto. Qed. Lemma make_xorimm_correct: @@ -361,8 +361,8 @@ Proof. predSpec Int.eq Int.eq_spec n Int.zero; intros. subst n. exists (e#r); split; auto. destruct (e#r); simpl; auto. rewrite Int.xor_zero; auto. predSpec Int.eq Int.eq_spec n Int.mone; intros. - subst n. exists (Val.notint e#r); split; auto. - econstructor; split; eauto. auto. + subst n. exists (Val.notint e#r); split; auto. + econstructor; split; eauto. auto. Qed. Lemma make_mulfimm_correct: @@ -371,11 +371,11 @@ Lemma make_mulfimm_correct: let (op, args) := make_mulfimm n r1 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op e##args m = Some v /\ Val.lessdef (Val.mulf e#r1 e#r2) v. Proof. - intros; unfold make_mulfimm. - destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. + intros; unfold make_mulfimm. + destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (e#r1); simpl; auto. rewrite Float.mul2_add; auto. - simpl. econstructor; split; eauto. + destruct (e#r1); simpl; auto. rewrite Float.mul2_add; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_mulfimm_correct_2: @@ -384,12 +384,12 @@ Lemma make_mulfimm_correct_2: let (op, args) := make_mulfimm n r2 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op e##args m = Some v /\ Val.lessdef (Val.mulf e#r1 e#r2) v. Proof. - intros; unfold make_mulfimm. - destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. + intros; unfold make_mulfimm. + destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (e#r2); simpl; auto. rewrite Float.mul2_add; auto. - rewrite Float.mul_commut; auto. - simpl. econstructor; split; eauto. + destruct (e#r2); simpl; auto. rewrite Float.mul2_add; auto. + rewrite Float.mul_commut; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_mulfsimm_correct: @@ -398,11 +398,11 @@ Lemma make_mulfsimm_correct: let (op, args) := make_mulfsimm n r1 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op e##args m = Some v /\ Val.lessdef (Val.mulfs e#r1 e#r2) v. Proof. - intros; unfold make_mulfsimm. - destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. + intros; unfold make_mulfsimm. + destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (e#r1); simpl; auto. rewrite Float32.mul2_add; auto. - simpl. econstructor; split; eauto. + destruct (e#r1); simpl; auto. rewrite Float32.mul2_add; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_mulfsimm_correct_2: @@ -411,12 +411,12 @@ Lemma make_mulfsimm_correct_2: let (op, args) := make_mulfsimm n r2 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op e##args m = Some v /\ Val.lessdef (Val.mulfs e#r1 e#r2) v. Proof. - intros; unfold make_mulfsimm. - destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. + intros; unfold make_mulfsimm. + destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (e#r2); simpl; auto. rewrite Float32.mul2_add; auto. - rewrite Float32.mul_commut; auto. - simpl. econstructor; split; eauto. + destruct (e#r2); simpl; auto. rewrite Float32.mul2_add; auto. + rewrite Float32.mul_commut; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_cast8signed_correct: @@ -425,8 +425,8 @@ Lemma make_cast8signed_correct: let (op, args) := make_cast8signed r x in exists v, eval_operation ge (Vptr sp Int.zero) op e##args m = Some v /\ Val.lessdef (Val.sign_ext 8 e#r) v. Proof. - intros; unfold make_cast8signed. destruct (vincl x (Sgn Ptop 8)) eqn:INCL. - exists e#r; split; auto. + intros; unfold make_cast8signed. destruct (vincl x (Sgn Ptop 8)) eqn:INCL. + exists e#r; split; auto. assert (V: vmatch bc e#r (Sgn Ptop 8)). { eapply vmatch_ge; eauto. apply vincl_ge; auto. } inv V; simpl; auto. rewrite is_sgn_sign_ext in H4 by auto. rewrite H4; auto. @@ -439,8 +439,8 @@ Lemma make_cast8unsigned_correct: let (op, args) := make_cast8unsigned r x in exists v, eval_operation ge (Vptr sp Int.zero) op e##args m = Some v /\ Val.lessdef (Val.zero_ext 8 e#r) v. Proof. - intros; unfold make_cast8unsigned. destruct (vincl x (Uns Ptop 8)) eqn:INCL. - exists e#r; split; auto. + intros; unfold make_cast8unsigned. destruct (vincl x (Uns Ptop 8)) eqn:INCL. + exists e#r; split; auto. assert (V: vmatch bc e#r (Uns Ptop 8)). { eapply vmatch_ge; eauto. apply vincl_ge; auto. } inv V; simpl; auto. rewrite is_uns_zero_ext in H4 by auto. rewrite H4; auto. @@ -453,8 +453,8 @@ Lemma make_cast16signed_correct: let (op, args) := make_cast16signed r x in exists v, eval_operation ge (Vptr sp Int.zero) op e##args m = Some v /\ Val.lessdef (Val.sign_ext 16 e#r) v. Proof. - intros; unfold make_cast16signed. destruct (vincl x (Sgn Ptop 16)) eqn:INCL. - exists e#r; split; auto. + intros; unfold make_cast16signed. destruct (vincl x (Sgn Ptop 16)) eqn:INCL. + exists e#r; split; auto. assert (V: vmatch bc e#r (Sgn Ptop 16)). { eapply vmatch_ge; eauto. apply vincl_ge; auto. } inv V; simpl; auto. rewrite is_sgn_sign_ext in H4 by auto. rewrite H4; auto. @@ -467,8 +467,8 @@ Lemma make_cast16unsigned_correct: let (op, args) := make_cast16unsigned r x in exists v, eval_operation ge (Vptr sp Int.zero) op e##args m = Some v /\ Val.lessdef (Val.zero_ext 16 e#r) v. Proof. - intros; unfold make_cast16unsigned. destruct (vincl x (Uns Ptop 16)) eqn:INCL. - exists e#r; split; auto. + intros; unfold make_cast16unsigned. destruct (vincl x (Uns Ptop 16)) eqn:INCL. + exists e#r; split; auto. assert (V: vmatch bc e#r (Uns Ptop 16)). { eapply vmatch_ge; eauto. apply vincl_ge; auto. } inv V; simpl; auto. rewrite is_uns_zero_ext in H4 by auto. rewrite H4; auto. @@ -493,17 +493,17 @@ Proof. (* cast16unsigned *) InvApproxRegs; SimplVM; inv H0. apply make_cast16unsigned_correct; auto. (* sub *) - InvApproxRegs; SimplVM; inv H0. rewrite Val.sub_add_opp. apply make_addimm_correct; auto. + InvApproxRegs; SimplVM; inv H0. rewrite Val.sub_add_opp. apply make_addimm_correct; auto. (* mul *) rewrite Val.mul_commut in H0. InvApproxRegs; SimplVM; inv H0. apply make_mulimm_correct; auto. InvApproxRegs; SimplVM; inv H0. apply make_mulimm_correct; auto. -(* divs *) +(* divs *) assert (e#r2 = Vint n2). clear H0. InvApproxRegs; SimplVM; auto. apply make_divimm_correct; auto. -(* divu *) +(* divu *) assert (e#r2 = Vint n2). clear H0. InvApproxRegs; SimplVM; auto. apply make_divuimm_correct; auto. -(* modu *) +(* modu *) assert (e#r2 = Vint n2). clear H0. InvApproxRegs; SimplVM; auto. apply make_moduimm_correct; auto. (* and *) @@ -523,7 +523,7 @@ Proof. (* shru *) InvApproxRegs; SimplVM; inv H0. apply make_shruimm_correct; auto. (* lea *) - exploit addr_strength_reduction_correct; eauto. + exploit addr_strength_reduction_correct; eauto. destruct (addr_strength_reduction addr args0 vl0) as [addr' args']. auto. (* cond *) diff --git a/ia32/Conventions1.v b/ia32/Conventions1.v index ef9ab6b9..11420d48 100644 --- a/ia32/Conventions1.v +++ b/ia32/Conventions1.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Function calling conventions and other conventions regarding the use of +(** Function calling conventions and other conventions regarding the use of machine registers and stack slots. *) Require Import Coqlib. @@ -106,19 +106,19 @@ Proof. Qed. Lemma index_int_callee_save_inj: - forall r1 r2, + forall r1 r2, In r1 int_callee_save_regs -> In r2 int_callee_save_regs -> r1 <> r2 -> index_int_callee_save r1 <> index_int_callee_save r2. Proof. - intros r1 r2. + intros r1 r2. simpl; ElimOrEq; ElimOrEq; unfold index_int_callee_save; intros; congruence. Qed. Lemma index_float_callee_save_inj: - forall r1 r2, + forall r1 r2, In r1 float_callee_save_regs -> In r2 float_callee_save_regs -> r1 <> r2 -> @@ -138,24 +138,24 @@ Proof. Qed. Lemma register_classification: - forall r, + forall r, In r destroyed_at_call \/ In r int_callee_save_regs \/ In r float_callee_save_regs. Proof. - destruct r; + destruct r; try (left; simpl; OrEq); try (right; left; simpl; OrEq); try (right; right; simpl; OrEq). Qed. Lemma int_callee_save_not_destroyed: - forall r, + forall r, In r destroyed_at_call -> In r int_callee_save_regs -> False. Proof. intros. revert H0 H. simpl. ElimOrEq; NotOrEq. Qed. Lemma float_callee_save_not_destroyed: - forall r, + forall r, In r destroyed_at_call -> In r float_callee_save_regs -> False. Proof. intros. revert H0 H. simpl. ElimOrEq; NotOrEq. @@ -198,9 +198,9 @@ Qed. (** The functions in this section determine the locations (machine registers and stack slots) used to communicate arguments and results between the caller and the callee during function calls. These locations are functions - of the signature of the function and of the call instruction. + of the signature of the function and of the call instruction. Agreement between the caller and the callee on the locations to use - is guaranteed by our dynamic semantics for Cminor and RTL, which demand + is guaranteed by our dynamic semantics for Cminor and RTL, which demand that the signature of the call instruction is identical to that of the called function. @@ -282,7 +282,7 @@ Fixpoint size_arguments_rec Definition size_arguments (s: signature) : Z := size_arguments_rec s.(sig_args) 0. -(** Argument locations are either caller-save registers or [Outgoing] +(** Argument locations are either caller-save registers or [Outgoing] stack slots at nonnegative offsets. *) Definition loc_argument_acceptable (l: loc) : Prop := @@ -302,7 +302,7 @@ Remark loc_arguments_rec_charact: Proof. induction tyl; simpl loc_arguments_rec; intros. - destruct H. -- assert (REC: forall ofs1, In l (loc_arguments_rec tyl ofs1) -> ofs1 > ofs -> +- assert (REC: forall ofs1, In l (loc_arguments_rec tyl ofs1) -> ofs1 > ofs -> match l with | R _ => False | S Local _ _ => False @@ -320,7 +320,7 @@ Lemma loc_arguments_acceptable: In l (loc_arguments s) -> loc_argument_acceptable l. Proof. unfold loc_arguments; intros. - exploit loc_arguments_rec_charact; eauto. + exploit loc_arguments_rec_charact; eauto. unfold loc_argument_acceptable. destruct l; tauto. Qed. @@ -334,14 +334,14 @@ Remark size_arguments_rec_above: Proof. induction tyl; simpl; intros. omega. - apply Zle_trans with (ofs0 + typesize a); auto. + apply Zle_trans with (ofs0 + typesize a); auto. generalize (typesize_pos a); omega. Qed. Lemma size_arguments_above: forall s, size_arguments s >= 0. Proof. - intros; unfold size_arguments. apply Zle_ge. + intros; unfold size_arguments. apply Zle_ge. apply size_arguments_rec_above. Qed. diff --git a/ia32/Machregs.v b/ia32/Machregs.v index f3801900..34eb0ac8 100644 --- a/ia32/Machregs.v +++ b/ia32/Machregs.v @@ -32,7 +32,7 @@ Inductive mreg: Type := (** Allocatable integer regs *) | AX: mreg | BX: mreg | CX: mreg | DX: mreg | SI: mreg | DI: mreg | BP: mreg (** Allocatable float regs *) - | X0: mreg | X1: mreg | X2: mreg | X3: mreg + | X0: mreg | X1: mreg | X2: mreg | X3: mreg | X4: mreg | X5: mreg | X6: mreg | X7: mreg (** Special float reg *) | FP0: mreg (**r top of x87 FP stack *). diff --git a/ia32/NeedOp.v b/ia32/NeedOp.v index 52b9fcbe..07eec160 100644 --- a/ia32/NeedOp.v +++ b/ia32/NeedOp.v @@ -116,7 +116,7 @@ Proof. intros. destruct cond; simpl in H; try (eapply default_needs_of_condition_sound; eauto; fail); simpl in *; FuncInv; InvAgree. -- eapply maskzero_sound; eauto. +- eapply maskzero_sound; eauto. - destruct (Val.maskzero_bool v i) as [b'|] eqn:MZ; try discriminate. erewrite maskzero_sound; eauto. Qed. @@ -132,8 +132,8 @@ Proof. unfold needs_of_addressing; intros. destruct addr; simpl in *; FuncInv; InvAgree; TrivialExists; auto using add_sound, mul_sound with na. - apply add_sound; auto with na. apply add_sound; rewrite modarith_idem; auto. - apply add_sound; auto. apply add_sound; rewrite modarith_idem; auto with na. + apply add_sound; auto with na. apply add_sound; rewrite modarith_idem; auto. + apply add_sound; auto. apply add_sound; rewrite modarith_idem; auto with na. apply mul_sound; rewrite modarith_idem; auto with na. Qed. @@ -148,9 +148,9 @@ Lemma needs_of_operation_sound: Proof. unfold needs_of_operation; intros; destruct op; try (eapply default_needs_of_operation_sound; eauto; fail); simpl in *; FuncInv; InvAgree; TrivialExists. -- apply sign_ext_sound; auto. compute; auto. +- apply sign_ext_sound; auto. compute; auto. - apply zero_ext_sound; auto. omega. -- apply sign_ext_sound; auto. compute; auto. +- apply sign_ext_sound; auto. compute; auto. - apply zero_ext_sound; auto. omega. - apply neg_sound; auto. - apply mul_sound; auto. @@ -164,10 +164,10 @@ Proof. - apply notint_sound; auto. - apply shlimm_sound; auto. - apply shrimm_sound; auto. -- apply shruimm_sound; auto. -- apply ror_sound; auto. +- apply shruimm_sound; auto. +- apply ror_sound; auto. - eapply needs_of_addressing_sound; eauto. -- destruct (eval_condition c args m) as [b|] eqn:EC; simpl in H2. +- destruct (eval_condition c args m) as [b|] eqn:EC; simpl in H2. erewrite needs_of_condition_sound by eauto. subst v; simpl. auto with na. subst v; auto with na. @@ -185,7 +185,7 @@ Proof. - apply zero_ext_redundant_sound; auto. omega. - apply sign_ext_redundant_sound; auto. omega. - apply zero_ext_redundant_sound; auto. omega. -- apply andimm_redundant_sound; auto. +- apply andimm_redundant_sound; auto. - apply orimm_redundant_sound; auto. Qed. @@ -17,7 +17,7 @@ - [operation]: arithmetic and logical operations; - [addressing]: addressing modes for load and store operations. - These types are IA32-specific and correspond roughly to what the + These types are IA32-specific and correspond roughly to what the processor can compute in one instruction. In other terms, these types reflect the state of the program after instruction selection. For a processor-independent set of operations, see the abstract @@ -49,7 +49,7 @@ Inductive condition : Type := | Cmaskzero: int -> condition (**r test [(arg & constant) == 0] *) | Cmasknotzero: int -> condition. (**r test [(arg & constant) != 0] *) -(** Addressing modes. [r1], [r2], etc, are the arguments to the +(** Addressing modes. [r1], [r2], etc, are the arguments to the addressing. *) Inductive addressing: Type := @@ -475,7 +475,7 @@ Proof with (try exact I). destruct v0; destruct v1... destruct v0... destruct v0... - destruct (eval_condition c vl m); simpl... destruct b... + destruct (eval_condition c vl m); simpl... destruct b... Qed. End SOUNDNESS. @@ -499,7 +499,7 @@ Proof. intros until a. unfold is_move_operation; destruct op; try (intros; discriminate). destruct args. intros; discriminate. - destruct args. intros. intuition congruence. + destruct args. intros. intuition congruence. intros; discriminate. Qed. @@ -529,9 +529,9 @@ Proof. repeat (destruct vl; auto). apply Val.negate_cmpu_bool. repeat (destruct vl; auto). apply Val.negate_cmp_bool. repeat (destruct vl; auto). apply Val.negate_cmpu_bool. - repeat (destruct vl; auto). + repeat (destruct vl; auto). repeat (destruct vl; auto). destruct (Val.cmpf_bool c v v0) as [[]|]; auto. - repeat (destruct vl; auto). + repeat (destruct vl; auto). repeat (destruct vl; auto). destruct (Val.cmpfs_bool c v v0) as [[]|]; auto. destruct vl; auto. destruct vl; auto. destruct vl; auto. destruct vl; auto. destruct (Val.maskzero_bool v i) as [[]|]; auto. @@ -554,13 +554,13 @@ Definition shift_stack_operation (delta: int) (op: operation) := Lemma type_shift_stack_addressing: forall delta addr, type_of_addressing (shift_stack_addressing delta addr) = type_of_addressing addr. Proof. - intros. destruct addr; auto. + intros. destruct addr; auto. Qed. Lemma type_shift_stack_operation: forall delta op, type_of_operation (shift_stack_operation delta op) = type_of_operation op. Proof. - intros. destruct op; auto. simpl. decEq. apply type_shift_stack_addressing. + intros. destruct op; auto. simpl. decEq. apply type_shift_stack_addressing. Qed. Lemma eval_shift_stack_addressing: @@ -578,7 +578,7 @@ Lemma eval_shift_stack_operation: eval_operation ge (Val.add sp (Vint delta)) op vl m. Proof. intros. destruct op; simpl; auto. - apply eval_shift_stack_addressing. + apply eval_shift_stack_addressing. Qed. (** Offset an addressing mode [addr] by a quantity [delta], so that @@ -613,12 +613,12 @@ Proof. rewrite !Val.add_assoc; auto. rewrite !Val.add_assoc; auto. rewrite !Val.add_assoc; auto. - unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); auto. unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); auto. - rewrite Val.add_assoc. rewrite Val.add_permut. rewrite Val.add_commut. auto. + unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); auto. + rewrite Val.add_assoc. rewrite Val.add_permut. rewrite Val.add_commut. auto. unfold Genv.symbol_address. destruct (Genv.find_symbol ge i0); auto. - rewrite Val.add_assoc. rewrite Val.add_permut. rewrite Val.add_commut. auto. - rewrite Val.add_assoc. auto. + rewrite Val.add_assoc. rewrite Val.add_permut. rewrite Val.add_commut. auto. + rewrite Val.add_assoc. auto. Qed. Lemma eval_offset_addressing: @@ -627,7 +627,7 @@ Lemma eval_offset_addressing: eval_addressing ge sp addr args = Some v -> eval_addressing ge sp addr' args = Some(Val.add v (Vint delta)). Proof. - intros. unfold offset_addressing in H; inv H. + intros. unfold offset_addressing in H; inv H. eapply eval_offset_addressing_total; eauto. Qed. @@ -832,9 +832,9 @@ Proof. inv H4; simpl; auto. inv H4; simpl; auto. inv H4; simpl; auto. - inv H4; inv H2; simpl; auto. econstructor; eauto. + inv H4; inv H2; simpl; auto. econstructor; eauto. rewrite Int.sub_add_l. auto. - destruct (eq_block b1 b0); auto. subst. rewrite H1 in H0. inv H0. rewrite dec_eq_true. + destruct (eq_block b1 b0); auto. subst. rewrite H1 in H0. inv H0. rewrite dec_eq_true. rewrite Int.sub_shifted. auto. inv H4; inv H2; simpl; auto. inv H4; simpl; auto. @@ -842,11 +842,11 @@ Proof. inv H4; inv H2; simpl; auto. inv H4; inv H3; simpl in H1; inv H1. simpl. destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2. TrivialExists. - inv H4; inv H3; simpl in H1; inv H1. simpl. + inv H4; inv H3; simpl in H1; inv H1. simpl. destruct (Int.eq i0 Int.zero); inv H2. TrivialExists. inv H4; inv H3; simpl in H1; inv H1. simpl. destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2. TrivialExists. - inv H4; inv H3; simpl in H1; inv H1. simpl. + inv H4; inv H3; simpl in H1; inv H1. simpl. destruct (Int.eq i0 Int.zero); inv H2. TrivialExists. inv H4; inv H2; simpl; auto. inv H4; simpl; auto. @@ -859,14 +859,14 @@ Proof. inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto. inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto. inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto. - inv H4; simpl in H1; try discriminate. simpl. + inv H4; simpl in H1; try discriminate. simpl. destruct (Int.ltu i (Int.repr 31)); inv H1. TrivialExists. inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto. inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto. inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto. inv H4; simpl; auto. destruct (Int.ltu i Int.iwordsize); auto. inv H2; simpl; auto. destruct (Int.ltu (Int.sub Int.iwordsize i) Int.iwordsize); auto. - eapply eval_addressing_inj; eauto. + eapply eval_addressing_inj; eauto. inv H4; simpl; auto. inv H4; simpl; auto. inv H4; inv H2; simpl; auto. @@ -912,7 +912,7 @@ Remark valid_pointer_extends: Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true -> Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true. Proof. - intros. inv H0. rewrite Int.add_zero. eapply Mem.valid_pointer_extends; eauto. + intros. inv H0. rewrite Int.add_zero. eapply Mem.valid_pointer_extends; eauto. Qed. Remark weak_valid_pointer_extends: @@ -922,7 +922,7 @@ Remark weak_valid_pointer_extends: Mem.weak_valid_pointer m1 b1 (Int.unsigned ofs) = true -> Mem.weak_valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true. Proof. - intros. inv H0. rewrite Int.add_zero. eapply Mem.weak_valid_pointer_extends; eauto. + intros. inv H0. rewrite Int.add_zero. eapply Mem.weak_valid_pointer_extends; eauto. Qed. Remark weak_valid_pointer_no_overflow_extends: @@ -978,11 +978,11 @@ Proof. apply weak_valid_pointer_extends; auto. apply weak_valid_pointer_no_overflow_extends. apply valid_different_pointers_extends; auto. - intros. apply val_inject_lessdef. auto. + intros. apply val_inject_lessdef. auto. apply val_inject_lessdef; auto. - eauto. + eauto. auto. - destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. + destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. Qed. Lemma eval_addressing_lessdef: @@ -998,8 +998,8 @@ Proof. eapply eval_addressing_inj with (sp1 := sp). intros. rewrite <- val_inject_lessdef; auto. rewrite <- val_inject_lessdef; auto. - eauto. auto. - destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. + eauto. auto. + destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. Qed. End EVAL_LESSDEF. @@ -1021,7 +1021,7 @@ Remark symbol_address_inject: forall id ofs, Val.inject f (Genv.symbol_address genv id ofs) (Genv.symbol_address genv id ofs). Proof. intros. unfold Genv.symbol_address. destruct (Genv.find_symbol genv id) eqn:?; auto. - exploit (proj1 globals); eauto. intros. + exploit (proj1 globals); eauto. intros. econstructor; eauto. rewrite Int.add_zero; auto. Qed. @@ -1043,11 +1043,11 @@ Lemma eval_addressing_inject: forall addr vl1 vl2 v1, Val.inject_list f vl1 vl2 -> eval_addressing genv (Vptr sp1 Int.zero) addr vl1 = Some v1 -> - exists v2, + exists v2, eval_addressing genv (Vptr sp2 Int.zero) (shift_stack_addressing (Int.repr delta) addr) vl2 = Some v2 /\ Val.inject f v1 v2. Proof. - intros. + intros. rewrite eval_shift_stack_addressing. simpl. eapply eval_addressing_inj with (sp1 := Vptr sp1 Int.zero); eauto. intros. apply symbol_address_inject. @@ -1062,14 +1062,14 @@ Lemma eval_operation_inject: eval_operation genv (Vptr sp2 Int.zero) (shift_stack_operation (Int.repr delta) op) vl2 m2 = Some v2 /\ Val.inject f v1 v2. Proof. - intros. + intros. rewrite eval_shift_stack_operation. simpl. eapply eval_operation_inj with (sp1 := Vptr sp1 Int.zero) (m1 := m1); eauto. intros; eapply Mem.valid_pointer_inject_val; eauto. intros; eapply Mem.weak_valid_pointer_inject_val; eauto. intros; eapply Mem.weak_valid_pointer_inject_no_overflow; eauto. intros; eapply Mem.different_pointers_inject; eauto. - intros. apply symbol_address_inject. + intros. apply symbol_address_inject. Qed. End EVAL_INJECT. diff --git a/ia32/SelectOpproof.v b/ia32/SelectOpproof.v index d40ec7af..bcfc13c9 100644 --- a/ia32/SelectOpproof.v +++ b/ia32/SelectOpproof.v @@ -30,7 +30,7 @@ Open Local Scope cminorsel_scope. (** The following are trivial lemmas and custom tactics that help perform backward (inversion) and forward reasoning over the evaluation - of operator applications. *) + of operator applications. *) Ltac EvalOp := eapply eval_Eop; eauto with evalexpr. @@ -119,9 +119,9 @@ Proof. destruct (symbol_is_external id). predSpec Int.eq Int.eq_spec ofs Int.zero. subst. EvalOp. - EvalOp. econstructor. EvalOp. simpl; eauto. econstructor. simpl. - unfold Genv.symbol_address. destruct (Genv.find_symbol ge id); auto. - simpl. rewrite Int.add_commut. rewrite Int.add_zero. auto. + EvalOp. econstructor. EvalOp. simpl; eauto. econstructor. simpl. + unfold Genv.symbol_address. destruct (Genv.find_symbol ge id); auto. + simpl. rewrite Int.add_commut. rewrite Int.add_zero. auto. EvalOp. Qed. @@ -130,7 +130,7 @@ Theorem eval_addrstack: exists v, eval_expr ge sp e m le (addrstack ofs) v /\ Val.lessdef (Val.add sp (Vint ofs)) v. Proof. intros. unfold addrstack. econstructor; split. - EvalOp. simpl; eauto. + EvalOp. simpl; eauto. auto. Qed. @@ -147,12 +147,12 @@ Theorem eval_addimm: Proof. red; unfold addimm; intros until x. predSpec Int.eq Int.eq_spec n Int.zero. - subst n. intros. exists x; split; auto. + subst n. intros. exists x; split; auto. destruct x; simpl; auto. rewrite Int.add_zero. auto. rewrite Int.add_zero. auto. case (addimm_match a); intros; InvEval; simpl. TrivialExists; simpl. rewrite Int.add_commut. auto. inv H0. simpl in H6. TrivialExists. simpl. eapply eval_offset_addressing_total; eauto. - TrivialExists. + TrivialExists. Qed. Theorem eval_add: binary_constructor_sound add Val.add. @@ -164,11 +164,11 @@ Proof. subst. TrivialExists. simpl. rewrite Val.add_permut_4. auto. subst. TrivialExists. simpl. rewrite Val.add_assoc. decEq; decEq. rewrite Val.add_permut. auto. subst. TrivialExists. simpl. rewrite Val.add_permut_4. rewrite <- Val.add_permut. rewrite <- Val.add_assoc. auto. - subst. TrivialExists. simpl. rewrite Genv.shift_symbol_address. + subst. TrivialExists. simpl. rewrite Genv.shift_symbol_address. rewrite Val.add_commut. rewrite Val.add_assoc. decEq. decEq. apply Val.add_commut. subst. TrivialExists. simpl. rewrite Genv.shift_symbol_address. rewrite Val.add_assoc. decEq; decEq. apply Val.add_commut. - subst. TrivialExists. simpl. rewrite Genv.shift_symbol_address. rewrite Val.add_commut. + subst. TrivialExists. simpl. rewrite Genv.shift_symbol_address. rewrite Val.add_commut. rewrite Val.add_assoc. decEq; decEq. apply Val.add_commut. subst. TrivialExists. simpl. rewrite Genv.shift_symbol_address. rewrite Val.add_assoc. decEq; decEq. apply Val.add_commut. @@ -185,7 +185,7 @@ Proof. red; intros until y. unfold sub; case (sub_match a b); intros; InvEval. rewrite Val.sub_add_opp. apply eval_addimm; auto. - subst. rewrite Val.sub_add_l. rewrite Val.sub_add_r. + subst. rewrite Val.sub_add_l. rewrite Val.sub_add_r. rewrite Val.add_assoc. simpl. rewrite Int.add_commut. rewrite <- Int.sub_add_opp. apply eval_addimm; EvalOp. subst. rewrite Val.sub_add_l. apply eval_addimm; EvalOp. @@ -197,7 +197,7 @@ Theorem eval_negint: unary_constructor_sound negint (fun v => Val.sub Vzero v). Proof. red; intros until x. unfold negint. case (negint_match a); intros; InvEval. TrivialExists. - TrivialExists. + TrivialExists. Qed. Theorem eval_shlimm: @@ -209,28 +209,28 @@ Proof. intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shl_zero; auto. destruct (Int.ltu n Int.iwordsize) eqn:LT; simpl. destruct (shlimm_match a); intros; InvEval. - exists (Vint (Int.shl n1 n)); split. EvalOp. + exists (Vint (Int.shl n1 n)); split. EvalOp. simpl. rewrite LT. auto. destruct (Int.ltu (Int.add n n1) Int.iwordsize) eqn:?. exists (Val.shl v1 (Vint (Int.add n n1))); split. EvalOp. - subst. destruct v1; simpl; auto. + subst. destruct v1; simpl; auto. rewrite Heqb. destruct (Int.ltu n1 Int.iwordsize) eqn:?; simpl; auto. destruct (Int.ltu n Int.iwordsize) eqn:?; simpl; auto. rewrite Int.add_commut. rewrite Int.shl_shl; auto. rewrite Int.add_commut; auto. - subst. TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. + subst. TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. simpl. auto. subst. destruct (shift_is_scale n). econstructor; split. EvalOp. simpl. eauto. - destruct v1; simpl; auto. rewrite LT. + destruct v1; simpl; auto. rewrite LT. rewrite Int.shl_mul. rewrite Int.mul_add_distr_l. rewrite (Int.shl_mul n1). auto. - TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. auto. + TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. auto. destruct (shift_is_scale n). - econstructor; split. EvalOp. simpl. eauto. + econstructor; split. EvalOp. simpl. eauto. destruct x; simpl; auto. rewrite LT. - rewrite Int.add_zero. rewrite Int.shl_mul. auto. + rewrite Int.add_zero. rewrite Int.shl_mul. auto. TrivialExists. - intros; TrivialExists. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. + intros; TrivialExists. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. auto. Qed. @@ -243,18 +243,18 @@ Proof. intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shru_zero; auto. destruct (Int.ltu n Int.iwordsize) eqn:LT; simpl. destruct (shruimm_match a); intros; InvEval. - exists (Vint (Int.shru n1 n)); split. EvalOp. - simpl. rewrite LT; auto. + exists (Vint (Int.shru n1 n)); split. EvalOp. + simpl. rewrite LT; auto. destruct (Int.ltu (Int.add n n1) Int.iwordsize) eqn:?. exists (Val.shru v1 (Vint (Int.add n n1))); split. EvalOp. - subst. destruct v1; simpl; auto. + subst. destruct v1; simpl; auto. rewrite Heqb. destruct (Int.ltu n1 Int.iwordsize) eqn:?; simpl; auto. rewrite LT. rewrite Int.add_commut. rewrite Int.shru_shru; auto. rewrite Int.add_commut; auto. - subst. TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. + subst. TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. simpl. auto. TrivialExists. - intros; TrivialExists. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. + intros; TrivialExists. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. auto. Qed. @@ -267,32 +267,32 @@ Proof. intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shr_zero; auto. destruct (Int.ltu n Int.iwordsize) eqn:LT; simpl. destruct (shrimm_match a); intros; InvEval. - exists (Vint (Int.shr n1 n)); split. EvalOp. - simpl. rewrite LT; auto. + exists (Vint (Int.shr n1 n)); split. EvalOp. + simpl. rewrite LT; auto. destruct (Int.ltu (Int.add n n1) Int.iwordsize) eqn:?. exists (Val.shr v1 (Vint (Int.add n n1))); split. EvalOp. - subst. destruct v1; simpl; auto. + subst. destruct v1; simpl; auto. rewrite Heqb. destruct (Int.ltu n1 Int.iwordsize) eqn:?; simpl; auto. - rewrite LT. + rewrite LT. rewrite Int.add_commut. rewrite Int.shr_shr; auto. rewrite Int.add_commut; auto. - subst. TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. + subst. TrivialExists. econstructor. EvalOp. simpl; eauto. constructor. simpl. auto. TrivialExists. - intros; TrivialExists. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. + intros; TrivialExists. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. auto. Qed. Lemma eval_mulimm_base: forall n, unary_constructor_sound (mulimm_base n) (fun x => Val.mul x (Vint n)). Proof. - intros; red; intros; unfold mulimm_base. - generalize (Int.one_bits_decomp n). + intros; red; intros; unfold mulimm_base. + generalize (Int.one_bits_decomp n). generalize (Int.one_bits_range n). destruct (Int.one_bits n). - intros. TrivialExists. + intros. TrivialExists. destruct l. - intros. rewrite H1. simpl. + intros. rewrite H1. simpl. rewrite Int.add_zero. replace (Vint (Int.shl Int.one i)) with (Val.shl Vone (Vint i)). rewrite Val.shl_mul. apply eval_shlimm. auto. simpl. rewrite H0; auto with coqlib. @@ -301,33 +301,33 @@ Proof. exploit (eval_shlimm i (x :: le) (Eletvar 0) x). constructor; auto. intros [v1 [A1 B1]]. exploit (eval_shlimm i0 (x :: le) (Eletvar 0) x). constructor; auto. intros [v2 [A2 B2]]. exploit eval_add. eexact A1. eexact A2. intros [v3 [A3 B3]]. - exists v3; split. econstructor; eauto. + exists v3; split. econstructor; eauto. rewrite Int.add_zero. replace (Vint (Int.add (Int.shl Int.one i) (Int.shl Int.one i0))) with (Val.add (Val.shl Vone (Vint i)) (Val.shl Vone (Vint i0))). rewrite Val.mul_add_distr_r. - repeat rewrite Val.shl_mul. - apply Val.lessdef_trans with (Val.add v1 v2); auto. apply Val.add_lessdef; auto. - simpl. repeat rewrite H0; auto with coqlib. - intros. TrivialExists. + repeat rewrite Val.shl_mul. + apply Val.lessdef_trans with (Val.add v1 v2); auto. apply Val.add_lessdef; auto. + simpl. repeat rewrite H0; auto with coqlib. + intros. TrivialExists. Qed. Theorem eval_mulimm: forall n, unary_constructor_sound (mulimm n) (fun x => Val.mul x (Vint n)). Proof. intros; red; intros until x; unfold mulimm. - predSpec Int.eq Int.eq_spec n Int.zero. - intros. exists (Vint Int.zero); split. EvalOp. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists (Vint Int.zero); split. EvalOp. destruct x; simpl; auto. subst n. rewrite Int.mul_zero. auto. predSpec Int.eq Int.eq_spec n Int.one. intros. exists x; split; auto. destruct x; simpl; auto. subst n. rewrite Int.mul_one. auto. case (mulimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.mul_commut; auto. - subst. rewrite Val.mul_add_distr_l. + subst. rewrite Val.mul_add_distr_l. exploit eval_mulimm_base; eauto. instantiate (1 := n). intros [v' [A1 B1]]. exploit (eval_addimm (Int.mul n n2) le (mulimm_base n t2) v'). auto. intros [v'' [A2 B2]]. - exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.add_lessdef; eauto. + exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.add_lessdef; eauto. rewrite Val.mul_commut; auto. apply eval_mulimm_base; auto. Qed. @@ -336,7 +336,7 @@ Theorem eval_mul: binary_constructor_sound mul Val.mul. Proof. red; intros until y. unfold mul; case (mul_match a b); intros; InvEval. - rewrite Val.mul_commut. apply eval_mulimm. auto. + rewrite Val.mul_commut. apply eval_mulimm. auto. apply eval_mulimm. auto. TrivialExists. Qed. @@ -345,8 +345,8 @@ Theorem eval_andimm: forall n, unary_constructor_sound (andimm n) (fun x => Val.and x (Vint n)). Proof. intros; red; intros until x. unfold andimm. - predSpec Int.eq Int.eq_spec n Int.zero. - intros. exists (Vint Int.zero); split. EvalOp. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists (Vint Int.zero); split. EvalOp. destruct x; simpl; auto. subst n. rewrite Int.and_zero. auto. predSpec Int.eq Int.eq_spec n Int.mone. intros. exists x; split; auto. @@ -354,9 +354,9 @@ Proof. case (andimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.and_commut; auto. subst. TrivialExists. simpl. rewrite Val.and_assoc. rewrite Int.and_commut. auto. - subst. rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc. + subst. rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc. rewrite Int.and_commut. auto. compute; auto. - subst. rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc. + subst. rewrite Val.zero_ext_and. TrivialExists. rewrite Val.and_assoc. rewrite Int.and_commut. auto. compute; auto. TrivialExists. Qed. @@ -373,15 +373,15 @@ Theorem eval_orimm: forall n, unary_constructor_sound (orimm n) (fun x => Val.or x (Vint n)). Proof. intros; red; intros until x. unfold orimm. - predSpec Int.eq Int.eq_spec n Int.zero. - intros. exists x; split. auto. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists x; split. auto. destruct x; simpl; auto. subst n. rewrite Int.or_zero. auto. predSpec Int.eq Int.eq_spec n Int.mone. intros. exists (Vint Int.mone); split. EvalOp. destruct x; simpl; auto. subst n. rewrite Int.or_mone. auto. destruct (orimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.or_commut; auto. - subst. rewrite Val.or_assoc. simpl. rewrite Int.or_commut. TrivialExists. + subst. rewrite Val.or_assoc. simpl. rewrite Int.or_commut. TrivialExists. TrivialExists. Qed. @@ -393,10 +393,10 @@ Remark eval_same_expr: a1 = a2 /\ v1 = v2. Proof. intros until v2. - destruct a1; simpl; try (intros; discriminate). + destruct a1; simpl; try (intros; discriminate). destruct a2; simpl; try (intros; discriminate). case (ident_eq i i0); intros. - subst i0. inversion H0. inversion H1. split. auto. congruence. + subst i0. inversion H0. inversion H1. split. auto. congruence. discriminate. Qed. @@ -410,33 +410,33 @@ Lemma eval_or: binary_constructor_sound or Val.or. Proof. red; intros until y; unfold or; case (or_match a b); intros. (* intconst *) - InvEval. rewrite Val.or_commut. apply eval_orimm; auto. + InvEval. rewrite Val.or_commut. apply eval_orimm; auto. InvEval. apply eval_orimm; auto. (* shlimm - shruimm *) predSpec Int.eq Int.eq_spec (Int.add n1 n2) Int.iwordsize. destruct (same_expr_pure t1 t2) eqn:?. - InvEval. exploit eval_same_expr; eauto. intros [EQ1 EQ2]; subst. + InvEval. exploit eval_same_expr; eauto. intros [EQ1 EQ2]; subst. exists (Val.ror v0 (Vint n2)); split. EvalOp. - destruct v0; simpl; auto. + destruct v0; simpl; auto. destruct (Int.ltu n1 Int.iwordsize) eqn:?; auto. destruct (Int.ltu n2 Int.iwordsize) eqn:?; auto. simpl. rewrite <- Int.or_ror; auto. - InvEval. exists (Val.or x y); split. EvalOp. + InvEval. exists (Val.or x y); split. EvalOp. simpl. erewrite int_add_sub_eq; eauto. rewrite H0; rewrite H; auto. auto. - TrivialExists. -(* shruimm - shlimm *) + TrivialExists. +(* shruimm - shlimm *) predSpec Int.eq Int.eq_spec (Int.add n1 n2) Int.iwordsize. destruct (same_expr_pure t1 t2) eqn:?. - InvEval. exploit eval_same_expr; eauto. intros [EQ1 EQ2]; subst. + InvEval. exploit eval_same_expr; eauto. intros [EQ1 EQ2]; subst. exists (Val.ror v1 (Vint n2)); split. EvalOp. - destruct v1; simpl; auto. + destruct v1; simpl; auto. destruct (Int.ltu n2 Int.iwordsize) eqn:?; auto. destruct (Int.ltu n1 Int.iwordsize) eqn:?; auto. simpl. rewrite Int.or_commut. rewrite <- Int.or_ror; auto. - InvEval. exists (Val.or y x); split. EvalOp. + InvEval. exists (Val.or y x); split. EvalOp. simpl. erewrite int_add_sub_eq; eauto. rewrite H0; rewrite H; auto. rewrite Val.or_commut; auto. - TrivialExists. + TrivialExists. (* default *) TrivialExists. Qed. @@ -445,13 +445,13 @@ Theorem eval_xorimm: forall n, unary_constructor_sound (xorimm n) (fun x => Val.xor x (Vint n)). Proof. intros; red; intros until x. unfold xorimm. - predSpec Int.eq Int.eq_spec n Int.zero. - intros. exists x; split. auto. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists x; split. auto. destruct x; simpl; auto. subst n. rewrite Int.xor_zero. auto. destruct (xorimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.xor_commut; auto. subst. rewrite Val.xor_assoc. simpl. rewrite Int.xor_commut. TrivialExists. - subst. rewrite Val.not_xor. rewrite Val.xor_assoc. + subst. rewrite Val.not_xor. rewrite Val.xor_assoc. rewrite (Val.xor_commut (Vint Int.mone)). TrivialExists. TrivialExists. Qed. @@ -510,13 +510,13 @@ Theorem eval_shrximm: Val.shrx x (Vint n) = Some z -> exists v, eval_expr ge sp e m le (shrximm a n) v /\ Val.lessdef z v. Proof. - intros. unfold shrximm. + intros. unfold shrximm. predSpec Int.eq Int.eq_spec n Int.zero. - subst n. exists x; split; auto. + subst n. exists x; split; auto. destruct x; simpl in H0; try discriminate. destruct (Int.ltu Int.zero (Int.repr 31)); inv H0. - replace (Int.shrx i Int.zero) with i. auto. - unfold Int.shrx, Int.divs. rewrite Int.shl_zero. + replace (Int.shrx i Int.zero) with i. auto. + unfold Int.shrx, Int.divs. rewrite Int.shl_zero. change (Int.signed Int.one) with 1. rewrite Z.quot_1_r. rewrite Int.repr_signed; auto. econstructor; split. EvalOp. auto. Qed. @@ -525,38 +525,38 @@ Theorem eval_shl: binary_constructor_sound shl Val.shl. Proof. red; intros until y; unfold shl; case (shl_match b); intros. InvEval. apply eval_shlimm; auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_shr: binary_constructor_sound shr Val.shr. Proof. red; intros until y; unfold shr; case (shr_match b); intros. InvEval. apply eval_shrimm; auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_shru: binary_constructor_sound shru Val.shru. Proof. red; intros until y; unfold shru; case (shru_match b); intros. InvEval. apply eval_shruimm; auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_negf: unary_constructor_sound negf Val.negf. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_absf: unary_constructor_sound absf Val.absf. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_addf: binary_constructor_sound addf Val.addf. Proof. red; intros; TrivialExists. Qed. - + Theorem eval_subf: binary_constructor_sound subf Val.subf. Proof. red; intros; TrivialExists. @@ -569,19 +569,19 @@ Qed. Theorem eval_negfs: unary_constructor_sound negfs Val.negfs. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_absfs: unary_constructor_sound absfs Val.absfs. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_addfs: binary_constructor_sound addfs Val.addfs. Proof. red; intros; TrivialExists. Qed. - + Theorem eval_subfs: binary_constructor_sound subfs Val.subfs. Proof. red; intros; TrivialExists. @@ -615,8 +615,8 @@ Proof. (* constant *) InvEval. rewrite sem_int. TrivialExists. simpl. destruct (intsem c0 n1 n2); auto. (* eq cmp *) - InvEval. inv H. simpl in H5. inv H5. - destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. + InvEval. inv H. simpl in H5. inv H5. + destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. simpl. rewrite eval_negate_condition. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_eq; auto. @@ -625,13 +625,13 @@ Proof. simpl. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_eq; auto. rewrite sem_undef; auto. - exists (Vint Int.zero); split. EvalOp. + exists (Vint Int.zero); split. EvalOp. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; rewrite sem_eq; rewrite Int.eq_false; auto. rewrite sem_undef; auto. (* ne cmp *) - InvEval. inv H. simpl in H5. inv H5. - destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. + InvEval. inv H. simpl in H5. inv H5. + destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. simpl. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_ne; auto. rewrite sem_undef; auto. @@ -639,21 +639,21 @@ Proof. simpl. rewrite eval_negate_condition. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_ne; auto. rewrite sem_undef; auto. - exists (Vint Int.one); split. EvalOp. + exists (Vint Int.one); split. EvalOp. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; rewrite sem_ne; rewrite Int.eq_false; auto. rewrite sem_undef; auto. (* eq andimm *) destruct (Int.eq_dec n2 Int.zero). InvEval; subst. - econstructor; split. EvalOp. simpl; eauto. - destruct v1; simpl; try (rewrite sem_undef; auto). rewrite sem_eq. - destruct (Int.eq (Int.and i n1) Int.zero); auto. + econstructor; split. EvalOp. simpl; eauto. + destruct v1; simpl; try (rewrite sem_undef; auto). rewrite sem_eq. + destruct (Int.eq (Int.and i n1) Int.zero); auto. TrivialExists. simpl. rewrite sem_default. auto. (* ne andimm *) destruct (Int.eq_dec n2 Int.zero). InvEval; subst. - econstructor; split. EvalOp. simpl; eauto. - destruct v1; simpl; try (rewrite sem_undef; auto). rewrite sem_ne. - destruct (Int.eq (Int.and i n1) Int.zero); auto. + econstructor; split. EvalOp. simpl; eauto. + destruct v1; simpl; try (rewrite sem_undef; auto). rewrite sem_ne. + destruct (Int.eq (Int.and i n1) Int.zero); auto. TrivialExists. simpl. rewrite sem_default. auto. (* default *) TrivialExists. simpl. rewrite sem_default. auto. @@ -668,7 +668,7 @@ Lemma eval_compimm_swap: exists v, eval_expr ge sp e m le (compimm default intsem (swap_comparison c) a n2) v /\ Val.lessdef (sem c (Vint n2) x) v. Proof. - intros. rewrite <- sem_swap. eapply eval_compimm; eauto. + intros. rewrite <- sem_swap. eapply eval_compimm; eauto. Qed. End COMP_IMM. @@ -677,9 +677,9 @@ Theorem eval_comp: forall c, binary_constructor_sound (comp c) (Val.cmp c). Proof. intros; red; intros until y. unfold comp; case (comp_match a b); intros; InvEval. - eapply eval_compimm_swap; eauto. + eapply eval_compimm_swap; eauto. intros. unfold Val.cmp. rewrite Val.swap_cmp_bool; auto. - eapply eval_compimm; eauto. + eapply eval_compimm; eauto. TrivialExists. Qed. @@ -687,9 +687,9 @@ Theorem eval_compu: forall c, binary_constructor_sound (compu c) (Val.cmpu (Mem.valid_pointer m) c). Proof. intros; red; intros until y. unfold compu; case (compu_match a b); intros; InvEval. - eapply eval_compimm_swap; eauto. + eapply eval_compimm_swap; eauto. intros. unfold Val.cmpu. rewrite Val.swap_cmpu_bool; auto. - eapply eval_compimm; eauto. + eapply eval_compimm; eauto. TrivialExists. Qed. @@ -732,7 +732,7 @@ Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ex Proof. red; intros until x. unfold cast16unsigned. destruct (cast16unsigned_match a); intros; InvEval. TrivialExists. - subst. rewrite Val.zero_ext_and. rewrite Val.and_assoc. + subst. rewrite Val.zero_ext_and. rewrite Val.and_assoc. rewrite Int.and_commut. apply eval_andimm; auto. compute; auto. TrivialExists. Qed. @@ -753,7 +753,7 @@ Theorem eval_intoffloat: Val.intoffloat x = Some y -> exists v, eval_expr ge sp e m le (intoffloat a) v /\ Val.lessdef y v. Proof. - intros; unfold intoffloat. TrivialExists. + intros; unfold intoffloat. TrivialExists. Qed. Theorem eval_floatofint: @@ -764,7 +764,7 @@ Theorem eval_floatofint: Proof. intros until y; unfold floatofint. case (floatofint_match a); intros; InvEval. TrivialExists. - TrivialExists. + TrivialExists. Qed. Theorem eval_intuoffloat: @@ -783,24 +783,24 @@ Proof. assert (eval_expr ge sp e m (Vfloat fm :: Vfloat f :: le) (Eletvar O) (Vfloat fm)). constructor. auto. econstructor. eauto. - econstructor. instantiate (1 := Vfloat fm). EvalOp. + econstructor. instantiate (1 := Vfloat fm). EvalOp. eapply eval_Econdition with (va := Float.cmp Clt f fm). eauto with evalexpr. destruct (Float.cmp Clt f fm) eqn:?. exploit Float.to_intu_to_int_1; eauto. intro EQ. EvalOp. simpl. rewrite EQ; auto. - exploit Float.to_intu_to_int_2; eauto. + exploit Float.to_intu_to_int_2; eauto. change Float.ox8000_0000 with im. fold fm. intro EQ. set (t2 := subf (Eletvar (S O)) (Eletvar O)). set (t3 := intoffloat t2). exploit (eval_subf (Vfloat fm :: Vfloat f :: le) (Eletvar (S O)) (Vfloat f) (Eletvar O)); eauto. - fold t2. intros [v2 [A2 B2]]. simpl in B2. inv B2. + fold t2. intros [v2 [A2 B2]]. simpl in B2. inv B2. exploit (eval_addimm Float.ox8000_0000 (Vfloat fm :: Vfloat f :: le) t3). - unfold t3. unfold intoffloat. EvalOp. simpl. rewrite EQ. simpl. eauto. - intros [v4 [A4 B4]]. simpl in B4. inv B4. - rewrite Int.sub_add_opp in A4. rewrite Int.add_assoc in A4. - rewrite (Int.add_commut (Int.neg im)) in A4. - rewrite Int.add_neg_zero in A4. + unfold t3. unfold intoffloat. EvalOp. simpl. rewrite EQ. simpl. eauto. + intros [v4 [A4 B4]]. simpl in B4. inv B4. + rewrite Int.sub_add_opp in A4. rewrite Int.add_assoc in A4. + rewrite (Int.add_commut (Int.neg im)) in A4. + rewrite Int.add_neg_zero in A4. rewrite Int.add_zero in A4. auto. Qed. @@ -815,20 +815,20 @@ Proof. InvEval. TrivialExists. destruct x; simpl in H0; try discriminate. inv H0. exists (Vfloat (Float.of_intu i)); split; auto. - econstructor. eauto. + econstructor. eauto. set (fm := Float.of_intu Float.ox8000_0000). assert (eval_expr ge sp e m (Vint i :: le) (Eletvar O) (Vint i)). - constructor. auto. + constructor. auto. eapply eval_Econdition with (va := Int.ltu i Float.ox8000_0000). eauto with evalexpr. destruct (Int.ltu i Float.ox8000_0000) eqn:?. rewrite Float.of_intu_of_int_1; auto. - unfold floatofint. EvalOp. + unfold floatofint. EvalOp. exploit (eval_addimm (Int.neg Float.ox8000_0000) (Vint i :: le) (Eletvar 0)); eauto. - simpl. intros [v [A B]]. inv B. - unfold addf. EvalOp. - constructor. unfold floatofint. EvalOp. simpl; eauto. - constructor. EvalOp. simpl; eauto. constructor. simpl; eauto. + simpl. intros [v [A B]]. inv B. + unfold addf. EvalOp. + constructor. unfold floatofint. EvalOp. simpl; eauto. + constructor. EvalOp. simpl; eauto. constructor. simpl; eauto. fold fm. rewrite Float.of_intu_of_int_2; auto. rewrite Int.sub_add_opp. auto. Qed. @@ -839,7 +839,7 @@ Theorem eval_intofsingle: Val.intofsingle x = Some y -> exists v, eval_expr ge sp e m le (intofsingle a) v /\ Val.lessdef y v. Proof. - intros; unfold intofsingle. TrivialExists. + intros; unfold intofsingle. TrivialExists. Qed. Theorem eval_singleofint: @@ -850,7 +850,7 @@ Theorem eval_singleofint: Proof. intros until y; unfold singleofint. case (singleofint_match a); intros; InvEval. TrivialExists. - TrivialExists. + TrivialExists. Qed. Theorem eval_intuofsingle: @@ -862,9 +862,9 @@ Proof. intros. destruct x; simpl in H0; try discriminate. destruct (Float32.to_intu f) as [n|] eqn:?; simpl in H0; inv H0. unfold intuofsingle. apply eval_intuoffloat with (Vfloat (Float.of_single f)). - unfold floatofsingle. EvalOp. - simpl. change (Float.of_single f) with (Float32.to_double f). - erewrite Float32.to_intu_double; eauto. auto. + unfold floatofsingle. EvalOp. + simpl. change (Float.of_single f) with (Float32.to_double f). + erewrite Float32.to_intu_double; eauto. auto. Qed. Theorem eval_singleofintu: @@ -876,11 +876,11 @@ Proof. intros until y; unfold singleofintu. case (singleofintu_match a); intros. InvEval. TrivialExists. destruct x; simpl in H0; try discriminate. inv H0. - exploit eval_floatofintu. eauto. simpl. reflexivity. + exploit eval_floatofintu. eauto. simpl. reflexivity. intros (v & A & B). exists (Val.singleoffloat v); split. unfold singleoffloat; EvalOp. - inv B; simpl. rewrite Float32.of_intu_double. auto. + inv B; simpl. rewrite Float32.of_intu_double. auto. Qed. Theorem eval_addressing: @@ -889,13 +889,13 @@ Theorem eval_addressing: v = Vptr b ofs -> match addressing chunk a with (mode, args) => exists vl, - eval_exprlist ge sp e m le args vl /\ + eval_exprlist ge sp e m le args vl /\ eval_addressing ge sp mode vl = Some v end. Proof. intros until v. unfold addressing; case (addressing_match a); intros; InvEval. inv H. exists vl; auto. - exists (v :: nil); split. constructor; auto. constructor. subst; simpl. rewrite Int.add_zero; auto. + exists (v :: nil); split. constructor; auto. constructor. subst; simpl. rewrite Int.add_zero; auto. Qed. Theorem eval_builtin_arg: @@ -906,7 +906,7 @@ Proof. intros until v. unfold builtin_arg; case (builtin_arg_match a); intros; InvEval. - constructor. - constructor. -- constructor. +- constructor. - simpl in H5. inv H5. constructor. - subst v. constructor; auto. - inv H. InvEval. simpl in H6; inv H6. constructor; auto. diff --git a/ia32/TargetPrinter.ml b/ia32/TargetPrinter.ml index 3f5e6cfe..fe2c2998 100644 --- a/ia32/TargetPrinter.ml +++ b/ia32/TargetPrinter.ml @@ -83,13 +83,13 @@ module Cygwin_System : SYSTEM = let raw_symbol oc s = fprintf oc "_%s" s - + let symbol oc symb = raw_symbol oc (extern_atom symb) let label oc lbl = fprintf oc "L%d" lbl - + let name_of_section = function | Section_text -> ".text" | Section_data i | Section_small_data i -> @@ -111,12 +111,12 @@ module Cygwin_System : SYSTEM = let print_align oc n = fprintf oc " .align %d\n" n - - let print_mov_ra oc rd id = + + let print_mov_ra oc rd id = fprintf oc " movl $%a, %a\n" symbol id ireg rd let print_fun_info _ _ = () - + let print_var_info _ _ = () let print_epilogue _ = () @@ -133,10 +133,10 @@ module Cygwin_System : SYSTEM = (* Printer functions for ELF *) module ELF_System : SYSTEM = struct - + let raw_symbol oc s = fprintf oc "%s" s - + let symbol = elf_symbol let label = elf_label @@ -157,19 +157,19 @@ module ELF_System : SYSTEM = | Section_debug_loc -> ".section .debug_loc,\"\",@progbits" | Section_debug_line _ -> ".section .debug_line,\"\",@progbits" | Section_debug_abbrev -> ".section .debug_abbrev,\"\",@progbits" - + let stack_alignment = 8 (* minimum is 4, 8 is better for perfs *) - + let print_align oc n = fprintf oc " .align %d\n" n - - let print_mov_ra oc rd id = + + let print_mov_ra oc rd id = fprintf oc " movl $%a, %a\n" symbol id ireg rd let print_fun_info = elf_print_fun_info - + let print_var_info = elf_print_var_info - + let print_epilogue _ = () let print_comm_decl oc name sz al = @@ -184,7 +184,7 @@ module ELF_System : SYSTEM = (* Printer functions for MacOS *) module MacOS_System : SYSTEM = struct - + let raw_symbol oc s = fprintf oc "_%s" s @@ -211,30 +211,30 @@ module MacOS_System : SYSTEM = | Section_debug_loc -> ".section __DWARF,__debug_loc,regular,debug" | Section_debug_line _ -> ".section __DWARF,__debug_line,regular,debug" | Section_debug_abbrev -> ".section __DWARF,__debug_abbrev,regular,debug" (* Dummy value *) - - + + let stack_alignment = 16 (* mandatory *) - - (* Base-2 log of a Caml integer *) + + (* Base-2 log of a Caml integer *) let rec log2 n = assert (n > 0); if n = 1 then 0 else 1 + log2 (n lsr 1) let print_align oc n = fprintf oc " .align %d\n" (log2 n) - + let indirect_symbols : StringSet.t ref = ref StringSet.empty - let print_mov_ra oc rd id = + let print_mov_ra oc rd id = let id = extern_atom id in indirect_symbols := StringSet.add id !indirect_symbols; fprintf oc " movl L%a$non_lazy_ptr, %a\n" raw_symbol id ireg rd let print_fun_info _ _ = () - + let print_var_info _ _ = () - - let print_epilogue oc = + + let print_epilogue oc = fprintf oc " .section __IMPORT,__pointers,non_lazy_symbol_pointers\n"; StringSet.iter (fun s -> @@ -272,7 +272,7 @@ module Target(System: SYSTEM):TARGET = | Coq_inl n -> let n = camlint_of_coqint n in fprintf oc "%ld" n - | Coq_inr(id, ofs) -> + | Coq_inr(id, ofs) -> let ofs = camlint_of_coqint ofs in if ofs = 0l then symbol oc id @@ -289,13 +289,13 @@ module Target(System: SYSTEM):TARGET = | Cond_e -> "e" | Cond_ne -> "ne" | Cond_b -> "b" | Cond_be -> "be" | Cond_ae -> "ae" | Cond_a -> "a" | Cond_l -> "l" | Cond_le -> "le" | Cond_ge -> "ge" | Cond_g -> "g" - | Cond_p -> "p" | Cond_np -> "np" + | Cond_p -> "p" | Cond_np -> "np" let name_of_neg_condition = function | Cond_e -> "ne" | Cond_ne -> "e" | Cond_b -> "ae" | Cond_be -> "a" | Cond_ae -> "b" | Cond_a -> "be" | Cond_l -> "ge" | Cond_le -> "g" | Cond_ge -> "l" | Cond_g -> "le" - | Cond_p -> "np" | Cond_np -> "p" + | Cond_p -> "np" | Cond_np -> "p" (* Names of sections *) @@ -339,7 +339,7 @@ module Target(System: SYSTEM):TARGET = (* Built-in functions *) -(* Built-ins. They come in two flavors: +(* Built-ins. They come in two flavors: - annotation statements: take their arguments in registers or stack locations; generate no code; - inlined by the compiler: take their arguments in arbitrary @@ -649,7 +649,7 @@ module Target(System: SYSTEM):TARGET = (** Pseudo-instructions *) | Plabel(l) -> fprintf oc "%a:\n" label (transl_label l) - | Pallocframe(sz, ofs_ra, ofs_link) + | Pallocframe(sz, ofs_ra, ofs_link) | Pfreeframe(sz, ofs_ra, ofs_link) -> assert false | Pbuiltin(ef, args, res) -> @@ -667,13 +667,13 @@ module Target(System: SYSTEM):TARGET = | _ -> assert false end - + let print_literal64 oc (lbl, n) = fprintf oc "%a: .quad 0x%Lx\n" label lbl n let print_literal32 oc (lbl, n) = fprintf oc "%a: .long 0x%lx\n" label lbl n - - let print_jumptable oc jmptbl = + + let print_jumptable oc jmptbl = let print_jumptable oc (lbl, tbl) = fprintf oc "%a:" label lbl; List.iter @@ -685,7 +685,7 @@ module Target(System: SYSTEM):TARGET = List.iter (print_jumptable oc) !jumptables; jumptables := [] end - + let print_init oc = function | Init_int8 n -> fprintf oc " .byte %ld\n" (camlint_of_coqint n) @@ -707,7 +707,7 @@ module Target(System: SYSTEM):TARGET = if Z.gt n Z.zero then fprintf oc " .space %s\n" (Z.to_string n) | Init_addrof(symb, ofs) -> - fprintf oc " .long %a\n" + fprintf oc " .long %a\n" symbol_offset (symb, camlint_of_coqint ofs) let print_align = print_align @@ -738,7 +738,7 @@ module Target(System: SYSTEM):TARGET = let print_optional_fun_info _ = () - let get_section_names name = + let get_section_names name = match C2C.atom_sections name with | [t;l;j] -> (t, l, j) | _ -> (Section_text, Section_literal, Section_jumptable) @@ -746,10 +746,10 @@ module Target(System: SYSTEM):TARGET = let reset_constants = reset_constants let print_fun_info = print_fun_info - + let print_var_info = print_var_info - let print_prologue oc = + let print_prologue oc = need_masks := false; if !Clflags.option_g then begin section oc Section_text; @@ -759,7 +759,7 @@ module Target(System: SYSTEM):TARGET = fprintf oc " .cfi_sections .debug_frame\n" end - let print_epilogue oc = + let print_epilogue oc = if !need_masks then begin section oc (Section_const true); (* not Section_literal because not 8-bytes *) @@ -781,13 +781,13 @@ module Target(System: SYSTEM):TARGET = section oc Section_text; fprintf oc "%a:\n" elf_label high_pc end - + let comment = comment let default_falignment = 16 let label = label - + let new_label = new_label end @@ -795,7 +795,7 @@ end let sel_target () = let module S = (val (match Configuration.system with | "macosx" -> (module MacOS_System:SYSTEM) - | "linux" + | "linux" | "bsd" -> (module ELF_System:SYSTEM) | "cygwin" -> (module Cygwin_System:SYSTEM) | _ -> invalid_arg ("System " ^ Configuration.system ^ " not supported") ):SYSTEM) in diff --git a/ia32/ValueAOp.v b/ia32/ValueAOp.v index 93fd8954..ad18c4f6 100644 --- a/ia32/ValueAOp.v +++ b/ia32/ValueAOp.v @@ -132,7 +132,7 @@ Proof. inv VM. destruct cond; auto with va. inv H0. - destruct cond; simpl; eauto with va. + destruct cond; simpl; eauto with va. inv H2. destruct cond; simpl; eauto with va. destruct cond; auto with va. @@ -149,7 +149,7 @@ Lemma symbol_address_sound_2: forall id ofs, vmatch bc (Genv.symbol_address ge id ofs) (Ifptr (Gl id ofs)). Proof. - intros. unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) as [b|] eqn:F. + intros. unfold Genv.symbol_address. destruct (Genv.find_symbol ge id) as [b|] eqn:F. constructor. constructor. apply GENV; auto. constructor. Qed. @@ -173,7 +173,7 @@ Theorem eval_static_addressing_sound: Proof. unfold eval_addressing, eval_static_addressing; intros; destruct addr; InvHyps; eauto with va. - rewrite Int.add_zero_l; auto with va. + rewrite Int.add_zero_l; auto with va. Qed. Theorem eval_static_operation_sound: @@ -187,7 +187,7 @@ Proof. destruct (propagate_float_constants tt); constructor. destruct (propagate_float_constants tt); constructor. eapply eval_static_addressing_sound; eauto. - apply of_optbool_sound. eapply eval_static_condition_sound; eauto. + apply of_optbool_sound. eapply eval_static_condition_sound; eauto. Qed. End SOUNDNESS. diff --git a/lib/Camlcoq.ml b/lib/Camlcoq.ml index c50b3230..c5fb2e55 100644 --- a/lib/Camlcoq.ml +++ b/lib/Camlcoq.ml @@ -86,7 +86,7 @@ module P = struct if n = 0l then assert false else Coq_xO (of_int32 (Int32.shift_right_logical n 1)) - else + else if n = 1l then Coq_xH else Coq_xI (of_int32 (Int32.shift_right_logical n 1)) @@ -101,7 +101,7 @@ module P = struct if n = 0L then assert false else Coq_xO (of_int64 (Int64.shift_right_logical n 1)) - else + else if n = 1L then Coq_xH else Coq_xI (of_int64 (Int64.shift_right_logical n 1)) @@ -295,7 +295,7 @@ let intern_string s = next_atom := Pos.succ !next_atom; Hashtbl.add atom_of_string s a; Hashtbl.add string_of_atom a s; - a + a let extern_atom a = try Hashtbl.find string_of_atom a diff --git a/lib/Coqlib.v b/lib/Coqlib.v index 35d53854..4ec19fa9 100644 --- a/lib/Coqlib.v +++ b/lib/Coqlib.v @@ -107,14 +107,14 @@ Proof. intros. case (peq x y); intros. elim H; auto. auto. -Qed. +Qed. Definition Plt: positive -> positive -> Prop := Pos.lt. Lemma Plt_ne: forall (x y: positive), Plt x y -> x <> y. Proof. - unfold Plt; intros. red; intro. subst y. eelim Pos.lt_irrefl; eauto. + unfold Plt; intros. red; intro. subst y. eelim Pos.lt_irrefl; eauto. Qed. Hint Resolve Plt_ne: coqlib. @@ -125,7 +125,7 @@ Proof (Pos.lt_trans). Lemma Plt_succ: forall (x: positive), Plt x (Psucc x). Proof. - unfold Plt; intros. apply Pos.lt_succ_r. apply Pos.le_refl. + unfold Plt; intros. apply Pos.lt_succ_r. apply Pos.le_refl. Qed. Hint Resolve Plt_succ: coqlib. @@ -139,7 +139,7 @@ Hint Resolve Plt_succ: coqlib. Lemma Plt_succ_inv: forall (x y: positive), Plt x (Psucc y) -> Plt x y \/ x = y. Proof. - unfold Plt; intros. rewrite Pos.lt_succ_r in H. + unfold Plt; intros. rewrite Pos.lt_succ_r in H. apply Pos.le_lteq; auto. Qed. @@ -242,11 +242,11 @@ Lemma positive_Peano_ind: Proof. intros. apply (well_founded_ind Plt_wf P). - intros. + intros. case (peq x0 xH); intro. subst x0; auto. elim (Psucc_pred x0); intro. contradiction. rewrite <- H2. - apply H0. apply H1. apply Ppred_Plt. auto. + apply H0. apply H1. apply Ppred_Plt. auto. Qed. End POSITIVE_ITERATION. @@ -269,14 +269,14 @@ Proof. intros. case (zeq x y); intros. elim H; auto. auto. -Qed. +Qed. Open Scope Z_scope. Definition zlt: forall (x y: Z), {x < y} + {x >= y} := Z_lt_dec. Lemma zlt_true: - forall (A: Type) (x y: Z) (a b: A), + forall (A: Type) (x y: Z) (a b: A), x < y -> (if zlt x y then a else b) = a. Proof. intros. case (zlt x y); intros. @@ -285,7 +285,7 @@ Proof. Qed. Lemma zlt_false: - forall (A: Type) (x y: Z) (a b: A), + forall (A: Type) (x y: Z) (a b: A), x >= y -> (if zlt x y then a else b) = b. Proof. intros. case (zlt x y); intros. @@ -296,7 +296,7 @@ Qed. Definition zle: forall (x y: Z), {x <= y} + {x > y} := Z_le_gt_dec. Lemma zle_true: - forall (A: Type) (x y: Z) (a b: A), + forall (A: Type) (x y: Z) (a b: A), x <= y -> (if zle x y then a else b) = a. Proof. intros. case (zle x y); intros. @@ -305,7 +305,7 @@ Proof. Qed. Lemma zle_false: - forall (A: Type) (x y: Z) (a b: A), + forall (A: Type) (x y: Z) (a b: A), x > y -> (if zle x y then a else b) = b. Proof. intros. case (zle x y); intros. @@ -327,7 +327,7 @@ Qed. Lemma two_power_nat_two_p: forall x, two_power_nat x = two_p (Z_of_nat x). Proof. - induction x. auto. + induction x. auto. rewrite two_power_nat_S. rewrite inj_S. rewrite two_p_S. omega. omega. Qed. @@ -335,7 +335,7 @@ Lemma two_p_monotone: forall x y, 0 <= x <= y -> two_p x <= two_p y. Proof. intros. - replace (two_p x) with (two_p x * 1) by omega. + replace (two_p x) with (two_p x * 1) by omega. replace y with (x + (y - x)) by omega. rewrite two_p_is_exp; try omega. apply Zmult_le_compat_l. @@ -356,7 +356,7 @@ Lemma two_p_strict: Proof. intros x0 GT. pattern x0. apply natlike_ind. simpl. omega. - intros. rewrite two_p_S; auto. generalize (two_p_gt_ZERO x H). omega. + intros. rewrite two_p_S; auto. generalize (two_p_gt_ZERO x H). omega. omega. Qed. @@ -366,7 +366,7 @@ Proof. intros. assert (x = 0 \/ x - 1 >= 0) by omega. destruct H0. subst. vm_compute. auto. replace (two_p x) with (2 * two_p (x - 1)). - generalize (two_p_strict _ H0). omega. + generalize (two_p_strict _ H0). omega. rewrite <- two_p_S. decEq. omega. omega. Qed. @@ -377,7 +377,7 @@ Lemma Zmin_spec: Proof. intros. case (zlt x y); unfold Zlt, Zge; intro z. unfold Zmin. rewrite z. auto. - unfold Zmin. caseEq (x ?= y); intro. + unfold Zmin. caseEq (x ?= y); intro. apply Zcompare_Eq_eq. auto. contradiction. reflexivity. @@ -411,21 +411,21 @@ Qed. Lemma Zdiv_small: forall x y, 0 <= x < y -> x / y = 0. Proof. - intros. assert (y > 0). omega. + intros. assert (y > 0). omega. assert (forall a b, 0 <= a < y -> 0 <= y * b + a < y -> b = 0). - intros. + intros. assert (b = 0 \/ b > 0 \/ (-b) > 0). omega. elim H3; intro. auto. elim H4; intro. - assert (y * b >= y * 1). apply Zmult_ge_compat_l. omega. omega. - omegaContradiction. + assert (y * b >= y * 1). apply Zmult_ge_compat_l. omega. omega. + omegaContradiction. assert (y * (-b) >= y * 1). apply Zmult_ge_compat_l. omega. omega. rewrite <- Zopp_mult_distr_r in H6. omegaContradiction. - apply H1 with (x mod y). + apply H1 with (x mod y). apply Z_mod_lt. auto. rewrite <- Z_div_mod_eq. auto. auto. Qed. @@ -434,7 +434,7 @@ Lemma Zmod_small: forall x y, 0 <= x < y -> x mod y = x. Proof. intros. assert (y > 0). omega. - generalize (Z_div_mod_eq x y H0). + generalize (Z_div_mod_eq x y H0). rewrite (Zdiv_small x y H). omega. Qed. @@ -442,7 +442,7 @@ Lemma Zmod_unique: forall x y a b, x = a * y + b -> 0 <= b < y -> x mod y = b. Proof. - intros. subst x. rewrite Zplus_comm. + intros. subst x. rewrite Zplus_comm. rewrite Z_mod_plus. apply Zmod_small. auto. omega. Qed. @@ -463,12 +463,12 @@ Proof. generalize (Z_div_mod_eq (a/b) c H0). generalize (Z_mod_lt (a/b) c H0). intros. set (q1 := a / b) in *. set (r1 := a mod b) in *. set (q2 := q1 / c) in *. set (r2 := q1 mod c) in *. - symmetry. apply Zdiv_unique with (r2 * b + r1). + symmetry. apply Zdiv_unique with (r2 * b + r1). rewrite H2. rewrite H4. ring. - split. + split. assert (0 <= r2 * b). apply Zmult_le_0_compat. omega. omega. omega. assert ((r2 + 1) * b <= c * b). - apply Zmult_le_compat_r. omega. omega. + apply Zmult_le_compat_r. omega. omega. replace ((r2 + 1) * b) with (r2 * b + b) in H5 by ring. replace (c * b) with (b * c) in H5 by ring. omega. @@ -490,17 +490,17 @@ Lemma Zdiv_interval_1: lo * b <= a < hi * b -> lo <= a/b < hi. Proof. - intros. + intros. generalize (Z_div_mod_eq a b H1). generalize (Z_mod_lt a b H1). intros. set (q := a/b) in *. set (r := a mod b) in *. split. assert (lo < (q + 1)). - apply Zmult_lt_reg_r with b. omega. - apply Zle_lt_trans with a. omega. + apply Zmult_lt_reg_r with b. omega. + apply Zle_lt_trans with a. omega. replace ((q + 1) * b) with (b * q + b) by ring. omega. omega. - apply Zmult_lt_reg_r with b. omega. + apply Zmult_lt_reg_r with b. omega. replace (q * b) with (b * q) by ring. omega. Qed. @@ -513,7 +513,7 @@ Proof. intros. assert (lo <= a / b < hi+1). apply Zdiv_interval_1. omega. omega. auto. - assert (lo * b <= lo * 1). apply Zmult_le_compat_l_neg. omega. omega. + assert (lo * b <= lo * 1). apply Zmult_le_compat_l_neg. omega. omega. replace (lo * 1) with lo in H3 by ring. assert ((hi + 1) * 1 <= (hi + 1) * b). apply Zmult_le_compat_l. omega. omega. replace ((hi + 1) * 1) with (hi + 1) in H4 by ring. @@ -526,19 +526,19 @@ Lemma Zmod_recombine: a > 0 -> b > 0 -> x mod (a * b) = ((x/b) mod a) * b + (x mod b). Proof. - intros. - set (xb := x/b). + intros. + set (xb := x/b). apply Zmod_unique with (xb/a). generalize (Z_div_mod_eq x b H0); fold xb; intro EQ1. generalize (Z_div_mod_eq xb a H); intro EQ2. - rewrite EQ2 in EQ1. + rewrite EQ2 in EQ1. eapply trans_eq. eexact EQ1. ring. - generalize (Z_mod_lt x b H0). intro. + generalize (Z_mod_lt x b H0). intro. generalize (Z_mod_lt xb a H). intro. assert (0 <= xb mod a * b <= a * b - b). split. apply Zmult_le_0_compat; omega. replace (a * b - b) with ((a - 1) * b) by ring. - apply Zmult_le_compat; omega. + apply Zmult_le_compat; omega. omega. Qed. @@ -554,10 +554,10 @@ Definition Zdivide_dec: forall (p q: Z), p > 0 -> { (p|q) } + { ~(p|q) }. Proof. intros. destruct (zeq (Zmod q p) 0). - left. exists (q / p). + left. exists (q / p). transitivity (p * (q / p) + (q mod p)). apply Z_div_mod_eq; auto. transitivity (p * (q / p)). omega. ring. - right; red; intros. elim n. apply Z_div_exact_1; auto. + right; red; intros. elim n. apply Z_div_exact_1; auto. inv H0. rewrite Z_div_mult; auto. ring. Defined. Global Opaque Zdivide_dec. @@ -567,7 +567,7 @@ Lemma Zdivide_interval: 0 < c -> 0 <= a < b -> (c | a) -> (c | b) -> 0 <= a <= b - c. Proof. intros. destruct H1 as [x EQ1]. destruct H2 as [y EQ2]. subst. destruct H0. - split. omega. exploit Zmult_lt_reg_r; eauto. intros. + split. omega. exploit Zmult_lt_reg_r; eauto. intros. replace (y * c - c) with ((y - 1) * c) by ring. apply Zmult_le_compat_r; omega. Qed. @@ -585,9 +585,9 @@ Qed. Lemma nat_of_Z_max: forall z, Z_of_nat (nat_of_Z z) = Zmax z 0. Proof. - intros. unfold Zmax. destruct z; simpl; auto. + intros. unfold Zmax. destruct z; simpl; auto. change (Z.of_nat (Z.to_nat (Zpos p)) = Zpos p). - apply Z2Nat.id. compute; intuition congruence. + apply Z2Nat.id. compute; intuition congruence. Qed. Lemma nat_of_Z_eq: @@ -607,7 +607,7 @@ Lemma nat_of_Z_plus: p >= 0 -> q >= 0 -> nat_of_Z (p + q) = (nat_of_Z p + nat_of_Z q)%nat. Proof. - unfold nat_of_Z; intros. apply Z2Nat.inj_add; omega. + unfold nat_of_Z; intros. apply Z2Nat.inj_add; omega. Qed. @@ -619,9 +619,9 @@ Definition align (n: Z) (amount: Z) := Lemma align_le: forall x y, y > 0 -> x <= align x y. Proof. - intros. unfold align. + intros. unfold align. generalize (Z_div_mod_eq (x + y - 1) y H). intro. - replace ((x + y - 1) / y * y) + replace ((x + y - 1) / y * y) with ((x + y - 1) - (x + y - 1) mod y). generalize (Z_mod_lt (x + y - 1) y H). omega. rewrite Zmult_comm. omega. @@ -629,7 +629,7 @@ Qed. Lemma align_divides: forall x y, y > 0 -> (y | align x y). Proof. - intros. unfold align. apply Zdivide_factor_l. + intros. unfold align. apply Zdivide_factor_l. Qed. (** * Definitions and theorems on the data types [option], [sum] and [list] *) @@ -709,14 +709,14 @@ Lemma list_length_z_cons: list_length_z (hd :: tl) = list_length_z tl + 1. Proof. intros. unfold list_length_z. simpl. - rewrite (list_length_z_aux_shift tl 1 0). omega. + rewrite (list_length_z_aux_shift tl 1 0). omega. Qed. Lemma list_length_z_pos: forall (A: Type) (l: list A), list_length_z l >= 0. Proof. - induction l; simpl. unfold list_length_z; simpl. omega. + induction l; simpl. unfold list_length_z; simpl. omega. rewrite list_length_z_cons. omega. Qed. @@ -725,7 +725,7 @@ Lemma list_length_z_map: list_length_z (map f l) = list_length_z l. Proof. induction l. reflexivity. simpl. repeat rewrite list_length_z_cons. congruence. -Qed. +Qed. (** Extract the n-th element of a list, as [List.nth_error] does, but the index [n] is of type [Z]. *) @@ -740,7 +740,7 @@ Lemma list_nth_z_in: forall (A: Type) (l: list A) n x, list_nth_z l n = Some x -> In x l. Proof. - induction l; simpl; intros. + induction l; simpl; intros. congruence. destruct (zeq n 0). left; congruence. right; eauto. Qed. @@ -762,7 +762,7 @@ Proof. discriminate. rewrite list_length_z_cons. destruct (zeq n 0). generalize (list_length_z_pos l); omega. - exploit IHl; eauto. unfold Zpred. omega. + exploit IHl; eauto. unfold Zpred. omega. Qed. (** Properties of [List.incl] (list inclusion). *) @@ -795,7 +795,7 @@ Lemma incl_same_head: forall (A: Type) (x: A) (l1 l2: list A), incl l1 l2 -> incl (x::l1) (x::l2). Proof. - intros; red; simpl; intros. intuition. + intros; red; simpl; intros. intuition. Qed. (** Properties of [List.map] (mapping a function over a list). *) @@ -848,9 +848,9 @@ Lemma list_in_map_inv: Proof. induction l; simpl; intros. contradiction. - elim H; intro. + elim H; intro. exists a; intuition auto. - generalize (IHl y H0). intros [x [EQ IN]]. + generalize (IHl y H0). intros [x [EQ IN]]. exists x; tauto. Qed. @@ -869,8 +869,8 @@ Lemma list_append_map_inv: Proof. induction m1; simpl; intros. exists (@nil A); exists l; auto. - destruct l; simpl in H; inv H. - exploit IHm1; eauto. intros [l1 [l2 [P [Q R]]]]. subst l. + destruct l; simpl in H; inv H. + exploit IHm1; eauto. intros [l1 [l2 [P [Q R]]]]. subst l. exists (a0 :: l1); exists l2; intuition. simpl; congruence. Qed. @@ -897,7 +897,7 @@ Remark list_fold_left_app: forall l1 l2 accu, list_fold_left accu (l1 ++ l2) = list_fold_left (list_fold_left accu l1) l2. Proof. - induction l1; simpl; intros. + induction l1; simpl; intros. auto. rewrite IHl1. auto. Qed. @@ -907,11 +907,11 @@ Lemma list_fold_right_eq: list_fold_right l base = match l with nil => base | x :: l' => f x (list_fold_right l' base) end. Proof. - unfold list_fold_right; intros. + unfold list_fold_right; intros. destruct l. auto. - unfold rev'. rewrite <- ! rev_alt. simpl. - rewrite list_fold_left_app. simpl. auto. + unfold rev'. rewrite <- ! rev_alt. simpl. + rewrite list_fold_left_app. simpl. auto. Qed. Lemma list_fold_right_spec: @@ -943,7 +943,7 @@ Proof. intros. apply in_or_app; simpl. elim (in_app_or _ _ _ H); intro; auto. Qed. -(** [list_disjoint l1 l2] holds iff [l1] and [l2] have no elements +(** [list_disjoint l1 l2] holds iff [l1] and [l2] have no elements in common. *) Definition list_disjoint (A: Type) (l1 l2: list A) : Prop := @@ -967,21 +967,21 @@ Lemma list_disjoint_cons_left: forall (A: Type) (a: A) (l1 l2: list A), list_disjoint (a :: l1) l2 -> list_disjoint l1 l2. Proof. - unfold list_disjoint; simpl; intros. apply H; tauto. + unfold list_disjoint; simpl; intros. apply H; tauto. Qed. Lemma list_disjoint_cons_right: forall (A: Type) (a: A) (l1 l2: list A), list_disjoint l1 (a :: l2) -> list_disjoint l1 l2. Proof. - unfold list_disjoint; simpl; intros. apply H; tauto. + unfold list_disjoint; simpl; intros. apply H; tauto. Qed. Lemma list_disjoint_notin: forall (A: Type) (l1 l2: list A) (a: A), list_disjoint l1 l2 -> In a l1 -> ~(In a l2). Proof. - unfold list_disjoint; intros; red; intros. + unfold list_disjoint; intros; red; intros. apply H with a a; auto. Qed. @@ -989,7 +989,7 @@ Lemma list_disjoint_sym: forall (A: Type) (l1 l2: list A), list_disjoint l1 l2 -> list_disjoint l2 l1. Proof. - unfold list_disjoint; intros. + unfold list_disjoint; intros. apply sym_not_equal. apply H; auto. Qed. @@ -1000,9 +1000,9 @@ Proof. induction l1; intros. left; red; intros. elim H. case (In_dec eqA_dec a l2); intro. - right; red; intro. apply (H a a); auto with coqlib. + right; red; intro. apply (H a a); auto with coqlib. case (IHl1 l2); intro. - left; red; intros. elim H; intro. + left; red; intros. elim H; intro. red; intro; subst a y. contradiction. apply l; auto. right; red; intros. elim n0. eapply list_disjoint_cons_left; eauto. @@ -1029,9 +1029,9 @@ Lemma list_norepet_dec: Proof. induction l. left; constructor. - destruct IHl. + destruct IHl. case (In_dec eqA_dec a l); intro. - right. red; intro. inversion H. contradiction. + right. red; intro. inversion H. contradiction. left. constructor; auto. right. red; intro. inversion H. contradiction. Defined. @@ -1047,7 +1047,7 @@ Proof. constructor. red; intro. generalize (list_in_map_inv f _ _ H2). intros [x [EQ IN]]. generalize EQ. change (f hd <> f x). - apply H1. tauto. tauto. + apply H1. tauto. tauto. red; intro; subst x. contradiction. apply IHlist_norepet. intros. apply H1. tauto. tauto. auto. Qed. @@ -1057,20 +1057,20 @@ Remark list_norepet_append_commut: list_norepet (a ++ b) -> list_norepet (b ++ a). Proof. intro A. - assert (forall (x: A) (b: list A) (a: list A), - list_norepet (a ++ b) -> ~(In x a) -> ~(In x b) -> + assert (forall (x: A) (b: list A) (a: list A), + list_norepet (a ++ b) -> ~(In x a) -> ~(In x b) -> list_norepet (a ++ x :: b)). induction a; simpl; intros. constructor; auto. inversion H. constructor. red; intro. elim (in_app_or _ _ _ H6); intro. elim H4. apply in_or_app. tauto. - elim H7; intro. subst a. elim H0. left. auto. + elim H7; intro. subst a. elim H0. left. auto. elim H4. apply in_or_app. tauto. auto. induction a; simpl; intros. rewrite <- app_nil_end. auto. - inversion H0. apply H. auto. + inversion H0. apply H. auto. red; intro; elim H3. apply in_or_app. tauto. red; intro; elim H3. apply in_or_app. tauto. Qed. @@ -1085,10 +1085,10 @@ Proof. tauto. inversion H; subst. rewrite IHl1 in H3. rewrite in_app in H2. intuition. - constructor; auto. red; intros. elim H2; intro. congruence. auto. - destruct H as [B [C D]]. inversion B; subst. - constructor. rewrite in_app. intuition. elim (D a a); auto. apply in_eq. - rewrite IHl1. intuition. red; intros. apply D; auto. apply in_cons; auto. + constructor; auto. red; intros. elim H2; intro. congruence. auto. + destruct H as [B [C D]]. inversion B; subst. + constructor. rewrite in_app. intuition. elim (D a a); auto. apply in_eq. + rewrite IHl1. intuition. red; intros. apply D; auto. apply in_cons; auto. Qed. Lemma list_norepet_append: @@ -1133,7 +1133,7 @@ Lemma is_tail_cons_left: forall (A: Type) (i: A) c1 c2, is_tail (i :: c1) c2 -> is_tail c1 c2. Proof. induction c2; intros; inversion H. - constructor. constructor. constructor. auto. + constructor. constructor. constructor. auto. Qed. Hint Resolve is_tail_refl is_tail_cons is_tail_in is_tail_cons_left: coqlib. @@ -1171,10 +1171,10 @@ Inductive list_forall2: list A -> list B -> Prop := Lemma list_forall2_app: forall a2 b2 a1 b1, - list_forall2 a1 b1 -> list_forall2 a2 b2 -> + list_forall2 a1 b1 -> list_forall2 a2 b2 -> list_forall2 (a1 ++ a2) (b1 ++ b2). Proof. - induction 1; intros; simpl. auto. constructor; auto. + induction 1; intros; simpl. auto. constructor; auto. Qed. Lemma list_forall2_length: @@ -1195,7 +1195,7 @@ Lemma list_forall2_imply: Proof. induction 1; intros. constructor. - constructor. auto with coqlib. apply IHlist_forall2; auto. + constructor. auto with coqlib. apply IHlist_forall2; auto. intros. auto with coqlib. Qed. @@ -1210,7 +1210,7 @@ Fixpoint list_drop (A: Type) (n: nat) (x: list A) {struct n} : list A := Lemma list_drop_incl: forall (A: Type) (x: A) n (l: list A), In x (list_drop n l) -> In x l. Proof. - induction n; simpl; intros. auto. + induction n; simpl; intros. auto. destruct l; auto with coqlib. Qed. @@ -1225,7 +1225,7 @@ Lemma list_map_drop: forall (A B: Type) (f: A -> B) n (l: list A), list_drop n (map f l) = map f (list_drop n l). Proof. - induction n; simpl; intros. auto. + induction n; simpl; intros. auto. destruct l; simpl; auto. Qed. @@ -1267,7 +1267,7 @@ Qed. Lemma proj_sumbool_is_true: forall (P: Prop) (a: {P}+{~P}), P -> proj_sumbool a = true. Proof. - intros. unfold proj_sumbool. destruct a. auto. contradiction. + intros. unfold proj_sumbool. destruct a. auto. contradiction. Qed. Ltac InvBooleans := @@ -1306,7 +1306,7 @@ Lemma dec_eq_sym: (if dec_eq x y then ifso else ifnot) = (if dec_eq y x then ifso else ifnot). Proof. - intros. destruct (dec_eq x y). + intros. destruct (dec_eq x y). subst y. rewrite dec_eq_true. auto. rewrite dec_eq_false; auto. Qed. @@ -1352,22 +1352,22 @@ Inductive lex_ord: A*B -> A*B -> Prop := | lex_ord_right: forall a b1 b2, ordB b1 b2 -> lex_ord (a,b1) (a,b2). -Lemma wf_lex_ord: +Lemma wf_lex_ord: well_founded ordA -> well_founded ordB -> well_founded lex_ord. Proof. intros Awf Bwf. assert (forall a, Acc ordA a -> forall b, Acc ordB b -> Acc lex_ord (a, b)). induction 1. induction 1. constructor; intros. inv H3. apply H0. auto. apply Bwf. - apply H2; auto. + apply H2; auto. red; intros. destruct a as [a b]. apply H; auto. Qed. Lemma transitive_lex_ord: transitive _ ordA -> transitive _ ordB -> transitive _ lex_ord. Proof. - intros trA trB; red; intros. - inv H; inv H0. + intros trA trB; red; intros. + inv H; inv H0. left; eapply trA; eauto. left; auto. left; auto. diff --git a/lib/FSetAVLplus.v b/lib/FSetAVLplus.v index eab427be..f16805c6 100644 --- a/lib/FSetAVLplus.v +++ b/lib/FSetAVLplus.v @@ -65,7 +65,7 @@ Proof. - discriminate. - destruct (above_low_bound t1) eqn: LB; [destruct (below_high_bound t1) eqn: HB | idtac]. + (* in interval *) - exists t1; split; auto. apply Raw.IsRoot. auto. + exists t1; split; auto. apply Raw.IsRoot. auto. + (* above interval *) exploit IHm1; auto. intros [x' [A B]]. exists x'; split; auto. apply Raw.InLeft; auto. + (* below interval *) @@ -80,7 +80,7 @@ Lemma raw_mem_between_2: Proof. induction 1; simpl; intros. - inv H. -- rewrite Raw.In_node_iff in H1. +- rewrite Raw.In_node_iff in H1. destruct (above_low_bound x0) eqn: LB; [destruct (below_high_bound x0) eqn: HB | idtac]. + (* in interval *) auto. @@ -98,7 +98,7 @@ Theorem mem_between_1: mem_between s = true -> exists x, In x s /\ above_low_bound x = true /\ below_high_bound x = true. Proof. - intros. apply raw_mem_between_1. auto. + intros. apply raw_mem_between_1. auto. Qed. Theorem mem_between_2: @@ -138,9 +138,9 @@ Remark In_raw_elements_between_1: Proof. induction m; simpl; intros. - inv H. -- rewrite Raw.In_node_iff. +- rewrite Raw.In_node_iff. destruct (above_low_bound t1) eqn:LB; [destruct (below_high_bound t1) eqn: RB | idtac]; simpl in H. - + rewrite Raw.join_spec in H. intuition. + + rewrite Raw.join_spec in H. intuition. + left; apply IHm1; auto. + right; right; apply IHm2; auto. Qed. @@ -174,7 +174,7 @@ Proof. - inv H. - destruct (above_low_bound t1) eqn:LB; [destruct (below_high_bound t1) eqn: RB | idtac]; simpl in H. + rewrite Raw.join_spec in H. intuition. - apply above_monotone with t1; auto. + apply above_monotone with t1; auto. apply below_monotone with t1; auto. + auto. + auto. @@ -190,7 +190,7 @@ Proof. - auto. - rewrite Raw.In_node_iff in H1. destruct (above_low_bound x0) eqn:LB; [destruct (below_high_bound x0) eqn: RB | idtac]. - + rewrite Raw.join_spec. intuition. + + rewrite Raw.join_spec. intuition. + assert (X.eq x x0 \/ X.lt x0 x -> False). { intros. exploit below_monotone; eauto. congruence. } intuition. elim H7. apply g. auto. @@ -204,7 +204,7 @@ Theorem elements_between_iff: In x (elements_between s) <-> In x s /\ above_low_bound x = true /\ below_high_bound x = true. Proof. intros. unfold elements_between, In; simpl. split. - intros. split. apply In_raw_elements_between_1; auto. eapply In_raw_elements_between_2; eauto. + intros. split. apply In_raw_elements_between_1; auto. eapply In_raw_elements_between_2; eauto. intros [A [B C]]. apply In_raw_elements_between_3; auto. apply MSet.is_ok. Qed. @@ -254,24 +254,24 @@ Lemma raw_for_all_between_1: pred x = true. Proof. induction 1; simpl; intros. -- inv H0. +- inv H0. - destruct (above_low_bound x0) eqn: LB; [destruct (below_high_bound x0) eqn: HB | idtac]. + (* in interval *) destruct (andb_prop _ _ H1) as [P C]. destruct (andb_prop _ _ P) as [A B]. clear H1 P. inv H2. - * erewrite pred_compat; eauto. + * erewrite pred_compat; eauto. * apply IHbst1; auto. * apply IHbst2; auto. + (* above interval *) inv H2. - * assert (below_high_bound x0 = true) by (apply below_monotone with x; auto). + * assert (below_high_bound x0 = true) by (apply below_monotone with x; auto). congruence. * apply IHbst1; auto. * assert (below_high_bound x0 = true) by (apply below_monotone with x; auto). congruence. + (* below interval *) inv H2. - * assert (above_low_bound x0 = true) by (apply above_monotone with x; auto). + * assert (above_low_bound x0 = true) by (apply above_monotone with x; auto). congruence. * assert (above_low_bound x0 = true) by (apply above_monotone with x; auto). congruence. @@ -290,7 +290,7 @@ Proof. + (* in interval *) rewrite IHbst1. rewrite (H1 x). rewrite IHbst2. auto. intros. apply H1; auto. apply Raw.InRight; auto. - apply Raw.IsRoot. reflexivity. auto. auto. + apply Raw.IsRoot. reflexivity. auto. auto. intros. apply H1; auto. apply Raw.InLeft; auto. + (* above interval *) apply IHbst1. intros. apply H1; auto. apply Raw.InLeft; auto. @@ -303,7 +303,7 @@ Theorem for_all_between_iff: for_all_between s = true <-> (forall x, In x s -> above_low_bound x = true -> below_high_bound x = true -> pred x = true). Proof. unfold for_all_between; intros; split; intros. -- eapply raw_for_all_between_1; eauto. apply MSet.is_ok. +- eapply raw_for_all_between_1; eauto. apply MSet.is_ok. - apply raw_for_all_between_2; auto. apply MSet.is_ok. Qed. @@ -337,10 +337,10 @@ Remark In_raw_partition_between_1: Proof. induction m; simpl; intros. - inv H. -- destruct (raw_partition_between m1) as [l1 l2] eqn:LEQ; simpl in *. +- destruct (raw_partition_between m1) as [l1 l2] eqn:LEQ; simpl in *. destruct (raw_partition_between m2) as [r1 r2] eqn:REQ; simpl in *. destruct (above_low_bound t1) eqn:LB; [destruct (below_high_bound t1) eqn: RB | idtac]; simpl in H. - + rewrite Raw.join_spec in H. rewrite Raw.In_node_iff. intuition. + + rewrite Raw.join_spec in H. rewrite Raw.In_node_iff. intuition. + rewrite Raw.In_node_iff. intuition. + rewrite Raw.In_node_iff. intuition. Qed. @@ -351,10 +351,10 @@ Remark In_raw_partition_between_2: Proof. induction m; simpl; intros. - inv H. -- destruct (raw_partition_between m1) as [l1 l2] eqn:LEQ; simpl in *. +- destruct (raw_partition_between m1) as [l1 l2] eqn:LEQ; simpl in *. destruct (raw_partition_between m2) as [r1 r2] eqn:REQ; simpl in *. destruct (above_low_bound t1) eqn:LB; [destruct (below_high_bound t1) eqn: RB | idtac]; simpl in H. - + rewrite Raw.concat_spec in H. rewrite Raw.In_node_iff. intuition. + + rewrite Raw.concat_spec in H. rewrite Raw.In_node_iff. intuition. + rewrite Raw.join_spec in H. rewrite Raw.In_node_iff. intuition. + rewrite Raw.join_spec in H. rewrite Raw.In_node_iff. intuition. Qed. @@ -364,22 +364,22 @@ Lemma raw_partition_between_ok: Proof. induction 1; simpl. - split; constructor. -- destruct IHbst1 as [L1 L2]. destruct IHbst2 as [R1 R2]. - destruct (raw_partition_between l) as [l1 l2] eqn:LEQ; simpl in *. +- destruct IHbst1 as [L1 L2]. destruct IHbst2 as [R1 R2]. + destruct (raw_partition_between l) as [l1 l2] eqn:LEQ; simpl in *. destruct (raw_partition_between r) as [r1 r2] eqn:REQ; simpl in *. destruct (above_low_bound x) eqn:LB; [destruct (below_high_bound x) eqn: RB | idtac]; simpl. + split. apply Raw.join_ok; auto. - red; intros. apply l0. apply In_raw_partition_between_1. rewrite LEQ; auto. + red; intros. apply l0. apply In_raw_partition_between_1. rewrite LEQ; auto. red; intros. apply g. apply In_raw_partition_between_1. rewrite REQ; auto. apply Raw.concat_ok; auto. - intros. transitivity x. - apply l0. apply In_raw_partition_between_2. rewrite LEQ; auto. + intros. transitivity x. + apply l0. apply In_raw_partition_between_2. rewrite LEQ; auto. apply g. apply In_raw_partition_between_2. rewrite REQ; auto. + split. auto. apply Raw.join_ok; auto. - red; intros. apply l0. apply In_raw_partition_between_2. rewrite LEQ; auto. + red; intros. apply l0. apply In_raw_partition_between_2. rewrite LEQ; auto. + split. auto. apply Raw.join_ok; auto. @@ -397,11 +397,11 @@ Remark In_raw_partition_between_3: Proof. induction m; simpl; intros. - inv H. -- destruct (raw_partition_between m1) as [l1 l2] eqn:LEQ; simpl in *. +- destruct (raw_partition_between m1) as [l1 l2] eqn:LEQ; simpl in *. destruct (raw_partition_between m2) as [r1 r2] eqn:REQ; simpl in *. destruct (above_low_bound t1) eqn:LB; [destruct (below_high_bound t1) eqn: RB | idtac]; simpl in H. + rewrite Raw.join_spec in H. intuition. - apply above_monotone with t1; auto. + apply above_monotone with t1; auto. apply below_monotone with t1; auto. + auto. + auto. @@ -414,17 +414,17 @@ Remark In_raw_partition_between_4: Proof. induction 1; simpl; intros. - inv H. -- destruct (raw_partition_between l) as [l1 l2] eqn:LEQ; simpl in *. +- destruct (raw_partition_between l) as [l1 l2] eqn:LEQ; simpl in *. destruct (raw_partition_between r) as [r1 r2] eqn:REQ; simpl in *. destruct (above_low_bound x0) eqn:LB; [destruct (below_high_bound x0) eqn: RB | idtac]; simpl in H. - + simpl in H1. rewrite Raw.concat_spec in H1. intuition. + + simpl in H1. rewrite Raw.concat_spec in H1. intuition. + assert (forall y, X.eq y x0 \/ X.lt x0 y -> below_high_bound y = false). - { intros. destruct (below_high_bound y) eqn:E; auto. + { intros. destruct (below_high_bound y) eqn:E; auto. assert (below_high_bound x0 = true) by (apply below_monotone with y; auto). congruence. } simpl in H1. rewrite Raw.join_spec in H1. intuition. + assert (forall y, X.eq y x0 \/ X.lt y x0 -> above_low_bound y = false). - { intros. destruct (above_low_bound y) eqn:E; auto. + { intros. destruct (above_low_bound y) eqn:E; auto. assert (above_low_bound x0 = true) by (apply above_monotone with y; auto). congruence. } simpl in H1. rewrite Raw.join_spec in H1. intuition. @@ -438,23 +438,23 @@ Remark In_raw_partition_between_5: Proof. induction 1; simpl; intros. - inv H. -- destruct (raw_partition_between l) as [l1 l2] eqn:LEQ; simpl in *. +- destruct (raw_partition_between l) as [l1 l2] eqn:LEQ; simpl in *. destruct (raw_partition_between r) as [r1 r2] eqn:REQ; simpl in *. destruct (above_low_bound x0) eqn:LB; [destruct (below_high_bound x0) eqn: RB | idtac]; simpl in H. - + simpl. rewrite Raw.join_spec. inv H1. + + simpl. rewrite Raw.join_spec. inv H1. auto. - right; left; apply IHbst1; auto. + right; left; apply IHbst1; auto. right; right; apply IHbst2; auto. - + simpl. inv H1. + + simpl. inv H1. assert (below_high_bound x0 = true) by (apply below_monotone with x; auto). congruence. - auto. - assert (below_high_bound x0 = true) by (apply below_monotone with x; auto). + auto. + assert (below_high_bound x0 = true) by (apply below_monotone with x; auto). congruence. - + simpl. inv H1. + + simpl. inv H1. assert (above_low_bound x0 = true) by (apply above_monotone with x; auto). congruence. - assert (above_low_bound x0 = true) by (apply above_monotone with x; auto). + assert (above_low_bound x0 = true) by (apply above_monotone with x; auto). congruence. eauto. Qed. @@ -467,7 +467,7 @@ Remark In_raw_partition_between_6: Proof. induction 1; simpl; intros. - inv H. -- destruct (raw_partition_between l) as [l1 l2] eqn:LEQ; simpl in *. +- destruct (raw_partition_between l) as [l1 l2] eqn:LEQ; simpl in *. destruct (raw_partition_between r) as [r1 r2] eqn:REQ; simpl in *. destruct (above_low_bound x0) eqn:LB; [destruct (below_high_bound x0) eqn: RB | idtac]; simpl in H. + simpl. rewrite Raw.concat_spec. inv H1. @@ -476,11 +476,11 @@ Proof. destruct H2; congruence. left; apply IHbst1; auto. right; apply IHbst2; auto. - + simpl. rewrite Raw.join_spec. inv H1. + + simpl. rewrite Raw.join_spec. inv H1. auto. - right; left; apply IHbst1; auto. + right; left; apply IHbst1; auto. auto. - + simpl. rewrite Raw.join_spec. inv H1. + + simpl. rewrite Raw.join_spec. inv H1. auto. auto. right; right; apply IHbst2; auto. @@ -496,7 +496,7 @@ Theorem partition_between_iff_1: In x (fst (partition_between s)) <-> In x s /\ above_low_bound x = true /\ below_high_bound x = true. Proof. - intros. unfold partition_between, In; simpl. split. + intros. unfold partition_between, In; simpl. split. intros. split. apply In_raw_partition_between_1; auto. eapply In_raw_partition_between_3; eauto. intros [A [B C]]. apply In_raw_partition_between_5; auto. apply MSet.is_ok. Qed. @@ -506,7 +506,7 @@ Theorem partition_between_iff_2: In x (snd (partition_between s)) <-> In x s /\ (above_low_bound x = false \/ below_high_bound x = false). Proof. - intros. unfold partition_between, In; simpl. split. + intros. unfold partition_between, In; simpl. split. intros. split. apply In_raw_partition_between_2; auto. eapply In_raw_partition_between_4; eauto. apply MSet.is_ok. intros [A B]. apply In_raw_partition_between_6; auto. apply MSet.is_ok. Qed. diff --git a/lib/Fappli_IEEE_extra.v b/lib/Fappli_IEEE_extra.v index 3de7b103..fe7f7c6d 100644 --- a/lib/Fappli_IEEE_extra.v +++ b/lib/Fappli_IEEE_extra.v @@ -110,10 +110,10 @@ Proof. subst; left; f_equal; f_equal; apply UIP_bool. destruct (positive_eq_dec m m0); try_not_eq; destruct (Z_eq_dec e e1); try solve [right; intro H; inversion H; congruence]; - subst; left; f_equal; apply UIP_bool. + subst; left; f_equal; apply UIP_bool. destruct (positive_eq_dec m m0); try_not_eq; destruct (Z_eq_dec e e1); try solve [right; intro H; inversion H; congruence]; - subst; left; f_equal; apply UIP_bool. + subst; left; f_equal; apply UIP_bool. Defined. (** ** Conversion from an integer to a FP number *) @@ -134,16 +134,16 @@ Lemma integer_representable_n2p: -2^prec < n < 2^prec -> 0 <= p -> p <= emax - prec -> integer_representable (n * 2^p). Proof. - intros; split. + intros; split. - red in prec_gt_0_. replace (Z.abs (n * 2^p)) with (Z.abs n * 2^p). rewrite int_upper_bound_eq. - apply Zmult_le_compat. zify; omega. apply (Zpower_le radix2); omega. - zify; omega. apply (Zpower_ge_0 radix2). - rewrite Z.abs_mul. f_equal. rewrite Z.abs_eq. auto. apply (Zpower_ge_0 radix2). + apply Zmult_le_compat. zify; omega. apply (Zpower_le radix2); omega. + zify; omega. apply (Zpower_ge_0 radix2). + rewrite Z.abs_mul. f_equal. rewrite Z.abs_eq. auto. apply (Zpower_ge_0 radix2). - apply generic_format_FLT. exists (Float radix2 n p). unfold F2R; simpl. - split. rewrite <- Z2R_Zpower by auto. apply Z2R_mult. - split. zify; omega. + split. rewrite <- Z2R_Zpower by auto. apply Z2R_mult. + split. zify; omega. unfold emin; red in prec_gt_0_; omega. Qed. @@ -152,13 +152,13 @@ Lemma integer_representable_2p: 0 <= p <= emax - 1 -> integer_representable (2^p). Proof. - intros; split. -- red in prec_gt_0_. - rewrite Z.abs_eq by (apply (Zpower_ge_0 radix2)). - apply Zle_trans with (2^(emax-1)). + intros; split. +- red in prec_gt_0_. + rewrite Z.abs_eq by (apply (Zpower_ge_0 radix2)). + apply Zle_trans with (2^(emax-1)). apply (Zpower_le radix2); omega. assert (2^emax = 2^(emax-1)*2). - { change 2 with (2^1) at 3. rewrite <- (Zpower_plus radix2) by omega. + { change 2 with (2^1) at 3. rewrite <- (Zpower_plus radix2) by omega. f_equal. omega. } assert (2^(emax - prec) <= 2^(emax - 1)). { apply (Zpower_le radix2). omega. } @@ -166,7 +166,7 @@ Proof. - red in prec_gt_0_. apply generic_format_FLT. exists (Float radix2 1 p). unfold F2R; simpl. - split. rewrite Rmult_1_l. rewrite <- Z2R_Zpower. auto. omega. + split. rewrite Rmult_1_l. rewrite <- Z2R_Zpower. auto. omega. split. change 1 with (2^0). apply (Zpower_lt radix2). omega. auto. unfold emin; omega. Qed. @@ -174,7 +174,7 @@ Qed. Lemma integer_representable_opp: forall n, integer_representable n -> integer_representable (-n). Proof. - intros n (A & B); split. rewrite Z.abs_opp. auto. + intros n (A & B); split. rewrite Z.abs_opp. auto. rewrite Z2R_opp. apply generic_format_opp; auto. Qed. @@ -186,10 +186,10 @@ Proof. intros. red in prec_gt_0_. destruct (Z.eq_dec n (2^prec)); [idtac | destruct (Z.eq_dec n (-2^prec))]. - rewrite e. rewrite <- (Zpower_plus radix2) by omega. - apply integer_representable_2p. omega. -- rewrite e. rewrite <- Zopp_mult_distr_l. apply integer_representable_opp. + apply integer_representable_2p. omega. +- rewrite e. rewrite <- Zopp_mult_distr_l. apply integer_representable_opp. rewrite <- (Zpower_plus radix2) by omega. - apply integer_representable_2p. omega. + apply integer_representable_2p. omega. - apply integer_representable_n2p; omega. Qed. @@ -198,7 +198,7 @@ Lemma integer_representable_n: Proof. red in prec_gt_0_. intros. replace n with (n * 2^0) by (change (2^0) with 1; ring). - apply integer_representable_n2p_wide. auto. omega. omega. + apply integer_representable_n2p_wide. auto. omega. omega. Qed. Lemma round_int_no_overflow: @@ -207,19 +207,19 @@ Lemma round_int_no_overflow: (Rabs (round radix2 fexp (round_mode mode_NE) (Z2R n)) < bpow radix2 emax)%R. Proof. intros. red in prec_gt_0_. - rewrite <- round_NE_abs. + rewrite <- round_NE_abs. apply Rle_lt_trans with (Z2R (2^emax - 2^(emax-prec))). apply round_le_generic. apply fexp_correct; auto. apply valid_rnd_N. apply generic_format_FLT. exists (Float radix2 (2^prec-1) (emax-prec)). rewrite int_upper_bound_eq. unfold F2R; simpl. - split. rewrite <- Z2R_Zpower by omega. rewrite <- Z2R_mult. auto. + split. rewrite <- Z2R_Zpower by omega. rewrite <- Z2R_mult. auto. split. assert (0 < 2^prec) by (apply (Zpower_gt_0 radix2); omega). zify; omega. unfold emin; omega. rewrite <- Z2R_abs. apply Z2R_le. auto. - rewrite <- Z2R_Zpower by omega. apply Z2R_lt. simpl. + rewrite <- Z2R_Zpower by omega. apply Z2R_lt. simpl. assert (0 < 2^(emax-prec)) by (apply (Zpower_gt_0 radix2); omega). omega. - apply fexp_correct. auto. + apply fexp_correct. auto. Qed. (** Conversion from an integer. Round to nearest. *) @@ -237,17 +237,17 @@ Theorem BofZ_correct: else B2FF prec emax (BofZ n) = binary_overflow prec emax mode_NE (Zlt_bool n 0). Proof. - intros. + intros. generalize (binary_normalize_correct prec emax prec_gt_0_ Hmax mode_NE n 0 false). - fold emin; fold fexp; fold (BofZ n). - replace (F2R {| Fnum := n; Fexp := 0 |}) with (Z2R n). - destruct Rlt_bool. + fold emin; fold fexp; fold (BofZ n). + replace (F2R {| Fnum := n; Fexp := 0 |}) with (Z2R n). + destruct Rlt_bool. - intros (A & B & C). split; [|split]. + auto. + auto. - + rewrite C. change 0%R with (Z2R 0). rewrite Rcompare_Z2R. + + rewrite C. change 0%R with (Z2R 0). rewrite Rcompare_Z2R. unfold Zlt_bool. auto. -- intros A; rewrite A. f_equal. change 0%R with (Z2R 0). +- intros A; rewrite A. f_equal. change 0%R with (Z2R 0). generalize (Zlt_bool_spec n 0); intros SPEC; inversion SPEC. apply Rlt_bool_true; apply Z2R_lt; auto. apply Rlt_bool_false; apply Z2R_le; auto. @@ -262,7 +262,7 @@ Theorem BofZ_finite: /\ Bsign _ _ (BofZ n) = Zlt_bool n 0%Z. Proof. intros. - generalize (BofZ_correct n). rewrite Rlt_bool_true. auto. + generalize (BofZ_correct n). rewrite Rlt_bool_true. auto. apply round_int_no_overflow; auto. Qed. @@ -274,7 +274,7 @@ Theorem BofZ_representable: /\ Bsign _ _ (BofZ n) = (n <? 0). Proof. intros. destruct H as (P & Q). destruct (BofZ_finite n) as (A & B & C). auto. - intuition. rewrite A. apply round_generic. apply valid_rnd_round_mode. auto. + intuition. rewrite A. apply round_generic. apply valid_rnd_round_mode. auto. Qed. Theorem BofZ_exact: @@ -291,21 +291,21 @@ Lemma BofZ_finite_pos0: forall n, Z.abs n <= 2^emax - 2^(emax-prec) -> is_finite_pos0 (BofZ n) = true. Proof. - intros. + intros. generalize (binary_normalize_correct prec emax prec_gt_0_ Hmax mode_NE n 0 false). - fold emin; fold fexp; fold (BofZ n). + fold emin; fold fexp; fold (BofZ n). replace (F2R {| Fnum := n; Fexp := 0 |}) with (Z2R n) by (unfold F2R; simpl; ring). rewrite Rlt_bool_true by (apply round_int_no_overflow; auto). intros (A & B & C). - destruct (BofZ n); auto; try discriminate. - simpl in *. rewrite C. change 0%R with (Z2R 0). rewrite Rcompare_Z2R. + destruct (BofZ n); auto; try discriminate. + simpl in *. rewrite C. change 0%R with (Z2R 0). rewrite Rcompare_Z2R. generalize (Zcompare_spec n 0); intros SPEC; inversion SPEC; auto. assert ((round radix2 fexp ZnearestE (Z2R n) <= -1)%R). { change (-1)%R with (Z2R (-1)). apply round_le_generic. apply fexp_correct. auto. apply valid_rnd_N. - apply (integer_representable_opp 1). - apply (integer_representable_2p 0). + apply (integer_representable_opp 1). + apply (integer_representable_2p 0). red in prec_gt_0_; omega. apply Z2R_le; omega. } @@ -325,16 +325,16 @@ Qed. (** Commutation properties with addition, subtraction, multiplication. *) Theorem BofZ_plus: - forall nan p q, + forall nan p q, integer_representable p -> integer_representable q -> Bplus _ _ _ Hmax nan mode_NE (BofZ p) (BofZ q) = BofZ (p + q). Proof. - intros. - destruct (BofZ_representable p) as (A & B & C); auto. + intros. + destruct (BofZ_representable p) as (A & B & C); auto. destruct (BofZ_representable q) as (D & E & F); auto. generalize (Bplus_correct _ _ _ Hmax nan mode_NE (BofZ p) (BofZ q) B E). fold emin; fold fexp. - rewrite A, D. rewrite <- Z2R_plus. + rewrite A, D. rewrite <- Z2R_plus. generalize (BofZ_correct (p + q)). destruct Rlt_bool. - intros (P & Q & R) (U & V & W). apply B2R_Bsign_inj; auto. @@ -342,29 +342,29 @@ Proof. rewrite R, W, C, F. change 0%R with (Z2R 0). rewrite Rcompare_Z2R. unfold Zlt_bool at 3. generalize (Zcompare_spec (p + q) 0); intros SPEC; inversion SPEC; auto. - assert (EITHER: 0 <= p \/ 0 <= q) by omega. + assert (EITHER: 0 <= p \/ 0 <= q) by omega. destruct EITHER; [apply andb_false_intro1 | apply andb_false_intro2]; apply Zlt_bool_false; auto. -- intros P (U & V). - apply B2FF_inj. - rewrite P, U, C. f_equal. rewrite C, F in V. - generalize (Zlt_bool_spec p 0) (Zlt_bool_spec q 0). rewrite <- V. +- intros P (U & V). + apply B2FF_inj. + rewrite P, U, C. f_equal. rewrite C, F in V. + generalize (Zlt_bool_spec p 0) (Zlt_bool_spec q 0). rewrite <- V. intros SPEC1 SPEC2; inversion SPEC1; inversion SPEC2; try congruence; symmetry. apply Zlt_bool_true; omega. apply Zlt_bool_false; omega. Qed. Theorem BofZ_minus: - forall nan p q, + forall nan p q, integer_representable p -> integer_representable q -> Bminus _ _ _ Hmax nan mode_NE (BofZ p) (BofZ q) = BofZ (p - q). Proof. - intros. - destruct (BofZ_representable p) as (A & B & C); auto. + intros. + destruct (BofZ_representable p) as (A & B & C); auto. destruct (BofZ_representable q) as (D & E & F); auto. generalize (Bminus_correct _ _ _ Hmax nan mode_NE (BofZ p) (BofZ q) B E). fold emin; fold fexp. - rewrite A, D. rewrite <- Z2R_minus. + rewrite A, D. rewrite <- Z2R_minus. generalize (BofZ_correct (p - q)). destruct Rlt_bool. - intros (P & Q & R) (U & V & W). apply B2R_Bsign_inj; auto. @@ -372,14 +372,14 @@ Proof. rewrite R, W, C, F. change 0%R with (Z2R 0). rewrite Rcompare_Z2R. unfold Zlt_bool at 3. generalize (Zcompare_spec (p - q) 0); intros SPEC; inversion SPEC; auto. - assert (EITHER: 0 <= p \/ q < 0) by omega. + assert (EITHER: 0 <= p \/ q < 0) by omega. destruct EITHER; [apply andb_false_intro1 | apply andb_false_intro2]. rewrite Zlt_bool_false; auto. rewrite Zlt_bool_true; auto. -- intros P (U & V). - apply B2FF_inj. - rewrite P, U, C. f_equal. rewrite C, F in V. - generalize (Zlt_bool_spec p 0) (Zlt_bool_spec q 0). rewrite V. +- intros P (U & V). + apply B2FF_inj. + rewrite P, U, C. f_equal. rewrite C, F in V. + generalize (Zlt_bool_spec p 0) (Zlt_bool_spec q 0). rewrite V. intros SPEC1 SPEC2; inversion SPEC1; inversion SPEC2; symmetry. rewrite <- H3 in H1; discriminate. apply Zlt_bool_true; omega. @@ -388,20 +388,20 @@ Proof. Qed. Theorem BofZ_mult: - forall nan p q, + forall nan p q, integer_representable p -> integer_representable q -> 0 < q -> Bmult _ _ _ Hmax nan mode_NE (BofZ p) (BofZ q) = BofZ (p * q). Proof. - intros. + intros. assert (SIGN: xorb (p <? 0) (q <? 0) = (p * q <? 0)). { rewrite (Zlt_bool_false q) by omega. generalize (Zlt_bool_spec p 0); intros SPEC; inversion SPEC; simpl; symmetry. apply Zlt_bool_true. rewrite Z.mul_comm. apply Z.mul_pos_neg; omega. - apply Zlt_bool_false. apply Zsame_sign_imp; omega. + apply Zlt_bool_false. apply Zsame_sign_imp; omega. } - destruct (BofZ_representable p) as (A & B & C); auto. + destruct (BofZ_representable p) as (A & B & C); auto. destruct (BofZ_representable q) as (D & E & F); auto. generalize (Bmult_correct _ _ _ Hmax nan mode_NE (BofZ p) (BofZ q)). fold emin; fold fexp. @@ -424,27 +424,27 @@ Theorem BofZ_mult_2p: Bmult _ _ _ Hmax nan mode_NE (BofZ x) (BofZ (2^p)) = BofZ (x * 2^p). Proof. intros. - destruct (Z.eq_dec x 0). + destruct (Z.eq_dec x 0). - subst x. apply BofZ_mult. - apply integer_representable_n. + apply integer_representable_n. generalize (Zpower_ge_0 radix2 prec). simpl; omega. - apply integer_representable_2p. auto. + apply integer_representable_2p. auto. apply (Zpower_gt_0 radix2). omega. - assert (Z2R x <> 0%R) by (apply (Z2R_neq _ _ n)). destruct (BofZ_finite x H) as (A & B & C). - destruct (BofZ_representable (2^p)) as (D & E & F). + destruct (BofZ_representable (2^p)) as (D & E & F). apply integer_representable_2p. auto. assert (canonic_exp radix2 fexp (Z2R (x * 2^p)) = canonic_exp radix2 fexp (Z2R x) + p). { - unfold canonic_exp, fexp. rewrite Z2R_mult. - change (2^p) with (radix2^p). rewrite Z2R_Zpower by omega. + unfold canonic_exp, fexp. rewrite Z2R_mult. + change (2^p) with (radix2^p). rewrite Z2R_Zpower by omega. rewrite ln_beta_mult_bpow by auto. assert (prec + 1 <= ln_beta radix2 (Z2R x)). - { rewrite <- (ln_beta_abs radix2 (Z2R x)). - rewrite <- (ln_beta_bpow radix2 prec). - apply ln_beta_le. + { rewrite <- (ln_beta_abs radix2 (Z2R x)). + rewrite <- (ln_beta_bpow radix2 prec). + apply ln_beta_le. apply bpow_gt_0. rewrite <- Z2R_Zpower by (red in prec_gt_0_;omega). rewrite <- Z2R_abs. apply Z2R_le; auto. } unfold FLT_exp. @@ -453,25 +453,25 @@ Proof. assert (forall m, round radix2 fexp m (Z2R x) * Z2R (2^p) = round radix2 fexp m (Z2R (x * 2^p)))%R. { - intros. unfold round, scaled_mantissa. rewrite H3. - rewrite Z2R_mult. rewrite Z.opp_add_distr. rewrite bpow_plus. + intros. unfold round, scaled_mantissa. rewrite H3. + rewrite Z2R_mult. rewrite Z.opp_add_distr. rewrite bpow_plus. set (a := Z2R x); set (b := bpow radix2 (- canonic_exp radix2 fexp a)). replace (a * Z2R (2^p) * (b * bpow radix2 (-p)))%R with (a * b)%R. - unfold F2R; simpl. rewrite Rmult_assoc. f_equal. - rewrite bpow_plus. f_equal. apply (Z2R_Zpower radix2). omega. + unfold F2R; simpl. rewrite Rmult_assoc. f_equal. + rewrite bpow_plus. f_equal. apply (Z2R_Zpower radix2). omega. transitivity ((a * b) * (Z2R (2^p) * bpow radix2 (-p)))%R. - rewrite (Z2R_Zpower radix2). rewrite <- bpow_plus. + rewrite (Z2R_Zpower radix2). rewrite <- bpow_plus. replace (p + -p) with 0 by omega. change (bpow radix2 0) with 1%R. ring. - omega. + omega. ring. } assert (forall m x, round radix2 fexp (round_mode m) (round radix2 fexp (round_mode m) x) = round radix2 fexp (round_mode m) x). { - intros. apply round_generic. apply valid_rnd_round_mode. - apply generic_format_round. apply fexp_correct; auto. - apply valid_rnd_round_mode. + intros. apply round_generic. apply valid_rnd_round_mode. + apply generic_format_round. apply fexp_correct; auto. + apply valid_rnd_round_mode. } assert (xorb (x <? 0) (2^p <? 0) = (x * 2^p <? 0)). { @@ -490,7 +490,7 @@ Proof. rewrite P, U. auto. rewrite R, W. auto. apply is_finite_not_is_nan; auto. -+ intros P U. ++ intros P U. apply B2FF_inj. rewrite P, U. f_equal; auto. Qed. @@ -503,8 +503,8 @@ Lemma round_odd_flt: round radix2 fexp (Znearest choice) x. Proof. intros. apply round_odd_prop. auto. apply fexp_correct; auto. - apply exists_NE_FLT. right; omega. - apply FLT_exp_valid. red; omega. + apply exists_NE_FLT. right; omega. + apply FLT_exp_valid. red; omega. apply exists_NE_FLT. right; omega. unfold fexp, FLT_exp; intros. zify; omega. Qed. @@ -517,29 +517,29 @@ Corollary round_odd_fix: round radix2 fexp (Znearest choice) (round radix2 (FIX_exp p) Zrnd_odd x) = round radix2 fexp (Znearest choice) x. Proof. - intros. destruct (Req_EM_T x 0%R). -- subst x. rewrite round_0. auto. apply valid_rnd_odd. + intros. destruct (Req_EM_T x 0%R). +- subst x. rewrite round_0. auto. apply valid_rnd_odd. - set (prec' := ln_beta radix2 x - p). set (emin' := emin - 2). assert (PREC: ln_beta radix2 (bpow radix2 (prec + p + 1)) <= ln_beta radix2 x). { rewrite <- (ln_beta_abs radix2 x). apply ln_beta_le; auto. apply bpow_gt_0. } - rewrite ln_beta_bpow in PREC. + rewrite ln_beta_bpow in PREC. assert (CANON: canonic_exp radix2 (FLT_exp emin' prec') x = canonic_exp radix2 (FIX_exp p) x). { unfold canonic_exp, FLT_exp, FIX_exp. replace (ln_beta radix2 x - prec') with p by (unfold prec'; omega). - apply Z.max_l. unfold emin', emin. red in prec_gt_0_; omega. + apply Z.max_l. unfold emin', emin. red in prec_gt_0_; omega. } assert (RND: round radix2 (FIX_exp p) Zrnd_odd x = round radix2 (FLT_exp emin' prec') Zrnd_odd x). { - unfold round, scaled_mantissa. rewrite CANON. auto. + unfold round, scaled_mantissa. rewrite CANON. auto. } - rewrite RND. - apply round_odd_flt. auto. - unfold prec'. red in prec_gt_0_; omega. + rewrite RND. + apply round_odd_flt. auto. + unfold prec'. red in prec_gt_0_; omega. unfold prec'. omega. unfold emin'. omega. Qed. @@ -552,7 +552,7 @@ Lemma Zrnd_odd_int: Zrnd_odd (Z2R n * bpow radix2 (-p)) * 2^p = int_round_odd n p. Proof. - intros. + intros. assert (0 < 2^p) by (apply (Zpower_gt_0 radix2); omega). assert (n = (n / 2^p) * 2^p + n mod 2^p) by (rewrite Zmult_comm; apply Z.div_mod; omega). assert (0 <= n mod 2^p < 2^p) by (apply Z_mod_lt; omega). @@ -562,16 +562,16 @@ Proof. assert (bpow radix2 p * bpow radix2 (-p) = 1)%R. { rewrite <- bpow_plus. replace (p + -p) with 0 by omega. auto. } assert (Z2R n * bpow radix2 (-p) = Z2R q + Z2R r * bpow radix2 (-p))%R. - { rewrite H1. rewrite Z2R_plus, Z2R_mult. + { rewrite H1. rewrite Z2R_plus, Z2R_mult. change (Z2R (2^p)) with (Z2R (radix2^p)). rewrite Z2R_Zpower by omega. ring_simplify. rewrite Rmult_assoc. rewrite H4. ring. } assert (0 <= Z2R r < bpow radix2 p)%R. - { split. change 0%R with (Z2R 0). apply Z2R_le; omega. + { split. change 0%R with (Z2R 0). apply Z2R_le; omega. rewrite <- Z2R_Zpower by omega. apply Z2R_lt; tauto. } assert (0 <= Z2R r * bpow radix2 (-p) < 1)%R. - { generalize (bpow_gt_0 radix2 (-p)). intros. - split. apply Rmult_le_pos; lra. + { generalize (bpow_gt_0 radix2 (-p)). intros. + split. apply Rmult_le_pos; lra. rewrite <- H4. apply Rmult_lt_compat_r. auto. tauto. } assert (Zfloor (Z2R n * bpow radix2 (-p)) = q). { apply Zfloor_imp. rewrite H5. rewrite Z2R_plus. change (Z2R 1) with 1%R. lra. } @@ -585,7 +585,7 @@ Proof. destruct (Z.eqb r 0) eqn:RZ. apply Z.eqb_eq in RZ. rewrite RZ in H9. change (Z2R 0) with 0%R in H9. rewrite Rmult_0_l in H9. congruence. - rewrite Zceil_floor_neq by lra. rewrite H8. + rewrite Zceil_floor_neq by lra. rewrite H8. change Zeven with Z.even. rewrite Zodd_even_bool. destruct (Z.even q); auto. Qed. @@ -593,12 +593,12 @@ Lemma int_round_odd_le: forall p x y, 0 <= p -> x <= y -> int_round_odd x p <= int_round_odd y p. Proof. - intros. + intros. assert (Zrnd_odd (Z2R x * bpow radix2 (-p)) <= Zrnd_odd (Z2R y * bpow radix2 (-p))). - { apply Zrnd_le. apply valid_rnd_odd. apply Rmult_le_compat_r. apply bpow_ge_0. + { apply Zrnd_le. apply valid_rnd_odd. apply Rmult_le_compat_r. apply bpow_ge_0. apply Z2R_le; auto. } - rewrite <- ! Zrnd_odd_int by auto. - apply Zmult_le_compat_r. auto. apply (Zpower_ge_0 radix2). + rewrite <- ! Zrnd_odd_int by auto. + apply Zmult_le_compat_r. auto. apply (Zpower_ge_0 radix2). Qed. Lemma int_round_odd_exact: @@ -607,7 +607,7 @@ Lemma int_round_odd_exact: Proof. intros. unfold int_round_odd. apply Znumtheory.Zdivide_mod in H0. rewrite H0. simpl. rewrite Zmult_comm. symmetry. apply Z_div_exact_2. - apply Zlt_gt. apply (Zpower_gt_0 radix2). auto. auto. + apply Zlt_gt. apply (Zpower_gt_0 radix2). auto. auto. Qed. Theorem BofZ_round_odd: @@ -621,16 +621,16 @@ Proof. intros x p PREC XRANGE PRANGE XGE. assert (DIV: (2^p | 2^emax - 2^(emax - prec))). { rewrite int_upper_bound_eq. apply Z.divide_mul_r. - exists (2^(emax - prec - p)). red in prec_gt_0_. + exists (2^(emax - prec - p)). red in prec_gt_0_. rewrite <- (Zpower_plus radix2) by omega. f_equal; omega. } assert (YRANGE: Z.abs (int_round_odd x p) <= 2^emax - 2^(emax-prec)). { apply Z.abs_le. split. replace (-(2^emax - 2^(emax-prec))) with (int_round_odd (-(2^emax - 2^(emax-prec))) p). apply int_round_odd_le; zify; omega. - apply int_round_odd_exact. omega. apply Z.divide_opp_r. auto. + apply int_round_odd_exact. omega. apply Z.divide_opp_r. auto. replace (2^emax - 2^(emax-prec)) with (int_round_odd (2^emax - 2^(emax-prec)) p). apply int_round_odd_le; zify; omega. - apply int_round_odd_exact. omega. auto. } + apply int_round_odd_exact. omega. auto. } destruct (BofZ_finite x XRANGE) as (X1 & X2 & X3). destruct (BofZ_finite (int_round_odd x p) YRANGE) as (Y1 & Y2 & Y3). apply BofZ_finite_equal; auto. @@ -641,8 +641,8 @@ Proof. rewrite <- Zrnd_odd_int by omega. unfold F2R; simpl. rewrite Z2R_mult. f_equal. apply (Z2R_Zpower radix2). omega. } - rewrite H. symmetry. apply round_odd_fix. auto. omega. - rewrite <- Z2R_Zpower. rewrite <- Z2R_abs. apply Z2R_le; auto. + rewrite H. symmetry. apply round_odd_fix. auto. omega. + rewrite <- Z2R_Zpower. rewrite <- Z2R_abs. apply Z2R_le; auto. red in prec_gt_0_; omega. Qed. @@ -653,13 +653,13 @@ Lemma int_round_odd_shifts: Proof. intros. unfold int_round_odd. rewrite Z.shiftl_mul_pow2 by auto. f_equal. - rewrite Z.shiftr_div_pow2 by auto. - destruct (x mod 2^p =? 0) eqn:E. auto. + rewrite Z.shiftr_div_pow2 by auto. + destruct (x mod 2^p =? 0) eqn:E. auto. assert (forall n, (if Z.odd n then n else n + 1) = Z.lor n 1). { destruct n; simpl; auto. - destruct p0; auto. + destruct p0; auto. destruct p0; auto. induction p0; auto. } - simpl. apply H0. + simpl. apply H0. Qed. Lemma int_round_odd_bits: @@ -669,20 +669,20 @@ Lemma int_round_odd_bits: (forall i, p < i -> Z.testbit y i = Z.testbit x i) -> int_round_odd x p = y. Proof. - intros until p; intros PPOS BELOW AT ABOVE. - rewrite int_round_odd_shifts by auto. - apply Z.bits_inj'. intros. + intros until p; intros PPOS BELOW AT ABOVE. + rewrite int_round_odd_shifts by auto. + apply Z.bits_inj'. intros. generalize (Zcompare_spec n p); intros SPEC; inversion SPEC. -- rewrite BELOW by auto. apply Z.shiftl_spec_low; auto. +- rewrite BELOW by auto. apply Z.shiftl_spec_low; auto. - subst n. rewrite AT. rewrite Z.shiftl_spec_high by omega. replace (p - p) with 0 by omega. destruct (x mod 2^p =? 0). - + rewrite Z.shiftr_spec by omega. f_equal; omega. - + rewrite Z.lor_spec. apply orb_true_r. + + rewrite Z.shiftr_spec by omega. f_equal; omega. + + rewrite Z.lor_spec. apply orb_true_r. - rewrite ABOVE by auto. rewrite Z.shiftl_spec_high by omega. destruct (x mod 2^p =? 0). rewrite Z.shiftr_spec by omega. f_equal; omega. - rewrite Z.lor_spec, Z.shiftr_spec by omega. + rewrite Z.lor_spec, Z.shiftr_spec by omega. change 1 with (Z.ones 1). rewrite Z.ones_spec_high by omega. rewrite orb_false_r. f_equal; omega. Qed. @@ -705,18 +705,18 @@ Theorem ZofB_correct: ZofB f = if is_finite _ _ f then Some (Ztrunc (B2R _ _ f)) else None. Proof. destruct f; simpl; auto. -- f_equal. symmetry. apply (Ztrunc_Z2R 0). -- destruct e; f_equal. +- f_equal. symmetry. apply (Ztrunc_Z2R 0). +- destruct e; f_equal. + unfold F2R; simpl. rewrite Rmult_1_r. rewrite Ztrunc_Z2R. auto. + unfold F2R; simpl. rewrite <- Z2R_mult. rewrite Ztrunc_Z2R. auto. - + unfold F2R; simpl. rewrite Z2R_cond_Zopp. rewrite <- cond_Ropp_mult_l. + + unfold F2R; simpl. rewrite Z2R_cond_Zopp. rewrite <- cond_Ropp_mult_l. assert (EQ: forall x, Ztrunc (cond_Ropp b x) = cond_Zopp b (Ztrunc x)). { intros. destruct b; simpl; auto. apply Ztrunc_opp. } - rewrite EQ. f_equal. + rewrite EQ. f_equal. generalize (Zpower_pos_gt_0 2 p (refl_equal _)); intros. - rewrite Ztrunc_floor. symmetry. apply Zfloor_div. omega. + rewrite Ztrunc_floor. symmetry. apply Zfloor_div. omega. apply Rmult_le_pos. apply (Z2R_le 0). compute; congruence. apply Rlt_le. apply Rinv_0_lt_compat. apply (Z2R_lt 0). auto. Qed. @@ -726,13 +726,13 @@ Qed. Remark Ztrunc_range_pos: forall x, 0 < Ztrunc x -> (Z2R (Ztrunc x) <= x < Z2R (Ztrunc x + 1)%Z)%R. Proof. - intros. + intros. rewrite Ztrunc_floor. split. apply Zfloor_lb. rewrite Z2R_plus. apply Zfloor_ub. generalize (Rle_bool_spec 0%R x). intros RLE; inversion RLE; subst; clear RLE. auto. rewrite Ztrunc_ceil in H by lra. unfold Zceil in H. assert (-x < 0)%R. - { apply Rlt_le_trans with (Z2R (Zfloor (-x)) + 1)%R. apply Zfloor_ub. + { apply Rlt_le_trans with (Z2R (Zfloor (-x)) + 1)%R. apply Zfloor_ub. change 0%R with (Z2R 0). change 1%R with (Z2R 1). rewrite <- Z2R_plus. apply Z2R_le. omega. } lra. @@ -742,14 +742,14 @@ Remark Ztrunc_range_zero: forall x, Ztrunc x = 0 -> (-1 < x < 1)%R. Proof. intros; generalize (Rle_bool_spec 0%R x). intros RLE; inversion RLE; subst; clear RLE. -- rewrite Ztrunc_floor in H by auto. split. - + apply Rlt_le_trans with 0%R; auto. rewrite <- Ropp_0. apply Ropp_lt_contravar. apply Rlt_0_1. - + replace 1%R with (Z2R (Zfloor x) + 1)%R. apply Zfloor_ub. rewrite H. simpl. apply Rplus_0_l. -- rewrite Ztrunc_ceil in H by (apply Rlt_le; auto). split. - + apply Ropp_lt_cancel. rewrite Ropp_involutive. - replace 1%R with (Z2R (Zfloor (-x)) + 1)%R. apply Zfloor_ub. - unfold Zceil in H. replace (Zfloor (-x)) with 0 by omega. simpl. apply Rplus_0_l. - + apply Rlt_le_trans with 0%R; auto. apply Rle_0_1. +- rewrite Ztrunc_floor in H by auto. split. + + apply Rlt_le_trans with 0%R; auto. rewrite <- Ropp_0. apply Ropp_lt_contravar. apply Rlt_0_1. + + replace 1%R with (Z2R (Zfloor x) + 1)%R. apply Zfloor_ub. rewrite H. simpl. apply Rplus_0_l. +- rewrite Ztrunc_ceil in H by (apply Rlt_le; auto). split. + + apply Ropp_lt_cancel. rewrite Ropp_involutive. + replace 1%R with (Z2R (Zfloor (-x)) + 1)%R. apply Zfloor_ub. + unfold Zceil in H. replace (Zfloor (-x)) with 0 by omega. simpl. apply Rplus_0_l. + + apply Rlt_le_trans with 0%R; auto. apply Rle_0_1. Qed. Theorem ZofB_range_pos: @@ -763,13 +763,13 @@ Theorem ZofB_range_neg: forall f n, ZofB f = Some n -> n < 0 -> (Z2R (n - 1)%Z < B2R _ _ f <= Z2R n)%R. Proof. intros. rewrite ZofB_correct in H. destruct (is_finite prec emax f) eqn:FIN; inversion H. - set (x := B2R prec emax f) in *. set (y := (-x)%R). + set (x := B2R prec emax f) in *. set (y := (-x)%R). assert (A: (Z2R (Ztrunc y) <= y < Z2R (Ztrunc y + 1)%Z)%R). { apply Ztrunc_range_pos. unfold y. rewrite Ztrunc_opp. omega. } - destruct A as [B C]. - unfold y in B, C. rewrite Ztrunc_opp in B, C. + destruct A as [B C]. + unfold y in B, C. rewrite Ztrunc_opp in B, C. replace (- Ztrunc x + 1) with (- (Ztrunc x - 1)) in C by omega. - rewrite Z2R_opp in B, C. lra. + rewrite Z2R_opp in B, C. lra. Qed. Theorem ZofB_range_zero: @@ -782,11 +782,11 @@ Qed. Theorem ZofB_range_nonneg: forall f n, ZofB f = Some n -> 0 <= n -> (-1 < B2R _ _ f < Z2R (n + 1)%Z)%R. Proof. - intros. destruct (Z.eq_dec n 0). -- subst n. apply ZofB_range_zero. auto. -- destruct (ZofB_range_pos f n) as (A & B). auto. omega. - split; auto. apply Rlt_le_trans with (Z2R 0). simpl; lra. - apply Rle_trans with (Z2R n); auto. apply Z2R_le; auto. + intros. destruct (Z.eq_dec n 0). +- subst n. apply ZofB_range_zero. auto. +- destruct (ZofB_range_pos f n) as (A & B). auto. omega. + split; auto. apply Rlt_le_trans with (Z2R 0). simpl; lra. + apply Rle_trans with (Z2R n); auto. apply Z2R_le; auto. Qed. (** For representable integers, [ZofB] is left inverse of [BofZ]. *) @@ -795,7 +795,7 @@ Theorem ZofBofZ_exact: forall n, integer_representable n -> ZofB (BofZ n) = Some n. Proof. intros. destruct (BofZ_representable n H) as (A & B & C). - rewrite ZofB_correct. rewrite A, B. f_equal. apply Ztrunc_Z2R. + rewrite ZofB_correct. rewrite A, B. f_equal. apply Ztrunc_Z2R. Qed. (** Compatibility with subtraction *) @@ -803,9 +803,9 @@ Qed. Remark Zfloor_minus: forall x n, Zfloor (x - Z2R n) = Zfloor x - n. Proof. - intros. apply Zfloor_imp. replace (Zfloor x - n + 1) with ((Zfloor x + 1) - n) by omega. - rewrite ! Z2R_minus. unfold Rminus. split. - apply Rplus_le_compat_r. apply Zfloor_lb. + intros. apply Zfloor_imp. replace (Zfloor x - n + 1) with ((Zfloor x + 1) - n) by omega. + rewrite ! Z2R_minus. unfold Rminus. split. + apply Rplus_le_compat_r. apply Zfloor_lb. apply Rplus_lt_compat_r. rewrite Z2R_plus. apply Zfloor_ub. Qed. @@ -815,25 +815,25 @@ Theorem ZofB_minus: ZofB (Bminus _ _ _ Hmax minus_nan m f (BofZ q)) = Some (p - q). Proof. intros. - assert (Q: -2^prec <= q <= 2^prec). + assert (Q: -2^prec <= q <= 2^prec). { split; auto. generalize (Zpower_ge_0 radix2 prec); simpl; omega. } - assert (RANGE: (-1 < B2R _ _ f < Z2R (p + 1)%Z)%R) by (apply ZofB_range_nonneg; auto; omega). + assert (RANGE: (-1 < B2R _ _ f < Z2R (p + 1)%Z)%R) by (apply ZofB_range_nonneg; auto; omega). rewrite ZofB_correct in H. destruct (is_finite prec emax f) eqn:FIN; try discriminate. - assert (PQ2: (Z2R (p + 1) <= Z2R q * 2)%R). + assert (PQ2: (Z2R (p + 1) <= Z2R q * 2)%R). { change 2%R with (Z2R 2). rewrite <- Z2R_mult. apply Z2R_le. omega. } assert (EXACT: round radix2 fexp (round_mode m) (B2R _ _ f - Z2R q)%R = (B2R _ _ f - Z2R q)%R). - { apply round_generic. apply valid_rnd_round_mode. - apply sterbenz_aux. apply FLT_exp_monotone. apply generic_format_B2R. + { apply round_generic. apply valid_rnd_round_mode. + apply sterbenz_aux. apply FLT_exp_monotone. apply generic_format_B2R. apply integer_representable_n. auto. lra. } - destruct (BofZ_exact q Q) as (A & B & C). + destruct (BofZ_exact q Q) as (A & B & C). generalize (Bminus_correct _ _ _ Hmax minus_nan m f (BofZ q) FIN B). rewrite Rlt_bool_true. - fold emin; fold fexp. intros (D & E & F). - rewrite ZofB_correct. rewrite E. rewrite D. rewrite A. rewrite EXACT. + rewrite ZofB_correct. rewrite E. rewrite D. rewrite A. rewrite EXACT. inversion H. f_equal. rewrite ! Ztrunc_floor. apply Zfloor_minus. - lra. lra. + lra. lra. - rewrite A. fold emin; fold fexp. rewrite EXACT. - apply Rle_lt_trans with (bpow radix2 prec). + apply Rle_lt_trans with (bpow radix2 prec). apply Rle_trans with (Z2R q). apply Rabs_le. lra. rewrite <- Z2R_Zpower. apply Z2R_le; auto. red in prec_gt_0_; omega. apply bpow_lt. auto. @@ -853,8 +853,8 @@ Theorem ZofB_range_correct: ZofB_range f min max = if is_finite _ _ f && Zle_bool min n && Zle_bool n max then Some n else None. Proof. - intros. unfold ZofB_range. rewrite ZofB_correct. fold n. - destruct (is_finite prec emax f); auto. + intros. unfold ZofB_range. rewrite ZofB_correct. fold n. + destruct (is_finite prec emax f); auto. Qed. Lemma ZofB_range_inversion: @@ -862,13 +862,13 @@ Lemma ZofB_range_inversion: ZofB_range f min max = Some n -> min <= n /\ n <= max /\ ZofB f = Some n. Proof. - intros. rewrite ZofB_range_correct in H. rewrite ZofB_correct. - destruct (is_finite prec emax f); try discriminate. + intros. rewrite ZofB_range_correct in H. rewrite ZofB_correct. + destruct (is_finite prec emax f); try discriminate. set (n1 := Ztrunc (B2R _ _ f)) in *. destruct (min <=? n1) eqn:MIN; try discriminate. destruct (n1 <=? max) eqn:MAX; try discriminate. - simpl in H. inversion H. subst n. - split. apply Zle_bool_imp_le; auto. + simpl in H. inversion H. subst n. + split. apply Zle_bool_imp_le; auto. split. apply Zle_bool_imp_le; auto. auto. Qed. @@ -894,16 +894,16 @@ Theorem Bplus_commut: plus_nan x y = plus_nan y x -> Bplus _ _ _ Hmax plus_nan mode x y = Bplus _ _ _ Hmax plus_nan mode y x. Proof. - intros until y; intros NAN. - pose proof (Bplus_correct _ _ _ Hmax plus_nan mode x y). + intros until y; intros NAN. + pose proof (Bplus_correct _ _ _ Hmax plus_nan mode x y). pose proof (Bplus_correct _ _ _ Hmax plus_nan mode y x). unfold Bplus in *; destruct x; destruct y; auto. -- rewrite (eqb_sym b0 b). destruct (eqb b b0) eqn:EQB; auto. +- rewrite (eqb_sym b0 b). destruct (eqb b b0) eqn:EQB; auto. f_equal; apply eqb_prop; auto. - rewrite NAN; auto. -- rewrite (eqb_sym b0 b). destruct (eqb b b0) eqn:EQB. +- rewrite (eqb_sym b0 b). destruct (eqb b b0) eqn:EQB. f_equal; apply eqb_prop; auto. - rewrite NAN; auto. + rewrite NAN; auto. - rewrite NAN; auto. - rewrite NAN; auto. - rewrite NAN; auto. @@ -912,14 +912,14 @@ Proof. - rewrite NAN; auto. - generalize (H (refl_equal _) (refl_equal _)); clear H. generalize (H0 (refl_equal _) (refl_equal _)); clear H0. - fold emin. fold fexp. - set (x := B754_finite prec emax b0 m0 e1 e2). set (rx := B2R _ _ x). + fold emin. fold fexp. + set (x := B754_finite prec emax b0 m0 e1 e2). set (rx := B2R _ _ x). set (y := B754_finite prec emax b m e e0). set (ry := B2R _ _ y). rewrite (Rplus_comm ry rx). destruct Rlt_bool. + intros (A1 & A2 & A3) (B1 & B2 & B3). - apply B2R_Bsign_inj; auto. rewrite <- B1 in A1. auto. + apply B2R_Bsign_inj; auto. rewrite <- B1 in A1. auto. rewrite Z.add_comm. rewrite Z.min_comm. auto. - + intros (A1 & A2) (B1 & B2). apply B2FF_inj. rewrite B2 in B1. rewrite <- B1 in A1. auto. + + intros (A1 & A2) (B1 & B2). apply B2FF_inj. rewrite B2 in B1. rewrite <- B1 in A1. auto. Qed. Theorem Bmult_commut: @@ -927,8 +927,8 @@ Theorem Bmult_commut: mult_nan x y = mult_nan y x -> Bmult _ _ _ Hmax mult_nan mode x y = Bmult _ _ _ Hmax mult_nan mode y x. Proof. - intros until y; intros NAN. - pose proof (Bmult_correct _ _ _ Hmax mult_nan mode x y). + intros until y; intros NAN. + pose proof (Bmult_correct _ _ _ Hmax mult_nan mode x y). pose proof (Bmult_correct _ _ _ Hmax mult_nan mode y x). unfold Bmult in *; destruct x; destruct y; auto. - rewrite (xorb_comm b0 b); auto. @@ -946,14 +946,14 @@ Proof. - rewrite (xorb_comm b0 b); auto. - rewrite (xorb_comm b0 b); auto. - rewrite NAN; auto. -- revert H H0. fold emin. fold fexp. - set (x := B754_finite prec emax b0 m0 e1 e2). set (rx := B2R _ _ x). +- revert H H0. fold emin. fold fexp. + set (x := B754_finite prec emax b0 m0 e1 e2). set (rx := B2R _ _ x). set (y := B754_finite prec emax b m e e0). set (ry := B2R _ _ y). rewrite (Rmult_comm ry rx). destruct Rlt_bool. + intros (A1 & A2 & A3) (B1 & B2 & B3). - apply B2R_Bsign_inj; auto. rewrite <- B1 in A1. auto. + apply B2R_Bsign_inj; auto. rewrite <- B1 in A1. auto. rewrite ! Bsign_FF2B. f_equal. f_equal. apply xorb_comm. apply Pos.mul_comm. apply Z.add_comm. - + intros A B. apply B2FF_inj. etransitivity. eapply A. rewrite xorb_comm. auto. + + intros A B. apply B2FF_inj. etransitivity. eapply A. rewrite xorb_comm. auto. Qed. (** Multiplication by 2 is diagonal addition. *) @@ -966,31 +966,31 @@ Theorem Bmult2_Bplus: Proof. intros until f; intros NAN. destruct (BofZ_representable 2) as (A & B & C). - apply (integer_representable_2p 1). red in prec_gt_0_; omega. + apply (integer_representable_2p 1). red in prec_gt_0_; omega. pose proof (Bmult_correct _ _ _ Hmax mult_nan mode f (BofZ 2%Z)). fold emin in H. - rewrite A, B, C in H. rewrite xorb_false_r in H. + rewrite A, B, C in H. rewrite xorb_false_r in H. destruct (is_finite _ _ f) eqn:FIN. -- pose proof (Bplus_correct _ _ _ Hmax plus_nan mode f f FIN FIN). fold emin in H0. +- pose proof (Bplus_correct _ _ _ Hmax plus_nan mode f f FIN FIN). fold emin in H0. assert (EQ: (B2R prec emax f * Z2R 2%Z = B2R prec emax f + B2R prec emax f)%R). { change (Z2R 2%Z) with 2%R. ring. } - rewrite <- EQ in H0. destruct Rlt_bool. - + destruct H0 as (P & Q & R). destruct H as (S & T & U). + rewrite <- EQ in H0. destruct Rlt_bool. + + destruct H0 as (P & Q & R). destruct H as (S & T & U). apply B2R_Bsign_inj; auto. rewrite P, S. auto. - rewrite R, U. - replace 0%R with (0 * Z2R 2%Z)%R by ring. rewrite Rcompare_mult_r. - rewrite andb_diag, orb_diag. destruct f; try discriminate; simpl. - rewrite Rcompare_Eq by auto. destruct mode; auto. + rewrite R, U. + replace 0%R with (0 * Z2R 2%Z)%R by ring. rewrite Rcompare_mult_r. + rewrite andb_diag, orb_diag. destruct f; try discriminate; simpl. + rewrite Rcompare_Eq by auto. destruct mode; auto. replace 0%R with (@F2R radix2 {| Fnum := 0%Z; Fexp := e |}). - rewrite Rcompare_F2R. destruct b; auto. - unfold F2R. simpl. ring. - change 0%R with (Z2R 0%Z). apply Z2R_lt. omega. + rewrite Rcompare_F2R. destruct b; auto. + unfold F2R. simpl. ring. + change 0%R with (Z2R 0%Z). apply Z2R_lt. omega. destruct (Bmult prec emax prec_gt_0_ Hmax mult_nan mode f (BofZ 2)); reflexivity || discriminate. + destruct H0 as (P & Q). apply B2FF_inj. rewrite P, H. auto. - destruct f; try discriminate. + simpl Bplus. rewrite eqb_true. destruct (BofZ 2) eqn:B2; try discriminate; simpl in *. assert ((0 = 2)%Z) by (apply eq_Z2R; auto). discriminate. - subst b0. rewrite xorb_false_r. auto. + subst b0. rewrite xorb_false_r. auto. auto. + unfold Bplus, Bmult. rewrite <- NAN by auto. auto. Qed. @@ -1003,9 +1003,9 @@ Remark Bexact_inverse_mantissa_value: Zpos Bexact_inverse_mantissa = 2 ^ (prec - 1). Proof. assert (REC: forall n, Z.pos (nat_iter n xO xH) = 2 ^ (Z.of_nat n)). - { induction n. reflexivity. - simpl nat_iter. transitivity (2 * Z.pos (nat_iter n xO xH)). reflexivity. - rewrite inj_S. rewrite IHn. unfold Z.succ. rewrite Zpower_plus by omega. + { induction n. reflexivity. + simpl nat_iter. transitivity (2 * Z.pos (nat_iter n xO xH)). reflexivity. + rewrite inj_S. rewrite IHn. unfold Z.succ. rewrite Zpower_plus by omega. change (2 ^ 1) with 2. ring. } red in prec_gt_0_. unfold Bexact_inverse_mantissa. rewrite iter_nat_of_Z by omega. rewrite REC. @@ -1029,10 +1029,10 @@ Remark bounded_Bexact_inverse: forall e, emin <= e <= emax - prec <-> bounded prec emax Bexact_inverse_mantissa e = true. Proof. - intros. unfold bounded, canonic_mantissa. rewrite andb_true_iff. - rewrite <- Zeq_is_eq_bool. rewrite <- Zle_is_le_bool. - rewrite Bexact_inverse_mantissa_digits2_pos. - split. + intros. unfold bounded, canonic_mantissa. rewrite andb_true_iff. + rewrite <- Zeq_is_eq_bool. rewrite <- Zle_is_le_bool. + rewrite Bexact_inverse_mantissa_digits2_pos. + split. - intros; split. unfold FLT_exp. unfold emin in H. zify; omega. omega. - intros [A B]. unfold FLT_exp in A. unfold emin. zify; omega. Qed. @@ -1049,7 +1049,7 @@ Program Definition Bexact_inverse (f: binary_float) : option binary_float := | _ => None end. Next Obligation. - rewrite <- bounded_Bexact_inverse in B. rewrite <- bounded_Bexact_inverse. + rewrite <- bounded_Bexact_inverse in B. rewrite <- bounded_Bexact_inverse. unfold emin in *. omega. Qed. @@ -1070,12 +1070,12 @@ Proof with (try discriminate). split. auto. split. auto. split. unfold B2R. rewrite Bexact_inverse_mantissa_value. unfold F2R; simpl. rewrite Z2R_cond_Zopp. rewrite <- ! cond_Ropp_mult_l. - red in prec_gt_0_. + red in prec_gt_0_. replace (Z2R (2 ^ (prec - 1))) with (bpow radix2 (prec - 1)) by (symmetry; apply (Z2R_Zpower radix2); omega). rewrite <- ! bpow_plus. - replace (prec - 1 + e') with (- (prec - 1 + e)) by (unfold e'; omega). - rewrite bpow_opp. unfold cond_Ropp; destruct b; auto. + replace (prec - 1 + e') with (- (prec - 1 + e)) by (unfold e'; omega). + rewrite bpow_opp. unfold cond_Ropp; destruct b; auto. rewrite Ropp_inv_permute. auto. apply Rgt_not_eq. apply bpow_gt_0. split. simpl. red; intros. apply F2R_eq_0_reg in H. destruct b; simpl in H; discriminate. auto. @@ -1091,23 +1091,23 @@ Theorem Bdiv_mult_inverse: Proof. intros until z; intros NAN; intros. destruct (Bexact_inverse_correct _ _ H) as (A & B & C & D & E). pose proof (Bmult_correct _ _ _ Hmax mult_nan mode x z). - fold emin in H0. fold fexp in H0. + fold emin in H0. fold fexp in H0. pose proof (Bdiv_correct _ _ _ Hmax div_nan mode x y D). fold emin in H1. fold fexp in H1. - unfold Rdiv in H1. rewrite <- C in H1. + unfold Rdiv in H1. rewrite <- C in H1. destruct (is_finite _ _ x) eqn:FINX. -- destruct Rlt_bool. - + destruct H0 as (P & Q & R). destruct H1 as (S & T & U). +- destruct Rlt_bool. + + destruct H0 as (P & Q & R). destruct H1 as (S & T & U). apply B2R_Bsign_inj; auto. - rewrite Q. simpl. apply is_finite_strict_finite; auto. - rewrite P, S. auto. - rewrite R, U, E. auto. - apply is_finite_not_is_nan; auto. - apply is_finite_not_is_nan. rewrite Q. simpl. apply is_finite_strict_finite; auto. + apply B2FF_inj. rewrite H0, H1. rewrite E. auto. + rewrite Q. simpl. apply is_finite_strict_finite; auto. + rewrite P, S. auto. + rewrite R, U, E. auto. + apply is_finite_not_is_nan; auto. + apply is_finite_not_is_nan. rewrite Q. simpl. apply is_finite_strict_finite; auto. + apply B2FF_inj. rewrite H0, H1. rewrite E. auto. - destruct y; try discriminate. destruct z; try discriminate. destruct x; try discriminate; simpl. + simpl in E; congruence. - + erewrite NAN; eauto. + + erewrite NAN; eauto. Qed. (** ** Conversion from scientific notation *) @@ -1126,13 +1126,13 @@ Lemma pos_pow_spec: Proof. intros x. assert (REC: forall y a, Pos.iter y (Pos.mul x) a = Pos.mul (pos_pow x y) a). - { induction y; simpl; intros. + { induction y; simpl; intros. - rewrite ! IHy, Pos.square_spec, ! Pos.mul_assoc. auto. - rewrite ! IHy, Pos.square_spec, ! Pos.mul_assoc. auto. - auto. } intros. simpl. rewrite <- Pos2Z.inj_pow_pos. unfold Pos.pow. rewrite REC. rewrite Pos.mul_1_r. auto. -Qed. +Qed. (** Given a base [base], a mantissa [m] and an exponent [e], the following function computes the FP number closest to [m * base ^ e], using round to odd, ties break to even. @@ -1142,7 +1142,7 @@ Qed. Definition Bparse (base: positive) (m: positive) (e: Z): binary_float := match e with - | Z0 => + | Z0 => BofZ (Zpos m) | Zpos p => if e * Z.log2 (Zpos base) <? emax @@ -1167,7 +1167,7 @@ Proof. assert (B: 0 <= Z.log2 base) by apply Z.log2_nonneg. assert (C: 0 <= Z.log2_up base) by apply Z.log2_up_nonneg. destruct (Z.log2_spec base) as [D E]; auto. - destruct (Z.log2_up_spec base) as [F G]. apply radix_gt_1. + destruct (Z.log2_up_spec base) as [F G]. apply radix_gt_1. assert (K: 0 <= 2 ^ Z.log2 base) by (apply Z.pow_nonneg; omega). rewrite ! (Zmult_comm n). rewrite ! Z.pow_mul_r by omega. split; apply Z.pow_le_mono_l; omega. @@ -1189,7 +1189,7 @@ Lemma bpow_log_neg: (bpow base n <= bpow radix2 (n * Z.log2 base)%Z)%R. Proof. intros. set (m := -n). replace n with (-m) by (unfold m; omega). - rewrite ! Z.mul_opp_l, ! bpow_opp. apply Rinv_le. + rewrite ! Z.mul_opp_l, ! bpow_opp. apply Rinv_le. apply bpow_gt_0. apply bpow_log_pos. unfold m; omega. Qed. @@ -1202,9 +1202,9 @@ Lemma round_integer_overflow: emax <= e * Z.log2 base -> (bpow radix2 emax <= round radix2 fexp (round_mode mode_NE) (Z2R (Zpos m) * bpow base e))%R. Proof. - intros. + intros. rewrite <- (round_generic radix2 fexp (round_mode mode_NE) (bpow radix2 emax)); auto. - apply round_le; auto. apply fexp_correct; auto. apply valid_rnd_round_mode. + apply round_le; auto. apply fexp_correct; auto. apply valid_rnd_round_mode. rewrite <- (Rmult_1_l (bpow radix2 emax)). apply Rmult_le_compat. apply Rle_0_1. apply bpow_ge_0. @@ -1224,24 +1224,24 @@ Proof. intros. set (eps := bpow radix2 (emin - 1)) in *. assert (A: round radix2 fexp (round_mode mode_NE) eps = 0%R). - { unfold round. simpl. + { unfold round. simpl. assert (E: canonic_exp radix2 fexp eps = emin). { unfold canonic_exp, eps. rewrite ln_beta_bpow. unfold fexp, FLT_exp. zify; red in prec_gt_0_; omega. } - unfold scaled_mantissa; rewrite E. + unfold scaled_mantissa; rewrite E. assert (P: (eps * bpow radix2 (-emin) = / 2)%R). { unfold eps. rewrite <- bpow_plus. replace (emin - 1 + -emin) with (-1) by omega. auto. } - rewrite P. unfold Znearest. + rewrite P. unfold Znearest. assert (F: Zfloor (/ 2)%R = 0). - { apply Zfloor_imp. + { apply Zfloor_imp. split. apply Rlt_le. apply Rinv_0_lt_compat. apply (Z2R_lt 0 2). omega. change (Z2R (0 + 1)) with 1%R. rewrite <- Rinv_1 at 3. apply Rinv_1_lt_contravar. apply Rle_refl. apply (Z2R_lt 1 2). omega. } - rewrite F. change (Z2R 0) with 0%R. rewrite Rminus_0_r. rewrite Rcompare_Eq by auto. - simpl. unfold F2R; simpl. apply Rmult_0_l. + rewrite F. change (Z2R 0) with 0%R. rewrite Rminus_0_r. rewrite Rcompare_Eq by auto. + simpl. unfold F2R; simpl. apply Rmult_0_l. } apply Rle_antisym. - rewrite <- A. apply round_le. apply fexp_correct; auto. apply valid_rnd_round_mode. tauto. -- rewrite <- (round_0 radix2 fexp (round_mode mode_NE)). +- rewrite <- (round_0 radix2 fexp (round_mode mode_NE)). apply round_le. apply fexp_correct; auto. apply valid_rnd_round_mode. tauto. Qed. @@ -1254,16 +1254,16 @@ Proof. intros. apply round_NE_underflows. split. - apply Rmult_le_pos. apply (Z2R_le 0). zify; omega. apply bpow_ge_0. - apply Rle_trans with (bpow radix2 (Z.log2_up (Z.pos m) + e * Z.log2 base)). -+ rewrite bpow_plus. apply Rmult_le_compat. ++ rewrite bpow_plus. apply Rmult_le_compat. apply (Z2R_le 0); zify; omega. apply bpow_ge_0. rewrite <- Z2R_Zpower. apply Z2R_le. - destruct (Z.eq_dec (Z.pos m) 1). + destruct (Z.eq_dec (Z.pos m) 1). rewrite e0. simpl. omega. apply Z.log2_up_spec. zify; omega. - apply Z.log2_up_nonneg. + apply Z.log2_up_nonneg. apply bpow_log_neg. auto. -+ apply bpow_le. omega. ++ apply bpow_le. omega. Qed. (** Correctness of Bparse *) @@ -1279,29 +1279,29 @@ Theorem Bparse_correct: else B2FF _ _ (Bparse b m e) = F754_infinity false. Proof. - intros. + intros. assert (A: forall x, @F2R radix2 {| Fnum := x; Fexp := 0 |} = Z2R x). { intros. unfold F2R, Fnum; simpl. ring. } unfold Bparse, r. destruct e as [ | e | e]. - (* e = Z0 *) - change (bpow base 0) with 1%R. rewrite Rmult_1_r. + change (bpow base 0) with 1%R. rewrite Rmult_1_r. exact (BofZ_correct (Z.pos m)). - (* e = Zpos e *) destruct (Z.ltb_spec (Z.pos e * Z.log2 (Z.pos b)) emax). + (* no overflow *) rewrite pos_pow_spec. rewrite <- Z2R_Zpower by (zify; omega). rewrite <- Z2R_mult. - replace false with (Z.pos m * Z.pos b ^ Z.pos e <? 0). + replace false with (Z.pos m * Z.pos b ^ Z.pos e <? 0). exact (BofZ_correct (Z.pos m * Z.pos b ^ Z.pos e)). - rewrite Z.ltb_ge. rewrite Zmult_comm. apply Zmult_gt_0_le_0_compat. zify; omega. apply (Zpower_ge_0 base). + rewrite Z.ltb_ge. rewrite Zmult_comm. apply Zmult_gt_0_le_0_compat. zify; omega. apply (Zpower_ge_0 base). + (* overflow *) - rewrite Rlt_bool_false. auto. eapply Rle_trans; [idtac|apply Rle_abs]. - apply (round_integer_overflow base). zify; omega. auto. + rewrite Rlt_bool_false. auto. eapply Rle_trans; [idtac|apply Rle_abs]. + apply (round_integer_overflow base). zify; omega. auto. - (* e = Zneg e *) destruct (Z.ltb_spec (Z.neg e * Z.log2 (Z.pos b) + Z.log2_up (Z.pos m)) emin). + (* undeflow *) rewrite round_integer_underflow; auto. - rewrite Rlt_bool_true. auto. - replace (Rabs 0)%R with 0%R. apply bpow_gt_0. apply (Z2R_abs 0). + rewrite Rlt_bool_true. auto. + replace (Rabs 0)%R with 0%R. apply bpow_gt_0. apply (Z2R_abs 0). zify; omega. + (* no underflow *) generalize (Bdiv_correct_aux prec emax prec_gt_0_ Hmax mode_NE false m 0 false (pos_pow b e) 0). @@ -1311,19 +1311,19 @@ Proof. binary_round_aux prec emax mode_NE (xorb false false) mz0 ez lz | (Z.neg _, _, _) => F754_nan false 1 end). - fold emin; fold fexp. rewrite ! A. unfold cond_Zopp. rewrite pos_pow_spec. + fold emin; fold fexp. rewrite ! A. unfold cond_Zopp. rewrite pos_pow_spec. assert (B: (Z2R (Z.pos m) / Z2R (Z.pos b ^ Z.pos e) = Z2R (Z.pos m) * bpow base (Z.neg e))%R). { change (Z.neg e) with (- (Z.pos e)). rewrite bpow_opp. auto. } - rewrite B. intros [P Q]. + rewrite B. intros [P Q]. destruct (Rlt_bool (Rabs (round radix2 fexp (round_mode mode_NE) (Z2R (Z.pos m) * bpow base (Z.neg e)))) (bpow radix2 emax)). -* destruct Q as (Q1 & Q2 & Q3). +* destruct Q as (Q1 & Q2 & Q3). split. rewrite B2R_FF2B, Q1. auto. - split. rewrite is_finite_FF2B. auto. + split. rewrite is_finite_FF2B. auto. rewrite Bsign_FF2B. auto. * rewrite B2FF_FF2B. auto. Qed. @@ -1365,16 +1365,16 @@ Theorem Bconv_correct: B2FF _ _ (Bconv conv_nan m f) = binary_overflow prec2 emax2 m (Bsign _ _ f). Proof. intros. destruct f; try discriminate. -- simpl. rewrite round_0. rewrite Rabs_R0. rewrite Rlt_bool_true. auto. - apply bpow_gt_0. apply valid_rnd_round_mode. +- simpl. rewrite round_0. rewrite Rabs_R0. rewrite Rlt_bool_true. auto. + apply bpow_gt_0. apply valid_rnd_round_mode. - generalize (binary_normalize_correct _ _ _ Hmax2 m (cond_Zopp b (Zpos m0)) e b). - fold emin2; fold fexp2. simpl. destruct Rlt_bool. - + intros (A & B & C). split. auto. split. auto. rewrite C. - destruct b; simpl. - rewrite Rcompare_Lt. auto. apply F2R_lt_0_compat. simpl. compute; auto. + fold emin2; fold fexp2. simpl. destruct Rlt_bool. + + intros (A & B & C). split. auto. split. auto. rewrite C. + destruct b; simpl. + rewrite Rcompare_Lt. auto. apply F2R_lt_0_compat. simpl. compute; auto. rewrite Rcompare_Gt. auto. apply F2R_gt_0_compat. simpl. compute; auto. + intros A. rewrite A. f_equal. destruct b. - apply Rlt_bool_true. apply F2R_lt_0_compat. simpl. compute; auto. + apply Rlt_bool_true. apply F2R_lt_0_compat. simpl. compute; auto. apply Rlt_bool_false. apply Rlt_le. apply Rgt_lt. apply F2R_gt_0_compat. simpl. compute; auto. Qed. @@ -1391,8 +1391,8 @@ Proof. intros PREC EMAX; intros. generalize (Bconv_correct conv_nan m f H). assert (LT: (Rabs (B2R _ _ f) < bpow radix2 emax2)%R). { - destruct f; try discriminate; simpl. - rewrite Rabs_R0. apply bpow_gt_0. + destruct f; try discriminate; simpl. + rewrite Rabs_R0. apply bpow_gt_0. apply Rlt_le_trans with (bpow radix2 emax1). rewrite F2R_cond_Zopp. rewrite abs_cond_Ropp. rewrite <- F2R_Zabs. simpl Z.abs. eapply bounded_lt_emax; eauto. @@ -1401,11 +1401,11 @@ Proof. assert (EQ: round radix2 fexp2 (round_mode m) (B2R prec1 emax1 f) = B2R prec1 emax1 f). { apply round_generic. apply valid_rnd_round_mode. eapply generic_inclusion_le. - 5: apply generic_format_B2R. apply fexp_correct; auto. apply fexp_correct; auto. + 5: apply generic_format_B2R. apply fexp_correct; auto. apply fexp_correct; auto. instantiate (1 := emax2). intros. unfold fexp2, FLT_exp. unfold emin2. zify; omega. apply Rlt_le; auto. } - rewrite EQ. rewrite Rlt_bool_true by auto. auto. + rewrite EQ. rewrite Rlt_bool_true by auto. auto. Qed. (** Conversion from integers and change of format *) @@ -1415,18 +1415,18 @@ Theorem Bconv_BofZ: integer_representable prec1 emax1 n -> Bconv conv_nan mode_NE (BofZ prec1 emax1 _ Hmax1 n) = BofZ prec2 emax2 _ Hmax2 n. Proof. - intros. - destruct (BofZ_representable _ _ _ Hmax1 n H) as (A & B & C). + intros. + destruct (BofZ_representable _ _ _ Hmax1 n H) as (A & B & C). set (f := BofZ prec1 emax1 prec1_gt_0_ Hmax1 n) in *. generalize (Bconv_correct conv_nan mode_NE f B). - unfold BofZ. - generalize (binary_normalize_correct _ _ _ Hmax2 mode_NE n 0 false). - fold emin2; fold fexp2. rewrite A. + unfold BofZ. + generalize (binary_normalize_correct _ _ _ Hmax2 mode_NE n 0 false). + fold emin2; fold fexp2. rewrite A. replace (F2R {| Fnum := n; Fexp := 0 |}) with (Z2R n). - destruct Rlt_bool. -- intros (P & Q & R) (D & E & F). apply B2R_Bsign_inj; auto. - congruence. rewrite F, C, R. change 0%R with (Z2R 0). rewrite Rcompare_Z2R. - unfold Zlt_bool. auto. + destruct Rlt_bool. +- intros (P & Q & R) (D & E & F). apply B2R_Bsign_inj; auto. + congruence. rewrite F, C, R. change 0%R with (Z2R 0). rewrite Rcompare_Z2R. + unfold Zlt_bool. auto. - intros P Q. apply B2FF_inj. rewrite P, Q. rewrite C. f_equal. change 0%R with (Z2R 0). generalize (Zlt_bool_spec n 0); intros LT; inversion LT. rewrite Rlt_bool_true; auto. apply Z2R_lt; auto. @@ -1442,7 +1442,7 @@ Theorem ZofB_Bconv: ZofB _ _ f = Some n -> ZofB _ _ (Bconv conv_nan m f) = Some n. Proof. intros. rewrite ZofB_correct in H1. destruct (is_finite _ _ f) eqn:FIN; inversion H1. - destruct (Bconv_widen_exact H H0 conv_nan m f) as (A & B & C). auto. + destruct (Bconv_widen_exact H H0 conv_nan m f) as (A & B & C). auto. rewrite ZofB_correct. rewrite B. rewrite A. auto. Qed. @@ -1453,9 +1453,9 @@ Theorem ZofB_range_Bconv: ZofB_range _ _ f min1 max1 = Some n -> ZofB_range _ _ (Bconv conv_nan m f) min2 max2 = Some n. Proof. - intros. + intros. destruct (ZofB_range_inversion _ _ _ _ _ _ H3) as (A & B & C). - unfold ZofB_range. erewrite ZofB_Bconv by eauto. + unfold ZofB_range. erewrite ZofB_Bconv by eauto. rewrite ! Zle_bool_true by omega. auto. Qed. @@ -1467,7 +1467,7 @@ Theorem Bcompare_Bconv_widen: Bcompare _ _ (Bconv conv_nan m x) (Bconv conv_nan m y) = Bcompare _ _ x y. Proof. intros. destruct (is_finite _ _ x && is_finite _ _ y) eqn:FIN. -- apply andb_true_iff in FIN. destruct FIN. +- apply andb_true_iff in FIN. destruct FIN. destruct (Bconv_widen_exact H H0 conv_nan m x H1) as (A & B & C). destruct (Bconv_widen_exact H H0 conv_nan m y H2) as (D & E & F). rewrite ! Bcompare_correct by auto. rewrite A, D. auto. @@ -1476,13 +1476,13 @@ Proof. destruct x, y; try discriminate; simpl in P, Q; simpl; repeat (match goal with |- context [conv_nan ?b ?pl] => destruct (conv_nan b pl) end); auto. - destruct Q as (D & E & F); auto. + destruct Q as (D & E & F); auto. destruct (binary_normalize prec2 emax2 prec2_gt_0_ Hmax2 m (cond_Zopp b0 (Z.pos m0)) e b0); discriminate || reflexivity. - destruct P as (A & B & C); auto. + destruct P as (A & B & C); auto. destruct (binary_normalize prec2 emax2 prec2_gt_0_ Hmax2 m (cond_Zopp b (Z.pos m0)) e b); - try discriminate; simpl. destruct b; auto. destruct b, b1; auto. - destruct P as (A & B & C); auto. + try discriminate; simpl. destruct b; auto. destruct b, b1; auto. + destruct P as (A & B & C); auto. destruct (binary_normalize prec2 emax2 prec2_gt_0_ Hmax2 m (cond_Zopp b (Z.pos m0)) e b); try discriminate; simpl. destruct b; auto. destruct b, b2; auto. @@ -1503,26 +1503,26 @@ Hypothesis Hmax2 : (prec2 < emax2)%Z. Let binary_float1 := binary_float prec1 emax1. Let binary_float2 := binary_float prec2 emax2. -(** Converting to a higher precision then down to the original format +(** Converting to a higher precision then down to the original format is the identity. *) Theorem Bconv_narrow_widen: prec2 >= prec1 -> emax2 >= emax1 -> - forall narrow_nan widen_nan m f, + forall narrow_nan widen_nan m f, is_nan _ _ f = false -> Bconv prec2 emax2 prec1 emax1 _ Hmax1 narrow_nan m (Bconv prec1 emax1 prec2 emax2 _ Hmax2 widen_nan m f) = f. Proof. - intros. destruct (is_finite _ _ f) eqn:FIN. + intros. destruct (is_finite _ _ f) eqn:FIN. - assert (EQ: round radix2 fexp1 (round_mode m) (B2R prec1 emax1 f) = B2R prec1 emax1 f). { apply round_generic. apply valid_rnd_round_mode. apply generic_format_B2R. } generalize (Bconv_widen_exact _ _ _ _ _ _ Hmax2 H H0 widen_nan m f FIN). - set (f' := Bconv prec1 emax1 prec2 emax2 _ Hmax2 widen_nan m f). + set (f' := Bconv prec1 emax1 prec2 emax2 _ Hmax2 widen_nan m f). intros (A & B & C). generalize (Bconv_correct _ _ _ _ _ Hmax1 narrow_nan m f' B). - fold emin1. fold fexp1. rewrite A, C, EQ. rewrite Rlt_bool_true. - intros (D & E & F). + fold emin1. fold fexp1. rewrite A, C, EQ. rewrite Rlt_bool_true. + intros (D & E & F). apply B2R_Bsign_inj; auto. destruct f; try discriminate; simpl. - rewrite Rabs_R0. apply bpow_gt_0. + rewrite Rabs_R0. apply bpow_gt_0. rewrite F2R_cond_Zopp. rewrite abs_cond_Ropp. rewrite <- F2R_Zabs. simpl Z.abs. eapply bounded_lt_emax; eauto. - destruct f; try discriminate. simpl. auto. diff --git a/lib/Floats.v b/lib/Floats.v index e893e3e7..cf25852e 100644 --- a/lib/Floats.v +++ b/lib/Floats.v @@ -53,13 +53,13 @@ Lemma cmp_of_comparison_swap: cmp_of_comparison (swap_comparison c) x = cmp_of_comparison c (match x with None => None | Some x => Some (CompOpp x) end). Proof. - intros. destruct c; destruct x as [[]|]; reflexivity. + intros. destruct c; destruct x as [[]|]; reflexivity. Qed. Lemma cmp_of_comparison_ne_eq: forall x, cmp_of_comparison Cne x = negb (cmp_of_comparison Ceq x). Proof. - intros. destruct x as [[]|]; reflexivity. + intros. destruct x as [[]|]; reflexivity. Qed. Lemma cmp_of_comparison_lt_eq_false: @@ -296,23 +296,23 @@ Qed. Theorem mul2_add: forall f, add f f = mul f (of_int (Int.repr 2%Z)). Proof. - intros. apply Bmult2_Bplus. - intros. destruct x; try discriminate. simpl. - transitivity (b, transform_quiet_pl n). - destruct Archi.choose_binop_pl_64; auto. + intros. apply Bmult2_Bplus. + intros. destruct x; try discriminate. simpl. + transitivity (b, transform_quiet_pl n). + destruct Archi.choose_binop_pl_64; auto. destruct y; auto || discriminate. Qed. (** Divisions that can be turned into multiplication by an inverse. *) -Definition exact_inverse : float -> option float := Bexact_inverse 53 1024 __ __. +Definition exact_inverse : float -> option float := Bexact_inverse 53 1024 __ __. Theorem div_mul_inverse: forall x y z, exact_inverse y = Some z -> div x y = mul x z. Proof. - intros. apply Bdiv_mult_inverse; auto. - intros. destruct x0; try discriminate. simpl. - transitivity (b, transform_quiet_pl n). + intros. apply Bdiv_mult_inverse; auto. + intros. destruct x0; try discriminate. simpl. + transitivity (b, transform_quiet_pl n). destruct y0; reflexivity || discriminate. destruct z0; reflexivity || discriminate. Qed. @@ -323,13 +323,13 @@ Theorem cmp_swap: forall c x y, cmp (swap_comparison c) x y = cmp c y x. Proof. unfold cmp; intros. rewrite (Bcompare_swap _ _ x y). - apply cmp_of_comparison_swap. + apply cmp_of_comparison_swap. Qed. Theorem cmp_ne_eq: forall f1 f2, cmp Cne f1 f2 = negb (cmp Ceq f1 f2). Proof. - intros; apply cmp_of_comparison_ne_eq. + intros; apply cmp_of_comparison_ne_eq. Qed. Theorem cmp_lt_eq_false: @@ -371,7 +371,7 @@ Proof. intros; unfold of_bits, to_bits, bits_of_b64, b64_of_bits. rewrite Int64.unsigned_repr, binary_float_of_bits_of_binary_float; [reflexivity|]. generalize (bits_of_binary_float_range 52 11 __ __ f). - change (2^(52+11+1)) with (Int64.max_unsigned + 1). omega. + change (2^(52+11+1)) with (Int64.max_unsigned + 1). omega. Qed. Theorem to_of_bits: @@ -379,7 +379,7 @@ Theorem to_of_bits: Proof. intros; unfold of_bits, to_bits, bits_of_b64, b64_of_bits. rewrite bits_of_binary_float_of_bits. apply Int64.repr_unsigned. - apply Int64.unsigned_range. + apply Int64.unsigned_range. Qed. (** Conversions between floats and unsigned ints can be defined @@ -412,7 +412,7 @@ Proof. assert (R8: integer_representable 53 1024 (Int.unsigned ox8000_0000)). { apply integer_representable_2p with (p := 31);auto; smart_omega. } rewrite BofZ_plus by auto. - f_equal. + f_equal. unfold Int.ltu in H. destruct zlt in H; try discriminate. unfold y, Int.sub. rewrite Int.signed_repr. omega. compute_this (Int.unsigned ox8000_0000); smart_omega. @@ -424,10 +424,10 @@ Theorem to_intu_to_int_1: to_intu x = Some n -> to_int x = Some n. Proof. - intros. unfold to_intu in H0. + intros. unfold to_intu in H0. destruct (ZofB_range 53 1024 x 0 Int.max_unsigned) as [p|] eqn:E; simpl in H0; inv H0. exploit ZofB_range_inversion; eauto. intros (A & B & C). - unfold to_int, ZofB_range. rewrite C. + unfold to_int, ZofB_range. rewrite C. rewrite Zle_bool_true by smart_omega. rewrite Zle_bool_true; auto. exploit (BofZ_exact 53 1024 __ __ (Int.unsigned ox8000_0000)). vm_compute; intuition congruence. @@ -436,16 +436,16 @@ Proof. intros (EQy & FINy & SIGNy). assert (FINx: is_finite _ _ x = true). { rewrite ZofB_correct in C. destruct (is_finite _ _ x) eqn:FINx; congruence. } - destruct (zeq p 0). + destruct (zeq p 0). subst p; smart_omega. destruct (ZofB_range_pos 53 1024 __ __ x p C) as [P Q]. omega. - assert (CMP: Bcompare _ _ x y = Some Lt). + assert (CMP: Bcompare _ _ x y = Some Lt). { unfold cmp, cmp_of_comparison in H. destruct (Bcompare _ _ x y) as [[]|]; auto; discriminate. } - rewrite Bcompare_correct in CMP by auto. + rewrite Bcompare_correct in CMP by auto. inv CMP. apply Rcompare_Lt_inv in H1. rewrite EQy in H1. assert (p < Int.unsigned ox8000_0000). { apply lt_Z2R. eapply Rle_lt_trans; eauto. } - change Int.max_signed with (Int.unsigned ox8000_0000 - 1). omega. + change Int.max_signed with (Int.unsigned ox8000_0000 - 1). omega. Qed. Theorem to_intu_to_int_2: @@ -454,7 +454,7 @@ Theorem to_intu_to_int_2: to_intu x = Some n -> to_int (sub x (of_intu ox8000_0000)) = Some (Int.sub n ox8000_0000). Proof. - intros. unfold to_intu in H0. + intros. unfold to_intu in H0. destruct (ZofB_range _ _ x 0 Int.max_unsigned) as [p|] eqn:E; simpl in H0; inv H0. exploit ZofB_range_inversion; eauto. intros (A & B & C). exploit (BofZ_exact 53 1024 __ __ (Int.unsigned ox8000_0000)). @@ -466,19 +466,19 @@ Proof. { rewrite ZofB_correct in C. destruct (is_finite _ _ x) eqn:FINx; congruence. } assert (GE: (B2R _ _ x >= Z2R (Int.unsigned ox8000_0000))%R). { rewrite <- EQy. unfold cmp, cmp_of_comparison in H. - rewrite Bcompare_correct in H by auto. + rewrite Bcompare_correct in H by auto. destruct (Rcompare (B2R 53 1024 x) (B2R 53 1024 y)) eqn:CMP. apply Req_ge; apply Rcompare_Eq_inv; auto. discriminate. - apply Rgt_ge; apply Rcompare_Gt_inv; auto. - } + apply Rgt_ge; apply Rcompare_Gt_inv; auto. + } assert (EQ: ZofB_range _ _ (sub x y) Int.min_signed Int.max_signed = Some (p - Int.unsigned ox8000_0000)). { - apply ZofB_range_minus. exact E. + apply ZofB_range_minus. exact E. compute_this (Int.unsigned ox8000_0000). smart_omega. apply Rge_le; auto. - } - unfold to_int; rewrite EQ. simpl. f_equal. unfold Int.sub. f_equal. f_equal. + } + unfold to_int; rewrite EQ. simpl. f_equal. unfold Int.sub. f_equal. f_equal. symmetry; apply Int.unsigned_repr. omega. Qed. @@ -522,14 +522,14 @@ Qed. Lemma from_words_eq: forall x, from_words ox4330_0000 x = BofZ 53 1024 __ __ (2^52 + Int.unsigned x). Proof. - intros. + intros. pose proof (Int.unsigned_range x). destruct (from_words_value x) as (A & B & C). destruct (BofZ_exact 53 1024 __ __ (2^52 + Int.unsigned x)) as (D & E & F). smart_omega. apply B2R_Bsign_inj; auto. - rewrite A, D. rewrite Z2R_plus. auto. - rewrite C, F. symmetry. apply Zlt_bool_false. smart_omega. + rewrite A, D. rewrite Z2R_plus. auto. + rewrite C, F. symmetry. apply Zlt_bool_false. smart_omega. Qed. Theorem of_intu_from_words: @@ -537,7 +537,7 @@ Theorem of_intu_from_words: of_intu x = sub (from_words ox4330_0000 x) (from_words ox4330_0000 Int.zero). Proof. intros. pose proof (Int.unsigned_range x). - rewrite ! from_words_eq. unfold sub. rewrite BofZ_minus. + rewrite ! from_words_eq. unfold sub. rewrite BofZ_minus. unfold of_intu. f_equal. rewrite Int.unsigned_zero. omega. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto; rewrite Int.unsigned_zero; smart_omega. @@ -560,11 +560,11 @@ Theorem of_int_from_words: of_int x = sub (from_words ox4330_0000 (Int.add x ox8000_0000)) (from_words ox4330_0000 ox8000_0000). Proof. - intros. + intros. pose proof (Int.signed_range x). rewrite ! from_words_eq. rewrite ox8000_0000_signed_unsigned. change (Int.unsigned ox8000_0000) with Int.half_modulus. - unfold sub. rewrite BofZ_minus. + unfold sub. rewrite BofZ_minus. unfold of_int. f_equal. omega. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto; smart_omega. @@ -607,16 +607,16 @@ Qed. Lemma from_words_eq': forall x, from_words ox4530_0000 x = BofZ 53 1024 __ __ (2^84 + Int.unsigned x * 2^32). Proof. - intros. + intros. pose proof (Int.unsigned_range x). destruct (from_words_value' x) as (A & B & C). destruct (BofZ_representable 53 1024 __ __ (2^84 + Int.unsigned x * 2^32)) as (D & E & F). replace (2^84 + Int.unsigned x * 2^32) - with ((2^52 + Int.unsigned x) * 2^32) by ring. + with ((2^52 + Int.unsigned x) * 2^32) by ring. apply integer_representable_n2p; auto. smart_omega. omega. omega. apply B2R_Bsign_inj; auto. - rewrite A, D. rewrite <- Z2R_Zpower by omega. rewrite <- Z2R_plus. auto. - rewrite C, F. symmetry. apply Zlt_bool_false. + rewrite A, D. rewrite <- Z2R_Zpower by omega. rewrite <- Z2R_plus. auto. + rewrite C, F. symmetry. apply Zlt_bool_false. compute_this (2^84); compute_this (2^32); omega. Qed. @@ -631,7 +631,7 @@ Proof. pose proof (Int64.unsigned_range l). pose proof (Int.unsigned_range (Int64.hiword l)). pose proof (Int.unsigned_range (Int64.loword l)). - rewrite ! from_words_eq, ! from_words_eq'. + rewrite ! from_words_eq, ! from_words_eq'. set (p20 := Int.unsigned (Int.repr (two_p 20))). set (x := Int64.unsigned l) in *; set (xl := Int.unsigned (Int64.loword l)) in *; @@ -639,17 +639,17 @@ Proof. unfold sub. rewrite BofZ_minus. replace (2^84 + xh * 2^32 - (2^84 + p20 * 2^32)) with ((xh - p20) * 2^32) by ring. - unfold add. rewrite BofZ_plus. - unfold of_longu. f_equal. + unfold add. rewrite BofZ_plus. + unfold of_longu. f_equal. rewrite <- (Int64.ofwords_recompose l) at 1. rewrite Int64.ofwords_add'. fold xh; fold xl. compute_this (two_p 32); compute_this p20; ring. apply integer_representable_n2p; auto. compute_this p20; smart_omega. omega. omega. - apply integer_representable_n; auto; smart_omega. + apply integer_representable_n; auto; smart_omega. replace (2^84 + xh * 2^32) with ((2^52 + xh) * 2^32) by ring. apply integer_representable_n2p; auto. smart_omega. omega. omega. change (2^84 + p20 * 2^32) with ((2^52 + 1048576) * 2^32). - apply integer_representable_n2p; auto. omega. omega. + apply integer_representable_n2p; auto. omega. omega. Qed. Theorem of_long_from_words: @@ -663,29 +663,29 @@ Proof. pose proof (Int64.signed_range l). pose proof (Int.signed_range (Int64.hiword l)). pose proof (Int.unsigned_range (Int64.loword l)). - rewrite ! from_words_eq, ! from_words_eq'. + rewrite ! from_words_eq, ! from_words_eq'. set (p := Int.unsigned (Int.repr (two_p 20 + two_p 31))). set (x := Int64.signed l) in *; set (xl := Int.unsigned (Int64.loword l)) in *; set (xh := Int.signed (Int64.hiword l)) in *. - rewrite ox8000_0000_signed_unsigned. fold xh. + rewrite ox8000_0000_signed_unsigned. fold xh. unfold sub. rewrite BofZ_minus. replace (2^84 + (xh + Int.half_modulus) * 2^32 - (2^84 + p * 2^32)) - with ((xh - 2^20) * 2^32) + with ((xh - 2^20) * 2^32) by (compute_this p; compute_this Int.half_modulus; ring). - unfold add. rewrite BofZ_plus. - unfold of_long. f_equal. + unfold add. rewrite BofZ_plus. + unfold of_long. f_equal. rewrite <- (Int64.ofwords_recompose l) at 1. rewrite Int64.ofwords_add''. - fold xh; fold xl. compute_this (two_p 32); ring. + fold xh; fold xl. compute_this (two_p 32); ring. apply integer_representable_n2p; auto. compute_this (2^20); smart_omega. omega. omega. apply integer_representable_n; auto; smart_omega. replace (2^84 + (xh + Int.half_modulus) * 2^32) - with ((2^52 + xh + Int.half_modulus) * 2^32) + with ((2^52 + xh + Int.half_modulus) * 2^32) by (compute_this Int.half_modulus; ring). apply integer_representable_n2p; auto. smart_omega. omega. omega. change (2^84 + p * 2^32) with ((2^52 + p) * 2^32). - apply integer_representable_n2p; auto. + apply integer_representable_n2p; auto. compute_this p; smart_omega. omega. Qed. @@ -708,7 +708,7 @@ Proof. assert (DECOMP: x = yh * 2^32 + yl). { unfold x. rewrite <- (Int64.ofwords_recompose l). apply Int64.ofwords_add'. } rewrite BofZ_mult. rewrite BofZ_plus. rewrite DECOMP; auto. - apply integer_representable_n2p; auto. smart_omega. omega. omega. + apply integer_representable_n2p; auto. smart_omega. omega. omega. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto; smart_omega. apply integer_representable_n; auto; smart_omega. @@ -761,7 +761,7 @@ Theorem of_longu_of_long_2: Proof. intros. change (of_int (Int.repr 2)) with (BofZ 53 1024 __ __ (2^1)). pose proof (Int64.unsigned_range x). - unfold Int64.ltu in H. + unfold Int64.ltu in H. change (Int64.unsigned (Int64.repr Int64.half_modulus)) with (2^63) in H. destruct (zlt (Int64.unsigned x) (2^63)); inv H. assert (Int64.modulus <= 2^1024 - 2^(1024-53)) by (vm_compute; intuition congruence). @@ -771,10 +771,10 @@ Proof. if zeq i 0 then Int64.testbit x 1 || Int64.testbit x 0 else if zeq i 63 then false else Int64.testbit x (i + 1)). { intros; unfold n; autorewrite with ints; auto. rewrite Int64.unsigned_one. - rewrite Int64.bits_one. compute_this Int64.zwordsize. + rewrite Int64.bits_one. compute_this Int64.zwordsize. destruct (zeq i 0); simpl proj_sumbool. - rewrite zlt_true by omega. rewrite andb_true_r. subst i; auto. - rewrite andb_false_r, orb_false_r. + rewrite zlt_true by omega. rewrite andb_true_r. subst i; auto. + rewrite andb_false_r, orb_false_r. destruct (zeq i 63). subst i. apply zlt_false; omega. apply zlt_true; omega. } assert (NB2: forall i, 0 <= i -> @@ -784,29 +784,29 @@ Proof. Int64.testbit x i). { intros. rewrite Z.mul_pow2_bits by omega. destruct (zeq i 0). apply Z.testbit_neg_r; omega. - rewrite Int64.bits_signed by omega. compute_this Int64.zwordsize. - destruct (zlt (i-1) 64). + rewrite Int64.bits_signed by omega. compute_this Int64.zwordsize. + destruct (zlt (i-1) 64). rewrite NB by omega. destruct (zeq i 1). subst. rewrite dec_eq_true by auto. auto. - rewrite dec_eq_false by omega. destruct (zeq (i - 1) 63). - symmetry. apply Int64.bits_above. compute_this Int64.zwordsize; omega. + rewrite dec_eq_false by omega. destruct (zeq (i - 1) 63). + symmetry. apply Int64.bits_above. compute_this Int64.zwordsize; omega. f_equal; omega. - rewrite NB by omega. rewrite dec_eq_false by omega. rewrite dec_eq_true by auto. - rewrite dec_eq_false by omega. symmetry. apply Int64.bits_above. compute_this Int64.zwordsize; omega. + rewrite NB by omega. rewrite dec_eq_false by omega. rewrite dec_eq_true by auto. + rewrite dec_eq_false by omega. symmetry. apply Int64.bits_above. compute_this Int64.zwordsize; omega. } assert (EQ: Int64.signed n * 2 = int_round_odd (Int64.unsigned x) 1). { symmetry. apply (int_round_odd_bits 53 1024). omega. - intros. rewrite NB2 by omega. replace i with 0 by omega. auto. - rewrite NB2 by omega. rewrite dec_eq_false by omega. rewrite dec_eq_true. + intros. rewrite NB2 by omega. replace i with 0 by omega. auto. + rewrite NB2 by omega. rewrite dec_eq_false by omega. rewrite dec_eq_true. rewrite orb_comm. unfold Int64.testbit. change (2^1) with 2. destruct (Z.testbit (Int64.unsigned x) 0) eqn:B0; [rewrite Z.testbit_true in B0 by omega|rewrite Z.testbit_false in B0 by omega]; change (2^0) with 1 in B0; rewrite Zdiv_1_r in B0; rewrite B0; auto. intros. rewrite NB2 by omega. rewrite ! dec_eq_false by omega. auto. } - unfold mul, of_long, of_longu. - rewrite BofZ_mult_2p. + unfold mul, of_long, of_longu. + rewrite BofZ_mult_2p. - change (2^1) with 2. rewrite EQ. apply BofZ_round_odd with (p := 1). + omega. + apply Zle_trans with Int64.modulus; trivial. smart_omega. @@ -818,7 +818,7 @@ Proof. compute_this Int64.modulus; xomega. - assert (2^63 <= int_round_odd (Int64.unsigned x) 1). { change (2^63) with (int_round_odd (2^63) 1). apply (int_round_odd_le 0 0); omega. } - rewrite <- EQ in H1. compute_this (2^63). compute_this (2^53). xomega. + rewrite <- EQ in H1. compute_this (2^63). compute_this (2^53). xomega. - omega. Qed. @@ -941,10 +941,10 @@ Qed. Theorem mul2_add: forall f, add f f = mul f (of_int (Int.repr 2%Z)). Proof. - intros. apply Bmult2_Bplus. - intros. destruct x; try discriminate. simpl. - transitivity (b, transform_quiet_pl n). - destruct Archi.choose_binop_pl_32; auto. + intros. apply Bmult2_Bplus. + intros. destruct x; try discriminate. simpl. + transitivity (b, transform_quiet_pl n). + destruct Archi.choose_binop_pl_32; auto. destruct y; auto || discriminate. Qed. @@ -955,9 +955,9 @@ Definition exact_inverse : float32 -> option float32 := Bexact_inverse 24 128 __ Theorem div_mul_inverse: forall x y z, exact_inverse y = Some z -> div x y = mul x z. Proof. - intros. apply Bdiv_mult_inverse; auto. - intros. destruct x0; try discriminate. simpl. - transitivity (b, transform_quiet_pl n). + intros. apply Bdiv_mult_inverse; auto. + intros. destruct x0; try discriminate. simpl. + transitivity (b, transform_quiet_pl n). destruct y0; reflexivity || discriminate. destruct z0; reflexivity || discriminate. Qed. @@ -968,13 +968,13 @@ Theorem cmp_swap: forall c x y, cmp (swap_comparison c) x y = cmp c y x. Proof. unfold cmp; intros. rewrite (Bcompare_swap _ _ x y). - apply cmp_of_comparison_swap. + apply cmp_of_comparison_swap. Qed. Theorem cmp_ne_eq: forall f1 f2, cmp Cne f1 f2 = negb (cmp Ceq f1 f2). Proof. - intros; apply cmp_of_comparison_ne_eq. + intros; apply cmp_of_comparison_ne_eq. Qed. Theorem cmp_lt_eq_false: @@ -1031,7 +1031,7 @@ Theorem to_of_bits: Proof. intros; unfold of_bits, to_bits, bits_of_b32, b32_of_bits. rewrite bits_of_binary_float_of_bits. apply Int.repr_unsigned. - apply Int.unsigned_range. + apply Int.unsigned_range. Qed. (** Conversions from 32-bit integers to single-precision floats can @@ -1041,15 +1041,15 @@ Qed. Theorem of_int_double: forall n, of_int n = of_double (Float.of_int n). Proof. - intros. symmetry. apply Bconv_BofZ. - apply integer_representable_n; auto. generalize (Int.signed_range n); Float.smart_omega. + intros. symmetry. apply Bconv_BofZ. + apply integer_representable_n; auto. generalize (Int.signed_range n); Float.smart_omega. Qed. Theorem of_intu_double: forall n, of_intu n = of_double (Float.of_intu n). Proof. intros. symmetry. apply Bconv_BofZ. - apply integer_representable_n; auto. generalize (Int.unsigned_range n); Float.smart_omega. + apply integer_representable_n; auto. generalize (Int.unsigned_range n); Float.smart_omega. Qed. (** Conversion of single-precision floats to integers can be decomposed @@ -1062,8 +1062,8 @@ Proof. intros. unfold to_int in H. destruct (ZofB_range _ _ f Int.min_signed Int.max_signed) as [n'|] eqn:E; inv H. - unfold Float.to_int, to_double, Float.of_single. - erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. + unfold Float.to_int, to_double, Float.of_single. + erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. Qed. Theorem to_intu_double: @@ -1072,8 +1072,8 @@ Proof. intros. unfold to_intu in H. destruct (ZofB_range _ _ f 0 Int.max_unsigned) as [n'|] eqn:E; inv H. - unfold Float.to_intu, to_double, Float.of_single. - erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. + unfold Float.to_intu, to_double, Float.of_single. + erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. Qed. Theorem to_long_double: @@ -1082,8 +1082,8 @@ Proof. intros. unfold to_long in H. destruct (ZofB_range _ _ f Int64.min_signed Int64.max_signed) as [n'|] eqn:E; inv H. - unfold Float.to_long, to_double, Float.of_single. - erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. + unfold Float.to_long, to_double, Float.of_single. + erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. Qed. Theorem to_longu_double: @@ -1092,8 +1092,8 @@ Proof. intros. unfold to_longu in H. destruct (ZofB_range _ _ f 0 Int64.max_unsigned) as [n'|] eqn:E; inv H. - unfold Float.to_longu, to_double, Float.of_single. - erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. + unfold Float.to_longu, to_double, Float.of_single. + erewrite ZofB_range_Bconv; eauto. auto. omega. omega. omega. omega. Qed. (** Conversions from 64-bit integers to single-precision floats can be expressed @@ -1106,7 +1106,7 @@ Lemma int_round_odd_plus: int_round_odd n p = Z.land (Z.lor n (Z.land n (2^p-1) + (2^p-1))) (-(2^p)). Proof. intros. - assert (POS: 0 < 2^p) by (apply (Zpower_gt_0 radix2); auto). + assert (POS: 0 < 2^p) by (apply (Zpower_gt_0 radix2); auto). assert (A: Z.land n (2^p-1) = n mod 2^p). { rewrite <- Z.land_ones by auto. f_equal. rewrite Z.ones_equiv. omega. } rewrite A. @@ -1115,29 +1115,29 @@ Proof. set (m := n mod 2^p + (2^p-1)) in *. assert (C: m / 2^p = if zeq (n mod 2^p) 0 then 0 else 1). { unfold m. destruct (zeq (n mod 2^p) 0). - rewrite e. apply Zdiv_small. omega. + rewrite e. apply Zdiv_small. omega. eapply Zdiv_unique with (n mod 2^p - 1). ring. omega. } assert (D: Z.testbit m p = if zeq (n mod 2^p) 0 then false else true). { destruct (zeq (n mod 2^p) 0). apply Z.testbit_false; auto. rewrite C; auto. apply Z.testbit_true; auto. rewrite C; auto. } assert (E: forall i, p < i -> Z.testbit m i = false). - { intros. apply Z.testbit_false. omega. - replace (m / 2^i) with 0. auto. symmetry. apply Zdiv_small. - unfold m. split. omega. apply Zlt_le_trans with (2 * 2^p). omega. - change 2 with (2^1) at 1. rewrite <- (Zpower_plus radix2) by omega. + { intros. apply Z.testbit_false. omega. + replace (m / 2^i) with 0. auto. symmetry. apply Zdiv_small. + unfold m. split. omega. apply Zlt_le_trans with (2 * 2^p). omega. + change 2 with (2^1) at 1. rewrite <- (Zpower_plus radix2) by omega. apply Zpower_le. omega. } assert (F: forall i, 0 <= i -> Z.testbit (-2^p) i = if zlt i p then false else true). { intros. rewrite Z.bits_opp by auto. rewrite <- Z.ones_equiv. - destruct (zlt i p). + destruct (zlt i p). rewrite Z.ones_spec_low by omega. auto. rewrite Z.ones_spec_high by omega. auto. } - apply int_round_odd_bits; auto. - - intros. rewrite Z.land_spec, F, zlt_true by omega. apply andb_false_r. + apply int_round_odd_bits; auto. + - intros. rewrite Z.land_spec, F, zlt_true by omega. apply andb_false_r. - rewrite Z.land_spec, Z.lor_spec, D, F, zlt_false, andb_true_r by omega. - destruct (Z.eqb (n mod 2^p) 0) eqn:Z. - rewrite Z.eqb_eq in Z. rewrite Z, zeq_true. apply orb_false_r. - rewrite Z.eqb_neq in Z. rewrite zeq_false by auto. apply orb_true_r. + destruct (Z.eqb (n mod 2^p) 0) eqn:Z. + rewrite Z.eqb_eq in Z. rewrite Z, zeq_true. apply orb_false_r. + rewrite Z.eqb_neq in Z. rewrite zeq_false by auto. apply orb_true_r. - intros. rewrite Z.land_spec, Z.lor_spec, E, F, zlt_false, andb_true_r by omega. apply orb_false_r. Qed. @@ -1148,18 +1148,18 @@ Lemma of_long_round_odd: BofZ 24 128 __ __ n = Bconv _ _ 24 128 __ __ conv_nan mode_NE (BofZ 53 1024 __ __ (Z.land (Z.lor n ((Z.land n 2047) + 2047)) (-2048))). Proof. intros. rewrite <- (int_round_odd_plus 11) by omega. - assert (-2^64 <= int_round_odd n 11). + assert (-2^64 <= int_round_odd n 11). { change (-2^64) with (int_round_odd (-2^64) 11). apply (int_round_odd_le 0 0); xomega. } - assert (int_round_odd n 11 <= 2^64). + assert (int_round_odd n 11 <= 2^64). { change (2^64) with (int_round_odd (2^64) 11). apply (int_round_odd_le 0 0); xomega. } - rewrite Bconv_BofZ. + rewrite Bconv_BofZ. apply BofZ_round_odd with (p := 11). omega. apply Zle_trans with (2^64). omega. compute; intuition congruence. omega. - exact (proj1 H). - unfold int_round_odd. apply integer_representable_n2p_wide. auto. omega. - unfold int_round_odd in H0, H1. + exact (proj1 H). + unfold int_round_odd. apply integer_representable_n2p_wide. auto. omega. + unfold int_round_odd in H0, H1. split; (apply Zmult_le_reg_r with (2^11); [compute; auto | assumption]). omega. omega. @@ -1170,46 +1170,46 @@ Theorem of_longu_double_1: Int64.unsigned n <= 2^53 -> of_longu n = of_double (Float.of_longu n). Proof. - intros. symmetry; apply Bconv_BofZ. apply integer_representable_n; auto. + intros. symmetry; apply Bconv_BofZ. apply integer_representable_n; auto. pose proof (Int64.unsigned_range n); omega. Qed. Theorem of_longu_double_2: forall n, 2^36 <= Int64.unsigned n -> - of_longu n = of_double (Float.of_longu - (Int64.and (Int64.or n + of_longu n = of_double (Float.of_longu + (Int64.and (Int64.or n (Int64.add (Int64.and n (Int64.repr 2047)) (Int64.repr 2047))) (Int64.repr (-2048)))). Proof. intros. - pose proof (Int64.unsigned_range n). + pose proof (Int64.unsigned_range n). unfold of_longu. erewrite of_long_round_odd. - unfold of_double, Float.to_single. instantiate (1 := Float.to_single_pl). + unfold of_double, Float.to_single. instantiate (1 := Float.to_single_pl). f_equal. unfold Float.of_longu. f_equal. set (n' := Z.land (Z.lor (Int64.unsigned n) (Z.land (Int64.unsigned n) 2047 + 2047)) (-2048)). assert (int_round_odd (Int64.unsigned n) 11 = n') by (apply int_round_odd_plus; omega). - assert (0 <= n'). + assert (0 <= n'). { rewrite <- H1. change 0 with (int_round_odd 0 11). apply (int_round_odd_le 0 0); omega. } - assert (n' < Int64.modulus). - { apply Zle_lt_trans with (int_round_odd (Int64.modulus - 1) 11). - rewrite <- H1. apply (int_round_odd_le 0 0); omega. + assert (n' < Int64.modulus). + { apply Zle_lt_trans with (int_round_odd (Int64.modulus - 1) 11). + rewrite <- H1. apply (int_round_odd_le 0 0); omega. compute; auto. } rewrite <- (Int64.unsigned_repr n') by (unfold Int64.max_unsigned; omega). f_equal. Int64.bit_solve. rewrite Int64.testbit_repr by auto. unfold n'. - rewrite Z.land_spec, Z.lor_spec. f_equal. f_equal. + rewrite Z.land_spec, Z.lor_spec. f_equal. f_equal. unfold Int64.testbit. rewrite Int64.add_unsigned. fold (Int64.testbit (Int64.repr (Int64.unsigned (Int64.and n (Int64.repr 2047)) + Int64.unsigned (Int64.repr 2047))) i). rewrite Int64.testbit_repr by auto. f_equal. f_equal. unfold Int64.and. symmetry. apply Int64.unsigned_repr. change 2047 with (Z.ones 11). - rewrite Z.land_ones by omega. - exploit (Z_mod_lt (Int64.unsigned n) (2^11)). compute; auto. - assert (2^11 < Int64.max_unsigned) by (compute; auto). omega. + rewrite Z.land_ones by omega. + exploit (Z_mod_lt (Int64.unsigned n) (2^11)). compute; auto. + assert (2^11 < Int64.max_unsigned) by (compute; auto). omega. apply Int64.same_bits_eqm; auto. exists (-1); auto. - split. xomega. change (2^64) with Int64.modulus. xomega. + split. xomega. change (2^64) with Int64.modulus. xomega. Qed. Theorem of_long_double_1: @@ -1217,50 +1217,50 @@ Theorem of_long_double_1: Z.abs (Int64.signed n) <= 2^53 -> of_long n = of_double (Float.of_long n). Proof. - intros. symmetry; apply Bconv_BofZ. apply integer_representable_n; auto. xomega. + intros. symmetry; apply Bconv_BofZ. apply integer_representable_n; auto. xomega. Qed. Theorem of_long_double_2: forall n, 2^36 <= Z.abs (Int64.signed n) -> of_long n = of_double (Float.of_long - (Int64.and (Int64.or n + (Int64.and (Int64.or n (Int64.add (Int64.and n (Int64.repr 2047)) (Int64.repr 2047))) (Int64.repr (-2048)))). Proof. intros. - pose proof (Int64.signed_range n). + pose proof (Int64.signed_range n). unfold of_long. erewrite of_long_round_odd. - unfold of_double, Float.to_single. instantiate (1 := Float.to_single_pl). + unfold of_double, Float.to_single. instantiate (1 := Float.to_single_pl). f_equal. unfold Float.of_long. f_equal. set (n' := Z.land (Z.lor (Int64.signed n) (Z.land (Int64.signed n) 2047 + 2047)) (-2048)). assert (int_round_odd (Int64.signed n) 11 = n') by (apply int_round_odd_plus; omega). - assert (Int64.min_signed <= n'). + assert (Int64.min_signed <= n'). { rewrite <- H1. change Int64.min_signed with (int_round_odd Int64.min_signed 11). apply (int_round_odd_le 0 0); omega. } assert (n' <= Int64.max_signed). - { apply Zle_trans with (int_round_odd Int64.max_signed 11). - rewrite <- H1. apply (int_round_odd_le 0 0); omega. + { apply Zle_trans with (int_round_odd Int64.max_signed 11). + rewrite <- H1. apply (int_round_odd_le 0 0); omega. compute; intuition congruence. } rewrite <- (Int64.signed_repr n') by omega. f_equal. Int64.bit_solve. rewrite Int64.testbit_repr by auto. unfold n'. rewrite Z.land_spec, Z.lor_spec. f_equal. f_equal. - rewrite Int64.bits_signed by omega. rewrite zlt_true by omega. auto. + rewrite Int64.bits_signed by omega. rewrite zlt_true by omega. auto. unfold Int64.testbit. rewrite Int64.add_unsigned. fold (Int64.testbit (Int64.repr (Int64.unsigned (Int64.and n (Int64.repr 2047)) + Int64.unsigned (Int64.repr 2047))) i). rewrite Int64.testbit_repr by auto. f_equal. f_equal. unfold Int64.and. - change (Int64.unsigned (Int64.repr 2047)) with 2047. + change (Int64.unsigned (Int64.repr 2047)) with 2047. change 2047 with (Z.ones 11). rewrite ! Z.land_ones by omega. - rewrite Int64.unsigned_repr. apply Int64.eqmod_mod_eq. + rewrite Int64.unsigned_repr. apply Int64.eqmod_mod_eq. apply Zlt_gt. apply (Zpower_gt_0 radix2); omega. - apply Int64.eqmod_divides with (2^64). apply Int64.eqm_signed_unsigned. + apply Int64.eqmod_divides with (2^64). apply Int64.eqm_signed_unsigned. exists (2^(64-11)); auto. - exploit (Z_mod_lt (Int64.unsigned n) (2^11)). compute; auto. - assert (2^11 < Int64.max_unsigned) by (compute; auto). omega. + exploit (Z_mod_lt (Int64.unsigned n) (2^11)). compute; auto. + assert (2^11 < Int64.max_unsigned) by (compute; auto). omega. apply Int64.same_bits_eqm; auto. exists (-1); auto. - split. auto. assert (-2^64 < Int64.min_signed) by (compute; auto). + split. auto. assert (-2^64 < Int64.min_signed) by (compute; auto). assert (Int64.max_signed < 2^64) by (compute; auto). xomega. Qed. diff --git a/lib/Heaps.v b/lib/Heaps.v index 0ee07a58..65334a38 100644 --- a/lib/Heaps.v +++ b/lib/Heaps.v @@ -152,7 +152,7 @@ Lemma le_lt_trans: Proof. unfold le; intros; intuition. destruct (E.compare x1 x3). - auto. + auto. elim (@E.lt_not_eq x2 x3). auto. apply E.eq_trans with x1. apply E.eq_sym; auto. auto. elim (@E.lt_not_eq x2 x1). eapply E.lt_trans; eauto. apply E.eq_sym; auto. eapply E.lt_trans; eauto. @@ -163,7 +163,7 @@ Lemma lt_le_trans: Proof. unfold le; intros; intuition. destruct (E.compare x1 x3). - auto. + auto. elim (@E.lt_not_eq x1 x2). auto. apply E.eq_trans with x3. auto. apply E.eq_sym; auto. elim (@E.lt_not_eq x3 x2). eapply E.lt_trans; eauto. apply E.eq_sym; auto. eapply E.lt_trans; eauto. @@ -172,7 +172,7 @@ Qed. Lemma le_trans: forall x1 x2 x3, le x1 x2 -> le x2 x3 -> le x1 x3. Proof. - intros. destruct H. destruct H0. red; left; eapply E.eq_trans; eauto. + intros. destruct H. destruct H0. red; left; eapply E.eq_trans; eauto. red. right. eapply le_lt_trans; eauto. red; auto. red. right. eapply lt_le_trans; eauto. Qed. @@ -181,7 +181,7 @@ Lemma lt_heap_trans: forall x y, le x y -> forall h, lt_heap h x -> lt_heap h y. Proof. - induction h; simpl; intros. + induction h; simpl; intros. auto. intuition. eapply lt_le_trans; eauto. Qed. @@ -190,7 +190,7 @@ Lemma gt_heap_trans: forall x y, le y x -> forall h, gt_heap h x -> gt_heap h y. Proof. - induction h; simpl; intros. + induction h; simpl; intros. auto. intuition. eapply le_lt_trans; eauto. Qed. @@ -205,12 +205,12 @@ Proof. - tauto. - tauto. - rewrite e3 in *; simpl in *; intuition. -- intuition. elim NEQ. eapply E.eq_trans; eauto. +- intuition. elim NEQ. eapply E.eq_trans; eauto. - rewrite e3 in *; simpl in *; intuition. -- intuition. elim NEQ. eapply E.eq_trans; eauto. -- intuition. +- intuition. elim NEQ. eapply E.eq_trans; eauto. +- intuition. - rewrite e3 in *; simpl in *; intuition. -- intuition. elim NEQ. eapply E.eq_trans; eauto. +- intuition. elim NEQ. eapply E.eq_trans; eauto. - rewrite e3 in *; simpl in *; intuition. Qed. @@ -224,7 +224,7 @@ Proof. - rewrite e3 in *; simpl in *; tauto. - rewrite e3 in *; simpl in *; tauto. Qed. - + Lemma partition_gt: forall x pivot h, gt_heap h x -> gt_heap (fst (partition pivot h)) x /\ gt_heap (snd (partition pivot h)) x. @@ -249,18 +249,18 @@ Proof. - intuition. eapply lt_heap_trans; eauto. red; auto. eapply lt_heap_trans; eauto. red; auto. - eapply gt_heap_trans with y; eauto. red. left. apply E.eq_sym; auto. + eapply gt_heap_trans with y; eauto. red. left. apply E.eq_sym; auto. - rewrite e3 in *; simpl in *; intuition. eapply lt_heap_trans; eauto. red; auto. eapply gt_heap_trans with y; eauto. red; auto. -- intuition. +- intuition. eapply lt_heap_trans; eauto. red; auto. eapply gt_heap_trans; eauto. red; auto. -- intuition. eapply gt_heap_trans; eauto. red; auto. +- intuition. eapply gt_heap_trans; eauto. red; auto. - rewrite e3 in *; simpl in *. intuition. eapply lt_heap_trans with y; eauto. red; auto. eapply gt_heap_trans; eauto. red; auto. -- intuition. +- intuition. eapply lt_heap_trans with y; eauto. red; auto. eapply gt_heap_trans; eauto. red; auto. eapply gt_heap_trans with x; eauto. red; auto. @@ -275,16 +275,16 @@ Lemma partition_bst: bst (fst (partition pivot h)) /\ bst (snd (partition pivot h)). Proof. intros pivot h0. functional induction (partition pivot h0); simpl; try tauto. -- rewrite e3 in *; simpl in *. intuition. +- rewrite e3 in *; simpl in *. intuition. apply lt_heap_trans with x; auto. red; auto. generalize (partition_gt y pivot b2 H7). rewrite e3; simpl. tauto. -- rewrite e3 in *; simpl in *. intuition. +- rewrite e3 in *; simpl in *. intuition. generalize (partition_gt x pivot b1 H3). rewrite e3; simpl. tauto. generalize (partition_lt y pivot b1 H4). rewrite e3; simpl. tauto. - rewrite e3 in *; simpl in *. intuition. generalize (partition_gt y pivot a2 H6). rewrite e3; simpl. tauto. generalize (partition_lt x pivot a2 H8). rewrite e3; simpl. tauto. -- rewrite e3 in *; simpl in *. intuition. +- rewrite e3 in *; simpl in *. intuition. generalize (partition_lt y pivot a1 H3). rewrite e3; simpl. tauto. apply gt_heap_trans with x; auto. red; auto. Qed. @@ -294,8 +294,8 @@ Qed. Lemma insert_bst: forall x h, bst h -> bst (insert x h). Proof. - intros. - unfold insert. case_eq (partition x h). intros a b EQ; simpl. + intros. + unfold insert. case_eq (partition x h). intros a b EQ; simpl. generalize (partition_bst x h H). generalize (partition_split x h H). rewrite EQ; simpl. tauto. @@ -305,13 +305,13 @@ Lemma In_insert: forall x h y, bst h -> (In y (insert x h) <-> E.eq y x \/ In y h). Proof. intros. unfold insert. - case_eq (partition x h). intros a b EQ; simpl. + case_eq (partition x h). intros a b EQ; simpl. assert (E.eq y x \/ ~E.eq y x). destruct (E.compare y x); auto. right; red; intros. elim (E.lt_not_eq l). apply E.eq_sym; auto. destruct H0. tauto. - generalize (In_partition y x H0 h H). rewrite EQ; simpl. tauto. + generalize (In_partition y x H0 h H). rewrite EQ; simpl. tauto. Qed. (** Properties of [findMin] and [deleteMin] *) @@ -324,7 +324,7 @@ Opaque deleteMin. auto. tauto. tauto. - intuition. apply IHh. simpl. tauto. + intuition. apply IHh. simpl. tauto. Qed. Lemma deleteMin_bst: @@ -336,8 +336,8 @@ Proof. tauto. intuition. apply IHh. simpl; auto. - apply deleteMin_lt; auto. simpl; auto. - apply gt_heap_trans with y; auto. red; auto. + apply deleteMin_lt; auto. simpl; auto. + apply gt_heap_trans with y; auto. red; auto. Qed. Lemma In_deleteMin: @@ -347,16 +347,16 @@ Lemma In_deleteMin: Proof. Transparent deleteMin. intros y x h0. functional induction (deleteMin h0); simpl; intros. - discriminate. + discriminate. + inv H. tauto. inv H. tauto. - inv H. tauto. destruct _x. inv H. simpl. tauto. generalize (IHh H). simpl. tauto. Qed. Lemma gt_heap_In: forall x y h, gt_heap h x -> In y h -> E.lt x y. Proof. - induction h; simpl; intros. + induction h; simpl; intros. contradiction. intuition. apply lt_le_trans with x0; auto. red. left. apply E.eq_sym; auto. Qed. @@ -373,7 +373,7 @@ Proof. assert (le x x1). apply IHh1; auto. tauto. simpl. right; left; apply E.eq_refl. intuition. - apply le_trans with x1. auto. apply le_trans with x0. simpl in H4. red; tauto. + apply le_trans with x1. auto. apply le_trans with x0. simpl in H4. red; tauto. red; left; apply E.eq_sym; auto. apply le_trans with x1. auto. apply le_trans with x0. simpl in H4. red; tauto. red; right. eapply gt_heap_In; eauto. @@ -396,8 +396,8 @@ Opaque deleteMax. intros x h0. functional induction (deleteMax h0); simpl; intros. auto. tauto. - tauto. - intuition. apply IHh. simpl. tauto. + tauto. + intuition. apply IHh. simpl. tauto. Qed. Lemma deleteMax_bst: @@ -410,7 +410,7 @@ Proof. intuition. apply IHh. simpl; auto. apply lt_heap_trans with x; auto. red; auto. - apply deleteMax_gt; auto. simpl; auto. + apply deleteMax_gt; auto. simpl; auto. Qed. Lemma In_deleteMax: @@ -422,14 +422,14 @@ Transparent deleteMax. intros y x h0. functional induction (deleteMax h0); simpl; intros. congruence. inv H. tauto. - inv H. tauto. + inv H. tauto. destruct _x1. inv H. simpl. tauto. generalize (IHh H). simpl. tauto. Qed. Lemma lt_heap_In: forall x y h, lt_heap h x -> In y h -> E.lt y x. Proof. - induction h; simpl; intros. + induction h; simpl; intros. contradiction. intuition. apply le_lt_trans with x0; auto. red. left. apply E.eq_sym; auto. Qed. @@ -448,7 +448,7 @@ Proof. intuition. apply le_trans with x1; auto. apply le_trans with x0. red; right. eapply lt_heap_In; eauto. - simpl in H6. red; tauto. + simpl in H6. red; tauto. apply le_trans with x1; auto. apply le_trans with x0. red; auto. simpl in H6. red; tauto. @@ -511,8 +511,8 @@ Qed. Lemma findMin_empty: forall h y, findMin h = None -> ~In y h. Proof. - unfold findMin, In; intros; simpl. - destruct (proj1_sig h). + unfold findMin, In; intros; simpl. + destruct (proj1_sig h). simpl. tauto. exploit R.findMin_empty; eauto. congruence. Qed. @@ -540,8 +540,8 @@ Qed. Lemma findMax_empty: forall h y, findMax h = None -> ~In y h. Proof. - unfold findMax, In; intros; simpl. - destruct (proj1_sig h). + unfold findMax, In; intros; simpl. + destruct (proj1_sig h). simpl. tauto. exploit R.findMax_empty; eauto. congruence. Qed. diff --git a/lib/Integers.v b/lib/Integers.v index a3ff5209..a0140e57 100644 --- a/lib/Integers.v +++ b/lib/Integers.v @@ -133,16 +133,16 @@ Proof. induction n; simpl; intros. - rewrite two_power_nat_O. exists (Zpos p). ring. - rewrite two_power_nat_S. destruct p. - + destruct (IHn p) as [y EQ]. exists y. - change (Zpos p~1) with (2 * Zpos p + 1). rewrite EQ. - rewrite Z.succ_double_spec. ring. - + destruct (IHn p) as [y EQ]. exists y. - change (Zpos p~0) with (2 * Zpos p). rewrite EQ. + + destruct (IHn p) as [y EQ]. exists y. + change (Zpos p~1) with (2 * Zpos p + 1). rewrite EQ. + rewrite Z.succ_double_spec. ring. + + destruct (IHn p) as [y EQ]. exists y. + change (Zpos p~0) with (2 * Zpos p). rewrite EQ. rewrite (Z.double_spec (P_mod_two_p p n)). ring. + exists 0; omega. } - intros. - destruct (H n p) as [y EQ]. + intros. + destruct (H n p) as [y EQ]. symmetry. apply Zmod_unique with y. auto. apply P_mod_two_p_range. Qed. @@ -150,12 +150,12 @@ Lemma Z_mod_modulus_range: forall x, 0 <= Z_mod_modulus x < modulus. Proof. intros; unfold Z_mod_modulus. - destruct x. + destruct x. - generalize modulus_pos; omega. - apply P_mod_two_p_range. - set (r := P_mod_two_p p wordsize). assert (0 <= r < modulus) by apply P_mod_two_p_range. - destruct (zeq r 0). + destruct (zeq r 0). + generalize modulus_pos; omega. + omega. Qed. @@ -171,22 +171,22 @@ Lemma Z_mod_modulus_eq: Proof. intros. unfold Z_mod_modulus. destruct x. - rewrite Zmod_0_l. auto. - - apply P_mod_two_p_eq. + - apply P_mod_two_p_eq. - generalize (P_mod_two_p_range wordsize p) (P_mod_two_p_eq wordsize p). fold modulus. intros A B. exploit (Z_div_mod_eq (Zpos p) modulus). apply modulus_pos. intros C. set (q := Zpos p / modulus) in *. - set (r := P_mod_two_p p wordsize) in *. - rewrite <- B in C. + set (r := P_mod_two_p p wordsize) in *. + rewrite <- B in C. change (Z.neg p) with (- (Z.pos p)). destruct (zeq r 0). - + symmetry. apply Zmod_unique with (-q). rewrite C; rewrite e. ring. + + symmetry. apply Zmod_unique with (-q). rewrite C; rewrite e. ring. generalize modulus_pos; omega. + symmetry. apply Zmod_unique with (-q - 1). rewrite C. ring. omega. Qed. (** The [unsigned] and [signed] functions return the Coq integer corresponding - to the given machine integer, interpreted as unsigned or signed + to the given machine integer, interpreted as unsigned or signed respectively. *) Definition unsigned (n: int) : Z := intval n. @@ -198,7 +198,7 @@ Definition signed (n: int) : Z := (** Conversely, [repr] takes a Coq integer and returns the corresponding machine integer. The argument is treated modulo [modulus]. *) -Definition repr (x: Z) : int := +Definition repr (x: Z) : int := mkint (Z_mod_modulus x) (Z_mod_modulus_range' x). Definition zero := repr 0. @@ -212,12 +212,12 @@ Proof. intros. subst y. assert (forall (n m: Z) (P1 P2: n < m), P1 = P2). { - unfold Zlt; intros. - apply eq_proofs_unicity. + unfold Zlt; intros. + apply eq_proofs_unicity. intros c1 c2. destruct c1; destruct c2; (left; reflexivity) || (right; congruence). } destruct Px as [Px1 Px2]. destruct Py as [Py1 Py2]. - rewrite (H _ _ Px1 Py1). + rewrite (H _ _ Px1 Py1). rewrite (H _ _ Px2 Py2). reflexivity. Qed. @@ -231,7 +231,7 @@ Defined. (** * Arithmetic and logical operations over machine integers *) -Definition eq (x y: int) : bool := +Definition eq (x y: int) : bool := if zeq (unsigned x) (unsigned y) then true else false. Definition lt (x y: int) : bool := if zlt (signed x) (signed y) then true else false. @@ -340,7 +340,7 @@ Definition Zshiftin (b: bool) (x: Z) : Z := *) Definition Zzero_ext (n: Z) (x: Z) : Z := - Z.iter n + Z.iter n (fun rec x => Zshiftin (Z.odd x) (rec (Z.div2 x))) (fun x => 0) x. @@ -410,8 +410,8 @@ Definition notbool (x: int) : int := if eq x zero then one else zero. Remark half_modulus_power: half_modulus = two_p (zwordsize - 1). Proof. - unfold half_modulus. rewrite modulus_power. - set (ws1 := zwordsize - 1). + unfold half_modulus. rewrite modulus_power. + set (ws1 := zwordsize - 1). replace (zwordsize) with (Zsucc ws1). rewrite two_p_S. rewrite Zmult_comm. apply Z_div_mult. omega. unfold ws1. generalize wordsize_pos; omega. @@ -420,8 +420,8 @@ Qed. Remark half_modulus_modulus: modulus = 2 * half_modulus. Proof. - rewrite half_modulus_power. rewrite modulus_power. - rewrite <- two_p_S. apply f_equal. omega. + rewrite half_modulus_power. rewrite modulus_power. + rewrite <- two_p_S. apply f_equal. omega. generalize wordsize_pos; omega. Qed. @@ -454,8 +454,8 @@ Qed. Remark wordsize_max_unsigned: zwordsize <= max_unsigned. Proof. assert (zwordsize < modulus). - rewrite modulus_power. apply two_p_strict. - generalize wordsize_pos. omega. + rewrite modulus_power. apply two_p_strict. + generalize wordsize_pos. omega. unfold max_unsigned. omega. Qed. @@ -468,14 +468,14 @@ Qed. Remark max_signed_unsigned: max_signed < max_unsigned. Proof. - unfold max_signed, max_unsigned. rewrite half_modulus_modulus. + unfold max_signed, max_unsigned. rewrite half_modulus_modulus. generalize half_modulus_pos. omega. Qed. Lemma unsigned_repr_eq: forall x, unsigned (repr x) = Zmod x modulus. Proof. - intros. simpl. apply Z_mod_modulus_eq. + intros. simpl. apply Z_mod_modulus_eq. Qed. Lemma signed_repr_eq: @@ -528,14 +528,14 @@ Qed. Lemma eqmod_mod_eq: forall x y, eqmod x y -> x mod modul = y mod modul. Proof. - intros x y [k EQ]. subst x. + intros x y [k EQ]. subst x. rewrite Zplus_comm. apply Z_mod_plus. auto. Qed. Lemma eqmod_mod: forall x, eqmod x (x mod modul). Proof. - intros; red. exists (x / modul). + intros; red. exists (x / modul). rewrite Zmult_comm. apply Z_div_mod_eq. auto. Qed. @@ -549,7 +549,7 @@ Qed. Lemma eqmod_neg: forall x y, eqmod x y -> eqmod (-x) (-y). Proof. - intros x y [k EQ]; red. exists (-k). rewrite EQ. ring. + intros x y [k EQ]; red. exists (-k). rewrite EQ. ring. Qed. Lemma eqmod_sub: @@ -573,11 +573,11 @@ End EQ_MODULO. Lemma eqmod_divides: forall n m x y, eqmod n x y -> Zdivide m n -> eqmod m x y. Proof. - intros. destruct H as [k1 EQ1]. destruct H0 as [k2 EQ2]. + intros. destruct H as [k1 EQ1]. destruct H0 as [k2 EQ2]. exists (k1*k2). rewrite <- Zmult_assoc. rewrite <- EQ2. auto. -Qed. +Qed. -(** We then specialize these definitions to equality modulo +(** We then specialize these definitions to equality modulo $2^{wordsize}$ #2<sup>wordsize</sup>#. *) Hint Resolve modulus_pos: ints. @@ -630,7 +630,7 @@ Hint Resolve eqm_mult: ints. Lemma eqm_samerepr: forall x y, eqm x y -> repr x = repr y. Proof. - intros. unfold repr. apply mkint_eq. + intros. unfold repr. apply mkint_eq. rewrite !Z_mod_modulus_eq. apply eqmod_mod_eq. auto with ints. exact H. Qed. @@ -644,7 +644,7 @@ Hint Resolve eqm_unsigned_repr: ints. Lemma eqm_unsigned_repr_l: forall a b, eqm a b -> eqm (unsigned (repr a)) b. Proof. - intros. apply eqm_trans with a. + intros. apply eqm_trans with a. apply eqm_sym. apply eqm_unsigned_repr. auto. Qed. Hint Resolve eqm_unsigned_repr_l: ints. @@ -653,7 +653,7 @@ Lemma eqm_unsigned_repr_r: forall a b, eqm a b -> eqm a (unsigned (repr b)). Proof. intros. apply eqm_trans with b. auto. - apply eqm_unsigned_repr. + apply eqm_unsigned_repr. Qed. Hint Resolve eqm_unsigned_repr_r: ints. @@ -662,7 +662,7 @@ Lemma eqm_signed_unsigned: Proof. intros; red. unfold signed. set (y := unsigned x). case (zlt y half_modulus); intro. - apply eqmod_refl. red; exists (-1); ring. + apply eqmod_refl. red; exists (-1); ring. Qed. Theorem unsigned_range: @@ -675,7 +675,7 @@ Hint Resolve unsigned_range: ints. Theorem unsigned_range_2: forall i, 0 <= unsigned i <= max_unsigned. Proof. - intro; unfold max_unsigned. + intro; unfold max_unsigned. generalize (unsigned_range i). omega. Qed. Hint Resolve unsigned_range_2: ints. @@ -683,13 +683,13 @@ Hint Resolve unsigned_range_2: ints. Theorem signed_range: forall i, min_signed <= signed i <= max_signed. Proof. - intros. unfold signed. + intros. unfold signed. generalize (unsigned_range i). set (n := unsigned i). intros. case (zlt n half_modulus); intro. unfold max_signed. generalize min_signed_neg. omega. unfold min_signed, max_signed. - rewrite half_modulus_modulus in *. omega. -Qed. + rewrite half_modulus_modulus in *. omega. +Qed. Theorem repr_unsigned: forall i, repr (unsigned i) = i. @@ -702,7 +702,7 @@ Hint Resolve repr_unsigned: ints. Lemma repr_signed: forall i, repr (signed i) = i. Proof. - intros. transitivity (repr (unsigned i)). + intros. transitivity (repr (unsigned i)). apply eqm_samerepr. apply eqm_signed_unsigned. auto with ints. Qed. Hint Resolve repr_signed: ints. @@ -717,7 +717,7 @@ Qed. Theorem unsigned_repr: forall z, 0 <= z <= max_unsigned -> unsigned (repr z) = z. Proof. - intros. rewrite unsigned_repr_eq. + intros. rewrite unsigned_repr_eq. apply Zmod_small. unfold max_unsigned in H. omega. Qed. Hint Resolve unsigned_repr: ints. @@ -728,16 +728,16 @@ Proof. intros. unfold signed. destruct (zle 0 z). replace (unsigned (repr z)) with z. rewrite zlt_true. auto. unfold max_signed in H. omega. - symmetry. apply unsigned_repr. generalize max_signed_unsigned. omega. + symmetry. apply unsigned_repr. generalize max_signed_unsigned. omega. pose (z' := z + modulus). replace (repr z) with (repr z'). replace (unsigned (repr z')) with z'. rewrite zlt_false. unfold z'. omega. unfold z'. unfold min_signed in H. - rewrite half_modulus_modulus. omega. + rewrite half_modulus_modulus. omega. symmetry. apply unsigned_repr. unfold z', max_unsigned. unfold min_signed, max_signed in H. - rewrite half_modulus_modulus. omega. + rewrite half_modulus_modulus. omega. apply eqm_samerepr. unfold z'; red. exists 1. omega. Qed. @@ -765,16 +765,16 @@ Qed. Theorem unsigned_one: unsigned one = 1. Proof. - unfold one; rewrite unsigned_repr_eq. apply Zmod_small. split. omega. - unfold modulus. replace wordsize with (S(pred wordsize)). - rewrite two_power_nat_S. generalize (two_power_nat_pos (pred wordsize)). + unfold one; rewrite unsigned_repr_eq. apply Zmod_small. split. omega. + unfold modulus. replace wordsize with (S(pred wordsize)). + rewrite two_power_nat_S. generalize (two_power_nat_pos (pred wordsize)). omega. - generalize wordsize_pos. unfold zwordsize. omega. + generalize wordsize_pos. unfold zwordsize. omega. Qed. Theorem unsigned_mone: unsigned mone = modulus - 1. Proof. - unfold mone; rewrite unsigned_repr_eq. + unfold mone; rewrite unsigned_repr_eq. replace (-1) with ((modulus - 1) + (-1) * modulus). rewrite Z_mod_plus_full. apply Zmod_small. generalize modulus_pos. omega. omega. @@ -789,12 +789,12 @@ Theorem signed_mone: signed mone = -1. Proof. unfold signed. rewrite unsigned_mone. rewrite zlt_false. omega. - rewrite half_modulus_modulus. generalize half_modulus_pos. omega. + rewrite half_modulus_modulus. generalize half_modulus_pos. omega. Qed. Theorem one_not_zero: one <> zero. Proof. - assert (unsigned one <> unsigned zero). + assert (unsigned one <> unsigned zero). rewrite unsigned_one; rewrite unsigned_zero; congruence. congruence. Qed. @@ -802,7 +802,7 @@ Qed. Theorem unsigned_repr_wordsize: unsigned iwordsize = zwordsize. Proof. - unfold iwordsize; rewrite unsigned_repr_eq. apply Zmod_small. + unfold iwordsize; rewrite unsigned_repr_eq. apply Zmod_small. generalize wordsize_pos wordsize_max_unsigned; unfold max_unsigned; omega. Qed. @@ -820,7 +820,7 @@ Theorem eq_spec: forall (x y: int), if eq x y then x = y else x <> y. Proof. intros; unfold eq. case (eq_dec x y); intro. subst y. rewrite zeq_true. auto. - rewrite zeq_false. auto. + rewrite zeq_false. auto. destruct x; destruct y. simpl. red; intro. elim n. apply mkint_eq. auto. Qed. @@ -838,11 +838,11 @@ Qed. Theorem eq_signed: forall x y, eq x y = if zeq (signed x) (signed y) then true else false. Proof. - intros. predSpec eq eq_spec x y. - subst x. rewrite zeq_true; auto. + intros. predSpec eq eq_spec x y. + subst x. rewrite zeq_true; auto. destruct (zeq (signed x) (signed y)); auto. elim H. rewrite <- (repr_signed x). rewrite <- (repr_signed y). congruence. -Qed. +Qed. (** ** Properties of addition *) @@ -851,7 +851,7 @@ Proof. intros; reflexivity. Qed. Theorem add_signed: forall x y, add x y = repr (signed x + signed y). -Proof. +Proof. intros. rewrite add_unsigned. apply eqm_samerepr. apply eqm_add; apply eqm_sym; apply eqm_signed_unsigned. Qed. @@ -876,7 +876,7 @@ Proof. set (x' := unsigned x). set (y' := unsigned y). set (z' := unsigned z). - apply eqm_samerepr. + apply eqm_samerepr. apply eqm_trans with ((x' + y') + z'). auto with ints. rewrite <- Zplus_assoc. auto with ints. @@ -884,7 +884,7 @@ Qed. Theorem add_permut: forall x y z, add x (add y z) = add y (add x z). Proof. - intros. rewrite (add_commut y z). rewrite <- add_assoc. apply add_commut. + intros. rewrite (add_commut y z). rewrite <- add_assoc. apply add_commut. Qed. Theorem add_neg_zero: forall x, add x (neg x) = zero. @@ -901,19 +901,19 @@ Proof. intros. unfold add, add_carry. rewrite unsigned_zero. rewrite Zplus_0_r. rewrite unsigned_repr_eq. - generalize (unsigned_range x) (unsigned_range y). intros. + generalize (unsigned_range x) (unsigned_range y). intros. destruct (zlt (unsigned x + unsigned y) modulus). - rewrite unsigned_zero. apply Zmod_unique with 0. omega. omega. - rewrite unsigned_one. apply Zmod_unique with 1. omega. omega. -Qed. + rewrite unsigned_zero. apply Zmod_unique with 0. omega. omega. + rewrite unsigned_one. apply Zmod_unique with 1. omega. omega. +Qed. Corollary unsigned_add_either: forall x y, unsigned (add x y) = unsigned x + unsigned y \/ unsigned (add x y) = unsigned x + unsigned y - modulus. Proof. - intros. rewrite unsigned_add_carry. unfold add_carry. - rewrite unsigned_zero. rewrite Zplus_0_r. + intros. rewrite unsigned_add_carry. unfold add_carry. + rewrite unsigned_zero. rewrite Zplus_0_r. destruct (zlt (unsigned x + unsigned y) modulus). rewrite unsigned_zero. left; omega. rewrite unsigned_one. right; omega. @@ -928,7 +928,7 @@ Qed. Theorem neg_zero: neg zero = zero. Proof. - unfold neg. rewrite unsigned_zero. auto. + unfold neg. rewrite unsigned_zero. auto. Qed. Theorem neg_involutive: forall x, neg (neg x) = x. @@ -936,7 +936,7 @@ Proof. intros; unfold neg. apply eqm_repr_eq. eapply eqm_trans. apply eqm_neg. apply eqm_unsigned_repr_l. apply eqm_refl. apply eqm_refl2. omega. -Qed. +Qed. Theorem neg_add_distr: forall x y, neg(add x y) = add (neg x) (neg y). Proof. @@ -952,7 +952,7 @@ Qed. Theorem sub_zero_l: forall x, sub x zero = x. Proof. - intros; unfold sub. rewrite unsigned_zero. + intros; unfold sub. rewrite unsigned_zero. replace (unsigned x - 0) with (unsigned x) by omega. apply repr_unsigned. Qed. @@ -974,7 +974,7 @@ Qed. Theorem sub_add_l: forall x y z, sub (add x y) z = add (sub x z) y. Proof. - intros. repeat rewrite sub_add_opp. + intros. repeat rewrite sub_add_opp. repeat rewrite add_assoc. decEq. apply add_commut. Qed. @@ -989,7 +989,7 @@ Theorem sub_shifted: sub (add x z) (add y z) = sub x y. Proof. intros. rewrite sub_add_opp. rewrite neg_add_distr. - rewrite add_assoc. + rewrite add_assoc. rewrite (add_commut (neg y) (neg z)). rewrite <- (add_assoc z). rewrite add_neg_zero. rewrite (add_commut zero). rewrite add_zero. @@ -1010,22 +1010,22 @@ Proof. intros. unfold sub, sub_borrow. rewrite unsigned_zero. rewrite Zminus_0_r. rewrite unsigned_repr_eq. - generalize (unsigned_range x) (unsigned_range y). intros. + generalize (unsigned_range x) (unsigned_range y). intros. destruct (zlt (unsigned x - unsigned y) 0). - rewrite unsigned_one. apply Zmod_unique with (-1). omega. omega. - rewrite unsigned_zero. apply Zmod_unique with 0. omega. omega. -Qed. + rewrite unsigned_one. apply Zmod_unique with (-1). omega. omega. + rewrite unsigned_zero. apply Zmod_unique with 0. omega. omega. +Qed. (** ** Properties of multiplication *) Theorem mul_commut: forall x y, mul x y = mul y x. Proof. - intros; unfold mul. decEq. ring. + intros; unfold mul. decEq. ring. Qed. Theorem mul_zero: forall x, mul x zero = zero. Proof. - intros; unfold mul. rewrite unsigned_zero. + intros; unfold mul. rewrite unsigned_zero. unfold zero. decEq. ring. Qed. @@ -1038,7 +1038,7 @@ Qed. Theorem mul_mone: forall x, mul x mone = neg x. Proof. - intros; unfold mul, neg. rewrite unsigned_mone. + intros; unfold mul, neg. rewrite unsigned_mone. apply eqm_samerepr. replace (-unsigned x) with (0 - unsigned x) by omega. replace (unsigned x * (modulus - 1)) with (unsigned x * modulus - unsigned x) by ring. @@ -1074,11 +1074,11 @@ Qed. Theorem mul_add_distr_r: forall x y z, mul x (add y z) = add (mul x y) (mul x z). Proof. - intros. rewrite mul_commut. rewrite mul_add_distr_l. + intros. rewrite mul_commut. rewrite mul_add_distr_l. decEq; apply mul_commut. -Qed. +Qed. -Theorem neg_mul_distr_l: +Theorem neg_mul_distr_l: forall x y, neg(mul x y) = mul (neg x) y. Proof. intros. unfold mul, neg. @@ -1093,7 +1093,7 @@ Theorem neg_mul_distr_r: forall x y, neg(mul x y) = mul x (neg y). Proof. intros. rewrite (mul_commut x y). rewrite (mul_commut x (neg y)). - apply neg_mul_distr_l. + apply neg_mul_distr_l. Qed. Theorem mul_signed: @@ -1109,13 +1109,13 @@ Lemma modu_divu_Euclid: forall x y, y <> zero -> x = add (mul (divu x y) y) (modu x y). Proof. intros. unfold add, mul, divu, modu. - transitivity (repr (unsigned x)). auto with ints. - apply eqm_samerepr. + transitivity (repr (unsigned x)). auto with ints. + apply eqm_samerepr. set (x' := unsigned x). set (y' := unsigned y). apply eqm_trans with ((x' / y') * y' + x' mod y'). apply eqm_refl2. rewrite Zmult_comm. apply Z_div_mod_eq. generalize (unsigned_range y); intro. - assert (unsigned y <> 0). red; intro. + assert (unsigned y <> 0). red; intro. elim H. rewrite <- (repr_unsigned y). unfold zero. congruence. unfold y'. omega. auto with ints. @@ -1124,7 +1124,7 @@ Qed. Theorem modu_divu: forall x y, y <> zero -> modu x y = sub x (mul (divu x y) y). Proof. - intros. + intros. assert (forall a b c, a = add b c -> c = sub a b). intros. subst a. rewrite sub_add_l. rewrite sub_idem. rewrite add_commut. rewrite add_zero. auto. @@ -1135,20 +1135,20 @@ Lemma mods_divs_Euclid: forall x y, x = add (mul (divs x y) y) (mods x y). Proof. intros. unfold add, mul, divs, mods. - transitivity (repr (signed x)). auto with ints. - apply eqm_samerepr. + transitivity (repr (signed x)). auto with ints. + apply eqm_samerepr. set (x' := signed x). set (y' := signed y). apply eqm_trans with ((Z.quot x' y') * y' + Z.rem x' y'). apply eqm_refl2. rewrite Zmult_comm. apply Z.quot_rem'. apply eqm_add; auto with ints. - apply eqm_unsigned_repr_r. apply eqm_mult; auto with ints. - unfold y'. apply eqm_signed_unsigned. + apply eqm_unsigned_repr_r. apply eqm_mult; auto with ints. + unfold y'. apply eqm_signed_unsigned. Qed. Theorem mods_divs: forall x y, mods x y = sub x (mul (divs x y) y). Proof. - intros. + intros. assert (forall a b c, a = add b c -> c = sub a b). intros. subst a. rewrite sub_add_l. rewrite sub_idem. rewrite add_commut. rewrite add_zero. auto. @@ -1171,26 +1171,26 @@ Qed. Theorem divs_mone: forall x, divs x mone = neg x. Proof. - unfold divs, neg; intros. - rewrite signed_mone. + unfold divs, neg; intros. + rewrite signed_mone. replace (Z.quot (signed x) (-1)) with (- (signed x)). - apply eqm_samerepr. apply eqm_neg. apply eqm_signed_unsigned. + apply eqm_samerepr. apply eqm_neg. apply eqm_signed_unsigned. set (x' := signed x). set (one := 1). change (-1) with (- one). rewrite Zquot_opp_r. - assert (Z.quot x' one = x'). + assert (Z.quot x' one = x'). symmetry. apply Zquot_unique_full with 0. red. - change (Z.abs one) with 1. - destruct (zle 0 x'). left. omega. right. omega. - unfold one; ring. + change (Z.abs one) with 1. + destruct (zle 0 x'). left. omega. right. omega. + unfold one; ring. congruence. Qed. Theorem mods_mone: forall x, mods x mone = zero. Proof. - intros. rewrite mods_divs. rewrite divs_mone. - rewrite <- neg_mul_distr_l. rewrite mul_mone. rewrite neg_involutive. apply sub_idem. + intros. rewrite mods_divs. rewrite divs_mone. + rewrite <- neg_mul_distr_l. rewrite mul_mone. rewrite neg_involutive. apply sub_idem. Qed. (** ** Bit-level properties *) @@ -1207,14 +1207,14 @@ Qed. Remark Ztestbit_m1: forall n, 0 <= n -> Z.testbit (-1) n = true. Proof. - intros. destruct n; simpl; auto. + intros. destruct n; simpl; auto. Qed. Remark Zshiftin_spec: forall b x, Zshiftin b x = 2 * x + (if b then 1 else 0). Proof. unfold Zshiftin; intros. destruct b. - - rewrite Z.succ_double_spec. omega. + - rewrite Z.succ_double_spec. omega. - rewrite Z.double_spec. omega. Qed. @@ -1222,7 +1222,7 @@ Remark Zshiftin_inj: forall b1 x1 b2 x2, Zshiftin b1 x1 = Zshiftin b2 x2 -> b1 = b2 /\ x1 = x2. Proof. - intros. rewrite !Zshiftin_spec in H. + intros. rewrite !Zshiftin_spec in H. destruct b1; destruct b2. split; [auto|omega]. omegaContradiction. @@ -1235,7 +1235,7 @@ Remark Zdecomp: Proof. intros. destruct x; simpl. - auto. - - destruct p; auto. + - destruct p; auto. - destruct p; auto. simpl. rewrite Pos.pred_double_succ. auto. Qed. @@ -1265,7 +1265,7 @@ Qed. Remark Ztestbit_shiftin_succ: forall b x n, 0 <= n -> Z.testbit (Zshiftin b x) (Z.succ n) = Z.testbit x n. Proof. - intros. rewrite Ztestbit_shiftin. rewrite zeq_false. rewrite Z.pred_succ. auto. + intros. rewrite Ztestbit_shiftin. rewrite zeq_false. rewrite Z.pred_succ. auto. omega. omega. Qed. @@ -1273,19 +1273,19 @@ Remark Ztestbit_eq: forall n x, 0 <= n -> Z.testbit x n = if zeq n 0 then Z.odd x else Z.testbit (Z.div2 x) (Z.pred n). Proof. - intros. rewrite (Zdecomp x) at 1. apply Ztestbit_shiftin; auto. + intros. rewrite (Zdecomp x) at 1. apply Ztestbit_shiftin; auto. Qed. Remark Ztestbit_base: forall x, Z.testbit x 0 = Z.odd x. Proof. - intros. rewrite Ztestbit_eq. apply zeq_true. omega. + intros. rewrite Ztestbit_eq. apply zeq_true. omega. Qed. Remark Ztestbit_succ: forall n x, 0 <= n -> Z.testbit x (Z.succ n) = Z.testbit (Z.div2 x) n. Proof. - intros. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ. auto. + intros. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ. auto. omega. omega. Qed. @@ -1296,14 +1296,14 @@ Lemma eqmod_same_bits: Proof. induction n; intros. - change (two_power_nat 0) with 1. exists (x-y); ring. - - rewrite two_power_nat_S. + - rewrite two_power_nat_S. assert (eqmod (two_power_nat n) (Z.div2 x) (Z.div2 y)). - apply IHn. intros. rewrite <- !Ztestbit_succ. apply H. rewrite inj_S; omega. - omega. omega. + apply IHn. intros. rewrite <- !Ztestbit_succ. apply H. rewrite inj_S; omega. + omega. omega. destruct H0 as [k EQ]. - exists k. rewrite (Zdecomp x). rewrite (Zdecomp y). + exists k. rewrite (Zdecomp x). rewrite (Zdecomp y). replace (Z.odd y) with (Z.odd x). - rewrite EQ. rewrite !Zshiftin_spec. ring. + rewrite EQ. rewrite !Zshiftin_spec. ring. exploit (H 0). rewrite inj_S; omega. rewrite !Ztestbit_base. auto. Qed. @@ -1321,14 +1321,14 @@ Lemma same_bits_eqmod: Proof. induction n; intros. - simpl in H0. omegaContradiction. - - rewrite inj_S in H0. rewrite two_power_nat_S in H. - rewrite !(Ztestbit_eq i); intuition. + - rewrite inj_S in H0. rewrite two_power_nat_S in H. + rewrite !(Ztestbit_eq i); intuition. destruct H as [k EQ]. assert (EQ': Zshiftin (Z.odd x) (Z.div2 x) = Zshiftin (Z.odd y) (k * two_power_nat n + Z.div2 y)). { rewrite (Zdecomp x) in EQ. rewrite (Zdecomp y) in EQ. - rewrite EQ. rewrite !Zshiftin_spec. ring. + rewrite EQ. rewrite !Zshiftin_spec. ring. } exploit Zshiftin_inj; eauto. intros [A B]. destruct (zeq i 0). @@ -1348,8 +1348,8 @@ Remark two_power_nat_infinity: Proof. intros x0 POS0; pattern x0; apply natlike_ind; auto. exists O. compute; auto. - intros. destruct H0 as [n LT]. exists (S n). rewrite two_power_nat_S. - generalize (two_power_nat_pos n). omega. + intros. destruct H0 as [n LT]. exists (S n). rewrite two_power_nat_S. + generalize (two_power_nat_pos n). omega. Qed. Lemma equal_same_bits: @@ -1357,15 +1357,15 @@ Lemma equal_same_bits: (forall i, 0 <= i -> Z.testbit x i = Z.testbit y i) -> x = y. Proof. - intros. + intros. set (z := if zlt x y then y - x else x - y). assert (0 <= z). unfold z; destruct (zlt x y); omega. - exploit (two_power_nat_infinity z); auto. intros [n LT]. + exploit (two_power_nat_infinity z); auto. intros [n LT]. assert (eqmod (two_power_nat n) x y). - apply eqmod_same_bits. intros. apply H. tauto. + apply eqmod_same_bits. intros. apply H. tauto. assert (eqmod (two_power_nat n) z 0). - unfold z. destruct (zlt x y). + unfold z. destruct (zlt x y). replace 0 with (y - y) by omega. apply eqmod_sub. apply eqmod_refl. auto. replace 0 with (x - x) by omega. apply eqmod_sub. apply eqmod_refl. apply eqmod_sym; auto. assert (z = 0). @@ -1377,13 +1377,13 @@ Lemma Z_one_complement: forall i, 0 <= i -> forall x, Z.testbit (-x-1) i = negb (Z.testbit x i). Proof. - intros i0 POS0. pattern i0. apply Zlt_0_ind; auto. - intros i IND POS x. + intros i0 POS0. pattern i0. apply Zlt_0_ind; auto. + intros i IND POS x. rewrite (Zdecomp x). set (y := Z.div2 x). replace (- Zshiftin (Z.odd x) y - 1) with (Zshiftin (negb (Z.odd x)) (- y - 1)). - rewrite !Ztestbit_shiftin; auto. - destruct (zeq i 0). auto. apply IND. omega. + rewrite !Ztestbit_shiftin; auto. + destruct (zeq i 0). auto. apply IND. omega. rewrite !Zshiftin_spec. destruct (Z.odd x); simpl negb; ring. Qed. @@ -1393,14 +1393,14 @@ Lemma Ztestbit_above: i >= Z.of_nat n -> Z.testbit x i = false. Proof. - induction n; intros. - - change (two_power_nat 0) with 1 in H. - replace x with 0 by omega. + induction n; intros. + - change (two_power_nat 0) with 1 in H. + replace x with 0 by omega. apply Z.testbit_0_l. - rewrite inj_S in H0. rewrite Ztestbit_eq. rewrite zeq_false. - apply IHn. rewrite two_power_nat_S in H. rewrite (Zdecomp x) in H. - rewrite Zshiftin_spec in H. destruct (Z.odd x); omega. - omega. omega. omega. + apply IHn. rewrite two_power_nat_S in H. rewrite (Zdecomp x) in H. + rewrite Zshiftin_spec in H. destruct (Z.odd x); omega. + omega. omega. omega. Qed. Lemma Ztestbit_above_neg: @@ -1410,11 +1410,11 @@ Lemma Ztestbit_above_neg: Z.testbit x i = true. Proof. intros. set (y := -x-1). - assert (Z.testbit y i = false). - apply Ztestbit_above with n. + assert (Z.testbit y i = false). + apply Ztestbit_above with n. unfold y; omega. auto. unfold y in H1. rewrite Z_one_complement in H1. - change true with (negb false). rewrite <- H1. rewrite negb_involutive; auto. + change true with (negb false). rewrite <- H1. rewrite negb_involutive; auto. omega. Qed. @@ -1423,17 +1423,17 @@ Lemma Zsign_bit: 0 <= x < two_power_nat (S n) -> Z.testbit x (Z_of_nat n) = if zlt x (two_power_nat n) then false else true. Proof. - induction n; intros. - - change (two_power_nat 1) with 2 in H. - assert (x = 0 \/ x = 1) by omega. + induction n; intros. + - change (two_power_nat 1) with 2 in H. + assert (x = 0 \/ x = 1) by omega. destruct H0; subst x; reflexivity. - - rewrite inj_S. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ. - rewrite IHn. rewrite two_power_nat_S. + - rewrite inj_S. rewrite Ztestbit_eq. rewrite zeq_false. rewrite Z.pred_succ. + rewrite IHn. rewrite two_power_nat_S. destruct (zlt (Z.div2 x) (two_power_nat n)); rewrite (Zdecomp x); rewrite Zshiftin_spec. - rewrite zlt_true. auto. destruct (Z.odd x); omega. - rewrite zlt_false. auto. destruct (Z.odd x); omega. - rewrite (Zdecomp x) in H; rewrite Zshiftin_spec in H. - rewrite two_power_nat_S in H. destruct (Z.odd x); omega. + rewrite zlt_true. auto. destruct (Z.odd x); omega. + rewrite zlt_false. auto. destruct (Z.odd x); omega. + rewrite (Zdecomp x) in H; rewrite Zshiftin_spec in H. + rewrite two_power_nat_S in H. destruct (Z.odd x); omega. omega. omega. Qed. @@ -1443,7 +1443,7 @@ Lemma Zshiftin_ind: (forall b x, 0 <= x -> P x -> P (Zshiftin b x)) -> forall x, 0 <= x -> P x. Proof. - intros. destruct x. + intros. destruct x. - auto. - induction p. + change (P (Zshiftin true (Z.pos p))). auto. @@ -1472,16 +1472,16 @@ Lemma Ztestbit_le: x <= y. Proof. intros x y0 POS0; revert x; pattern y0; apply Zshiftin_ind; auto; intros. - - replace x with 0. omega. apply equal_same_bits; intros. - rewrite Ztestbit_0. destruct (Z.testbit x i) as [] eqn:E; auto. + - replace x with 0. omega. apply equal_same_bits; intros. + rewrite Ztestbit_0. destruct (Z.testbit x i) as [] eqn:E; auto. exploit H; eauto. rewrite Ztestbit_0. auto. - assert (Z.div2 x0 <= x). { apply H0. intros. exploit (H1 (Zsucc i)). - omega. rewrite Ztestbit_succ; auto. rewrite Ztestbit_shiftin_succ; auto. + omega. rewrite Ztestbit_succ; auto. rewrite Ztestbit_shiftin_succ; auto. } - rewrite (Zdecomp x0). rewrite !Zshiftin_spec. + rewrite (Zdecomp x0). rewrite !Zshiftin_spec. destruct (Z.odd x0) as [] eqn:E1; destruct b as [] eqn:E2; try omega. - exploit (H1 0). omega. rewrite Ztestbit_base; auto. + exploit (H1 0). omega. rewrite Ztestbit_base; auto. rewrite Ztestbit_shiftin_base. congruence. Qed. @@ -1502,25 +1502,25 @@ Lemma same_bits_eq: (forall i, 0 <= i < zwordsize -> testbit x i = testbit y i) -> x = y. Proof. - intros. rewrite <- (repr_unsigned x). rewrite <- (repr_unsigned y). + intros. rewrite <- (repr_unsigned x). rewrite <- (repr_unsigned y). apply eqm_samerepr. apply eqm_same_bits. auto. Qed. Lemma bits_above: forall x i, i >= zwordsize -> testbit x i = false. Proof. - intros. apply Ztestbit_above with wordsize; auto. apply unsigned_range. -Qed. + intros. apply Ztestbit_above with wordsize; auto. apply unsigned_range. +Qed. Lemma bits_zero: forall i, testbit zero i = false. Proof. - intros. unfold testbit. rewrite unsigned_zero. apply Ztestbit_0. + intros. unfold testbit. rewrite unsigned_zero. apply Ztestbit_0. Qed. Remark bits_one: forall n, testbit one n = zeq n 0. Proof. - unfold testbit; intros. rewrite unsigned_one. apply Ztestbit_1. + unfold testbit; intros. rewrite unsigned_one. apply Ztestbit_1. Qed. Lemma bits_mone: @@ -1539,25 +1539,25 @@ Lemma sign_bit_of_unsigned: Proof. intros. unfold testbit. set (ws1 := pred wordsize). - assert (zwordsize - 1 = Z_of_nat ws1). - unfold zwordsize, ws1, wordsize. + assert (zwordsize - 1 = Z_of_nat ws1). + unfold zwordsize, ws1, wordsize. destruct WS.wordsize as [] eqn:E. elim WS.wordsize_not_zero; auto. - rewrite inj_S. simpl. omega. + rewrite inj_S. simpl. omega. assert (half_modulus = two_power_nat ws1). rewrite two_power_nat_two_p. rewrite <- H. apply half_modulus_power. rewrite H; rewrite H0. - apply Zsign_bit. rewrite two_power_nat_S. rewrite <- H0. + apply Zsign_bit. rewrite two_power_nat_S. rewrite <- H0. rewrite <- half_modulus_modulus. apply unsigned_range. Qed. - + Lemma bits_signed: forall x i, 0 <= i -> Z.testbit (signed x) i = testbit x (if zlt i zwordsize then i else zwordsize - 1). Proof. intros. destruct (zlt i zwordsize). - - apply same_bits_eqm. apply eqm_signed_unsigned. omega. + - apply same_bits_eqm. apply eqm_signed_unsigned. omega. - unfold signed. rewrite sign_bit_of_unsigned. destruct (zlt (unsigned x) half_modulus). + apply Ztestbit_above with wordsize. apply unsigned_range. auto. + apply Ztestbit_above_neg with wordsize. @@ -1569,11 +1569,11 @@ Lemma bits_le: (forall i, 0 <= i < zwordsize -> testbit x i = true -> testbit y i = true) -> unsigned x <= unsigned y. Proof. - intros. apply Ztestbit_le. generalize (unsigned_range y); omega. - intros. fold (testbit y i). destruct (zlt i zwordsize). - apply H. omega. auto. + intros. apply Ztestbit_le. generalize (unsigned_range y); omega. + intros. fold (testbit y i). destruct (zlt i zwordsize). + apply H. omega. auto. fold (testbit x i) in H1. rewrite bits_above in H1; auto. congruence. -Qed. +Qed. (** ** Properties of bitwise and, or, xor *) @@ -1654,7 +1654,7 @@ Qed. Theorem or_zero: forall x, or x zero = x. Proof. - bit_solve. + bit_solve. Qed. Corollary or_zero_l: forall x, or zero x = x. @@ -1664,7 +1664,7 @@ Qed. Theorem or_mone: forall x, or x mone = mone. Proof. - bit_solve. + bit_solve. Qed. Theorem or_idem: forall x, or x x = x. @@ -1677,7 +1677,7 @@ Theorem and_or_distrib: and x (or y z) = or (and x y) (and x z). Proof. bit_solve. apply demorgan1. -Qed. +Qed. Corollary and_or_distrib_l: forall x y z, @@ -1690,8 +1690,8 @@ Theorem or_and_distrib: forall x y z, or x (and y z) = and (or x y) (or x z). Proof. - bit_solve. apply orb_andb_distrib_r. -Qed. + bit_solve. apply orb_andb_distrib_r. +Qed. Corollary or_and_distrib_l: forall x y z, @@ -1702,7 +1702,7 @@ Qed. Theorem and_or_absorb: forall x y, and x (or x y) = x. Proof. - bit_solve. + bit_solve. assert (forall a b, a && (a || b) = a) by destr_bool. auto. Qed. @@ -1716,7 +1716,7 @@ Qed. Theorem xor_commut: forall x y, xor x y = xor y x. Proof. - bit_solve. apply xorb_comm. + bit_solve. apply xorb_comm. Qed. Theorem xor_assoc: forall x y z, xor (xor x y) z = xor x (xor y z). @@ -1726,7 +1726,7 @@ Qed. Theorem xor_zero: forall x, xor x zero = x. Proof. - bit_solve. apply xorb_false. + bit_solve. apply xorb_false. Qed. Corollary xor_zero_l: forall x, xor zero x = x. @@ -1736,7 +1736,7 @@ Qed. Theorem xor_idem: forall x, xor x x = zero. Proof. - bit_solve. apply xorb_nilpotent. + bit_solve. apply xorb_nilpotent. Qed. Theorem xor_zero_one: xor zero one = one. @@ -1747,7 +1747,7 @@ Proof. apply xor_idem. Qed. Theorem xor_zero_equal: forall x y, xor x y = zero -> x = y. Proof. - intros. apply same_bits_eq; intros. + intros. apply same_bits_eq; intros. assert (xorb (testbit x i) (testbit y i) = false). rewrite <- bits_xor; auto. rewrite H. apply bits_zero. destruct (testbit x i); destruct (testbit y i); reflexivity || discriminate. @@ -1757,23 +1757,23 @@ Theorem and_xor_distrib: forall x y z, and x (xor y z) = xor (and x y) (and x z). Proof. - bit_solve. + bit_solve. assert (forall a b c, a && (xorb b c) = xorb (a && b) (a && c)) by destr_bool. auto. -Qed. +Qed. Theorem and_le: forall x y, unsigned (and x y) <= unsigned x. Proof. - intros. apply bits_le; intros. + intros. apply bits_le; intros. rewrite bits_and in H0; auto. rewrite andb_true_iff in H0. tauto. Qed. Theorem or_le: forall x y, unsigned x <= unsigned (or x y). Proof. - intros. apply bits_le; intros. - rewrite bits_or; auto. rewrite H0; auto. + intros. apply bits_le; intros. + rewrite bits_or; auto. rewrite H0; auto. Qed. (** Properties of bitwise complement.*) @@ -1781,7 +1781,7 @@ Qed. Theorem not_involutive: forall (x: int), not (not x) = x. Proof. - intros. unfold not. rewrite xor_assoc. rewrite xor_idem. apply xor_zero. + intros. unfold not. rewrite xor_assoc. rewrite xor_idem. apply xor_zero. Qed. Theorem not_zero: @@ -1799,31 +1799,31 @@ Qed. Theorem not_or_and_not: forall x y, not (or x y) = and (not x) (not y). Proof. - bit_solve. apply negb_orb. + bit_solve. apply negb_orb. Qed. Theorem not_and_or_not: forall x y, not (and x y) = or (not x) (not y). Proof. - bit_solve. apply negb_andb. + bit_solve. apply negb_andb. Qed. Theorem and_not_self: forall x, and x (not x) = zero. Proof. - bit_solve. + bit_solve. Qed. Theorem or_not_self: forall x, or x (not x) = mone. Proof. - bit_solve. + bit_solve. Qed. Theorem xor_not_self: forall x, xor x (not x) = mone. Proof. - bit_solve. destruct (testbit x i); auto. + bit_solve. destruct (testbit x i); auto. Qed. Lemma unsigned_not: @@ -1832,7 +1832,7 @@ Proof. intros. transitivity (unsigned (repr(-unsigned x - 1))). f_equal. bit_solve. rewrite testbit_repr; auto. symmetry. apply Z_one_complement. omega. rewrite unsigned_repr_eq. apply Zmod_unique with (-1). - unfold max_unsigned. omega. + unfold max_unsigned. omega. generalize (unsigned_range x). unfold max_unsigned. omega. Qed. @@ -1840,30 +1840,30 @@ Theorem not_neg: forall x, not x = add (neg x) mone. Proof. bit_solve. - rewrite <- (repr_unsigned x) at 1. unfold add. + rewrite <- (repr_unsigned x) at 1. unfold add. rewrite !testbit_repr; auto. transitivity (Z.testbit (-unsigned x - 1) i). symmetry. apply Z_one_complement. omega. apply same_bits_eqm; auto. replace (-unsigned x - 1) with (-unsigned x + (-1)) by omega. - apply eqm_add. - unfold neg. apply eqm_unsigned_repr. - rewrite unsigned_mone. exists (-1). ring. + apply eqm_add. + unfold neg. apply eqm_unsigned_repr. + rewrite unsigned_mone. exists (-1). ring. Qed. Theorem neg_not: forall x, neg x = add (not x) one. Proof. - intros. rewrite not_neg. rewrite add_assoc. - replace (add mone one) with zero. rewrite add_zero. auto. - apply eqm_samerepr. rewrite unsigned_mone. rewrite unsigned_one. - exists (-1). ring. + intros. rewrite not_neg. rewrite add_assoc. + replace (add mone one) with zero. rewrite add_zero. auto. + apply eqm_samerepr. rewrite unsigned_mone. rewrite unsigned_one. + exists (-1). ring. Qed. Theorem sub_add_not: forall x y, sub x y = add (add x (not y)) one. Proof. - intros. rewrite sub_add_opp. rewrite neg_not. + intros. rewrite sub_add_opp. rewrite neg_not. rewrite ! add_assoc. auto. Qed. @@ -1883,13 +1883,13 @@ Theorem sub_borrow_add_carry: b = zero \/ b = one -> sub_borrow x y b = xor (add_carry x (not y) (xor b one)) one. Proof. - intros. unfold sub_borrow, add_carry. rewrite unsigned_not. + intros. unfold sub_borrow, add_carry. rewrite unsigned_not. replace (unsigned (xor b one)) with (1 - unsigned b). destruct (zlt (unsigned x - unsigned y - unsigned b)). rewrite zlt_true. rewrite xor_zero_l; auto. unfold max_unsigned; omega. rewrite zlt_false. rewrite xor_idem; auto. - unfold max_unsigned; omega. + unfold max_unsigned; omega. destruct H; subst b. rewrite xor_zero_l. rewrite unsigned_one, unsigned_zero; auto. rewrite xor_idem. rewrite unsigned_one, unsigned_zero; auto. @@ -1908,14 +1908,14 @@ Proof. rewrite (Zdecomp x) in *. rewrite (Zdecomp y) in *. transitivity (Z.testbit (Zshiftin (Z.odd x || Z.odd y) (Z.div2 x + Z.div2 y)) i). - f_equal. rewrite !Zshiftin_spec. - exploit (EXCL 0). omega. rewrite !Ztestbit_shiftin_base. intros. + exploit (EXCL 0). omega. rewrite !Ztestbit_shiftin_base. intros. Opaque Z.mul. destruct (Z.odd x); destruct (Z.odd y); simpl in *; discriminate || ring. - rewrite !Ztestbit_shiftin; auto. destruct (zeq i 0). + auto. - + apply IND. omega. intros. - exploit (EXCL (Z.succ j)). omega. + + apply IND. omega. intros. + exploit (EXCL (Z.succ j)). omega. rewrite !Ztestbit_shiftin_succ. auto. omega. omega. Qed. @@ -1926,8 +1926,8 @@ Theorem add_is_or: add x y = or x y. Proof. bit_solve. unfold add. rewrite testbit_repr; auto. - apply Z_add_is_or. omega. - intros. + apply Z_add_is_or. omega. + intros. assert (testbit (and x y) j = testbit zero j) by congruence. autorewrite with ints in H2. assumption. omega. Qed. @@ -1935,9 +1935,9 @@ Qed. Theorem xor_is_or: forall x y, and x y = zero -> xor x y = or x y. Proof. - bit_solve. + bit_solve. assert (testbit (and x y) i = testbit zero i) by congruence. - autorewrite with ints in H1; auto. + autorewrite with ints in H1; auto. destruct (testbit x i); destruct (testbit y i); simpl in *; congruence. Qed. @@ -1957,8 +1957,8 @@ Proof. intros. rewrite add_is_or. rewrite and_or_distrib; auto. rewrite (and_commut x y). - rewrite and_assoc. - repeat rewrite <- (and_assoc x). + rewrite and_assoc. + repeat rewrite <- (and_assoc x). rewrite (and_commut (and x x)). rewrite <- and_assoc. rewrite H. rewrite and_commut. apply and_zero. @@ -1972,8 +1972,8 @@ Lemma bits_shl: testbit (shl x y) i = if zlt i (unsigned y) then false else testbit x (i - unsigned y). Proof. - intros. unfold shl. rewrite testbit_repr; auto. - destruct (zlt i (unsigned y)). + intros. unfold shl. rewrite testbit_repr; auto. + destruct (zlt i (unsigned y)). apply Z.shiftl_spec_low. auto. apply Z.shiftl_spec_high. omega. omega. Qed. @@ -1984,11 +1984,11 @@ Lemma bits_shru: testbit (shru x y) i = if zlt (i + unsigned y) zwordsize then testbit x (i + unsigned y) else false. Proof. - intros. unfold shru. rewrite testbit_repr; auto. + intros. unfold shru. rewrite testbit_repr; auto. rewrite Z.shiftr_spec. fold (testbit x (i + unsigned y)). destruct (zlt (i + unsigned y) zwordsize). auto. - apply bits_above; auto. + apply bits_above; auto. omega. Qed. @@ -1998,8 +1998,8 @@ Lemma bits_shr: testbit (shr x y) i = testbit x (if zlt (i + unsigned y) zwordsize then i + unsigned y else zwordsize - 1). Proof. - intros. unfold shr. rewrite testbit_repr; auto. - rewrite Z.shiftr_spec. apply bits_signed. + intros. unfold shr. rewrite testbit_repr; auto. + rewrite Z.shiftr_spec. apply bits_signed. generalize (unsigned_range y); omega. omega. Qed. @@ -2017,10 +2017,10 @@ Lemma bitwise_binop_shl: f' false false = false -> f (shl x n) (shl y n) = shl (f x y) n. Proof. - intros. apply same_bits_eq; intros. + intros. apply same_bits_eq; intros. rewrite H; auto. rewrite !bits_shl; auto. destruct (zlt i (unsigned n)); auto. - rewrite H; auto. generalize (unsigned_range n); omega. + rewrite H; auto. generalize (unsigned_range n); omega. Qed. Theorem and_shl: @@ -2060,22 +2060,22 @@ Qed. Theorem shl_shl: forall x y z, - ltu y iwordsize = true -> + ltu y iwordsize = true -> ltu z iwordsize = true -> ltu (add y z) iwordsize = true -> shl (shl x y) z = shl x (add y z). Proof. - intros. + intros. generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros. assert (unsigned (add y z) = unsigned y + unsigned z). - unfold add. apply unsigned_repr. + unfold add. apply unsigned_repr. generalize two_wordsize_max_unsigned; omega. - apply same_bits_eq; intros. + apply same_bits_eq; intros. rewrite bits_shl; auto. destruct (zlt i (unsigned z)). - rewrite bits_shl; auto. rewrite zlt_true. auto. omega. - rewrite bits_shl. destruct (zlt (i - unsigned z) (unsigned y)). - + rewrite bits_shl; auto. rewrite zlt_true. auto. omega. + + rewrite bits_shl; auto. rewrite zlt_true. auto. omega. + rewrite bits_shl; auto. rewrite zlt_false. f_equal. omega. omega. + omega. Qed. @@ -2091,10 +2091,10 @@ Lemma bitwise_binop_shru: f' false false = false -> f (shru x n) (shru y n) = shru (f x y) n. Proof. - intros. apply same_bits_eq; intros. + intros. apply same_bits_eq; intros. rewrite H; auto. rewrite !bits_shru; auto. destruct (zlt (i + unsigned n) zwordsize); auto. - rewrite H; auto. generalize (unsigned_range n); omega. + rewrite H; auto. generalize (unsigned_range n); omega. Qed. Theorem and_shru: @@ -2120,7 +2120,7 @@ Qed. Theorem shru_shru: forall x y z, - ltu y iwordsize = true -> + ltu y iwordsize = true -> ltu z iwordsize = true -> ltu (add y z) iwordsize = true -> shru (shru x y) z = shru x (add y z). @@ -2128,14 +2128,14 @@ Proof. intros. generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros. assert (unsigned (add y z) = unsigned y + unsigned z). - unfold add. apply unsigned_repr. + unfold add. apply unsigned_repr. generalize two_wordsize_max_unsigned; omega. - apply same_bits_eq; intros. + apply same_bits_eq; intros. rewrite bits_shru; auto. destruct (zlt (i + unsigned z) zwordsize). - rewrite bits_shru. destruct (zlt (i + unsigned z + unsigned y) zwordsize). - + rewrite bits_shru; auto. rewrite zlt_true. f_equal. omega. omega. - + rewrite bits_shru; auto. rewrite zlt_false. auto. omega. + + rewrite bits_shru; auto. rewrite zlt_true. f_equal. omega. omega. + + rewrite bits_shru; auto. rewrite zlt_false. auto. omega. + omega. - rewrite bits_shru; auto. rewrite zlt_false. auto. omega. Qed. @@ -2150,10 +2150,10 @@ Lemma bitwise_binop_shr: (forall x y i, 0 <= i < zwordsize -> testbit (f x y) i = f' (testbit x i) (testbit y i)) -> f (shr x n) (shr y n) = shr (f x y) n. Proof. - intros. apply same_bits_eq; intros. + intros. apply same_bits_eq; intros. rewrite H; auto. rewrite !bits_shr; auto. - rewrite H; auto. - destruct (zlt (i + unsigned n) zwordsize). + rewrite H; auto. + destruct (zlt (i + unsigned n) zwordsize). generalize (unsigned_range n); omega. omega. Qed. @@ -2181,7 +2181,7 @@ Qed. Theorem shr_shr: forall x y z, - ltu y iwordsize = true -> + ltu y iwordsize = true -> ltu z iwordsize = true -> ltu (add y z) iwordsize = true -> shr (shr x y) z = shr x (add y z). @@ -2189,14 +2189,14 @@ Proof. intros. generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros. assert (unsigned (add y z) = unsigned y + unsigned z). - unfold add. apply unsigned_repr. + unfold add. apply unsigned_repr. generalize two_wordsize_max_unsigned; omega. - apply same_bits_eq; intros. + apply same_bits_eq; intros. rewrite !bits_shr; auto. f_equal. destruct (zlt (i + unsigned z) zwordsize). - rewrite H4. replace (i + (unsigned y + unsigned z)) with (i + unsigned z + unsigned y) by omega. auto. + rewrite H4. replace (i + (unsigned y + unsigned z)) with (i + unsigned z + unsigned y) by omega. auto. rewrite (zlt_false _ (i + unsigned (add y z))). - destruct (zlt (zwordsize - 1 + unsigned y) zwordsize); omega. + destruct (zlt (zwordsize - 1 + unsigned y) zwordsize); omega. omega. destruct (zlt (i + unsigned z) zwordsize); omega. Qed. @@ -2217,8 +2217,8 @@ Theorem shr_and_shru_and: shru (shl z y) y = z -> and (shr x y) z = and (shru x y) z. Proof. - intros. - rewrite <- H. + intros. + rewrite <- H. rewrite and_shru. rewrite and_shr_shru. auto. Qed. @@ -2228,19 +2228,19 @@ Theorem shru_lt_zero: Proof. intros. apply same_bits_eq; intros. rewrite bits_shru; auto. - rewrite unsigned_repr. + rewrite unsigned_repr. destruct (zeq i 0). subst i. rewrite Zplus_0_l. rewrite zlt_true. rewrite sign_bit_of_unsigned. - unfold lt. rewrite signed_zero. unfold signed. + unfold lt. rewrite signed_zero. unfold signed. destruct (zlt (unsigned x) half_modulus). - rewrite zlt_false. auto. generalize (unsigned_range x); omega. - rewrite zlt_true. unfold one; rewrite testbit_repr; auto. - generalize (unsigned_range x); omega. + rewrite zlt_false. auto. generalize (unsigned_range x); omega. + rewrite zlt_true. unfold one; rewrite testbit_repr; auto. + generalize (unsigned_range x); omega. omega. rewrite zlt_false. - unfold testbit. rewrite Ztestbit_eq. rewrite zeq_false. - destruct (lt x zero). + unfold testbit. rewrite Ztestbit_eq. rewrite zeq_false. + destruct (lt x zero). rewrite unsigned_one. simpl Z.div2. rewrite Z.testbit_0_l; auto. rewrite unsigned_zero. simpl Z.div2. rewrite Z.testbit_0_l; auto. auto. omega. omega. @@ -2256,10 +2256,10 @@ Proof. rewrite unsigned_repr. transitivity (testbit x (zwordsize - 1)). f_equal. destruct (zlt (i + (zwordsize - 1)) zwordsize); omega. - rewrite sign_bit_of_unsigned. - unfold lt. rewrite signed_zero. unfold signed. + rewrite sign_bit_of_unsigned. + unfold lt. rewrite signed_zero. unfold signed. destruct (zlt (unsigned x) half_modulus). - rewrite zlt_false. rewrite bits_zero; auto. generalize (unsigned_range x); omega. + rewrite zlt_false. rewrite bits_zero; auto. generalize (unsigned_range x); omega. rewrite zlt_true. rewrite bits_mone; auto. generalize (unsigned_range x); omega. generalize wordsize_max_unsigned; omega. Qed. @@ -2267,18 +2267,18 @@ Qed. (** ** Properties of rotations *) Lemma bits_rol: - forall x y i, + forall x y i, 0 <= i < zwordsize -> testbit (rol x y) i = testbit x ((i - unsigned y) mod zwordsize). Proof. intros. unfold rol. - exploit (Z_div_mod_eq (unsigned y) zwordsize). apply wordsize_pos. - set (j := unsigned y mod zwordsize). set (k := unsigned y / zwordsize). + exploit (Z_div_mod_eq (unsigned y) zwordsize). apply wordsize_pos. + set (j := unsigned y mod zwordsize). set (k := unsigned y / zwordsize). intros EQ. - exploit (Z_mod_lt (unsigned y) zwordsize). apply wordsize_pos. + exploit (Z_mod_lt (unsigned y) zwordsize). apply wordsize_pos. fold j. intros RANGE. rewrite testbit_repr; auto. - rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: omega. + rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: omega. destruct (zlt i j). - rewrite Z.shiftl_spec_low; auto. simpl. unfold testbit. f_equal. @@ -2289,9 +2289,9 @@ Proof. fold (testbit x (i + (zwordsize - j))). rewrite bits_above. rewrite orb_false_r. fold (testbit x (i - j)). - f_equal. symmetry. apply Zmod_unique with (-k). + f_equal. symmetry. apply Zmod_unique with (-k). rewrite EQ. ring. - omega. omega. omega. omega. + omega. omega. omega. omega. Qed. Lemma bits_ror: @@ -2300,26 +2300,26 @@ Lemma bits_ror: testbit (ror x y) i = testbit x ((i + unsigned y) mod zwordsize). Proof. intros. unfold ror. - exploit (Z_div_mod_eq (unsigned y) zwordsize). apply wordsize_pos. - set (j := unsigned y mod zwordsize). set (k := unsigned y / zwordsize). + exploit (Z_div_mod_eq (unsigned y) zwordsize). apply wordsize_pos. + set (j := unsigned y mod zwordsize). set (k := unsigned y / zwordsize). intros EQ. - exploit (Z_mod_lt (unsigned y) zwordsize). apply wordsize_pos. + exploit (Z_mod_lt (unsigned y) zwordsize). apply wordsize_pos. fold j. intros RANGE. rewrite testbit_repr; auto. - rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: omega. + rewrite Z.lor_spec. rewrite Z.shiftr_spec. 2: omega. destruct (zlt (i + j) zwordsize). - - rewrite Z.shiftl_spec_low; auto. rewrite orb_false_r. + - rewrite Z.shiftl_spec_low; auto. rewrite orb_false_r. unfold testbit. f_equal. symmetry. apply Zmod_unique with k. rewrite EQ. ring. omega. omega. - rewrite Z.shiftl_spec_high. - fold (testbit x (i + j)). - rewrite bits_above. simpl. - unfold testbit. f_equal. - symmetry. apply Zmod_unique with (k + 1). + fold (testbit x (i + j)). + rewrite bits_above. simpl. + unfold testbit. f_equal. + symmetry. apply Zmod_unique with (k + 1). rewrite EQ. ring. - omega. omega. omega. omega. + omega. omega. omega. omega. Qed. Hint Rewrite bits_rol bits_ror: ints. @@ -2330,13 +2330,13 @@ Theorem shl_rolm: shl x n = rolm x n (shl mone n). Proof. intros. generalize (ltu_inv _ _ H). rewrite unsigned_repr_wordsize; intros. - unfold rolm. apply same_bits_eq; intros. - rewrite bits_and; auto. rewrite !bits_shl; auto. rewrite bits_rol; auto. + unfold rolm. apply same_bits_eq; intros. + rewrite bits_and; auto. rewrite !bits_shl; auto. rewrite bits_rol; auto. destruct (zlt i (unsigned n)). - rewrite andb_false_r; auto. - - generalize (unsigned_range n); intros. - rewrite bits_mone. rewrite andb_true_r. f_equal. - symmetry. apply Zmod_small. omega. + - generalize (unsigned_range n); intros. + rewrite bits_mone. rewrite andb_true_r. f_equal. + symmetry. apply Zmod_small. omega. omega. Qed. @@ -2346,15 +2346,15 @@ Theorem shru_rolm: shru x n = rolm x (sub iwordsize n) (shru mone n). Proof. intros. generalize (ltu_inv _ _ H). rewrite unsigned_repr_wordsize; intros. - unfold rolm. apply same_bits_eq; intros. - rewrite bits_and; auto. rewrite !bits_shru; auto. rewrite bits_rol; auto. + unfold rolm. apply same_bits_eq; intros. + rewrite bits_and; auto. rewrite !bits_shru; auto. rewrite bits_rol; auto. destruct (zlt (i + unsigned n) zwordsize). - - generalize (unsigned_range n); intros. + - generalize (unsigned_range n); intros. rewrite bits_mone. rewrite andb_true_r. f_equal. unfold sub. rewrite unsigned_repr. rewrite unsigned_repr_wordsize. - symmetry. apply Zmod_unique with (-1). ring. omega. + symmetry. apply Zmod_unique with (-1). ring. omega. rewrite unsigned_repr_wordsize. generalize wordsize_max_unsigned. omega. - omega. + omega. - rewrite andb_false_r; auto. Qed. @@ -2362,8 +2362,8 @@ Theorem rol_zero: forall x, rol x zero = x. Proof. - bit_solve. f_equal. rewrite unsigned_zero. rewrite Zminus_0_r. - apply Zmod_small; auto. + bit_solve. f_equal. rewrite unsigned_zero. rewrite Zminus_0_r. + apply Zmod_small; auto. Qed. Lemma bitwise_binop_rol: @@ -2371,8 +2371,8 @@ Lemma bitwise_binop_rol: (forall x y i, 0 <= i < zwordsize -> testbit (f x y) i = f' (testbit x i) (testbit y i)) -> rol (f x y) n = f (rol x n) (rol y n). Proof. - intros. apply same_bits_eq; intros. - rewrite H; auto. rewrite !bits_rol; auto. rewrite H; auto. + intros. apply same_bits_eq; intros. + rewrite H; auto. rewrite !bits_rol; auto. rewrite H; auto. apply Z_mod_lt. apply wordsize_pos. Qed. @@ -2402,11 +2402,11 @@ Theorem rol_rol: Zdivide zwordsize modulus -> rol (rol x n) m = rol x (modu (add n m) iwordsize). Proof. - bit_solve. f_equal. apply eqmod_mod_eq. apply wordsize_pos. + bit_solve. f_equal. apply eqmod_mod_eq. apply wordsize_pos. set (M := unsigned m); set (N := unsigned n). apply eqmod_trans with (i - M - N). apply eqmod_sub. - apply eqmod_sym. apply eqmod_mod. apply wordsize_pos. + apply eqmod_sym. apply eqmod_mod. apply wordsize_pos. apply eqmod_refl. replace (i - M - N) with (i - (M + N)) by omega. apply eqmod_sub. @@ -2416,8 +2416,8 @@ Proof. unfold modu, add. fold M; fold N. rewrite unsigned_repr_wordsize. assert (forall a, eqmod zwordsize a (unsigned (repr a))). intros. eapply eqmod_divides. apply eqm_unsigned_repr. assumption. - eapply eqmod_trans. 2: apply H1. - apply eqmod_refl2. apply eqmod_mod_eq. apply wordsize_pos. auto. + eapply eqmod_trans. 2: apply H1. + apply eqmod_refl2. apply eqmod_mod_eq. apply wordsize_pos. auto. apply Z_mod_lt. apply wordsize_pos. Qed. @@ -2436,7 +2436,7 @@ Theorem rolm_rolm: (and (rol m1 n2) m2). Proof. intros. - unfold rolm. rewrite rol_and. rewrite and_assoc. + unfold rolm. rewrite rol_and. rewrite and_assoc. rewrite rol_rol. reflexivity. auto. Qed. @@ -2444,7 +2444,7 @@ Theorem or_rolm: forall x n m1 m2, or (rolm x n m1) (rolm x n m2) = rolm x n (or m1 m2). Proof. - intros; unfold rolm. symmetry. apply and_or_distrib. + intros; unfold rolm. symmetry. apply and_or_distrib. Qed. Theorem ror_rol: @@ -2455,23 +2455,23 @@ Proof. intros. generalize (ltu_iwordsize_inv _ H); intros. apply same_bits_eq; intros. - rewrite bits_ror; auto. rewrite bits_rol; auto. f_equal. + rewrite bits_ror; auto. rewrite bits_rol; auto. f_equal. unfold sub. rewrite unsigned_repr. rewrite unsigned_repr_wordsize. - apply eqmod_mod_eq. apply wordsize_pos. exists 1. ring. - rewrite unsigned_repr_wordsize. - generalize wordsize_pos; generalize wordsize_max_unsigned; omega. + apply eqmod_mod_eq. apply wordsize_pos. exists 1. ring. + rewrite unsigned_repr_wordsize. + generalize wordsize_pos; generalize wordsize_max_unsigned; omega. Qed. Theorem ror_rol_neg: forall x y, (zwordsize | modulus) -> ror x y = rol x (neg y). Proof. intros. apply same_bits_eq; intros. - rewrite bits_ror by auto. rewrite bits_rol by auto. - f_equal. apply eqmod_mod_eq. omega. - apply eqmod_trans with (i - (- unsigned y)). - apply eqmod_refl2; omega. + rewrite bits_ror by auto. rewrite bits_rol by auto. + f_equal. apply eqmod_mod_eq. omega. + apply eqmod_trans with (i - (- unsigned y)). + apply eqmod_refl2; omega. apply eqmod_sub. apply eqmod_refl. - apply eqmod_divides with modulus. + apply eqmod_divides with modulus. apply eqm_unsigned_repr. auto. Qed. @@ -2484,17 +2484,17 @@ Theorem or_ror: Proof. intros. generalize (ltu_iwordsize_inv _ H) (ltu_iwordsize_inv _ H0); intros. - unfold ror, or, shl, shru. apply same_bits_eq; intros. - rewrite !testbit_repr; auto. + unfold ror, or, shl, shru. apply same_bits_eq; intros. + rewrite !testbit_repr; auto. rewrite !Z.lor_spec. rewrite orb_comm. f_equal; apply same_bits_eqm; auto. - apply eqm_unsigned_repr_r. apply eqm_refl2. f_equal. - rewrite Zmod_small; auto. - assert (unsigned (add y z) = zwordsize). - rewrite H1. apply unsigned_repr_wordsize. - unfold add in H5. rewrite unsigned_repr in H5. - omega. - generalize two_wordsize_max_unsigned; omega. - - apply eqm_unsigned_repr_r. apply eqm_refl2. f_equal. + rewrite Zmod_small; auto. + assert (unsigned (add y z) = zwordsize). + rewrite H1. apply unsigned_repr_wordsize. + unfold add in H5. rewrite unsigned_repr in H5. + omega. + generalize two_wordsize_max_unsigned; omega. + - apply eqm_unsigned_repr_r. apply eqm_refl2. f_equal. apply Zmod_small; auto. Qed. @@ -2509,23 +2509,23 @@ Fixpoint powerserie (l: list Z): Z := Lemma Z_one_bits_powerserie: forall x, 0 <= x < modulus -> x = powerserie (Z_one_bits wordsize x 0). Proof. - assert (forall n x i, + assert (forall n x i, 0 <= i -> 0 <= x < two_power_nat n -> x * two_p i = powerserie (Z_one_bits n x i)). { induction n; intros. - simpl. rewrite two_power_nat_O in H0. + simpl. rewrite two_power_nat_O in H0. assert (x = 0) by omega. subst x. omega. rewrite two_power_nat_S in H0. simpl Z_one_bits. rewrite (Zdecomp x) in H0. rewrite Zshiftin_spec in H0. assert (EQ: Z.div2 x * two_p (i + 1) = powerserie (Z_one_bits n (Z.div2 x) (i + 1))). apply IHn. omega. - destruct (Z.odd x); omega. + destruct (Z.odd x); omega. rewrite two_p_is_exp in EQ. change (two_p 1) with 2 in EQ. - rewrite (Zdecomp x) at 1. rewrite Zshiftin_spec. + rewrite (Zdecomp x) at 1. rewrite Zshiftin_spec. destruct (Z.odd x); simpl powerserie; rewrite <- EQ; ring. - omega. omega. + omega. omega. } intros. rewrite <- H. change (two_p 0) with 1. omega. omega. exact H0. @@ -2543,7 +2543,7 @@ Proof. assert (In j (Z_one_bits n (Z.div2 x) (i + 1)) -> i <= j < i + Z.succ (Z.of_nat n)). intros. exploit IHn; eauto. omega. destruct (Z.odd x); simpl. - intros [A|B]. subst j. omega. auto. + intros [A|B]. subst j. omega. auto. auto. } intros. generalize (H wordsize x 0 i H0). fold zwordsize; omega. @@ -2572,7 +2572,7 @@ Theorem is_power2_range: Proof. intros. unfold ltu. rewrite unsigned_repr_wordsize. apply zlt_true. generalize (is_power2_rng _ _ H). tauto. -Qed. +Qed. Lemma is_power2_correct: forall n logn, @@ -2589,7 +2589,7 @@ Proof. rewrite unsigned_repr. replace (two_p z) with (two_p z + 0). auto. omega. elim (H z); intros. generalize wordsize_max_unsigned; omega. - auto with coqlib. + auto with coqlib. intros; discriminate. Qed. @@ -2600,9 +2600,9 @@ Remark two_p_range: Proof. intros. split. assert (two_p n > 0). apply two_p_gt_ZERO. omega. omega. - generalize (two_p_monotone_strict _ _ H). - unfold zwordsize; rewrite <- two_power_nat_two_p. - unfold max_unsigned, modulus. omega. + generalize (two_p_monotone_strict _ _ H). + unfold zwordsize; rewrite <- two_power_nat_two_p. + unfold max_unsigned, modulus. omega. Qed. Remark Z_one_bits_zero: @@ -2617,7 +2617,7 @@ Remark Z_one_bits_two_p: Z_one_bits n (two_p x) i = (i + x) :: nil. Proof. induction n; intros; simpl. simpl in H. omegaContradiction. - rewrite inj_S in H. + rewrite inj_S in H. assert (x = 0 \/ 0 < x) by omega. destruct H0. subst x; simpl. decEq. omega. apply Z_one_bits_zero. assert (Z.odd (two_p x) = false /\ Z.div2 (two_p x) = two_p (x-1)). @@ -2631,7 +2631,7 @@ Lemma is_power2_two_p: forall n, 0 <= n < zwordsize -> is_power2 (repr (two_p n)) = Some (repr n). Proof. - intros. unfold is_power2. rewrite unsigned_repr. + intros. unfold is_power2. rewrite unsigned_repr. rewrite Z_one_bits_two_p. auto. auto. apply two_p_range. auto. Qed. @@ -2645,7 +2645,7 @@ Lemma Zshiftl_mul_two_p: Proof. intros. destruct n; simpl. - omega. - - pattern p. apply Pos.peano_ind. + - pattern p. apply Pos.peano_ind. + change (two_power_pos 1) with 2. simpl. ring. + intros. rewrite Pos.iter_succ. rewrite H0. rewrite Pplus_one_succ_l. rewrite two_power_pos_is_exp. @@ -2658,7 +2658,7 @@ Lemma shl_mul_two_p: shl x y = mul x (repr (two_p (unsigned y))). Proof. intros. unfold shl, mul. apply eqm_samerepr. - rewrite Zshiftl_mul_two_p. auto with ints. + rewrite Zshiftl_mul_two_p. auto with ints. generalize (unsigned_range y); omega. Qed. @@ -2666,7 +2666,7 @@ Theorem shl_mul: forall x y, shl x y = mul x (shl one y). Proof. - intros. + intros. assert (shl one y = repr (two_p (unsigned y))). { rewrite shl_mul_two_p. rewrite mul_commut. rewrite mul_one. auto. @@ -2690,21 +2690,21 @@ Theorem shifted_or_is_add: unsigned y < two_p n -> or (shl x (repr n)) y = repr(unsigned x * two_p n + unsigned y). Proof. - intros. rewrite <- add_is_or. - - unfold add. apply eqm_samerepr. apply eqm_add; auto with ints. + intros. rewrite <- add_is_or. + - unfold add. apply eqm_samerepr. apply eqm_add; auto with ints. rewrite shl_mul_two_p. unfold mul. apply eqm_unsigned_repr_l. - apply eqm_mult; auto with ints. apply eqm_unsigned_repr_l. - apply eqm_refl2. rewrite unsigned_repr. auto. + apply eqm_mult; auto with ints. apply eqm_unsigned_repr_l. + apply eqm_refl2. rewrite unsigned_repr. auto. generalize wordsize_max_unsigned; omega. - bit_solve. - rewrite unsigned_repr. + rewrite unsigned_repr. destruct (zlt i n). + auto. - + replace (testbit y i) with false. apply andb_false_r. + + replace (testbit y i) with false. apply andb_false_r. symmetry. unfold testbit. assert (EQ: Z.of_nat (Z.to_nat n) = n) by (apply Z2Nat.id; omega). apply Ztestbit_above with (Z.to_nat n). - rewrite <- EQ in H0. rewrite <- two_power_nat_two_p in H0. + rewrite <- EQ in H0. rewrite <- two_power_nat_two_p in H0. generalize (unsigned_range y); omega. rewrite EQ; auto. + generalize wordsize_max_unsigned; omega. @@ -2717,8 +2717,8 @@ Lemma Zshiftr_div_two_p: Proof. intros. destruct n; unfold Z.shiftr; simpl. - rewrite Zdiv_1_r. auto. - - pattern p. apply Pos.peano_ind. - + change (two_power_pos 1) with 2. simpl. apply Zdiv2_div. + - pattern p. apply Pos.peano_ind. + + change (two_power_pos 1) with 2. simpl. apply Zdiv2_div. + intros. rewrite Pos.iter_succ. rewrite H0. rewrite Pplus_one_succ_l. rewrite two_power_pos_is_exp. change (two_power_pos 1) with 2. @@ -2731,7 +2731,7 @@ Lemma shru_div_two_p: forall x y, shru x y = repr (unsigned x / two_p (unsigned y)). Proof. - intros. unfold shru. + intros. unfold shru. rewrite Zshiftr_div_two_p. auto. generalize (unsigned_range y); omega. Qed. @@ -2775,12 +2775,12 @@ Lemma Ztestbit_mod_two_p: Z.testbit (x mod (two_p n)) i = if zlt i n then Z.testbit x i else false. Proof. intros n0 x i N0POS. revert x i; pattern n0; apply natlike_ind; auto. - - intros. change (two_p 0) with 1. rewrite Zmod_1_r. rewrite Z.testbit_0_l. + - intros. change (two_p 0) with 1. rewrite Zmod_1_r. rewrite Z.testbit_0_l. rewrite zlt_false; auto. omega. - - intros. rewrite two_p_S; auto. - replace (x0 mod (2 * two_p x)) + - intros. rewrite two_p_S; auto. + replace (x0 mod (2 * two_p x)) with (Zshiftin (Z.odd x0) (Z.div2 x0 mod two_p x)). - rewrite Ztestbit_shiftin; auto. rewrite (Ztestbit_eq i x0); auto. destruct (zeq i 0). + rewrite Ztestbit_shiftin; auto. rewrite (Ztestbit_eq i x0); auto. destruct (zeq i 0). + rewrite zlt_true; auto. omega. + rewrite H0. destruct (zlt (Z.pred i) x). * rewrite zlt_true; auto. omega. @@ -2800,10 +2800,10 @@ Corollary Ztestbit_two_p_m1: forall n i, 0 <= n -> 0 <= i -> Z.testbit (two_p n - 1) i = if zlt i n then true else false. Proof. - intros. replace (two_p n - 1) with ((-1) mod (two_p n)). + intros. replace (two_p n - 1) with ((-1) mod (two_p n)). rewrite Ztestbit_mod_two_p; auto. destruct (zlt i n); auto. apply Ztestbit_m1; auto. - apply Zmod_unique with (-1). ring. - exploit (two_p_gt_ZERO n). auto. omega. + apply Zmod_unique with (-1). ring. + exploit (two_p_gt_ZERO n). auto. omega. Qed. Theorem modu_and: @@ -2814,12 +2814,12 @@ Proof. intros. generalize (is_power2_correct _ _ H); intro. generalize (is_power2_rng _ _ H); intro. apply same_bits_eq; intros. - rewrite bits_and; auto. + rewrite bits_and; auto. unfold sub. rewrite testbit_repr; auto. - rewrite H0. rewrite unsigned_one. + rewrite H0. rewrite unsigned_one. unfold modu. rewrite testbit_repr; auto. rewrite H0. - rewrite Ztestbit_mod_two_p. rewrite Ztestbit_two_p_m1. - destruct (zlt i (unsigned logn)). + rewrite Ztestbit_mod_two_p. rewrite Ztestbit_two_p_m1. + destruct (zlt i (unsigned logn)). rewrite andb_true_r; auto. rewrite andb_false_r; auto. tauto. tauto. tauto. tauto. @@ -2834,11 +2834,11 @@ Lemma Zquot_Zdiv: Proof. intros. destruct (zlt x 0). - symmetry. apply Zquot_unique_full with ((x + y - 1) mod y - (y - 1)). - + red. right; split. omega. - exploit (Z_mod_lt (x + y - 1) y); auto. + + red. right; split. omega. + exploit (Z_mod_lt (x + y - 1) y); auto. rewrite Z.abs_eq. omega. omega. + transitivity ((y * ((x + y - 1) / y) + (x + y - 1) mod y) - (y-1)). - rewrite <- Z_div_mod_eq. ring. auto. ring. + rewrite <- Z_div_mod_eq. ring. auto. ring. - apply Zquot_Zdiv_pos; omega. Qed. @@ -2850,20 +2850,20 @@ Proof. intros. set (uy := unsigned y). assert (0 <= uy < zwordsize - 1). - generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto. + generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto. generalize wordsize_pos wordsize_max_unsigned; omega. - rewrite shr_div_two_p. unfold shrx. unfold divs. + rewrite shr_div_two_p. unfold shrx. unfold divs. assert (shl one y = repr (two_p uy)). transitivity (mul one (repr (two_p uy))). - symmetry. apply mul_pow2. replace y with (repr uy). + symmetry. apply mul_pow2. replace y with (repr uy). apply is_power2_two_p. omega. apply repr_unsigned. rewrite mul_commut. apply mul_one. assert (two_p uy > 0). apply two_p_gt_ZERO. omega. - assert (two_p uy < half_modulus). - rewrite half_modulus_power. + assert (two_p uy < half_modulus). + rewrite half_modulus_power. apply two_p_monotone_strict. auto. assert (two_p uy < modulus). - rewrite modulus_power. apply two_p_monotone_strict. omega. + rewrite modulus_power. apply two_p_monotone_strict. omega. assert (unsigned (shl one y) = two_p uy). rewrite H1. apply unsigned_repr. unfold max_unsigned. omega. assert (signed (shl one y) = two_p uy). @@ -2871,15 +2871,15 @@ Proof. unfold max_signed. generalize min_signed_neg. omega. rewrite H6. rewrite Zquot_Zdiv; auto. - unfold lt. rewrite signed_zero. + unfold lt. rewrite signed_zero. destruct (zlt (signed x) 0); auto. rewrite add_signed. assert (signed (sub (shl one y) one) = two_p uy - 1). - unfold sub. rewrite H5. rewrite unsigned_one. + unfold sub. rewrite H5. rewrite unsigned_one. apply signed_repr. - generalize min_signed_neg. unfold max_signed. omega. + generalize min_signed_neg. unfold max_signed. omega. rewrite H7. rewrite signed_repr. f_equal. f_equal. omega. - generalize (signed_range x). intros. + generalize (signed_range x). intros. assert (two_p uy - 1 <= max_signed). unfold max_signed. omega. omega. Qed. @@ -2888,27 +2888,27 @@ Theorem shrx_shr_2: ltu y (repr (zwordsize - 1)) = true -> shrx x y = shr (add x (shru (shr x (repr (zwordsize - 1))) (sub iwordsize y))) y. Proof. - intros. + intros. rewrite shrx_shr by auto. f_equal. rewrite shr_lt_zero. destruct (lt x zero). - set (uy := unsigned y). generalize (unsigned_range y); fold uy; intros. assert (0 <= uy < zwordsize - 1). - generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto. + generalize (ltu_inv _ _ H). rewrite unsigned_repr. auto. generalize wordsize_pos wordsize_max_unsigned; omega. assert (two_p uy < modulus). - rewrite modulus_power. apply two_p_monotone_strict. omega. + rewrite modulus_power. apply two_p_monotone_strict. omega. f_equal. rewrite shl_mul_two_p. fold uy. rewrite mul_commut. rewrite mul_one. - unfold sub. rewrite unsigned_one. rewrite unsigned_repr. - rewrite unsigned_repr_wordsize. fold uy. - apply same_bits_eq; intros. rewrite bits_shru by auto. + unfold sub. rewrite unsigned_one. rewrite unsigned_repr. + rewrite unsigned_repr_wordsize. fold uy. + apply same_bits_eq; intros. rewrite bits_shru by auto. rewrite testbit_repr by auto. rewrite Ztestbit_two_p_m1 by omega. rewrite unsigned_repr by (generalize wordsize_max_unsigned; omega). - destruct (zlt i uy). + destruct (zlt i uy). rewrite zlt_true by omega. rewrite bits_mone by omega. auto. rewrite zlt_false by omega. auto. assert (two_p uy > 0) by (apply two_p_gt_ZERO; omega). unfold max_unsigned; omega. -- replace (shru zero (sub iwordsize y)) with zero. +- replace (shru zero (sub iwordsize y)) with zero. rewrite add_zero; auto. bit_solve. destruct (zlt (i + unsigned (sub iwordsize y)) zwordsize); auto. Qed. @@ -2917,9 +2917,9 @@ Lemma Zdiv_shift: forall x y, y > 0 -> (x + (y - 1)) / y = x / y + if zeq (Zmod x y) 0 then 0 else 1. Proof. - intros. generalize (Z_div_mod_eq x y H). generalize (Z_mod_lt x y H). + intros. generalize (Z_div_mod_eq x y H). generalize (Z_mod_lt x y H). set (q := x / y). set (r := x mod y). intros. - destruct (zeq r 0). + destruct (zeq r 0). apply Zdiv_unique with (y - 1). rewrite H1. rewrite e. ring. omega. apply Zdiv_unique with (r - 1). rewrite H1. ring. omega. Qed. @@ -2930,8 +2930,8 @@ Theorem shrx_carry: shrx x y = add (shr x y) (shr_carry x y). Proof. intros. rewrite shrx_shr; auto. unfold shr_carry. - unfold lt. set (sx := signed x). rewrite signed_zero. - destruct (zlt sx 0); simpl. + unfold lt. set (sx := signed x). rewrite signed_zero. + destruct (zlt sx 0); simpl. 2: rewrite add_zero; auto. set (uy := unsigned y). assert (0 <= uy < zwordsize - 1). @@ -2943,46 +2943,46 @@ Proof. symmetry. rewrite H1. apply modu_and with (logn := y). rewrite is_power2_two_p. unfold uy. rewrite repr_unsigned. auto. omega. - rewrite H2. rewrite H1. + rewrite H2. rewrite H1. repeat rewrite shr_div_two_p. fold sx. fold uy. assert (two_p uy > 0). apply two_p_gt_ZERO. omega. assert (two_p uy < modulus). rewrite modulus_power. apply two_p_monotone_strict. omega. - assert (two_p uy < half_modulus). - rewrite half_modulus_power. + assert (two_p uy < half_modulus). + rewrite half_modulus_power. apply two_p_monotone_strict. auto. assert (two_p uy < modulus). rewrite modulus_power. apply two_p_monotone_strict. omega. assert (sub (repr (two_p uy)) one = repr (two_p uy - 1)). - unfold sub. apply eqm_samerepr. apply eqm_sub. apply eqm_sym; apply eqm_unsigned_repr. + unfold sub. apply eqm_samerepr. apply eqm_sub. apply eqm_sym; apply eqm_unsigned_repr. rewrite unsigned_one. apply eqm_refl. rewrite H7. rewrite add_signed. fold sx. - rewrite (signed_repr (two_p uy - 1)). rewrite signed_repr. - unfold modu. rewrite unsigned_repr. - unfold eq. rewrite unsigned_zero. rewrite unsigned_repr. + rewrite (signed_repr (two_p uy - 1)). rewrite signed_repr. + unfold modu. rewrite unsigned_repr. + unfold eq. rewrite unsigned_zero. rewrite unsigned_repr. assert (unsigned x mod two_p uy = sx mod two_p uy). - apply eqmod_mod_eq; auto. apply eqmod_divides with modulus. + apply eqmod_mod_eq; auto. apply eqmod_divides with modulus. fold eqm. unfold sx. apply eqm_sym. apply eqm_signed_unsigned. - unfold modulus. rewrite two_power_nat_two_p. + unfold modulus. rewrite two_power_nat_two_p. exists (two_p (zwordsize - uy)). rewrite <- two_p_is_exp. f_equal. fold zwordsize; omega. omega. omega. rewrite H8. rewrite Zdiv_shift; auto. - unfold add. apply eqm_samerepr. apply eqm_add. - apply eqm_unsigned_repr. + unfold add. apply eqm_samerepr. apply eqm_add. + apply eqm_unsigned_repr. destruct (zeq (sx mod two_p uy) 0); simpl. rewrite unsigned_zero. apply eqm_refl. rewrite unsigned_one. apply eqm_refl. generalize (Z_mod_lt (unsigned x) (two_p uy) H3). unfold max_unsigned. omega. unfold max_unsigned; omega. - generalize (signed_range x). fold sx. intros. split. omega. unfold max_signed. omega. - generalize min_signed_neg. unfold max_signed. omega. + generalize (signed_range x). fold sx. intros. split. omega. unfold max_signed. omega. + generalize min_signed_neg. unfold max_signed. omega. Qed. (** Connections between [shr] and [shru]. *) Lemma shr_shru_positive: forall x y, - signed x >= 0 -> + signed x >= 0 -> shr x y = shru x y. Proof. intros. @@ -2996,7 +2996,7 @@ Proof. intros. assert (unsigned y < half_modulus). rewrite signed_positive in H. unfold max_signed in H; omega. generalize (sign_bit_of_unsigned y). rewrite zlt_true; auto. intros A. - generalize (sign_bit_of_unsigned (and x y)). rewrite bits_and. rewrite A. + generalize (sign_bit_of_unsigned (and x y)). rewrite bits_and. rewrite A. rewrite andb_false_r. unfold signed. destruct (zlt (unsigned (and x y)) half_modulus). intros. generalize (unsigned_range (and x y)); omega. @@ -3008,7 +3008,7 @@ Theorem shr_and_is_shru_and: forall x y z, lt y zero = false -> shr (and x y) z = shru (and x y) z. Proof. - intros. apply shr_shru_positive. apply and_positive. + intros. apply shr_shru_positive. apply and_positive. unfold lt in H. rewrite signed_zero in H. destruct (zlt (signed y) 0). congruence. auto. Qed. @@ -3017,14 +3017,14 @@ Qed. Lemma Ziter_base: forall (A: Type) n (f: A -> A) x, n <= 0 -> Z.iter n f x = x. Proof. - intros. unfold Z.iter. destruct n; auto. compute in H. elim H; auto. + intros. unfold Z.iter. destruct n; auto. compute in H. elim H; auto. Qed. Lemma Ziter_succ: forall (A: Type) n (f: A -> A) x, 0 <= n -> Z.iter (Z.succ n) f x = f (Z.iter n f x). Proof. - intros. destruct n; simpl. + intros. destruct n; simpl. - auto. - rewrite Pos.add_1_r. apply Pos.iter_succ. - compute in H. elim H; auto. @@ -3037,7 +3037,7 @@ Lemma Znatlike_ind: forall n, P n. Proof. intros. destruct (zle 0 n). - apply natlike_ind; auto. apply H; omega. + apply natlike_ind; auto. apply H; omega. apply H. omega. Qed. @@ -3045,12 +3045,12 @@ Lemma Zzero_ext_spec: forall n x i, 0 <= i -> Z.testbit (Zzero_ext n x) i = if zlt i n then Z.testbit x i else false. Proof. - unfold Zzero_ext. induction n using Znatlike_ind. + unfold Zzero_ext. induction n using Znatlike_ind. - intros. rewrite Ziter_base; auto. rewrite zlt_false. rewrite Ztestbit_0; auto. omega. - - intros. rewrite Ziter_succ; auto. - rewrite Ztestbit_shiftin; auto. - rewrite (Ztestbit_eq i x); auto. + - intros. rewrite Ziter_succ; auto. + rewrite Ztestbit_shiftin; auto. + rewrite (Ztestbit_eq i x); auto. destruct (zeq i 0). + subst i. rewrite zlt_true; auto. omega. + rewrite IHn. destruct (zlt (Z.pred i) n). @@ -3059,12 +3059,12 @@ Proof. omega. Qed. -Lemma bits_zero_ext: +Lemma bits_zero_ext: forall n x i, 0 <= i -> testbit (zero_ext n x) i = if zlt i n then testbit x i else false. Proof. intros. unfold zero_ext. destruct (zlt i zwordsize). - rewrite testbit_repr; auto. rewrite Zzero_ext_spec. auto. auto. + rewrite testbit_repr; auto. rewrite Zzero_ext_spec. auto. auto. rewrite !bits_above; auto. destruct (zlt i n); auto. Qed. @@ -3072,20 +3072,20 @@ Lemma Zsign_ext_spec: forall n x i, 0 <= i -> 0 < n -> Z.testbit (Zsign_ext n x) i = Z.testbit x (if zlt i n then i else n - 1). Proof. - intros n0 x i I0 N0. + intros n0 x i I0 N0. revert x i I0. pattern n0. apply Zlt_lower_bound_ind with (z := 1). - unfold Zsign_ext. intros. destruct (zeq x 1). - + subst x; simpl. + + subst x; simpl. replace (if zlt i 1 then i else 0) with 0. rewrite Ztestbit_base. - destruct (Z.odd x0). - apply Ztestbit_m1; auto. + destruct (Z.odd x0). + apply Ztestbit_m1; auto. apply Ztestbit_0. destruct (zlt i 1); omega. + set (x1 := Z.pred x). replace x1 with (Z.succ (Z.pred x1)). - rewrite Ziter_succ. rewrite Ztestbit_shiftin. - destruct (zeq i 0). + rewrite Ziter_succ. rewrite Ztestbit_shiftin. + destruct (zeq i 0). * subst i. rewrite zlt_true. rewrite Ztestbit_base; auto. omega. * rewrite H. unfold x1. destruct (zlt (Z.pred i) (Z.pred x)). rewrite zlt_true. rewrite (Ztestbit_eq i x0); auto. rewrite zeq_false; auto. omega. @@ -3097,13 +3097,13 @@ Proof. - omega. Qed. -Lemma bits_sign_ext: +Lemma bits_sign_ext: forall n x i, 0 <= i < zwordsize -> 0 < n -> testbit (sign_ext n x) i = testbit x (if zlt i n then i else n - 1). Proof. intros. unfold sign_ext. rewrite testbit_repr; auto. rewrite Zsign_ext_spec. destruct (zlt i n); auto. - omega. auto. + omega. auto. Qed. Hint Rewrite bits_zero_ext bits_sign_ext: ints. @@ -3119,7 +3119,7 @@ Theorem sign_ext_above: forall n x, n >= zwordsize -> sign_ext n x = x. Proof. intros. apply same_bits_eq; intros. - unfold sign_ext; rewrite testbit_repr; auto. + unfold sign_ext; rewrite testbit_repr; auto. rewrite Zsign_ext_spec. rewrite zlt_true. auto. omega. omega. omega. Qed. @@ -3127,22 +3127,22 @@ Theorem zero_ext_and: forall n x, 0 <= n -> zero_ext n x = and x (repr (two_p n - 1)). Proof. bit_solve. rewrite testbit_repr; auto. rewrite Ztestbit_two_p_m1; intuition. - destruct (zlt i n). - rewrite andb_true_r; auto. + destruct (zlt i n). + rewrite andb_true_r; auto. rewrite andb_false_r; auto. tauto. Qed. Theorem zero_ext_mod: - forall n x, 0 <= n < zwordsize -> + forall n x, 0 <= n < zwordsize -> unsigned (zero_ext n x) = Zmod (unsigned x) (two_p n). Proof. intros. apply equal_same_bits. intros. rewrite Ztestbit_mod_two_p; auto. - fold (testbit (zero_ext n x) i). + fold (testbit (zero_ext n x) i). destruct (zlt i zwordsize). rewrite bits_zero_ext; auto. - rewrite bits_above. rewrite zlt_false; auto. omega. omega. + rewrite bits_above. rewrite zlt_false; auto. omega. omega. omega. Qed. @@ -3150,8 +3150,8 @@ Theorem zero_ext_widen: forall x n n', 0 <= n <= n' -> zero_ext n' (zero_ext n x) = zero_ext n x. Proof. - bit_solve. destruct (zlt i n). - apply zlt_true. omega. + bit_solve. destruct (zlt i n). + apply zlt_true. omega. destruct (zlt i n'); auto. tauto. tauto. Qed. @@ -3163,11 +3163,11 @@ Proof. intros. destruct (zlt n' zwordsize). bit_solve. destruct (zlt i n'). auto. - rewrite (zlt_false _ i n). + rewrite (zlt_false _ i n). destruct (zlt (n' - 1) n); f_equal; omega. omega. omega. destruct (zlt i n'); omega. - omega. omega. + omega. omega. apply sign_ext_above; auto. Qed. @@ -3176,10 +3176,10 @@ Theorem sign_zero_ext_widen: sign_ext n' (zero_ext n x) = zero_ext n x. Proof. intros. destruct (zlt n' zwordsize). - bit_solve. + bit_solve. destruct (zlt i n'). auto. - rewrite !zlt_false. auto. omega. omega. omega. + rewrite !zlt_false. auto. omega. omega. omega. destruct (zlt i n'); omega. omega. apply sign_ext_above; auto. @@ -3189,8 +3189,8 @@ Theorem zero_ext_narrow: forall x n n', 0 <= n <= n' -> zero_ext n (zero_ext n' x) = zero_ext n x. Proof. - bit_solve. destruct (zlt i n). - apply zlt_true. omega. + bit_solve. destruct (zlt i n). + apply zlt_true. omega. auto. omega. omega. omega. Qed. @@ -3201,10 +3201,10 @@ Theorem sign_ext_narrow: Proof. intros. destruct (zlt n zwordsize). bit_solve. destruct (zlt i n); f_equal; apply zlt_true; omega. - omega. + omega. destruct (zlt i n); omega. omega. omega. - rewrite (sign_ext_above n'). auto. omega. + rewrite (sign_ext_above n'). auto. omega. Qed. Theorem zero_sign_ext_narrow: @@ -3212,7 +3212,7 @@ Theorem zero_sign_ext_narrow: zero_ext n (sign_ext n' x) = zero_ext n x. Proof. intros. destruct (zlt n' zwordsize). - bit_solve. + bit_solve. destruct (zlt i n); auto. rewrite zlt_true; auto. omega. omega. omega. omega. @@ -3235,10 +3235,10 @@ Theorem sign_ext_zero_ext: forall n x, 0 < n -> sign_ext n (zero_ext n x) = sign_ext n x. Proof. intros. destruct (zlt n zwordsize). - bit_solve. - destruct (zlt i n). + bit_solve. + destruct (zlt i n). rewrite zlt_true; auto. - rewrite zlt_true; auto. omega. + rewrite zlt_true; auto. omega. destruct (zlt i n); omega. rewrite zero_ext_above; auto. Qed. @@ -3268,12 +3268,12 @@ Proof. assert (unsigned y = zwordsize - n). unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega. apply same_bits_eq; intros. - rewrite bits_zero_ext. + rewrite bits_zero_ext. rewrite bits_shru; auto. destruct (zlt i n). - rewrite zlt_true. rewrite bits_shl. rewrite zlt_false. f_equal. omega. - omega. omega. omega. - rewrite zlt_false. auto. omega. + rewrite zlt_true. rewrite bits_shl. rewrite zlt_false. f_equal. omega. + omega. omega. omega. + rewrite zlt_false. auto. omega. omega. Qed. @@ -3287,13 +3287,13 @@ Proof. assert (unsigned y = zwordsize - n). unfold y. apply unsigned_repr. generalize wordsize_max_unsigned. omega. apply same_bits_eq; intros. - rewrite bits_sign_ext. + rewrite bits_sign_ext. rewrite bits_shr; auto. destruct (zlt i n). - rewrite zlt_true. rewrite bits_shl. rewrite zlt_false. f_equal. omega. - omega. omega. omega. - rewrite zlt_false. rewrite bits_shl. rewrite zlt_false. f_equal. omega. - omega. omega. omega. omega. omega. + rewrite zlt_true. rewrite bits_shl. rewrite zlt_false. f_equal. omega. + omega. omega. omega. + rewrite zlt_false. rewrite bits_shl. rewrite zlt_false. f_equal. omega. + omega. omega. omega. omega. omega. Qed. (** [zero_ext n x] is the unique integer congruent to [x] modulo [2^n] @@ -3302,13 +3302,13 @@ Qed. Lemma zero_ext_range: forall n x, 0 <= n < zwordsize -> 0 <= unsigned (zero_ext n x) < two_p n. Proof. - intros. rewrite zero_ext_mod; auto. apply Z_mod_lt. apply two_p_gt_ZERO. omega. + intros. rewrite zero_ext_mod; auto. apply Z_mod_lt. apply two_p_gt_ZERO. omega. Qed. Lemma eqmod_zero_ext: forall n x, 0 <= n < zwordsize -> eqmod (two_p n) (unsigned (zero_ext n x)) (unsigned x). Proof. - intros. rewrite zero_ext_mod; auto. apply eqmod_sym. apply eqmod_mod. + intros. rewrite zero_ext_mod; auto. apply eqmod_sym. apply eqmod_mod. apply two_p_gt_ZERO. omega. Qed. @@ -3318,25 +3318,25 @@ Qed. Lemma sign_ext_range: forall n x, 0 < n < zwordsize -> -two_p (n-1) <= signed (sign_ext n x) < two_p (n-1). Proof. - intros. rewrite sign_ext_shr_shl; auto. + intros. rewrite sign_ext_shr_shl; auto. set (X := shl x (repr (zwordsize - n))). assert (two_p (n - 1) > 0) by (apply two_p_gt_ZERO; omega). assert (unsigned (repr (zwordsize - n)) = zwordsize - n). - apply unsigned_repr. + apply unsigned_repr. split. omega. generalize wordsize_max_unsigned; omega. rewrite shr_div_two_p. rewrite signed_repr. rewrite H1. - apply Zdiv_interval_1. + apply Zdiv_interval_1. omega. omega. apply two_p_gt_ZERO; omega. replace (- two_p (n - 1) * two_p (zwordsize - n)) with (- (two_p (n - 1) * two_p (zwordsize - n))) by ring. rewrite <- two_p_is_exp. replace (n - 1 + (zwordsize - n)) with (zwordsize - 1) by omega. rewrite <- half_modulus_power. - generalize (signed_range X). unfold min_signed, max_signed. omega. + generalize (signed_range X). unfold min_signed, max_signed. omega. omega. omega. - apply Zdiv_interval_2. apply signed_range. + apply Zdiv_interval_2. apply signed_range. generalize min_signed_neg; omega. generalize max_signed_pos; omega. rewrite H1. apply two_p_gt_ZERO. omega. @@ -3346,13 +3346,13 @@ Lemma eqmod_sign_ext': forall n x, 0 < n < zwordsize -> eqmod (two_p n) (unsigned (sign_ext n x)) (unsigned x). Proof. - intros. + intros. set (N := Z.to_nat n). assert (Z.of_nat N = n) by (apply Z2Nat.id; omega). - rewrite <- H0. rewrite <- two_power_nat_two_p. - apply eqmod_same_bits; intros. - rewrite H0 in H1. rewrite H0. - fold (testbit (sign_ext n x) i). rewrite bits_sign_ext. + rewrite <- H0. rewrite <- two_power_nat_two_p. + apply eqmod_same_bits; intros. + rewrite H0 in H1. rewrite H0. + fold (testbit (sign_ext n x) i). rewrite bits_sign_ext. rewrite zlt_true. auto. omega. omega. omega. Qed. @@ -3360,11 +3360,11 @@ Lemma eqmod_sign_ext: forall n x, 0 < n < zwordsize -> eqmod (two_p n) (signed (sign_ext n x)) (unsigned x). Proof. - intros. apply eqmod_trans with (unsigned (sign_ext n x)). - apply eqmod_divides with modulus. apply eqm_signed_unsigned. - exists (two_p (zwordsize - n)). + intros. apply eqmod_trans with (unsigned (sign_ext n x)). + apply eqmod_divides with modulus. apply eqm_signed_unsigned. + exists (two_p (zwordsize - n)). unfold modulus. rewrite two_power_nat_two_p. fold zwordsize. - rewrite <- two_p_is_exp. f_equal. omega. omega. omega. + rewrite <- two_p_is_exp. f_equal. omega. omega. omega. apply eqmod_sign_ext'; auto. Qed. @@ -3374,8 +3374,8 @@ Theorem one_bits_range: forall x i, In i (one_bits x) -> ltu i iwordsize = true. Proof. assert (A: forall p, 0 <= p < zwordsize -> ltu (repr p) iwordsize = true). - intros. unfold ltu, iwordsize. apply zlt_true. - repeat rewrite unsigned_repr. tauto. + intros. unfold ltu, iwordsize. apply zlt_true. + repeat rewrite unsigned_repr. tauto. generalize wordsize_max_unsigned; omega. generalize wordsize_max_unsigned; omega. intros. unfold one_bits in H. @@ -3392,21 +3392,21 @@ Fixpoint int_of_one_bits (l: list int) : int := Theorem one_bits_decomp: forall x, x = int_of_one_bits (one_bits x). Proof. - intros. + intros. transitivity (repr (powerserie (Z_one_bits wordsize (unsigned x) 0))). transitivity (repr (unsigned x)). auto with ints. decEq. apply Z_one_bits_powerserie. auto with ints. - unfold one_bits. + unfold one_bits. generalize (Z_one_bits_range (unsigned x)). generalize (Z_one_bits wordsize (unsigned x) 0). induction l. intros; reflexivity. intros; simpl. rewrite <- IHl. unfold add. apply eqm_samerepr. - apply eqm_add. rewrite shl_mul_two_p. rewrite mul_commut. - rewrite mul_one. apply eqm_unsigned_repr_r. + apply eqm_add. rewrite shl_mul_two_p. rewrite mul_commut. + rewrite mul_one. apply eqm_unsigned_repr_r. rewrite unsigned_repr. auto with ints. - generalize (H a (in_eq _ _)). generalize wordsize_max_unsigned. omega. + generalize (H a (in_eq _ _)). generalize wordsize_max_unsigned. omega. auto with ints. intros; apply H; auto with coqlib. Qed. @@ -3443,7 +3443,7 @@ Lemma translate_eq: Proof. intros. unfold eq. case (zeq (unsigned x) (unsigned y)); intro. unfold add. rewrite e. apply zeq_true. - apply zeq_false. unfold add. red; intro. apply n. + apply zeq_false. unfold add. red; intro. apply n. apply eqm_small_eq; auto with ints. replace (unsigned x) with ((unsigned x + unsigned d) - unsigned d). replace (unsigned y) with ((unsigned y + unsigned d) - unsigned d). @@ -3473,7 +3473,7 @@ Theorem translate_cmpu: Proof. intros. unfold cmpu. rewrite translate_eq. repeat rewrite translate_ltu; auto. -Qed. +Qed. Lemma translate_lt: forall x y d, @@ -3495,13 +3495,13 @@ Theorem translate_cmp: Proof. intros. unfold cmp. rewrite translate_eq. repeat rewrite translate_lt; auto. -Qed. +Qed. Theorem notbool_isfalse_istrue: forall x, is_false x -> is_true (notbool x). Proof. - unfold is_false, is_true, notbool; intros; subst x. - rewrite eq_true. apply one_not_zero. + unfold is_false, is_true, notbool; intros; subst x. + rewrite eq_true. apply one_not_zero. Qed. Theorem notbool_istrue_isfalse: @@ -3527,7 +3527,7 @@ Theorem lt_sub_overflow: forall x y, xor (sub_overflow x y zero) (negative (sub x y)) = if lt x y then one else zero. Proof. - intros. unfold negative, sub_overflow, lt. rewrite sub_signed. + intros. unfold negative, sub_overflow, lt. rewrite sub_signed. rewrite signed_zero. rewrite Zminus_0_r. generalize (signed_range x) (signed_range y). set (X := signed x); set (Y := signed y). intros RX RY. @@ -3540,19 +3540,19 @@ Proof. + unfold proj_sumbool; rewrite zle_true by omega. rewrite signed_repr. rewrite zlt_false by omega. apply xor_idem. unfold min_signed, max_signed; omega. - + unfold proj_sumbool; rewrite zle_false by omega. + + unfold proj_sumbool; rewrite zle_false by omega. replace (signed (repr (X - Y))) with (X - Y - modulus). - rewrite zlt_true by omega. apply xor_idem. - rewrite signed_repr_eq. replace ((X - Y) mod modulus) with (X - Y). - rewrite zlt_false; auto. + rewrite zlt_true by omega. apply xor_idem. + rewrite signed_repr_eq. replace ((X - Y) mod modulus) with (X - Y). + rewrite zlt_false; auto. symmetry. apply Zmod_unique with 0; omega. - unfold proj_sumbool at 2. rewrite zle_true at 1 by omega. rewrite andb_true_r. rewrite (zlt_true _ X) by omega. destruct (zlt (X - Y) (-half_modulus)). - + unfold proj_sumbool; rewrite zle_false by omega. + + unfold proj_sumbool; rewrite zle_false by omega. replace (signed (repr (X - Y))) with (X - Y + modulus). rewrite zlt_false by omega. apply xor_zero. - rewrite signed_repr_eq. replace ((X - Y) mod modulus) with (X - Y + modulus). + rewrite signed_repr_eq. replace ((X - Y) mod modulus) with (X - Y + modulus). rewrite zlt_true by omega; auto. symmetry. apply Zmod_unique with (-1); omega. + unfold proj_sumbool; rewrite zle_true by omega. @@ -3573,8 +3573,8 @@ Lemma no_overlap_sound: unsigned (add base ofs1) + sz1 <= unsigned (add base ofs2) \/ unsigned (add base ofs2) + sz2 <= unsigned (add base ofs1). Proof. - intros. - destruct (andb_prop _ _ H1). clear H1. + intros. + destruct (andb_prop _ _ H1). clear H1. destruct (andb_prop _ _ H2). clear H2. exploit proj_sumbool_true. eexact H1. intro A; clear H1. exploit proj_sumbool_true. eexact H4. intro B; clear H4. @@ -3610,18 +3610,18 @@ Lemma Zsize_shiftin: forall b x, 0 < x -> Zsize (Zshiftin b x) = Zsucc (Zsize x). Proof. intros. destruct x; compute in H; try discriminate. - destruct b. + destruct b. change (Zshiftin true (Zpos p)) with (Zpos (p~1)). - simpl. f_equal. rewrite Pos.add_1_r; auto. + simpl. f_equal. rewrite Pos.add_1_r; auto. change (Zshiftin false (Zpos p)) with (Zpos (p~0)). - simpl. f_equal. rewrite Pos.add_1_r; auto. + simpl. f_equal. rewrite Pos.add_1_r; auto. Qed. Lemma Ztestbit_size_1: forall x, 0 < x -> Z.testbit x (Zpred (Zsize x)) = true. Proof. intros x0 POS0; pattern x0; apply Zshiftin_pos_ind; auto. - intros. rewrite Zsize_shiftin; auto. + intros. rewrite Zsize_shiftin; auto. replace (Z.pred (Z.succ (Zsize x))) with (Z.succ (Z.pred (Zsize x))) by omega. rewrite Ztestbit_shiftin_succ. auto. generalize (Zsize_pos' x H); omega. Qed. @@ -3629,14 +3629,14 @@ Qed. Lemma Ztestbit_size_2: forall x, 0 <= x -> forall i, i >= Zsize x -> Z.testbit x i = false. Proof. - intros x0 POS0. destruct (zeq x0 0). - - subst x0; intros. apply Ztestbit_0. + intros x0 POS0. destruct (zeq x0 0). + - subst x0; intros. apply Ztestbit_0. - pattern x0; apply Zshiftin_pos_ind. - + simpl. intros. change 1 with (Zshiftin true 0). rewrite Ztestbit_shiftin. + + simpl. intros. change 1 with (Zshiftin true 0). rewrite Ztestbit_shiftin. rewrite zeq_false. apply Ztestbit_0. omega. omega. + intros. rewrite Zsize_shiftin in H1; auto. generalize (Zsize_pos' _ H); intros. - rewrite Ztestbit_shiftin. rewrite zeq_false. apply H0. omega. + rewrite Ztestbit_shiftin. rewrite zeq_false. apply H0. omega. omega. omega. + omega. Qed. @@ -3644,25 +3644,25 @@ Qed. Lemma Zsize_interval_1: forall x, 0 <= x -> 0 <= x < two_p (Zsize x). Proof. - intros. + intros. assert (x = x mod (two_p (Zsize x))). apply equal_same_bits; intros. - rewrite Ztestbit_mod_two_p; auto. - destruct (zlt i (Zsize x)). auto. apply Ztestbit_size_2; auto. - apply Zsize_pos; auto. - rewrite H0 at 1. rewrite H0 at 3. apply Z_mod_lt. apply two_p_gt_ZERO. apply Zsize_pos; auto. + rewrite Ztestbit_mod_two_p; auto. + destruct (zlt i (Zsize x)). auto. apply Ztestbit_size_2; auto. + apply Zsize_pos; auto. + rewrite H0 at 1. rewrite H0 at 3. apply Z_mod_lt. apply two_p_gt_ZERO. apply Zsize_pos; auto. Qed. Lemma Zsize_interval_2: forall x n, 0 <= n -> 0 <= x < two_p n -> n >= Zsize x. Proof. - intros. set (N := Z.to_nat n). + intros. set (N := Z.to_nat n). assert (Z.of_nat N = n) by (apply Z2Nat.id; auto). - rewrite <- H1 in H0. rewrite <- two_power_nat_two_p in H0. - destruct (zeq x 0). - subst x; simpl; omega. + rewrite <- H1 in H0. rewrite <- two_power_nat_two_p in H0. + destruct (zeq x 0). + subst x; simpl; omega. destruct (zlt n (Zsize x)); auto. - exploit (Ztestbit_above N x (Zpred (Zsize x))). auto. omega. + exploit (Ztestbit_above N x (Zpred (Zsize x))). auto. omega. rewrite Ztestbit_size_1. congruence. omega. Qed. @@ -3670,15 +3670,15 @@ Lemma Zsize_monotone: forall x y, 0 <= x <= y -> Zsize x <= Zsize y. Proof. intros. apply Zge_le. apply Zsize_interval_2. apply Zsize_pos. - exploit (Zsize_interval_1 y). omega. - omega. + exploit (Zsize_interval_1 y). omega. + omega. Qed. Theorem size_zero: size zero = 0. Proof. unfold size; rewrite unsigned_zero; auto. Qed. - + Theorem bits_size_1: forall x, x = zero \/ testbit x (Zpred (size x)) = true. Proof. @@ -3690,8 +3690,8 @@ Qed. Theorem bits_size_2: forall x i, size x <= i -> testbit x i = false. Proof. - intros. apply Ztestbit_size_2. generalize (unsigned_range x); omega. - fold (size x); omega. + intros. apply Ztestbit_size_2. generalize (unsigned_range x); omega. + fold (size x); omega. Qed. Theorem size_range: @@ -3700,9 +3700,9 @@ Proof. intros; split. apply Zsize_pos. destruct (bits_size_1 x). subst x; unfold size; rewrite unsigned_zero; simpl. generalize wordsize_pos; omega. - destruct (zle (size x) zwordsize); auto. + destruct (zle (size x) zwordsize); auto. rewrite bits_above in H. congruence. omega. -Qed. +Qed. Theorem bits_size_3: forall x n, @@ -3710,10 +3710,10 @@ Theorem bits_size_3: (forall i, n <= i < zwordsize -> testbit x i = false) -> size x <= n. Proof. - intros. destruct (zle (size x) n). auto. - destruct (bits_size_1 x). + intros. destruct (zle (size x) n). auto. + destruct (bits_size_1 x). subst x. unfold size; rewrite unsigned_zero; assumption. - rewrite (H0 (Z.pred (size x))) in H1. congruence. + rewrite (H0 (Z.pred (size x))) in H1. congruence. generalize (size_range x); omega. Qed. @@ -3728,7 +3728,7 @@ Proof. assert (size x <= n). apply bits_size_3; auto. destruct (zlt (size x) n). - rewrite bits_size_2 in H0. congruence. omega. + rewrite bits_size_2 in H0. congruence. omega. omega. Qed. @@ -3747,24 +3747,24 @@ Qed. Theorem size_and: forall a b, size (and a b) <= Z.min (size a) (size b). Proof. - intros. + intros. assert (0 <= Z.min (size a) (size b)). - generalize (size_range a) (size_range b). zify; omega. + generalize (size_range a) (size_range b). zify; omega. apply bits_size_3. auto. intros. - rewrite bits_and. zify. subst z z0. destruct H1. - rewrite (bits_size_2 a). auto. omega. - rewrite (bits_size_2 b). apply andb_false_r. omega. + rewrite bits_and. zify. subst z z0. destruct H1. + rewrite (bits_size_2 a). auto. omega. + rewrite (bits_size_2 b). apply andb_false_r. omega. omega. Qed. Corollary and_interval: forall a b, 0 <= unsigned (and a b) < two_p (Z.min (size a) (size b)). Proof. - intros. - generalize (size_interval_1 (and a b)); intros. + intros. + generalize (size_interval_1 (and a b)); intros. assert (two_p (size (and a b)) <= two_p (Z.min (size a) (size b))). - apply two_p_monotone. split. generalize (size_range (and a b)); omega. - apply size_and. + apply two_p_monotone. split. generalize (size_range (and a b)); omega. + apply size_and. omega. Qed. @@ -3776,42 +3776,42 @@ Proof. subst a. rewrite size_zero. rewrite or_zero_l. zify; omega. destruct (bits_size_1 b). subst b. rewrite size_zero. rewrite or_zero. zify; omega. - zify. destruct H3 as [[P Q] | [P Q]]; subst. - apply bits_size_4. tauto. rewrite bits_or. rewrite H2. apply orb_true_r. - omega. - intros. rewrite bits_or. rewrite !bits_size_2. auto. omega. omega. omega. - apply bits_size_4. tauto. rewrite bits_or. rewrite H1. apply orb_true_l. + zify. destruct H3 as [[P Q] | [P Q]]; subst. + apply bits_size_4. tauto. rewrite bits_or. rewrite H2. apply orb_true_r. + omega. + intros. rewrite bits_or. rewrite !bits_size_2. auto. omega. omega. omega. + apply bits_size_4. tauto. rewrite bits_or. rewrite H1. apply orb_true_l. destruct (zeq (size a) 0). unfold testbit in H1. rewrite Z.testbit_neg_r in H1. - congruence. omega. omega. - intros. rewrite bits_or. rewrite !bits_size_2. auto. omega. omega. omega. + congruence. omega. omega. + intros. rewrite bits_or. rewrite !bits_size_2. auto. omega. omega. omega. Qed. Corollary or_interval: forall a b, 0 <= unsigned (or a b) < two_p (Z.max (size a) (size b)). Proof. - intros. rewrite <- size_or. apply size_interval_1. + intros. rewrite <- size_or. apply size_interval_1. Qed. Theorem size_xor: forall a b, size (xor a b) <= Z.max (size a) (size b). Proof. - intros. + intros. assert (0 <= Z.max (size a) (size b)). - generalize (size_range a) (size_range b). zify; omega. + generalize (size_range a) (size_range b). zify; omega. apply bits_size_3. auto. intros. - rewrite bits_xor. rewrite !bits_size_2. auto. + rewrite bits_xor. rewrite !bits_size_2. auto. + zify; omega. zify; omega. - zify; omega. - omega. + omega. Qed. Corollary xor_interval: forall a b, 0 <= unsigned (xor a b) < two_p (Z.max (size a) (size b)). Proof. - intros. - generalize (size_interval_1 (xor a b)); intros. + intros. + generalize (size_interval_1 (xor a b)); intros. assert (two_p (size (xor a b)) <= two_p (Z.max (size a) (size b))). - apply two_p_monotone. split. generalize (size_range (xor a b)); omega. + apply two_p_monotone. split. generalize (size_range (xor a b)); omega. apply size_xor. omega. Qed. @@ -3837,7 +3837,7 @@ Notation int := Int.int. Remark int_wordsize_divides_modulus: Zdivide (Z_of_nat Int.wordsize) Int.modulus. Proof. - exists (two_p (32-5)); reflexivity. + exists (two_p (32-5)); reflexivity. Qed. Module Wordsize_8. @@ -3883,8 +3883,8 @@ Lemma bits_shl': testbit (shl' x y) i = if zlt i (Int.unsigned y) then false else testbit x (i - Int.unsigned y). Proof. - intros. unfold shl'. rewrite testbit_repr; auto. - destruct (zlt i (Int.unsigned y)). + intros. unfold shl'. rewrite testbit_repr; auto. + destruct (zlt i (Int.unsigned y)). apply Z.shiftl_spec_low. auto. apply Z.shiftl_spec_high. omega. omega. Qed. @@ -3895,11 +3895,11 @@ Lemma bits_shru': testbit (shru' x y) i = if zlt (i + Int.unsigned y) zwordsize then testbit x (i + Int.unsigned y) else false. Proof. - intros. unfold shru'. rewrite testbit_repr; auto. + intros. unfold shru'. rewrite testbit_repr; auto. rewrite Z.shiftr_spec. fold (testbit x (i + Int.unsigned y)). destruct (zlt (i + Int.unsigned y) zwordsize). auto. - apply bits_above; auto. + apply bits_above; auto. omega. Qed. @@ -3909,8 +3909,8 @@ Lemma bits_shr': testbit (shr' x y) i = testbit x (if zlt (i + Int.unsigned y) zwordsize then i + Int.unsigned y else zwordsize - 1). Proof. - intros. unfold shr'. rewrite testbit_repr; auto. - rewrite Z.shiftr_spec. apply bits_signed. + intros. unfold shr'. rewrite testbit_repr; auto. + rewrite Z.shiftr_spec. apply bits_signed. generalize (Int.unsigned_range y); omega. omega. Qed. @@ -3927,7 +3927,7 @@ Definition ofwords (hi lo: Int.int) : int := Lemma bits_loword: forall n i, 0 <= i < Int.zwordsize -> Int.testbit (loword n) i = testbit n i. Proof. - intros. unfold loword. rewrite Int.testbit_repr; auto. + intros. unfold loword. rewrite Int.testbit_repr; auto. Qed. Lemma bits_hiword: @@ -3937,7 +3937,7 @@ Proof. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. fold (testbit (shru n (repr Int.zwordsize)) i). rewrite bits_shru. change (unsigned (repr Int.zwordsize)) with Int.zwordsize. - apply zlt_true. omega. omega. + apply zlt_true. omega. omega. Qed. Lemma bits_ofwords: @@ -3945,53 +3945,53 @@ Lemma bits_ofwords: testbit (ofwords hi lo) i = if zlt i Int.zwordsize then Int.testbit lo i else Int.testbit hi (i - Int.zwordsize). Proof. - intros. unfold ofwords. rewrite bits_or; auto. rewrite bits_shl; auto. - change (unsigned (repr Int.zwordsize)) with Int.zwordsize. + intros. unfold ofwords. rewrite bits_or; auto. rewrite bits_shl; auto. + change (unsigned (repr Int.zwordsize)) with Int.zwordsize. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. destruct (zlt i Int.zwordsize). - rewrite testbit_repr; auto. + rewrite testbit_repr; auto. rewrite !testbit_repr; auto. - fold (Int.testbit lo i). rewrite Int.bits_above. apply orb_false_r. auto. + fold (Int.testbit lo i). rewrite Int.bits_above. apply orb_false_r. auto. omega. Qed. Lemma lo_ofwords: forall hi lo, loword (ofwords hi lo) = lo. Proof. - intros. apply Int.same_bits_eq; intros. - rewrite bits_loword; auto. rewrite bits_ofwords. apply zlt_true. omega. + intros. apply Int.same_bits_eq; intros. + rewrite bits_loword; auto. rewrite bits_ofwords. apply zlt_true. omega. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. omega. Qed. Lemma hi_ofwords: forall hi lo, hiword (ofwords hi lo) = hi. Proof. - intros. apply Int.same_bits_eq; intros. + intros. apply Int.same_bits_eq; intros. rewrite bits_hiword; auto. rewrite bits_ofwords. - rewrite zlt_false. f_equal. omega. omega. + rewrite zlt_false. f_equal. omega. omega. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. omega. Qed. Lemma ofwords_recompose: forall n, ofwords (hiword n) (loword n) = n. Proof. - intros. apply same_bits_eq; intros. rewrite bits_ofwords; auto. - destruct (zlt i Int.zwordsize). - apply bits_loword. omega. - rewrite bits_hiword. f_equal. omega. + intros. apply same_bits_eq; intros. rewrite bits_ofwords; auto. + destruct (zlt i Int.zwordsize). + apply bits_loword. omega. + rewrite bits_hiword. f_equal. omega. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. omega. Qed. Lemma ofwords_add: forall lo hi, ofwords hi lo = repr (Int.unsigned hi * two_p 32 + Int.unsigned lo). Proof. - intros. unfold ofwords. rewrite shifted_or_is_add. - apply eqm_samerepr. apply eqm_add. apply eqm_mult. + intros. unfold ofwords. rewrite shifted_or_is_add. + apply eqm_samerepr. apply eqm_add. apply eqm_mult. apply eqm_sym; apply eqm_unsigned_repr. - apply eqm_refl. + apply eqm_refl. apply eqm_sym; apply eqm_unsigned_repr. change Int.zwordsize with 32; change zwordsize with 64; omega. - rewrite unsigned_repr. generalize (Int.unsigned_range lo). intros [A B]. exact B. + rewrite unsigned_repr. generalize (Int.unsigned_range lo). intros [A B]. exact B. assert (Int.max_unsigned < max_unsigned) by (compute; auto). generalize (Int.unsigned_range_2 lo); omega. Qed. @@ -4000,7 +4000,7 @@ Lemma ofwords_add': forall lo hi, unsigned (ofwords hi lo) = Int.unsigned hi * two_p 32 + Int.unsigned lo. Proof. intros. rewrite ofwords_add. apply unsigned_repr. - generalize (Int.unsigned_range hi) (Int.unsigned_range lo). + generalize (Int.unsigned_range hi) (Int.unsigned_range lo). change (two_p 32) with Int.modulus. change Int.modulus with 4294967296. change max_unsigned with 18446744073709551615. @@ -4011,7 +4011,7 @@ Remark eqm_mul_2p32: forall x y, Int.eqm x y -> eqm (x * two_p 32) (y * two_p 32). Proof. intros. destruct H as [k EQ]. exists k. rewrite EQ. - change Int.modulus with (two_p 32). + change Int.modulus with (two_p 32). change modulus with (two_p 32 * two_p 32). ring. Qed. @@ -4023,7 +4023,7 @@ Proof. replace (repr (Int.unsigned hi * two_p 32 + Int.unsigned lo)) with (repr (Int.signed hi * two_p 32 + Int.unsigned lo)). apply signed_repr. - generalize (Int.signed_range hi) (Int.unsigned_range lo). + generalize (Int.signed_range hi) (Int.unsigned_range lo). change (two_p 32) with Int.modulus. change min_signed with (Int.min_signed * Int.modulus). change max_signed with (Int.max_signed * Int.modulus + Int.modulus - 1). @@ -4074,7 +4074,7 @@ Lemma decompose_not: forall xh xl, not (ofwords xh xl) = ofwords (Int.not xh) (Int.not xl). Proof. - intros. unfold not, Int.not. rewrite <- decompose_xor. f_equal. + intros. unfold not, Int.not. rewrite <- decompose_xor. f_equal. apply (Int64.eq_spec mone (ofwords Int.mone Int.mone)). Qed. @@ -4087,21 +4087,21 @@ Lemma decompose_shl_1: Proof. intros. assert (Int.unsigned (Int.sub Int.iwordsize y) = Int.zwordsize - Int.unsigned y). - { unfold Int.sub. rewrite Int.unsigned_repr. auto. + { unfold Int.sub. rewrite Int.unsigned_repr. auto. rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; omega. } assert (zwordsize = 2 * Int.zwordsize) by reflexivity. apply Int64.same_bits_eq; intros. rewrite bits_shl' by auto. symmetry. rewrite bits_ofwords by auto. - destruct (zlt i Int.zwordsize). rewrite Int.bits_shl by omega. - destruct (zlt i (Int.unsigned y)). auto. + destruct (zlt i Int.zwordsize). rewrite Int.bits_shl by omega. + destruct (zlt i (Int.unsigned y)). auto. rewrite bits_ofwords by omega. rewrite zlt_true by omega. auto. - rewrite zlt_false by omega. rewrite bits_ofwords by omega. - rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega. + rewrite zlt_false by omega. rewrite bits_ofwords by omega. + rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega. rewrite Int.bits_shru by omega. rewrite H0. destruct (zlt (i - Int.unsigned y) (Int.zwordsize)). rewrite zlt_true by omega. rewrite zlt_true by omega. - rewrite orb_false_l. f_equal. omega. - rewrite zlt_false by omega. rewrite zlt_false by omega. + rewrite orb_false_l. f_equal. omega. + rewrite zlt_false by omega. rewrite zlt_false by omega. rewrite orb_false_r. f_equal. omega. Qed. @@ -4114,16 +4114,16 @@ Proof. intros. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. assert (Int.unsigned (Int.sub y Int.iwordsize) = Int.unsigned y - Int.zwordsize). - { unfold Int.sub. rewrite Int.unsigned_repr. auto. + { unfold Int.sub. rewrite Int.unsigned_repr. auto. rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). omega. } apply Int64.same_bits_eq; intros. rewrite bits_shl' by auto. symmetry. rewrite bits_ofwords by auto. destruct (zlt i Int.zwordsize). rewrite zlt_true by omega. apply Int.bits_zero. - rewrite Int.bits_shl by omega. + rewrite Int.bits_shl by omega. destruct (zlt i (Int.unsigned y)). - rewrite zlt_true by omega. auto. - rewrite zlt_false by omega. - rewrite bits_ofwords by omega. rewrite zlt_true by omega. f_equal. omega. + rewrite zlt_true by omega. auto. + rewrite zlt_false by omega. + rewrite bits_ofwords by omega. rewrite zlt_true by omega. f_equal. omega. Qed. Lemma decompose_shru_1: @@ -4135,25 +4135,25 @@ Lemma decompose_shru_1: Proof. intros. assert (Int.unsigned (Int.sub Int.iwordsize y) = Int.zwordsize - Int.unsigned y). - { unfold Int.sub. rewrite Int.unsigned_repr. auto. + { unfold Int.sub. rewrite Int.unsigned_repr. auto. rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; omega. } assert (zwordsize = 2 * Int.zwordsize) by reflexivity. apply Int64.same_bits_eq; intros. rewrite bits_shru' by auto. symmetry. rewrite bits_ofwords by auto. destruct (zlt i Int.zwordsize). - rewrite zlt_true by omega. + rewrite zlt_true by omega. rewrite bits_ofwords by omega. - rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega. + rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega. rewrite Int.bits_shru by omega. rewrite H0. destruct (zlt (i + Int.unsigned y) (Int.zwordsize)). rewrite zlt_true by omega. rewrite orb_false_r. auto. - rewrite zlt_false by omega. + rewrite zlt_false by omega. rewrite orb_false_l. f_equal. omega. - rewrite Int.bits_shru by omega. + rewrite Int.bits_shru by omega. destruct (zlt (i + Int.unsigned y) zwordsize). - rewrite bits_ofwords by omega. - rewrite zlt_true by omega. rewrite zlt_false by omega. f_equal. omega. + rewrite bits_ofwords by omega. + rewrite zlt_true by omega. rewrite zlt_false by omega. f_equal. omega. rewrite zlt_false by omega. auto. Qed. @@ -4166,15 +4166,15 @@ Proof. intros. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. assert (Int.unsigned (Int.sub y Int.iwordsize) = Int.unsigned y - Int.zwordsize). - { unfold Int.sub. rewrite Int.unsigned_repr. auto. + { unfold Int.sub. rewrite Int.unsigned_repr. auto. rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). omega. } apply Int64.same_bits_eq; intros. rewrite bits_shru' by auto. symmetry. rewrite bits_ofwords by auto. destruct (zlt i Int.zwordsize). rewrite Int.bits_shru by omega. rewrite H1. destruct (zlt (i + Int.unsigned y) zwordsize). - rewrite zlt_true by omega. rewrite bits_ofwords by omega. - rewrite zlt_false by omega. f_equal; omega. + rewrite zlt_true by omega. rewrite bits_ofwords by omega. + rewrite zlt_false by omega. f_equal; omega. rewrite zlt_false by omega. auto. rewrite zlt_false by omega. apply Int.bits_zero. Qed. @@ -4188,26 +4188,26 @@ Lemma decompose_shr_1: Proof. intros. assert (Int.unsigned (Int.sub Int.iwordsize y) = Int.zwordsize - Int.unsigned y). - { unfold Int.sub. rewrite Int.unsigned_repr. auto. + { unfold Int.sub. rewrite Int.unsigned_repr. auto. rewrite Int.unsigned_repr_wordsize. generalize Int.wordsize_max_unsigned; omega. } assert (zwordsize = 2 * Int.zwordsize) by reflexivity. apply Int64.same_bits_eq; intros. rewrite bits_shr' by auto. symmetry. rewrite bits_ofwords by auto. destruct (zlt i Int.zwordsize). - rewrite zlt_true by omega. + rewrite zlt_true by omega. rewrite bits_ofwords by omega. - rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega. + rewrite Int.bits_or by omega. rewrite Int.bits_shl by omega. rewrite Int.bits_shru by omega. rewrite H0. destruct (zlt (i + Int.unsigned y) (Int.zwordsize)). rewrite zlt_true by omega. rewrite orb_false_r. auto. - rewrite zlt_false by omega. + rewrite zlt_false by omega. rewrite orb_false_l. f_equal. omega. - rewrite Int.bits_shr by omega. + rewrite Int.bits_shr by omega. destruct (zlt (i + Int.unsigned y) zwordsize). - rewrite bits_ofwords by omega. - rewrite zlt_true by omega. rewrite zlt_false by omega. f_equal. omega. - rewrite zlt_false by omega. rewrite bits_ofwords by omega. + rewrite bits_ofwords by omega. + rewrite zlt_true by omega. rewrite zlt_false by omega. f_equal. omega. + rewrite zlt_false by omega. rewrite bits_ofwords by omega. rewrite zlt_false by omega. f_equal. Qed. @@ -4221,24 +4221,24 @@ Proof. intros. assert (zwordsize = 2 * Int.zwordsize) by reflexivity. assert (Int.unsigned (Int.sub y Int.iwordsize) = Int.unsigned y - Int.zwordsize). - { unfold Int.sub. rewrite Int.unsigned_repr. auto. + { unfold Int.sub. rewrite Int.unsigned_repr. auto. rewrite Int.unsigned_repr_wordsize. generalize (Int.unsigned_range_2 y). omega. } apply Int64.same_bits_eq; intros. rewrite bits_shr' by auto. symmetry. rewrite bits_ofwords by auto. destruct (zlt i Int.zwordsize). rewrite Int.bits_shr by omega. rewrite H1. destruct (zlt (i + Int.unsigned y) zwordsize). - rewrite zlt_true by omega. rewrite bits_ofwords by omega. - rewrite zlt_false by omega. f_equal; omega. - rewrite zlt_false by omega. rewrite bits_ofwords by omega. + rewrite zlt_true by omega. rewrite bits_ofwords by omega. + rewrite zlt_false by omega. f_equal; omega. + rewrite zlt_false by omega. rewrite bits_ofwords by omega. rewrite zlt_false by omega. auto. - rewrite Int.bits_shr by omega. + rewrite Int.bits_shr by omega. change (Int.unsigned (Int.sub Int.iwordsize Int.one)) with (Int.zwordsize - 1). destruct (zlt (i + Int.unsigned y) zwordsize); rewrite bits_ofwords by omega. - symmetry. rewrite zlt_false by omega. f_equal. + symmetry. rewrite zlt_false by omega. f_equal. destruct (zlt (i - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); omega. - symmetry. rewrite zlt_false by omega. f_equal. + symmetry. rewrite zlt_false by omega. f_equal. destruct (zlt (i - Int.zwordsize + (Int.zwordsize - 1)) Int.zwordsize); omega. Qed. @@ -4249,8 +4249,8 @@ Lemma decompose_add: (Int.add xl yl). Proof. intros. symmetry. rewrite ofwords_add. rewrite add_unsigned. - apply eqm_samerepr. - rewrite ! ofwords_add'. rewrite (Int.unsigned_add_carry xl yl). + apply eqm_samerepr. + rewrite ! ofwords_add'. rewrite (Int.unsigned_add_carry xl yl). set (cc := Int.add_carry xl yl Int.zero). set (Xl := Int.unsigned xl); set (Xh := Int.unsigned xh); set (Yl := Int.unsigned yl); set (Yh := Int.unsigned yh). @@ -4264,8 +4264,8 @@ Proof. apply eqm_add. 2: apply eqm_refl. apply eqm_mul_2p32. replace (Xh + Yh) with ((Xh + Yh + Int.unsigned cc) - Int.unsigned cc) by ring. apply Int.eqm_sub. 2: apply Int.eqm_refl. - apply Int.eqm_unsigned_repr_l. apply Int.eqm_add. 2: apply Int.eqm_refl. - apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl. + apply Int.eqm_unsigned_repr_l. apply Int.eqm_add. 2: apply Int.eqm_refl. + apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl. Qed. Lemma decompose_sub: @@ -4275,8 +4275,8 @@ Lemma decompose_sub: (Int.sub xl yl). Proof. intros. symmetry. rewrite ofwords_add. - apply eqm_samerepr. - rewrite ! ofwords_add'. rewrite (Int.unsigned_sub_borrow xl yl). + apply eqm_samerepr. + rewrite ! ofwords_add'. rewrite (Int.unsigned_sub_borrow xl yl). set (bb := Int.sub_borrow xl yl Int.zero). set (Xl := Int.unsigned xl); set (Xh := Int.unsigned xh); set (Yl := Int.unsigned yl); set (Yh := Int.unsigned yh). @@ -4290,8 +4290,8 @@ Proof. apply eqm_add. 2: apply eqm_refl. apply eqm_mul_2p32. replace (Xh - Yh) with ((Xh - Yh - Int.unsigned bb) + Int.unsigned bb) by ring. apply Int.eqm_add. 2: apply Int.eqm_refl. - apply Int.eqm_unsigned_repr_l. apply Int.eqm_add. 2: apply Int.eqm_refl. - apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl. + apply Int.eqm_unsigned_repr_l. apply Int.eqm_add. 2: apply Int.eqm_refl. + apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl. Qed. Lemma decompose_sub': @@ -4300,9 +4300,9 @@ Lemma decompose_sub': ofwords (Int.add (Int.add xh (Int.not yh)) (Int.add_carry xl (Int.not yl) Int.one)) (Int.sub xl yl). Proof. - intros. rewrite decompose_sub. f_equal. + intros. rewrite decompose_sub. f_equal. rewrite Int.sub_borrow_add_carry by auto. - rewrite Int.sub_add_not_3. rewrite Int.xor_assoc. rewrite Int.xor_idem. + rewrite Int.sub_add_not_3. rewrite Int.xor_assoc. rewrite Int.xor_idem. rewrite Int.xor_zero. auto. rewrite Int.xor_zero_l. unfold Int.add_carry. destruct (zlt (Int.unsigned xl + Int.unsigned (Int.not yl) + Int.unsigned Int.one) Int.modulus); @@ -4314,12 +4314,12 @@ Definition mul' (x y: Int.int) : int := repr (Int.unsigned x * Int.unsigned y). Lemma mul'_mulhu: forall x y, mul' x y = ofwords (Int.mulhu x y) (Int.mul x y). Proof. - intros. - rewrite ofwords_add. unfold mul', Int.mulhu, Int.mul. + intros. + rewrite ofwords_add. unfold mul', Int.mulhu, Int.mul. set (p := Int.unsigned x * Int.unsigned y). - set (ph := p / Int.modulus). set (pl := p mod Int.modulus). + set (ph := p / Int.modulus). set (pl := p mod Int.modulus). transitivity (repr (ph * Int.modulus + pl)). -- f_equal. rewrite Zmult_comm. apply Z_div_mod_eq. apply Int.modulus_pos. +- f_equal. rewrite Zmult_comm. apply Z_div_mod_eq. apply Int.modulus_pos. - apply eqm_samerepr. apply eqm_add. apply eqm_mul_2p32. auto with ints. rewrite Int.unsigned_repr_eq. apply eqm_refl. Qed. @@ -4330,7 +4330,7 @@ Lemma decompose_mul: ofwords (Int.add (Int.add (hiword (mul' xl yl)) (Int.mul xl yh)) (Int.mul xh yl)) (loword (mul' xl yl)). Proof. - intros. + intros. set (pl := loword (mul' xl yl)); set (ph := hiword (mul' xl yl)). assert (EQ0: unsigned (mul' xl yl) = Int.unsigned ph * two_p 32 + Int.unsigned pl). { rewrite <- (ofwords_recompose (mul' xl yl)). apply ofwords_add'. } @@ -4339,7 +4339,7 @@ Proof. set (YL := Int.unsigned yl); set (YH := Int.unsigned yh). set (PH := Int.unsigned ph) in *. set (PL := Int.unsigned pl) in *. transitivity (repr (((PH + XL * YH) + XH * YL) * two_p 32 + PL)). - apply eqm_samerepr. apply eqm_add. 2: apply eqm_refl. + apply eqm_samerepr. apply eqm_add. 2: apply eqm_refl. apply eqm_mul_2p32. rewrite Int.add_unsigned. apply Int.eqm_unsigned_repr_l. apply Int.eqm_add. rewrite Int.add_unsigned. apply Int.eqm_unsigned_repr_l. apply Int.eqm_add. @@ -4349,14 +4349,14 @@ Proof. transitivity (repr (unsigned (mul' xl yl) + (XL * YH + XH * YL) * two_p 32)). rewrite EQ0. f_equal. ring. transitivity (repr ((XL * YL + (XL * YH + XH * YL) * two_p 32))). - apply eqm_samerepr. apply eqm_add. 2: apply eqm_refl. + apply eqm_samerepr. apply eqm_add. 2: apply eqm_refl. unfold mul'. apply eqm_unsigned_repr_l. apply eqm_refl. transitivity (repr (0 + (XL * YL + (XL * YH + XH * YL) * two_p 32))). - rewrite Zplus_0_l; auto. + rewrite Zplus_0_l; auto. transitivity (repr (XH * YH * (two_p 32 * two_p 32) + (XL * YL + (XL * YH + XH * YL) * two_p 32))). - apply eqm_samerepr. apply eqm_add. 2: apply eqm_refl. - change (two_p 32 * two_p 32) with modulus. exists (- XH * YH). ring. - f_equal. ring. + apply eqm_samerepr. apply eqm_add. 2: apply eqm_refl. + change (two_p 32 * two_p 32) with modulus. exists (- XH * YH). ring. + f_equal. ring. Qed. Lemma decompose_mul_2: @@ -4365,7 +4365,7 @@ Lemma decompose_mul_2: ofwords (Int.add (Int.add (Int.mulhu xl yl) (Int.mul xl yh)) (Int.mul xh yl)) (Int.mul xl yl). Proof. - intros. rewrite decompose_mul. rewrite mul'_mulhu. + intros. rewrite decompose_mul. rewrite mul'_mulhu. rewrite hi_ofwords, lo_ofwords. auto. Qed. @@ -4375,11 +4375,11 @@ Lemma decompose_ltu: Proof. intros. unfold ltu. rewrite ! ofwords_add'. unfold Int.ltu, Int.eq. destruct (zeq (Int.unsigned xh) (Int.unsigned yh)). - rewrite e. destruct (zlt (Int.unsigned xl) (Int.unsigned yl)). + rewrite e. destruct (zlt (Int.unsigned xl) (Int.unsigned yl)). apply zlt_true; omega. apply zlt_false; omega. - change (two_p 32) with Int.modulus. - generalize (Int.unsigned_range xl) (Int.unsigned_range yl). + change (two_p 32) with Int.modulus. + generalize (Int.unsigned_range xl) (Int.unsigned_range yl). change Int.modulus with 4294967296. intros. destruct (zlt (Int.unsigned xh) (Int.unsigned yh)). apply zlt_true; omega. @@ -4392,9 +4392,9 @@ Lemma decompose_leu: if Int.eq xh yh then negb (Int.ltu yl xl) else Int.ltu xh yh. Proof. intros. rewrite decompose_ltu. rewrite Int.eq_sym. - unfold Int.eq. destruct (zeq (Int.unsigned xh) (Int.unsigned yh)). + unfold Int.eq. destruct (zeq (Int.unsigned xh) (Int.unsigned yh)). auto. - unfold Int.ltu. destruct (zlt (Int.unsigned xh) (Int.unsigned yh)). + unfold Int.ltu. destruct (zlt (Int.unsigned xh) (Int.unsigned yh)). rewrite zlt_false by omega; auto. rewrite zlt_true by omega; auto. Qed. @@ -4403,13 +4403,13 @@ Lemma decompose_lt: forall xh xl yh yl, lt (ofwords xh xl) (ofwords yh yl) = if Int.eq xh yh then Int.ltu xl yl else Int.lt xh yh. Proof. - intros. unfold lt. rewrite ! ofwords_add''. rewrite Int.eq_signed. + intros. unfold lt. rewrite ! ofwords_add''. rewrite Int.eq_signed. destruct (zeq (Int.signed xh) (Int.signed yh)). - rewrite e. unfold Int.ltu. destruct (zlt (Int.unsigned xl) (Int.unsigned yl)). + rewrite e. unfold Int.ltu. destruct (zlt (Int.unsigned xl) (Int.unsigned yl)). apply zlt_true; omega. apply zlt_false; omega. - change (two_p 32) with Int.modulus. - generalize (Int.unsigned_range xl) (Int.unsigned_range yl). + change (two_p 32) with Int.modulus. + generalize (Int.unsigned_range xl) (Int.unsigned_range yl). change Int.modulus with 4294967296. intros. unfold Int.lt. destruct (zlt (Int.signed xh) (Int.signed yh)). apply zlt_true; omega. @@ -4422,9 +4422,9 @@ Lemma decompose_le: if Int.eq xh yh then negb (Int.ltu yl xl) else Int.lt xh yh. Proof. intros. rewrite decompose_lt. rewrite Int.eq_sym. - rewrite Int.eq_signed. destruct (zeq (Int.signed xh) (Int.signed yh)). + rewrite Int.eq_signed. destruct (zeq (Int.signed xh) (Int.signed yh)). auto. - unfold Int.lt. destruct (zlt (Int.signed xh) (Int.signed yh)). + unfold Int.lt. destruct (zlt (Int.signed xh) (Int.signed yh)). rewrite zlt_false by omega; auto. rewrite zlt_true by omega; auto. Qed. @@ -30,18 +30,18 @@ Lemma In_dec: forall x i, {In x i} + {~In x i}. Proof. unfold In; intros. - case (zle (fst i) x); intros. + case (zle (fst i) x); intros. case (zlt x (snd i)); intros. left; auto. - right; intuition. + right; intuition. right; intuition. Qed. -Lemma notin_range: +Lemma notin_range: forall x i, x < fst i \/ x >= snd i -> ~In x i. Proof. - unfold In; intros; omega. + unfold In; intros; omega. Qed. Lemma range_notin: @@ -58,7 +58,7 @@ Definition empty (i: interv) : Prop := fst i >= snd i. Lemma empty_dec: forall i, {empty i} + {~empty i}. Proof. - unfold empty; intros. + unfold empty; intros. case (zle (snd i) (fst i)); intros. left; omega. right; omega. @@ -90,7 +90,7 @@ Definition disjoint (i j: interv) : Prop := Lemma disjoint_sym: forall i j, disjoint i j -> disjoint j i. Proof. - unfold disjoint; intros; red; intros. elim (H x); auto. + unfold disjoint; intros; red; intros. elim (H x); auto. Qed. Lemma empty_disjoint_r: @@ -102,7 +102,7 @@ Qed. Lemma empty_disjoint_l: forall i j, empty i -> disjoint i j. Proof. - intros. apply disjoint_sym. apply empty_disjoint_r; auto. + intros. apply disjoint_sym. apply empty_disjoint_r; auto. Qed. Lemma disjoint_range: @@ -147,12 +147,12 @@ Qed. Lemma disjoint_dec: forall i j, {disjoint i j} + {~disjoint i j}. Proof. - intros. + intros. destruct (empty_dec i). left; apply empty_disjoint_l; auto. destruct (empty_dec j). left; apply empty_disjoint_r; auto. destruct (zle (snd i) (fst j)). left; apply disjoint_range; auto. destruct (zle (snd j) (fst i)). left; apply disjoint_range; auto. - right; red; intro. exploit range_disjoint; eauto. intuition. + right; red; intro. exploit range_disjoint; eauto. intuition. Qed. (** * Shifting an interval by some amount *) @@ -170,7 +170,7 @@ Lemma in_shift_inv: forall x i delta, In x (shift i delta) -> In (x - delta) i. Proof. - unfold shift, In; simpl; intros. omega. + unfold shift, In; simpl; intros. omega. Qed. (** * Enumerating the elements of an interval *) @@ -182,7 +182,7 @@ Variable lo: Z. Function elements_rec (hi: Z) {wf (Zwf lo) hi} : list Z := if zlt lo hi then (hi-1) :: elements_rec (hi-1) else nil. Proof. - intros. red. omega. + intros. red. omega. apply Zwf_well_founded. Qed. @@ -190,11 +190,11 @@ Lemma In_elements_rec: forall hi x, List.In x (elements_rec hi) <-> lo <= x < hi. Proof. - intros. functional induction (elements_rec hi). + intros. functional induction (elements_rec hi). simpl; split; intros. destruct H. clear IHl. omega. rewrite IHl in H. clear IHl. omega. destruct (zeq (hi - 1) x); auto. right. rewrite IHl. clear IHl. omega. - simpl; intuition. + simpl; intuition. Qed. End ELEMENTS. @@ -213,8 +213,8 @@ Lemma elements_in: forall x i, List.In x (elements i) -> In x i. Proof. - unfold elements; intros. - rewrite In_elements_rec in H. auto. + unfold elements; intros. + rewrite In_elements_rec in H. auto. Qed. (** * Checking properties on all elements of an interval *) @@ -241,11 +241,11 @@ Program Fixpoint forall_rec (hi: Z) {wf (Zwf lo) hi}: left _ _ . Next Obligation. - red. omega. + red. omega. Qed. Next Obligation. assert (x = hi - 1 \/ x < hi - 1) by omega. - destruct H2. congruence. auto. + destruct H2. congruence. auto. Qed. Next Obligation. exists wildcard'0; split; auto. omega. @@ -276,7 +276,7 @@ Variable a: A. Function fold_rec (hi: Z) {wf (Zwf lo) hi} : A := if zlt lo hi then f (hi - 1) (fold_rec (hi - 1)) else a. Proof. - intros. red. omega. + intros. red. omega. apply Zwf_well_founded. Qed. @@ -284,9 +284,9 @@ Lemma fold_rec_elements: forall hi, fold_rec hi = List.fold_right f a (elements_rec lo hi). Proof. intros. functional induction (fold_rec hi). - rewrite elements_rec_equation. rewrite zlt_true; auto. - simpl. congruence. - rewrite elements_rec_equation. rewrite zlt_false; auto. + rewrite elements_rec_equation. rewrite zlt_true; auto. + simpl. congruence. + rewrite elements_rec_equation. rewrite zlt_false; auto. Qed. End FOLD. @@ -298,7 +298,7 @@ Lemma fold_elements: forall (A: Type) (f: Z -> A -> A) a i, fold f a i = List.fold_right f a (elements i). Proof. - intros. unfold fold, elements. apply fold_rec_elements. + intros. unfold fold, elements. apply fold_rec_elements. Qed. (** Hints *) @@ -313,4 +313,4 @@ Hint Resolve - + diff --git a/lib/IntvSets.v b/lib/IntvSets.v index 9f1a895f..78c20cc5 100644 --- a/lib/IntvSets.v +++ b/lib/IntvSets.v @@ -55,12 +55,12 @@ Lemma mem_In: Proof. induction 1; simpl. - intuition congruence. -- destruct (zlt x h). +- destruct (zlt x h). + destruct (zle l x); simpl. * tauto. * split; intros. congruence. - exfalso. destruct H0. omega. exploit BELOW; eauto. omega. -+ rewrite IHok. intuition. + exfalso. destruct H0. omega. exploit BELOW; eauto. omega. ++ rewrite IHok. intuition. Qed. Fixpoint contains (L H: Z) (s: t) : bool := @@ -78,9 +78,9 @@ Proof. - destruct (zle h0 h); simpl. destruct (zle l l0); simpl. intuition. - rewrite IHok. intuition. destruct (H3 x); auto. exfalso. + rewrite IHok. intuition. destruct (H3 x); auto. exfalso. destruct (H3 l0). omega. omega. exploit BELOW; eauto. omega. - rewrite IHok. intuition. destruct (H3 x); auto. exfalso. + rewrite IHok. intuition. destruct (H3 x); auto. exfalso. destruct (H3 h). omega. omega. exploit BELOW; eauto. omega. Qed. @@ -102,7 +102,7 @@ Proof. simpl. rewrite IHok. tauto. destruct (zlt h0 l). simpl. tauto. - rewrite IHok. intuition. + rewrite IHok. intuition. assert (l0 <= x < h0 \/ l <= x < h) by xomega. tauto. left; xomega. left; xomega. @@ -115,10 +115,10 @@ Proof. constructor. auto. intros. inv H0. constructor. destruct (zlt h l0). constructor; auto. intros. rewrite In_add in H1; auto. - destruct H1. omega. auto. + destruct H1. omega. auto. destruct (zlt h0 l). - constructor. auto. simpl; intros. destruct H1. omega. exploit BELOW; eauto. omega. - constructor. omega. auto. auto. + constructor. auto. simpl; intros. destruct H1. omega. exploit BELOW; eauto. omega. + constructor. omega. auto. auto. apply IHok. xomega. Qed. @@ -130,7 +130,7 @@ Fixpoint remove (L H: Z) (s: t) {struct s} : t := else if zlt H l then s else if zlt l L then if zlt H h then Cons l L (Cons H h s') else Cons l L (remove L H s') - else + else if zlt H h then Cons H h s' else remove L H s' end. @@ -141,22 +141,22 @@ Proof. induction 1; simpl. tauto. destruct (zlt h l0). - simpl. rewrite IHok. intuition omega. + simpl. rewrite IHok. intuition omega. destruct (zlt h0 l). - simpl. intuition. exploit BELOW; eauto. omega. + simpl. intuition. exploit BELOW; eauto. omega. destruct (zlt l l0). destruct (zlt h0 h); simpl. clear IHok. split. - intros [A | [A | A]]. - split. omega. left; omega. - split. omega. left; omega. + intros [A | [A | A]]. + split. omega. left; omega. + split. omega. left; omega. split. exploit BELOW; eauto. omega. auto. intros [A [B | B]]. - destruct (zlt x l0). left; omega. right; left; omega. + destruct (zlt x l0). left; omega. right; left; omega. auto. - intuition omega. + intuition omega. destruct (zlt h0 h); simpl. intuition. exploit BELOW; eauto. omega. - rewrite IHok. intuition. omegaContradiction. + rewrite IHok. intuition. omegaContradiction. Qed. Lemma remove_ok: @@ -165,14 +165,14 @@ Proof. induction 2; simpl. constructor. destruct (zlt h l0). - constructor; auto. intros; apply BELOW. rewrite In_remove in H1; tauto. + constructor; auto. intros; apply BELOW. rewrite In_remove in H1; tauto. destruct (zlt h0 l). - constructor; auto. + constructor; auto. destruct (zlt l l0). destruct (zlt h0 h). - constructor. omega. intros. inv H1. omega. exploit BELOW; eauto. omega. + constructor. omega. intros. inv H1. omega. exploit BELOW; eauto. omega. constructor. omega. auto. auto. - constructor; auto. intros. rewrite In_remove in H1 by auto. destruct H1. exploit BELOW; eauto. omega. + constructor; auto. intros. rewrite In_remove in H1 by auto. destruct H1. exploit BELOW; eauto. omega. destruct (zlt h0 h). constructor; auto. auto. @@ -204,7 +204,7 @@ Proof. tauto. assert (ok (Cons l0 h0 s0)) by (constructor; auto). destruct (zle h l0). - rewrite IHok; auto. simpl. intuition. omegaContradiction. + rewrite IHok; auto. simpl. intuition. omegaContradiction. exploit BELOW0; eauto. intros. omegaContradiction. destruct (zle h0 l). simpl in IHok0; rewrite IHok0. intuition. omegaContradiction. @@ -212,10 +212,10 @@ Proof. destruct (zle l l0). destruct (zle h0 h). simpl. simpl in IHok0; rewrite IHok0. intuition. - simpl. rewrite IHok; auto. simpl. intuition. exploit BELOW0; eauto. intros; omegaContradiction. + simpl. rewrite IHok; auto. simpl. intuition. exploit BELOW0; eauto. intros; omegaContradiction. destruct (zle h h0). simpl. rewrite IHok; auto. simpl. intuition. - simpl. simpl in IHok0; rewrite IHok0. intuition. + simpl. simpl in IHok0; rewrite IHok0. intuition. exploit BELOW; eauto. intros; omegaContradiction. Qed. @@ -237,8 +237,8 @@ Proof. constructor; auto. intros. assert (In x (inter (Cons l h s) s0)) by exact H3. rewrite In_inter in H4; auto. apply BELOW0. tauto. - constructor. omega. intros. rewrite In_inter in H3; auto. apply BELOW. tauto. - auto. + constructor. omega. intros. rewrite In_inter in H3; auto. apply BELOW. tauto. + auto. destruct (zle h h0). constructor. omega. intros. rewrite In_inter in H3; auto. apply BELOW. tauto. auto. @@ -265,7 +265,7 @@ Proof. split. constructor; auto. tauto. destruct (IHok s0) as [A B]; auto. split. apply add_ok; auto. apply add_ok; auto. - intros. rewrite In_add. rewrite In_add. rewrite <- B. tauto. auto. apply add_ok; auto. + intros. rewrite In_add. rewrite In_add. rewrite <- B. tauto. auto. apply add_ok; auto. Qed. Fixpoint beq (s1 s2: t) : bool := @@ -281,13 +281,13 @@ Lemma beq_spec: Proof. induction 1; destruct 1; simpl. - tauto. -- split; intros. discriminate. exfalso. apply (H0 l). left; omega. - split; intros. discriminate. exfalso. apply (H0 l). left; omega. -- split; intros. -+ InvBooleans. subst. rewrite IHok in H3 by auto. rewrite H3. tauto. -+ destruct (zeq l l0). destruct (zeq h h0). simpl. subst. +- split; intros. discriminate. exfalso. apply (H0 l). left; omega. +- split; intros. ++ InvBooleans. subst. rewrite IHok in H3 by auto. rewrite H3. tauto. ++ destruct (zeq l l0). destruct (zeq h h0). simpl. subst. apply IHok. auto. intros; split; intros. - destruct (proj1 (H1 x)); auto. exfalso. exploit BELOW; eauto. omega. + destruct (proj1 (H1 x)); auto. exfalso. exploit BELOW; eauto. omega. destruct (proj2 (H1 x)); auto. exfalso. exploit BELOW0; eauto. omega. exfalso. subst l0. destruct (zlt h h0). destruct (proj2 (H1 h)). left; omega. omega. exploit BELOW; eauto. omega. @@ -310,7 +310,7 @@ Next Obligation. constructor. Qed. Theorem In_empty: forall x, ~(In x empty). Proof. - unfold In; intros; simpl. tauto. + unfold In; intros; simpl. tauto. Qed. Program Definition interval (l h: Z) : t := @@ -337,16 +337,16 @@ Qed. Theorem In_add: forall x l h s, In x (add l h s) <-> l <= x < h \/ In x s. Proof. - unfold add, In; intros. + unfold add, In; intros. destruct (zlt l h). simpl. apply R.In_add. apply proj2_sig. - intuition. omegaContradiction. + intuition. omegaContradiction. Qed. Program Definition remove (l h: Z) (s: t) : t := if zlt l h then R.remove l h s else s. Next Obligation. - apply R.remove_ok. auto. apply proj2_sig. + apply R.remove_ok. auto. apply proj2_sig. Qed. Theorem In_remove: forall x l h s, In x (remove l h s) <-> ~(l <= x < h) /\ In x s. @@ -362,11 +362,11 @@ Next Obligation. apply R.inter_ok; apply proj2_sig. Qed. Theorem In_inter: forall x s1 s2, In x (inter s1 s2) <-> In x s1 /\ In x s2. Proof. - unfold inter, In; intros; simpl. apply R.In_inter; apply proj2_sig. + unfold inter, In; intros; simpl. apply R.In_inter; apply proj2_sig. Qed. Program Definition union (s1 s2: t) : t := R.union s1 s2. -Next Obligation. +Next Obligation. destruct (R.In_ok_union _ (proj2_sig s1) _ (proj2_sig s2)). auto. Qed. @@ -381,7 +381,7 @@ Program Definition mem (x: Z) (s: t) := R.mem x s. Theorem mem_spec: forall x s, mem x s = true <-> In x s. Proof. - unfold mem, In; intros. apply R.mem_In. apply proj2_sig. + unfold mem, In; intros. apply R.mem_In. apply proj2_sig. Qed. Program Definition contains (l h: Z) (s: t) := @@ -392,7 +392,7 @@ Theorem contains_spec: Proof. unfold contains, In; intros. destruct (zlt l h). apply R.contains_In. auto. apply proj2_sig. - split; intros. omegaContradiction. auto. + split; intros. omegaContradiction. auto. Qed. Program Definition beq (s1 s2: t) : bool := R.beq s1 s2. diff --git a/lib/Iteration.v b/lib/Iteration.v index f3507fe6..4398f96d 100644 --- a/lib/Iteration.v +++ b/lib/Iteration.v @@ -50,7 +50,7 @@ Hypothesis step_decr: forall a a', step a = inr _ a' -> ord a' a. Definition step_info (a: A) : {b | step a = inl _ b} + {a' | step a = inr _ a' & ord a' a}. Proof. - caseEq (step a); intros. left; exists b; auto. right; exists a0; auto. + caseEq (step a); intros. left; exists b; auto. right; exists a0; auto. Defined. Definition iterate_F (a: A) (rec: forall a', ord a' a -> B) : B := @@ -75,10 +75,10 @@ Lemma iterate_prop: forall a, P a -> Q (iterate a). Proof. intros a0. pattern a0. apply well_founded_ind with (R := ord). auto. - intros. unfold iterate; rewrite unroll_Fix. unfold iterate_F. - destruct (step_info x) as [[b U] | [a' U V]]. + intros. unfold iterate; rewrite unroll_Fix. unfold iterate_F. + destruct (step_info x) as [[b U] | [a' U V]]. exploit step_prop; eauto. rewrite U; auto. - apply H. auto. exploit step_prop; eauto. rewrite U; auto. + apply H. auto. exploit step_prop; eauto. rewrite U; auto. Qed. End ITERATION. @@ -105,7 +105,7 @@ End WfIter. Since we know (informally) that our computations terminate, we can take a very large constant as the maximal number of iterations. Failure will therefore never happen in practice, but of - course our proofs also cover the failure case and show that + course our proofs also cover the failure case and show that nothing bad happens in this hypothetical case either. *) Module PrimIter. @@ -169,11 +169,11 @@ Hypothesis step_prop: Lemma iter_prop: forall n a b, P a -> iter n a = Some b -> Q b. Proof. - apply (well_founded_ind Plt_wf + apply (well_founded_ind Plt_wf (fun p => forall a b, P a -> iter p a = Some b -> Q b)). intros. unfold iter in H1. rewrite unroll_Fix in H1. unfold iter_step in H1. destruct (peq x 1). discriminate. - specialize (step_prop a H0). + specialize (step_prop a H0). destruct (step a) as [b'|a'] eqn:?. inv H1. auto. apply H with (Ppred x) a'. apply Ppred_Plt; auto. auto. auto. @@ -222,8 +222,8 @@ Definition F_iter (next: A -> option B) (a: A) : option B := Lemma F_iter_monot: forall f g, F_le f g -> F_le (F_iter f) (F_iter g). Proof. - intros; red; intros. unfold F_iter. - destruct (step a) as [b | a']. red; auto. apply H. + intros; red; intros. unfold F_iter. + destruct (step a) as [b | a']. red; auto. apply H. Qed. Fixpoint iter (n: nat) : A -> option B := @@ -235,9 +235,9 @@ Fixpoint iter (n: nat) : A -> option B := Lemma iter_monot: forall p q, (p <= q)%nat -> F_le (iter p) (iter q). Proof. - induction p; intros. + induction p; intros. simpl. red; intros; red; auto. - destruct q. elimtype False; omega. + destruct q. elimtype False; omega. simpl. apply F_iter_monot. apply IHp. omega. Qed. @@ -249,7 +249,7 @@ Proof. intro a. elim (classic (forall n, iter n a = None)); intro. right; assumption. left. generalize (not_all_ex_not nat (fun n => iter n a = None) H). - intros [n D]. exists n. generalize D. + intros [n D]. exists n. generalize D. case (iter n a); intros. exists b; auto. congruence. Qed. @@ -259,23 +259,23 @@ Definition converges_to (a: A) (b: option B) : Prop := Lemma converges_to_Some: forall a n b, iter n a = Some b -> converges_to a (Some b). Proof. - intros. exists n. intros. + intros. exists n. intros. assert (B_le (iter n a) (iter m a)). apply iter_monot. auto. - elim H1; intro; congruence. + elim H1; intro; congruence. Qed. Lemma converges_to_exists: forall a, exists b, converges_to a b. Proof. - intros. elim (iter_either a). + intros. elim (iter_either a). intros [n [b EQ]]. exists (Some b). apply converges_to_Some with n. assumption. - intro. exists (@None B). exists O. intros. auto. + intro. exists (@None B). exists O. intros. auto. Qed. Lemma converges_to_unique: forall a b, converges_to a b -> forall b', converges_to a b' -> b = b'. Proof. - intros a b [n C] b' [n' C']. + intros a b [n C] b' [n' C']. rewrite <- (C (max n n')). rewrite <- (C' (max n n')). auto. apply le_max_r. apply le_max_l. Qed. @@ -283,7 +283,7 @@ Qed. Lemma converges_to_exists_uniquely: forall a, exists! b, converges_to a b . Proof. - intro. destruct (converges_to_exists a) as [b CT]. + intro. destruct (converges_to_exists a) as [b CT]. exists b. split. assumption. exact (converges_to_unique _ _ CT). Qed. @@ -293,7 +293,7 @@ Definition iterate (a: A) : option B := Lemma converges_to_iterate: forall a b, converges_to a b -> iterate a = b. Proof. - intros. unfold iterate. + intros. unfold iterate. destruct (constructive_definite_description (converges_to a) (converges_to_exists_uniquely a)) as [b' P]. simpl. apply converges_to_unique with a; auto. Qed. @@ -301,7 +301,7 @@ Qed. Lemma iterate_converges_to: forall a, converges_to a (iterate a). Proof. - intros. unfold iterate. + intros. unfold iterate. destruct (constructive_definite_description (converges_to a) (converges_to_exists_uniquely a)) as [b' P]. simpl; auto. Qed. @@ -320,15 +320,15 @@ Lemma iter_prop: Proof. induction n; intros until b; intro H; simpl. congruence. - unfold F_iter. generalize (step_prop a H). - case (step a); intros. congruence. + unfold F_iter. generalize (step_prop a H). + case (step a); intros. congruence. apply IHn with a0; auto. Qed. Lemma iterate_prop: forall a b, iterate a = Some b -> P a -> Q b. Proof. - intros. destruct (iterate_converges_to a) as [n IT]. + intros. destruct (iterate_converges_to a) as [n IT]. rewrite H in IT. apply iter_prop with n a. auto. apply IT. auto. Qed. diff --git a/lib/Lattice.v b/lib/Lattice.v index 5a941a13..352b4479 100644 --- a/lib/Lattice.v +++ b/lib/Lattice.v @@ -27,7 +27,7 @@ Local Unset Case Analysis Schemes. (** * Signatures of semi-lattices *) (** A semi-lattice is a type [t] equipped with an equivalence relation [eq], - a boolean equivalence test [beq], a partial order [ge], a smallest element + a boolean equivalence test [beq], a partial order [ge], a smallest element [bot], and an upper bound operation [lub]. Note that we do not demand that [lub] computes the least upper bound. *) @@ -86,9 +86,9 @@ Lemma gsspec: forall p v x q, L.eq (get q (set p v x)) (if peq q p then v else get q x). Proof. - intros. unfold set, get. + intros. unfold set, get. destruct (L.beq v L.bot) eqn:EBOT. - rewrite PTree.grspec. unfold PTree.elt_eq. destruct (peq q p). + rewrite PTree.grspec. unfold PTree.elt_eq. destruct (peq q p). apply L.eq_sym. apply L.beq_correct; auto. apply L.eq_refl. rewrite PTree.gsspec. destruct (peq q p); apply L.eq_refl. @@ -117,7 +117,7 @@ Definition beq (x y: t) : bool := PTree.beq L.beq x y. Lemma beq_correct: forall x y, beq x y = true -> eq x y. Proof. unfold beq; intros; red; intros. unfold get. - rewrite PTree.beq_correct in H. specialize (H p). + rewrite PTree.beq_correct in H. specialize (H p). destruct (x!p); destruct (y!p); intuition. apply L.beq_correct; auto. apply L.eq_refl. @@ -165,17 +165,17 @@ Definition opt_eq (ox oy: option L.t) : Prop := Lemma opt_eq_refl: forall ox, opt_eq ox ox. Proof. - intros. unfold opt_eq. destruct ox. apply L.eq_refl. auto. + intros. unfold opt_eq. destruct ox. apply L.eq_refl. auto. Qed. Lemma opt_eq_sym: forall ox oy, opt_eq ox oy -> opt_eq oy ox. Proof. - unfold opt_eq. destruct ox; destruct oy; auto. apply L.eq_sym. + unfold opt_eq. destruct ox; destruct oy; auto. apply L.eq_sym. Qed. Lemma opt_eq_trans: forall ox oy oz, opt_eq ox oy -> opt_eq oy oz -> opt_eq ox oz. Proof. - unfold opt_eq. destruct ox; destruct oy; destruct oz; intuition. + unfold opt_eq. destruct ox; destruct oy; destruct oz; intuition. eapply L.eq_trans; eauto. Qed. @@ -189,8 +189,8 @@ Definition opt_beq (ox oy: option L.t) : bool := Lemma opt_beq_correct: forall ox oy, opt_beq ox oy = true -> opt_eq ox oy. Proof. - unfold opt_beq, opt_eq. destruct ox; destruct oy; try congruence. - intros. apply L.beq_correct; auto. + unfold opt_beq, opt_eq. destruct ox; destruct oy; try congruence. + intros. apply L.beq_correct; auto. auto. Qed. @@ -206,7 +206,7 @@ Proof. intros; red; intros; apply opt_eq_sym; auto. Qed. Lemma tree_eq_trans: forall m1 m2 m3, tree_eq m1 m2 -> tree_eq m2 m3 -> tree_eq m1 m3. Proof. intros; red; intros; apply opt_eq_trans with (PTree.get i m2); auto. Qed. -Lemma tree_eq_node: +Lemma tree_eq_node: forall l1 o1 r1 l2 o2 r2, tree_eq l1 l2 -> tree_eq r1 r2 -> opt_eq o1 o2 -> tree_eq (PTree.Node l1 o1 r1) (PTree.Node l2 o2 r2). @@ -214,23 +214,23 @@ Proof. intros; red; intros. destruct i; simpl; auto. Qed. -Lemma tree_eq_node': +Lemma tree_eq_node': forall l1 o1 r1 l2 o2 r2, tree_eq l1 l2 -> tree_eq r1 r2 -> opt_eq o1 o2 -> tree_eq (PTree.Node l1 o1 r1) (PTree.Node' l2 o2 r2). Proof. - intros; red; intros. rewrite PTree.gnode'. apply tree_eq_node; auto. + intros; red; intros. rewrite PTree.gnode'. apply tree_eq_node; auto. Qed. -Lemma tree_eq_node'': +Lemma tree_eq_node'': forall l1 o1 r1 l2 o2 r2, tree_eq l1 l2 -> tree_eq r1 r2 -> opt_eq o1 o2 -> tree_eq (PTree.Node' l1 o1 r1) (PTree.Node' l2 o2 r2). Proof. - intros; red; intros. repeat rewrite PTree.gnode'. apply tree_eq_node; auto. + intros; red; intros. repeat rewrite PTree.gnode'. apply tree_eq_node; auto. Qed. -Hint Resolve opt_beq_correct opt_eq_refl opt_eq_sym +Hint Resolve opt_beq_correct opt_eq_refl opt_eq_sym tree_eq_refl tree_eq_sym tree_eq_node tree_eq_node' tree_eq_node'' : combine. @@ -296,7 +296,7 @@ Inductive changed2 : Type := Fixpoint xcombine (m1 m2 : PTree.t L.t) {struct m1} : changed2 := match m1, m2 with - | PTree.Leaf, PTree.Leaf => + | PTree.Leaf, PTree.Leaf => Same | PTree.Leaf, _ => match combine_r m2 with @@ -333,7 +333,7 @@ Fixpoint xcombine (m1 m2 : PTree.t L.t) {struct m1} : changed2 := end. Lemma xcombine_eq: - forall m1 m2, + forall m1 m2, match xcombine m1 m2 with | Same => tree_eq m1 (PTree.combine f m1 m2) /\ tree_eq m2 (PTree.combine f m1 m2) | Same1 => tree_eq m1 (PTree.combine f m1 m2) @@ -348,7 +348,7 @@ Opaque combine_l combine_r PTree.xcombine_l PTree.xcombine_r. destruct (combine_r (PTree.Node m2_1 o m2_2)); auto. generalize (combine_l_eq (PTree.Node m1_1 o m1_2)). destruct (combine_l (PTree.Node m1_1 o m1_2)); auto. - generalize (IHm1_1 m2_1) (IHm1_2 m2_2). + generalize (IHm1_1 m2_1) (IHm1_2 m2_2). destruct (xcombine m1_1 m2_1); destruct (xcombine m1_2 m2_2); auto with combine; intuition; case_eq (opt_beq (f o o0) o); case_eq (opt_beq (f o o0) o0); auto with combine. @@ -390,7 +390,7 @@ Lemma gcombine_bot: L.eq (get p (combine f t1 t2)) (match f t1!p t2!p with Some x => x | None => L.bot end). Proof. - intros. unfold get. generalize (gcombine f H t1 t2 p). unfold opt_eq. + intros. unfold get. generalize (gcombine f H t1 t2 p). unfold opt_eq. destruct ((combine f t1 t2)!p); destruct (f t1!p t2!p). auto. contradiction. contradiction. intros; apply L.eq_refl. Qed. @@ -398,9 +398,9 @@ Qed. Lemma ge_lub_left: forall x y, ge (lub x y) x. Proof. - unfold ge, lub; intros. + unfold ge, lub; intros. eapply L.ge_trans. apply L.ge_refl. apply gcombine_bot; auto. - unfold get. destruct x!p. destruct y!p. + unfold get. destruct x!p. destruct y!p. apply L.ge_lub_left. apply L.ge_refl. apply L.eq_refl. apply L.ge_bot. @@ -409,9 +409,9 @@ Qed. Lemma ge_lub_right: forall x y, ge (lub x y) y. Proof. - unfold ge, lub; intros. + unfold ge, lub; intros. eapply L.ge_trans. apply L.ge_refl. apply gcombine_bot; auto. - unfold get. destruct y!p. destruct x!p. + unfold get. destruct y!p. destruct x!p. apply L.ge_lub_right. apply L.ge_refl. apply L.eq_refl. apply L.ge_bot. @@ -451,11 +451,11 @@ Lemma gsspec: x <> Bot -> ~L.eq v L.bot -> L.eq (get q (set p v x)) (if peq q p then v else get q x). Proof. - intros. unfold set. destruct x. congruence. - destruct (L.beq v L.bot) eqn:EBOT. + intros. unfold set. destruct x. congruence. + destruct (L.beq v L.bot) eqn:EBOT. elim H0. apply L.beq_correct; auto. destruct (L.beq v L.top) eqn:ETOP; simpl. - rewrite PTree.grspec. unfold PTree.elt_eq. destruct (peq q p). + rewrite PTree.grspec. unfold PTree.elt_eq. destruct (peq q p). apply L.eq_sym. apply L.beq_correct; auto. apply L.eq_refl. rewrite PTree.gsspec. destruct (peq q p); apply L.eq_refl. @@ -561,7 +561,7 @@ Lemma gcombine_top: L.eq (get p (Top_except (LM.combine f t1 t2))) (match f t1!p t2!p with Some x => x | None => L.top end). Proof. - intros. simpl. generalize (LM.gcombine f H t1 t2 p). unfold LM.opt_eq. + intros. simpl. generalize (LM.gcombine f H t1 t2 p). unfold LM.opt_eq. destruct ((LM.combine f t1 t2)!p); destruct (f t1!p t2!p). auto. contradiction. contradiction. intros; apply L.eq_refl. Qed. @@ -574,10 +574,10 @@ Proof. rewrite get_bot. apply L.ge_bot. apply L.ge_refl. apply L.eq_refl. eapply L.ge_trans. apply L.ge_refl. apply gcombine_top; auto. - unfold get. destruct t0!p. destruct t1!p. + unfold get. destruct t0!p. destruct t1!p. unfold opt_lub. destruct (L.beq (L.lub t2 t3) L.top) eqn:E. - apply L.ge_top. apply L.ge_lub_left. - apply L.ge_top. + apply L.ge_top. apply L.ge_lub_left. + apply L.ge_top. apply L.ge_top. Qed. @@ -589,10 +589,10 @@ Proof. apply L.ge_refl. apply L.eq_refl. rewrite get_bot. apply L.ge_bot. eapply L.ge_trans. apply L.ge_refl. apply gcombine_top; auto. - unfold get. destruct t0!p; destruct t1!p. + unfold get. destruct t0!p; destruct t1!p. unfold opt_lub. destruct (L.beq (L.lub t2 t3) L.top) eqn:E. - apply L.ge_top. apply L.ge_lub_right. - apply L.ge_top. + apply L.ge_top. apply L.ge_lub_right. + apply L.ge_top. apply L.ge_top. apply L.ge_top. Qed. @@ -618,7 +618,7 @@ Module LFSet (S: FSetInterface.WS) <: SEMILATTICE. Definition ge (x y: t) := S.Subset y x. Lemma ge_refl: forall x y, eq x y -> ge x y. Proof. - unfold eq, ge, S.Equal, S.Subset; intros. firstorder. + unfold eq, ge, S.Equal, S.Subset; intros. firstorder. Qed. Lemma ge_trans: forall x y z, ge x y -> ge y z -> ge x z. Proof. @@ -635,12 +635,12 @@ Module LFSet (S: FSetInterface.WS) <: SEMILATTICE. Lemma ge_lub_left: forall x y, ge (lub x y) x. Proof. - unfold lub, ge, S.Subset; intros. apply S.union_2; auto. + unfold lub, ge, S.Subset; intros. apply S.union_2; auto. Qed. Lemma ge_lub_right: forall x y, ge (lub x y) y. Proof. - unfold lub, ge, S.Subset; intros. apply S.union_3; auto. + unfold lub, ge, S.Subset; intros. apply S.union_3; auto. Qed. End LFSet. @@ -650,7 +650,7 @@ End LFSet. (** Given a type with decidable equality [X], the following functor returns a semi-lattice structure over [X.t] complemented with a top and a bottom element. The ordering is the flat ordering - [Bot < Inj x < Top]. *) + [Bot < Inj x < Top]. *) Module LFlat(X: EQUALITY_TYPE) <: SEMILATTICE_WITH_TOP. @@ -735,7 +735,7 @@ Proof. Qed. End LFlat. - + (** * Boolean semi-lattice *) (** This semi-lattice has only two elements, [bot] and [top], trivially @@ -126,7 +126,7 @@ Module Type TREE. forall (A: Type) (m: t A) (i: elt) (v: A), In (i, v) (elements m) -> get i m = Some v. Hypothesis elements_keys_norepet: - forall (A: Type) (m: t A), + forall (A: Type) (m: t A), list_norepet (List.map (@fst elt A) (elements m)). Hypothesis elements_extensional: forall (A: Type) (m n: t A), @@ -396,7 +396,7 @@ Module PTree <: TREE. generalize (H xH); simpl; congruence. destruct (andb_prop _ _ H). rewrite IHm1 in H0. rewrite IHm2 in H1. destruct x; simpl; auto. - apply andb_true_intro; split. + apply andb_true_intro; split. apply IHm1. intros; apply (H (xO x)). apply IHm2. intros; apply (H (xI x)). Qed. @@ -414,18 +414,18 @@ Module PTree <: TREE. induction m1; intros. - simpl. rewrite bempty_correct. split; intros. rewrite gleaf. rewrite H. auto. - generalize (H x). rewrite gleaf. destruct (get x m2); tauto. + generalize (H x). rewrite gleaf. destruct (get x m2); tauto. - destruct m2. + unfold beq. rewrite bempty_correct. split; intros. rewrite H. rewrite gleaf. auto. generalize (H x). rewrite gleaf. destruct (get x (Node m1_1 o m1_2)); tauto. + simpl. split; intros. * destruct (andb_prop _ _ H). destruct (andb_prop _ _ H0). - rewrite IHm1_1 in H3. rewrite IHm1_2 in H1. + rewrite IHm1_1 in H3. rewrite IHm1_2 in H1. destruct x; simpl. apply H1. apply H3. destruct o; destruct o0; auto || congruence. * apply andb_true_intro. split. apply andb_true_intro. split. - generalize (H xH); simpl. destruct o; destruct o0; tauto. + generalize (H xH); simpl. destruct o; destruct o0; tauto. apply IHm1_1. intros; apply (H (xO x)). apply IHm1_2. intros; apply (H (xI x)). Qed. @@ -450,7 +450,7 @@ Module PTree <: TREE. intros j. simpl. rewrite IH. reflexivity. intros j. simpl. rewrite IH. reflexivity. Qed. - + Lemma prev_involutive i : prev (prev i) = i. Proof (prev_append_prev i xH). @@ -513,7 +513,7 @@ Module PTree <: TREE. forall (A: Type) (l r: t A) (x: option A) (i: positive), get i (Node' l x r) = get i (Node l x r). Proof. - intros. unfold Node'. + intros. unfold Node'. destruct l; destruct x; destruct r; auto. destruct i; simpl; auto; rewrite gleaf; auto. Qed. @@ -531,9 +531,9 @@ Module PTree <: TREE. get i (filter1 pred m) = match get i m with None => None | Some x => if pred x then Some x else None end. Proof. - intros until m. revert m i. induction m; simpl; intros. + intros until m. revert m i. induction m; simpl; intros. rewrite gleaf; auto. - rewrite gnode'. destruct i; simpl; auto. destruct o; auto. + rewrite gnode'. destruct i; simpl; auto. destruct o; auto. Qed. Section COMBINE. @@ -589,7 +589,7 @@ Module PTree <: TREE. induction m1; intros; simpl. rewrite gleaf. apply xgcombine_r. destruct m2; simpl. - rewrite gleaf. rewrite <- xgcombine_l. auto. + rewrite gleaf. rewrite <- xgcombine_l. auto. repeat rewrite gnode'. destruct i; simpl; auto. Qed. @@ -622,10 +622,10 @@ Module PTree <: TREE. auto. rewrite IHm1_1. rewrite IHm1_2. - auto. + auto. Qed. - Fixpoint xelements (A : Type) (m : t A) (i : positive) + Fixpoint xelements (A : Type) (m : t A) (i : positive) (k: list (positive * A)) {struct m} : list (positive * A) := match m with @@ -651,7 +651,7 @@ Module PTree <: TREE. Remark xelements_leaf: forall A i, xelements (@Leaf A) i nil = nil. Proof. - intros; reflexivity. + intros; reflexivity. Qed. Remark xelements_node: @@ -685,8 +685,8 @@ Module PTree <: TREE. apply xelements_incl. right. auto. auto. inv H. apply xelements_incl. left. reflexivity. - apply xelements_incl. auto. - auto. + apply xelements_incl. auto. + auto. inv H. Qed. @@ -694,7 +694,7 @@ Module PTree <: TREE. forall (A: Type) (m: t A) (i: positive) (v: A), get i m = Some v -> In (i, v) (elements m). Proof. - intros A m i v H. + intros A m i v H. generalize (xelements_correct m i xH nil H). rewrite prev_append_prev. exact id. Qed. @@ -703,11 +703,11 @@ Module PTree <: TREE. In (k, v) (xelements m i nil) -> exists j, k = prev (prev_append j i) /\ get j m = Some v. Proof. - induction m; intros. + induction m; intros. - rewrite xelements_leaf in H. contradiction. - rewrite xelements_node in H. rewrite ! in_app_iff in H. destruct H as [P | [P | P]]. + exploit IHm1; eauto. intros (j & Q & R). exists (xO j); auto. - + destruct o; simpl in P; intuition auto. inv H. exists xH; auto. + + destruct o; simpl in P; intuition auto. inv H. exists xH; auto. + exploit IHm2; eauto. intros (j & Q & R). exists (xI j); auto. Qed. @@ -715,8 +715,8 @@ Module PTree <: TREE. forall (A: Type) (m: t A) (i: positive) (v: A), In (i, v) (elements m) -> get i m = Some v. Proof. - unfold elements. intros A m i v H. exploit in_xelements; eauto. intros (j & P & Q). - rewrite prev_append_prev in P. change i with (prev_append 1 i) in P. + unfold elements. intros A m i v H. exploit in_xelements; eauto. intros (j & P & Q). + rewrite prev_append_prev in P. change i with (prev_append 1 i) in P. exploit prev_append_inj; eauto. intros; congruence. Qed. @@ -726,7 +726,7 @@ Module PTree <: TREE. Remark xkeys_leaf: forall A i, xkeys (@Leaf A) i = nil. Proof. - intros; reflexivity. + intros; reflexivity. Qed. Remark xkeys_node: @@ -736,7 +736,7 @@ Module PTree <: TREE. ++ match o with None => nil | Some v => prev i :: nil end ++ xkeys m2 (xI i). Proof. - intros. unfold xkeys. rewrite xelements_node. rewrite ! map_app. destruct o; auto. + intros. unfold xkeys. rewrite xelements_node. rewrite ! map_app. destruct o; auto. Qed. Lemma in_xkeys: @@ -746,7 +746,7 @@ Module PTree <: TREE. Proof. unfold xkeys; intros. apply (list_in_map_inv) in H. destruct H as ((j, v) & -> & H). - exploit in_xelements; eauto. intros (k & P & Q). exists k; auto. + exploit in_xelements; eauto. intros (k & P & Q). exists k; auto. Qed. Lemma xelements_keys_norepet: @@ -756,26 +756,26 @@ Module PTree <: TREE. induction m; intros. - rewrite xkeys_leaf; constructor. - assert (NOTIN1: ~ In (prev i) (xkeys m1 (xO i))). - { red; intros. exploit in_xkeys; eauto. intros (j & EQ). + { red; intros. exploit in_xkeys; eauto. intros (j & EQ). rewrite prev_append_prev in EQ. simpl in EQ. apply prev_append_inj in EQ. discriminate. } assert (NOTIN2: ~ In (prev i) (xkeys m2 (xI i))). - { red; intros. exploit in_xkeys; eauto. intros (j & EQ). + { red; intros. exploit in_xkeys; eauto. intros (j & EQ). rewrite prev_append_prev in EQ. simpl in EQ. apply prev_append_inj in EQ. discriminate. } assert (DISJ: forall x, In x (xkeys m1 (xO i)) -> In x (xkeys m2 (xI i)) -> False). - { intros. exploit in_xkeys. eexact H. intros (j1 & EQ1). - exploit in_xkeys. eexact H0. intros (j2 & EQ2). + { intros. exploit in_xkeys. eexact H. intros (j1 & EQ1). + exploit in_xkeys. eexact H0. intros (j2 & EQ2). rewrite prev_append_prev in *. simpl in *. rewrite EQ2 in EQ1. apply prev_append_inj in EQ1. discriminate. } - rewrite xkeys_node. apply list_norepet_append. auto. + rewrite xkeys_node. apply list_norepet_append. auto. destruct o; simpl; auto. constructor; auto. - red; intros. red; intros; subst y. destruct o; simpl in H0. - destruct H0. subst x. tauto. eauto. eauto. + red; intros. red; intros; subst y. destruct o; simpl in H0. + destruct H0. subst x. tauto. eauto. eauto. Qed. Theorem elements_keys_norepet: - forall (A: Type) (m: t A), + forall (A: Type) (m: t A), list_norepet (List.map (@fst elt A) (elements m)). Proof. - intros. apply (xelements_keys_norepet m xH). + intros. apply (xelements_keys_norepet m xH). Qed. Remark xelements_empty: @@ -783,7 +783,7 @@ Module PTree <: TREE. Proof. induction m; intros. auto. - rewrite xelements_node. rewrite IHm1, IHm2. destruct o; auto. + rewrite xelements_node. rewrite IHm1, IHm2. destruct o; auto. generalize (H xH); simpl; congruence. intros. apply (H (xI i0)). intros. apply (H (xO i0)). @@ -806,29 +806,29 @@ Module PTree <: TREE. (xelements m j nil) (xelements n j nil)). { induction m; intros. - - rewrite xelements_leaf. rewrite xelements_empty. constructor. - intros. destruct (get i n) eqn:E; auto. exploit H0; eauto. + - rewrite xelements_leaf. rewrite xelements_empty. constructor. + intros. destruct (get i n) eqn:E; auto. exploit H0; eauto. intros [x [P Q]]. rewrite gleaf in P; congruence. - - destruct n as [ | n1 o' n2 ]. + - destruct n as [ | n1 o' n2 ]. + rewrite xelements_leaf, xelements_empty. constructor. - intros. destruct (get i (Node m1 o m2)) eqn:E; auto. exploit H; eauto. + intros. destruct (get i (Node m1 o m2)) eqn:E; auto. exploit H; eauto. intros [x [P Q]]. rewrite gleaf in P; congruence. + rewrite ! xelements_node. apply list_forall2_app. - apply IHm1. - intros. apply (H (xO i) x); auto. + apply IHm1. + intros. apply (H (xO i) x); auto. intros. apply (H0 (xO i) y); auto. - apply list_forall2_app. + apply list_forall2_app. destruct o, o'. - destruct (H xH a) as [x [P Q]]. auto. simpl in P. inv P. + destruct (H xH a) as [x [P Q]]. auto. simpl in P. inv P. constructor. auto. constructor. destruct (H xH a) as [x [P Q]]. auto. simpl in P. inv P. destruct (H0 xH b) as [x [P Q]]. auto. simpl in P. inv P. constructor. - apply IHm2. - intros. apply (H (xI i) x); auto. + apply IHm2. + intros. apply (H (xI i) x); auto. intros. apply (H0 (xI i) y); auto. } - intros. apply H with (j := xH); auto. + intros. apply H with (j := xH); auto. Qed. Theorem elements_extensional: @@ -836,8 +836,8 @@ Module PTree <: TREE. (forall i, get i m = get i n) -> elements m = elements n. Proof. - intros. - exploit (elements_canonical_order (fun (x y: A) => x = y) m n). + intros. + exploit (elements_canonical_order (fun (x y: A) => x = y) m n). intros. rewrite H in H0. exists x; auto. intros. rewrite <- H in H0. exists y; auto. induction 1. auto. destruct a1 as [a2 a3]; destruct b1 as [b2 b3]; simpl in *. @@ -862,8 +862,8 @@ Module PTree <: TREE. { destruct i; simpl remove. destruct m1; auto. destruct o; auto. destruct (remove i m2); auto. - destruct o; auto. destruct m2; auto. destruct (remove i m1); auto. - destruct m1; auto. destruct m2; auto. + destruct o; auto. destruct m2; auto. destruct (remove i m1); auto. + destruct m1; auto. destruct m2; auto. } rewrite REMOVE. destruct i; simpl in H. + destruct (IHm2 i (xI j) H) as (l1 & l2 & EQ & EQ'). @@ -883,7 +883,7 @@ Module PTree <: TREE. rewrite xelements_node, EQ', ! app_ass. auto. + subst o. exists (xelements m1 (xO j) nil); exists (xelements m2 (xI j) nil); split. rewrite xelements_node. rewrite prev_append_prev. auto. - rewrite xelements_node; auto. + rewrite xelements_node; auto. Qed. Theorem elements_remove: @@ -891,8 +891,8 @@ Module PTree <: TREE. get i m = Some v -> exists l1 l2, elements m = l1 ++ (i,v) :: l2 /\ elements (remove i m) = l1 ++ l2. Proof. - intros. exploit xelements_remove. eauto. instantiate (1 := xH). - rewrite prev_append_prev. auto. + intros. exploit xelements_remove. eauto. instantiate (1 := xH). + rewrite prev_append_prev. auto. Qed. Fixpoint xfold (A B: Type) (f: B -> positive -> A -> B) @@ -920,7 +920,7 @@ Module PTree <: TREE. simpl. auto. destruct o; simpl. rewrite <- IHm1. simpl. rewrite <- IHm2. auto. - rewrite <- IHm1. rewrite <- IHm2. auto. + rewrite <- IHm1. rewrite <- IHm2. auto. Qed. Theorem fold_spec: @@ -928,7 +928,7 @@ Module PTree <: TREE. fold f m v = List.fold_left (fun a p => f a (fst p) (snd p)) (elements m) v. Proof. - intros. unfold fold, elements. rewrite <- xfold_xelements. auto. + intros. unfold fold, elements. rewrite <- xfold_xelements. auto. Qed. Fixpoint fold1 (A B: Type) (f: B -> A -> B) (m: t A) (v: B) {struct m} : B := @@ -952,7 +952,7 @@ Module PTree <: TREE. simpl. auto. destruct o; simpl. rewrite <- IHm1. simpl. rewrite <- IHm2. auto. - rewrite <- IHm1. rewrite <- IHm2. auto. + rewrite <- IHm1. rewrite <- IHm2. auto. Qed. Theorem fold1_spec: @@ -960,7 +960,7 @@ Module PTree <: TREE. fold1 f m v = List.fold_left (fun a p => f a (snd p)) (elements m) v. Proof. - intros. apply fold1_xelements with (l := @nil (positive * A)). + intros. apply fold1_xelements with (l := @nil (positive * A)). Qed. End PTree. @@ -1064,7 +1064,7 @@ Module IMap(X: INDEXED_TYPE). Lemma gi: forall (A: Type) (x: A) (i: X.t), get i (init x) = x. Proof. - intros. unfold get, init. apply PMap.gi. + intros. unfold get, init. apply PMap.gi. Qed. Lemma gss: @@ -1077,19 +1077,19 @@ Module IMap(X: INDEXED_TYPE). forall (A: Type) (i j: X.t) (x: A) (m: t A), i <> j -> get i (set j x m) = get i m. Proof. - intros. unfold get, set. apply PMap.gso. - red. intro. apply H. apply X.index_inj; auto. + intros. unfold get, set. apply PMap.gso. + red. intro. apply H. apply X.index_inj; auto. Qed. Lemma gsspec: forall (A: Type) (i j: X.t) (x: A) (m: t A), get i (set j x m) = if X.eq i j then x else get i m. Proof. - intros. unfold get, set. + intros. unfold get, set. rewrite PMap.gsspec. case (X.eq i j); intro. subst j. rewrite peq_true. reflexivity. - rewrite peq_false. reflexivity. + rewrite peq_false. reflexivity. red; intro. elim n. apply X.index_inj; auto. Qed. @@ -1097,7 +1097,7 @@ Module IMap(X: INDEXED_TYPE). forall (A B: Type) (f: A -> B) (i: X.t) (m: t A), get i (map f m) = f(get i m). Proof. - intros. unfold map, get. apply PMap.gmap. + intros. unfold map, get. apply PMap.gmap. Qed. Lemma set2: @@ -1225,7 +1225,7 @@ Hypothesis P_compat: (forall x, T.get x m = T.get x m') -> P m a -> P m' a. -Hypothesis H_base: +Hypothesis H_base: P (T.empty _) init. Hypothesis H_rec: @@ -1253,23 +1253,23 @@ Remark H_rec': P' l a -> P' (l ++ (k, v) :: nil) (f a k v). Proof. - unfold P'; intros. - set (m0 := T.remove k m). + unfold P'; intros. + set (m0 := T.remove k m). apply P_compat with (T.set k v m0). intros. unfold m0. rewrite T.gsspec. destruct (T.elt_eq x k). symmetry. apply T.elements_complete. rewrite <- (H2 (x, v)). apply in_or_app. simpl. intuition congruence. apply T.gro. auto. - apply H_rec. unfold m0. apply T.grs. apply T.elements_complete. auto. - apply H1. red. intros [k' v']. - split; intros. - apply T.elements_correct. unfold m0. rewrite T.gro. apply T.elements_complete. - rewrite <- (H2 (k', v')). apply in_or_app. auto. + apply H_rec. unfold m0. apply T.grs. apply T.elements_complete. auto. + apply H1. red. intros [k' v']. + split; intros. + apply T.elements_correct. unfold m0. rewrite T.gro. apply T.elements_complete. + rewrite <- (H2 (k', v')). apply in_or_app. auto. red; intro; subst k'. elim H. change k with (fst (k, v')). apply in_map. auto. assert (T.get k' m0 = Some v'). apply T.elements_complete. auto. unfold m0 in H4. rewrite T.grspec in H4. destruct (T.elt_eq k' k). congruence. assert (In (k', v') (T.elements m)). apply T.elements_correct; auto. - rewrite <- (H2 (k', v')) in H5. destruct (in_app_or _ _ _ H5). auto. + rewrite <- (H2 (k', v')) in H5. destruct (in_app_or _ _ _ H5). auto. simpl in H6. intuition congruence. Qed. @@ -1282,10 +1282,10 @@ Lemma fold_rec_aux: Proof. induction l1; intros; simpl. rewrite <- List.app_nil_end. auto. - destruct a as [k v]; simpl in *. inv H1. + destruct a as [k v]; simpl in *. inv H1. change ((k, v) :: l1) with (((k, v) :: nil) ++ l1). rewrite <- List.app_ass. apply IHl1. rewrite app_ass. auto. - red; intros. rewrite map_app in H3. destruct (in_app_or _ _ _ H3). apply H0; auto with coqlib. + red; intros. rewrite map_app in H3. destruct (in_app_or _ _ _ H3). apply H0; auto with coqlib. simpl in H4. intuition congruence. auto. unfold f'. simpl. apply H_rec'; auto. eapply list_disjoint_notin; eauto with coqlib. @@ -1300,8 +1300,8 @@ Proof. apply fold_rec_aux. simpl. red; intros; tauto. simpl. red; intros. elim H0. - apply T.elements_keys_norepet. - apply H_base'. + apply T.elements_keys_norepet. + apply H_base'. simpl in H. red in H. apply H. red; intros. tauto. Qed. @@ -1319,18 +1319,18 @@ Theorem cardinal_remove: forall x m y, T.get x m = Some y -> (cardinal (T.remove x m) < cardinal m)%nat. Proof. unfold cardinal; intros. - exploit T.elements_remove; eauto. intros (l1 & l2 & P & Q). + exploit T.elements_remove; eauto. intros (l1 & l2 & P & Q). rewrite P, Q. rewrite ! app_length. simpl. omega. Qed. Theorem cardinal_set: forall x m y, T.get x m = None -> (cardinal m < cardinal (T.set x y m))%nat. Proof. - intros. set (m' := T.set x y m). - replace (cardinal m) with (cardinal (T.remove x m')). - apply cardinal_remove with y. unfold m'; apply T.gss. - unfold cardinal. f_equal. apply T.elements_extensional. - intros. unfold m'. rewrite T.grspec, T.gsspec. + intros. set (m' := T.set x y m). + replace (cardinal m) with (cardinal (T.remove x m')). + apply cardinal_remove with y. unfold m'; apply T.gss. + unfold cardinal. f_equal. apply T.elements_extensional. + intros. unfold m'. rewrite T.grspec, T.gsspec. destruct (T.elt_eq i x); auto. congruence. Qed. @@ -1352,16 +1352,16 @@ Proof. intros m0 f. unfold for_all. apply fold_rec; intros. - (* Extensionality *) - rewrite H0. split; intros. rewrite <- H in H2; auto. rewrite H in H2; auto. + rewrite H0. split; intros. rewrite <- H in H2; auto. rewrite H in H2; auto. - (* Base case *) split; intros. rewrite T.gempty in H0; congruence. auto. - (* Inductive case *) split; intros. - destruct (andb_prop _ _ H2). rewrite T.gsspec in H3. destruct (T.elt_eq x k). + destruct (andb_prop _ _ H2). rewrite T.gsspec in H3. destruct (T.elt_eq x k). inv H3. auto. apply H1; auto. - apply andb_true_intro. split. - rewrite H1. intros. apply H2. rewrite T.gso; auto. congruence. + apply andb_true_intro. split. + rewrite H1. intros. apply H2. rewrite T.gso; auto. congruence. apply H2. apply T.gss. Qed. @@ -1375,7 +1375,7 @@ Proof. intros m0 f. unfold exists_. apply fold_rec; intros. - (* Extensionality *) - rewrite H0. split; intros (x0 & a0 & P & Q); exists x0; exists a0; split; auto; congruence. + rewrite H0. split; intros (x0 & a0 & P & Q); exists x0; exists a0; split; auto; congruence. - (* Base case *) split; intros. congruence. destruct H as (x & a & P & Q). rewrite T.gempty in P; congruence. - (* Inductive case *) @@ -1383,7 +1383,7 @@ Proof. destruct (orb_true_elim _ _ H2). rewrite H1 in e. destruct e as (x1 & a1 & P & Q). exists x1; exists a1; split; auto. rewrite T.gso; auto. congruence. - exists k; exists v; split; auto. apply T.gss. + exists k; exists v; split; auto. apply T.gss. destruct H2 as (x1 & a1 & P & Q). apply orb_true_intro. rewrite T.gsspec in P. destruct (T.elt_eq x1 k). inv P. right; auto. @@ -1394,11 +1394,11 @@ Remark exists_for_all: forall m f, exists_ m f = negb (for_all m (fun x a => negb (f x a))). Proof. - intros. unfold exists_, for_all. rewrite ! T.fold_spec. - change false with (negb true). generalize (T.elements m) true. + intros. unfold exists_, for_all. rewrite ! T.fold_spec. + change false with (negb true). generalize (T.elements m) true. induction l; simpl; intros. auto. - rewrite <- IHl. f_equal. + rewrite <- IHl. f_equal. destruct b; destruct (f (fst a) (snd a)); reflexivity. Qed. @@ -1406,11 +1406,11 @@ Remark for_all_exists: forall m f, for_all m f = negb (exists_ m (fun x a => negb (f x a))). Proof. - intros. unfold exists_, for_all. rewrite ! T.fold_spec. - change true with (negb false). generalize (T.elements m) false. + intros. unfold exists_, for_all. rewrite ! T.fold_spec. + change true with (negb false). generalize (T.elements m) false. induction l; simpl; intros. auto. - rewrite <- IHl. f_equal. + rewrite <- IHl. f_equal. destruct b; destruct (f (fst a) (snd a)); reflexivity. Qed. @@ -1418,20 +1418,20 @@ Lemma for_all_false: forall m f, for_all m f = false <-> (exists x a, T.get x m = Some a /\ f x a = false). Proof. - intros. rewrite for_all_exists. - rewrite negb_false_iff. rewrite exists_correct. - split; intros (x & a & P & Q); exists x; exists a; split; auto. + intros. rewrite for_all_exists. + rewrite negb_false_iff. rewrite exists_correct. + split; intros (x & a & P & Q); exists x; exists a; split; auto. rewrite negb_true_iff in Q. auto. - rewrite Q; auto. + rewrite Q; auto. Qed. Lemma exists_false: forall m f, exists_ m f = false <-> (forall x a, T.get x m = Some a -> f x a = false). Proof. - intros. rewrite exists_for_all. + intros. rewrite exists_for_all. rewrite negb_false_iff. rewrite for_all_correct. - split; intros. apply H in H0. rewrite negb_true_iff in H0. auto. rewrite H; auto. + split; intros. apply H in H0. rewrite negb_true_iff in H0. auto. rewrite H; auto. Qed. End FORALL_EXISTS. @@ -1457,20 +1457,20 @@ Proof. set (p1 := fun x a1 => match T.get x m2 with None => false | Some a2 => beqA a1 a2 end). set (p2 := fun x a2 => match T.get x m1 with None => false | Some a1 => beqA a1 a2 end). destruct (for_all m1 p1) eqn:F1; [destruct (for_all m2 p2) eqn:F2 | idtac]. - + cut (T.beq beqA m1 m2 = true). congruence. - rewrite for_all_correct in *. rewrite T.beq_correct; intros. - destruct (T.get x m1) as [a1|] eqn:X1. + + cut (T.beq beqA m1 m2 = true). congruence. + rewrite for_all_correct in *. rewrite T.beq_correct; intros. + destruct (T.get x m1) as [a1|] eqn:X1. generalize (F1 _ _ X1). unfold p1. destruct (T.get x m2); congruence. destruct (T.get x m2) as [a2|] eqn:X2; auto. - generalize (F2 _ _ X2). unfold p2. rewrite X1. congruence. + generalize (F2 _ _ X2). unfold p2. rewrite X1. congruence. + rewrite for_all_false in F2. destruct F2 as (x & a & P & Q). - exists x. rewrite P. unfold p2 in Q. destruct (T.get x m1); auto. + exists x. rewrite P. unfold p2 in Q. destruct (T.get x m1); auto. + rewrite for_all_false in F1. destruct F1 as (x & a & P & Q). exists x. rewrite P. unfold p1 in Q. destruct (T.get x m2); auto. - (* existence -> beq = false *) destruct H as [x P]. - destruct (T.beq beqA m1 m2) eqn:E; auto. - rewrite T.beq_correct in E. + destruct (T.beq beqA m1 m2) eqn:E; auto. + rewrite T.beq_correct in E. generalize (E x). destruct (T.get x m1); destruct (T.get x m2); tauto || congruence. Qed. @@ -1493,7 +1493,7 @@ Definition Equal (m1 m2: T.t A) : Prop := Lemma Equal_refl: forall m, Equal m m. Proof. - intros; red; intros. destruct (T.get x m); auto. reflexivity. + intros; red; intros. destruct (T.get x m); auto. reflexivity. Qed. Lemma Equal_sym: forall m1 m2, Equal m1 m2 -> Equal m2 m1. @@ -1505,7 +1505,7 @@ Lemma Equal_trans: forall m1 m2 m3, Equal m1 m2 -> Equal m2 m3 -> Equal m1 m3. Proof. intros; red; intros. generalize (H x) (H0 x). destruct (T.get x m1); destruct (T.get x m2); try tauto; - destruct (T.get x m3); try tauto. + destruct (T.get x m3); try tauto. intros. transitivity a0; auto. Qed. @@ -1525,15 +1525,15 @@ Program Definition Equal_dec (m1 m2: T.t A) : { m1 === m2 } + { m1 =/= m2 } := Next Obligation. rename Heq_anonymous into B. symmetry in B. rewrite T.beq_correct in B. - red; intros. generalize (B x). - destruct (T.get x m1); destruct (T.get x m2); auto. - intros. eapply proj_sumbool_true; eauto. + red; intros. generalize (B x). + destruct (T.get x m1); destruct (T.get x m2); auto. + intros. eapply proj_sumbool_true; eauto. Qed. Next Obligation. assert (T.beq (fun a1 a2 => proj_sumbool (a1 == a2)) m1 m2 = true). - apply T.beq_correct; intros. - generalize (H x). - destruct (T.get x m1); destruct (T.get x m2); try tauto. + apply T.beq_correct; intros. + generalize (H x). + destruct (T.get x m1); destruct (T.get x m2); try tauto. intros. apply proj_sumbool_is_true; auto. unfold equiv, complement in H0. congruence. Qed. diff --git a/lib/Ordered.v b/lib/Ordered.v index 5d02586d..a2c36673 100644 --- a/lib/Ordered.v +++ b/lib/Ordered.v @@ -31,7 +31,7 @@ Definition eq (x y: t) := x = y. Definition lt := Plt. Lemma eq_refl : forall x : t, eq x x. -Proof (@refl_equal t). +Proof (@refl_equal t). Lemma eq_sym : forall x y : t, eq x y -> eq y x. Proof (@sym_equal t). Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. @@ -61,7 +61,7 @@ Definition eq (x y: t) := x = y. Definition lt := Zlt. Lemma eq_refl : forall x : t, eq x x. -Proof (@refl_equal t). +Proof (@refl_equal t). Lemma eq_sym : forall x y : t, eq x y -> eq y x. Proof (@sym_equal t). Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. @@ -69,7 +69,7 @@ Proof (@trans_equal t). Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof Zlt_trans. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. -Proof. unfold lt, eq, t; intros. omega. Qed. +Proof. unfold lt, eq, t; intros. omega. Qed. Lemma compare : forall x y : t, Compare lt eq x y. Proof. intros. destruct (Z.compare x y) as [] eqn:E. @@ -91,7 +91,7 @@ Definition eq (x y: t) := x = y. Definition lt (x y: t) := Int.unsigned x < Int.unsigned y. Lemma eq_refl : forall x : t, eq x x. -Proof (@refl_equal t). +Proof (@refl_equal t). Lemma eq_sym : forall x y : t, eq x y -> eq y x. Proof (@sym_equal t). Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. @@ -129,7 +129,7 @@ Definition eq (x y: t) := x = y. Definition lt (x y: t) := Plt (A.index x) (A.index y). Lemma eq_refl : forall x : t, eq x x. -Proof (@refl_equal t). +Proof (@refl_equal t). Lemma eq_sym : forall x y : t, eq x y -> eq y x. Proof (@sym_equal t). Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. @@ -149,7 +149,7 @@ Qed. Lemma compare : forall x y : t, Compare lt eq x y. Proof. intros. case (OrderedPositive.compare (A.index x) (A.index y)); intro. - apply LT. exact l. + apply LT. exact l. apply EQ. red; red in e. apply A.index_inj; auto. apply GT. exact l. Defined. @@ -158,7 +158,7 @@ Lemma eq_dec : forall x y, { eq x y } + { ~ eq x y }. Proof. intros. case (peq (A.index x) (A.index y)); intros. left. apply A.index_inj; auto. - right; red; unfold eq; intros; subst. congruence. + right; red; unfold eq; intros; subst. congruence. Defined. End OrderedIndexed. @@ -211,7 +211,7 @@ Proof. case (A.compare (fst x) (fst z)); intro. assumption. generalize (A.lt_not_eq H1); intro. elim H5. - apply A.eq_trans with (fst x). + apply A.eq_trans with (fst x). apply A.eq_sym. auto. auto. generalize (@A.lt_not_eq (fst y) (fst x)); intro. elim H5. apply A.lt_trans with (fst z); auto. @@ -231,7 +231,7 @@ Proof. elim H3; intros. apply (@B.lt_not_eq _ _ H5 H2). Qed. - + Lemma compare : forall x y : t, Compare lt eq x y. Proof. intros. diff --git a/lib/Parmov.v b/lib/Parmov.v index f96a692e..92bba559 100644 --- a/lib/Parmov.v +++ b/lib/Parmov.v @@ -61,7 +61,7 @@ Section PARMOV. (** * Registers, moves, and their semantics *) -(** The development is parameterized by the type of registers, +(** The development is parameterized by the type of registers, equipped with a decidable equality. *) Variable reg: Type. @@ -102,7 +102,7 @@ Lemma env_ext: (forall r, e1 r = e2 r) -> e1 = e2. Proof (@extensionality reg val). -(** The main operation over environments is update: it assigns +(** The main operation over environments is update: it assigns a value [v] to a register [r] and preserves the values of other registers. *) @@ -132,7 +132,7 @@ Lemma update_commut: r1 <> r2 -> update r1 v1 (update r2 v2 e) = update r2 v2 (update r1 v1 e). Proof. - intros. apply env_ext; intro; unfold update. + intros. apply env_ext; intro; unfold update. destruct (reg_eq r r1); destruct (reg_eq r r2); auto. congruence. Qed. @@ -174,7 +174,7 @@ Fixpoint exec_seq (m: moves) (e: env) {struct m}: env := Fixpoint exec_seq_rev (m: moves) (e: env) {struct m}: env := match m with | nil => e - | (s, d) :: m' => + | (s, d) :: m' => let e' := exec_seq_rev m' e in update d (e' s) e' end. @@ -274,7 +274,7 @@ Inductive state_wf: state -> Prop := Lemma dests_append: forall m1 m2, dests (m1 ++ m2) = dests m1 ++ dests m2. Proof. - intros. unfold dests. apply map_app. + intros. unfold dests. apply map_app. Qed. Lemma dests_decomp: @@ -286,7 +286,7 @@ Qed. Lemma srcs_append: forall m1 m2, srcs (m1 ++ m2) = srcs m1 ++ srcs m2. Proof. - intros. unfold srcs. apply map_app. + intros. unfold srcs. apply map_app. Qed. Lemma srcs_decomp: @@ -317,7 +317,7 @@ Lemma dests_disjoint_sym: forall m1 m2, dests_disjoint m1 m2 <-> dests_disjoint m2 m1. Proof. - unfold dests_disjoint; intros. + unfold dests_disjoint; intros. split; intros; apply list_disjoint_sym; auto. Qed. @@ -326,9 +326,9 @@ Lemma dests_disjoint_cons_left: dests_disjoint ((s, d) :: m1) m2 <-> dests_disjoint m1 m2 /\ ~In d (dests m2). Proof. - unfold dests_disjoint, list_disjoint. + unfold dests_disjoint, list_disjoint. simpl; intros; split; intros. - split. auto. firstorder. + split. auto. firstorder. destruct H. elim H0; intro. red; intro; subst. contradiction. apply H; auto. @@ -339,7 +339,7 @@ Lemma dests_disjoint_cons_right: dests_disjoint m1 ((s, d) :: m2) <-> dests_disjoint m1 m2 /\ ~In d (dests m1). Proof. - intros. rewrite dests_disjoint_sym. rewrite dests_disjoint_cons_left. + intros. rewrite dests_disjoint_sym. rewrite dests_disjoint_cons_left. rewrite dests_disjoint_sym. tauto. Qed. @@ -348,11 +348,11 @@ Lemma dests_disjoint_append_left: dests_disjoint (m1 ++ m2) m3 <-> dests_disjoint m1 m3 /\ dests_disjoint m2 m3. Proof. - unfold dests_disjoint, list_disjoint. + unfold dests_disjoint, list_disjoint. intros; split; intros. split; intros. apply H; eauto. rewrite dests_append. apply in_or_app. auto. apply H; eauto. rewrite dests_append. apply in_or_app. auto. - destruct H. + destruct H. rewrite dests_append in H0. elim (in_app_or _ _ _ H0); auto. Qed. @@ -361,7 +361,7 @@ Lemma dests_disjoint_append_right: dests_disjoint m1 (m2 ++ m3) <-> dests_disjoint m1 m2 /\ dests_disjoint m1 m3. Proof. - intros. rewrite dests_disjoint_sym. rewrite dests_disjoint_append_left. + intros. rewrite dests_disjoint_sym. rewrite dests_disjoint_append_left. intuition; rewrite dests_disjoint_sym; assumption. Qed. @@ -371,7 +371,7 @@ Lemma is_mill_cons: is_mill m /\ ~In d (dests m). Proof. unfold is_mill, dests_disjoint; intros. simpl. - split; intros. + split; intros. inversion H; tauto. constructor; tauto. Qed. @@ -381,7 +381,7 @@ Lemma is_mill_append: is_mill (m1 ++ m2) <-> is_mill m1 /\ is_mill m2 /\ dests_disjoint m1 m2. Proof. - unfold is_mill, dests_disjoint; intros. rewrite dests_append. + unfold is_mill, dests_disjoint; intros. rewrite dests_append. apply list_norepet_app. Qed. @@ -391,7 +391,7 @@ Lemma move_no_temp_append: forall m1 m2, move_no_temp m1 -> move_no_temp m2 -> move_no_temp (m1 ++ m2). Proof. - intros; red; intros. elim (in_app_or _ _ _ H1); intro. + intros; red; intros. elim (in_app_or _ _ _ H1); intro. apply H; auto. apply H0; auto. Qed. @@ -418,12 +418,12 @@ Lemma temp_last_push: is_not_temp s1 -> is_not_temp d1 -> temp_last ((s1, d1) :: (s2, d2) :: sigma). Proof. - unfold temp_last; intros. simpl. simpl in H. + unfold temp_last; intros. simpl. simpl in H. destruct (rev sigma); simpl in *. - intuition. red; simpl; intros. - elim H; intros. inversion H4. subst; tauto. tauto. - destruct p as [sN dN]. intuition. - red; intros. elim (in_app_or _ _ _ H); intros. + intuition. red; simpl; intros. + elim H; intros. inversion H4. subst; tauto. tauto. + destruct p as [sN dN]. intuition. + red; intros. elim (in_app_or _ _ _ H); intros. apply H3; auto. elim H4; intros. inversion H5; subst; tauto. elim H5. Qed. @@ -433,12 +433,12 @@ Lemma temp_last_pop: temp_last ((s1, d1) :: sigma ++ (s2, d2) :: nil) -> temp_last (sigma ++ (s2, d2) :: nil). Proof. - intros until d2. + intros until d2. change ((s1, d1) :: sigma ++ (s2, d2) :: nil) with ((((s1, d1) :: nil) ++ sigma) ++ ((s2, d2) :: nil)). - unfold temp_last. repeat rewrite rev_unit. - intuition. simpl in H1. red; intros. apply H1. - apply in_or_app. auto. + unfold temp_last. repeat rewrite rev_unit. + intuition. simpl in H1. red; intros. apply H1. + apply in_or_app. auto. Qed. (** Some properties of [is_path]. *) @@ -458,7 +458,7 @@ Proof. induction sigma; simpl; intros. constructor. red; auto. constructor. inversion H; subst; clear H. - constructor. + constructor. destruct sigma as [ | [s1 d1] sigma']; simpl; simpl in H2; auto. auto. Qed. @@ -471,12 +471,12 @@ Lemma path_sources_dests: Proof. induction sigma; simpl; intros. red; simpl; tauto. - inversion H; subst; clear H. simpl. + inversion H; subst; clear H. simpl. assert (In s (dests (sigma ++ (s0, d0) :: nil))). - destruct sigma as [ | [s1 d1] sigma']; simpl; simpl in H2; intuition. - apply incl_cons. simpl; tauto. + destruct sigma as [ | [s1 d1] sigma']; simpl; simpl in H2; intuition. + apply incl_cons. simpl; tauto. apply incl_tran with (s0 :: dests (sigma ++ (s0, d0) :: nil)). - eapply IHsigma; eauto. + eapply IHsigma; eauto. red; simpl; tauto. Qed. @@ -484,11 +484,11 @@ Lemma no_read_path: forall d1 sigma s0 d0, d1 <> s0 -> is_path (sigma ++ (s0, d0) :: nil) -> - ~In d1 (dests (sigma ++ (s0, d0) :: nil)) -> + ~In d1 (dests (sigma ++ (s0, d0) :: nil)) -> no_read (sigma ++ (s0, d0) :: nil) d1. Proof. intros. - generalize (path_sources_dests _ _ _ H0). intro. + generalize (path_sources_dests _ _ _ H0). intro. intro. elim H1. elim (H2 _ H3); intro. congruence. auto. Qed. @@ -499,7 +499,7 @@ Lemma notin_dests_cons: forall x s d m, ~In x (dests ((s, d) :: m)) <-> x <> d /\ ~In x (dests m). Proof. - intros. simpl. intuition auto. + intros. simpl. intuition auto. Qed. Lemma notin_dests_append: @@ -509,7 +509,7 @@ Proof. intros. rewrite dests_append. rewrite in_app. tauto. Qed. -Hint Rewrite is_mill_cons is_mill_append +Hint Rewrite is_mill_cons is_mill_append dests_disjoint_cons_left dests_disjoint_cons_right dests_disjoint_append_left dests_disjoint_append_right notin_dests_cons notin_dests_append: pmov. @@ -525,29 +525,29 @@ Proof. autorewrite with pmov in A; constructor; autorewrite with pmov. (* Nop *) - tauto. + tauto. red; intros. apply B. apply list_in_insert; auto. auto. auto. (* Start *) tauto. red; intros. apply B. apply list_in_insert; auto. - red. simpl. split. elim (B s d). auto. - apply in_or_app. right. apply in_eq. + red. simpl. split. elim (B s d). auto. + apply in_or_app. right. apply in_eq. red; simpl; tauto. - constructor. exact I. constructor. + constructor. exact I. constructor. (* Push *) intuition. red; intros. apply B. apply list_in_insert; auto. - elim (B d r). apply temp_last_push; auto. + elim (B d r). apply temp_last_push; auto. apply in_or_app; right; apply in_eq. constructor. simpl. auto. auto. (* Loop *) - tauto. + tauto. auto. - eapply temp_last_change_last_source; eauto. + eapply temp_last_change_last_source; eauto. eapply is_path_change_last_source; eauto. (* Pop *) @@ -557,7 +557,7 @@ Proof. eapply is_path_pop; eauto. (* Last *) - intuition. + intuition. auto. unfold temp_last. simpl. auto. constructor. @@ -577,7 +577,7 @@ Qed. reverse sequential order, then the moves [mu ++ sigma] in parallel. *) Definition statemove (st: state) (e: env) := - match st with + match st with | State mu sigma tau => exec_par (mu ++ sigma) (exec_seq_rev tau e) end. @@ -589,7 +589,7 @@ Lemma exec_par_outside: forall m e r, ~In r (dests m) -> exec_par m e r = e r. Proof. induction m; simpl; intros. auto. - destruct a as [s d]. rewrite update_o. apply IHm. tauto. + destruct a as [s d]. rewrite update_o. apply IHm. tauto. simpl in H. intuition. Qed. @@ -600,8 +600,8 @@ Lemma exec_par_lift: Proof. induction m1; simpl; intros. auto. - destruct a as [s0 d0]. simpl in H. rewrite IHm1. simpl. - apply update_commut. tauto. tauto. + destruct a as [s0 d0]. simpl in H. rewrite IHm1. simpl. + apply update_commut. tauto. tauto. Qed. Lemma exec_par_ident: @@ -609,9 +609,9 @@ Lemma exec_par_ident: is_mill (m1 ++ (r, r) :: m2) -> exec_par (m1 ++ (r, r) :: m2) e = exec_par (m1 ++ m2) e. Proof. - intros. autorewrite with pmov in H. - rewrite exec_par_lift. simpl. - replace (e r) with (exec_par (m1 ++ m2) e r). apply update_ident. + intros. autorewrite with pmov in H. + rewrite exec_par_lift. simpl. + replace (e r) with (exec_par (m1 ++ m2) e r). apply update_ident. apply exec_par_outside. autorewrite with pmov. tauto. tauto. Qed. @@ -619,7 +619,7 @@ Lemma exec_seq_app: forall m1 m2 e, exec_seq (m1 ++ m2) e = exec_seq m2 (exec_seq m1 e). Proof. - induction m1; simpl; intros. auto. + induction m1; simpl; intros. auto. destruct a as [s d]. rewrite IHm1. auto. Qed. @@ -627,7 +627,7 @@ Lemma exec_seq_rev_app: forall m1 m2 e, exec_seq_rev (m1 ++ m2) e = exec_seq_rev m1 (exec_seq_rev m2 e). Proof. - induction m1; simpl; intros. auto. + induction m1; simpl; intros. auto. destruct a as [s d]. rewrite IHm1. auto. Qed. @@ -657,8 +657,8 @@ Lemma exec_par_update_no_read: Proof. unfold no_read; induction m; simpl; intros. auto. - destruct a as [s0 d0]; simpl in *. rewrite IHm. - rewrite update_commut. f_equal. f_equal. + destruct a as [s0 d0]; simpl in *. rewrite IHm. + rewrite update_commut. f_equal. f_equal. apply update_o. tauto. tauto. tauto. tauto. Qed. @@ -682,14 +682,14 @@ Lemma exec_par_combine: Proof. induction sl; destruct dl; simpl; intros; try discriminate. split; auto. - inversion H0; subst; clear H0. + inversion H0; subst; clear H0. injection H; intro; clear H. destruct (IHsl dl H0 H4) as [A B]. set (e' := exec_par (combine sl dl) e) in *. split. - decEq. apply update_s. + decEq. apply update_s. rewrite <- A. apply list_map_exten; intros. - rewrite update_o. auto. congruence. + rewrite update_o. auto. congruence. intros. rewrite update_o. apply B. tauto. intuition. Qed. @@ -733,10 +733,10 @@ Lemma exec_par_env_equiv: Proof. unfold move_no_temp; induction m; simpl; intros. auto. - destruct a as [s d]. + destruct a as [s d]. red; intros. unfold update. destruct (reg_eq r d). - apply H0. elim (H s d); tauto. - apply IHm; auto. + apply H0. elim (H s d); tauto. + apply IHm; auto. Qed. (** The proof that transitions preserve semantics (up to the values of @@ -750,57 +750,57 @@ Proof. induction 1; intro WF; inversion WF as [mu0 sigma0 tau0 A B C D]; subst; simpl. (* nop *) - apply env_equiv_refl'. unfold statemove. - repeat rewrite app_ass. simpl. symmetry. apply exec_par_ident. - rewrite app_ass in A. exact A. + apply env_equiv_refl'. unfold statemove. + repeat rewrite app_ass. simpl. symmetry. apply exec_par_ident. + rewrite app_ass in A. exact A. (* start *) - apply env_equiv_refl'. unfold statemove. - autorewrite with pmov in A. + apply env_equiv_refl'. unfold statemove. + autorewrite with pmov in A. rewrite exec_par_lift. repeat rewrite app_ass. simpl. rewrite exec_par_lift. reflexivity. - tauto. autorewrite with pmov. tauto. + tauto. autorewrite with pmov. tauto. (* push *) - apply env_equiv_refl'. unfold statemove. + apply env_equiv_refl'. unfold statemove. autorewrite with pmov in A. rewrite exec_par_lift. rewrite exec_par_lift. simpl. - rewrite exec_par_lift. repeat rewrite app_ass. simpl. rewrite exec_par_lift. - simpl. apply update_commut. intuition. - tauto. autorewrite with pmov; tauto. - autorewrite with pmov; intuition. + rewrite exec_par_lift. repeat rewrite app_ass. simpl. rewrite exec_par_lift. + simpl. apply update_commut. intuition. + tauto. autorewrite with pmov; tauto. + autorewrite with pmov; intuition. autorewrite with pmov; intuition. (* loop *) - unfold statemove. simpl exec_seq_rev. - set (e1 := exec_seq_rev tau e). + unfold statemove. simpl exec_seq_rev. + set (e1 := exec_seq_rev tau e). autorewrite with pmov in A. - repeat rewrite <- app_ass. - assert (~In d (dests (mu ++ sigma))). autorewrite with pmov. tauto. - repeat rewrite exec_par_lift; auto. simpl. + repeat rewrite <- app_ass. + assert (~In d (dests (mu ++ sigma))). autorewrite with pmov. tauto. + repeat rewrite exec_par_lift; auto. simpl. repeat rewrite <- app_nil_end. assert (move_no_temp (mu ++ sigma)). - red in C. rewrite rev_unit in C. destruct C. + red in C. rewrite rev_unit in C. destruct C. apply move_no_temp_append; auto. apply move_no_temp_rev; auto. set (e2 := update (temp s) (e1 s) e1). set (e3 := exec_par (mu ++ sigma) e1). set (e4 := exec_par (mu ++ sigma) e2). assert (env_equiv e2 e1). - unfold e2; red; intros. apply update_o. apply H1. + unfold e2; red; intros. apply update_o. apply H1. assert (env_equiv e4 e3). unfold e4, e3. apply exec_par_env_equiv; auto. - red; intros. unfold update. destruct (reg_eq r d). + red; intros. unfold update. destruct (reg_eq r d). unfold e2. apply update_s. apply H2. auto. (* pop *) - apply env_equiv_refl'. unfold statemove. simpl exec_seq_rev. + apply env_equiv_refl'. unfold statemove. simpl exec_seq_rev. set (e1 := exec_seq_rev tau e). autorewrite with pmov in A. - apply exec_par_append_eq. simpl. - apply exec_par_update_no_read. - apply no_read_path; auto. eapply is_path_pop; eauto. + apply exec_par_append_eq. simpl. + apply exec_par_update_no_read. + apply no_read_path; auto. eapply is_path_pop; eauto. autorewrite with pmov; tauto. autorewrite with pmov; tauto. - intros. apply update_o. red; intro; subst r. elim (H H1). + intros. apply update_o. red; intro; subst r. elim (H H1). (* last *) apply env_equiv_refl'. unfold statemove. simpl exec_seq_rev. @@ -814,9 +814,9 @@ Lemma transitions_preserve_semantics: transitions st st' -> state_wf st -> env_equiv (statemove st' e) (statemove st e). Proof. - induction 1; intros. + induction 1; intros. eapply transition_preserves_semantics; eauto. - apply env_equiv_refl. + apply env_equiv_refl. apply env_equiv_trans with (statemove y e); auto. apply IHclos_refl_trans2. eapply transitions_preserve_wf; eauto. Qed. @@ -828,10 +828,10 @@ Lemma state_wf_start: state_wf (State mu nil nil). Proof. intros. constructor. rewrite <- app_nil_end. auto. - auto. + auto. red. simpl. auto. constructor. -Qed. +Qed. (** The main correctness result in this section is the following: if we can transition repeatedly from an initial state [mu, nil, nil] @@ -846,10 +846,10 @@ Theorem transitions_correctness: transitions (State mu nil nil) (State nil nil tau) -> forall e, env_equiv (exec_seq (List.rev tau) e) (exec_par mu e). Proof. - intros. + intros. generalize (transitions_preserve_semantics _ _ e H1 (state_wf_start _ H H0)). - unfold statemove. simpl. rewrite <- app_nil_end. + unfold statemove. simpl. rewrite <- app_nil_end. rewrite exec_seq_exec_seq_rev. auto. Qed. @@ -897,23 +897,23 @@ Lemma transition_determ: transitions st st'. Proof. induction 1; intro; unfold transitions. - apply rt_step. exact (tr_nop nil r mu nil tau). - apply rt_step. exact (tr_start nil s d mu tau). - apply rt_step. apply tr_push. + apply rt_step. exact (tr_nop nil r mu nil tau). + apply rt_step. exact (tr_start nil s d mu tau). + apply rt_step. apply tr_push. eapply rt_trans. - apply rt_step. + apply rt_step. change ((s, r0) :: sigma ++ (r0, d) :: nil) with (((s, r0) :: sigma) ++ (r0, d) :: nil). - apply tr_loop. - apply rt_step. simpl. apply tr_pop. auto. - inv H0. generalize H6. + apply tr_loop. + apply rt_step. simpl. apply tr_pop. auto. + inv H0. generalize H6. change ((s, r0) :: sigma ++ (r0, d) :: nil) with (((s, r0) :: sigma) ++ (r0, d) :: nil). unfold temp_last; rewrite List.rev_unit. intros [E F]. - elim (F s r0). unfold is_not_temp. auto. + elim (F s r0). unfold is_not_temp. auto. rewrite <- List.In_rev. apply in_eq. - apply rt_step. apply tr_pop. auto. auto. - apply rt_step. apply tr_last. auto. + apply rt_step. apply tr_pop. auto. auto. + apply rt_step. apply tr_last. auto. Qed. Lemma transitions_determ: @@ -939,9 +939,9 @@ Theorem dtransitions_correctness: dtransitions (State mu nil nil) (State nil nil tau) -> forall e, env_equiv (exec_seq (List.rev tau) e) (exec_par mu e). Proof. - intros. + intros. eapply transitions_correctness; eauto. - apply transitions_determ. auto. apply state_wf_start; auto. + apply transitions_determ. auto. apply state_wf_start; auto. Qed. (** * The compilation function *) @@ -1017,10 +1017,10 @@ Lemma split_move_charact: Proof. unfold no_read. induction m; simpl; intros. - tauto. -- destruct a as [s d]. destruct (reg_eq s r). +- destruct a as [s d]. destruct (reg_eq s r). + subst s. auto. + specialize (IHm r). destruct (split_move m r) as [[[before d'] after] | ]. - * destruct IHm. subst m. simpl. intuition. + * destruct IHm. subst m. simpl. intuition. * simpl; intuition. Qed. @@ -1030,11 +1030,11 @@ Lemma is_last_source_charact: then s = r else s <> r. Proof. - induction m; simpl. + induction m; simpl. destruct (reg_eq s r); congruence. destruct a as [s0 d0]. case_eq (m ++ (s, d) :: nil); intros. generalize (app_cons_not_nil m nil (s, d)). congruence. - rewrite <- H. auto. + rewrite <- H. auto. Qed. Lemma replace_last_source_charact: @@ -1055,24 +1055,24 @@ Lemma parmove_step_compatible: dtransition st (parmove_step st). Proof. intros st NOTFINAL. destruct st as [mu sigma tau]. unfold parmove_step. - case_eq mu; [intros MEQ | intros [ms md] mtl MEQ]. - case_eq sigma; [intros SEQ | intros [ss sd] stl SEQ]. - subst mu sigma. simpl in NOTFINAL. discriminate. - simpl. + case_eq mu; [intros MEQ | intros [ms md] mtl MEQ]. + case_eq sigma; [intros SEQ | intros [ss sd] stl SEQ]. + subst mu sigma. simpl in NOTFINAL. discriminate. + simpl. case_eq stl; [intros STLEQ | intros xx1 xx2 STLEQ]. apply dtr_last. red; simpl; auto. - elim (@exists_last _ stl). 2:congruence. intros sigma1 [[ss1 sd1] SEQ2]. - rewrite <- STLEQ. clear STLEQ xx1 xx2. - generalize (is_last_source_charact sd ss1 sd1 sigma1). + elim (@exists_last _ stl). 2:congruence. intros sigma1 [[ss1 sd1] SEQ2]. + rewrite <- STLEQ. clear STLEQ xx1 xx2. + generalize (is_last_source_charact sd ss1 sd1 sigma1). rewrite SEQ2. destruct (is_last_source sd (sigma1 ++ (ss1, sd1) :: nil)). - intro. subst ss1. - rewrite replace_last_source_charact. apply dtr_loop_pop. + intro. subst ss1. + rewrite replace_last_source_charact. apply dtr_loop_pop. red; simpl; auto. - intro. apply dtr_pop. red; simpl; auto. auto. + intro. apply dtr_pop. red; simpl; auto. auto. - case_eq sigma; [intros SEQ | intros [ss sd] stl SEQ]. - destruct (reg_eq ms md). - subst. apply dtr_nop. + case_eq sigma; [intros SEQ | intros [ss sd] stl SEQ]. + destruct (reg_eq ms md). + subst. apply dtr_nop. apply dtr_start. auto. generalize (split_move_charact ((ms, md) :: mtl) sd). @@ -1082,9 +1082,9 @@ Proof. intro NOREAD. case_eq stl; [intros STLEQ | intros xx1 xx2 STLEQ]. apply dtr_last. auto. - elim (@exists_last _ stl). 2:congruence. intros sigma1 [[ss1 sd1] SEQ2]. - rewrite <- STLEQ. clear STLEQ xx1 xx2. - generalize (is_last_source_charact sd ss1 sd1 sigma1). + elim (@exists_last _ stl). 2:congruence. intros sigma1 [[ss1 sd1] SEQ2]. + rewrite <- STLEQ. clear STLEQ xx1 xx2. + generalize (is_last_source_charact sd ss1 sd1 sigma1). rewrite SEQ2. destruct (is_last_source sd (sigma1 ++ (ss1, sd1) :: nil)). intro. subst ss1. rewrite replace_last_source_charact. apply dtr_loop_pop. auto. @@ -1120,7 +1120,7 @@ Qed. (** Compilation function for parallel moves. *) Function parmove_aux (st: state) {measure measure st} : moves := - if final_state st + if final_state st then match st with State _ _ tau => tau end else parmove_aux (parmove_step st). Proof. @@ -1134,7 +1134,7 @@ Proof. unfold dtransitions. intro st. functional induction (parmove_aux st). destruct _x; destruct _x0; simpl in e; discriminate || apply rt_refl. eapply rt_trans. apply rt_step. apply parmove_step_compatible; eauto. - auto. + auto. Qed. Definition parmove (mu: moves) : moves := @@ -1151,7 +1151,7 @@ Theorem parmove_correctness: env_equiv (exec_seq (parmove mu) e) (exec_par mu e). Proof. intros. unfold parmove. apply dtransitions_correctness; auto. - apply parmove_aux_transitions. + apply parmove_aux_transitions. Qed. (** Here is an alternate formulation of [parmove], where the @@ -1172,7 +1172,7 @@ Theorem parmove2_correctness: List.map e' dl = List.map e sl /\ forall r, ~In r dl -> is_not_temp r -> e' r = e r. Proof. - intros. + intros. destruct (srcs_dests_combine sl dl H) as [A B]. assert (env_equiv e' (exec_par (List.combine sl dl) e)). unfold e', parmove2. apply parmove_correctness. @@ -1182,8 +1182,8 @@ Proof. red. rewrite B. auto. destruct (exec_par_combine e sl dl H H0) as [C D]. set (e1 := exec_par (combine sl dl) e) in *. - split. rewrite <- C. apply list_map_exten; intros. - symmetry. apply H3. auto. + split. rewrite <- C. apply list_map_exten; intros. + symmetry. apply H3. auto. intros. transitivity (e1 r); auto. Qed. @@ -1213,7 +1213,7 @@ Definition wf_moves (m: moves) : Prop := Lemma wf_moves_cons: forall s d m, wf_moves ((s, d) :: m) <-> wf_move s d /\ wf_moves m. Proof. - unfold wf_moves; intros; simpl. firstorder. + unfold wf_moves; intros; simpl. firstorder. inversion H0; subst s0 d0. auto. Qed. @@ -1237,7 +1237,7 @@ Lemma dtransition_preserves_wf_state: dtransition st st' -> wf_state st -> wf_state st'. Proof. induction 1; intro WF; inv WF; constructor; autorewrite with pmov in *; intuition. - apply wf_move_temp_left; auto. + apply wf_move_temp_left; auto. eapply wf_move_temp_right; eauto. Qed. @@ -1245,31 +1245,31 @@ Lemma dtransitions_preserve_wf_state: forall st st', dtransitions st st' -> wf_state st -> wf_state st'. Proof. - induction 1; intros; eauto. + induction 1; intros; eauto. eapply dtransition_preserves_wf_state; eauto. -Qed. +Qed. End PROPERTIES. Lemma parmove_wf_moves: forall mu, wf_moves mu (parmove mu). Proof. - intros. + intros. assert (wf_state mu (State mu nil nil)). constructor. red; intros. apply wf_move_same. auto. red; simpl; tauto. red; simpl; tauto. generalize (dtransitions_preserve_wf_state mu _ _ (parmove_aux_transitions (State mu nil nil)) H). - intro WFS. inv WFS. - unfold parmove. red; intros. apply H5. + intro WFS. inv WFS. + unfold parmove. red; intros. apply H5. rewrite List.In_rev. auto. Qed. Lemma parmove2_wf_moves: forall sl dl, wf_moves (List.combine sl dl) (parmove2 sl dl). Proof. - intros. unfold parmove2. apply parmove_wf_moves. + intros. unfold parmove2. apply parmove_wf_moves. Qed. (** As a corollary, we show that all sources of [parmove mu] @@ -1278,12 +1278,12 @@ Qed. or temporaries. *) Remark wf_move_initial_reg_or_temp: - forall mu s d, + forall mu s d, wf_move mu s d -> (In s (srcs mu) \/ is_temp s) /\ (In d (dests mu) \/ is_temp d). Proof. - induction 1. - split; left. + induction 1. + split; left. change s with (fst (s, d)). unfold srcs. apply List.in_map; auto. change d with (snd (s, d)). unfold dests. apply List.in_map; auto. split. right. exists s; auto. tauto. @@ -1316,7 +1316,7 @@ Lemma parmove_srcs_initial_reg_or_temp: forall mu s, In s (srcs (parmove mu)) -> In s (srcs mu) \/ is_temp s. Proof. - intros. destruct (in_srcs _ _ H) as [d A]. + intros. destruct (in_srcs _ _ H) as [d A]. destruct (parmove_initial_reg_or_temp _ _ _ A). auto. Qed. @@ -1324,7 +1324,7 @@ Lemma parmove_dests_initial_reg_or_temp: forall mu d, In d (dests (parmove mu)) -> In d (dests mu) \/ is_temp d. Proof. - intros. destruct (in_dests _ _ H) as [s A]. + intros. destruct (in_dests _ _ H) as [s A]. destruct (parmove_initial_reg_or_temp _ _ _ A). auto. Qed. @@ -1455,11 +1455,11 @@ Hypothesis temps_no_overlap: Lemma disjoint_list_notin: forall r l, disjoint_list r l -> ~In r l. Proof. - intros. red; intro. - assert (r <> r). apply disjoint_not_equal. apply H; auto. + intros. red; intro. + assert (r <> r). apply disjoint_not_equal. apply H; auto. congruence. Qed. - + Lemma pairwise_disjoint_norepet: forall l, pairwise_disjoint l -> list_norepet l. Proof. @@ -1513,7 +1513,7 @@ Proof. subst. right. apply H. auto. subst. right. apply disjoint_sym. apply H. auto. auto. -Qed. +Qed. Lemma no_adherence_dst: forall d, In d (dests mu) -> no_adherence d. @@ -1547,7 +1547,7 @@ Qed. Definition env_match (e1 e2: env) : Prop := forall r, no_adherence r -> e1 r = e2 r. -(** The following lemmas relate the effect of executing moves +(** The following lemmas relate the effect of executing moves using normal, overlap-unaware update and weak, overlap-aware update. *) Lemma weak_update_match: @@ -1558,9 +1558,9 @@ Lemma weak_update_match: env_match (update d (e1 s) e1) (weak_update d (e2 s) e2). Proof. - intros. red; intros. + intros. red; intros. assert (no_overlap d r). apply H2. auto. - destruct H3. + destruct H3. subst. rewrite update_s. rewrite weak_update_s. apply H1. destruct H. apply no_adherence_src; auto. apply no_adherence_tmp; auto. rewrite update_o. rewrite weak_update_d. apply H1. auto. @@ -1576,8 +1576,8 @@ Lemma weak_exec_seq_match: Proof. induction m; intros; simpl. auto. - destruct a as [s d]. simpl in H. simpl in H0. - apply IHm; auto. + destruct a as [s d]. simpl in H. simpl in H0. + apply IHm; auto. apply weak_update_match; auto. Qed. @@ -1600,7 +1600,7 @@ Theorem parmove2_correctness_with_overlap: forall r, disjoint_list r dl -> disjoint_temps r -> e' r = e r. Proof. intros. - assert (list_norepet dl). + assert (list_norepet dl). apply pairwise_disjoint_norepet; auto. assert (forall r : reg, In r sl -> is_not_temp r). intros. apply disjoint_temps_not_temp; auto. @@ -1608,7 +1608,7 @@ Proof. intros. apply disjoint_temps_not_temp; auto. generalize (parmove2_correctness sl dl H H5 H6 H7 e). set (e1 := exec_seq (parmove2 sl dl) e). intros [A B]. - destruct (srcs_dests_combine sl dl H) as [C D]. + destruct (srcs_dests_combine sl dl H) as [C D]. assert (env_match (combine sl dl) e1 e'). unfold parmove2. unfold e1, e'. apply weak_exec_seq_match; try (rewrite C); try (rewrite D); auto. @@ -1616,11 +1616,11 @@ Proof. intros. rewrite <- D. apply parmove_dests_initial_reg_or_temp. auto. red; auto. split. - rewrite <- A. + rewrite <- A. apply list_map_exten; intros. apply H8. - apply no_adherence_dst. rewrite D; auto. rewrite D; auto. rewrite D; auto. + apply no_adherence_dst. rewrite D; auto. rewrite D; auto. rewrite D; auto. intros. transitivity (e1 r). - symmetry. apply H8. red. rewrite D. intros. destruct H11. + symmetry. apply H8. red. rewrite D. intros. destruct H11. right. apply disjoint_sym. apply H9. auto. right. apply disjoint_sym. apply H10. auto. apply B. apply disjoint_list_notin; auto. apply disjoint_temps_not_temp; auto. diff --git a/lib/Postorder.v b/lib/Postorder.v index 4a83ea50..0215a829 100644 --- a/lib/Postorder.v +++ b/lib/Postorder.v @@ -41,8 +41,8 @@ Module PositiveOrd. Theorem leb_total : forall x y, is_true (leb x y) \/ is_true (leb y x). Proof. unfold leb, is_true; intros. - destruct (plt x y); auto. destruct (plt y x); auto. - elim (Plt_strict x). eapply Plt_trans; eauto. + destruct (plt x y); auto. destruct (plt y x); auto. + elim (Plt_strict x). eapply Plt_trans; eauto. Qed. End PositiveOrd. @@ -114,7 +114,7 @@ Inductive invariant (s: state) : Prop := (REM: forall x y, s.(gr)!x = Some y -> s.(map)!x = None) (* black nodes have no white son *) (COLOR: forall x succs n y, - ginit!x = Some succs -> s.(map)!x = Some n -> + ginit!x = Some succs -> s.(map)!x = Some n -> In y succs -> s.(gr)!y = None) (* worklist is well-formed *) (WKLIST: forall x l, In (x, l) s.(wrk) -> @@ -140,15 +140,15 @@ Proof. Qed. Lemma transition_spec: - forall s, invariant s -> + forall s, invariant s -> match transition s with inr s' => invariant s' | inl m => postcondition m end. Proof. - intros. inv H. unfold transition. destruct (wrk s) as [ | [x succ_x] l]. + intros. inv H. unfold transition. destruct (wrk s) as [ | [x succ_x] l]. (* finished *) constructor; intros. eauto. caseEq (s.(map)!root); intros. congruence. exploit GREY; eauto. intros [? ?]; contradiction. - destruct (s.(map)!x) eqn:?; try congruence. + destruct (s.(map)!x) eqn:?; try congruence. destruct (s.(map)!y) eqn:?; try congruence. exploit COLOR; eauto. intros. exploit GREY; eauto. intros [? ?]; contradiction. (* not finished *) @@ -160,30 +160,30 @@ Proof. (* root *) eauto. (* below *) - rewrite PTree.gsspec in H. destruct (peq x0 x). inv H. + rewrite PTree.gsspec in H. destruct (peq x0 x). inv H. apply Plt_succ. apply Plt_trans_succ. eauto. (* inj *) - rewrite PTree.gsspec in H. rewrite PTree.gsspec in H0. + rewrite PTree.gsspec in H. rewrite PTree.gsspec in H0. destruct (peq x1 x); destruct (peq x2 x); subst. auto. - inv H. exploit BELOW; eauto. intros. eelim Plt_strict; eauto. + inv H. exploit BELOW; eauto. intros. eelim Plt_strict; eauto. inv H0. exploit BELOW; eauto. intros. eelim Plt_strict; eauto. eauto. (* rem *) - intros. rewrite PTree.gso; eauto. red; intros; subst x0. + intros. rewrite PTree.gso; eauto. red; intros; subst x0. exploit (WKLIST x nil); auto with coqlib. intros [A B]. congruence. (* color *) - rewrite PTree.gsspec in H0. destruct (peq x0 x). - inv H0. exploit (WKLIST x nil); auto with coqlib. + rewrite PTree.gsspec in H0. destruct (peq x0 x). + inv H0. exploit (WKLIST x nil); auto with coqlib. intros [A [l' [B C]]]. assert (l' = succs) by congruence. subst l'. - apply C; auto. + apply C; auto. eauto. (* wklist *) apply WKLIST. auto with coqlib. (* grey *) - rewrite PTree.gsspec in H1. destruct (peq x0 x). inv H1. + rewrite PTree.gsspec in H1. destruct (peq x0 x). inv H1. exploit GREY; eauto. intros [l' A]. simpl in A; destruct A. congruence. exists l'; auto. @@ -191,11 +191,11 @@ Proof. (* children y needs traversing *) destruct ((gr s)!y) as [ succs_y | ] eqn:?. (* y has children *) - constructor; simpl; intros. + constructor; simpl; intros. (* sub *) rewrite PTree.grspec in H. destruct (PTree.elt_eq x0 y); eauto. inv H. (* root *) - rewrite PTree.gro. auto. congruence. + rewrite PTree.gro. auto. congruence. (* below *) eauto. (* inj *) @@ -203,33 +203,33 @@ Proof. (* rem *) rewrite PTree.grspec in H. destruct (PTree.elt_eq x0 y); eauto. inv H. (* color *) - rewrite PTree.grspec. destruct (PTree.elt_eq y0 y); eauto. + rewrite PTree.grspec. destruct (PTree.elt_eq y0 y); eauto. (* wklist *) - destruct H. - inv H. split. apply PTree.grs. exists succs_y; split. eauto. + destruct H. + inv H. split. apply PTree.grs. exists succs_y; split. eauto. intros. rewrite In_sort in H. tauto. destruct H. inv H. exploit WKLIST; eauto with coqlib. intros [A [l' [B C]]]. - split. rewrite PTree.grspec. destruct (PTree.elt_eq x0 y); auto. + split. rewrite PTree.grspec. destruct (PTree.elt_eq x0 y); auto. exists l'; split. auto. intros. rewrite PTree.grspec. destruct (PTree.elt_eq y0 y); auto. - apply C; auto. simpl. intuition congruence. + apply C; auto. simpl. intuition congruence. exploit (WKLIST x0 l0); eauto with coqlib. intros [A [l' [B C]]]. - split. rewrite PTree.grspec. destruct (PTree.elt_eq x0 y); auto. - exists l'; split; auto. intros. + split. rewrite PTree.grspec. destruct (PTree.elt_eq x0 y); auto. + exists l'; split; auto. intros. rewrite PTree.grspec. destruct (PTree.elt_eq y0 y); auto. (* grey *) - rewrite PTree.grspec in H0. destruct (PTree.elt_eq x0 y) in H0. + rewrite PTree.grspec in H0. destruct (PTree.elt_eq x0 y) in H0. subst. exists (Sort.sort succs_y); auto with coqlib. - exploit GREY; eauto. simpl. intros [l1 A]. destruct A. - inv H2. exists succ_x; auto. + exploit GREY; eauto. simpl. intros [l1 A]. destruct A. + inv H2. exists succ_x; auto. exists l1; auto. (* y has no children *) constructor; simpl; intros; eauto. (* wklist *) - destruct H. inv H. + destruct H. inv H. exploit (WKLIST x0); eauto with coqlib. intros [A [l' [B C]]]. - split. auto. exists l'; split. auto. + split. auto. exists l'; split. auto. intros. destruct (peq y y0). congruence. apply C; auto. simpl. intuition congruence. eapply WKLIST; eauto with coqlib. (* grey *) @@ -257,18 +257,18 @@ Proof. (* color *) rewrite PTree.gempty in H0; inv H0. (* wklist *) - destruct H; inv H. - split. apply PTree.grs. exists succs; split; auto. + destruct H; inv H. + split. apply PTree.grs. exists succs; split; auto. intros. rewrite In_sort in H. intuition. (* grey *) rewrite PTree.grspec in H0. destruct (PTree.elt_eq x root). - subst. exists (Sort.sort succs); auto. + subst. exists (Sort.sort succs); auto. contradiction. (* root has no succs *) constructor; simpl; intros. (* sub *) - auto. + auto. (* root *) auto. (* below *) @@ -302,12 +302,12 @@ Lemma lt_state_wf: well_founded lt_state. Proof. set (f := fun s => (PTree_Properties.cardinal s.(gr), size_worklist s.(wrk))). change (well_founded (fun s1 s2 => lex_ord lt lt (f s1) (f s2))). - apply wf_inverse_image. - apply wf_lex_ord. + apply wf_inverse_image. + apply wf_lex_ord. apply lt_wf. apply lt_wf. Qed. -Lemma transition_decreases: +Lemma transition_decreases: forall s s', transition s = inr _ s' -> lt_state s' s. Proof. unfold transition, lt_state; intros. @@ -338,11 +338,11 @@ Theorem postorder_correct: (forall x1 x2 y, m!x1 = Some y -> m!x2 = Some y -> x1 = x2) /\ (forall x, reachable g root x -> g!x <> None -> m!x <> None). Proof. - intros. + intros. assert (postcondition g root m). unfold m. unfold postorder. apply WfIter.iterate_prop with (P := invariant g root). - apply transition_spec. + apply transition_spec. apply initial_state_spec. inv H. split. auto. diff --git a/lib/Readconfig.mll b/lib/Readconfig.mll index 27ef32cf..ec2f6bb0 100644 --- a/lib/Readconfig.mll +++ b/lib/Readconfig.mll @@ -28,7 +28,7 @@ let error msg lexbuf = lexbuf.lex_curr_p.pos_lnum, msg))) -let ill_formed_line lexbuf = error "Ill-formed line" lexbuf +let ill_formed_line lexbuf = error "Ill-formed line" lexbuf let unterminated_quote lexbuf = error "Unterminated quote" lexbuf let lone_backslash lexbuf = error "Lone \\ (backslash) at end of file" lexbuf @@ -41,7 +41,7 @@ let ident = ['A'-'Z' 'a'-'z' '_'] ['A'-'Z' 'a'-'z' '0'-'9' '_' '.']* rule begline = parse | '#' [^ '\n']* ('\n' | eof) { Lexing.new_line lexbuf; begline lexbuf } - | whitespace* (ident as key) whitespace* '=' + | whitespace* (ident as key) whitespace* '=' { let words = unquoted false [] lexbuf in Hashtbl.add key_val_tbl key (List.rev words); begline lexbuf } diff --git a/lib/UnionFind.v b/lib/UnionFind.v index 46a886ea..76dd6b31 100644 --- a/lib/UnionFind.v +++ b/lib/UnionFind.v @@ -90,7 +90,7 @@ Module Type UNIONFIND. Hypothesis sameclass_union_3: forall uf a b x y, sameclass (union uf a b) x y -> - sameclass uf x y + sameclass uf x y \/ sameclass uf x a /\ sameclass uf y b \/ sameclass uf x b /\ sameclass uf y a. @@ -120,7 +120,7 @@ Module Type UNIONFIND. pathlen (merge uf a b) x = if elt_eq (repr uf a) (repr uf b) then pathlen uf x - else if elt_eq (repr uf x) (repr uf a) then + else if elt_eq (repr uf x) (repr uf a) then pathlen uf x + pathlen uf b + 1 else pathlen uf x. @@ -155,7 +155,7 @@ Definition t := unionfind. Definition getlink (m: M.t elt) (a: elt) : {a' | M.get a m = Some a'} + {M.get a m = None}. Proof. - destruct (M.get a m). left. exists e; auto. right; auto. + destruct (M.get a m). left. exists e; auto. right; auto. Defined. (* The canonical representative of an element *) @@ -175,11 +175,11 @@ Definition repr (a: elt) : elt := Fix uf.(mwf) (fun _ => elt) F_repr a. Lemma repr_unroll: forall a, repr a = match M.get a uf.(m) with Some a' => repr a' | None => a end. Proof. - intros. unfold repr at 1. rewrite Fix_eq. - unfold F_repr. destruct (getlink uf.(m) a) as [[a' P] | Q]. + intros. unfold repr at 1. rewrite Fix_eq. + unfold F_repr. destruct (getlink uf.(m) a) as [[a' P] | Q]. rewrite P; auto. rewrite Q; auto. - intros. unfold F_repr. destruct (getlink (m uf) x) as [[a' P] | Q]; auto. + intros. unfold F_repr. destruct (getlink (m uf) x) as [[a' P] | Q]; auto. Qed. Lemma repr_none: @@ -187,36 +187,36 @@ Lemma repr_none: M.get a uf.(m) = None -> repr a = a. Proof. - intros. rewrite repr_unroll. rewrite H; auto. + intros. rewrite repr_unroll. rewrite H; auto. Qed. Lemma repr_some: - forall a a', + forall a a', M.get a uf.(m) = Some a' -> repr a = repr a'. Proof. - intros. rewrite repr_unroll. rewrite H; auto. + intros. rewrite repr_unroll. rewrite H; auto. Qed. Lemma repr_res_none: forall (a: elt), M.get (repr a) uf.(m) = None. Proof. - apply (well_founded_ind (mwf uf)). intros. + apply (well_founded_ind (mwf uf)). intros. rewrite repr_unroll. destruct (M.get x (m uf)) as [y|] eqn:X; auto. Qed. Lemma repr_canonical: forall (a: elt), repr (repr a) = repr a. Proof. - intros. apply repr_none. apply repr_res_none. + intros. apply repr_none. apply repr_res_none. Qed. Lemma repr_some_diff: forall a a', M.get a uf.(m) = Some a' -> a <> repr a'. Proof. - intros; red; intros. - assert (repr a = a). rewrite (repr_some a a'); auto. - assert (M.get a uf.(m) = None). rewrite <- H1. apply repr_res_none. + intros; red; intros. + assert (repr a = a). rewrite (repr_some a a'); auto. + assert (M.get a uf.(m) = None). rewrite <- H1. apply repr_res_none. congruence. Qed. @@ -297,9 +297,9 @@ Remark identify_Acc_b: Proof. induction 1; intros. constructor; intros. rewrite identify_order in H2. destruct H2 as [A | [A B]]. - apply H0; auto. rewrite <- (repr_some uf _ _ A). auto. + apply H0; auto. rewrite <- (repr_some uf _ _ A). auto. subst. elim H1. apply repr_none. auto. -Qed. +Qed. Remark identify_Acc: forall x, @@ -308,13 +308,13 @@ Proof. induction 1. constructor; intros. rewrite identify_order in H1. destruct H1 as [A | [A B]]. auto. - subst. apply identify_Acc_b; auto. apply uf.(mwf). + subst. apply identify_Acc_b; auto. apply uf.(mwf). Qed. Lemma identify_wf: well_founded (order (M.set a b uf.(m))). Proof. - red; intros. apply identify_Acc. apply uf.(mwf). + red; intros. apply identify_Acc. apply uf.(mwf). Qed. Definition identify := mk (M.set a b uf.(m)) identify_wf. @@ -323,11 +323,11 @@ Lemma repr_identify_1: forall x, repr uf x <> a -> repr identify x = repr uf x. Proof. intros x0; pattern x0. apply (well_founded_ind (mwf uf)); intros. - rewrite (repr_unroll uf) in *. + rewrite (repr_unroll uf) in *. destruct (M.get x (m uf)) as [a'|] eqn:X. rewrite <- H; auto. apply repr_some. simpl. rewrite M.gsspec. rewrite dec_eq_false; auto. congruence. - apply repr_none. simpl. rewrite M.gsspec. rewrite dec_eq_false; auto. + apply repr_none. simpl. rewrite M.gsspec. rewrite dec_eq_false; auto. Qed. Lemma repr_identify_2: @@ -335,9 +335,9 @@ Lemma repr_identify_2: Proof. intros x0; pattern x0. apply (well_founded_ind (mwf uf)); intros. rewrite (repr_unroll uf) in H0. destruct (M.get x (m uf)) as [a'|] eqn:X. - rewrite <- (H a'); auto. + rewrite <- (H a'); auto. apply repr_some. simpl. rewrite M.gsspec. rewrite dec_eq_false; auto. congruence. - subst x. rewrite (repr_unroll identify). simpl. rewrite M.gsspec. + subst x. rewrite (repr_unroll identify). simpl. rewrite M.gsspec. rewrite dec_eq_true. apply repr_identify_1. auto. Qed. @@ -348,7 +348,7 @@ End IDENTIFY. Remark union_not_same_class: forall uf a b, repr uf a <> repr uf b -> repr uf (repr uf b) <> repr uf a. Proof. - intros. rewrite repr_canonical. auto. + intros. rewrite repr_canonical. auto. Qed. Definition union (uf: t) (a b: elt) : t := @@ -402,7 +402,7 @@ Qed. Lemma sameclass_union_3: forall uf a b x y, sameclass (union uf a b) x y -> - sameclass uf x y + sameclass uf x y \/ sameclass uf x a /\ sameclass uf y b \/ sameclass uf x b /\ sameclass uf y a. Proof. @@ -448,14 +448,14 @@ Definition path_ord (uf: t) : elt -> elt -> Prop := order uf.(m). Lemma path_ord_wellfounded: forall uf, well_founded (path_ord uf). Proof. - intros. apply mwf. + intros. apply mwf. Qed. Lemma path_ord_canonical: forall uf x y, repr uf x = x -> ~path_ord uf y x. Proof. intros; red; intros. hnf in H0. - assert (M.get x (m uf) = None). rewrite <- H. apply repr_res_none. + assert (M.get x (m uf) = None). rewrite <- H. apply repr_res_none. congruence. Qed. @@ -463,10 +463,10 @@ Lemma path_ord_merge_1: forall uf a b x y, path_ord uf x y -> path_ord (merge uf a b) x y. Proof. - intros. unfold merge. + intros. unfold merge. destruct (M.elt_eq (repr uf a) (repr uf b)). auto. - red. simpl. red. rewrite M.gsspec. rewrite dec_eq_false. apply H. + red. simpl. red. rewrite M.gsspec. rewrite dec_eq_false. apply H. red; intros. hnf in H. generalize (repr_res_none uf a). congruence. Qed. @@ -497,11 +497,11 @@ Definition pathlen (a: elt) : nat := Fix uf.(mwf) (fun _ => nat) F_pathlen a. Lemma pathlen_unroll: forall a, pathlen a = match M.get a uf.(m) with Some a' => S(pathlen a') | None => O end. Proof. - intros. unfold pathlen at 1. rewrite Fix_eq. - unfold F_pathlen. destruct (getlink uf.(m) a) as [[a' P] | Q]. + intros. unfold pathlen at 1. rewrite Fix_eq. + unfold F_pathlen. destruct (getlink uf.(m) a) as [[a' P] | Q]. rewrite P; auto. rewrite Q; auto. - intros. unfold F_pathlen. destruct (getlink (m uf) x) as [[a' P] | Q]; auto. + intros. unfold F_pathlen. destruct (getlink (m uf) x) as [[a' P] | Q]; auto. Qed. Lemma pathlen_none: @@ -509,11 +509,11 @@ Lemma pathlen_none: M.get a uf.(m) = None -> pathlen a = 0. Proof. - intros. rewrite pathlen_unroll. rewrite H; auto. + intros. rewrite pathlen_unroll. rewrite H; auto. Qed. Lemma pathlen_some: - forall a a', + forall a a', M.get a uf.(m) = Some a' -> pathlen a = S (pathlen a'). Proof. @@ -524,8 +524,8 @@ Lemma pathlen_zero: forall a, repr uf a = a <-> pathlen a = O. Proof. intros; split; intros. - apply pathlen_none. rewrite <- H. apply repr_res_none. - apply repr_none. rewrite pathlen_unroll in H. + apply pathlen_none. rewrite <- H. apply repr_res_none. + apply repr_none. rewrite pathlen_unroll in H. destruct (M.get a (m uf)); congruence. Qed. @@ -538,27 +538,27 @@ Lemma pathlen_merge: pathlen (merge uf a b) x = if M.elt_eq (repr uf a) (repr uf b) then pathlen uf x - else if M.elt_eq (repr uf x) (repr uf a) then + else if M.elt_eq (repr uf x) (repr uf a) then pathlen uf x + pathlen uf b + 1 else pathlen uf x. Proof. - intros. unfold merge. + intros. unfold merge. destruct (M.elt_eq (repr uf a) (repr uf b)). auto. set (uf' := identify uf (repr uf a) b (repr_res_none uf a) (not_eq_sym n)). pattern x. apply (well_founded_ind (mwf uf')); intros. rewrite (pathlen_unroll uf'). destruct (M.get x0 (m uf')) as [x'|] eqn:G. - rewrite H; auto. simpl in G. rewrite M.gsspec in G. + rewrite H; auto. simpl in G. rewrite M.gsspec in G. destruct (M.elt_eq x0 (repr uf a)). rewrite e. rewrite repr_canonical. rewrite dec_eq_true. - inversion G. subst x'. rewrite dec_eq_false; auto. - replace (pathlen uf (repr uf a)) with 0. omega. - symmetry. apply pathlen_none. apply repr_res_none. + inversion G. subst x'. rewrite dec_eq_false; auto. + replace (pathlen uf (repr uf a)) with 0. omega. + symmetry. apply pathlen_none. apply repr_res_none. rewrite (repr_unroll uf x0), (pathlen_unroll uf x0); rewrite G. - destruct (M.elt_eq (repr uf x') (repr uf a)); omega. + destruct (M.elt_eq (repr uf x') (repr uf a)); omega. simpl in G. rewrite M.gsspec in G. destruct (M.elt_eq x0 (repr uf a)); try discriminate. - rewrite (repr_none uf x0) by auto. rewrite dec_eq_false; auto. - symmetry. apply pathlen_zero; auto. apply repr_none; auto. + rewrite (repr_none uf x0) by auto. rewrite dec_eq_false; auto. + symmetry. apply pathlen_zero; auto. apply repr_none; auto. Qed. Lemma pathlen_gt_merge: @@ -567,7 +567,7 @@ Lemma pathlen_gt_merge: pathlen uf x > pathlen uf y -> pathlen (merge uf a b) x > pathlen (merge uf a b) y. Proof. - intros. repeat rewrite pathlen_merge. + intros. repeat rewrite pathlen_merge. destruct (M.elt_eq (repr uf a) (repr uf b)). auto. rewrite H. destruct (M.elt_eq (repr uf y) (repr uf a)). omega. auto. @@ -600,7 +600,7 @@ Proof. induction 1. constructor; intros. destruct (compress_order _ _ H1) as [A | [A B]]. auto. - subst x y. constructor; intros. + subst x y. constructor; intros. destruct (compress_order _ _ H2) as [A | [A B]]. red in A. generalize (repr_res_none uf a). congruence. congruence. @@ -609,7 +609,7 @@ Qed. Lemma compress_wf: well_founded (order (M.set a b uf.(m))). Proof. - red; intros. apply compress_Acc. apply uf.(mwf). + red; intros. apply compress_Acc. apply uf.(mwf). Qed. Definition compress := mk (M.set a b uf.(m)) compress_wf. @@ -620,11 +620,11 @@ Proof. apply (well_founded_ind (mwf compress)); intros. rewrite (repr_unroll compress). destruct (M.get x (m compress)) as [y|] eqn:G. - rewrite H; auto. - simpl in G. rewrite M.gsspec in G. destruct (M.elt_eq x a). + rewrite H; auto. + simpl in G. rewrite M.gsspec in G. destruct (M.elt_eq x a). inversion G. subst x y. rewrite <- a_repr_b. apply repr_canonical. symmetry; apply repr_some; auto. - simpl in G. rewrite M.gsspec in G. destruct (M.elt_eq x a). + simpl in G. rewrite M.gsspec in G. destruct (M.elt_eq x a). congruence. symmetry; apply repr_none; auto. Qed. @@ -637,7 +637,7 @@ Section FIND. Variable uf: t. -Program Fixpoint find_x (a: elt) {wf (order uf.(m)) a} : +Program Fixpoint find_x (a: elt) {wf (order uf.(m)) a} : { r: elt * t | fst r = repr uf a /\ forall x, repr (snd r) x = repr uf x } := match M.get a uf.(m) with | Some a' => @@ -664,7 +664,7 @@ Next Obligation. destruct (find_x a') as [[b' uf''] [A B]]. simpl in *. inv Heq_anonymous0. symmetry. apply repr_some. auto. - intros. rewrite repr_compress. + intros. rewrite repr_compress. destruct (find_x a') as [[b' uf''] [A B]]. simpl in *. inv Heq_anonymous0. auto. Qed. @@ -672,7 +672,7 @@ Next Obligation. split; auto. symmetry. apply repr_none. auto. Qed. Next Obligation. - apply mwf. + apply mwf. Defined. Definition find (a: elt) : elt * t := proj1_sig (find_x a). @@ -680,15 +680,15 @@ Definition find (a: elt) : elt * t := proj1_sig (find_x a). Lemma find_repr: forall a, fst (find a) = repr uf a. Proof. - unfold find; intros. destruct (find_x a) as [[b uf'] [A B]]. simpl. auto. + unfold find; intros. destruct (find_x a) as [[b uf'] [A B]]. simpl. auto. Qed. Lemma find_unchanged: forall a x, repr (snd (find a)) x = repr uf x. Proof. - unfold find; intros. destruct (find_x a) as [[b uf'] [A B]]. simpl. auto. + unfold find; intros. destruct (find_x a) as [[b uf'] [A B]]. simpl. auto. Qed. - + Lemma sameclass_find_1: forall a x y, sameclass (snd (find a)) x y <-> sameclass uf x y. Proof. diff --git a/lib/Wfsimpl.v b/lib/Wfsimpl.v index 1ed6326a..4f80822e 100644 --- a/lib/Wfsimpl.v +++ b/lib/Wfsimpl.v @@ -35,9 +35,9 @@ Definition Fix (x: A) : B := Wf.Fix Rwf (fun (x: A) => B) F x. Theorem unroll_Fix: forall x, Fix x = F (fun (y: A) (P: R y x) => Fix y). Proof. - unfold Fix; intros. apply Wf.Fix_eq with (P := fun (x: A) => B). + unfold Fix; intros. apply Wf.Fix_eq with (P := fun (x: A) => B). intros. assert (f = g). apply functional_extensionality_dep; intros. - apply functional_extensionality; intros. auto. + apply functional_extensionality; intros. auto. subst g; auto. Qed. @@ -56,9 +56,9 @@ Definition Fixm (x: A) : B := Wf.Fix (well_founded_ltof A measure) (fun (x: A) = Theorem unroll_Fixm: forall x, Fixm x = F (fun (y: A) (P: measure y < measure x) => Fixm y). Proof. - unfold Fixm; intros. apply Wf.Fix_eq with (P := fun (x: A) => B). + unfold Fixm; intros. apply Wf.Fix_eq with (P := fun (x: A) => B). intros. assert (f = g). apply functional_extensionality_dep; intros. - apply functional_extensionality; intros. auto. + apply functional_extensionality; intros. auto. subst g; auto. Qed. diff --git a/powerpc/Archi.v b/powerpc/Archi.v index 058b057f..dbf24875 100644 --- a/powerpc/Archi.v +++ b/powerpc/Archi.v @@ -25,13 +25,13 @@ Definition big_endian := true. Notation align_int64 := 8%Z (only parsing). Notation align_float64 := 8%Z (only parsing). -Program Definition default_pl_64 : bool * nan_pl 53 := +Program Definition default_pl_64 : bool * nan_pl 53 := (false, nat_iter 51 xO xH). Definition choose_binop_pl_64 (s1: bool) (pl1: nan_pl 53) (s2: bool) (pl2: nan_pl 53) := false. (**r always choose first NaN *) -Program Definition default_pl_32 : bool * nan_pl 24 := +Program Definition default_pl_32 : bool * nan_pl 24 := (false, nat_iter 22 xO xH). Definition choose_binop_pl_32 (s1: bool) (pl1: nan_pl 24) (s2: bool) (pl2: nan_pl 24) := diff --git a/powerpc/Asm.v b/powerpc/Asm.v index 3c7bdd15..ce306f73 100644 --- a/powerpc/Asm.v +++ b/powerpc/Asm.v @@ -109,7 +109,7 @@ Inductive constant: Type := (** A note on constants: while immediate operands to PowerPC instructions must be representable in 16 bits (with sign extension or left shift by 16 positions for some instructions), - we do not attempt to capture these restrictions in the + we do not attempt to capture these restrictions in the abstract syntax nor in the semantics. The assembler will emit an error if immediate operands exceed the representable range. Of course, our PPC generator (file [Asmgen]) is @@ -185,8 +185,8 @@ Inductive instruction : Type := | Pfadds: freg -> freg -> freg -> instruction (**r float addition *) | Pfcmpu: freg -> freg -> instruction (**r float comparison *) | Pfcti: ireg -> freg -> instruction (**r float-to-signed-int conversion, round towards 0 (pseudo) *) - | Pfctiw: freg -> freg -> instruction (**r float-to-signed-int conversion, round by default *) - | Pfctiwz: freg -> freg -> instruction (**r float-to-signed-int conversion, round towards 0 *) + | Pfctiw: freg -> freg -> instruction (**r float-to-signed-int conversion, round by default *) + | Pfctiwz: freg -> freg -> instruction (**r float-to-signed-int conversion, round towards 0 *) | Pfdiv: freg -> freg -> freg -> instruction (**r float division *) | Pfdivs: freg -> freg -> freg -> instruction (**r float division *) | Pfmake: freg -> ireg -> ireg -> instruction (**r build a float from 2 ints (pseudo) *) @@ -372,7 +372,7 @@ Definition program := AST.program fundef unit. type [Tint], float registers to values of type [Tfloat], and boolean registers ([CARRY], [CR0_0], etc) to either [Vzero] or [Vone]. *) - + Definition regset := Pregmap.t val. Definition genv := Genv.t fundef unit. @@ -666,7 +666,7 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out end | Pbtbl r tbl => match rs r with - | Vint n => + | Vint n => match list_nth_z tbl (Int.unsigned n) with | None => Stuck | Some lbl => goto_label f lbl (rs #GPR12 <- Vundef #CTR <- Vundef) m @@ -1019,7 +1019,7 @@ Inductive final_state: state -> int -> Prop := rs#PC = Vzero -> rs#GPR3 = Vint r -> final_state (State rs m) r. - + Definition semantics (p: program) := Semantics step (initial_state p) final_state (Genv.globalenv p). @@ -1034,9 +1034,9 @@ Proof. forall vl2, list_forall2 (extcall_arg rs m) ll vl2 -> vl1 = vl2). induction 1; intros vl2 EA; inv EA. auto. - f_equal; auto. + f_equal; auto. inv H; inv H3; congruence. - intros. red in H0; red in H1. eauto. + intros. red in H0; red in H1. eauto. Qed. Lemma semantics_determinate: forall p, determinate (semantics p). diff --git a/powerpc/AsmToJSON.ml b/powerpc/AsmToJSON.ml index 433beaeb..888efff2 100644 --- a/powerpc/AsmToJSON.ml +++ b/powerpc/AsmToJSON.ml @@ -106,17 +106,17 @@ let p_z oc z = fprintf oc "%s" (Z.to_string z) let p_int_constant oc i = fprintf oc "{\"Integer\":%a}" p_int i let p_float64_constant oc f = fprintf oc "{\"Float\":%a}" p_float64 f let p_float32_constant oc f = fprintf oc "{\"Float\":%a}" p_float32 f -let p_z_constant oc z = fprintf oc "{\"Integer\":%s}" (Z.to_string z) +let p_z_constant oc z = fprintf oc "{\"Integer\":%s}" (Z.to_string z) let p_constant oc = function | Cint i -> p_int_constant oc i | Csymbol_low (i,c) -> fprintf oc "{\"Symbol_low\":{\"Name\":%a,\"Offset\":%a}}" p_atom i p_int c - | Csymbol_high (i,c) -> fprintf oc "{\"Symbol_high\":{\"Name\":%a,\"Offset\":%a}}" p_atom i p_int c - | Csymbol_sda (i,c) -> fprintf oc "{\"Symbol_sda\":{\"Name\":%a,\"Offset\":%a}}" p_atom i p_int c - | Csymbol_rel_low (i,c) -> fprintf oc "{\"Symbol_rel_low\":{\"Name\":%a,\"Offset\":%a}}" p_atom i p_int c - | Csymbol_rel_high (i,c) -> fprintf oc "{\"Symbol_rel_high\":{\"Name\":%a,\"Offset\":%a}}" p_atom i p_int c + | Csymbol_high (i,c) -> fprintf oc "{\"Symbol_high\":{\"Name\":%a,\"Offset\":%a}}" p_atom i p_int c + | Csymbol_sda (i,c) -> fprintf oc "{\"Symbol_sda\":{\"Name\":%a,\"Offset\":%a}}" p_atom i p_int c + | Csymbol_rel_low (i,c) -> fprintf oc "{\"Symbol_rel_low\":{\"Name\":%a,\"Offset\":%a}}" p_atom i p_int c + | Csymbol_rel_high (i,c) -> fprintf oc "{\"Symbol_rel_high\":{\"Name\":%a,\"Offset\":%a}}" p_atom i p_int c -let p_crbit oc c = +let p_crbit oc c = let number = match c with | CRbit_0 -> 0 | CRbit_1 -> 1 @@ -160,7 +160,7 @@ let p_instruction oc ic = | Pb l -> fprintf oc "{\"Instruction Name\":\"Pb\",\"Args\":[%a]}" p_label l | Pbctr s -> fprintf oc "{\"Instruction Name\":\"Pbctr\",\"Args\":[]}" | Pbctrl s -> fprintf oc "{\"Instruction Name\":\"Pbctrl\",\"Args\":[]}" - | Pbdnz l -> fprintf oc "{\"Instruction Name\":\"Pbdnz\",\"Args\":[%a]}" p_label l + | Pbdnz l -> fprintf oc "{\"Instruction Name\":\"Pbdnz\",\"Args\":[%a]}" p_label l | Pbf (c,l) -> fprintf oc "{\"Instruction Name\":\"Pbf\",\"Args\":[%a,%a]}" p_crbit c p_label l | Pbl (i,s) -> fprintf oc "{\"Instruction Name\":\"Pbl\",\"Args\":[%a]}" p_atom_constant i | Pbs (i,s) -> fprintf oc "{\"Instruction Name\":\"Pbs\",\"Args\":[%a]}" p_atom_constant i @@ -171,7 +171,7 @@ let p_instruction oc ic = | Pcmplw (ir1,ir2) -> fprintf oc "{\"Instruction Name\":\"Pcmplw\",\"Args\":[%a,%a]}" p_ireg ir1 p_ireg ir2 | Pcmplwi (ir,c) -> fprintf oc "{\"Instruction Name\":\"Pcmplwi\",\"Args\":[%a,%a]}" p_ireg ir p_constant c | Pcmpw (ir1,ir2) -> fprintf oc "{\"Instruction Name\":\"Pcmpw\",\"Args\":[%a,%a]}" p_ireg ir1 p_ireg ir2 - | Pcmpwi (ir,c) -> fprintf oc "{\"Instruction Name\":\"Pcmpwi\",\"Args\":[%a,%a]}" p_ireg ir p_constant c + | Pcmpwi (ir,c) -> fprintf oc "{\"Instruction Name\":\"Pcmpwi\",\"Args\":[%a,%a]}" p_ireg ir p_constant c | Pcntlzw (ir1,ir2) -> fprintf oc "{\"Instruction Name\":\"Pcntlzw\",\"Args\":[%a,%a]}" p_ireg ir1 p_ireg ir2 | Pcreqv (cr1,cr2,cr3) -> fprintf oc "{\"Instruction Name\":\"Pcreqv\",\"Args\":[%a,%a,%a]}" p_crbit cr1 p_crbit cr2 p_crbit cr3 | Pcror (cr1,cr2,cr3) -> fprintf oc "{\"Instruction Name\":\"Pcror\",\"Args\":[%a,%a,%a]}" p_crbit cr1 p_crbit cr2 p_crbit cr3 @@ -189,7 +189,7 @@ let p_instruction oc ic = | Pextsb (ir1,ir2) -> fprintf oc "{\"Instruction Name\":\"Pextsb\",\"Args\":[%a,%a]}" p_ireg ir1 p_ireg ir2 | Pextsh (ir1,ir2) -> fprintf oc "{\"Instruction Name\":\"Pextsh\",\"Args\":[%a,%a]}" p_ireg ir1 p_ireg ir2 | Pfreeframe (c,i) -> assert false (* Should not occur *) - | Pfabs (fr1,fr2) + | Pfabs (fr1,fr2) | Pfabss (fr1,fr2) -> fprintf oc "{\"Instruction Name\":\"Pfabs\",\"Args\":[%a,%a]}" p_freg fr1 p_freg fr2 | Pfadd (fr1,fr2,fr3) -> fprintf oc "{\"Instruction Name\":\"Pfadd\",\"Args\":[%a,%a,%a]}" p_freg fr1 p_freg fr2 p_freg fr3 | Pfadds (fr1,fr2,fr3) -> fprintf oc "{\"Instruction Name\":\"Pfadds\",\"Args\":[%a,%a,%a]}" p_freg fr1 p_freg fr2 p_freg fr3 @@ -240,7 +240,7 @@ let p_instruction oc ic = | Plwz (ir1,ic,ir2) -> fprintf oc "{\"Instruction Name\":\"Plwz\",\"Args\":[%a,%a,%a]}" p_ireg ir1 p_constant ic p_ireg ir2 | Plwz_a (ir1,c,ir2) -> fprintf oc "{\"Instruction Name\":\"Plwz\",\"Args\":[%a,%a,%a]}" p_ireg ir1 p_constant c p_ireg ir2 | Plwzu (ir1,c,ir2) -> fprintf oc "{\"Instruction Name\":\"Plwzu\",\"Args\":[%a,%a,%a]}" p_ireg ir1 p_constant c p_ireg ir2 - | Plwzx (ir1,ir2,ir3) + | Plwzx (ir1,ir2,ir3) | Plwzx_a (ir1,ir2,ir3) -> fprintf oc "{\"Instruction Name\":\"Plwzx\",\"Args\":[%a,%a,%a]}" p_ireg ir1 p_ireg ir2 p_ireg ir3 | Plwarx (ir1,ir2,ir3) -> fprintf oc "{\"Instruction Name\":\"Plwarx\",\"Args\":[%a,%a,%a]}" p_ireg ir1 p_ireg ir2 p_ireg ir3 | Plwbrx (ir1,ir2,ir3) -> fprintf oc "{\"Instruction Name\":\"Plwbrx\",\"Args\":[%a,%a,%a]}" p_ireg ir1 p_ireg ir2 p_ireg ir3 @@ -331,7 +331,7 @@ let p_section oc = function | Section_jumptable -> fprintf oc "{\"Section Name\":\"Jumptable\"}" | Section_user (s,w,e) -> fprintf oc "{\"Section Name\":\"%s\",\"Writable\":%B,\"Executable\":%B}" s w e | Section_debug_info _ - | Section_debug_abbrev + | Section_debug_abbrev | Section_debug_line _ | Section_debug_loc -> () (* There should be no info in the debug sections *) @@ -340,17 +340,17 @@ let p_int_opt oc = function | Some i -> fprintf oc "%d" i -let p_fundef oc (name,f) = +let p_fundef oc (name,f) = let alignment = atom_alignof name and inline = atom_is_inline name and static = atom_is_static name and instr = List.filter (function Pbuiltin _| Pcfi_adjust _ | Pcfi_rel_offset _ -> false | _ -> true) f.fn_code in let c_section,l_section,j_section = match (atom_sections name) with [a;b;c] -> a,b,c | _ -> assert false in fprintf oc "{\"Fun Name\":%a,\n\"Fun Storage Class\":%a,\n\"Fun Alignment\":%a,\n\"Fun Section Code\":%a,\"Fun Section Literals\":%a,\"Fun Section Jumptable\":%a,\n\"Fun Inline\":%B,\n\"Fun Code\":%a}\n" - p_atom name p_storage static p_int_opt alignment + p_atom name p_storage static p_int_opt alignment p_section c_section p_section l_section p_section j_section inline (p_list p_instruction) instr - + let p_init_data oc = function | Init_int8 ic -> fprintf oc "{\"Init_int8\":%a}" p_int ic | Init_int16 ic -> fprintf oc "{\"Init_int16\":%a}" p_int ic @@ -363,10 +363,10 @@ let p_init_data oc = function let p_vardef oc (name,v) = let alignment = atom_alignof name - and static = atom_is_static name + and static = atom_is_static name and section = match (atom_sections name) with [s] -> s | _ -> assert false (* Should only have one section *) in fprintf oc "{\"Var Name\":%a,\"Var Readonly\":%B,\"Var Volatile\":%B,\n\"Var Storage Class\":%a,\n\"Var Alignment\":%a,\n\"Var Section\":%a,\n\"Var Init\":%a}\n" - p_atom name v.gvar_readonly v.gvar_volatile + p_atom name v.gvar_readonly v.gvar_volatile p_storage static p_int_opt alignment p_section section (p_list p_init_data) v.gvar_init diff --git a/powerpc/Asmgen.v b/powerpc/Asmgen.v index db3b7028..6a027eee 100644 --- a/powerpc/Asmgen.v +++ b/powerpc/Asmgen.v @@ -126,7 +126,7 @@ Definition accessind {A: Type} (instr1: A -> constant -> ireg -> instruction) (instr2: A -> ireg -> ireg -> instruction) (base: ireg) (ofs: int) (r: A) (k: code) := - if Int.eq (high_s ofs) Int.zero + if Int.eq (high_s ofs) Int.zero then instr1 r (Cint ofs) base :: k else loadimm GPR0 ofs (instr2 r base GPR0 :: k). @@ -513,7 +513,7 @@ Definition int_temp_for (r: mreg) := Definition transl_memory_access (mk1: constant -> ireg -> instruction) (mk2: ireg -> ireg -> instruction) - (addr: addressing) (args: list mreg) + (addr: addressing) (args: list mreg) (temp: ireg) (k: code) := match addr, args with | Aindexed ofs, a1 :: nil => @@ -640,12 +640,12 @@ Definition transl_instr (f: Mach.function) (i: Mach.instruction) OK (Pmtctr r1 :: Plwz GPR0 (Cint f.(fn_retaddr_ofs)) GPR1 :: Pmtlr GPR0 :: - Pfreeframe f.(fn_stacksize) f.(fn_link_ofs) :: + Pfreeframe f.(fn_stacksize) f.(fn_link_ofs) :: Pbctr sig :: k) | Mtailcall sig (inr symb) => OK (Plwz GPR0 (Cint f.(fn_retaddr_ofs)) GPR1 :: Pmtlr GPR0 :: - Pfreeframe f.(fn_stacksize) f.(fn_link_ofs) :: + Pfreeframe f.(fn_stacksize) f.(fn_link_ofs) :: Pbs symb sig :: k) | Mbuiltin ef args res => OK (Pbuiltin ef (List.map (map_builtin_arg preg_of) args) (map_builtin_res preg_of res) :: k) diff --git a/powerpc/Asmgenproof.v b/powerpc/Asmgenproof.v index ece6af1a..4e59b297 100644 --- a/powerpc/Asmgenproof.v +++ b/powerpc/Asmgenproof.v @@ -44,25 +44,25 @@ Let tge := Genv.globalenv tprog. Lemma symbols_preserved: forall id, Genv.find_symbol tge id = Genv.find_symbol ge id. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.find_symbol_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma public_preserved: forall id, Genv.public_symbol tge id = Genv.public_symbol ge id. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.public_symbol_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma varinfo_preserved: forall b, Genv.find_var_info tge b = Genv.find_var_info ge b. Proof. - intros. unfold ge, tge. + intros. unfold ge, tge. apply Genv.find_var_info_transf_partial with transf_fundef. - exact TRANSF. + exact TRANSF. Qed. Lemma functions_translated: @@ -78,7 +78,7 @@ Lemma functions_transl: transf_function f = OK tf -> Genv.find_funct_ptr tge b = Some (Internal tf). Proof. - intros. + intros. destruct (functions_translated _ _ H) as [tf' [A B]]. rewrite A. monadInv B. f_equal. congruence. Qed. @@ -89,7 +89,7 @@ Lemma transf_function_no_overflow: forall f tf, transf_function f = OK tf -> list_length_z tf.(fn_code) <= Int.max_unsigned. Proof. - intros. monadInv H. destruct (zlt Int.max_unsigned (list_length_z x.(fn_code))); inv EQ0. + intros. monadInv H. destruct (zlt Int.max_unsigned (list_length_z x.(fn_code))); inv EQ0. omega. Qed. @@ -102,7 +102,7 @@ Proof. intros. inv H. eapply exec_straight_steps_1; eauto. eapply transf_function_no_overflow; eauto. - eapply functions_transl; eauto. + eapply functions_transl; eauto. Qed. Lemma exec_straight_at: @@ -112,8 +112,8 @@ Lemma exec_straight_at: exec_straight tge tf tc rs m tc' rs' m' -> transl_code_at_pc ge (rs' PC) fb f c' ep' tf tc'. Proof. - intros. inv H. - exploit exec_straight_steps_2; eauto. + intros. inv H. + exploit exec_straight_steps_2; eauto. eapply transf_function_no_overflow; eauto. eapply functions_transl; eauto. intros [ofs' [PC' CT']]. @@ -141,7 +141,7 @@ Section TRANSL_LABEL. Remark loadimm_label: forall r n k, tail_nolabel k (loadimm r n k). Proof. - intros. unfold loadimm. + intros. unfold loadimm. case (Int.eq (high_s n) Int.zero). TailNoLabel. case (Int.eq (low_s n) Int.zero); TailNoLabel. Qed. @@ -150,7 +150,7 @@ Hint Resolve loadimm_label: labels. Remark addimm_label: forall r1 r2 n k, tail_nolabel k (addimm r1 r2 n k). Proof. - intros; unfold addimm. + intros; unfold addimm. case (Int.eq (high_s n) Int.zero). TailNoLabel. case (Int.eq (low_s n) Int.zero); TailNoLabel. Qed. @@ -159,7 +159,7 @@ Hint Resolve addimm_label: labels. Remark andimm_base_label: forall r1 r2 n k, tail_nolabel k (andimm_base r1 r2 n k). Proof. - intros; unfold andimm_base. + intros; unfold andimm_base. case (Int.eq (high_u n) Int.zero). TailNoLabel. case (Int.eq (low_u n) Int.zero). TailNoLabel. eapply tail_nolabel_trans; TailNoLabel. @@ -169,7 +169,7 @@ Hint Resolve andimm_base_label: labels. Remark andimm_label: forall r1 r2 n k, tail_nolabel k (andimm r1 r2 n k). Proof. - intros; unfold andimm. + intros; unfold andimm. case (is_rlw_mask n); TailNoLabel. Qed. Hint Resolve andimm_label: labels. @@ -177,7 +177,7 @@ Hint Resolve andimm_label: labels. Remark orimm_label: forall r1 r2 n k, tail_nolabel k (orimm r1 r2 n k). Proof. - intros; unfold orimm. + intros; unfold orimm. case (Int.eq (high_u n) Int.zero). TailNoLabel. case (Int.eq (low_u n) Int.zero); TailNoLabel. Qed. @@ -186,7 +186,7 @@ Hint Resolve orimm_label: labels. Remark xorimm_label: forall r1 r2 n k, tail_nolabel k (xorimm r1 r2 n k). Proof. - intros; unfold xorimm. + intros; unfold xorimm. case (Int.eq (high_u n) Int.zero). TailNoLabel. case (Int.eq (low_u n) Int.zero); TailNoLabel. Qed. @@ -195,7 +195,7 @@ Hint Resolve xorimm_label: labels. Remark rolm_label: forall r1 r2 amount mask k, tail_nolabel k (rolm r1 r2 amount mask k). Proof. - intros; unfold rolm. + intros; unfold rolm. case (is_rlw_mask mask); TailNoLabel. Qed. Hint Resolve rolm_label: labels. @@ -291,7 +291,7 @@ Proof. destruct m; monadInv H; eapply transl_memory_access_label; TailNoLabel. destruct s0; monadInv H; TailNoLabel. destruct s0; monadInv H; TailNoLabel. - eapply tail_nolabel_trans. eapply transl_cond_label; eauto. + eapply tail_nolabel_trans. eapply transl_cond_label; eauto. destruct (snd (crbit_for_cond c0)); TailNoLabel. Qed. @@ -301,7 +301,7 @@ Lemma transl_instr_label': find_label lbl c = if Mach.is_label lbl i then Some k else find_label lbl k. Proof. intros. exploit transl_instr_label; eauto. - destruct i; try (intros [A B]; apply B). + destruct i; try (intros [A B]; apply B). intros. subst c. simpl. auto. Qed. @@ -316,7 +316,7 @@ Proof. induction c; simpl; intros. inv H. auto. monadInv H. rewrite (transl_instr_label' lbl _ _ _ _ _ EQ0). - generalize (Mach.is_label_correct lbl a). + generalize (Mach.is_label_correct lbl a). destruct (Mach.is_label lbl a); intros. subst a. simpl in EQ. exists x; auto. eapply IHc; eauto. @@ -332,7 +332,7 @@ Lemma transl_find_label: Proof. intros. monadInv H. destruct (zlt Int.max_unsigned (list_length_z x.(fn_code))); inv EQ0. monadInv EQ. rewrite transl_code'_transl_code in EQ0. - simpl. eapply transl_code_label; eauto. + simpl. eapply transl_code_label; eauto. Qed. End TRANSL_LABEL. @@ -347,17 +347,17 @@ Lemma find_label_goto_label: rs PC = Vptr b ofs -> Mach.find_label lbl f.(Mach.fn_code) = Some c' -> exists tc', exists rs', - goto_label tf lbl rs m = Next rs' m + goto_label tf lbl rs m = Next rs' m /\ transl_code_at_pc ge (rs' PC) b f c' false tf tc' /\ forall r, r <> PC -> rs'#r = rs#r. Proof. - intros. exploit (transl_find_label lbl f tf); eauto. rewrite H2. + intros. exploit (transl_find_label lbl f tf); eauto. rewrite H2. intros [tc [A B]]. exploit label_pos_code_tail; eauto. instantiate (1 := 0). intros [pos' [P [Q R]]]. exists tc; exists (rs#PC <- (Vptr b (Int.repr pos'))). split. unfold goto_label. rewrite P. rewrite H1. auto. - split. rewrite Pregmap.gss. constructor; auto. + split. rewrite Pregmap.gss. constructor; auto. rewrite Int.unsigned_repr. replace (pos' - 0) with pos' in Q. auto. omega. generalize (transf_function_no_overflow _ _ H0). omega. @@ -370,10 +370,10 @@ Lemma return_address_exists: forall f sg ros c, is_tail (Mcall sg ros :: c) f.(Mach.fn_code) -> exists ra, return_address_offset f c ra. Proof. - intros. eapply Asmgenproof0.return_address_exists; eauto. -- intros. exploit transl_instr_label; eauto. + intros. eapply Asmgenproof0.return_address_exists; eauto. +- intros. exploit transl_instr_label; eauto. destruct i; try (intros [A B]; apply A). intros. subst c0. repeat constructor. -- intros. monadInv H0. +- intros. monadInv H0. destruct (zlt Int.max_unsigned (list_length_z x.(fn_code))); inv EQ0. monadInv EQ. rewrite transl_code'_transl_code in EQ0. exists x; exists false; split; auto. unfold fn_code. repeat constructor. @@ -442,10 +442,10 @@ Lemma exec_straight_steps: plus step tge (State rs1 m1') E0 st' /\ match_states (Mach.State s fb sp c ms2 m2) st'. Proof. - intros. inversion H2. subst. monadInv H7. - exploit H3; eauto. intros [rs2 [A [B C]]]. + intros. inversion H2. subst. monadInv H7. + exploit H3; eauto. intros [rs2 [A [B C]]]. exists (State rs2 m2'); split. - eapply exec_straight_exec; eauto. + eapply exec_straight_exec; eauto. econstructor; eauto. eapply exec_straight_at; eauto. Qed. @@ -470,15 +470,15 @@ Proof. exploit H5; eauto. intros [jmp [k' [rs2 [A [B C]]]]]. generalize (functions_transl _ _ _ H7 H8); intro FN. generalize (transf_function_no_overflow _ _ H8); intro NOOV. - exploit exec_straight_steps_2; eauto. + exploit exec_straight_steps_2; eauto. intros [ofs' [PC2 CT2]]. - exploit find_label_goto_label; eauto. + exploit find_label_goto_label; eauto. intros [tc' [rs3 [GOTO [AT' OTH]]]]. exists (State rs3 m2'); split. eapply plus_right'. - eapply exec_straight_steps_1; eauto. + eapply exec_straight_steps_1; eauto. econstructor; eauto. - eapply find_instr_tail. eauto. + eapply find_instr_tail. eauto. rewrite C. eexact GOTO. traceEq. econstructor; eauto. @@ -503,7 +503,7 @@ Definition measure (s: Mach.state) : nat := Remark preg_of_not_GPR11: forall r, negb (mreg_eq r R11) = true -> IR GPR11 <> preg_of r. Proof. - intros. change (IR GPR11) with (preg_of R11). red; intros. + intros. change (IR GPR11) with (preg_of R11). red; intros. exploit preg_of_injective; eauto. intros; subst r; discriminate. Qed. @@ -518,8 +518,8 @@ Proof. induction 1; intros; inv MS. - (* Mlabel *) - left; eapply exec_straight_steps; eauto; intros. - monadInv TR. econstructor; split. apply exec_straight_one. simpl; eauto. auto. + left; eapply exec_straight_steps; eauto; intros. + monadInv TR. econstructor; split. apply exec_straight_one. simpl; eauto. auto. split. apply agree_nextinstr; auto. simpl; congruence. - (* Mgetstack *) @@ -535,51 +535,51 @@ Proof. - (* Msetstack *) unfold store_stack in H. assert (Val.lessdef (rs src) (rs0 (preg_of src))). eapply preg_val; eauto. - exploit Mem.storev_extends; eauto. intros [m2' [A B]]. + exploit Mem.storev_extends; eauto. intros [m2' [A B]]. left; eapply exec_straight_steps; eauto. rewrite (sp_val _ _ _ AG) in A. intros. simpl in TR. exploit storeind_correct; eauto with asmgen. intros [rs' [P Q]]. exists rs'; split. eauto. split. eapply agree_undef_regs; eauto with asmgen. - simpl; intros. rewrite Q; auto with asmgen. + simpl; intros. rewrite Q; auto with asmgen. - (* Mgetparam *) assert (f0 = f) by congruence; subst f0. - unfold load_stack in *. - exploit Mem.loadv_extends. eauto. eexact H0. auto. + unfold load_stack in *. + exploit Mem.loadv_extends. eauto. eexact H0. auto. intros [parent' [A B]]. rewrite (sp_val _ _ _ AG) in A. exploit lessdef_parent_sp; eauto. clear B; intros B; subst parent'. - exploit Mem.loadv_extends. eauto. eexact H1. auto. + exploit Mem.loadv_extends. eauto. eexact H1. auto. intros [v' [C D]]. Opaque loadind. left; eapply exec_straight_steps; eauto; intros. - destruct ep; simpl in TR. + destruct ep; simpl in TR. (* GPR11 contains parent *) exploit loadind_correct. eexact TR. instantiate (2 := rs0). rewrite DXP; eauto. congruence. intros [rs1 [P [Q R]]]. - exists rs1; split. eauto. + exists rs1; split. eauto. split. eapply agree_set_mreg. eapply agree_set_mreg; eauto. congruence. auto with asmgen. - simpl; intros. rewrite R; auto with asmgen. + simpl; intros. rewrite R; auto with asmgen. apply preg_of_not_GPR11; auto. (* GPR11 does not contain parent *) - monadInv TR. + monadInv TR. exploit loadind_correct. eexact EQ0. eauto. congruence. intros [rs1 [P [Q R]]]. simpl in Q. exploit loadind_correct. eexact EQ. instantiate (2 := rs1). rewrite Q. eauto. congruence. - intros [rs2 [S [T U]]]. + intros [rs2 [S [T U]]]. exists rs2; split. eapply exec_straight_trans; eauto. split. eapply agree_set_mreg. eapply agree_set_mreg. eauto. eauto. instantiate (1 := rs1#GPR11 <- (rs2#GPR11)). intros. rewrite Pregmap.gso; auto with asmgen. - congruence. intros. unfold Pregmap.set. destruct (PregEq.eq r' GPR11). congruence. auto with asmgen. - simpl; intros. rewrite U; auto with asmgen. + congruence. intros. unfold Pregmap.set. destruct (PregEq.eq r' GPR11). congruence. auto with asmgen. + simpl; intros. rewrite U; auto with asmgen. apply preg_of_not_GPR11; auto. - (* Mop *) - assert (eval_operation tge sp op rs##args m = Some v). + assert (eval_operation tge sp op rs##args m = Some v). rewrite <- H. apply eval_operation_preserved. exact symbols_preserved. exploit eval_operation_lessdef. eapply preg_vals; eauto. eauto. eexact H0. - intros [v' [A B]]. rewrite (sp_val _ _ _ AG) in A. + intros [v' [A B]]. rewrite (sp_val _ _ _ AG) in A. left; eapply exec_straight_steps; eauto; intros. simpl in TR. exploit transl_op_correct; eauto. intros [rs2 [P [Q R]]]. exists rs2; split. eauto. split. auto. @@ -589,34 +589,34 @@ Opaque loadind. change (destroyed_by_op Omove) with (@nil mreg). simpl; auto. - (* Mload *) - assert (eval_addressing tge sp addr rs##args = Some a). + assert (eval_addressing tge sp addr rs##args = Some a). rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1. intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A. exploit Mem.loadv_extends; eauto. intros [v' [C D]]. left; eapply exec_straight_steps; eauto; intros. simpl in TR. - exploit transl_load_correct; eauto. intros [rs2 [P [Q R]]]. + exploit transl_load_correct; eauto. intros [rs2 [P [Q R]]]. exists rs2; split. eauto. split. eapply agree_set_undef_mreg; eauto. congruence. - intros; auto with asmgen. + intros; auto with asmgen. simpl; congruence. - (* Mstore *) - assert (eval_addressing tge sp addr rs##args = Some a). + assert (eval_addressing tge sp addr rs##args = Some a). rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. exploit eval_addressing_lessdef. eapply preg_vals; eauto. eexact H1. intros [a' [A B]]. rewrite (sp_val _ _ _ AG) in A. assert (Val.lessdef (rs src) (rs0 (preg_of src))). eapply preg_val; eauto. exploit Mem.storev_extends; eauto. intros [m2' [C D]]. left; eapply exec_straight_steps; eauto. - intros. simpl in TR. exploit transl_store_correct; eauto. intros [rs2 [P Q]]. + intros. simpl in TR. exploit transl_store_correct; eauto. intros [rs2 [P Q]]. exists rs2; split. eauto. split. eapply agree_undef_regs; eauto with asmgen. simpl; congruence. - (* Mcall *) assert (f0 = f) by congruence. subst f0. - inv AT. + inv AT. assert (NOOV: list_length_z tf.(fn_code) <= Int.max_unsigned). eapply transf_function_no_overflow; eauto. destruct ros as [rf|fid]; simpl in H; monadInv H5. @@ -633,27 +633,27 @@ Opaque loadind. exploit return_address_offset_correct; eauto. intros; subst ra. left; econstructor; split. eapply plus_left. eapply exec_step_internal. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. eauto. apply star_one. eapply exec_step_internal. Simpl. rewrite <- H2; simpl; eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. eauto. traceEq. - econstructor; eauto. - econstructor; eauto. + econstructor; eauto. + econstructor; eauto. eapply agree_sp_def; eauto. - simpl. eapply agree_exten; eauto. intros. Simpl. + simpl. eapply agree_exten; eauto. intros. Simpl. Simpl. rewrite <- H2. auto. + (* Direct call *) generalize (code_tail_next_int _ _ _ _ NOOV H6). intro CT1. assert (TCA: transl_code_at_pc ge (Vptr fb (Int.add ofs Int.one)) fb f c false tf x). - econstructor; eauto. + econstructor; eauto. exploit return_address_offset_correct; eauto. intros; subst ra. left; econstructor; split. apply plus_one. eapply exec_step_internal. eauto. - eapply functions_transl; eauto. eapply find_instr_tail; eauto. + eapply functions_transl; eauto. eapply find_instr_tail; eauto. simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. eauto. - econstructor; eauto. + econstructor; eauto. econstructor; eauto. eapply agree_sp_def; eauto. simpl. eapply agree_exten; eauto. intros. Simpl. @@ -667,7 +667,7 @@ Opaque loadind. exploit Mem.loadv_extends. eauto. eexact H2. auto. simpl. intros [ra' [C D]]. exploit lessdef_parent_sp; eauto. intros. subst parent'. clear B. exploit lessdef_parent_ra; eauto. intros. subst ra'. clear D. - exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. + exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. destruct ros as [rf|fid]; simpl in H; monadInv H7. + (* Indirect call *) assert (rs rf = Vptr f' Int.zero). @@ -685,16 +685,16 @@ Opaque loadind. :: Pfreeframe (fn_stacksize f) (fn_link_ofs f) :: Pbctr sig :: x) rs0 m'0 (Pbctr sig :: x) rs5 m2'). - apply exec_straight_step with rs2 m'0. + apply exec_straight_step with rs2 m'0. simpl. rewrite H9. auto. auto. apply exec_straight_step with rs3 m'0. simpl. unfold load1. rewrite gpr_or_zero_not_zero. unfold const_low. - change (rs2 GPR1) with (rs0 GPR1). rewrite <- (sp_val _ _ _ AG). + change (rs2 GPR1) with (rs0 GPR1). rewrite <- (sp_val _ _ _ AG). simpl. rewrite C. auto. congruence. auto. apply exec_straight_step with rs4 m'0. simpl. reflexivity. reflexivity. - apply exec_straight_one. - simpl. change (rs4 GPR1) with (rs0 GPR1). rewrite <- (sp_val _ _ _ AG). + apply exec_straight_one. + simpl. change (rs4 GPR1) with (rs0 GPR1). rewrite <- (sp_val _ _ _ AG). simpl. rewrite A. rewrite E. reflexivity. reflexivity. left; exists (State rs6 m2'); split. @@ -703,9 +703,9 @@ Opaque loadind. econstructor. change (rs5 PC) with (Val.add (Val.add (Val.add (Val.add (rs0 PC) Vone) Vone) Vone) Vone). rewrite <- H4; simpl. eauto. - eapply functions_transl; eauto. + eapply functions_transl; eauto. eapply find_instr_tail. - repeat (eapply code_tail_next_int; auto). eauto. + repeat (eapply code_tail_next_int; auto). eauto. simpl. reflexivity. traceEq. (* match states *) econstructor; eauto. @@ -713,8 +713,8 @@ Hint Resolve agree_nextinstr agree_set_other: asmgen. assert (AG4: agree rs (Vptr stk soff) rs4). unfold rs4, rs3, rs2; auto 10 with asmgen. assert (AG5: agree rs (parent_sp s) rs5). - unfold rs5. apply agree_nextinstr. eapply agree_change_sp. eauto. - eapply parent_sp_def; eauto. + unfold rs5. apply agree_nextinstr. eapply agree_change_sp. eauto. + eapply parent_sp_def; eauto. unfold rs6, rs5; auto 10 with asmgen. + (* Direct call *) set (rs2 := nextinstr (rs0#GPR0 <- (parent_ra s))). @@ -726,13 +726,13 @@ Hint Resolve agree_nextinstr agree_set_other: asmgen. :: Pfreeframe (fn_stacksize f) (fn_link_ofs f) :: Pbs fid sig :: x) rs0 m'0 (Pbs fid sig :: x) rs4 m2'). - apply exec_straight_step with rs2 m'0. + apply exec_straight_step with rs2 m'0. simpl. unfold load1. rewrite gpr_or_zero_not_zero. unfold const_low. rewrite <- (sp_val _ _ _ AG). simpl. rewrite C. auto. congruence. auto. apply exec_straight_step with rs3 m'0. simpl. reflexivity. reflexivity. - apply exec_straight_one. - simpl. change (rs3 GPR1) with (rs0 GPR1). rewrite <- (sp_val _ _ _ AG). simpl. rewrite A. + apply exec_straight_one. + simpl. change (rs3 GPR1) with (rs0 GPR1). rewrite <- (sp_val _ _ _ AG). simpl. rewrite A. rewrite E. reflexivity. reflexivity. left; exists (State rs5 m2'); split. (* execution *) @@ -740,30 +740,30 @@ Hint Resolve agree_nextinstr agree_set_other: asmgen. econstructor. change (rs4 PC) with (Val.add (Val.add (Val.add (rs0 PC) Vone) Vone) Vone). rewrite <- H4; simpl. eauto. - eapply functions_transl; eauto. + eapply functions_transl; eauto. eapply find_instr_tail. - repeat (eapply code_tail_next_int; auto). eauto. + repeat (eapply code_tail_next_int; auto). eauto. simpl. unfold Genv.symbol_address. rewrite symbols_preserved. rewrite H. auto. traceEq. (* match states *) econstructor; eauto. assert (AG3: agree rs (Vptr stk soff) rs3). unfold rs3, rs2; auto 10 with asmgen. assert (AG4: agree rs (parent_sp s) rs4). - unfold rs4. apply agree_nextinstr. eapply agree_change_sp. eauto. - eapply parent_sp_def; eauto. + unfold rs4. apply agree_nextinstr. eapply agree_change_sp. eauto. + eapply parent_sp_def; eauto. unfold rs5; auto 10 with asmgen. - (* Mbuiltin *) - inv AT. monadInv H4. + inv AT. monadInv H4. exploit functions_transl; eauto. intro FN. generalize (transf_function_no_overflow _ _ H3); intro NOOV. - exploit builtin_args_match; eauto. intros [vargs' [P Q]]. + exploit builtin_args_match; eauto. intros [vargs' [P Q]]. exploit external_call_mem_extends; eauto. intros [vres' [m2' [A [B [C D]]]]]. - left. econstructor; split. apply plus_one. + left. econstructor; split. apply plus_one. eapply exec_step_builtin. eauto. eauto. eapply find_instr_tail; eauto. - erewrite <- sp_val by eauto. + erewrite <- sp_val by eauto. eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved. eapply external_call_symbols_preserved; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. @@ -777,12 +777,12 @@ Hint Resolve agree_nextinstr agree_set_other: asmgen. rewrite preg_notin_charact. intros. auto with asmgen. auto with asmgen. apply agree_nextinstr. eapply agree_set_res; auto. - eapply agree_undef_regs; eauto. intros; apply undef_regs_other_2; auto. + eapply agree_undef_regs; eauto. intros; apply undef_regs_other_2; auto. congruence. - (* Mgoto *) assert (f0 = f) by congruence. subst f0. - inv AT. monadInv H4. + inv AT. monadInv H4. exploit find_label_goto_label; eauto. intros [tc' [rs' [GOTO [AT2 INV]]]]. left; exists (State rs' m'); split. apply plus_one. econstructor; eauto. @@ -802,13 +802,13 @@ Hint Resolve agree_nextinstr agree_set_other: asmgen. rewrite EC in B. destruct (snd (crbit_for_cond cond)). (* Pbt, taken *) - econstructor; econstructor; econstructor; split. eexact A. + econstructor; econstructor; econstructor; split. eexact A. split. eapply agree_exten; eauto with asmgen. - simpl. rewrite B. reflexivity. + simpl. rewrite B. reflexivity. (* Pbf, taken *) - econstructor; econstructor; econstructor; split. eexact A. + econstructor; econstructor; econstructor; split. eexact A. split. eapply agree_exten; eauto with asmgen. - simpl. rewrite B. reflexivity. + simpl. rewrite B. reflexivity. - (* Mcond false *) exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros EC. @@ -816,7 +816,7 @@ Hint Resolve agree_nextinstr agree_set_other: asmgen. destruct (transl_cond_correct_1 tge tf cond args _ rs0 m' _ TR) as [rs' [A [B C]]]. rewrite EC in B. econstructor; split. - eapply exec_straight_trans. eexact A. + eapply exec_straight_trans. eexact A. destruct (snd (crbit_for_cond cond)). apply exec_straight_one. simpl. rewrite B. reflexivity. auto. apply exec_straight_one. simpl. rewrite B. reflexivity. auto. @@ -826,23 +826,23 @@ Hint Resolve agree_nextinstr agree_set_other: asmgen. - (* Mjumptable *) assert (f0 = f) by congruence. subst f0. - inv AT. monadInv H6. + inv AT. monadInv H6. exploit functions_transl; eauto. intro FN. generalize (transf_function_no_overflow _ _ H5); intro NOOV. exploit find_label_goto_label. eauto. eauto. - instantiate (2 := rs0#GPR12 <- Vundef #CTR <- Vundef). + instantiate (2 := rs0#GPR12 <- Vundef #CTR <- Vundef). Simpl. eauto. - eauto. + eauto. intros [tc' [rs' [A [B C]]]]. exploit ireg_val; eauto. rewrite H. intros LD; inv LD. left; econstructor; split. - apply plus_one. econstructor; eauto. - eapply find_instr_tail; eauto. + apply plus_one. econstructor; eauto. + eapply find_instr_tail; eauto. simpl. rewrite <- H9. unfold Mach.label in H0; unfold label; rewrite H0. eexact A. - econstructor; eauto. + econstructor; eauto. eapply agree_undef_regs; eauto. -Local Transparent destroyed_by_jumptable. - simpl. intros. rewrite C; auto with asmgen. Simpl. +Local Transparent destroyed_by_jumptable. + simpl. intros. rewrite C; auto with asmgen. Simpl. congruence. - (* Mreturn *) @@ -851,9 +851,9 @@ Local Transparent destroyed_by_jumptable. assert (NOOV: list_length_z tf.(fn_code) <= Int.max_unsigned). eapply transf_function_no_overflow; eauto. rewrite (sp_val _ _ _ AG) in *. unfold load_stack in *. - exploit Mem.loadv_extends. eauto. eexact H0. auto. simpl. intros [parent' [A B]]. + exploit Mem.loadv_extends. eauto. eexact H0. auto. simpl. intros [parent' [A B]]. exploit lessdef_parent_sp; eauto. intros. subst parent'. clear B. - exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [ra' [C D]]. + exploit Mem.loadv_extends. eauto. eexact H1. auto. simpl. intros [ra' [C D]]. exploit lessdef_parent_ra; eauto. intros. subst ra'. clear D. exploit Mem.free_parallel_extends; eauto. intros [m2' [E F]]. monadInv H6. @@ -868,43 +868,43 @@ Local Transparent destroyed_by_jumptable. (Pblr :: x) rs4 m2'). simpl. apply exec_straight_three with rs2 m'0 rs3 m'0. simpl. unfold load1. rewrite gpr_or_zero_not_zero. unfold const_low. rewrite C. auto. congruence. - simpl. auto. - simpl. change (rs3 GPR1) with (rs0 GPR1). rewrite A. - rewrite <- (sp_val _ _ _ AG). rewrite E. auto. - auto. auto. auto. + simpl. auto. + simpl. change (rs3 GPR1) with (rs0 GPR1). rewrite A. + rewrite <- (sp_val _ _ _ AG). rewrite E. auto. + auto. auto. auto. left; exists (State rs5 m2'); split. (* execution *) apply plus_right' with E0 (State rs4 m2') E0. eapply exec_straight_exec; eauto. econstructor. - change (rs4 PC) with (Val.add (Val.add (Val.add (rs0 PC) Vone) Vone) Vone). + change (rs4 PC) with (Val.add (Val.add (Val.add (rs0 PC) Vone) Vone) Vone). rewrite <- H3. simpl. eauto. eapply functions_transl; eauto. - eapply find_instr_tail. + eapply find_instr_tail. eapply code_tail_next_int; auto. eapply code_tail_next_int; auto. eapply code_tail_next_int; eauto. reflexivity. traceEq. (* match states *) - econstructor; eauto. - assert (AG3: agree rs (Vptr stk soff) rs3). + econstructor; eauto. + assert (AG3: agree rs (Vptr stk soff) rs3). unfold rs3, rs2; auto 10 with asmgen. assert (AG4: agree rs (parent_sp s) rs4). - unfold rs4. apply agree_nextinstr. eapply agree_change_sp; eauto. + unfold rs4. apply agree_nextinstr. eapply agree_change_sp; eauto. eapply parent_sp_def; eauto. unfold rs5; auto with asmgen. - (* internal function *) exploit functions_translated; eauto. intros [tf [A B]]. monadInv B. - generalize EQ; intros EQ'. monadInv EQ'. + generalize EQ; intros EQ'. monadInv EQ'. destruct (zlt Int.max_unsigned (list_length_z x0.(fn_code))); inversion EQ1. clear EQ1. - unfold store_stack in *. - exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. + unfold store_stack in *. + exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl. intros [m1' [C D]]. - exploit Mem.storev_extends. eexact D. eexact H1. eauto. eauto. + exploit Mem.storev_extends. eexact D. eexact H1. eauto. eauto. intros [m2' [F G]]. - simpl chunk_of_type in F. - exploit Mem.storev_extends. eexact G. eexact H2. eauto. eauto. + simpl chunk_of_type in F. + exploit Mem.storev_extends. eexact G. eexact H2. eauto. eauto. intros [m3' [P Q]]. (* Execution of function prologue *) monadInv EQ0. rewrite transl_code'_transl_code in EQ1. @@ -916,31 +916,31 @@ Local Transparent destroyed_by_jumptable. exec_straight tge x x.(fn_code) rs0 m' x1 rs5 m3'). - rewrite <- H5 at 2. simpl. + rewrite <- H5 at 2. simpl. apply exec_straight_step with rs2 m2'. unfold exec_instr. rewrite C. fold sp. rewrite <- (sp_val _ _ _ AG). rewrite F. auto. auto. apply exec_straight_step with rs3 m2'. simpl. auto. auto. apply exec_straight_two with rs4 m3'. - simpl. unfold store1. rewrite gpr_or_zero_not_zero. - change (rs3 GPR1) with sp. change (rs3 GPR0) with (rs0 LR). simpl. + simpl. unfold store1. rewrite gpr_or_zero_not_zero. + change (rs3 GPR1) with sp. change (rs3 GPR0) with (rs0 LR). simpl. rewrite Int.add_zero_l. simpl in P. rewrite Int.add_zero_l in P. rewrite ATLR. rewrite P. auto. congruence. auto. auto. auto. left; exists (State rs5 m3'); split. - eapply exec_straight_steps_1; eauto. omega. constructor. - econstructor; eauto. + eapply exec_straight_steps_1; eauto. omega. constructor. + econstructor; eauto. change (rs5 PC) with (Val.add (Val.add (Val.add (Val.add (rs0 PC) Vone) Vone) Vone) Vone). rewrite ATPC. simpl. constructor; eauto. subst x; simpl in g. unfold fn_code. - eapply code_tail_next_int. omega. - eapply code_tail_next_int. omega. + eapply code_tail_next_int. omega. + eapply code_tail_next_int. omega. eapply code_tail_next_int. omega. eapply code_tail_next_int. omega. constructor. unfold rs5, rs4, rs3, rs2. - apply agree_nextinstr. apply agree_nextinstr. - apply agree_set_other; auto. apply agree_set_other; auto. + apply agree_nextinstr. apply agree_nextinstr. + apply agree_set_other; auto. apply agree_set_other; auto. apply agree_nextinstr. apply agree_set_other; auto. eapply agree_change_sp; eauto. unfold sp; congruence. congruence. @@ -948,13 +948,13 @@ Local Transparent destroyed_by_jumptable. - (* external function *) exploit functions_translated; eauto. intros [tf [A B]]. simpl in B. inv B. - exploit extcall_arguments_match; eauto. + exploit extcall_arguments_match; eauto. intros [args' [C D]]. exploit external_call_mem_extends'; eauto. intros [res' [m2' [P [Q [R S]]]]]. left; econstructor; split. - apply plus_one. eapply exec_step_external; eauto. - eapply external_call_symbols_preserved'; eauto. + apply plus_one. eapply exec_step_external; eauto. + eapply external_call_symbols_preserved'; eauto. exact symbols_preserved. exact public_preserved. exact varinfo_preserved. econstructor; eauto. unfold loc_external_result. @@ -963,7 +963,7 @@ Local Transparent destroyed_by_jumptable. - (* return *) inv STACKS. simpl in *. right. split. omega. split. auto. - rewrite <- ATPC in H5. + rewrite <- ATPC in H5. econstructor; eauto. congruence. Qed. @@ -980,19 +980,19 @@ Proof. econstructor; eauto. constructor. apply Mem.extends_refl. - split. auto. simpl. unfold Vzero; congruence. intros. rewrite Regmap.gi. auto. - unfold Genv.symbol_address. + split. auto. simpl. unfold Vzero; congruence. intros. rewrite Regmap.gi. auto. + unfold Genv.symbol_address. rewrite (transform_partial_program_main _ _ TRANSF). - rewrite symbols_preserved. + rewrite symbols_preserved. unfold ge; rewrite H1. auto. Qed. Lemma transf_final_states: - forall st1 st2 r, + forall st1 st2 r, match_states st1 st2 -> Mach.final_state st1 r -> Asm.final_state st2 r. Proof. - intros. inv H0. inv H. constructor. auto. - compute in H1. inv H1. + intros. inv H0. inv H. constructor. auto. + compute in H1. inv H1. generalize (preg_val _ _ _ R3 AG). rewrite H2. intros LD; inv LD. auto. Qed. diff --git a/powerpc/Asmgenproof1.v b/powerpc/Asmgenproof1.v index cb94c555..1981f1a7 100644 --- a/powerpc/Asmgenproof1.v +++ b/powerpc/Asmgenproof1.v @@ -35,8 +35,8 @@ Lemma low_high_u: forall n, Int.or (Int.shl (high_u n) (Int.repr 16)) (low_u n) = n. Proof. intros. unfold high_u, low_u. - rewrite Int.shl_rolm. rewrite Int.shru_rolm. - rewrite Int.rolm_rolm. + rewrite Int.shl_rolm. rewrite Int.shru_rolm. + rewrite Int.rolm_rolm. change (Int.modu (Int.add (Int.sub (Int.repr (Z_of_nat Int.wordsize)) (Int.repr 16)) (Int.repr 16)) (Int.repr (Z_of_nat Int.wordsize))) @@ -50,8 +50,8 @@ Lemma low_high_u_xor: forall n, Int.xor (Int.shl (high_u n) (Int.repr 16)) (low_u n) = n. Proof. intros. unfold high_u, low_u. - rewrite Int.shl_rolm. rewrite Int.shru_rolm. - rewrite Int.rolm_rolm. + rewrite Int.shl_rolm. rewrite Int.shru_rolm. + rewrite Int.rolm_rolm. change (Int.modu (Int.add (Int.sub (Int.repr (Z_of_nat Int.wordsize)) (Int.repr 16)) (Int.repr 16)) (Int.repr (Z_of_nat Int.wordsize))) @@ -65,8 +65,8 @@ Lemma low_high_s: forall n, Int.add (Int.shl (high_s n) (Int.repr 16)) (low_s n) = n. Proof. intros. - rewrite Int.shl_mul_two_p. - unfold high_s. + rewrite Int.shl_mul_two_p. + unfold high_s. rewrite <- (Int.divu_pow2 (Int.sub n (low_s n)) (Int.repr 65536) (Int.repr 16)). 2: reflexivity. change (two_p (Int.unsigned (Int.repr 16))) with 65536. @@ -78,17 +78,17 @@ Proof. unfold Int.modu, Int.zero. decEq. change 0 with (0 mod 65536). change (Int.unsigned (Int.repr 65536)) with 65536. - apply Int.eqmod_mod_eq. omega. + apply Int.eqmod_mod_eq. omega. unfold x, low_s. eapply Int.eqmod_trans. apply Int.eqmod_divides with Int.modulus. unfold Int.sub. apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl. exists 65536. compute; auto. replace 0 with (Int.unsigned n - Int.unsigned n) by omega. - apply Int.eqmod_sub. apply Int.eqmod_refl. apply Int.eqmod_sign_ext'. + apply Int.eqmod_sub. apply Int.eqmod_refl. apply Int.eqmod_sign_ext'. compute; auto. rewrite H0 in H. rewrite Int.add_zero in H. rewrite <- H. unfold x. rewrite Int.sub_add_opp. rewrite Int.add_assoc. - rewrite (Int.add_commut (Int.neg (low_s n))). rewrite <- Int.sub_add_opp. + rewrite (Int.add_commut (Int.neg (low_s n))). rewrite <- Int.sub_add_opp. rewrite Int.sub_idem. apply Int.add_zero. Qed. @@ -96,7 +96,7 @@ Lemma add_zero_symbol_address: forall (ge: genv) id ofs, Val.add Vzero (Genv.symbol_address ge id ofs) = Genv.symbol_address ge id ofs. Proof. - unfold Genv.symbol_address; intros. destruct (Genv.find_symbol ge id); auto. + unfold Genv.symbol_address; intros. destruct (Genv.find_symbol ge id); auto. simpl. rewrite Int.add_zero; auto. Qed. @@ -213,15 +213,15 @@ Proof. intros. unfold loadimm. case (Int.eq (high_s n) Int.zero). (* addi *) - econstructor; split. apply exec_straight_one. simpl; eauto. auto. + econstructor; split. apply exec_straight_one. simpl; eauto. auto. rewrite Int.add_zero_l. intuition Simpl. (* addis *) generalize (Int.eq_spec (low_s n) Int.zero); case (Int.eq (low_s n) Int.zero); intro. - econstructor; split. apply exec_straight_one. simpl; eauto. auto. - rewrite <- H. rewrite Int.add_commut. rewrite low_high_s. + econstructor; split. apply exec_straight_one. simpl; eauto. auto. + rewrite <- H. rewrite Int.add_commut. rewrite low_high_s. intuition Simpl. (* addis + ori *) - econstructor; split. eapply exec_straight_two. + econstructor; split. eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. split. Simpl. rewrite Int.add_zero_l. unfold Val.or. rewrite low_high_u. auto. intros; Simpl. @@ -241,25 +241,25 @@ Proof. intros. unfold addimm. (* addi *) case (Int.eq (high_s n) Int.zero). - econstructor; split. apply exec_straight_one. + econstructor; split. apply exec_straight_one. simpl. rewrite gpr_or_zero_not_zero; eauto. reflexivity. intuition Simpl. (* addis *) generalize (Int.eq_spec (low_s n) Int.zero); case (Int.eq (low_s n) Int.zero); intro. econstructor; split. apply exec_straight_one. - simpl. rewrite gpr_or_zero_not_zero; auto. auto. - split. Simpl. - generalize (low_high_s n). rewrite H1. rewrite Int.add_zero. congruence. + simpl. rewrite gpr_or_zero_not_zero; auto. auto. + split. Simpl. + generalize (low_high_s n). rewrite H1. rewrite Int.add_zero. congruence. intros; Simpl. (* addis + addi *) econstructor; split. eapply exec_straight_two. - simpl. rewrite gpr_or_zero_not_zero; eauto. simpl. rewrite gpr_or_zero_not_zero; eauto. - auto. auto. + simpl. rewrite gpr_or_zero_not_zero; eauto. + auto. auto. split. Simpl. rewrite Val.add_assoc. simpl. rewrite low_high_s. auto. intros; Simpl. -Qed. +Qed. (** And integer immediate. *) @@ -290,7 +290,7 @@ Proof. generalize (compare_sint_spec (rs#r1 <- v) v Vzero). intros [A [B [C D]]]. split. apply exec_straight_one. simpl. - generalize (low_high_u n). rewrite H0. rewrite Int.or_zero. + generalize (low_high_u n). rewrite H0. rewrite Int.or_zero. intro. rewrite H1. reflexivity. reflexivity. split. rewrite D; auto with asmgen. Simpl. split. auto. @@ -301,10 +301,10 @@ Proof. exists (nextinstr (compare_sint (rs1#r1 <- v) v Vzero)). generalize (compare_sint_spec (rs1#r1 <- v) v Vzero). intros [A [B [C D]]]. - split. eapply exec_straight_trans. eexact EX1. - apply exec_straight_one. simpl. rewrite RES1. + split. eapply exec_straight_trans. eexact EX1. + apply exec_straight_one. simpl. rewrite RES1. rewrite (OTHER1 r2). reflexivity. congruence. congruence. - reflexivity. + reflexivity. split. rewrite D; auto with asmgen. Simpl. split. auto. intros. rewrite D; auto with asmgen. Simpl. @@ -321,7 +321,7 @@ Proof. intros. unfold andimm. destruct (is_rlw_mask n). (* turned into rlw *) econstructor; split. eapply exec_straight_one. - simpl. rewrite Val.rolm_zero. eauto. auto. + simpl. rewrite Val.rolm_zero. eauto. auto. intuition Simpl. (* andimm_base *) destruct (andimm_base_correct r1 r2 n k rs m) as [rs' [A [B [C D]]]]; auto. @@ -349,13 +349,13 @@ Proof. case (Int.eq (low_u n) Int.zero); intro. exists (nextinstr (rs#r1 <- v)). split. apply exec_straight_one. simpl. - generalize (low_high_u n). rewrite H. rewrite Int.or_zero. + generalize (low_high_u n). rewrite H. rewrite Int.or_zero. intro. rewrite H0. reflexivity. reflexivity. intuition Simpl. (* oris + ori *) econstructor; split. eapply exec_straight_two; simpl; reflexivity. - intuition Simpl. - rewrite Val.or_assoc. simpl. rewrite low_high_u. reflexivity. + intuition Simpl. + rewrite Val.or_assoc. simpl. rewrite low_high_u. reflexivity. Qed. (** Xor integer immediate. *) @@ -379,13 +379,13 @@ Proof. case (Int.eq (low_u n) Int.zero); intro. exists (nextinstr (rs#r1 <- v)). split. apply exec_straight_one. simpl. - generalize (low_high_u n). rewrite H. rewrite Int.or_zero. + generalize (low_high_u n). rewrite H. rewrite Int.or_zero. intro. rewrite H0. reflexivity. reflexivity. intuition Simpl. (* xoris + xori *) econstructor; split. eapply exec_straight_two; simpl; reflexivity. - intuition Simpl. - rewrite Val.xor_assoc. simpl. rewrite low_high_u_xor. reflexivity. + intuition Simpl. + rewrite Val.xor_assoc. simpl. rewrite low_high_u_xor. reflexivity. Qed. (** Rotate and mask. *) @@ -406,12 +406,12 @@ Proof. set (rs1 := nextinstr (rs#r1 <- (Val.rolm rs#r2 amount Int.mone))). destruct (andimm_base_correct r1 r1 mask k rs1 m) as [rs' [A [B [C D]]]]; auto. exists rs'. - split. eapply exec_straight_step; eauto. auto. auto. - split. rewrite B. unfold rs1. rewrite nextinstr_inv; auto with asmgen. - rewrite Pregmap.gss. destruct (rs r2); simpl; auto. - unfold Int.rolm. rewrite Int.and_assoc. + split. eapply exec_straight_step; eauto. auto. auto. + split. rewrite B. unfold rs1. rewrite nextinstr_inv; auto with asmgen. + rewrite Pregmap.gss. destruct (rs r2); simpl; auto. + unfold Int.rolm. rewrite Int.and_assoc. decEq; decEq; decEq. rewrite Int.and_commut. apply Int.and_mone. - intros. rewrite D; auto. unfold rs1; Simpl. + intros. rewrite D; auto. unfold rs1; Simpl. Qed. (** Indexed memory loads. *) @@ -433,14 +433,14 @@ Lemma accessind_load_correct: /\ forall r, r <> PC -> r <> inj rx -> r <> GPR0 -> rs'#r = rs#r. Proof. intros. unfold accessind. destruct (Int.eq (high_s ofs) Int.zero). -- econstructor; split. apply exec_straight_one. +- econstructor; split. apply exec_straight_one. rewrite H. unfold load1. rewrite gpr_or_zero_not_zero by auto. simpl. rewrite H1. eauto. unfold nextinstr. repeat Simplif. - split. unfold nextinstr. repeat Simplif. - intros. repeat Simplif. + split. unfold nextinstr. repeat Simplif. + intros. repeat Simplif. - exploit (loadimm_correct GPR0 ofs); eauto. intros [rs' [P [Q R]]]. econstructor; split. eapply exec_straight_trans. eexact P. - apply exec_straight_one. rewrite H0. unfold load2. rewrite Q, R by auto with asmgen. + apply exec_straight_one. rewrite H0. unfold load2. rewrite Q, R by auto with asmgen. rewrite H1. reflexivity. unfold nextinstr. repeat Simplif. split. repeat Simplif. intros. repeat Simplif. @@ -482,14 +482,14 @@ Lemma accessind_store_correct: /\ forall r, r <> PC -> r <> GPR0 -> rs'#r = rs#r. Proof. intros. unfold accessind. destruct (Int.eq (high_s ofs) Int.zero). -- econstructor; split. apply exec_straight_one. +- econstructor; split. apply exec_straight_one. rewrite H. unfold store1. rewrite gpr_or_zero_not_zero by auto. simpl. rewrite H1. eauto. unfold nextinstr. repeat Simplif. - intros. repeat Simplif. + intros. repeat Simplif. - exploit (loadimm_correct GPR0 ofs); eauto. intros [rs' [P [Q R]]]. econstructor; split. eapply exec_straight_trans. eexact P. apply exec_straight_one. rewrite H0. unfold store2. - rewrite Q. rewrite R by auto with asmgen. rewrite R by auto. + rewrite Q. rewrite R by auto with asmgen. rewrite R by auto. rewrite H1. reflexivity. unfold nextinstr. repeat Simplif. intros. repeat Simplif. Qed. @@ -519,15 +519,15 @@ Lemma floatcomp_correct: forall cmp (r1 r2: freg) k rs m, exists rs', exec_straight ge fn (floatcomp cmp r1 r2 k) rs m k rs' m - /\ rs'#(reg_of_crbit (fst (crbit_for_fcmp cmp))) = + /\ rs'#(reg_of_crbit (fst (crbit_for_fcmp cmp))) = (if snd (crbit_for_fcmp cmp) then Val.cmpf cmp rs#r1 rs#r2 else Val.notbool (Val.cmpf cmp rs#r1 rs#r2)) - /\ forall r', + /\ forall r', r' <> PC -> r' <> CR0_0 -> r' <> CR0_1 -> r' <> CR0_2 -> r' <> CR0_3 -> rs'#r' = rs#r'. Proof. - intros. + intros. generalize (compare_float_spec rs rs#r1 rs#r2). intros [A [B [C D]]]. set (rs1 := nextinstr (compare_float rs rs#r1 rs#r2)) in *. @@ -538,25 +538,25 @@ Proof. exists rs1. split. destruct H0 as [EQ|[EQ|[EQ|EQ]]]; subst cmp; apply exec_straight_one; reflexivity. - split. - destruct H0 as [EQ|[EQ|[EQ|EQ]]]; subst cmp; simpl; auto. + split. + destruct H0 as [EQ|[EQ|[EQ|EQ]]]; subst cmp; simpl; auto. rewrite Val.negate_cmpf_eq. auto. auto. (* two instrs *) exists (nextinstr (rs1#CR0_3 <- (Val.cmpf cmp rs#r1 rs#r2))). split. elim H0; intro; subst cmp. apply exec_straight_two with rs1 m. - reflexivity. simpl. + reflexivity. simpl. rewrite C; rewrite A. rewrite Val.or_commut. rewrite <- Val.cmpf_le. reflexivity. reflexivity. reflexivity. apply exec_straight_two with rs1 m. - reflexivity. simpl. + reflexivity. simpl. rewrite C; rewrite B. rewrite Val.or_commut. rewrite <- Val.cmpf_ge. reflexivity. reflexivity. reflexivity. split. elim H0; intro; subst cmp; simpl. reflexivity. reflexivity. - intros. Simpl. + intros. Simpl. Qed. (** Translation of conditions. *) @@ -580,7 +580,7 @@ Lemma transl_cond_correct_1: transl_cond cond args k = OK c -> exists rs', exec_straight ge fn c rs m k rs' m - /\ rs'#(reg_of_crbit (fst (crbit_for_cond cond))) = + /\ rs'#(reg_of_crbit (fst (crbit_for_cond cond))) = (if snd (crbit_for_cond cond) then Val.of_optbool (eval_condition cond (map rs (map preg_of args)) m) else Val.notbool (Val.of_optbool (eval_condition cond (map rs (map preg_of args)) m))) @@ -594,7 +594,7 @@ Opaque Int.eq. destruct (compare_sint_spec rs (rs x) (rs x0)) as [A [B [C D]]]. econstructor; split. apply exec_straight_one. simpl; reflexivity. reflexivity. - split. + split. case c0; simpl; auto; rewrite <- Val.negate_cmp; simpl; auto. auto with asmgen. (* Ccompu *) @@ -602,7 +602,7 @@ Opaque Int.eq. destruct (compare_uint_spec rs m (rs x) (rs x0)) as [A [B [C D]]]. econstructor; split. apply exec_straight_one. simpl; reflexivity. reflexivity. - split. + split. case c0; simpl; auto; rewrite <- Val.negate_cmpu; simpl; auto. auto with asmgen. (* Ccompimm *) @@ -611,7 +611,7 @@ Opaque Int.eq. destruct (compare_sint_spec rs (rs x) (Vint i)) as [A [B [C D]]]. econstructor; split. apply exec_straight_one. simpl; reflexivity. reflexivity. - split. + split. case c0; simpl; auto; rewrite <- Val.negate_cmp; simpl; auto. auto with asmgen. destruct (loadimm_correct GPR0 i (Pcmpw x GPR0 :: k) rs m) as [rs1 [EX1 [RES1 OTH1]]]. @@ -620,8 +620,8 @@ Opaque Int.eq. exists (nextinstr (compare_sint rs1 (rs1 x) (Vint i))). split. eapply exec_straight_trans. eexact EX1. apply exec_straight_one. simpl. rewrite RES1; rewrite SAME; auto. - reflexivity. - split. rewrite SAME. + reflexivity. + split. rewrite SAME. case c0; simpl; auto; rewrite <- Val.negate_cmp; simpl; auto. intros. rewrite SAME; rewrite D; auto with asmgen. (* Ccompuimm *) @@ -630,7 +630,7 @@ Opaque Int.eq. destruct (compare_uint_spec rs m (rs x) (Vint i)) as [A [B [C D]]]. econstructor; split. apply exec_straight_one. simpl; reflexivity. reflexivity. - split. + split. case c0; simpl; auto; rewrite <- Val.negate_cmpu; simpl; auto. auto with asmgen. destruct (loadimm_correct GPR0 i (Pcmplw x GPR0 :: k) rs m) as [rs1 [EX1 [RES1 OTH1]]]. @@ -639,36 +639,36 @@ Opaque Int.eq. exists (nextinstr (compare_uint rs1 m (rs1 x) (Vint i))). split. eapply exec_straight_trans. eexact EX1. apply exec_straight_one. simpl. rewrite RES1; rewrite SAME; auto. - reflexivity. - split. rewrite SAME. + reflexivity. + split. rewrite SAME. case c0; simpl; auto; rewrite <- Val.negate_cmpu; simpl; auto. intros. rewrite SAME; rewrite D; auto with asmgen. (* Ccompf *) fold (Val.cmpf c0 (rs x) (rs x0)). destruct (floatcomp_correct c0 x x0 k rs m) as [rs' [EX [RES OTH]]]. - exists rs'. split. auto. - split. apply RES. + exists rs'. split. auto. + split. apply RES. auto with asmgen. (* Cnotcompf *) rewrite Val.notbool_negb_3. rewrite Val.notbool_idem4. fold (Val.cmpf c0 (rs x) (rs x0)). destruct (floatcomp_correct c0 x x0 k rs m) as [rs' [EX [RES OTH]]]. - exists rs'. split. auto. - split. rewrite RES. destruct (snd (crbit_for_fcmp c0)); auto. + exists rs'. split. auto. + split. rewrite RES. destruct (snd (crbit_for_fcmp c0)); auto. auto with asmgen. (* Cmaskzero *) destruct (andimm_base_correct GPR0 x i k rs m) as [rs' [A [B [C D]]]]. eauto with asmgen. - exists rs'. split. assumption. - split. rewrite C. destruct (rs x); auto. + exists rs'. split. assumption. + split. rewrite C. destruct (rs x); auto. auto with asmgen. (* Cmasknotzero *) destruct (andimm_base_correct GPR0 x i k rs m) as [rs' [A [B [C D]]]]. eauto with asmgen. - exists rs'. split. assumption. + exists rs'. split. assumption. split. rewrite C. destruct (rs x); auto. fold (option_map negb (Some (Int.eq (Int.and i0 i) Int.zero))). - rewrite Val.notbool_negb_3. rewrite Val.notbool_idem4. auto. + rewrite Val.notbool_negb_3. rewrite Val.notbool_idem4. auto. auto with asmgen. Qed. @@ -678,7 +678,7 @@ Lemma transl_cond_correct_2: eval_condition cond (map rs (map preg_of args)) m = Some b -> exists rs', exec_straight ge fn c rs m k rs' m - /\ rs'#(reg_of_crbit (fst (crbit_for_cond cond))) = + /\ rs'#(reg_of_crbit (fst (crbit_for_cond cond))) = (if snd (crbit_for_cond cond) then Val.of_bool b else Val.notbool (Val.of_bool b)) @@ -687,7 +687,7 @@ Proof. intros. replace (Val.of_bool b) with (Val.of_optbool (eval_condition cond rs ## (preg_of ## args) m)). - eapply transl_cond_correct_1; eauto. + eapply transl_cond_correct_1; eauto. rewrite H0; auto. Qed. @@ -699,14 +699,14 @@ Lemma transl_cond_correct_3: Mem.extends m m' -> exists rs', exec_straight ge fn c rs m' k rs' m' - /\ rs'#(reg_of_crbit (fst (crbit_for_cond cond))) = + /\ rs'#(reg_of_crbit (fst (crbit_for_cond cond))) = (if snd (crbit_for_cond cond) then Val.of_bool b else Val.notbool (Val.of_bool b)) /\ agree ms sp rs'. Proof. intros. - exploit transl_cond_correct_2. eauto. + exploit transl_cond_correct_2. eauto. eapply eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros [rs' [A [B C]]]. exists rs'; split. eauto. split. auto. apply agree_exten with rs; auto. @@ -722,21 +722,21 @@ Remark add_carry_eq0: Proof. intros. rewrite <- Int.sub_add_l. rewrite Int.add_zero_l. rewrite Int.sub_idem. rewrite Int.add_zero_l. fold (Int.not i). - predSpec Int.eq Int.eq_spec i Int.zero. + predSpec Int.eq Int.eq_spec i Int.zero. subst i. reflexivity. - unfold Val.of_bool, Vfalse. decEq. + unfold Val.of_bool, Vfalse. decEq. unfold Int.add_carry. rewrite Int.unsigned_zero. rewrite Int.unsigned_one. apply zlt_true. - generalize (Int.unsigned_range (Int.not i)); intro. + generalize (Int.unsigned_range (Int.not i)); intro. assert (Int.unsigned (Int.not i) <> Int.modulus - 1). red; intros. assert (Int.repr (Int.unsigned (Int.not i)) = Int.mone). Local Transparent Int.repr. - rewrite H1. apply Int.mkint_eq. reflexivity. - rewrite Int.repr_unsigned in H2. + rewrite H1. apply Int.mkint_eq. reflexivity. + rewrite Int.repr_unsigned in H2. assert (Int.not (Int.not i) = Int.zero). rewrite H2. apply Int.mkint_eq; reflexivity. - rewrite Int.not_involutive in H3. + rewrite Int.not_involutive in H3. congruence. omega. Qed. @@ -749,10 +749,10 @@ Remark add_carry_ne0: Proof. intros. fold (Int.not (Int.add i Int.mone)). rewrite Int.not_neg. rewrite (Int.add_commut (Int.neg (Int.add i Int.mone))). - rewrite <- Int.sub_add_opp. rewrite Int.sub_add_r. rewrite Int.sub_idem. + rewrite <- Int.sub_add_opp. rewrite Int.sub_add_r. rewrite Int.sub_idem. rewrite Int.add_zero_l. rewrite Int.add_neg_zero. rewrite Int.add_zero_l. Transparent Int.eq. - unfold Int.add_carry, Int.eq. + unfold Int.add_carry, Int.eq. rewrite Int.unsigned_zero. rewrite Int.unsigned_mone. unfold negb, Val.of_bool, Vtrue, Vfalse. destruct (zeq (Int.unsigned i) 0); decEq. @@ -774,25 +774,25 @@ Proof. (* eq 0 *) econstructor; split. eapply exec_straight_two; simpl; reflexivity. - split. Simpl. destruct (rs x0); simpl; auto. + split. Simpl. destruct (rs x0); simpl; auto. apply add_carry_eq0. intros; Simpl. (* ne 0 *) econstructor; split. eapply exec_straight_two; simpl; reflexivity. rewrite gpr_or_zero_not_zero; eauto with asmgen. - split. Simpl. destruct (rs x0); simpl; auto. + split. Simpl. destruct (rs x0); simpl; auto. apply add_carry_ne0. intros; Simpl. (* ge 0 *) econstructor; split. eapply exec_straight_two; simpl; reflexivity. - split. Simpl. rewrite Val.rolm_ge_zero. auto. + split. Simpl. rewrite Val.rolm_ge_zero. auto. intros; Simpl. (* lt 0 *) econstructor; split. apply exec_straight_one; simpl; reflexivity. - split. Simpl. rewrite Val.rolm_lt_zero. auto. + split. Simpl. rewrite Val.rolm_lt_zero. auto. intros; Simpl. (* default *) set (bit := fst (crbit_for_cond c)) in *. @@ -803,15 +803,15 @@ Proof. then k else Pxori x x (Cint Int.one) :: k)). generalize (transl_cond_correct_1 c rl k1 rs m c0 EQ0). - fold bit; fold isset. + fold bit; fold isset. intros [rs1 [EX1 [RES1 AG1]]]. destruct isset. (* bit set *) - econstructor; split. eapply exec_straight_trans. eexact EX1. + econstructor; split. eapply exec_straight_trans. eexact EX1. unfold k1. apply exec_straight_one; simpl; reflexivity. intuition Simpl. (* bit clear *) - econstructor; split. eapply exec_straight_trans. eexact EX1. + econstructor; split. eapply exec_straight_trans. eexact EX1. unfold k1. eapply exec_straight_two; simpl; reflexivity. intuition Simpl. rewrite RES1. destruct (eval_condition c rs ## (preg_of ## rl) m). destruct b; auto. auto. @@ -840,8 +840,8 @@ Opaque Int.eq. TranslOpSimpl. TranslOpSimpl. (* Ointconst *) - destruct (loadimm_correct x i k rs m) as [rs' [A [B C]]]. - exists rs'. auto with asmgen. + destruct (loadimm_correct x i k rs m) as [rs' [A [B C]]]. + exists rs'. auto with asmgen. (* Oaddrsymbol *) set (v' := Genv.symbol_address ge i i0). destruct (symbol_is_small_data i i0) eqn:SD; [ | destruct (symbol_is_rel_data i i0) ]. @@ -853,13 +853,13 @@ Opaque Val.add. (* relative data *) econstructor; split. eapply exec_straight_two; simpl; reflexivity. split. Simpl. rewrite gpr_or_zero_not_zero by eauto with asmgen. Simpl. - apply low_high_half_zero. + apply low_high_half_zero. intros; Simpl. (* absolute data *) econstructor; split. eapply exec_straight_two; simpl; reflexivity. split. Simpl. rewrite gpr_or_zero_not_zero; eauto with asmgen. Simpl. apply low_high_half_zero. - intros; Simpl. + intros; Simpl. (* Oaddrstack *) destruct (addimm_correct x GPR1 i k rs m) as [rs' [EX [RES OTH]]]; eauto with asmgen. exists rs'; auto with asmgen. @@ -869,21 +869,21 @@ Opaque Val.add. (* Oaddsymbol *) destruct (symbol_is_small_data i i0) eqn:SD; [ | destruct (symbol_is_rel_data i i0) ]. (* small data *) - econstructor; split. eapply exec_straight_two; simpl; reflexivity. + econstructor; split. eapply exec_straight_two; simpl; reflexivity. split. Simpl. rewrite (Val.add_commut (rs x)). f_equal. rewrite small_data_area_addressing by auto. apply add_zero_symbol_address. intros; Simpl. (* relative data *) - econstructor; split. eapply exec_straight_trans. + econstructor; split. eapply exec_straight_trans. eapply exec_straight_two; simpl; reflexivity. eapply exec_straight_two; simpl; reflexivity. split. assert (GPR0 <> x0) by (apply sym_not_equal; eauto with asmgen). Simpl. rewrite ! gpr_or_zero_zero. rewrite ! gpr_or_zero_not_zero by eauto with asmgen. Simpl. rewrite low_high_half_zero. auto. - intros; Simpl. + intros; Simpl. (* absolute data *) econstructor; split. eapply exec_straight_two; simpl; reflexivity. - split. Simpl. rewrite ! gpr_or_zero_not_zero by (eauto with asmgen). Simpl. + split. Simpl. rewrite ! gpr_or_zero_not_zero by (eauto with asmgen). Simpl. rewrite Val.add_assoc. rewrite (Val.add_commut (rs x)). rewrite low_high_half. auto. intros; Simpl. (* Osubimm *) @@ -892,7 +892,7 @@ Opaque Val.add. destruct (loadimm_correct GPR0 i (Psubfc x0 x GPR0 :: k) rs m) as [rs1 [EX [RES OTH]]]. econstructor; split. eapply exec_straight_trans. eexact EX. apply exec_straight_one; simpl; reflexivity. - split. Simpl. rewrite RES. rewrite OTH; eauto with asmgen. + split. Simpl. rewrite RES. rewrite OTH; eauto with asmgen. intros; Simpl. (* Omulimm *) case (Int.eq (high_s i) Int.zero). @@ -900,15 +900,15 @@ Opaque Val.add. destruct (loadimm_correct GPR0 i (Pmullw x0 x GPR0 :: k) rs m) as [rs1 [EX [RES OTH]]]. econstructor; split. eapply exec_straight_trans. eexact EX. apply exec_straight_one; simpl; reflexivity. - split. Simpl. rewrite RES. rewrite OTH; eauto with asmgen. + split. Simpl. rewrite RES. rewrite OTH; eauto with asmgen. intros; Simpl. (* Odivs *) replace v with (Val.maketotal (Val.divs (rs x) (rs x0))). - TranslOpSimpl. + TranslOpSimpl. rewrite H1; auto. (* Odivu *) replace v with (Val.maketotal (Val.divu (rs x) (rs x0))). - TranslOpSimpl. + TranslOpSimpl. rewrite H1; auto. (* Oand *) set (v' := Val.and (rs x) (rs x0)) in *. @@ -932,8 +932,8 @@ Opaque Val.add. destruct (rs x); simpl; auto. rewrite Int.or_idem. auto. (* Oshrximm *) econstructor; split. - eapply exec_straight_two; simpl; reflexivity. - split. Simpl. apply Val.shrx_carry. auto. + eapply exec_straight_two; simpl; reflexivity. + split. Simpl. apply Val.shrx_carry. auto. intros; Simpl. (* Orolm *) destruct (rolm_correct x0 x i i0 k rs m) as [rs' [A [B C]]]; eauto with asmgen. @@ -957,9 +957,9 @@ Lemma transl_op_correct: /\ agree (Regmap.set res v (Mach.undef_regs (destroyed_by_op op) ms)) sp rs' /\ forall r, data_preg r = true -> r <> preg_of res -> preg_notin r (destroyed_by_op op) -> rs' r = rs r. Proof. - intros. - exploit eval_operation_lessdef. eapply preg_vals; eauto. eauto. eauto. - intros [v' [A B]]. rewrite (sp_val _ _ _ H0) in A. + intros. + exploit eval_operation_lessdef. eapply preg_vals; eauto. eauto. eauto. + intros [v' [A B]]. rewrite (sp_val _ _ _ H0) in A. exploit transl_op_correct_aux; eauto. intros [rs' [P [Q R]]]. rewrite <- Q in B. exists rs'; split. eexact P. @@ -987,7 +987,7 @@ Lemma transl_memory_access_correct: exists rs', exec_straight ge fn c rs m k rs' m' /\ P rs'. Proof. - intros until m'; intros TR ADDR TEMP MK1 MK2. + intros until m'; intros TR ADDR TEMP MK1 MK2. unfold transl_memory_access in TR; destruct addr; ArgsInv; simpl in ADDR; inv ADDR. (* Aindexed *) case (Int.eq (high_s i) Int.zero). @@ -1003,37 +1003,37 @@ Transparent Val.add. intros; unfold rs1; Simpl. intros [rs' [EX' AG']]. exists rs'. split. apply exec_straight_step with rs1 m. - simpl. rewrite gpr_or_zero_not_zero; eauto with asmgen. auto. + simpl. rewrite gpr_or_zero_not_zero; eauto with asmgen. auto. auto. auto. (* Aindexed2 *) apply MK2; auto. (* Aglobal *) destruct (symbol_is_small_data i i0) eqn:SISD; [ | destruct (symbol_is_rel_data i i0) ]; inv TR. (* Aglobal from small data *) - apply MK1. unfold const_low. rewrite small_data_area_addressing by auto. + apply MK1. unfold const_low. rewrite small_data_area_addressing by auto. apply add_zero_symbol_address. auto. (* Aglobal from relative data *) set (rs1 := nextinstr (rs#temp <- (Val.add Vzero (high_half ge i i0)))). set (rs2 := nextinstr (rs1#temp <- (Genv.symbol_address ge i i0))). exploit (MK1 (Cint Int.zero) temp rs2). - simpl. rewrite gpr_or_zero_not_zero by eauto with asmgen. + simpl. rewrite gpr_or_zero_not_zero by eauto with asmgen. unfold rs2. Simpl. rewrite Val.add_commut. apply add_zero_symbol_address. - intros; unfold rs2, rs1; Simpl. + intros; unfold rs2, rs1; Simpl. intros [rs' [EX' AG']]. - exists rs'; split. apply exec_straight_step with rs1 m; auto. - apply exec_straight_step with rs2 m; auto. simpl. unfold rs2. + exists rs'; split. apply exec_straight_step with rs1 m; auto. + apply exec_straight_step with rs2 m; auto. simpl. unfold rs2. rewrite gpr_or_zero_not_zero by eauto with asmgen. f_equal. f_equal. f_equal. unfold rs1; Simpl. apply low_high_half_zero. eexact EX'. auto. (* Aglobal from absolute data *) set (rs1 := nextinstr (rs#temp <- (Val.add Vzero (high_half ge i i0)))). exploit (MK1 (Csymbol_low i i0) temp rs1). - simpl. rewrite gpr_or_zero_not_zero by eauto with asmgen. - unfold rs1. Simpl. apply low_high_half_zero. - intros; unfold rs1; Simpl. + simpl. rewrite gpr_or_zero_not_zero by eauto with asmgen. + unfold rs1. Simpl. apply low_high_half_zero. + intros; unfold rs1; Simpl. intros [rs' [EX' AG']]. - exists rs'; split. apply exec_straight_step with rs1 m; auto. + exists rs'; split. apply exec_straight_step with rs1 m; auto. eexact EX'. auto. (* Abased *) destruct (symbol_is_small_data i i0) eqn:SISD; [ | destruct (symbol_is_rel_data i i0) ]. @@ -1043,8 +1043,8 @@ Transparent Val.add. unfold rs1; Simpl. apply Val.add_commut. intros. unfold rs1; Simpl. intros [rs' [EX' AG']]. - exists rs'; split. apply exec_straight_step with rs1 m. - unfold exec_instr. rewrite gpr_or_zero_zero. f_equal. unfold rs1. f_equal. f_equal. + exists rs'; split. apply exec_straight_step with rs1 m. + unfold exec_instr. rewrite gpr_or_zero_zero. f_equal. unfold rs1. f_equal. f_equal. unfold const_low. rewrite small_data_area_addressing; auto. apply add_zero_symbol_address. reflexivity. @@ -1054,20 +1054,20 @@ Transparent Val.add. set (rs2 := nextinstr (rs1#temp <- (Val.add Vzero (high_half ge i i0)))). set (rs3 := nextinstr (rs2#temp <- (Genv.symbol_address ge i i0))). exploit (MK2 temp GPR0 rs3). - f_equal. unfold rs3; Simpl. unfold rs3, rs2, rs1; Simpl. + f_equal. unfold rs3; Simpl. unfold rs3, rs2, rs1; Simpl. intros. unfold rs3, rs2, rs1; Simpl. intros [rs' [EX' AG']]. - exists rs'. split. eapply exec_straight_trans with (rs2 := rs3) (m2 := m). - apply exec_straight_three with rs1 m rs2 m; auto. - simpl. unfold rs3. f_equal. f_equal. f_equal. rewrite gpr_or_zero_not_zero by auto. - unfold rs2; Simpl. apply low_high_half_zero. - eexact EX'. auto. + exists rs'. split. eapply exec_straight_trans with (rs2 := rs3) (m2 := m). + apply exec_straight_three with rs1 m rs2 m; auto. + simpl. unfold rs3. f_equal. f_equal. f_equal. rewrite gpr_or_zero_not_zero by auto. + unfold rs2; Simpl. apply low_high_half_zero. + eexact EX'. auto. (* Abased absolute *) set (rs1 := nextinstr (rs#temp <- (Val.add (rs x) (high_half ge i i0)))). exploit (MK1 (Csymbol_low i i0) temp rs1 k). simpl. rewrite gpr_or_zero_not_zero; eauto with asmgen. - unfold rs1. Simpl. - rewrite Val.add_assoc. rewrite low_high_half. apply Val.add_commut. + unfold rs1. Simpl. + rewrite Val.add_assoc. rewrite low_high_half. apply Val.add_commut. intros; unfold rs1; Simpl. intros [rs' [EX' AG']]. exists rs'. split. apply exec_straight_step with rs1 m. @@ -1075,10 +1075,10 @@ Transparent Val.add. assumption. assumption. (* Ainstack *) destruct (Int.eq (high_s i) Int.zero); inv TR. - apply MK1. simpl. rewrite gpr_or_zero_not_zero; eauto with asmgen. auto. + apply MK1. simpl. rewrite gpr_or_zero_not_zero; eauto with asmgen. auto. set (rs1 := nextinstr (rs#temp <- (Val.add rs#GPR1 (Vint (Int.shl (high_s i) (Int.repr 16)))))). exploit (MK1 (Cint (low_s i)) temp rs1 k). - simpl. rewrite gpr_or_zero_not_zero; auto. + simpl. rewrite gpr_or_zero_not_zero; auto. unfold rs1. rewrite nextinstr_inv. rewrite Pregmap.gss. rewrite Val.add_assoc. simpl. rewrite low_high_s. auto. congruence. @@ -1117,12 +1117,12 @@ Proof. /\ forall r, r <> PC -> r <> GPR12 -> r <> GPR0 -> r <> preg_of dst -> rs' r = rs r). { intros. eapply transl_memory_access_correct; eauto. congruence. - intros. econstructor; split. apply exec_straight_one. - rewrite H4. unfold load1. rewrite H6. rewrite H3. eauto. + intros. econstructor; split. apply exec_straight_one. + rewrite H4. unfold load1. rewrite H6. rewrite H3. eauto. unfold nextinstr. rewrite Pregmap.gss. rewrite Pregmap.gso; auto with asmgen. intuition Simpl. - intros. econstructor; split. apply exec_straight_one. - rewrite H5. unfold load2. rewrite H6. rewrite H3. eauto. + intros. econstructor; split. apply exec_straight_one. + rewrite H5. unfold load2. rewrite H6. rewrite H3. eauto. unfold nextinstr. rewrite Pregmap.gss. rewrite Pregmap.gso; auto with asmgen. intuition Simpl. } @@ -1130,17 +1130,17 @@ Proof. - (* Mint8signed *) assert (exists v1, Mem.loadv Mint8unsigned m a = Some v1 /\ v = Val.sign_ext 8 v1). { - destruct a; simpl in *; try discriminate. - rewrite Mem.load_int8_signed_unsigned in H1. + destruct a; simpl in *; try discriminate. + rewrite Mem.load_int8_signed_unsigned in H1. destruct (Mem.load Mint8unsigned m b (Int.unsigned i)); simpl in H1; inv H1. exists v0; auto. } - destruct H as [v1 [LD SG]]. clear H1. + destruct H as [v1 [LD SG]]. clear H1. exploit BASE; eauto; erewrite ireg_of_eq by eauto; auto. intros [rs1 [A [B C]]]. - econstructor; split. - eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto. - split. Simpl. congruence. intros. Simpl. + econstructor; split. + eapply exec_straight_trans. eexact A. apply exec_straight_one. simpl; eauto. auto. + split. Simpl. congruence. intros. Simpl. - (* Mint8unsigned *) eapply BASE; eauto; erewrite ireg_of_eq by eauto; auto. - (* Mint816signed *) @@ -1173,9 +1173,9 @@ Local Transparent destroyed_by_store. assert (TEMP1: int_temp_for src <> GPR0). destruct TEMP0; congruence. assert (TEMP2: IR (int_temp_for src) <> preg_of src). - unfold int_temp_for. destruct (mreg_eq src R12). + unfold int_temp_for. destruct (mreg_eq src R12). subst src; simpl; congruence. - change (IR GPR12) with (preg_of R12). red; intros; elim n. + change (IR GPR12) with (preg_of R12). red; intros; elim n. eapply preg_of_injective; eauto. assert (BASE: forall mk1 mk2 chunk', transl_memory_access mk1 mk2 addr args (int_temp_for src) k = OK c -> @@ -1191,12 +1191,12 @@ Local Transparent destroyed_by_store. /\ forall r, r <> PC -> r <> GPR0 -> r <> GPR11 /\ r <> GPR12 -> rs' r = rs r). { intros. eapply transl_memory_access_correct; eauto. - intros. econstructor; split. apply exec_straight_one. - rewrite H4. unfold store1. rewrite H6. rewrite H7; auto with asmgen. rewrite H3. eauto. auto. - intros; Simpl. apply H7; auto. destruct TEMP0; destruct H10; congruence. - intros. econstructor; split. apply exec_straight_one. - rewrite H5. unfold store2. rewrite H6. rewrite H7; auto with asmgen. rewrite H3. eauto. auto. - intros; Simpl. apply H7; auto. destruct TEMP0; destruct H10; congruence. + intros. econstructor; split. apply exec_straight_one. + rewrite H4. unfold store1. rewrite H6. rewrite H7; auto with asmgen. rewrite H3. eauto. auto. + intros; Simpl. apply H7; auto. destruct TEMP0; destruct H10; congruence. + intros. econstructor; split. apply exec_straight_one. + rewrite H5. unfold store2. rewrite H6. rewrite H7; auto with asmgen. rewrite H3. eauto. auto. + intros; Simpl. apply H7; auto. destruct TEMP0; destruct H10; congruence. } destruct chunk; monadInv H. - (* Mint8signed *) diff --git a/powerpc/CBuiltins.ml b/powerpc/CBuiltins.ml index a9e4f5e3..106ba4d0 100644 --- a/powerpc/CBuiltins.ml +++ b/powerpc/CBuiltins.ml @@ -19,7 +19,7 @@ open C let builtins = { Builtins.typedefs = [ - "__builtin_va_list", + "__builtin_va_list", TArray(TInt(IUInt, []), Some 3L, []) ]; Builtins.functions = [ @@ -40,19 +40,19 @@ let builtins = { (TInt (IUInt, []), [TInt(IUInt, []);TInt(IUInt, [])], false); (* Float arithmetic *) "__builtin_fmadd", - (TFloat(FDouble, []), + (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); "__builtin_fmsub", - (TFloat(FDouble, []), + (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); "__builtin_fnmadd", - (TFloat(FDouble, []), + (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); "__builtin_fnmsub", - (TFloat(FDouble, []), + (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); "__builtin_fsqrt", @@ -62,7 +62,7 @@ let builtins = { "__builtin_fres", (TFloat(FFloat, []), [TFloat(FFloat, [])], false); "__builtin_fsel", - (TFloat(FDouble, []), + (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); "__builtin_fcti", diff --git a/powerpc/CombineOp.v b/powerpc/CombineOp.v index 6ad6987d..15ddb76f 100644 --- a/powerpc/CombineOp.v +++ b/powerpc/CombineOp.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Recognition of combined operations, addressing modes and conditions +(** Recognition of combined operations, addressing modes and conditions during the [CSE] phase. *) Require Import Coqlib. @@ -95,7 +95,7 @@ Function combine_op (op: operation) (args: list valnum) : option(operation * lis end | Oandimm n, x :: nil => match get x with - | Some(Op (Oandimm m) ys) => + | Some(Op (Oandimm m) ys) => Some(let p := Int.and m n in if Int.eq p m then (Omove, x :: nil) else (Oandimm p, ys)) | Some(Op (Orolm amount m) ys) => diff --git a/powerpc/CombineOpproof.v b/powerpc/CombineOpproof.v index 4d8fed78..4883876d 100644 --- a/powerpc/CombineOpproof.v +++ b/powerpc/CombineOpproof.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Recognition of combined operations, addressing modes and conditions +(** Recognition of combined operations, addressing modes and conditions during the [CSE] phase. *) Require Import Coqlib. @@ -36,7 +36,7 @@ Hypothesis get_sound: forall v rhs, get v = Some rhs -> rhs_eval_to valu ge sp m Lemma get_op_sound: forall v op vl, get v = Some (Op op vl) -> eval_operation ge sp op (map valu vl) m = Some (valu v). Proof. - intros. exploit get_sound; eauto. intros REV; inv REV; auto. + intros. exploit get_sound; eauto. intros REV; inv REV; auto. Qed. Ltac UseGetSound := @@ -44,7 +44,7 @@ Ltac UseGetSound := | [ H: get _ = Some _ |- _ ] => let x := fresh "EQ" in (generalize (get_op_sound _ _ _ H); intros x; simpl in x; FuncInv) end. - + Lemma combine_compimm_ne_0_sound: forall x cond args, combine_compimm_ne_0 get x = Some(cond, args) -> @@ -53,11 +53,11 @@ Lemma combine_compimm_ne_0_sound: Proof. intros until args. functional induction (combine_compimm_ne_0 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. + UseGetSound. rewrite <- H. destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto. (* of and *) - UseGetSound. rewrite <- H. - destruct v; simpl; auto. + UseGetSound. rewrite <- H. + destruct v; simpl; auto. Qed. Lemma combine_compimm_eq_0_sound: @@ -69,10 +69,10 @@ Proof. intros until args. functional induction (combine_compimm_eq_0 get x); intros EQ; inv EQ. (* of cmp *) UseGetSound. rewrite <- H. - rewrite eval_negate_condition. + rewrite eval_negate_condition. destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto. (* of and *) - UseGetSound. rewrite <- H. destruct v; auto. + UseGetSound. rewrite <- H. destruct v; auto. Qed. Lemma combine_compimm_eq_1_sound: @@ -83,7 +83,7 @@ Lemma combine_compimm_eq_1_sound: Proof. intros until args. functional induction (combine_compimm_eq_1 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. + UseGetSound. rewrite <- H. destruct (eval_condition cond (map valu args) m); simpl; auto. destruct b; auto. Qed. @@ -95,7 +95,7 @@ Lemma combine_compimm_ne_1_sound: Proof. intros until args. functional induction (combine_compimm_ne_1 get x); intros EQ; inv EQ. (* of cmp *) - UseGetSound. rewrite <- H. + UseGetSound. rewrite <- H. rewrite eval_negate_condition. destruct (eval_condition c (map valu args) m); simpl; auto. destruct b; auto. Qed. @@ -131,7 +131,7 @@ Theorem combine_addr_sound: Proof. intros. functional inversion H; subst. (* indexed - addimm *) - UseGetSound. simpl; rewrite <- H0. rewrite Val.add_assoc. auto. + UseGetSound. simpl; rewrite <- H0. rewrite Val.add_assoc. auto. Qed. Theorem combine_op_sound: @@ -144,27 +144,27 @@ Proof. UseGetSound; simpl. rewrite <- H0. rewrite Val.add_assoc. auto. (* addimm - subimm *) Opaque Val.sub. - UseGetSound; simpl. rewrite <- H0. + UseGetSound; simpl. rewrite <- H0. change (Vint (Int.add m0 n)) with (Val.add (Vint m0) (Vint n)). rewrite Val.sub_add_l. auto. (* subimm - addimm *) - UseGetSound; simpl. rewrite <- H0. + UseGetSound; simpl. rewrite <- H0. Transparent Val.sub. destruct v; simpl; auto. repeat rewrite Int.sub_add_opp. rewrite Int.add_assoc. rewrite Int.neg_add_distr. decEq. decEq. decEq. apply Int.add_commut. (* andimm - andimm *) - UseGetSound; simpl. - generalize (Int.eq_spec p m0); rewrite H7; intros. + UseGetSound; simpl. + generalize (Int.eq_spec p m0); rewrite H7; intros. rewrite <- H0. rewrite Val.and_assoc. simpl. fold p. rewrite H1. auto. - UseGetSound; simpl. + UseGetSound; simpl. rewrite <- H0. rewrite Val.and_assoc. auto. (* andimm - rolm *) - UseGetSound; simpl. - generalize (Int.eq_spec p m0); rewrite H7; intros. - rewrite <- H0. destruct v; simpl; auto. unfold Int.rolm. + UseGetSound; simpl. + generalize (Int.eq_spec p m0); rewrite H7; intros. + rewrite <- H0. destruct v; simpl; auto. unfold Int.rolm. rewrite Int.and_assoc. fold p. rewrite H1. auto. - UseGetSound; simpl. - rewrite <- H0. destruct v; simpl; auto. unfold Int.rolm. + UseGetSound; simpl. + rewrite <- H0. destruct v; simpl; auto. unfold Int.rolm. rewrite Int.and_assoc. auto. (* orimm *) UseGetSound; simpl. rewrite <- H0. rewrite Val.or_assoc. auto. @@ -172,10 +172,10 @@ Transparent Val.sub. UseGetSound; simpl. rewrite <- H0. rewrite Val.xor_assoc. auto. (* rolm - andimm *) UseGetSound; simpl. rewrite <- H0. - rewrite <- Val.rolm_zero. rewrite Val.rolm_rolm. + rewrite <- Val.rolm_zero. rewrite Val.rolm_rolm. rewrite (Int.add_commut Int.zero). rewrite Int.add_zero. auto. (* rolm - rolm *) - UseGetSound; simpl. rewrite <- H0. rewrite Val.rolm_rolm. auto. + UseGetSound; simpl. rewrite <- H0. rewrite Val.rolm_rolm. auto. (* cmp *) simpl. decEq; decEq. eapply combine_cond_sound; eauto. Qed. diff --git a/powerpc/ConstpropOpproof.v b/powerpc/ConstpropOpproof.v index aac37dc6..eb68f586 100644 --- a/powerpc/ConstpropOpproof.v +++ b/powerpc/ConstpropOpproof.v @@ -51,7 +51,7 @@ Lemma match_G: forall r id ofs, AE.get r ae = Ptr(Gl id ofs) -> Val.lessdef rs#r (Genv.symbol_address ge id ofs). Proof. - intros. apply vmatch_ptr_gl with bc; auto. rewrite <- H. apply MATCH. + intros. apply vmatch_ptr_gl with bc; auto. rewrite <- H. apply MATCH. Qed. Lemma match_S: @@ -63,9 +63,9 @@ Qed. Ltac InvApproxRegs := match goal with - | [ H: _ :: _ = _ :: _ |- _ ] => + | [ H: _ :: _ = _ :: _ |- _ ] => injection H; clear H; intros; InvApproxRegs - | [ H: ?v = AE.get ?r ae |- _ ] => + | [ H: ?v = AE.get ?r ae |- _ ] => generalize (MATCH r); rewrite <- H; clear H; intro; InvApproxRegs | _ => idtac end. @@ -86,11 +86,11 @@ Ltac SimplVM := rewrite E in *; clear H; SimplVM | [ H: vmatch _ ?v (Ptr(Gl ?id ?ofs)) |- _ ] => let E := fresh in - assert (E: Val.lessdef v (Genv.symbol_address ge id ofs)) by (eapply vmatch_ptr_gl; eauto); + assert (E: Val.lessdef v (Genv.symbol_address ge id ofs)) by (eapply vmatch_ptr_gl; eauto); clear H; SimplVM | [ H: vmatch _ ?v (Ptr(Stk ?ofs)) |- _ ] => let E := fresh in - assert (E: Val.lessdef v (Vptr sp ofs)) by (eapply vmatch_ptr_stk; eauto); + assert (E: Val.lessdef v (Vptr sp ofs)) by (eapply vmatch_ptr_stk; eauto); clear H; SimplVM | _ => idtac end. @@ -114,20 +114,20 @@ Lemma make_cmp_base_correct: forall c args vl, vl = map (fun r => AE.get r ae) args -> let (op', args') := make_cmp_base c args vl in - exists v, eval_operation ge (Vptr sp Int.zero) op' rs##args' m = Some v + exists v, eval_operation ge (Vptr sp Int.zero) op' rs##args' m = Some v /\ Val.lessdef (Val.of_optbool (eval_condition c rs##args m)) v. Proof. - intros. unfold make_cmp_base. - generalize (cond_strength_reduction_correct c args vl H). + intros. unfold make_cmp_base. + generalize (cond_strength_reduction_correct c args vl H). destruct (cond_strength_reduction c args vl) as [c' args']. intros EQ. - econstructor; split. simpl; eauto. rewrite EQ. auto. + econstructor; split. simpl; eauto. rewrite EQ. auto. Qed. Lemma make_cmp_correct: forall c args vl, vl = map (fun r => AE.get r ae) args -> let (op', args') := make_cmp c args vl in - exists v, eval_operation ge (Vptr sp Int.zero) op' rs##args' m = Some v + exists v, eval_operation ge (Vptr sp Int.zero) op' rs##args' m = Some v /\ Val.lessdef (Val.of_optbool (eval_condition c rs##args m)) v. Proof. intros c args vl. @@ -136,20 +136,20 @@ Proof. { intros. apply vmatch_Uns_1 with bc Ptop. eapply vmatch_ge. eapply vincl_ge; eauto. apply MATCH. } unfold make_cmp. case (make_cmp_match c args vl); intros. - destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (rs#r1); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (Val.xor rs#r1 (Vint Int.one)); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. apply make_cmp_base_correct; auto. - destruct (Int.eq_dec n Int.zero && vincl v1 (Uns Ptop 1)) eqn:E0. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (rs#r1); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. destruct (Int.eq_dec n Int.one && vincl v1 (Uns Ptop 1)) eqn:E1. - simpl in H; inv H. InvBooleans. subst n. + simpl in H; inv H. InvBooleans. subst n. exists (Val.xor rs#r1 (Vint Int.one)); split; auto. simpl. exploit Y; eauto. intros [A | [A | A]]; rewrite A; simpl; auto. apply make_cmp_base_correct; auto. @@ -162,7 +162,7 @@ Lemma make_addimm_correct: exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.add rs#r (Vint n)) v. Proof. intros. unfold make_addimm. - predSpec Int.eq Int.eq_spec n Int.zero; intros. + predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (rs#r); split; auto. destruct (rs#r); simpl; auto; rewrite Int.add_zero; auto. exists (Val.add rs#r (Vint n)); auto. Qed. @@ -177,7 +177,7 @@ Proof. predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shl_zero. auto. destruct (Int.ltu n Int.iwordsize) eqn:?; intros. - rewrite Val.shl_rolm; auto. econstructor; split; eauto. auto. + rewrite Val.shl_rolm; auto. econstructor; split; eauto. auto. econstructor; split; eauto. simpl. congruence. Qed. @@ -205,7 +205,7 @@ Proof. predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shru_zero. auto. destruct (Int.ltu n Int.iwordsize) eqn:?; intros. - rewrite Val.shru_rolm; auto. econstructor; split; eauto. auto. + rewrite Val.shru_rolm; auto. econstructor; split; eauto. auto. econstructor; split; eauto. simpl. congruence. Qed. @@ -221,10 +221,10 @@ Proof. predSpec Int.eq Int.eq_spec n Int.one; intros. subst. exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.mul_one; auto. destruct (Int.is_power2 n) eqn:?; intros. - rewrite (Val.mul_pow2 rs#r1 _ _ Heqo). rewrite Val.shl_rolm. - econstructor; split; eauto. auto. + rewrite (Val.mul_pow2 rs#r1 _ _ Heqo). rewrite Val.shl_rolm. + econstructor; split; eauto. auto. eapply Int.is_power2_range; eauto. - econstructor; split; eauto. auto. + econstructor; split; eauto. auto. Qed. Lemma make_divimm_correct: @@ -235,9 +235,9 @@ Lemma make_divimm_correct: exists w, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some w /\ Val.lessdef v w. Proof. intros; unfold make_divimm. - destruct (Int.is_power2 n) eqn:?. + destruct (Int.is_power2 n) eqn:?. destruct (Int.ltu i (Int.repr 31)) eqn:?. - exists v; split; auto. simpl. eapply Val.divs_pow2; eauto. congruence. + exists v; split; auto. simpl. eapply Val.divs_pow2; eauto. congruence. exists v; auto. exists v; auto. Qed. @@ -250,11 +250,11 @@ Lemma make_divuimm_correct: exists w, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some w /\ Val.lessdef v w. Proof. intros; unfold make_divuimm. - destruct (Int.is_power2 n) eqn:?. + destruct (Int.is_power2 n) eqn:?. econstructor; split. simpl; eauto. exploit Int.is_power2_range; eauto. intros RANGE. - rewrite <- Val.shru_rolm; auto. rewrite H0 in H. - destruct (rs#r1); simpl in *; inv H. + rewrite <- Val.shru_rolm; auto. rewrite H0 in H. + destruct (rs#r1); simpl in *; inv H. destruct (Int.eq n Int.zero); inv H2. rewrite RANGE. rewrite (Int.divu_pow2 i0 _ _ Heqo). auto. exists v; auto. @@ -273,17 +273,17 @@ Proof. subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.and_mone; auto. destruct (match x with Uns _ k => Int.eq (Int.zero_ext k (Int.not n)) Int.zero | _ => false end) eqn:UNS. - destruct x; try congruence. + destruct x; try congruence. exists (rs#r); split; auto. inv H; auto. simpl. replace (Int.and i n) with i; auto. generalize (Int.eq_spec (Int.zero_ext n0 (Int.not n)) Int.zero); rewrite UNS; intro EQ. Int.bit_solve. destruct (zlt i0 n0). replace (Int.testbit n i0) with (negb (Int.testbit Int.zero i0)). - rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. - rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. - rewrite Int.bits_not by auto. apply negb_involutive. - rewrite H6 by auto. auto. - econstructor; split; eauto. auto. + rewrite Int.bits_zero. simpl. rewrite andb_true_r. auto. + rewrite <- EQ. rewrite Int.bits_zero_ext by omega. rewrite zlt_true by auto. + rewrite Int.bits_not by auto. apply negb_involutive. + rewrite H6 by auto. auto. + econstructor; split; eauto. auto. Qed. Lemma make_orimm_correct: @@ -296,7 +296,7 @@ Proof. subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.or_zero; auto. predSpec Int.eq Int.eq_spec n Int.mone; intros. subst n. exists (Vint Int.mone); split; auto. destruct (rs#r); simpl; auto. rewrite Int.or_mone; auto. - econstructor; split; eauto. auto. + econstructor; split; eauto. auto. Qed. Lemma make_xorimm_correct: @@ -306,10 +306,10 @@ Lemma make_xorimm_correct: Proof. intros; unfold make_xorimm. predSpec Int.eq Int.eq_spec n Int.zero; intros. - subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.xor_zero; auto. + subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.xor_zero; auto. predSpec Int.eq Int.eq_spec n Int.mone; intros. - subst n. exists (Val.notint rs#r); split; auto. - econstructor; split; eauto. auto. + subst n. exists (Val.notint rs#r); split; auto. + econstructor; split; eauto. auto. Qed. Lemma make_mulfimm_correct: @@ -318,11 +318,11 @@ Lemma make_mulfimm_correct: let (op, args) := make_mulfimm n r1 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.mulf rs#r1 rs#r2) v. Proof. - intros; unfold make_mulfimm. - destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. + intros; unfold make_mulfimm. + destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (rs#r1); simpl; auto. rewrite Float.mul2_add; auto. - simpl. econstructor; split; eauto. + destruct (rs#r1); simpl; auto. rewrite Float.mul2_add; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_mulfimm_correct_2: @@ -331,12 +331,12 @@ Lemma make_mulfimm_correct_2: let (op, args) := make_mulfimm n r2 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.mulf rs#r1 rs#r2) v. Proof. - intros; unfold make_mulfimm. - destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. + intros; unfold make_mulfimm. + destruct (Float.eq_dec n (Float.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (rs#r2); simpl; auto. rewrite Float.mul2_add; auto. - rewrite Float.mul_commut; auto. - simpl. econstructor; split; eauto. + destruct (rs#r2); simpl; auto. rewrite Float.mul2_add; auto. + rewrite Float.mul_commut; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_mulfsimm_correct: @@ -345,11 +345,11 @@ Lemma make_mulfsimm_correct: let (op, args) := make_mulfsimm n r1 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.mulfs rs#r1 rs#r2) v. Proof. - intros; unfold make_mulfsimm. - destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. + intros; unfold make_mulfsimm. + destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (rs#r1); simpl; auto. rewrite Float32.mul2_add; auto. - simpl. econstructor; split; eauto. + destruct (rs#r1); simpl; auto. rewrite Float32.mul2_add; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_mulfsimm_correct_2: @@ -358,12 +358,12 @@ Lemma make_mulfsimm_correct_2: let (op, args) := make_mulfsimm n r2 r1 r2 in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.mulfs rs#r1 rs#r2) v. Proof. - intros; unfold make_mulfsimm. - destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. + intros; unfold make_mulfsimm. + destruct (Float32.eq_dec n (Float32.of_int (Int.repr 2))); intros. simpl. econstructor; split. eauto. rewrite H; subst n. - destruct (rs#r2); simpl; auto. rewrite Float32.mul2_add; auto. - rewrite Float32.mul_commut; auto. - simpl. econstructor; split; eauto. + destruct (rs#r2); simpl; auto. rewrite Float32.mul2_add; auto. + rewrite Float32.mul_commut; auto. + simpl. econstructor; split; eauto. Qed. Lemma make_cast8signed_correct: @@ -372,8 +372,8 @@ Lemma make_cast8signed_correct: let (op, args) := make_cast8signed r x in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.sign_ext 8 rs#r) v. Proof. - intros; unfold make_cast8signed. destruct (vincl x (Sgn Ptop 8)) eqn:INCL. - exists rs#r; split; auto. + intros; unfold make_cast8signed. destruct (vincl x (Sgn Ptop 8)) eqn:INCL. + exists rs#r; split; auto. assert (V: vmatch bc rs#r (Sgn Ptop 8)). { eapply vmatch_ge; eauto. apply vincl_ge; auto. } inv V; simpl; auto. rewrite is_sgn_sign_ext in H4 by auto. rewrite H4; auto. @@ -386,8 +386,8 @@ Lemma make_cast16signed_correct: let (op, args) := make_cast16signed r x in exists v, eval_operation ge (Vptr sp Int.zero) op rs##args m = Some v /\ Val.lessdef (Val.sign_ext 16 rs#r) v. Proof. - intros; unfold make_cast16signed. destruct (vincl x (Sgn Ptop 16)) eqn:INCL. - exists rs#r; split; auto. + intros; unfold make_cast16signed. destruct (vincl x (Sgn Ptop 16)) eqn:INCL. + exists rs#r; split; auto. assert (V: vmatch bc rs#r (Sgn Ptop 16)). { eapply vmatch_ge; eauto. apply vincl_ge; auto. } inv V; simpl; auto. rewrite is_sgn_sign_ext in H4 by auto. rewrite H4; auto. @@ -413,7 +413,7 @@ Proof. InvApproxRegs; SimplVM; inv H0. econstructor; split; eauto. apply Val.add_lessdef; auto. InvApproxRegs; SimplVM; inv H0. econstructor; split; eauto. rewrite Val.add_commut. apply Val.add_lessdef; auto. (* sub *) - InvApproxRegs; SimplVM; inv H0. fold (Val.sub (Vint n1) rs#r2). econstructor; split; eauto. + InvApproxRegs; SimplVM; inv H0. fold (Val.sub (Vint n1) rs#r2). econstructor; split; eauto. InvApproxRegs; SimplVM; inv H0. rewrite Val.sub_add_opp. apply make_addimm_correct. (* mul *) InvApproxRegs; SimplVM; inv H0. fold (Val.mul (Vint n1) rs#r2). rewrite Val.mul_commut. apply make_mulimm_correct; auto. @@ -464,23 +464,23 @@ Proof. intros until res. unfold addr_strength_reduction. destruct (addr_strength_reduction_match addr args vl); simpl; intros VL EA; InvApproxRegs; SimplVM; try (inv EA). -- rewrite Genv.shift_symbol_address. econstructor; split; eauto. apply Val.add_lessdef; auto. +- rewrite Genv.shift_symbol_address. econstructor; split; eauto. apply Val.add_lessdef; auto. - fold (Val.add (Vint n1) rs#r2). rewrite Int.add_commut. rewrite Genv.shift_symbol_address. rewrite Val.add_commut. econstructor; split; eauto. apply Val.add_lessdef; auto. -- rewrite Int.add_zero_l. +- rewrite Int.add_zero_l. change (Vptr sp (Int.add n1 n2)) with (Val.add (Vptr sp n1) (Vint n2)). econstructor; split; eauto. apply Val.add_lessdef; auto. - fold (Val.add (Vint n1) rs#r2). rewrite Int.add_zero_l. rewrite Int.add_commut. change (Vptr sp (Int.add n2 n1)) with (Val.add (Vptr sp n2) (Vint n1)). rewrite Val.add_commut. econstructor; split; eauto. apply Val.add_lessdef; auto. -- econstructor; split; eauto. apply Val.add_lessdef; auto. -- rewrite Val.add_commut. econstructor; split; eauto. apply Val.add_lessdef; auto. +- econstructor; split; eauto. apply Val.add_lessdef; auto. +- rewrite Val.add_commut. econstructor; split; eauto. apply Val.add_lessdef; auto. - fold (Val.add (Vint n1) rs#r2). rewrite Val.add_commut. econstructor; split; eauto. - econstructor; split; eauto. -- rewrite Genv.shift_symbol_address. econstructor; split; eauto. -- rewrite Genv.shift_symbol_address. econstructor; split; eauto. apply Val.add_lessdef; auto. -- rewrite Int.add_zero_l. +- rewrite Genv.shift_symbol_address. econstructor; split; eauto. +- rewrite Genv.shift_symbol_address. econstructor; split; eauto. apply Val.add_lessdef; auto. +- rewrite Int.add_zero_l. change (Vptr sp (Int.add n1 n)) with (Val.add (Vptr sp n1) (Vint n)). econstructor; split; eauto. apply Val.add_lessdef; auto. - exists res; auto. diff --git a/powerpc/Conventions1.v b/powerpc/Conventions1.v index 7c7177e4..4ee25a32 100644 --- a/powerpc/Conventions1.v +++ b/powerpc/Conventions1.v @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(** Function calling conventions and other conventions regarding the use of +(** Function calling conventions and other conventions regarding the use of machine registers and stack slots. *) Require Import Coqlib. @@ -58,8 +58,8 @@ Definition index_int_callee_save (r: mreg) := match r with | R14 => 17 | R15 => 16 | R16 => 15 | R17 => 14 | R18 => 13 | R19 => 12 | R20 => 11 | R21 => 10 - | R22 => 9 | R23 => 8 | R24 => 7 | R25 => 6 - | R26 => 5 | R27 => 4 | R28 => 3 | R29 => 2 + | R22 => 9 | R23 => 8 | R24 => 7 | R25 => 6 + | R26 => 5 | R27 => 4 | R28 => 3 | R29 => 2 | R30 => 1 | R31 => 0 | _ => -1 end. @@ -67,8 +67,8 @@ Definition index_float_callee_save (r: mreg) := match r with | F14 => 17 | F15 => 16 | F16 => 15 | F17 => 14 | F18 => 13 | F19 => 12 | F20 => 11 | F21 => 10 - | F22 => 9 | F23 => 8 | F24 => 7 | F25 => 6 - | F26 => 5 | F27 => 4 | F28 => 3 | F29 => 2 + | F22 => 9 | F23 => 8 | F24 => 7 | F25 => 6 + | F26 => 5 | F27 => 4 | F28 => 3 | F29 => 2 | F30 => 1 | F31 => 0 | _ => -1 end. @@ -123,25 +123,25 @@ Proof. Qed. Lemma index_int_callee_save_inj: - forall r1 r2, + forall r1 r2, In r1 int_callee_save_regs -> In r2 int_callee_save_regs -> r1 <> r2 -> index_int_callee_save r1 <> index_int_callee_save r2. Proof. - intros r1 r2. + intros r1 r2. simpl; ElimOrEq; ElimOrEq; unfold index_int_callee_save; intros; congruence. Qed. Lemma index_float_callee_save_inj: - forall r1 r2, + forall r1 r2, In r1 float_callee_save_regs -> In r2 float_callee_save_regs -> r1 <> r2 -> index_float_callee_save r1 <> index_float_callee_save r2. Proof. - intros r1 r2. + intros r1 r2. simpl; ElimOrEq; ElimOrEq; unfold index_float_callee_save; intros; congruence. Qed. @@ -157,24 +157,24 @@ Proof. Qed. Lemma register_classification: - forall r, + forall r, In r destroyed_at_call \/ In r int_callee_save_regs \/ In r float_callee_save_regs. Proof. - destruct r; + destruct r; try (left; simpl; OrEq); try (right; left; simpl; OrEq); try (right; right; simpl; OrEq). Qed. Lemma int_callee_save_not_destroyed: - forall r, + forall r, In r destroyed_at_call -> In r int_callee_save_regs -> False. Proof. intros. revert H0 H. simpl. ElimOrEq; NotOrEq. Qed. Lemma float_callee_save_not_destroyed: - forall r, + forall r, In r destroyed_at_call -> In r float_callee_save_regs -> False. Proof. intros. revert H0 H. simpl. ElimOrEq; NotOrEq. @@ -217,9 +217,9 @@ Qed. (** The functions in this section determine the locations (machine registers and stack slots) used to communicate arguments and results between the caller and the callee during function calls. These locations are functions - of the signature of the function and of the call instruction. + of the signature of the function and of the call instruction. Agreement between the caller and the callee on the locations to use - is guaranteed by our dynamic semantics for Cminor and RTL, which demand + is guaranteed by our dynamic semantics for Cminor and RTL, which demand that the signature of the call instruction is identical to that of the called function. @@ -257,7 +257,7 @@ Qed. (** The result locations are caller-save registers *) Lemma loc_result_caller_save: - forall (s: signature) (r: mreg), + forall (s: signature) (r: mreg), In r (loc_result s) -> In r destroyed_at_call. Proof. intros. @@ -354,7 +354,7 @@ Definition tailcall_possible (s: signature) : Prop := forall l, In l (loc_arguments s) -> match l with R _ => True | S _ _ _ => False end. -(** Argument locations are either caller-save registers or [Outgoing] +(** Argument locations are either caller-save registers or [Outgoing] stack slots at nonnegative offsets. *) Definition loc_argument_acceptable (l: loc) : Prop := @@ -384,12 +384,12 @@ Opaque list_nth_z. subst. split. omega. congruence. exploit IHtyl; eauto. destruct l; auto. destruct sl; auto. intuition omega. - (* float *) - destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H. + destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H. subst. right. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. subst. split. apply Zle_ge. apply align_le. omega. congruence. exploit IHtyl; eauto. destruct l; auto. destruct sl; auto. - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; omega). intuition omega. - (* long *) set (ir' := align ir 2) in *. @@ -398,21 +398,21 @@ Opaque list_nth_z. destruct H. subst; left; eapply list_nth_z_in; eauto. destruct H. subst; left; eapply list_nth_z_in; eauto. eapply IHtyl; eauto. - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; omega). destruct H. subst. split. omega. congruence. destruct H. subst. split. omega. congruence. exploit IHtyl; eauto. destruct l; auto. destruct sl; auto. intuition omega. - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; omega). destruct H. subst. split. omega. congruence. destruct H. subst. split. omega. congruence. - exploit IHtyl; eauto. destruct l; auto. destruct sl; auto. intuition omega. + exploit IHtyl; eauto. destruct l; auto. destruct sl; auto. intuition omega. - (* single *) - destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H. + destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H. subst. right. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. subst. split. apply Zle_ge. apply align_le. omega. congruence. exploit IHtyl; eauto. destruct l; auto. destruct sl; auto. - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; omega). intuition omega. - (* any32 *) destruct (list_nth_z int_param_regs ir) as [r|] eqn:E; destruct H. @@ -421,12 +421,12 @@ Opaque list_nth_z. subst. split. omega. congruence. exploit IHtyl; eauto. destruct l; auto. destruct sl; auto. intuition omega. - (* any64 *) - destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H. + destruct (list_nth_z float_param_regs fr) as [r|] eqn:E; destruct H. subst. right. eapply list_nth_z_in; eauto. eapply IHtyl; eauto. subst. split. apply Zle_ge. apply align_le. omega. congruence. exploit IHtyl; eauto. destruct l; auto. destruct sl; auto. - assert (ofs <= align ofs 2) by (apply align_le; omega). + assert (ofs <= align ofs 2) by (apply align_le; omega). intuition omega. Qed. @@ -439,7 +439,7 @@ Proof. destruct l. intro H0; elim H0; simpl; ElimOrEq; OrEq. destruct sl; try contradiction. simpl. intuition omega. -Qed. +Qed. Hint Resolve loc_arguments_acceptable: locs. (** The offsets of [Outgoing] arguments are below [size_arguments s]. *) @@ -474,7 +474,7 @@ Qed. Lemma size_arguments_above: forall s, size_arguments s >= 0. Proof. - intros; unfold size_arguments. apply Zle_ge. + intros; unfold size_arguments. apply Zle_ge. apply size_arguments_rec_above. Qed. @@ -492,48 +492,48 @@ Proof. elim H0. destruct a. - (* int *) - destruct (list_nth_z int_param_regs ir); destruct H0. + destruct (list_nth_z int_param_regs ir); destruct H0. congruence. eauto. inv H0. apply size_arguments_rec_above. eauto. - (* float *) - destruct (list_nth_z float_param_regs fr); destruct H0. + destruct (list_nth_z float_param_regs fr); destruct H0. congruence. eauto. - inv H0. apply size_arguments_rec_above. eauto. + inv H0. apply size_arguments_rec_above. eauto. - (* long *) set (ir' := align ir 2) in *. destruct (list_nth_z int_param_regs ir'). destruct (list_nth_z int_param_regs (ir' + 1)). destruct H0. congruence. destruct H0. congruence. eauto. - destruct H0. inv H0. + destruct H0. inv H0. transitivity (align ofs0 2 + 2). simpl; omega. eauto. apply size_arguments_rec_above. destruct H0. inv H0. transitivity (align ofs0 2 + 2). simpl; omega. eauto. apply size_arguments_rec_above. - eauto. - destruct H0. inv H0. + eauto. + destruct H0. inv H0. transitivity (align ofs0 2 + 2). simpl; omega. eauto. apply size_arguments_rec_above. destruct H0. inv H0. transitivity (align ofs0 2 + 2). simpl; omega. eauto. apply size_arguments_rec_above. eauto. - (* single *) - destruct (list_nth_z float_param_regs fr); destruct H0. + destruct (list_nth_z float_param_regs fr); destruct H0. congruence. eauto. inv H0. transitivity (align ofs0 2 + 2). simpl; omega. apply size_arguments_rec_above. eauto. - (* any32 *) - destruct (list_nth_z int_param_regs ir); destruct H0. + destruct (list_nth_z int_param_regs ir); destruct H0. congruence. eauto. inv H0. apply size_arguments_rec_above. eauto. - (* any64 *) - destruct (list_nth_z float_param_regs fr); destruct H0. + destruct (list_nth_z float_param_regs fr); destruct H0. congruence. eauto. - inv H0. apply size_arguments_rec_above. eauto. + inv H0. apply size_arguments_rec_above. eauto. } eauto. Qed. diff --git a/powerpc/Machregs.v b/powerpc/Machregs.v index ec721a16..a8aa94c5 100644 --- a/powerpc/Machregs.v +++ b/powerpc/Machregs.v @@ -21,7 +21,7 @@ Require Import Op. (** The following type defines the machine registers that can be referenced as locations. These include: - Integer registers that can be allocated to RTL pseudo-registers ([Rxx]). -- Floating-point registers that can be allocated to RTL pseudo-registers +- Floating-point registers that can be allocated to RTL pseudo-registers ([Fxx]). The type [mreg] does not include special-purpose or reserved diff --git a/powerpc/NeedOp.v b/powerpc/NeedOp.v index e1307492..672bd6f2 100644 --- a/powerpc/NeedOp.v +++ b/powerpc/NeedOp.v @@ -101,7 +101,7 @@ Proof. intros. destruct cond; simpl in H; try (eapply default_needs_of_condition_sound; eauto; fail); simpl in *; FuncInv; InvAgree. -- eapply maskzero_sound; eauto. +- eapply maskzero_sound; eauto. - destruct (Val.maskzero_bool v i) as [b'|] eqn:MZ; try discriminate. erewrite maskzero_sound; eauto. Qed. @@ -117,7 +117,7 @@ Lemma needs_of_operation_sound: Proof. unfold needs_of_operation; intros; destruct op; try (eapply default_needs_of_operation_sound; eauto; fail); simpl in *; FuncInv; InvAgree; TrivialExists. -- apply sign_ext_sound; auto. compute; auto. +- apply sign_ext_sound; auto. compute; auto. - apply sign_ext_sound; auto. compute; auto. - apply add_sound; auto. - apply add_sound; auto with na. @@ -137,8 +137,8 @@ Proof. - apply and_sound; auto. apply notint_sound; rewrite bitwise_idem; auto. - apply or_sound; auto. apply notint_sound; rewrite bitwise_idem; auto. - apply shrimm_sound; auto. -- apply rolm_sound; auto. -- destruct (eval_condition c args m) as [b|] eqn:EC; simpl in H2. +- apply rolm_sound; auto. +- destruct (eval_condition c args m) as [b|] eqn:EC; simpl in H2. erewrite needs_of_condition_sound by eauto. subst v; simpl. auto with na. subst v; auto with na. @@ -154,7 +154,7 @@ Proof. intros. destruct op; simpl in *; try discriminate; inv H1; FuncInv; subst. - apply sign_ext_redundant_sound; auto. omega. - apply sign_ext_redundant_sound; auto. omega. -- apply andimm_redundant_sound; auto. +- apply andimm_redundant_sound; auto. - apply orimm_redundant_sound; auto. - apply rolm_redundant_sound; auto. Qed. diff --git a/powerpc/Op.v b/powerpc/Op.v index 3ff08791..18e285e1 100644 --- a/powerpc/Op.v +++ b/powerpc/Op.v @@ -17,7 +17,7 @@ - [operation]: arithmetic and logical operations; - [addressing]: addressing modes for load and store operations. - These types are PowerPC-specific and correspond roughly to what the + These types are PowerPC-specific and correspond roughly to what the processor can compute in one instruction. In other terms, these types reflect the state of the program after instruction selection. For a processor-independent set of operations, see the abstract @@ -115,7 +115,7 @@ Inductive operation : Type := (*c Boolean tests: *) | Ocmp: condition -> operation. (**r [rd = 1] if condition holds, [rd = 0] otherwise. *) -(** Addressing modes. [r1], [r2], etc, are the arguments to the +(** Addressing modes. [r1], [r2], etc, are the arguments to the addressing. *) Inductive addressing: Type := @@ -181,7 +181,7 @@ Definition eval_operation | Ointconst n, nil => Some (Vint n) | Ofloatconst n, nil => Some (Vfloat n) | Osingleconst n, nil => Some (Vsingle n) - | Oaddrsymbol s ofs, nil => Some (Genv.symbol_address genv s ofs) + | Oaddrsymbol s ofs, nil => Some (Genv.symbol_address genv s ofs) | Oaddrstack ofs, nil => Some (Val.add sp (Vint ofs)) | Ocast8signed, v1::nil => Some (Val.sign_ext 8 v1) | Ocast16signed, v1::nil => Some (Val.sign_ext 16 v1) @@ -424,7 +424,7 @@ Proof with (try exact I). destruct v0; destruct v1... destruct v0... destruct v0... - destruct (eval_condition c vl m); simpl... destruct b... + destruct (eval_condition c vl m); simpl... destruct b... Qed. End SOUNDNESS. @@ -448,7 +448,7 @@ Proof. intros until a. unfold is_move_operation; destruct op; try (intros; discriminate). destruct args. intros; discriminate. - destruct args. intros. intuition congruence. + destruct args. intros. intuition congruence. intros; discriminate. Qed. @@ -476,9 +476,9 @@ Proof. repeat (destruct vl; auto). apply Val.negate_cmpu_bool. repeat (destruct vl; auto). apply Val.negate_cmp_bool. repeat (destruct vl; auto). apply Val.negate_cmpu_bool. - repeat (destruct vl; auto). + repeat (destruct vl; auto). repeat (destruct vl; auto). destruct (Val.cmpf_bool c v v0); auto. destruct b; auto. - repeat (destruct vl; auto). + repeat (destruct vl; auto). repeat (destruct vl; auto). destruct (Val.maskzero_bool v i) as [[]|]; auto. Qed. @@ -499,7 +499,7 @@ Definition shift_stack_operation (delta: int) (op: operation) := Lemma type_shift_stack_addressing: forall delta addr, type_of_addressing (shift_stack_addressing delta addr) = type_of_addressing addr. Proof. - intros. destruct addr; auto. + intros. destruct addr; auto. Qed. Lemma type_shift_stack_operation: @@ -547,10 +547,10 @@ Lemma eval_offset_addressing: Proof. intros. destruct addr; simpl in H; inv H; simpl in *; FuncInv; subst. rewrite Val.add_assoc; auto. - unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); auto. unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); auto. - rewrite Val.add_assoc. rewrite Val.add_permut. rewrite Val.add_commut. auto. - rewrite Val.add_assoc. auto. + unfold Genv.symbol_address. destruct (Genv.find_symbol ge i); auto. + rewrite Val.add_assoc. rewrite Val.add_permut. rewrite Val.add_commut. auto. + rewrite Val.add_assoc. auto. Qed. (** Operations that are so cheap to recompute that CSE should not factor them out. *) @@ -579,7 +579,7 @@ Lemma op_depends_on_memory_correct: eval_operation ge sp op args m1 = eval_operation ge sp op args m2. Proof. intros until m2. destruct op; simpl; try congruence. unfold eval_condition. - destruct c; simpl; auto; try discriminate. + destruct c; simpl; auto; try discriminate. Qed. (** Global variables mentioned in an operation or addressing mode *) @@ -618,7 +618,7 @@ Remark symbol_address_preserved: Proof. unfold Genv.symbol_address; intros. rewrite agree_on_symbols; auto. Qed. - + Lemma eval_operation_preserved: forall sp op vl m, eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m. @@ -728,25 +728,25 @@ Lemma eval_operation_inj: Proof. intros until v1; intros GL; intros. destruct op; simpl in H1; simpl; FuncInv; InvInject; TrivialExists. apply GL; simpl; auto. - apply Values.Val.add_inject; auto. + apply Values.Val.add_inject; auto. inv H4; simpl; auto. inv H4; simpl; auto. apply Values.Val.add_inject; auto. apply Values.Val.add_inject; auto. apply Values.Val.add_inject; auto. apply GL; simpl; auto. - inv H4; inv H2; simpl; auto. econstructor; eauto. + inv H4; inv H2; simpl; auto. econstructor; eauto. rewrite Int.sub_add_l. auto. - destruct (eq_block b1 b0); auto. subst. rewrite H1 in H0. inv H0. rewrite dec_eq_true. + destruct (eq_block b1 b0); auto. subst. rewrite H1 in H0. inv H0. rewrite dec_eq_true. rewrite Int.sub_shifted. auto. - inv H4; auto. + inv H4; auto. inv H4; inv H2; simpl; auto. inv H4; simpl; auto. inv H4; inv H2; simpl; auto. inv H4; inv H2; simpl; auto. - inv H4; inv H3; simpl in H1; inv H1. simpl. + inv H4; inv H3; simpl in H1; inv H1. simpl. destruct (Int.eq i0 Int.zero || Int.eq i (Int.repr Int.min_signed) && Int.eq i0 Int.mone); inv H2. TrivialExists. - inv H4; inv H3; simpl in H1; inv H1. simpl. + inv H4; inv H3; simpl in H1; inv H1. simpl. destruct (Int.eq i0 Int.zero); inv H2. TrivialExists. inv H4; inv H2; simpl; auto. inv H4; simpl; auto. @@ -825,7 +825,7 @@ Remark valid_pointer_extends: Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true -> Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true. Proof. - intros. inv H0. rewrite Int.add_zero. eapply Mem.valid_pointer_extends; eauto. + intros. inv H0. rewrite Int.add_zero. eapply Mem.valid_pointer_extends; eauto. Qed. Remark weak_valid_pointer_extends: @@ -893,8 +893,8 @@ Proof. apply valid_different_pointers_extends; auto. intros. rewrite <- val_inject_lessdef; auto. rewrite <- val_inject_lessdef; auto. - eauto. auto. - destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. + eauto. auto. + destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. Qed. Lemma eval_addressing_lessdef: @@ -910,8 +910,8 @@ Proof. eapply eval_addressing_inj with (sp1 := sp). intros. rewrite <- val_inject_lessdef; auto. rewrite <- val_inject_lessdef; auto. - eauto. auto. - destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. + eauto. auto. + destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. Qed. End EVAL_LESSDEF. @@ -933,7 +933,7 @@ Remark symbol_address_inject: forall id ofs, Val.inject f (Genv.symbol_address genv id ofs) (Genv.symbol_address genv id ofs). Proof. intros. unfold Genv.symbol_address. destruct (Genv.find_symbol genv id) eqn:?; auto. - exploit (proj1 globals); eauto. intros. + exploit (proj1 globals); eauto. intros. econstructor; eauto. rewrite Int.add_zero; auto. Qed. @@ -955,11 +955,11 @@ Lemma eval_addressing_inject: forall addr vl1 vl2 v1, Val.inject_list f vl1 vl2 -> eval_addressing genv (Vptr sp1 Int.zero) addr vl1 = Some v1 -> - exists v2, + exists v2, eval_addressing genv (Vptr sp2 Int.zero) (shift_stack_addressing (Int.repr delta) addr) vl2 = Some v2 /\ Val.inject f v1 v2. Proof. - intros. + intros. rewrite eval_shift_stack_addressing. simpl. eapply eval_addressing_inj with (sp1 := Vptr sp1 Int.zero); eauto. intros. apply symbol_address_inject. @@ -974,7 +974,7 @@ Lemma eval_operation_inject: eval_operation genv (Vptr sp2 Int.zero) (shift_stack_operation (Int.repr delta) op) vl2 m2 = Some v2 /\ Val.inject f v1 v2. Proof. - intros. + intros. rewrite eval_shift_stack_operation. simpl. eapply eval_operation_inj with (sp1 := Vptr sp1 Int.zero) (m1 := m1); eauto. intros; eapply Mem.valid_pointer_inject_val; eauto. @@ -999,7 +999,7 @@ End EVAL_INJECT. / \ / \ / \ \ / \ / \ / -0--> [1] --1--> [2] --0--> [3] - / + / [0] \ -1--> [4] --0--> [5] --1--> [6] diff --git a/powerpc/SelectOpproof.v b/powerpc/SelectOpproof.v index 147132dd..b40ad21b 100644 --- a/powerpc/SelectOpproof.v +++ b/powerpc/SelectOpproof.v @@ -32,7 +32,7 @@ Open Local Scope cminorsel_scope. (** The following are trivial lemmas and custom tactics that help perform backward (inversion) and forward reasoning over the evaluation - of operator applications. *) + of operator applications. *) Ltac EvalOp := eapply eval_Eop; eauto with evalexpr. @@ -117,8 +117,8 @@ Theorem eval_addrsymbol: forall le id ofs, exists v, eval_expr ge sp e m le (addrsymbol id ofs) v /\ Val.lessdef (Genv.symbol_address ge id ofs) v. Proof. - intros. unfold addrsymbol. econstructor; split. - EvalOp. simpl; eauto. + intros. unfold addrsymbol. econstructor; split. + EvalOp. simpl; eauto. auto. Qed. @@ -127,7 +127,7 @@ Theorem eval_addrstack: exists v, eval_expr ge sp e m le (addrstack ofs) v /\ Val.lessdef (Val.add sp (Vint ofs)) v. Proof. intros. unfold addrstack. econstructor; split. - EvalOp. simpl; eauto. + EvalOp. simpl; eauto. auto. Qed. @@ -138,20 +138,20 @@ Proof. unfold notint; red; intros until x; case (notint_match a); intros; InvEval. TrivialExists. subst. exists v1; split; auto. - subst. TrivialExists. + subst. TrivialExists. subst. TrivialExists. subst. TrivialExists. subst. exists (Val.and v1 v0); split; auto. EvalOp. subst. exists (Val.or v1 v0); split; auto. EvalOp. subst. exists (Val.xor v1 v0); split; auto. EvalOp. - subst. exists (Val.or v0 (Val.notint v1)); split. EvalOp. + subst. exists (Val.or v0 (Val.notint v1)); split. EvalOp. destruct v0; destruct v1; simpl; auto. rewrite Int.not_and_or_not. rewrite Int.not_involutive. rewrite Int.or_commut. auto. - subst. exists (Val.and v0 (Val.notint v1)); split. EvalOp. + subst. exists (Val.and v0 (Val.notint v1)); split. EvalOp. destruct v0; destruct v1; simpl; auto. rewrite Int.not_or_and_not. rewrite Int.not_involutive. rewrite Int.and_commut. auto. subst x. TrivialExists. simpl. rewrite Val.not_xor. rewrite Val.xor_assoc. auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_addimm: @@ -159,7 +159,7 @@ Theorem eval_addimm: Proof. red; unfold addimm; intros until x. predSpec Int.eq Int.eq_spec n Int.zero. - subst n. intros. exists x; split; auto. + subst n. intros. exists x; split; auto. destruct x; simpl; auto. rewrite Int.add_zero. auto. rewrite Int.add_zero. auto. case (addimm_match a); intros; InvEval; simpl; TrivialExists; simpl. rewrite Int.add_commut. auto. @@ -167,15 +167,15 @@ Proof. rewrite Val.add_assoc. rewrite Int.add_commut. auto. subst. rewrite Val.add_assoc. rewrite Int.add_commut. auto. subst. rewrite Int.add_commut. rewrite Genv.shift_symbol_address. rewrite ! Val.add_assoc. f_equal. f_equal. apply Val.add_commut. -Qed. +Qed. Theorem eval_addsymbol: forall s ofs, unary_constructor_sound (addsymbol s ofs) (Val.add (Genv.symbol_address ge s ofs)). Proof. red; unfold addsymbol; intros until x. case (addsymbol_match a); intros; InvEval; simpl; TrivialExists; simpl. - rewrite Genv.shift_symbol_address. auto. - rewrite Genv.shift_symbol_address. subst x. rewrite Val.add_assoc. f_equal. f_equal. + rewrite Genv.shift_symbol_address. auto. + rewrite Genv.shift_symbol_address. subst x. rewrite Val.add_assoc. f_equal. f_equal. apply Val.add_commut. Qed. @@ -187,36 +187,36 @@ Proof. - apply eval_addimm; auto. - apply eval_addsymbol; auto. - rewrite Val.add_commut. apply eval_addsymbol; auto. -- subst. +- subst. replace (Val.add (Val.add v1 (Vint n1)) (Val.add v0 (Vint n2))) with (Val.add (Val.add v1 v0) (Val.add (Vint n1) (Vint n2))). apply eval_addimm. EvalOp. repeat rewrite Val.add_assoc. decEq. apply Val.add_permut. -- subst. +- subst. replace (Val.add (Val.add v1 (Vint n1)) y) with (Val.add (Val.add v1 y) (Vint n1)). apply eval_addimm. EvalOp. repeat rewrite Val.add_assoc. decEq. apply Val.add_commut. -- subst. TrivialExists. +- subst. TrivialExists. econstructor. EvalOp. simpl. reflexivity. econstructor. eauto. constructor. simpl. repeat rewrite Val.add_assoc. decEq; decEq. rewrite Val.add_commut. rewrite Val.add_permut. auto. - replace (Val.add x y) with (Val.add (Genv.symbol_address ge s (Int.add ofs n)) (Val.add v1 v0)). - apply eval_addsymbol; auto. EvalOp. - subst. rewrite Genv.shift_symbol_address. rewrite ! Val.add_assoc. f_equal. + apply eval_addsymbol; auto. EvalOp. + subst. rewrite Genv.shift_symbol_address. rewrite ! Val.add_assoc. f_equal. rewrite Val.add_permut. f_equal. apply Val.add_commut. -- subst. rewrite Val.add_assoc. apply eval_addsymbol. EvalOp. +- subst. rewrite Val.add_assoc. apply eval_addsymbol. EvalOp. - subst. rewrite <- Val.add_assoc. apply eval_addimm. EvalOp. -- subst. rewrite Val.add_permut. apply eval_addsymbol. EvalOp. -- TrivialExists. +- subst. rewrite Val.add_permut. apply eval_addsymbol. EvalOp. +- TrivialExists. Qed. Theorem eval_subimm: forall n, unary_constructor_sound (subimm n) (fun v => Val.sub (Vint n) v). Proof. intros; red; intros until x. unfold subimm. destruct (subimm_match a); intros. - InvEval. TrivialExists. + InvEval. TrivialExists. InvEval. subst x. TrivialExists. unfold eval_operation. destruct v1; simpl; auto. rewrite ! Int.sub_add_opp. rewrite Int.add_assoc. f_equal. f_equal. f_equal. rewrite Int.neg_add_distr. apply Int.add_commut. @@ -229,7 +229,7 @@ Proof. unfold sub; case (sub_match a b); intros; InvEval. rewrite Val.sub_add_opp. apply eval_addimm; auto. apply eval_subimm; auto. - subst. rewrite Val.sub_add_l. rewrite Val.sub_add_r. + subst. rewrite Val.sub_add_l. rewrite Val.sub_add_r. rewrite Val.add_assoc. simpl. rewrite Int.add_commut. rewrite <- Int.sub_add_opp. apply eval_addimm; EvalOp. subst. rewrite Val.sub_add_l. apply eval_addimm; EvalOp. @@ -239,7 +239,7 @@ Qed. Theorem eval_negint: unary_constructor_sound negint (fun v => Val.sub Vzero v). Proof. - red; intros. unfold negint. apply eval_subimm; auto. + red; intros. unfold negint. apply eval_subimm; auto. Qed. Lemma eval_rolm: @@ -248,7 +248,7 @@ Lemma eval_rolm: (fun x => Val.rolm x amount mask). Proof. red; intros until x. unfold rolm; case (rolm_match a); intros; InvEval. - TrivialExists. + TrivialExists. subst. rewrite Val.rolm_rolm. TrivialExists. subst. rewrite <- Val.rolm_zero. rewrite Val.rolm_rolm. rewrite (Int.add_commut Int.zero). rewrite Int.add_zero. TrivialExists. @@ -262,8 +262,8 @@ Proof. red; intros. unfold shlimm. predSpec Int.eq Int.eq_spec n Int.zero. subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shl_zero; auto. - destruct (Int.ltu n Int.iwordsize) eqn:?. - rewrite Val.shl_rolm; auto. apply eval_rolm; auto. + destruct (Int.ltu n Int.iwordsize) eqn:?. + rewrite Val.shl_rolm; auto. apply eval_rolm; auto. TrivialExists. econstructor. eauto. econstructor. EvalOp. simpl; eauto. constructor. auto. Qed. @@ -274,8 +274,8 @@ Proof. red; intros. unfold shruimm. predSpec Int.eq Int.eq_spec n Int.zero. subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shru_zero; auto. - destruct (Int.ltu n Int.iwordsize) eqn:?. - rewrite Val.shru_rolm; auto. apply eval_rolm; auto. + destruct (Int.ltu n Int.iwordsize) eqn:?. + rewrite Val.shru_rolm; auto. apply eval_rolm; auto. TrivialExists. econstructor. eauto. econstructor. EvalOp. simpl; eauto. constructor. auto. Qed. @@ -283,18 +283,18 @@ Theorem eval_shrimm: forall n, unary_constructor_sound (fun a => shrimm a n) (fun x => Val.shr x (Vint n)). Proof. - red; intros until x. unfold shrimm. + red; intros until x. unfold shrimm. predSpec Int.eq Int.eq_spec n Int.zero. intros. subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shr_zero; auto. destruct (Int.ltu n Int.iwordsize) eqn:WS. case (shrimm_match a); intros. InvEval. exists (Vint (Int.shr n1 n)); split. EvalOp. simpl; rewrite WS; auto. - simpl; destruct (Int.lt mask1 Int.zero) eqn:?. + simpl; destruct (Int.lt mask1 Int.zero) eqn:?. TrivialExists. - replace (Val.shr x (Vint n)) with (Val.shru x (Vint n)). + replace (Val.shr x (Vint n)) with (Val.shru x (Vint n)). apply eval_shruimm; auto. destruct x; simpl; auto. rewrite WS. - decEq. symmetry. InvEval. destruct v1; simpl in H0; inv H0. + decEq. symmetry. InvEval. destruct v1; simpl in H0; inv H0. apply Int.shr_and_is_shru_and; auto. simpl. TrivialExists. intros. simpl. TrivialExists. @@ -304,13 +304,13 @@ Qed. Lemma eval_mulimm_base: forall n, unary_constructor_sound (mulimm_base n) (fun x => Val.mul x (Vint n)). Proof. - intros; red; intros; unfold mulimm_base. - generalize (Int.one_bits_decomp n). + intros; red; intros; unfold mulimm_base. + generalize (Int.one_bits_decomp n). generalize (Int.one_bits_range n). destruct (Int.one_bits n). - intros. TrivialExists. + intros. TrivialExists. destruct l. - intros. rewrite H1. simpl. + intros. rewrite H1. simpl. rewrite Int.add_zero. replace (Vint (Int.shl Int.one i)) with (Val.shl Vone (Vint i)). rewrite Val.shl_mul. apply eval_shlimm. auto. simpl. rewrite H0; auto with coqlib. @@ -325,27 +325,27 @@ Proof. replace (Vint (Int.add (Int.shl Int.one i) (Int.shl Int.one i0))) with (Val.add (Val.shl Vone (Vint i)) (Val.shl Vone (Vint i0))). rewrite Val.mul_add_distr_r. - repeat rewrite Val.shl_mul. apply Val.add_lessdef; auto. - simpl. repeat rewrite H0; auto with coqlib. - intros. TrivialExists. + repeat rewrite Val.shl_mul. apply Val.add_lessdef; auto. + simpl. repeat rewrite H0; auto with coqlib. + intros. TrivialExists. Qed. Theorem eval_mulimm: forall n, unary_constructor_sound (mulimm n) (fun x => Val.mul x (Vint n)). Proof. intros; red; intros until x; unfold mulimm. - predSpec Int.eq Int.eq_spec n Int.zero. - intros. exists (Vint Int.zero); split. EvalOp. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists (Vint Int.zero); split. EvalOp. destruct x; simpl; auto. subst n. rewrite Int.mul_zero. auto. predSpec Int.eq Int.eq_spec n Int.one. intros. exists x; split; auto. destruct x; simpl; auto. subst n. rewrite Int.mul_one. auto. case (mulimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.mul_commut; auto. - subst. rewrite Val.mul_add_distr_l. + subst. rewrite Val.mul_add_distr_l. exploit eval_mulimm_base; eauto. instantiate (1 := n). intros [v' [A1 B1]]. exploit (eval_addimm (Int.mul n n2) le (mulimm_base n t2) v'). auto. intros [v'' [A2 B2]]. - exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.add_lessdef; eauto. + exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.add_lessdef; eauto. rewrite Val.mul_commut; auto. apply eval_mulimm_base; auto. Qed. @@ -354,7 +354,7 @@ Theorem eval_mul: binary_constructor_sound mul Val.mul. Proof. red; intros until y. unfold mul; case (mul_match a b); intros; InvEval. - rewrite Val.mul_commut. apply eval_mulimm. auto. + rewrite Val.mul_commut. apply eval_mulimm. auto. apply eval_mulimm. auto. TrivialExists. Qed. @@ -362,9 +362,9 @@ Qed. Theorem eval_andimm: forall n, unary_constructor_sound (andimm n) (fun x => Val.and x (Vint n)). Proof. - intros; red; intros until x. unfold andimm. + intros; red; intros until x. unfold andimm. predSpec Int.eq Int.eq_spec n Int.zero. - intros. subst. exists (Vint Int.zero); split. EvalOp. + intros. subst. exists (Vint Int.zero); split. EvalOp. destruct x; simpl; auto. rewrite Int.and_zero; auto. predSpec Int.eq Int.eq_spec n Int.mone. intros. subst. exists x; split. auto. @@ -372,10 +372,10 @@ Proof. clear H H0. case (andimm_match a); intros. InvEval. TrivialExists. simpl. rewrite Int.and_commut; auto. - set (n' := Int.and n n2). + set (n' := Int.and n n2). destruct (Int.eq (Int.shru (Int.shl n' amount) amount) n' && Int.ltu amount Int.iwordsize) eqn:?. - InvEval. destruct (andb_prop _ _ Heqb). + InvEval. destruct (andb_prop _ _ Heqb). generalize (Int.eq_spec (Int.shru (Int.shl n' amount) amount) n'). rewrite H1; intros. replace (Val.and x (Vint n)) with (Val.rolm v0 (Int.sub Int.iwordsize amount) (Int.and (Int.shru Int.mone amount) n')). @@ -383,26 +383,26 @@ Proof. subst. destruct v0; simpl; auto. rewrite H3. simpl. decEq. rewrite Int.and_assoc. rewrite (Int.and_commut n2 n). transitivity (Int.and (Int.shru i amount) (Int.and n n2)). - rewrite (Int.shru_rolm i); auto. unfold Int.rolm. rewrite Int.and_assoc; auto. + rewrite (Int.shru_rolm i); auto. unfold Int.rolm. rewrite Int.and_assoc; auto. symmetry. apply Int.shr_and_shru_and. auto. set (e2 := Eop (Oshrimm amount) (t2 ::: Enil)) in *. - InvEval. subst. rewrite Val.and_assoc. simpl. rewrite Int.and_commut. TrivialExists. - InvEval. subst. rewrite Val.and_assoc. simpl. rewrite Int.and_commut. TrivialExists. - InvEval. subst. TrivialExists. simpl. - destruct v1; auto. simpl. unfold Int.rolm. rewrite Int.and_assoc. + InvEval. subst. rewrite Val.and_assoc. simpl. rewrite Int.and_commut. TrivialExists. + InvEval. subst. rewrite Val.and_assoc. simpl. rewrite Int.and_commut. TrivialExists. + InvEval. subst. TrivialExists. simpl. + destruct v1; auto. simpl. unfold Int.rolm. rewrite Int.and_assoc. decEq. decEq. decEq. apply Int.and_commut. destruct (Int.eq (Int.shru (Int.shl n amount) amount) n && Int.ltu amount Int.iwordsize) eqn:?. - InvEval. destruct (andb_prop _ _ Heqb). + InvEval. destruct (andb_prop _ _ Heqb). generalize (Int.eq_spec (Int.shru (Int.shl n amount) amount) n). rewrite H0; intros. replace (Val.and x (Vint n)) with (Val.rolm v1 (Int.sub Int.iwordsize amount) (Int.and (Int.shru Int.mone amount) n)). apply eval_rolm; auto. - subst x. destruct v1; simpl; auto. rewrite H1; simpl. decEq. + subst x. destruct v1; simpl; auto. rewrite H1; simpl. decEq. transitivity (Int.and (Int.shru i amount) n). - rewrite (Int.shru_rolm i); auto. unfold Int.rolm. rewrite Int.and_assoc; auto. + rewrite (Int.shru_rolm i); auto. unfold Int.rolm. rewrite Int.and_assoc; auto. symmetry. apply Int.shr_and_shru_and. auto. - TrivialExists. + TrivialExists. TrivialExists. Qed. @@ -426,7 +426,7 @@ Proof. intros. subst. exists (Vint Int.mone); split. EvalOp. destruct x; simpl; auto. rewrite Int.or_mone; auto. clear H H0. destruct (orimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.or_commut; auto. - subst. rewrite Val.or_assoc. simpl. rewrite Int.or_commut. TrivialExists. + subst. rewrite Val.or_assoc. simpl. rewrite Int.or_commut. TrivialExists. TrivialExists. Qed. @@ -438,10 +438,10 @@ Remark eval_same_expr: a1 = a2 /\ v1 = v2. Proof. intros until v2. - destruct a1; simpl; try (intros; discriminate). + destruct a1; simpl; try (intros; discriminate). destruct a2; simpl; try (intros; discriminate). case (ident_eq i i0); intros. - subst i0. inversion H0. inversion H1. split. auto. congruence. + subst i0. inversion H0. inversion H1. split. auto. congruence. discriminate. Qed. @@ -452,29 +452,29 @@ Proof. destruct (Int.eq amount1 amount2 && same_expr_pure t1 t2) eqn:?. destruct (andb_prop _ _ Heqb0). generalize (Int.eq_spec amount1 amount2). rewrite H1. intro. subst amount2. - InvEval. exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst. + InvEval. exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst. rewrite Val.or_rolm. TrivialExists. TrivialExists. (* andimm - rolm *) destruct (Int.eq mask1 (Int.not mask2) && is_rlw_mask mask2) eqn:?. - destruct (andb_prop _ _ Heqb0). + destruct (andb_prop _ _ Heqb0). generalize (Int.eq_spec mask1 (Int.not mask2)); rewrite H1; intros. - InvEval. subst. TrivialExists. + InvEval. subst. TrivialExists. TrivialExists. (* rolm - andimm *) destruct (Int.eq mask2 (Int.not mask1) && is_rlw_mask mask1) eqn:?. - destruct (andb_prop _ _ Heqb0). + destruct (andb_prop _ _ Heqb0). generalize (Int.eq_spec mask2 (Int.not mask1)); rewrite H1; intros. InvEval. subst. rewrite Val.or_commut. TrivialExists. TrivialExists. (* intconst *) - InvEval. rewrite Val.or_commut. apply eval_orimm; auto. + InvEval. rewrite Val.or_commut. apply eval_orimm; auto. InvEval. apply eval_orimm; auto. (* orc *) InvEval. subst. rewrite Val.or_commut. TrivialExists. InvEval. subst. TrivialExists. (* default *) - TrivialExists. + TrivialExists. Qed. Theorem eval_xorimm: @@ -484,11 +484,11 @@ Proof. predSpec Int.eq Int.eq_spec n Int.zero. intros. subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.xor_zero; auto. predSpec Int.eq Int.eq_spec n Int.mone. - intros. subst. rewrite <- Val.not_xor. apply eval_notint; auto. + intros. subst. rewrite <- Val.not_xor. apply eval_notint; auto. clear H H0. destruct (xorimm_match a); intros; InvEval. TrivialExists. simpl. rewrite Int.xor_commut; auto. subst. rewrite Val.xor_assoc. simpl. rewrite Int.xor_commut. TrivialExists. - subst x. TrivialExists. simpl. rewrite Val.not_xor. rewrite Val.xor_assoc. + subst x. TrivialExists. simpl. rewrite Val.not_xor. rewrite Val.xor_assoc. simpl. rewrite Int.xor_commut; auto. TrivialExists. Qed. @@ -498,7 +498,7 @@ Proof. red; intros until y; unfold xor; case (xor_match a b); intros; InvEval. rewrite Val.xor_commut. apply eval_xorimm; auto. apply eval_xorimm; auto. - subst. rewrite Val.xor_commut. rewrite Val.not_xor. rewrite <- Val.xor_assoc. + subst. rewrite Val.xor_commut. rewrite Val.not_xor. rewrite <- Val.xor_assoc. rewrite <- Val.not_xor. rewrite Val.xor_commut. TrivialExists. subst. rewrite Val.not_xor. rewrite <- Val.xor_assoc. rewrite <- Val.not_xor. TrivialExists. TrivialExists. @@ -524,19 +524,19 @@ Lemma eval_mod_aux: eval_expr ge sp e m le (mod_aux divop a b) (Val.sub x (Val.mul z y)). Proof. intros; unfold mod_aux. - eapply eval_Elet. eexact H0. eapply eval_Elet. + eapply eval_Elet. eexact H0. eapply eval_Elet. apply eval_lift. eexact H1. - eapply eval_Eop. eapply eval_Econs. + eapply eval_Eop. eapply eval_Econs. eapply eval_Eletvar. simpl; reflexivity. - eapply eval_Econs. eapply eval_Eop. + eapply eval_Econs. eapply eval_Eop. eapply eval_Econs. eapply eval_Eop. eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity. eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity. - apply eval_Enil. + apply eval_Enil. rewrite H. eauto. eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity. - apply eval_Enil. - simpl; reflexivity. apply eval_Enil. + apply eval_Enil. + simpl; reflexivity. apply eval_Enil. reflexivity. Qed. @@ -547,7 +547,7 @@ Theorem eval_mods_base: Val.mods x y = Some z -> exists v, eval_expr ge sp e m le (mods_base a b) v /\ Val.lessdef z v. Proof. - intros; unfold mods_base. + intros; unfold mods_base. exploit Val.mods_divs; eauto. intros [v [A B]]. subst. econstructor; split; eauto. apply eval_mod_aux with (semdivop := Val.divs); auto. @@ -570,7 +570,7 @@ Theorem eval_modu_base: Val.modu x y = Some z -> exists v, eval_expr ge sp e m le (modu_base a b) v /\ Val.lessdef z v. Proof. - intros; unfold modu_base. + intros; unfold modu_base. exploit Val.modu_divu; eauto. intros [v [A B]]. subst. econstructor; split; eauto. apply eval_mod_aux with (semdivop := Val.divu); auto. @@ -582,13 +582,13 @@ Theorem eval_shrximm: Val.shrx x (Vint n) = Some z -> exists v, eval_expr ge sp e m le (shrximm a n) v /\ Val.lessdef z v. Proof. - intros. unfold shrximm. + intros. unfold shrximm. predSpec Int.eq Int.eq_spec n Int.zero. - subst n. exists x; split; auto. + subst n. exists x; split; auto. destruct x; simpl in H0; try discriminate. destruct (Int.ltu Int.zero (Int.repr 31)); inv H0. - replace (Int.shrx i Int.zero) with i. auto. - unfold Int.shrx, Int.divs. rewrite Int.shl_zero. + replace (Int.shrx i Int.zero) with i. auto. + unfold Int.shrx, Int.divs. rewrite Int.shl_zero. change (Int.signed Int.one) with 1. rewrite Z.quot_1_r. rewrite Int.repr_signed; auto. econstructor; split. EvalOp. auto. Qed. @@ -597,38 +597,38 @@ Theorem eval_shl: binary_constructor_sound shl Val.shl. Proof. red; intros until y; unfold shl; case (shl_match b); intros. InvEval. apply eval_shlimm; auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_shr: binary_constructor_sound shr Val.shr. Proof. red; intros until y; unfold shr; case (shr_match b); intros. InvEval. apply eval_shrimm; auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_shru: binary_constructor_sound shru Val.shru. Proof. red; intros until y; unfold shru; case (shru_match b); intros. InvEval. apply eval_shruimm; auto. - TrivialExists. + TrivialExists. Qed. Theorem eval_negf: unary_constructor_sound negf Val.negf. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_absf: unary_constructor_sound absf Val.absf. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_addf: binary_constructor_sound addf Val.addf. Proof. red; intros; TrivialExists. Qed. - + Theorem eval_subf: binary_constructor_sound subf Val.subf. Proof. red; intros; TrivialExists. @@ -641,19 +641,19 @@ Qed. Theorem eval_negfs: unary_constructor_sound negfs Val.negfs. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_absfs: unary_constructor_sound absfs Val.absfs. Proof. - red; intros. TrivialExists. + red; intros. TrivialExists. Qed. Theorem eval_addfs: binary_constructor_sound addfs Val.addfs. Proof. red; intros; TrivialExists. Qed. - + Theorem eval_subfs: binary_constructor_sound subfs Val.subfs. Proof. red; intros; TrivialExists. @@ -687,8 +687,8 @@ Proof. (* constant *) InvEval. rewrite sem_int. TrivialExists. simpl. destruct (intsem c0 n1 n2); auto. (* eq cmp *) - InvEval. inv H. simpl in H5. inv H5. - destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. + InvEval. inv H. simpl in H5. inv H5. + destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. simpl. rewrite eval_negate_condition. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_eq; auto. @@ -697,13 +697,13 @@ Proof. simpl. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_eq; auto. rewrite sem_undef; auto. - exists (Vint Int.zero); split. EvalOp. + exists (Vint Int.zero); split. EvalOp. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; rewrite sem_eq; rewrite Int.eq_false; auto. rewrite sem_undef; auto. (* ne cmp *) - InvEval. inv H. simpl in H5. inv H5. - destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. + InvEval. inv H. simpl in H5. inv H5. + destruct (Int.eq_dec n2 Int.zero). subst n2. TrivialExists. simpl. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_ne; auto. rewrite sem_undef; auto. @@ -711,21 +711,21 @@ Proof. simpl. rewrite eval_negate_condition. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; simpl; rewrite sem_ne; auto. rewrite sem_undef; auto. - exists (Vint Int.one); split. EvalOp. + exists (Vint Int.one); split. EvalOp. destruct (eval_condition c0 vl m); simpl. unfold Vtrue, Vfalse. destruct b; rewrite sem_ne; rewrite Int.eq_false; auto. rewrite sem_undef; auto. (* eq andimm *) destruct (Int.eq_dec n2 Int.zero). InvEval; subst. - econstructor; split. EvalOp. simpl; eauto. - destruct v1; simpl; try (rewrite sem_undef; auto). rewrite sem_eq. - destruct (Int.eq (Int.and i n1) Int.zero); auto. + econstructor; split. EvalOp. simpl; eauto. + destruct v1; simpl; try (rewrite sem_undef; auto). rewrite sem_eq. + destruct (Int.eq (Int.and i n1) Int.zero); auto. TrivialExists. simpl. rewrite sem_default. auto. (* ne andimm *) destruct (Int.eq_dec n2 Int.zero). InvEval; subst. - econstructor; split. EvalOp. simpl; eauto. - destruct v1; simpl; try (rewrite sem_undef; auto). rewrite sem_ne. - destruct (Int.eq (Int.and i n1) Int.zero); auto. + econstructor; split. EvalOp. simpl; eauto. + destruct v1; simpl; try (rewrite sem_undef; auto). rewrite sem_ne. + destruct (Int.eq (Int.and i n1) Int.zero); auto. TrivialExists. simpl. rewrite sem_default. auto. (* default *) TrivialExists. simpl. rewrite sem_default. auto. @@ -740,7 +740,7 @@ Lemma eval_compimm_swap: exists v, eval_expr ge sp e m le (compimm default intsem (swap_comparison c) a n2) v /\ Val.lessdef (sem c (Vint n2) x) v. Proof. - intros. rewrite <- sem_swap. eapply eval_compimm; eauto. + intros. rewrite <- sem_swap. eapply eval_compimm; eauto. Qed. End COMP_IMM. @@ -749,9 +749,9 @@ Theorem eval_comp: forall c, binary_constructor_sound (comp c) (Val.cmp c). Proof. intros; red; intros until y. unfold comp; case (comp_match a b); intros; InvEval. - eapply eval_compimm_swap; eauto. + eapply eval_compimm_swap; eauto. intros. unfold Val.cmp. rewrite Val.swap_cmp_bool; auto. - eapply eval_compimm; eauto. + eapply eval_compimm; eauto. TrivialExists. Qed. @@ -759,9 +759,9 @@ Theorem eval_compu: forall c, binary_constructor_sound (compu c) (Val.cmpu (Mem.valid_pointer m) c). Proof. intros; red; intros until y. unfold compu; case (compu_match a b); intros; InvEval. - eapply eval_compimm_swap; eauto. + eapply eval_compimm_swap; eauto. intros. unfold Val.cmpu. rewrite Val.swap_cmpu_bool; auto. - eapply eval_compimm; eauto. + eapply eval_compimm; eauto. TrivialExists. Qed. @@ -777,11 +777,11 @@ Proof. intros; red; intros. unfold compfs. replace (Val.cmpfs c x y) with (Val.cmpf c (Val.floatofsingle x) (Val.floatofsingle y)). - TrivialExists. constructor. EvalOp. simpl; reflexivity. + TrivialExists. constructor. EvalOp. simpl; reflexivity. constructor. EvalOp. simpl; reflexivity. constructor. - auto. - destruct x; auto. destruct y; auto. unfold Val.cmpf, Val.cmpfs; simpl. - rewrite Float32.cmp_double. auto. + auto. + destruct x; auto. destruct y; auto. unfold Val.cmpf, Val.cmpfs; simpl. + rewrite Float32.cmp_double. auto. Qed. Theorem eval_cast8signed: unary_constructor_sound cast8signed (Val.sign_ext 8). @@ -826,7 +826,7 @@ Theorem eval_intoffloat: Val.intoffloat x = Some y -> exists v, eval_expr ge sp e m le (intoffloat a) v /\ Val.lessdef y v. Proof. - intros; unfold intoffloat. TrivialExists. + intros; unfold intoffloat. TrivialExists. Qed. Theorem eval_intuoffloat: @@ -845,24 +845,24 @@ Proof. assert (eval_expr ge sp e m (Vfloat fm :: Vfloat f :: le) (Eletvar O) (Vfloat fm)). constructor. auto. econstructor. eauto. - econstructor. instantiate (1 := Vfloat fm). EvalOp. + econstructor. instantiate (1 := Vfloat fm). EvalOp. eapply eval_Econdition with (va := Float.cmp Clt f fm). eauto with evalexpr. destruct (Float.cmp Clt f fm) eqn:?. exploit Float.to_intu_to_int_1; eauto. intro EQ. EvalOp. simpl. rewrite EQ; auto. - exploit Float.to_intu_to_int_2; eauto. + exploit Float.to_intu_to_int_2; eauto. change Float.ox8000_0000 with im. fold fm. intro EQ. set (t2 := subf (Eletvar (S O)) (Eletvar O)). set (t3 := intoffloat t2). exploit (eval_subf (Vfloat fm :: Vfloat f :: le) (Eletvar (S O)) (Vfloat f) (Eletvar O)); eauto. - fold t2. intros [v2 [A2 B2]]. simpl in B2. inv B2. + fold t2. intros [v2 [A2 B2]]. simpl in B2. inv B2. exploit (eval_addimm Float.ox8000_0000 (Vfloat fm :: Vfloat f :: le) t3). - unfold t3. unfold intoffloat. EvalOp. simpl. rewrite EQ. simpl. eauto. - intros [v4 [A4 B4]]. simpl in B4. inv B4. - rewrite Int.sub_add_opp in A4. rewrite Int.add_assoc in A4. - rewrite (Int.add_commut (Int.neg im)) in A4. - rewrite Int.add_neg_zero in A4. + unfold t3. unfold intoffloat. EvalOp. simpl. rewrite EQ. simpl. eauto. + intros [v4 [A4 B4]]. simpl in B4. inv B4. + rewrite Int.sub_add_opp in A4. rewrite Int.add_assoc in A4. + rewrite (Int.add_commut (Int.neg im)) in A4. + rewrite Int.add_neg_zero in A4. rewrite Int.add_zero in A4. auto. Qed. @@ -874,18 +874,18 @@ Theorem eval_floatofint: exists v, eval_expr ge sp e m le (floatofint a) v /\ Val.lessdef y v. Proof. intros until y. unfold floatofint. destruct (floatofint_match a); intros. - InvEval. TrivialExists. + InvEval. TrivialExists. rename e0 into a. destruct x; simpl in H0; inv H0. exists (Vfloat (Float.of_int i)); split; auto. set (t1 := addimm Float.ox8000_0000 a). set (t2 := Eop Ofloatofwords (Eop (Ointconst Float.ox4330_0000) Enil ::: t1 ::: Enil)). set (t3 := Eop (Ofloatconst (Float.from_words Float.ox4330_0000 Float.ox8000_0000)) Enil). - exploit (eval_addimm Float.ox8000_0000 le a). eauto. fold t1. + exploit (eval_addimm Float.ox8000_0000 le a). eauto. fold t1. intros [v1 [A1 B1]]. simpl in B1. inv B1. - exploit (eval_subf le t2). - unfold t2. EvalOp. constructor. EvalOp. simpl; eauto. constructor. eauto. constructor. - unfold eval_operation. eauto. - instantiate (2 := t3). unfold t3. EvalOp. simpl; eauto. + exploit (eval_subf le t2). + unfold t2. EvalOp. constructor. EvalOp. simpl; eauto. constructor. eauto. constructor. + unfold eval_operation. eauto. + instantiate (2 := t3). unfold t3. EvalOp. simpl; eauto. intros [v2 [A2 B2]]. simpl in B2. inv B2. rewrite Float.of_int_from_words. auto. Qed. @@ -902,9 +902,9 @@ Proof. unfold floatofintu. set (t2 := Eop Ofloatofwords (Eop (Ointconst Float.ox4330_0000) Enil ::: a ::: Enil)). set (t3 := Eop (Ofloatconst (Float.from_words Float.ox4330_0000 Int.zero)) Enil). - exploit (eval_subf le t2). - unfold t2. EvalOp. constructor. EvalOp. simpl; eauto. constructor. eauto. constructor. - unfold eval_operation. eauto. + exploit (eval_subf le t2). + unfold t2. EvalOp. constructor. EvalOp. simpl; eauto. constructor. eauto. constructor. + unfold eval_operation. eauto. instantiate (2 := t3). unfold t3. EvalOp. simpl; eauto. intros [v2 [A2 B2]]. simpl in B2. inv B2. rewrite Float.of_intu_from_words. auto. Qed. @@ -915,14 +915,14 @@ Theorem eval_intofsingle: Val.intofsingle x = Some y -> exists v, eval_expr ge sp e m le (intofsingle a) v /\ Val.lessdef y v. Proof. - intros; unfold intofsingle. + intros; unfold intofsingle. assert (Val.intoffloat (Val.floatofsingle x) = Some y). { destruct x; simpl in H0; try discriminate. - destruct (Float32.to_int f) eqn:F; inv H0. - apply Float32.to_int_double in F. - simpl. unfold Float32.to_double in F; rewrite F; auto. + destruct (Float32.to_int f) eqn:F; inv H0. + apply Float32.to_int_double in F. + simpl. unfold Float32.to_double in F; rewrite F; auto. } - apply eval_intoffloat with (Val.floatofsingle x); auto. EvalOp. + apply eval_intoffloat with (Val.floatofsingle x); auto. EvalOp. Qed. Theorem eval_singleofint: @@ -935,11 +935,11 @@ Proof. assert (exists z, Val.floatofint x = Some z /\ y = Val.singleoffloat z). { destruct x; inv H0. simpl. exists (Vfloat (Float.of_int i)); simpl; split; auto. - f_equal. apply Float32.of_int_double. + f_equal. apply Float32.of_int_double. } - destruct H1 as (z & A & B). subst y. - exploit eval_floatofint; eauto. intros (v & C & D). - exists (Val.singleoffloat v); split. EvalOp. inv D; auto. + destruct H1 as (z & A & B). subst y. + exploit eval_floatofint; eauto. intros (v & C & D). + exists (Val.singleoffloat v); split. EvalOp. inv D; auto. Qed. Theorem eval_intuofsingle: @@ -948,14 +948,14 @@ Theorem eval_intuofsingle: Val.intuofsingle x = Some y -> exists v, eval_expr ge sp e m le (intuofsingle a) v /\ Val.lessdef y v. Proof. - intros; unfold intuofsingle. + intros; unfold intuofsingle. assert (Val.intuoffloat (Val.floatofsingle x) = Some y). { destruct x; simpl in H0; try discriminate. - destruct (Float32.to_intu f) eqn:F; inv H0. - apply Float32.to_intu_double in F. - simpl. unfold Float32.to_double in F; rewrite F; auto. + destruct (Float32.to_intu f) eqn:F; inv H0. + apply Float32.to_intu_double in F. + simpl. unfold Float32.to_double in F; rewrite F; auto. } - apply eval_intuoffloat with (Val.floatofsingle x); auto. EvalOp. + apply eval_intuoffloat with (Val.floatofsingle x); auto. EvalOp. Qed. Theorem eval_singleofintu: @@ -968,11 +968,11 @@ Proof. assert (exists z, Val.floatofintu x = Some z /\ y = Val.singleoffloat z). { destruct x; inv H0. simpl. exists (Vfloat (Float.of_intu i)); simpl; split; auto. - f_equal. apply Float32.of_intu_double. + f_equal. apply Float32.of_intu_double. } - destruct H1 as (z & A & B). subst y. - exploit eval_floatofintu; eauto. intros (v & C & D). - exists (Val.singleoffloat v); split. EvalOp. inv D; auto. + destruct H1 as (z & A & B). subst y. + exploit eval_floatofintu; eauto. intros (v & C & D). + exists (Val.singleoffloat v); split. EvalOp. inv D; auto. Qed. Theorem eval_addressing: @@ -981,7 +981,7 @@ Theorem eval_addressing: v = Vptr b ofs -> match addressing chunk a with (mode, args) => exists vl, - eval_exprlist ge sp e m le args vl /\ + eval_exprlist ge sp e m le args vl /\ eval_addressing ge sp mode vl = Some v end. Proof. @@ -990,12 +990,12 @@ Proof. exists (@nil val). split. eauto with evalexpr. simpl. auto. exists (v1 :: nil). split. eauto with evalexpr. simpl. congruence. exists (v1 :: nil). split. eauto with evalexpr. simpl. congruence. - destruct (can_use_Aindexed2 chunk). + destruct (can_use_Aindexed2 chunk). exists (v1 :: v0 :: nil). split. eauto with evalexpr. simpl. congruence. exists (Vptr b ofs :: nil). split. - constructor. EvalOp. simpl; congruence. constructor. + constructor. EvalOp. simpl; congruence. constructor. simpl. rewrite Int.add_zero. auto. - exists (v :: nil). split. eauto with evalexpr. subst v. simpl. + exists (v :: nil). split. eauto with evalexpr. subst v. simpl. rewrite Int.add_zero. auto. Qed. @@ -1007,7 +1007,7 @@ Proof. intros until v. unfold builtin_arg; case (builtin_arg_match a); intros; InvEval. - constructor. - constructor. -- constructor. +- constructor. - simpl in H5. inv H5. constructor. - subst v. constructor; auto. - inv H. InvEval. simpl in H6; inv H6. constructor; auto. diff --git a/powerpc/Stacklayout.v b/powerpc/Stacklayout.v index be823c1e..a751fd98 100644 --- a/powerpc/Stacklayout.v +++ b/powerpc/Stacklayout.v @@ -117,10 +117,10 @@ Proof. fe_ofs_float_callee_save, fe_num_float_callee_save, fe_stack_data. set (x1 := align (8 + 4 * bound_outgoing b) 8). - assert (8 | x1). unfold x1; apply align_divides. omega. + assert (8 | x1). unfold x1; apply align_divides. omega. set (x2 := x1 + 4 * bound_local b). assert (4 | x2). unfold x2; apply Zdivide_plus_r; auto. - apply Zdivides_trans with 8. exists 2; auto. auto. + apply Zdivides_trans with 8. exists 2; auto. auto. exists (bound_local b); ring. set (x3 := x2 + 4). assert (4 | x3). unfold x3; apply Zdivide_plus_r; auto. exists 1; auto. diff --git a/powerpc/TargetPrinter.ml b/powerpc/TargetPrinter.ml index 7dbc2cf5..74eb8776 100644 --- a/powerpc/TargetPrinter.ml +++ b/powerpc/TargetPrinter.ml @@ -103,15 +103,15 @@ module Linux_System : SYSTEM = let freg oc r = output_string oc (float_reg_name r) - - let creg oc r = + + let creg oc r = fprintf oc "%d" r - + let name_of_section = function | Section_text -> ".text" | Section_data i -> if i then ".data" else "COMM" - | Section_small_data i -> + | Section_small_data i -> if i then ".section .sdata,\"aw\",@progbits" else "COMM" | Section_const i -> if i then ".rodata" else "COMM" @@ -137,17 +137,17 @@ module Linux_System : SYSTEM = let print_file_line oc file line = print_file_line oc comment file line - - (* Emit .cfi directives *) + + (* Emit .cfi directives *) let cfi_startproc = cfi_startproc let cfi_endproc = cfi_endproc - + let cfi_adjust = cfi_adjust - + let cfi_rel_offset = cfi_rel_offset - let print_prologue oc = + let print_prologue oc = if !Clflags.option_g then begin section oc Section_text; let low_pc = new_label () in @@ -168,7 +168,7 @@ module Linux_System : SYSTEM = let debug_section _ _ = () end - + module Diab_System : SYSTEM = struct @@ -188,7 +188,7 @@ module Diab_System : SYSTEM = symbol_fragment oc s n "@sdax@l" | Csymbol_rel_high(s, n) -> symbol_fragment oc s n "@sdarx@ha" - + let ireg oc r = output_char oc 'r'; output_string oc (int_reg_name r) @@ -196,10 +196,10 @@ module Diab_System : SYSTEM = let freg oc r = output_char oc 'f'; output_string oc (float_reg_name r) - + let creg oc r = fprintf oc "cr%d" r - + let name_of_section = function | Section_text -> ".text" | Section_data i -> if i then ".data" else "COMM" @@ -247,20 +247,20 @@ module Diab_System : SYSTEM = let debug_section oc sec = match sec with - | Section_debug_abbrev + | Section_debug_abbrev | Section_debug_info _ | Section_debug_loc -> () | sec -> let name = match sec with | Section_user (name,_,_) -> name | _ -> name_of_section sec in - if not (Debug.exists_section name) then + if not (Debug.exists_section name) then let line_start = new_label () and low_pc = new_label () and debug_info = new_label () in Debug.add_diab_info name (line_start,debug_info,name_of_section sec); Debug.add_compilation_section_start name low_pc; - let line_name = ".debug_line" ^(if name <> ".text" then name else "") in + let line_name = ".debug_line" ^(if name <> ".text" then name else "") in fprintf oc " .section %s,,n\n" line_name; if name <> ".text" then fprintf oc " .sectionlink .debug_line\n"; @@ -271,18 +271,18 @@ module Diab_System : SYSTEM = fprintf oc " .d2_line_start %s\n" line_name else () - + let print_prologue oc = fprintf oc " .xopt align-fill-text=0x60000000\n"; debug_section oc Section_text let print_epilogue oc = - let end_label sec = + let end_label sec = fprintf oc "\n"; fprintf oc " %s\n" sec; let label_end = new_label () in fprintf oc "%a:\n" label label_end; - label_end + label_end and entry_label f = let label = new_label () in fprintf oc ".L%d: .d2filenum \"%s\"\n" label f; @@ -298,7 +298,7 @@ module Target (System : SYSTEM):TARGET = (* Basic printing functions *) let symbol = symbol - + let raw_symbol oc s = fprintf oc "%s" s @@ -363,7 +363,7 @@ module Target (System : SYSTEM):TARGET = let short_cond_branch tbl pc lbl_dest = match PTree.get lbl_dest tbl with | None -> assert false - | Some pc_dest -> + | Some pc_dest -> let disp = pc_dest - pc in -0x2000 <= disp && disp < 0x2000 (* Printing of instructions *) @@ -531,11 +531,11 @@ module Target (System : SYSTEM):TARGET = | Pfnmsub(r1, r2, r3, r4) -> fprintf oc " fnmsub %a, %a, %a, %a\n" freg r1 freg r2 freg r3 freg r4 | Pfsqrt(r1, r2) -> - fprintf oc " fsqrt %a, %a\n" freg r1 freg r2 + fprintf oc " fsqrt %a, %a\n" freg r1 freg r2 | Pfrsqrte(r1, r2) -> - fprintf oc " frsqrte %a, %a\n" freg r1 freg r2 + fprintf oc " frsqrte %a, %a\n" freg r1 freg r2 | Pfres(r1, r2) -> - fprintf oc " fres %a, %a\n" freg r1 freg r2 + fprintf oc " fres %a, %a\n" freg r1 freg r2 | Pfsel(r1, r2, r3, r4) -> fprintf oc " fsel %a, %a, %a, %a\n" freg r1 freg r2 freg r3 freg r4 | Pisel (r1,r2,r3,cr) -> @@ -768,7 +768,7 @@ module Target (System : SYSTEM):TARGET = let nlo = Int64.to_int32 n and nhi = Int64.to_int32(Int64.shift_right_logical n 32) in fprintf oc "%a: .long 0x%lx, 0x%lx\n" label lbl nhi nlo - + let print_literal32 oc (lbl, n) = fprintf oc "%a: .long 0x%lx\n" label lbl n @@ -798,10 +798,10 @@ module Target (System : SYSTEM):TARGET = if Z.gt n Z.zero then fprintf oc " .space %s\n" (Z.to_string n) | Init_addrof(symb, ofs) -> - fprintf oc " .long %a\n" + fprintf oc " .long %a\n" symbol_offset (symb, ofs) - + let print_fun_info = elf_print_fun_info let emit_constants oc lit = @@ -815,26 +815,26 @@ module Target (System : SYSTEM):TARGET = let print_optional_fun_info _ = () - let get_section_names name = + let get_section_names name = match C2C.atom_sections name with | [t;l;j] -> (t, l, j) | _ -> (Section_text, Section_literal, Section_jumptable) - + let reset_constants = reset_constants - + let print_var_info = elf_print_var_info - let print_comm_symb oc sz name align = + let print_comm_symb oc sz name align = fprintf oc " %s %a, %s, %d\n" (if C2C.atom_is_static name then ".lcomm" else ".comm") symbol name (Z.to_string sz) align - + let print_align oc align = fprintf oc " .balign %d\n" align - let print_jumptable oc jmptbl = + let print_jumptable oc jmptbl = let print_jumptable oc (lbl, tbl) = fprintf oc "%a:" label lbl; List.iter @@ -849,7 +849,7 @@ module Target (System : SYSTEM):TARGET = let default_falignment = 4 - let new_label = new_label + let new_label = new_label let section oc sec = section oc sec; @@ -857,7 +857,7 @@ module Target (System : SYSTEM):TARGET = end let sel_target () = - let module S = (val + let module S = (val (match Configuration.system with | "linux" -> (module Linux_System:SYSTEM) | "diab" -> (module Diab_System:SYSTEM) diff --git a/powerpc/ValueAOp.v b/powerpc/ValueAOp.v index 8cb29145..9985fb9f 100644 --- a/powerpc/ValueAOp.v +++ b/powerpc/ValueAOp.v @@ -159,7 +159,7 @@ Theorem eval_static_addressing_sound: Proof. unfold eval_addressing, eval_static_addressing; intros; destruct addr; InvHyps; eauto with va. - rewrite Int.add_zero_l; auto with va. + rewrite Int.add_zero_l; auto with va. Qed. Theorem eval_static_operation_sound: @@ -174,8 +174,8 @@ Proof. destruct (propagate_float_constants tt); constructor. rewrite Int.add_zero_l; eauto with va. fold (Val.sub (Vint i) a1). auto with va. - apply floatofwords_sound; auto. - apply of_optbool_sound. eapply eval_static_condition_sound; eauto. + apply floatofwords_sound; auto. + apply of_optbool_sound. eapply eval_static_condition_sound; eauto. Qed. End SOUNDNESS. diff --git a/tools/ndfun.ml b/tools/ndfun.ml index 4ee07e54..2b8bcb19 100644 --- a/tools/ndfun.ml +++ b/tools/ndfun.ml @@ -33,7 +33,7 @@ let oneline s = let re_trim_1 = Str.regexp "^[ \t]+\\|[ \t]+$" let re_trim_2 = Str.regexp " +" -let trim s = +let trim s = Str.global_replace re_trim_2 " " (Str.global_replace re_trim_1 "" s) (* A nicer interface to Str.match_string, with automatic trimming *) @@ -70,7 +70,7 @@ let re_arg = Str.regexp "\\([a-z][a-z0-9_]*\\)" let match_args args = let n = ref 0 in - let subst s = + let subst s = incr n; sprintf "%s as zz%d" (Str.matched_group 1 s) !n in Str.global_substitute re_arg subst args @@ -78,7 +78,7 @@ let match_args args = let match_temps args = let n = ref 0 in - let subst s = + let subst s = incr n; sprintf "zz%d" !n in Str.global_substitute re_arg subst (remove_commas args) |