diff --git a/.gitignore b/.gitignore index 16fa114..8cee781 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,6 @@ src/clib/* *.aux .lia.cache **Makefile*coq* +src/verified_lowering/stringify/test/ +src/verified_lowering/stringify/lib/ +src/verified_lowering/count_reshape/out.csv diff --git a/src/verified_lowering/count_reshape/.Makefile.coq.d b/src/verified_lowering/count_reshape/.Makefile.coq.d deleted file mode 100644 index 3d931d6..0000000 --- a/src/verified_lowering/count_reshape/.Makefile.coq.d +++ /dev/null @@ -1,3 +0,0 @@ -Count.vo Count.glob Count.v.beautified Count.required_vo: Count.v ../../verified_scheduling/atl/Div.vo ../../verified_scheduling/atl/ATL.vo ../../examples/Blur.vo ../../examples/TensorAdd.vo ../../examples/Im2col.vo ../../examples/Convolution.vo ../../examples/GatherScatter.vo ../../examples/Matmul.vo ../../verified_scheduling/codegen/IdentParsing.vo ../../verified_scheduling/codegen/NatToString.vo ../../verified_scheduling/codegen/IntToString.vo ../../verified_scheduling/codegen/Normalize.vo ../proof/ATLDeep.vo ../proof/Sexpr.vo ../proof/Zexpr.vo ../proof/Bexpr.vo ../inferpad/Reify.vo -Count.vio: Count.v ../../verified_scheduling/atl/Div.vio ../../verified_scheduling/atl/ATL.vio ../../examples/Blur.vio ../../examples/TensorAdd.vio ../../examples/Im2col.vio ../../examples/Convolution.vio ../../examples/GatherScatter.vio ../../examples/Matmul.vio ../../verified_scheduling/codegen/IdentParsing.vio ../../verified_scheduling/codegen/NatToString.vio ../../verified_scheduling/codegen/IntToString.vio ../../verified_scheduling/codegen/Normalize.vio ../proof/ATLDeep.vio ../proof/Sexpr.vio ../proof/Zexpr.vio ../proof/Bexpr.vio ../inferpad/Reify.vio -Count.vos Count.vok Count.required_vos: Count.v ../../verified_scheduling/atl/Div.vos ../../verified_scheduling/atl/ATL.vos ../../examples/Blur.vos ../../examples/TensorAdd.vos ../../examples/Im2col.vos ../../examples/Convolution.vos ../../examples/GatherScatter.vos ../../examples/Matmul.vos ../../verified_scheduling/codegen/IdentParsing.vos ../../verified_scheduling/codegen/NatToString.vos ../../verified_scheduling/codegen/IntToString.vos ../../verified_scheduling/codegen/Normalize.vos ../proof/ATLDeep.vos ../proof/Sexpr.vos ../proof/Zexpr.vos ../proof/Bexpr.vos ../inferpad/Reify.vos diff --git a/src/verified_lowering/inferpad/InferPad.v b/src/verified_lowering/inferpad/InferPad.v index 8858f5b..6f7b85e 100644 --- a/src/verified_lowering/inferpad/InferPad.v +++ b/src/verified_lowering/inferpad/InferPad.v @@ -129,7 +129,7 @@ Proof. assert (x0 <> x)%Z by lia. eapply Z.eqb_neq in H1. rewrite <- H1. econstructor; eapply eval_Zexpr_Z_eval_Zexpr; eauto. -Qed. +Qed. Ltac is_unspec_nat n := match n with @@ -188,44 +188,51 @@ Ltac arith := Ltac outer_dim e := let outer_dim := constr:(match (sizeof e) with - | n::_ => eval_Zexpr_Z_total $0 n - | _ => 0%Z + | n::_ => Z.to_nat (eval_Zexpr_Z_total $0 n) + | _ => 0 end) in - let outer_dim := eval unfold eval_Zexpr_Z_total in outer_dim in - let outer_dim := eval simpl in outer_dim in - outer_dim. + let outer_dim := eval compute in outer_dim in + outer_dim. Ltac inner_dim e := let inner_dim := constr:(match (sizeof e) with - | _::d::_ => eval_Zexpr_Z_total $0 d - | _ => 0%Z + | _::d::_ => Z.to_nat (eval_Zexpr_Z_total $0 d) + | _ => 0 end) in - let inner_dim := eval unfold eval_Zexpr_Z_total in inner_dim in - let inner_dim := eval simpl in inner_dim in - inner_dim. + let inner_dim := eval compute in inner_dim in + inner_dim. + +Ltac infer_size_of := + repeat match goal with + | |- size_of _ _ _ => econstructor + | |- eval_Zexpr _ _ _ => econstructor; eauto + | |- _ = _ => reflexivity + | |- _ :: _ = _ :: _ => f_equal + | _ => lia + end. + Ltac infer_pad left right := match goal with - | |- has_pad _ _ _ (Scalar _) _ => + | |- has_pad _ _ (Scalar _) _ => eapply HasPadScalarNotPad - | |- has_pad _ _ _ (Split _ _) _ => + | |- has_pad _ _ (Split _ _) _ => infer_split left right - | |- has_pad _ _ _ (Truncr ?k _) _ => + | |- has_pad _ _ (Truncr ?k _) _ => infer_truncr left right 0%nat - | |- has_pad _ _ _ (Truncl ?k _) _ => + | |- has_pad _ _ (Truncl ?k _) _ => infer_truncl left right 0%nat - | |- has_pad _ _ _ (Padr ?k _) _ => + | |- has_pad _ _ (Padr ?k _) _ => infer_padr left right - | |- has_pad _ _ _ (Padl ?k _) _ => + | |- has_pad _ _ (Padl ?k _) _ => infer_padl left right - | |- has_pad _ _ _ (Gen ?i ?lo ?hi ?e) _ => + | |- has_pad _ _ (Gen ?i ?lo ?hi ?e) _ => infer_gen left right - | |- has_pad _ _ _ (Lbind ?x ?e1 ?e2) _ => + | |- has_pad _ _ (Lbind ?x ?e1 ?e2) _ => eapply HasPadLbind; [ solve [ infer_pad 0%Z 0%Z ] | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | + infer_size_of | solve [ infer_pad left right ] ] - | |- has_pad ?ctx ?v ?g (Guard ?p ?e) _ => + | |- has_pad ?v ?g (Guard ?p ?e) _ => first [ solve [ eapply HasPadGuardFalse; [ eapply Bexpr_to_Prop_eval_Bexpr_false; [ autounfold; simpl; @@ -233,66 +240,66 @@ Ltac infer_pad left right := [ rewrite lookup_add_ne by inversion 1 | rewrite lookup_add_eq by auto ]; lia | simpl; repeat rewrite dom_add; rewrite dom_empty; simpl; sets ] | - repeat (econstructor; eauto) | + infer_size_of | reflexivity ] ] | eapply HasPadGuardTrue; infer_pad left right ] - | |- has_pad ?ctx ?v ?g (Concat ?e1 ?e2) _ => + | |- has_pad ?v ?g (Concat ?e1 ?e2) _ => infer_concat left right - | |- has_pad ?ctx ?v ?g (Sum ?i ?lo ?hi ?e) _ => + | |- has_pad ?v ?g (Sum ?i ?lo ?hi ?e) _ => first [ eapply HasPadSumEmpty; - [ repeat (econstructor; eauto) | + [ infer_size_of | autounfold; simpl; lia | reflexivity ] | eapply HasPadSum; [ autounfold; simpl; intros; infer_pad left right | autounfold; simpl; lia ] ] - | |- has_pad ?ctx ?v ?g (Flatten ?e) _ => + | |- has_pad ?v ?g (Flatten ?e) _ => infer_flatten left right 0%nat - | |- has_pad _ _ _ (Transpose _) _ => + | |- has_pad _ _ (Transpose _) _ => infer_transpose 0%Z 0%Z 0%nat 0%nat end with infer_padr left right := match goal with - | |- has_pad _ _ _ (Padr ?k ?e) _ => + | |- has_pad _ _ (Padr ?k ?e) _ => let outer_dim := outer_dim e in let right' := constr:(Z.max (right-eval_Zexpr_Z_total $0 k)%Z 0%Z) in let right' := eval unfold eval_Zexpr_Z_total in right' in let right' := eval simpl in right' in - first [ solve [ assert (0 < outer_dim)%Z as Hcheck by lia; + first [ solve [ assert (0 < outer_dim)%nat as Hcheck by lia; clear Hcheck; eapply HasPadPadr; [ autounfold; simpl; intros; try lia; infer_pad left right' | - repeat (econstructor; eauto) | + infer_size_of | arith | arith | arith | arith ] ] | - eapply HasPadPadrEmpty; [ repeat (econstructor; eauto) | + eapply HasPadPadrEmpty; [ infer_size_of | infer_pad 0%Z 0%Z | arith ] ] end with infer_padl left right := match goal with - | |- has_pad _ _ _ (Padl ?k ?e) _ => + | |- has_pad _ _ (Padl ?k ?e) _ => let outer_dim := outer_dim e in let left' := constr:(Z.max (left-eval_Zexpr_Z_total $0 k)%Z 0%Z) in let left' := eval unfold eval_Zexpr_Z_total in left' in let left' := eval simpl in left' in - first [ solve [ assert (0 < outer_dim)%Z as Hcheck by lia; + first [ solve [ assert (0 < outer_dim)%nat as Hcheck by lia; clear Hcheck; eapply HasPadPadl; [ autounfold; simpl; intros; try lia; infer_pad left' right | - repeat (econstructor; eauto) | + infer_size_of | arith | arith | arith | arith ] ] | - eapply HasPadPadlEmpty; [ repeat (econstructor; eauto) | + eapply HasPadPadlEmpty; [ infer_size_of | infer_pad 0%Z 0%Z | arith ] ] end with infer_truncr left right offset := match goal with - | |- has_pad _ _ _ (Truncr ?k ?e) _ => + | |- has_pad _ _ (Truncr ?k ?e) _ => let outer_dim := outer_dim e in let right' := constr:((right+ eval_Zexpr_Z_total $0 k)%Z) in let right' := eval unfold eval_Zexpr_Z_total in right' in @@ -305,7 +312,7 @@ end with infer_truncr left right offset := ] end with infer_truncl left right offset := match goal with - | |- has_pad _ _ _ (Truncl ?k ?e) _ => + | |- has_pad _ _ (Truncl ?k ?e) _ => let outer_dim := outer_dim e in let left' := constr:((left+ eval_Zexpr_Z_total $0 k)%Z) in let left' := eval unfold eval_Zexpr_Z_total in left' in @@ -315,20 +322,22 @@ end with infer_truncr left right offset := [ infer_pad left' right | arith | arith ] ] | - assert (Z.to_nat left' + offset < Z.to_nat outer_dim) as + assert (Z.to_nat left' + offset < outer_dim)%nat as Hcheck by (arith; lia); clear Hcheck; infer_truncl left right constr:(offset+1) ] end with infer_concat left right := match goal with - | |- has_pad _ _ _ (Concat _ _) _ => - first [ solve [ eapply HasPadConcat with + | |- has_pad _ _ (Concat _ _) _ => + first [ + (*Uncommenting the folllowing code will cause blur_tiles_guarded pad inference + to take a very very long time. idk if it goes into an infinite loop, but i + let it run for 30 minutes and nothing happened.*) + (*solve [ eapply HasPadConcat with (x:=0) (y:=0) (a:=0) (b:=0) - (l1:=0) (r1:=0) (l1:=0) (r2:=0); - [ repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | + (l1:=0) (r1:=0) (r2:=0); + [ infer_size_of | + infer_size_of | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold; simpl; intros; try lia; @@ -336,12 +345,10 @@ end with infer_truncr left right offset := arith | arith | arith | - arith ] ] | + arith ] ] |*) solve [ eapply HasPadConcat; - [ repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | + [ infer_size_of | + infer_size_of | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold; simpl; intros; try lia; @@ -350,9 +357,9 @@ end with infer_truncr left right offset := arith | arith | arith ] ] ] - end with infer_gen left right := + end with infer_gen left right := match goal with - | |- has_pad _ _ _ (Gen ?i ?lo ?hi _) (PadCons ?kk ?l ?p1 ?r ?p2 ?cc) => + | |- has_pad _ _ (Gen ?i ?lo ?hi _) (PadCons ?kk ?l ?p1 ?r ?p2 ?cc) => let kkk := match goal with | |- _ => let _ := (* if it's an evar let's instantiate @@ -410,8 +417,7 @@ end with infer_truncr left right offset := [ arith | arith | arith | - repeat (econstructor; autounfold; try intros;simpl ); - try list_eq; eauto | + infer_size_of | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold;simpl;intros; @@ -423,14 +429,13 @@ end with infer_truncr left right offset := [ arith | arith | arith | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | + infer_size_of | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold;simpl;intros;first [ lia|infer_pad 0%Z 0%Z ] | try (autounfold; simpl; try first [ lia | reflexivity]) ] ] ] - | |- has_pad _ _ _ (Gen ?i ?lo ?hi ?e) _ => + | |- has_pad _ _ (Gen ?i ?lo ?hi ?e) _ => (* if it doesn't have any pad type structure all bets are off *) let kk:= constr:(Z.to_nat left) in let cc:= constr:(Z.to_nat right) in @@ -444,8 +449,7 @@ end with infer_truncr left right offset := [ arith | arith | arith | - repeat (econstructor; autounfold; try intros;simpl ); - try list_eq; eauto | + infer_size_of | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold;simpl;intros; @@ -457,17 +461,16 @@ end with infer_truncr left right offset := [ arith | arith | arith | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | + infer_size_of | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | autounfold;simpl;intros;first [ lia|infer_pad 0%Z 0%Z ] | try (autounfold; simpl; try first [ lia | reflexivity]) ] ] ] end -with infer_flatten left right offset := + with infer_flatten left right offset := match goal with - | |- has_pad _ _ _ (Flatten ?e) (PadCons ?xx ?ll ?p1 ?rr ?p4 ?yy) => + | |- has_pad _ _ (Flatten ?e) (PadCons ?xx ?ll ?p1 ?rr ?p4 ?yy) => let inner_dim := inner_dim e in let outer_dim := outer_dim e in let xxx := match goal with @@ -480,55 +483,55 @@ with infer_flatten left right offset := constr:(Z.to_nat right) | |- _ => yy end in - let aa := constr:(xxx mod Z.to_nat inner_dim) in - let bb := constr:(yyy mod Z.to_nat inner_dim) in - let x_ := constr:(xxx / Z.to_nat inner_dim) in - let y_ := constr:(yyy / Z.to_nat inner_dim) in + let aa := constr:(xxx mod inner_dim) in + let bb := constr:(yyy mod inner_dim) in + let x_ := constr:(xxx / inner_dim) in + let y_ := constr:(yyy / inner_dim) in let ll := offset in (* idtac x_; idtac ll; idtac aa; idtac bb; idtac y_; *) first [ solve [ eapply HasPadFlattenStrong with (b:=bb) (a:=aa) (x:=x_) (y:=y_) (l:=ll) (l1:=0) (r1:=0) (c:=0) (l2:=0) (r2:=0) (d:=0); [ infer_pad x_ y_ | - repeat econstructor; eauto | + infer_size_of | arith | arith | arith | arith | arith | arith | arith | arith | arith ] ] | solve [ eapply HasPadFlattenStrong with (b:=bb) (a:=aa) (x:=x_) (y:=y_) (l:=ll) (l1:=0) (r1:=0) (c:=0); [ infer_pad x_ y_ | - repeat econstructor; eauto | + infer_size_of | arith | arith | arith | arith | arith | arith | arith | arith | arith ] ] | solve [ eapply HasPadFlattenStrong with (b:=bb) (a:=aa) (x:=x_) (y:=y_) (l:=ll); [ infer_pad x_ y_ | - repeat econstructor; eauto | + infer_size_of | arith | arith | arith | arith | arith | arith | arith | arith | arith ] ] | solve [ eapply HasPadFlattenStrong with (b:=bb) (a:=aa) (x:=x_) (y:=y_); [ infer_pad x_ y_ | - repeat econstructor; eauto | + infer_size_of | arith | arith | arith | arith | arith | arith | arith | arith | arith ] ] | - assert (offset < Z.to_nat outer_dim - x_ - y_) + assert (offset < outer_dim - x_ - y_) as Hcheck by (arith; lia); clear Hcheck; solve [ infer_flatten left right constr:(offset+1) ] ] -end with infer_transpose left right offset1 offset2 := + end with infer_transpose left right offset1 offset2 := match goal with - | |- has_pad _ _ _ (Transpose ?e) ?pi => + | |- has_pad _ _ (Transpose ?e) ?pi => is_unspec_pad_ty pi; solve [ eapply HasPadTransposeWeak; [ infer_pad 0%Z 0%Z | - repeat econstructor | + infer_size_of | arith | arith | arith | arith ] ] - | |- has_pad _ _ _ (Transpose ?e) + | |- has_pad _ _ (Transpose ?e) (PadCons ?ll_ ?lll_ ?pi1 ?rrr_ ?pi2 ?rr_) => let outer_dim := outer_dim e in let inner_dim := inner_dim e in @@ -542,32 +545,32 @@ end with infer_transpose left right offset1 offset2 := constr:(Z.to_nat right) | |- _ => rr_ end in - let lll':= constr:(Z.to_nat inner_dim - ll' - rr' - offset1) in + let lll':= constr:(inner_dim - ll' - rr' - offset1) in let rrr' := offset1 in - let l' := constr:(Z.to_nat outer_dim - offset2) in + let l' := constr:(outer_dim - offset2) in let r' := offset2 in (* idtac ll'; idtac rr'; idtac lll'; idtac rrr'; *) first [ solve [ eapply HasPadTransposeStrong with (x:=0) (y:=0) (ll:=ll') (rr:=rr') (lll:=lll') (rrr:=rrr') (l:=l') (r:=r'); cycle 1; - [ repeat (econstructor; eauto) | + [ infer_size_of | arith | arith | arith | arith | arith | autounfold; simpl; intros; arith; try lia; infer_pad 0%Z 0%Z ] ] | - assert (offset2 + 1 <= Z.to_nat outer_dim - ll' - rr') + assert (offset2 + 1 <= outer_dim - ll' - rr') as Hcheck by (arith; try lia) ; clear Hcheck; infer_transpose left right offset1 constr:((offset2 + 1)%nat) ] end with infer_split left right := match goal with - | |- has_pad _ _ _ (Split _ _) _ => + | |- has_pad _ _ (Split _ _) _ => eapply HasPadSplit; [ infer_pad 0%Z 0%Z | - repeat econstructor | + infer_size_of | arith | arith | arith | @@ -577,14 +580,14 @@ end with infer_transpose left right offset1 offset2 := Goal forall v, Common.truncl 3 (GEN [ i < 10 ] (|[ 1 @@ -621,9 +624,9 @@ Goal forall B C K W RR (w : list (list (list R))) (x : list (list (list R))), im2col_lifted B K W C RR w x. Proof. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } -Abort. +Abort. Goal forall B C K W RR (w : list (list (list R))) (x : list (list (list R))), (0 < B)%Z -> @@ -634,9 +637,9 @@ Goal forall B C K W RR (w : list (list (list R))) (x : list (list (list R))), im2col_lifted B K W C RR w x = im2col B K W C RR w x. Proof. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } -Abort. +Abort. Goal forall (W C B K : Z) (x w : list (list (list R))) (RR : Z) (a b :nat), consistent w (a,(b,(Z.to_nat RR, tt))) -> @@ -650,7 +653,7 @@ Goal forall (W C B K : Z) (x w : list (list (list R))) (RR : Z) (a b :nat), Proof. intros. unfold scatter_full. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } Abort. @@ -666,23 +669,23 @@ Goal forall (W C B K : Z) (x w : list (list (list R))) (RR : Z) (a b :nat), Proof. intros. unfold gather_full. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } Abort. - + Goal forall (A B C : nat) (m1 m2 : (list (list R))) (k : Z), (0 < k)%Z -> 0 < A -> 0 < B -> 0 < C -> consistent m1 (64,(64,tt)) -> - consistent m2 (64,(64,tt)) -> + consistent m2 (64,(64,tt)) -> matmul_tiled_split 64 64 64 m1 m2 4 = matmul 64 64 64 m1 m2. Proof. autounfold with examples. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } Abort. @@ -691,12 +694,11 @@ Goal forall n m (l : list (list R)), 0 < m -> consistent l (n,(m,tt)) -> blur_tiles_guarded l 64 64 4 4 = @nil _. -Proof. +Proof. autounfold. unfold blur_tiles_guarded. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - eexists. - { infer_pad 0%Z 0%Z. (* Takes ~10m to run *) } + assert (exists pad, has_pad $0 $0 ast pad). + { eexists. infer_pad 0%Z 0%Z. (* Takes ~10m to run *) } Abort. Goal forall n m (v : list (list R)), @@ -706,7 +708,7 @@ Goal forall n m (v : list (list R)), blurimmediate_isolate n m v = @nil _. Proof. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_concat 0%Z 0%Z. } Abort. @@ -717,14 +719,14 @@ Goal forall N M (v : list (list R)), blurtwostage_partition N M v = @nil _. Proof. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } Abort. Goal forall v, Common.truncl 3 (GEN [ i < 10 ] (|[ 2 0 < M -> @@ -746,23 +748,23 @@ Goal forall N M (v : list (list R)), blurtwostage N M v = blurimmediate v M N. Proof. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } Abort. Goal forall n m (l : list (list R)), - 0 < n -> - 0 < m -> + 1 < n -> + 1 < m -> consistent l (n,(m,tt)) -> - fusion_no_boundary n m l + fusion_no_boundary n m l = @nil _. Proof. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } Abort. -Goal forall W R0 (x w : list R), +Goal forall W R0 (x w : list R), consistent w (Z.to_nat R0, tt) -> consistent x (Z.to_nat R0, tt) -> (0 < W)%Z -> @@ -770,11 +772,11 @@ Goal forall W R0 (x w : list R), GatherScatter.gather W x w = @nil _. Proof. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } -Abort. +Abort. -Goal forall W R0 (x w : list R), +Goal forall W R0 (x w : list R), consistent w (Z.to_nat R0, tt) -> consistent x (Z.to_nat R0, tt) -> (0 < W)%Z -> @@ -782,7 +784,7 @@ Goal forall W R0 (x w : list R), GatherScatter.scatter W x w = @nil _. Proof. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } Abort. @@ -798,9 +800,9 @@ Goal forall (A B C D : nat) (m1 m2 : (list (list (list (list R))))), Proof. autounfold. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } -Abort. +Abort. Goal forall (A B C : nat) (m1 m2 : (list (list R))) (k : Z), (0 < k)%Z -> @@ -814,7 +816,7 @@ Goal forall (A B C : nat) (m1 m2 : (list (list R))) (k : Z), Proof. autounfold with examples. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). eexists. { infer_pad 0%Z 0%Z. } Abort. @@ -824,13 +826,12 @@ Goal forall (A B C : nat) (m1 m2 : (list (list R))) (k : Z), 0 < B -> 0 < C -> consistent m1 (64,(64,tt)) -> - consistent m2 (64,(64,tt)) -> + consistent m2 (64,(64,tt)) -> matmul_tiled 64 64 64 m1 m2 4 = matmul 64 64 64 m1 m2. Proof. autounfold with examples. let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). + assert (exists pad, has_pad $0 $0 ast pad). eexists. { infer_pad 0%Z 0%Z. } Abort. - diff --git a/src/verified_lowering/inferpad/Reify.v b/src/verified_lowering/inferpad/Reify.v index 860ae98..a0f2774 100644 --- a/src/verified_lowering/inferpad/Reify.v +++ b/src/verified_lowering/inferpad/Reify.v @@ -11,6 +11,7 @@ From Stdlib Require Import Logic.FunctionalExtensionality. From Stdlib Require Import Lists.List. From Stdlib Require Import micromega.Lia. From Stdlib Require Import Reals.Rpower. +From Stdlib Require Import QArith. Import ListNotations. @@ -51,7 +52,7 @@ Ltac reify_Z z := | (?x / ?y)%Z => let lx := reify_Z x in let ly := reify_Z y in - constr:(ZDivf lx ly) + constr:(ZDivf lx ly) | (?x // ?y)%Z => let lx := reify_Z x in let ly := reify_Z y in @@ -84,19 +85,19 @@ Ltac reify_get g := let iz := reify_Z i in constr:(match tup with (var,idx) => (var,(idx++[iz])%list)end) | _ => let _ := match goal with _ => is_var g end in - constr:((ltac:(to_str g), @nil Zexpr)) + constr:((ltac:(to_str g), @nil Zexpr)) end. (* Goal forall (i j : Z) (s : string) (v : list (list R)), True. intros. let s := reify_get constr:(v _[i;j]) in idtac s. - *) + *) Ltac reify_R s := lazymatch s with - | 1%R => constr:(Lit 1%R) - | 0%R => constr:(Lit 0%R) + | 1%R => constr:(Lit 1%Q) + | 0%R => constr:(Lit 0%Q) | (?a * ?b)%R => let la := reify_R a in let lb := reify_R b in @@ -116,7 +117,6 @@ Ltac reify_R s := | _ => let tup := reify_get s in constr:(match tup with - | (var,[]) => Var var | (var,idx) => Get var idx end) end. @@ -159,11 +159,11 @@ Ltac reify prog := let i' := match goal with H : Z |- _ => H end in let i := constr:(ltac:(to_str i')) in let rn := reify_Z nn in - + let body' := constr:(f i') in let body := eval lazy beta in body' in let rbody := reify body in - + constr:(Gen i (|0|)%z rn rbody) | GEN [ ?mm <= ii < ?nn ] @?f ii => let _ := match goal with _ => assert Z by exact 0%Z end in @@ -171,22 +171,22 @@ Ltac reify prog := let i := constr:(ltac:(to_str i')) in let rn := reify_Z nn in let rm := reify_Z mm in - + let body' := constr:(f i') in let body := eval lazy beta in body' in let rbody := reify body in - + constr:(Gen i rm rn rbody) | SUM [ ii < ?nn ] @?f ii => let _ := match goal with _ => assert Z by exact 0%Z end in let i' := match goal with H : Z |- _ => H end in let i := constr:(ltac:(to_str i')) in let rn := reify_Z nn in - + let body' := constr:(f i') in let body := eval lazy beta in body' in let rbody := reify body in - + constr:(Sum i (|0|)%z rn rbody) | let_binding ?e1 ?e2 => let e1t := type of e1 in @@ -195,7 +195,7 @@ Ltac reify prog := let tempH := fresh "tempH" in (assert (exists temp, temp = e1) as tempH by eauto; destruct tempH) - end in + end in let x := match goal with H : e1t |- _ => H end in let xstr := constr:(ltac:(to_str x)) in let re1 := reify e1 in @@ -203,7 +203,7 @@ Ltac reify prog := let body' := constr:(e2 x) in let body := eval simpl in body' in let re2 := reify body in - + constr:(Lbind xstr re1 re2) | transpose ?e => let re := reify e in @@ -256,7 +256,7 @@ Ltac R := normalize end in let prog := match goal with |- ?prog = _ => prog end in - + let ast := reify prog in let ast := eval simpl in ast in ast. @@ -280,7 +280,7 @@ Proof. let x := match goal with H : e1t |- _ => H end in let xstr := constr:(ltac:(to_str x)) in - + let body' := constr:(e2 x) in let body := eval simpl in body' in let re2 := reify body in diff --git a/src/verified_lowering/proof/ATLDeep.v b/src/verified_lowering/proof/ATLDeep.v index 6329a4b..8e64f01 100644 --- a/src/verified_lowering/proof/ATLDeep.v +++ b/src/verified_lowering/proof/ATLDeep.v @@ -73,217 +73,228 @@ Fixpoint vars_of (e : ATLexpr) : set var := Fixpoint sizeof (e : ATLexpr) := match e with | Gen i lo hi body => - (ZMinus hi lo)::(sizeof body) + ZMinus hi lo :: sizeof body | Sum i lo hi body => - sizeof body + sizeof body | Guard p body => - sizeof body + sizeof body | Lbind x e1 e2 => - sizeof e2 + sizeof e2 | Concat x y => - let sx := sizeof x in - let sy := sizeof y in - match sx with - | n::rest => - match sy with - | m::rest' => - (ZPlus n m)::rest - | _ => sx + match sizeof x, sizeof y with + | n :: rest, m :: _ => (n + m)%z :: rest + | _, _ => [] end - | _ => - match sy with - | m::rest' => - sy - | _ => [ZLit 0] - end - end | Flatten e => - match sizeof e with - | a::b::rest => (ZTimes a b)::rest - | [] => [ZLit 0] - | s => s - end + match sizeof e with + | a :: b :: rest => (a * b)%z :: rest + | _ => [] + end | Split k e => - match sizeof e with - | a::rest => (ZDivc a k)::k::rest - | [] => [ZLit 0] - end + match sizeof e with + | a::rest => (a // k)%z :: k :: rest + | [] => [] + end | Transpose e => - match sizeof e with - | a::b::rest => b::a::rest - | [] => [ZLit 0] - | s => s - end + match sizeof e with + | a::b::rest => b::a::rest + | _ => [] + end | Truncr n e => - match sizeof e with - | m::rest => - (ZMinus m n)::rest - | [] => [ZLit 0] - end + match sizeof e with + | m :: rest => (m - n)%z :: rest + | [] => [] + end | Truncl n e => - match sizeof e with - | m::rest => - (ZMinus m n)::rest - | [] => [ZLit 0] - end + match sizeof e with + | m :: rest => (m - n)%z :: rest + | [] => [] + end | Padr n e => - match sizeof e with - | m::rest => - (ZPlus m n)::rest - | [] => [ZLit 0] - end + match sizeof e with + | m :: rest => (m + n)%z :: rest + | [] => [] + end | Padl n e => - match sizeof e with - | m::rest => - (ZPlus m n)::rest - | [] => [ZLit 0] - end + match sizeof e with + | m :: rest => (m + n)%z :: rest + | [] => [] + end | Scalar s => - [] - end. + [] + end. Definition flat_sizeof e := match sizeof e with - | [] => ZLit 0 - | x::xs => fold_left ZTimes xs x + | [] => | 0 |%z + | x :: xs => fold_left ZTimes xs x end. Fixpoint lower - (e : ATLexpr) - (f : list (Zexpr * Zexpr) -> list (Zexpr * Zexpr)) - p asn sh := + (e : ATLexpr) + (f : list (Zexpr * Zexpr) -> list (Zexpr * Zexpr)) + p asn sh := match e with | Gen i lo hi body => For i lo hi - (lower body (fun l => - f ((ZMinus (ZVar i) lo, - ZMinus hi lo)::l)) p asn sh) + (lower body (fun l => + f (((! i ! - lo)%z, + (hi - lo)%z)::l)) p asn sh) | Sum i lo hi body => For i lo hi - (lower body f p Reduce sh) + (lower body f p Reduce sh) | Guard b body => If b (lower body f p asn sh) | Scalar s => Store asn p (f nil) (lowerS s sh) | Lbind x e1 e2 => - match sizeof e1 with - | [] => - Seq (AllocS x) + match sizeof e1 with + | [] => + Seq (AllocS x) (Seq (lower e1 (fun l => l) x Assign sh) - (Seq (lower e2 f p asn (sh $+ (x,sizeof e1))) - (DeallocS x))) - | _ => - Seq (AllocV x (flat_sizeof e1)) - (Seq (lower e1 (fun l => l) x Assign sh) (Seq (lower e2 f p asn (sh $+ (x,sizeof e1))) - (Free x))) - end + (DeallocS x))) + | _ => + Seq (AllocV x (flat_sizeof e1)) + (Seq (lower e1 (fun l => l) x Assign sh) + (Seq (lower e2 f p asn (sh $+ (x,sizeof e1))) + (Free x))) + end | Concat x y => - let xlen := match sizeof x with - | n::_ => n - | _ => ZLit 0 - end in - let ylen := match sizeof y with - | n::_ => n - | _ => ZLit 0 - end in - Seq (lower x (fun l => - f (match l with - | (v,d)::xs => - ((v,ZPlus d ylen)::xs) - | _ => l - end)) p asn sh) + let xlen := match sizeof x with + | n::_ => n + | _ => | 0 |%z + end in + let ylen := match sizeof y with + | n::_ => n + | _ => | 0 |%z + end in + Seq (lower x (fun l => + f (match l with + | (v, d) :: xs => + (v,d + ylen)%z :: xs + | _ => l + end)) p asn sh) (lower y (fun l => f (match l with - | (v,d)::xs => ((ZPlus v xlen,ZPlus d xlen)::xs) - | _ => l - end)) p asn sh) + | (v, d) :: xs => + (v + xlen, d + xlen)%z :: xs + | _ => l + end)) p asn sh) | Transpose e => - lower e (fun l => f (match l with - | (v,d)::(vi,di)::xs => (vi,di)::(v,d)::xs - | _ => l - end)) p asn sh + lower e (fun l => f (match l with + | (v, d) :: (vi, di) :: xs => + (vi, di) :: (v, d) :: xs + | _ => l + end)) p asn sh | Split k e => - lower e (fun l => f (match l with - | (v,d)::xs => (ZDivf v k,ZDivc d k)::(ZMod v k,k)::xs - | _ => l - end)) p asn sh + lower e (fun l => f (match l with + | (v, d) :: xs => + (v / k, d // k)%z :: (ZMod v k, k) :: xs + | _ => l + end)) p asn sh | Flatten e => - lower e (fun l => f (match l with - | (v,d)::(vi,di)::xs => - (ZPlus (ZTimes v di) vi,ZTimes d di)::xs - | _ => l - end)) p asn sh + lower e (fun l => f (match l with + | (v, d) :: (vi, di) :: xs => + (v * di + vi, d * di)%z :: xs + | _ => l + end)) p asn sh | Truncr n e => - lower e (fun l => f (match l with - | (v,d)::xs => - (v,ZMinus d n)::xs - | _ => l - end)) p asn sh + lower e (fun l => f (match l with + | (v, d) :: xs => + (v, d - n)%z :: xs + | _ => l + end)) p asn sh | Truncl n e => - lower e (fun l => f (match l with - | (v,d)::xs => - (ZMinus v n, - ZMinus d n)::xs - | _ => l - end)) p asn sh + lower e (fun l => f (match l with + | (v, d) :: xs => + (v - n, d - n)%z :: xs + | _ => l + end)) p asn sh | Padr n e => - lower e (fun l => f (match l with - | (v,d)::xs => - (v,ZPlus d n)::xs - | _ => l - end)) p asn sh + lower e (fun l => f (match l with + | (v,d)::xs => + (v, d + n)%z :: xs + | _ => l + end)) p asn sh | Padl n e => - lower e (fun l => f (match l with - | (v,d)::xs => - (ZPlus v n,ZPlus d n)::xs - | _ => l - end)) p asn sh + lower e (fun l => f (match l with + | (v,d)::xs => + (v + n, d + n)%z :: xs + | _ => l + end)) p asn sh end. -Inductive size_of : ATLexpr -> list Zexpr -> Prop := -| SizeOfGen : forall i lo hi body l, - size_of body l -> - size_of (Gen i lo hi body) ((ZMinus hi lo)::l) -| SizeOfSum : forall i lo hi body l, - size_of body l -> - size_of (Sum i lo hi body) l -| SizeOfGuard : forall p e l, - size_of e l -> - size_of (Guard p e) l -| SizeOfLBind : forall e1 e2 x l2, - size_of e2 l2 -> - size_of (Lbind x e1 e2) l2 -| SizeOfConcat : forall e1 e2 l1 l2 n m, - size_of e1 (n::l1) -> - size_of e2 (m::l2) -> - (forall v, - map (eval_Zexpr_Z_total v) l1 = map (eval_Zexpr_Z_total v) l2) -> - size_of (Concat e1 e2) ((ZPlus n m)::l1) -| SizeOfFlatten : forall e n m l, - size_of e (n::m::l) -> - size_of (Flatten e) ((ZTimes n m)::l) -| SizeOfSplit : forall e n l k, - size_of e (n::l) -> - size_of (Split k e) ((ZDivc n k)::k::l) -| SizeOfTranspose : forall e n m l, - size_of e (n::m::l) -> - size_of (Transpose e) (m::n::l) -| SizeOfTruncr : forall n e m l, - size_of e (m::l) -> - size_of (Truncr n e) (ZMinus m n::l) -| SizeOfTruncl : forall n e m l, - size_of e (m::l) -> - size_of (Truncl n e) (ZMinus m n::l) -| SizeOfPadr : forall n e m l, - size_of e (m::l) -> - size_of (Padr n e) ((ZPlus m n)::l) -| SizeOfPadl : forall n e m l, - size_of e (m::l) -> - size_of (Padl n e) ((ZPlus m n)::l) +Inductive size_of v : ATLexpr -> list nat -> Prop := +| SizeOfGen : forall i lo loz hi hiz body sh, + eval_Zexpr v lo loz -> + eval_Zexpr v hi hiz -> + size_of _ body sh -> + size_of _ (Gen i lo hi body) (Z.to_nat (hiz - loz) :: sh) +| SizeOfSum : forall i lo hi body sh, + size_of _ body sh -> + size_of _ (Sum i lo hi body) sh +| SizeOfGuard : forall p e sh, + size_of _ e sh -> + size_of _ (Guard p e) sh +| SizeOfLBind : forall e1 e2 x sh2, + size_of _ e2 sh2 -> + size_of _ (Lbind x e1 e2) sh2 +| SizeOfConcat : forall e1 e2 sh1 sh2 n m, + size_of _ e1 (n::sh1) -> + size_of _ e2 (m::sh2) -> + sh1 = sh2 -> + size_of _ (Concat e1 e2) (n + m :: sh1) +| SizeOfFlatten : forall e n m sh, + size_of _ e (n :: m :: sh) -> + size_of _ (Flatten e) (n * m :: sh) +| SizeOfSplit : forall e n sh k kz, + eval_Zexpr v k kz -> + size_of _ e (n::sh) -> + size_of _ (Split k e) (n //n (Z.to_nat kz) :: Z.to_nat kz :: sh) +| SizeOfTranspose : forall e n m sh, + size_of _ e (n::m::sh) -> + size_of _ (Transpose e) (m::n::sh) +| SizeOfTruncr : forall k kz e m sh, + eval_Zexpr v k kz -> + size_of _ e (m::sh) -> + size_of _ (Truncr k e) (m - Z.to_nat kz :: sh) +| SizeOfTruncl : forall k kz e m sh, + eval_Zexpr v k kz -> + size_of _ e (m :: sh) -> + size_of _ (Truncl k e) (m - Z.to_nat kz :: sh) +| SizeOfPadr : forall k kz e m sh, + eval_Zexpr v k kz -> + size_of _ e (m :: sh) -> + size_of _ (Padr k e) (m + Z.to_nat kz :: sh) +| SizeOfPadl : forall k kz e m sh, + eval_Zexpr v k kz -> + size_of _ e (m :: sh) -> + size_of _ (Padl k e) (m + Z.to_nat kz :: sh) | SizeOfScalar : forall s, - size_of (Scalar s) []. + size_of _ (Scalar s) []. Local Hint Constructors eval_Zexpr eval_Bexpr eval_Sexpr size_of. +Fixpoint nonneg_bounds v e := + match e with + | Gen _ lo hi body => + nonneg_bounds v body /\ + exists loz hiz, eval_Zexpr v lo loz /\ eval_Zexpr v hi hiz /\ (loz <= hiz)%Z + | Split k body => nonneg_bounds v body /\ exists kz, eval_Zexpr v k kz /\ (0 < kz)%Z + | Truncr k body | Truncl k body => + nonneg_bounds v body /\ + match sizeof body with + | m :: _ => exists kz mz, + eval_Zexpr v k kz /\ eval_Zexpr v m mz /\ (0 <= kz <= mz)%Z + | [] => False + end + | Padr k body | Padl k body => + nonneg_bounds v body /\ exists kz, eval_Zexpr v k kz /\ (0 <= kz)%Z + | Lbind _ e1 e2 | Concat e1 e2 => nonneg_bounds v e1 /\ nonneg_bounds v e2 + | Sum _ _ _ body | Guard _ body | Flatten body | Transpose body => + nonneg_bounds v body + | Scalar _ => True + end. + Inductive eval_stmt (v : valuation) : stack -> heap -> stmt -> stack -> heap -> Prop := | EvalAssignS : @@ -328,7 +339,7 @@ Inductive eval_stmt (v : valuation) : eval_stmt v st h (If b s) st h | EvalAllocS : forall x st h, eval_stmt v st h (AllocS x) (st $+ (x,0%R)) h -| EvalAllocV : forall x n st h nz, +| EvalAllocV : forall x n nz st h, eval_Zexpr v n nz -> eval_stmt v st h (AllocV x n) st (alloc_array_in_heap [Z.to_nat nz] h x) @@ -355,117 +366,97 @@ Inductive eval_stmt (v : valuation) : eval_stmt v st' h' s2 st'' h'' -> eval_stmt v st h (Seq s1 s2) st'' h''. Local Hint Constructors eval_stmt. -Local Hint Constructors eval_Zexprlist. -Inductive eval_expr (sh : context) : +Inductive eval_expr : valuation -> expr_context -> ATLexpr -> result -> Prop := | EvalGenBase : forall ec v lo hi loz hiz i body, eval_Zexpr_Z v lo = Some loz -> eval_Zexpr_Z v hi = Some hiz -> (hiz <= loz)%Z -> - eval_expr sh v ec (Gen i lo hi body) (V []) + eval_expr v ec (Gen i lo hi body) (V []) | EvalGenStep : forall ec v lo hi loz hiz i body l r, eval_Zexpr_Z v lo = Some loz -> eval_Zexpr_Z v hi = Some hiz -> (loz < hiz)%Z -> ~ i \in dom v -> ~ contains_substring "?" i -> - eval_expr sh (v $+ (i,loz)) ec body r -> - eval_expr sh v ec (Gen i (ZPlus lo (ZLit 1%Z)) hi body) (V l) -> - eval_expr sh v ec (Gen i lo hi body) (V (r::l)) + eval_expr (v $+ (i,loz)) ec body r -> + eval_expr v ec (Gen i (ZPlus lo (ZLit 1%Z)) hi body) (V l) -> + eval_expr v ec (Gen i lo hi body) (V (r::l)) | EvalSumStep : forall v ec lo hi loz hiz i body r r' s, eval_Zexpr_Z v lo = Some loz -> eval_Zexpr_Z v hi = Some hiz -> (loz < hiz)%Z -> ~ i \in dom v -> ~ contains_substring "?" i -> - eval_expr sh (v $+ (i,loz)) ec body r -> - eval_expr sh v ec (Sum i (ZPlus lo (ZLit 1%Z)) hi body) r' -> + eval_expr (v $+ (i,loz)) ec body r -> + eval_expr v ec (Sum i (ZPlus lo (ZLit 1%Z)) hi body) r' -> add_result r r' s -> - eval_expr sh v ec (Sum i lo hi body) s -| EvalSumBase : forall v ec lo hi loz hiz i body l lz, + eval_expr v ec (Sum i lo hi body) s +| EvalSumBase : forall v ec lo hi loz hiz i body sz, eval_Zexpr_Z v lo = Some loz -> eval_Zexpr_Z v hi = Some hiz -> (hiz <= loz)%Z -> - size_of body l -> - eval_Zexprlist v l lz -> - eval_expr sh v ec (Sum i lo hi body) (gen_pad (List.map Z.to_nat lz)) -| EvalGuardFalse : forall e v ec b l lz, + size_of v body sz -> + eval_expr v ec (Sum i lo hi body) (gen_pad sz) +| EvalGuardFalse : forall e v ec b sz, eval_Bexpr v b false -> - size_of e l -> - eval_Zexprlist v l lz -> - eval_expr sh v ec (Guard b e) (gen_pad (List.map Z.to_nat lz)) + size_of v e sz -> + eval_expr v ec (Guard b e) (gen_pad sz) | EvalGuardTrue : forall e ec v b r, eval_Bexpr v b true -> - eval_expr sh v ec e r -> - eval_expr sh v ec (Guard b e) r -| EvalLbindS : forall v e1 e2 x r1 l2 ec, - size_of e1 [] -> - ec $? x = None -> - ~ x \in vars_of e1 /\ ~ x \in vars_of e2 -> - vars_of e1 \cap vars_of e2 = constant nil -> - eval_expr sh v ec e1 (S r1) -> - eval_expr (sh $+ (x,[])) v (ec $+ (x,S r1)) e2 l2 -> - eval_expr sh v ec (Lbind x e1 e2) l2 -| EvalLbindV : forall v e1 e2 x l1 l2 ec esh1 esh1z, - esh1 <> [] -> - size_of e1 esh1 -> - eval_Zexprlist v esh1 esh1z -> + eval_expr v ec e r -> + eval_expr v ec (Guard b e) r +| EvalLbind : forall v e1 e2 x l1 l2 ec sz1, + size_of v e1 sz1 -> ec $? x = None -> ~ x \in vars_of e1 /\ ~ x \in vars_of e2 -> vars_of e1 \cap vars_of e2 = constant nil -> - eval_expr sh v ec e1 (V l1) -> - eval_expr (sh $+ (x, esh1)) v - (ec $+ (x,V l1)) e2 l2 -> - eval_expr sh v ec (Lbind x e1 e2) l2 + eval_expr v ec e1 l1 -> + eval_expr v + (ec $+ (x,l1)) e2 l2 -> + eval_expr v ec (Lbind x e1 e2) l2 | EvalConcat : forall ec v e1 e2 l1 l2, - eval_expr sh v ec e1 (V l1) -> - eval_expr sh v ec e2 (V l2) -> - eval_expr sh v ec (Concat e1 e2) (V (l1++l2)) -| EvalTranspose : forall e v ec l n nz m mz esh eshz, - eval_expr sh v ec e (V l) -> - size_of e (n::m::esh) -> - eval_Zexprlist v (n::m::esh) (nz::mz::eshz) -> - eval_expr sh v ec (Transpose e) - (transpose_result l (map Z.to_nat (mz::nz::eshz))) + eval_expr v ec e1 (V l1) -> + eval_expr v ec e2 (V l2) -> + eval_expr v ec (Concat e1 e2) (V (l1++l2)) +| EvalTranspose : forall e v ec l n m esh, + eval_expr v ec e (V l) -> + size_of v e (n::m::esh) -> + eval_expr v ec (Transpose e) + (transpose_result l (m::n::esh)) | EvalFlatten : forall e v ec l, - eval_expr sh v ec e (V l) -> - Forall (fun x => exists v, x = V v) l -> - eval_expr sh v ec (Flatten e) (V (flatten_result l)) -| EvalSplit : forall e v ec l k, - eval_expr sh v ec e (V l) -> + eval_expr v ec e (V l) -> Forall (fun x => exists v, x = V v) l -> - eval_expr sh v ec (Split k e) (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l)) + eval_expr v ec (Flatten e) (V (flatten_result l)) +| EvalSplit : forall e v ec l k kz, + eval_expr v ec e (V l) -> + eval_Zexpr_Z v k = Some kz -> + eval_expr v ec (Split k e) (V (split_result (Z.to_nat kz) l)) | EvalTruncr : forall e v ec k kz l, eval_Zexpr_Z v k = Some kz -> - (0 <= kz)%Z -> - eval_expr sh v ec e (V l) -> - eval_expr sh v ec (Truncr k e) + eval_expr v ec e (V l) -> + eval_expr v ec (Truncr k e) (V (List.rev (truncl_list (Z.to_nat kz) (List.rev l)))) | EvalTruncl : forall e v ec k kz l, eval_Zexpr_Z v k = Some kz -> - (0 <= kz)%Z -> - eval_expr sh v ec e (V l) -> - eval_expr sh v ec (Truncl k e) (V (truncl_list (Z.to_nat kz) l)) -| EvalPadr : forall e v ec l s n k kz sz, + eval_expr v ec e (V l) -> + eval_expr v ec (Truncl k e) (V (truncl_list (Z.to_nat kz) l)) +| EvalPadr : forall e v ec l s n k kz, eval_Zexpr_Z v k = Some kz -> - (0 <= kz)%Z -> - size_of e (n::s) -> - eval_expr sh v ec e (V l) -> - eval_Zexprlist v s sz -> - eval_expr sh v ec (Padr k e) - (V (l++gen_pad_list ((Z.to_nat kz)::(List.map Z.to_nat sz)))) -| EvalPadl : forall e v ec l s n k kz sz, + size_of v e (n::s) -> + eval_expr v ec e (V l) -> + eval_expr v ec (Padr k e) + (V (l++gen_pad_list ((Z.to_nat kz)::s))) +| EvalPadl : forall e v ec l s n k kz, eval_Zexpr_Z v k = Some kz -> - (0 <= kz)%Z -> - size_of e (n::s) -> - eval_expr sh v ec e (V l) -> - eval_Zexprlist v s sz -> - eval_expr sh v ec (Padl k e) - (V (gen_pad_list ((Z.to_nat kz)::(List.map Z.to_nat sz))++l)) + size_of v e (n::s) -> + eval_expr v ec e (V l) -> + eval_expr v ec (Padl k e) + (V (gen_pad_list ((Z.to_nat kz)::s)++l)) | EvalScalar : forall s v ec r, - eval_Sexpr sh v ec s r -> - eval_expr sh v ec (Scalar s) (S r). + eval_Sexpr v ec s r -> + eval_expr v ec (Scalar s) (S r). Ltac invs := repeat @@ -476,7 +467,7 @@ Ltac invs := | H : eval_Zexprlist _ [] _ |- _ => invert H | H : eval_Zexprlist _ _ (_::_) |- _ => invert H | H : eval_Zexprlist _ (_::_) _ |- _ => invert H - | H : size_of _ _ |- _ => invert1 H + | H : size_of _ _ _ |- _ => invert1 H | H : eval_Zexpr _ (ZPlus _ _) _ |- _ => invert H | H : eval_Zexpr _ (ZMinus _ _) _ |- _ => invert H | H : eval_Zexpr _ (ZTimes _ _) _ |- _ => invert H @@ -494,110 +485,101 @@ Ltac invs := | H : Some _ = Some _ |- _ => invert H end. -Lemma size_of_deterministic : forall e l1 l2, - size_of e l1 -> - size_of e l2 -> +(*because invs is slow sometimes*) +Ltac invs' := + repeat match goal with + | H:_ /\ _ |- _ => invert H + | H:exists _, _ |- _ => invert H + | H:Some _ = Some _ |- _ => invert H + | H: _ :: _ = _ :: _ |- _ => invert H + | H: Forall2 _ _ (_ :: _) |- _ => invert H + | H: Forall2 _ (_ :: _) _ |- _ => invert H + end. + +Lemma size_of_deterministic : forall v e l1 l2, + size_of v e l1 -> + size_of v e l2 -> l1 = l2. Proof. - induction e; intros. - - invert H. invert H0. - eq_eval_Z. - f_equal. eauto. - - invert H. invert H0. - eq_eval_Z. - eauto. - - invert H. invert H0. eauto. - - invert H. invert H0. eauto. - - invert H. invert H0. - specialize (IHe1 _ _ H3 H2). - specialize (IHe2 _ _ H4 H5). - invert IHe1. invert IHe2. eauto. - - invert H. invert H0. - specialize (IHe _ _ H2 H1). - invert IHe. - eauto. - - invert H. invert H0. simpl. eapply IHe in H4; eauto. invert H4. - eauto. - - invert H. invert H0. - eapply IHe in H2. 2: apply H1. invert H2. auto. - - invert H. invert H0. - specialize (IHe _ _ H4 H3). - invert IHe. - reflexivity. - - invert H. invert H0. - specialize (IHe _ _ H4 H3). - invert IHe. - reflexivity. - - invert H. invert H0. - specialize (IHe _ _ H4 H3). - invert IHe. - reflexivity. - - invert H. invert H0. - specialize (IHe _ _ H4 H3). - invert IHe. - reflexivity. - - invert H. invert H0. + induction e; intros; + try match goal with + | H1: size_of _ _ _, H2: size_of _ _ _ |- _ => invert H1; invert H2 + end; + do 2 try match goal with + | IH: _, H1: _, H2: _ |- _ => specialize (IH _ _ H1 H2); invert IH + end; + eq_eval_Z; reflexivity. Qed. +Lemma nonneg_bounds_includes v1 v2 e : + v1 $<= v2 -> + nonneg_bounds v1 e -> + nonneg_bounds v2 e. +Proof. + intros H1 H2. induction e; simpl in *; invs'; + try match goal with | H: match ?x with _ => _ end |- _ => destruct x end; invs'; + eauto 10 using eval_Zexpr_includes_valuation. +Qed. + +Lemma size_of_includes v1 v2 e sz : + v1 $<= v2 -> + size_of v1 e sz -> + size_of v2 e sz. +Proof. + intros H. revert sz. + induction e; invert 1; eauto using eval_Zexpr_includes_valuation. +Qed. + +Lemma size_of_deterministic' e v l1 l2 : + size_of $0 e l1 -> + size_of v e l2 -> + l1 = l2. +Proof. + intros H1 H2. eapply size_of_includes in H1. 2: apply empty_includes. + eauto using size_of_deterministic. +Qed. + Ltac eq_size_of := repeat match goal with - | H1 : size_of ?e ?a, H2 : size_of ?e ?b |- _ => - pose proof (size_of_deterministic _ _ _ H1 H2); subst; + | H1 : size_of $0 ?e ?a, H2 : size_of ?v ?e ?b |- _ => + pose proof (size_of_deterministic' _ _ _ _ H1 H2); subst; clear H2 + | H1 : size_of ?v ?e ?a, H2 : size_of ?v ?e ?b |- _ => + pose proof (size_of_deterministic _ _ _ _ H1 H2); subst; + clear H2 end. -Theorem size_of_sizeof : forall e1 l, - size_of e1 l -> - sizeof e1 = l. +Theorem size_of_sizeof : forall v e l, + size_of v e l -> + nonneg_bounds v e -> + exists lz, + eval_Zexprlist v (sizeof e) lz /\ + lz = map Z.of_nat l. Proof. - induction e1; intros; simpl; invert H; try f_equal; eauto. - - destruct (sizeof e1_1) eqn:e; - destruct (sizeof e1_2) eqn:ee. - + eapply IHe1_1 in H2. discriminate. - + eapply IHe1_1 in H2. discriminate. - + eapply IHe1_2 in H3. discriminate. - + eapply IHe1_1 in H2. - eapply IHe1_2 in H3. - invert H2. invert H3. - reflexivity. - - destruct (sizeof e1) eqn:e. - eapply IHe1 in H1. discriminate. - destruct l. - eapply IHe1 in H1. discriminate. - eapply IHe1 in H1. invert H1. - reflexivity. - - erewrite IHe1 by eassumption. reflexivity. - - eapply IHe1 in H1; eauto. rewrite H1. reflexivity. - - destruct (sizeof e1) eqn:e. - eapply IHe1 in H3. discriminate. - destruct l. - eapply IHe1 in H3. invert H3. - reflexivity. - eapply IHe1 in H3. invert H3. - reflexivity. - - destruct (sizeof e1) eqn:e. - eapply IHe1 in H3. discriminate. - destruct l. - eapply IHe1 in H3. invert H3. - reflexivity. - eapply IHe1 in H3. invert H3. - reflexivity. - - destruct (sizeof e1) eqn:e. - eapply IHe1 in H3. discriminate. - destruct l. - eapply IHe1 in H3. invert H3. - reflexivity. - eapply IHe1 in H3. invert H3. - reflexivity. - - destruct (sizeof e1) eqn:e. - eapply IHe1 in H3. discriminate. - destruct l. - eapply IHe1 in H3. invert H3. - reflexivity. - eapply IHe1 in H3. invert H3. - reflexivity. + induction e; intros ? H1 H2; simpl in *; invert H1; invs'; + repeat match goal with + | IH: forall _, _ -> _ -> _, H1: _, H2: _ |- _ => specialize (IH _ H1 H2) + end; + repeat match goal with + | H: map _ ?x = _ :: _ |- _ => + is_var x; destruct x; [discriminate H|]; simpl in H; invert H + end; + eq_eval_Z; + simpl in *; + invs'; + repeat match goal with + | H: _ = sizeof _ |- _ => rewrite <- H in * + end; + invs'; + eq_eval_Z; + simpl in *; + eauto 7. + all: eexists; split; [solve[eauto] |]. + all: f_equal; try lia. + - rewrite <- of_nat_div_distr. f_equal. lia. + - f_equal; lia. Qed. Theorem dom_alloc_array_in_heap : forall h x l, @@ -610,14 +592,14 @@ Proof. rewrite dom_add. reflexivity. Qed. -Lemma length_eval_expr_gen : forall sh c v e l i lo hi, - eval_expr sh v c (Gen i lo hi e) (V l) -> +Lemma length_eval_expr_gen : forall c v e l i lo hi, + eval_expr v c (Gen i lo hi e) (V l) -> forall z, eval_Zexpr_Z v (ZMinus hi lo) = Some z -> length l = Z.to_nat z. Proof. induct 1; intros. - - simpl in *. invert H2. rewrite H,H0 in *. invert H4. lia. + - simpl in *. invert H2. rewrite H,H0 in *. invert H4. lia. - invert H6. rewrite H,H0 in *. invert H8. simpl. erewrite IHeval_expr2. @@ -639,8 +621,8 @@ Hint Extern 3 (Datatypes.length _ = Datatypes.length _) => rewrite length_map; rewrite length_nat_range_rec; eapply length_mesh_grid_indices; eassumption : reindexers. -Lemma result_shape_gen_length : forall i lo hi body c v sh l, - eval_expr c v sh (Gen i lo hi body) (V l) -> +Lemma result_shape_gen_length : forall i lo hi body v sh l, + eval_expr v sh (Gen i lo hi body) (V l) -> forall hiz loz, eval_Zexpr_Z v lo = Some loz -> eval_Zexpr_Z v hi = Some hiz -> @@ -677,7 +659,7 @@ Lemma eq_eval_stmt_for : Proof. induct 1; intros. - rewrite H,H0 in *. invert H4. invert H5. - eapply EvalForStep; eauto. + eapply EvalForStep; eauto. eapply H6. lia. eassumption. eapply IHeval_stmt2. reflexivity. simpl. rewrite H. reflexivity. @@ -716,81 +698,51 @@ Proof. - invert H. + specialize (H0 []). econstructor. eauto. eauto. rewrite H11 in *. invert H0. invs. - cases (reindexer2 []). auto. simpl in *. lia. + cases (reindexer2 []). auto. simpl in *. invert H. + eapply EvalAssignV; eauto. * specialize (H0 []); simpl in *. unfold not in *. intros. apply H8. - rewrite H in *. invert H0. + rewrite H in *. invert H0. invert H1. cases (reindexer2 []); cases (reindexer1 []); simpl in *; try lia; try discriminate; propositional. * rewrite <- H12. eapply eq_eval_Zexpr_Z. - eapply eq_zexpr_flatten_shape_index; - eapply eq_Z_index_list_sym; apply H0. + apply eq_zexpr_flatten_shape_index. + 2: eapply eq_Z_index_list_sym; apply H0. + specialize (H0 []). invert H0. + apply eq_Z_index_list_sym. assumption. + specialize (H0 []); simpl in *. pose proof H0. unfold eq_Z_tuple_index_list in *. invs. econstructor; eauto. cases (reindexer2 []); cases (reindexer1 []); simpl in *; try lia; try discriminate; propositional. + invert H1. + eapply EvalReduceV; eauto. - * unfold not in *. intros. apply H8. + * unfold not in *. intros. apply H8. specialize (H0 []); simpl in *. invert H0. invs. rewrite H in *. cases (reindexer2 []); cases (reindexer1 []); simpl in *; try lia; try discriminate; propositional. + invert H1. * rewrite <- H12. eapply eq_eval_Zexpr_Z. - eapply eq_zexpr_flatten_shape_index; - eapply eq_Z_index_list_sym; apply H0. + apply eq_zexpr_flatten_shape_index. + 2: eapply eq_Z_index_list_sym; apply H0. + specialize (H0 []). + invert H0. + apply eq_Z_index_list_sym. assumption. Qed. -Fixpoint constant_nonneg_bounds (e : ATLexpr) : Prop := - match e with - | Gen i lo hi e => - vars_of_Zexpr lo = [] /\ vars_of_Zexpr hi = [] /\ - (0 <= eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)%Z /\ - constant_nonneg_bounds e - | Sum i lo hi e => - vars_of_Zexpr lo = [] /\ vars_of_Zexpr hi = [] /\ - constant_nonneg_bounds e - | Guard p e => constant_nonneg_bounds e - | Lbind x e1 e2 => constant_nonneg_bounds e1 /\ constant_nonneg_bounds e2 - | Concat e1 e2 => constant_nonneg_bounds e1 /\ constant_nonneg_bounds e2 - | Flatten e => constant_nonneg_bounds e - | Split k e => vars_of_Zexpr k = [] /\ constant_nonneg_bounds e /\ - (0 < eval_Zexpr_Z_total $0 k)%Z - | Transpose e => constant_nonneg_bounds e - | Truncr k e => constant_nonneg_bounds e /\ vars_of_Zexpr k = [] /\ - (0 <= eval_Zexpr_Z_total $0 k)%Z /\ - (0 <= match (sizeof e) with - | dim::_ => eval_Zexpr_Z_total $0 dim - | _ => 0%Z - end - - eval_Zexpr_Z_total $0 k)%Z - | Truncl k e => constant_nonneg_bounds e /\ vars_of_Zexpr k = [] /\ - (0 <= eval_Zexpr_Z_total $0 k)%Z /\ - (0 <= match (sizeof e) with - | dim::_ => eval_Zexpr_Z_total $0 dim - | _ => 0%Z - end - - eval_Zexpr_Z_total $0 k)%Z - | Padr k e => constant_nonneg_bounds e /\ vars_of_Zexpr k = [] /\ - (0 <= eval_Zexpr_Z_total $0 k)%Z - | Padl k e => constant_nonneg_bounds e /\ vars_of_Zexpr k = [] /\ - (0 <= eval_Zexpr_Z_total $0 k)%Z - | Scalar s => True - end. - Lemma eval_expr_for_gen_result_has_shape : - forall n c v ec i lo hi loz hiz e v0, + forall n v ec i lo hi loz hiz e v0, eval_Zexpr_Z v lo = Some loz -> eval_Zexpr_Z v hi = Some hiz -> (hiz -loz)%Z = Z.of_nat n -> - eval_expr c v ec (Gen i lo hi e) (V v0) -> + eval_expr v ec (Gen i lo hi e) (V v0) -> (forall ii, 0 <= ii < n -> - eval_expr c (v$+(i,Z.of_nat ii+loz))%Z ec e + eval_expr (v$+(i,Z.of_nat ii+loz))%Z ec e (nth ii v0 (S (SS 0%R)))). Proof. induct n; intros. @@ -807,362 +759,39 @@ Proof. simpl. rewrite H. auto. eauto. lia. lia. Qed. -Lemma constant_nonneg_bounds_size_of_no_vars : - forall e l, - constant_nonneg_bounds e -> - size_of e l -> - Forall (fun z => vars_of_Zexpr z = []) l. -Proof. - induct e; simpl; intros; propositional; invert H0; eauto. - - econstructor. simpl. rewrite H,H1. - rewrite app_no_dups_empty_r. auto. eauto. - - eapply IHe1 in H1. 2: apply H4. - eapply IHe2 in H2. 2: apply H5. - invert H1. invert H2. - econstructor. simpl. rewrite H3, H1. rewrite app_no_dups_empty_r. auto. - auto. - - eapply IHe in H. 2: apply H2. invert H. invert H4. - econstructor. simpl. rewrite H3,H1. rewrite app_no_dups_empty_r. auto. - auto. - - eapply IHe in H6; eauto. invert H6. - econstructor. simpl. rewrite H4,H1. eauto. eauto. - - eapply IHe in H2; auto. invert H2. invert H4. - eauto. - - eapply IHe in H1. 2: eassumption. invert H1. - econstructor. simpl. erewrite size_of_sizeof in * by eauto. - simpl in *. rewrite H,H5. - eauto. eauto. - - eapply IHe in H1. 2: eassumption. invert H1. - econstructor. simpl. rewrite H,H5. - eauto. eauto. - - eapply IHe in H1. 2: eassumption. invert H1. - econstructor. simpl. rewrite H, H4. - rewrite app_no_dups_empty_r. auto. auto. - - eapply IHe in H1. 2: eassumption. invert H1. - econstructor. simpl. rewrite H, H4. - rewrite app_no_dups_empty_r. auto. auto. -Qed. - -Lemma constant_nonneg_bounds_sizeof_no_vars : - forall e, - constant_nonneg_bounds e -> - Forall (fun z => vars_of_Zexpr z = []) (sizeof e). -Proof. - induct e; simpl; intros; propositional. - - econstructor. simpl. rewrite H,H0. - rewrite app_no_dups_empty_r. auto. eauto. - - cases (sizeof e1); cases (sizeof e2). - + econstructor. reflexivity. econstructor. - + eauto. - + eauto. - + invert H. invert H2. econstructor. simpl. - rewrite H4,H5. rewrite app_no_dups_empty_r. auto. auto. - - cases (sizeof e). - + econstructor. reflexivity. eauto. - + invert H0. cases l. econstructor. rewrite H3. eauto. eauto. - invert H4. - econstructor. simpl. rewrite H2,H3. - rewrite app_no_dups_empty_r. auto. auto. - - cases (sizeof e). - + econstructor. reflexivity. eauto. - + econstructor. invert H1. simpl. rewrite H5,H0. reflexivity. - invert H1. eauto. - - cases (sizeof e). - + econstructor. reflexivity. eauto. - + invert H0. cases l. econstructor. rewrite H3. eauto. eauto. - invert H4. - econstructor. auto. econstructor. auto. eauto. - - invs. cases (sizeof e). econstructor. reflexivity. eauto. - invert H2. - econstructor. simpl. rewrite H,H6. reflexivity. - eauto. - - invs. cases (sizeof e). econstructor. reflexivity. eauto. - invert H2. - econstructor. simpl. rewrite H,H6. reflexivity. - eauto. - - cases (sizeof e). - + econstructor. reflexivity. eauto. - + invert H1. - econstructor. simpl. rewrite H,H5. - rewrite app_no_dups_empty_r. auto. auto. - - cases (sizeof e). - + econstructor; eauto. - + invert H1. econstructor. - simpl. rewrite H,H5. - rewrite app_no_dups_empty_r. auto. auto. - - eauto. -Qed. - Lemma result_has_shape_for_sum : - forall e lz v , - (forall l : list Zexpr, - constant_nonneg_bounds e -> - size_of e l -> - forall v : valuation, - eval_Zexprlist v l (map (eval_Zexpr_Z_total $0) l) -> - forall (sh : context) (ec : expr_context) (r : result), - eval_expr sh v ec e r -> - result_has_shape r (map Z.to_nat (map (eval_Zexpr_Z_total $0) l))) -> - forall n l r sh ec i lo hi loz hiz, - constant_nonneg_bounds e -> - size_of e l -> - eval_Zexprlist v l lz -> - eval_Zexpr_Z v lo = Some loz -> - eval_Zexpr_Z v hi = Some hiz -> - Z.of_nat n = (hiz - loz)%Z -> - eval_expr sh v ec (Sum i lo hi e) r -> - result_has_shape r (map Z.to_nat (map (eval_Zexpr_Z_total $0) l)). + forall e, + (forall (v : valuation) (sz : list nat), + nonneg_bounds v e -> + size_of v e sz -> + forall (ec : expr_context) (r : result), + eval_expr v ec e r -> + result_has_shape r sz) -> + forall v n sz r ec i lo hi loz hiz, + nonneg_bounds v e -> + size_of v e sz -> + eval_Zexpr_Z v lo = Some loz -> + eval_Zexpr_Z v hi = Some hiz -> + Z.of_nat n = (hiz - loz)%Z -> + eval_expr v ec (Sum i lo hi e) r -> + result_has_shape r sz. Proof. intros ? ? ? ?. induct n; propositional. - - invert H6. - rewrite H3,H4 in *. invert H11. invert H12. lia. - rewrite H3,H4 in *. invert H11. invert H14. - eq_size_of. eq_eval_Zlist. - eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0; eauto. - eq_eval_Zlist. + - invert H5. + rewrite H2, H3 in *. invs'. lia. + rewrite H2, H3 in *. invs'. + eq_size_of. eapply result_has_shape_gen_pad. - - invert H6. - rewrite H3,H4 in *. invert H11. invert H12. - pose proof H0. - eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0; eauto. - eq_eval_Zlist. + - invert H5. + rewrite H2,H3 in *. invs'. eapply result_has_shape_add_result. eassumption. - 2: { eapply IHn in H20. auto. eassumption. eassumption. eassumption. - eauto. - simpl. rewrite H3. reflexivity. - eauto. lia. } - eapply H. 4: eassumption. eassumption. eassumption. - eapply eval_Zexprlist_add. eassumption. auto. - eq_size_of. eq_eval_Zlist. - eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0; eauto. - eq_eval_Zlist. - eapply result_has_shape_gen_pad. -Qed. - -Lemma constant_nonneg_bounds_size_of_nonneg : - forall e, - constant_nonneg_bounds e -> - forall l, - size_of e l -> - forall v lz, - eval_Zexprlist v l lz -> - Forall (fun x => 0 <= x)%Z lz. -Proof. - induct e; intros; simpl in *. - - invert H0. invert H. invert H1. invs. - econstructor. unfold eval_Zexpr_Z_total in *. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H0,H. - invs. - pose proof (H1 v). pose proof (H v). eq_eval_Z. - specialize (H1 $0). specialize (H $0). - eapply eval_Zexpr_Z_eval_Zexpr in H,H1. - rewrite H,H1 in *. lia. - eapply IHe; eauto. - - invs. eauto. - - invs. eauto. - - invs. eauto. - - invs. - eapply IHe1 in H2. 2: eassumption. 2: eauto. - invert H2. - econstructor. 2: eauto. - pose proof H3 as Hc. - eapply IHe2 in H3. 2: eassumption. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - eapply constant_nonneg_bounds_size_of_no_vars. eauto. eauto. } - invert H3. - eapply constant_nonneg_bounds_size_of_no_vars in H6; eauto. invert H6. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total with (v:=$0) in H3. - eapply H3 in H9. invert H9. lia. - - invs. - eapply IHe in H. - 2: eassumption. - 2: econstructor; eauto. - invert H. invert H5. econstructor. lia. auto. - - invs. eq_eval_Z. eapply IHe in H. - 2: eauto. 2: econstructor. - 2: eauto. 2: eauto. - invert H. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H2. - eapply H2 in H5. invert H5. - econstructor. 2: eauto. - eapply ceil_div_nonneg; lia. - econstructor. lia. eauto. - - invs. - eapply IHe in H. 2: eassumption. - 2: econstructor; eauto. invert H. invert H6. - eauto. - - invs. pose proof H2. erewrite size_of_sizeof in * by eauto. simpl in *. - eapply IHe in H0. 2: eassumption. - 2: { econstructor. eassumption. eassumption. } - eapply constant_nonneg_bounds_size_of_no_vars in H2. - 2: { eassumption. } invert H2. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H,H7. invs. - pose proof (H1 $0). pose proof (H2 $0). - pose proof (H1 v). pose proof (H2 v). eq_eval_Z. - eapply eval_Zexpr_Z_eval_Zexpr in H,H6. - unfold eval_Zexpr_Z_total in *. - rewrite H6,H in *. invert H0. - econstructor. lia. eauto. - - invs. pose proof H2. erewrite size_of_sizeof in * by eauto. simpl in *. - eapply IHe in H0. 2: eassumption. - 2: { econstructor. eassumption. eassumption. } - eapply constant_nonneg_bounds_size_of_no_vars in H2. - 2: { eassumption. } invert H2. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H,H7. invs. - pose proof (H1 $0). pose proof (H2 $0). - pose proof (H1 v). pose proof (H2 v). eq_eval_Z. - eapply eval_Zexpr_Z_eval_Zexpr in H,H6. - unfold eval_Zexpr_Z_total in *. - rewrite H6,H in *. invert H0. - econstructor. lia. eauto. - - invs. pose proof H2. - eapply IHe in H2. 2: eassumption. 2: eauto. invert H2. - unfold eval_Zexpr_Z_total in *. - eapply constant_nonneg_bounds_size_of_no_vars in H0. - 2: eassumption. invert H0. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H,H5. invs. - pose proof (H0 $0). pose proof (H1 $0). - pose proof (H0 v). pose proof (H1 v). eq_eval_Z. - eapply eval_Zexpr_Z_eval_Zexpr in H,H1. - rewrite H1 in *. - econstructor. lia. eauto. - - invs. pose proof H2. - eapply IHe in H2. 2: eassumption. 2: eauto. invert H2. - unfold eval_Zexpr_Z_total in *. - eapply constant_nonneg_bounds_size_of_no_vars in H0. - 2: eassumption. invert H0. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H,H5. invs. - pose proof (H0 $0). pose proof (H1 $0). - pose proof (H0 v). pose proof (H1 v). eq_eval_Z. - eapply eval_Zexpr_Z_eval_Zexpr in H,H1. - rewrite H1 in *. - econstructor. lia. eauto. - - invs. eauto. + 2: { eapply IHn in H19. eassumption. eassumption. eassumption. + simpl. rewrite H2. reflexivity. + eauto. lia. } + eapply H. 3: eassumption. + { eapply nonneg_bounds_includes; [|eassumption]. sets. } + { eapply size_of_includes; [|eassumption]. sets. } + eapply size_of_includes in H1; eauto. + eq_size_of. apply result_has_shape_gen_pad. Qed. - -Lemma constant_nonneg_bounds_sizeof_nonneg : - forall e, - constant_nonneg_bounds e -> - forall v lz, - eval_Zexprlist v (sizeof e) lz -> - Forall (fun x => 0 <= x)%Z lz. -Proof. - induct e; intros; simpl in *. - - invs. unfold eval_Zexpr_Z_total in *. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H1,H. - invs. - pose proof (H0 v). pose proof (H v). eq_eval_Z. - specialize (H0 $0). specialize (H $0). - eapply eval_Zexpr_Z_eval_Zexpr in H,H0. - rewrite H,H0 in *. econstructor. lia. eauto. - - invs. eauto. - - invs. eauto. - - invs. eauto. - - invs. cases (sizeof e1); cases (sizeof e2). - + invert H0. invert H5. invert H7. econstructor; eauto. lia. - + invert H0. eapply IHe2 with (v:=v) in H2. - 2: econstructor; eauto. eauto. - + invert H0. - eapply IHe1 in H1. 2: econstructor; eauto. eauto. - + invert H0. invert H5. - eapply IHe1 in H1. 2: econstructor; eauto. - invert H1. - pose proof H2. - eapply constant_nonneg_bounds_sizeof_no_vars in H. rewrite Heq0 in *. - invert H. - eapply IHe2 in H2. - 2: { econstructor. eassumption. - eapply forall_no_vars_eval_Zexpr_Z_total. eauto. } - invert H2. - econstructor. lia. auto. - - cases (sizeof e). - + invert H0. - invert H4. invert H6. econstructor; eauto. lia. - + cases l. invert H0. eapply IHe in H. 2: econstructor; eauto. - eauto. invert H0. invert H4. - eapply IHe in H. 2: econstructor; eauto. - invert H. invert H4. econstructor. lia. auto. - - cases (sizeof e). - + invert H0. - invert H4. invert H6. econstructor; eauto. lia. - + invert H0. invert H4. invert H6. invs. - eapply IHe in H. - 2: econstructor; eauto. invert H. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H0; eauto. eapply H0 in H5. invert H5. - econstructor. - eapply ceil_div_nonneg. lia. - lia. - econstructor. eapply H0 in H4. invert H4. lia. eauto. - - cases (sizeof e). - + invert H0. invert H4. invert H6. econstructor; eauto. lia. - + cases l. - * invert H0. invert H6. econstructor. - eapply IHe in H. 2: econstructor. - 2: eauto. 2: eauto. 2: econstructor. invert H. lia. - * invert H0. invert H6. - eapply IHe in H. 2: econstructor. 3: econstructor. - 2: eassumption. 2: eassumption. 2: eassumption. - invert H. invert H5. eauto. - - invs. cases (sizeof e). invert H0. invert H7. invert H9. - econstructor. lia. eauto. - invert H0. invert H7. - pose proof H1. eapply IHe in H1. - 2: econstructor; eauto. invert H1. - pose proof H0. - eapply constant_nonneg_bounds_sizeof_no_vars in H0; eauto. - rewrite Heq in *. - invert H0. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H,H11. invs. - pose proof (H0 $0). pose proof (H3 $0). - pose proof (H0 v). pose proof (H3 v). eq_eval_Z. - unfold eval_Zexpr_Z_total in *. - eapply eval_Zexpr_Z_eval_Zexpr in H,H6. rewrite H,H6 in *. - econstructor. lia. eauto. - - invs. cases (sizeof e). invert H0. invert H7. invert H9. - econstructor. lia. eauto. - invert H0. invert H7. - pose proof H1. eapply IHe in H1. - 2: econstructor; eauto. invert H1. - pose proof H0. - eapply constant_nonneg_bounds_sizeof_no_vars in H0; eauto. - rewrite Heq in *. - invert H0. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H,H11. invs. - pose proof (H0 $0). pose proof (H3 $0). - pose proof (H0 v). pose proof (H3 v). eq_eval_Z. - unfold eval_Zexpr_Z_total in *. - eapply eval_Zexpr_Z_eval_Zexpr in H,H6. rewrite H,H6 in *. - econstructor. lia. eauto. - - invs. cases (sizeof e). - + invs. econstructor; eauto; lia. - + invs. pose proof H1. - eapply constant_nonneg_bounds_sizeof_no_vars in H1. - rewrite Heq in *. invert H1. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H,H6. invs. - pose proof (H1 $0). pose proof (H2 $0). - pose proof (H1 v). pose proof (H2 v). eq_eval_Z. - unfold eval_Zexpr_Z_total in *. - eapply eval_Zexpr_Z_eval_Zexpr in H,H5. rewrite H5 in *. - eapply IHe in H0. 2: econstructor; eauto. invert H0. - econstructor. lia. eauto. - - invs. cases (sizeof e). - + invs. econstructor; eauto; lia. - + invs. pose proof H1. - eapply constant_nonneg_bounds_sizeof_no_vars in H1. - rewrite Heq in *. invert H1. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H,H6. invs. - pose proof (H1 $0). pose proof (H2 $0). - pose proof (H1 v). pose proof (H2 v). eq_eval_Z. - unfold eval_Zexpr_Z_total in *. - eapply eval_Zexpr_Z_eval_Zexpr in H,H5. rewrite H5 in *. - eapply IHe in H0. 2: econstructor; eauto. invert H0. - econstructor. lia. eauto. - - invert H0. eauto. -Qed. - diff --git a/src/verified_lowering/proof/Constant.v b/src/verified_lowering/proof/Constant.v index 82f7a40..7fe85e9 100644 --- a/src/verified_lowering/proof/Constant.v +++ b/src/verified_lowering/proof/Constant.v @@ -293,7 +293,7 @@ Proof. rewrite (union_comm (constant [a])). rewrite <- union_assoc. reflexivity. -Qed. +Qed. Lemma constant_cup_subseteq_eliminate {X} : forall (a : X) l1 l2, no_dup l1 -> @@ -330,7 +330,7 @@ Proof. + rewrite constant_cons. assert (~ a \in constant (List.remove H x l)). eauto. sets. -Qed. +Qed. Lemma no_dup_remove {X} : forall (x : X) l H, no_dup l -> @@ -345,7 +345,7 @@ Proof. invert H0. eapply not_In_remove. auto. rewrite <- In_iff_in. auto. -Qed. +Qed. Lemma length_remove {X} : forall X0 l1 (a : X), a \in constant l1 -> @@ -429,3 +429,20 @@ Lemma cap_monotone_contra {X} : forall (x y z : set X), x \cap y = constant []. Proof. intros. sets. Qed. +Lemma constant_not_empty {X} : forall (l : list X), + l <> [] -> + constant l = constant [] -> + False. +Proof. + intros. + erewrite <- sets_equal in H0. + cases l. propositional. + specialize (H0 x). + propositional. simpl in H1. sets. +Qed. + +Ltac cups_empty := + repeat match goal with + | H: constant _ = constant [] |- _ => eapply constant_not_empty in H; [contradiction | solve[inversion 1]] + | H: _ \cup _ = constant [] |- _ => simpl in H; apply cup_empty in H; destruct H + end. diff --git a/src/verified_lowering/proof/ContextsAgree.v b/src/verified_lowering/proof/ContextsAgree.v index fa11abd..f44ec2a 100644 --- a/src/verified_lowering/proof/ContextsAgree.v +++ b/src/verified_lowering/proof/ContextsAgree.v @@ -24,14 +24,10 @@ Definition contexts_agree (ec : expr_context) (st : stack) (h : heap) sh := forall x, (forall v, ec $? x = Some (V v) -> - exists l, + exists l l', sh $? x = Some l /\ - Forall (fun x => vars_of_Zexpr x = []) l /\ - result_has_shape - (V v) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l)) /\ - (Forall (fun x => 0 <= x)%Z - (map (eval_Zexpr_Z_total $0) l)) /\ + eval_Zexprlist $0 l (map Z.of_nat l') /\ + result_has_shape (V v) l' /\ exists arr, h $? x = Some arr /\ array_add @@ -40,17 +36,11 @@ Definition contexts_agree (fold_left Z.mul (map Z.of_nat - (filter_until - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l) - ) 0)) 1%Z)) $0) + (filter_until l' 0)) 1%Z)) $0) (tensor_to_array_delta (partial_interpret_reindexer (fun l => l) - (map Z.of_nat - (filter_until - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l)) 0)) $0) + (map Z.of_nat (filter_until l' 0)) $0) (V v)) = arr) /\ (forall s, ec $? x = Some (S s) -> sh $? x = Some [] /\ st $? x = Some (match s with @@ -62,9 +52,7 @@ Lemma eval_get_eval_Zexprlist : forall l v rs r, eval_get v rs l r -> exists lz, eval_Zexprlist v l lz. Proof. - induct 1; invs. - - eexists. econstructor. eauto. eauto. - - eexists. eauto. + induct 1; invs; eauto. Qed. Arguments flatten : simpl nomatch. @@ -72,22 +60,21 @@ Lemma eval_get_lookup_result_Z : forall l v rs r, eval_get v rs l r -> forall x0, eval_Zexprlist v l x0 -> - r = result_lookup_Z x0 (V rs). + r = result_lookup_Z x0 rs. Proof. induct 1; intros. - invert H3. simpl. eq_eval_Z. rewrite H1. - cases z; try lia; eauto. - - invert H2. invert H8. eq_eval_Z. simpl. rewrite H1. - cases z; try lia; eauto. + cases y; try lia; eauto. + - invert H. reflexivity. Qed. Lemma eval_get_In_meshgrid : forall l v rs r, eval_get v rs l r -> - result_has_shape (V rs) (result_shape_nat (V rs)) -> + result_has_shape rs (result_shape_nat rs) -> forall x0, eval_Zexprlist v l x0 -> - In x0 (mesh_grid (result_shape_Z (V rs))). + In x0 (mesh_grid (result_shape_Z rs)). Proof. induct 1; intros. - invert H4. cases l. simpl in *. @@ -97,33 +84,36 @@ Proof. split. eq_eval_Z. eapply nth_error_Some in H1. simpl in *. lia. unfold result_shape_Z in IHeval_get. - simpl in H3. invert H3. clear H9. + simpl in H3. invert H3. clear H10. eapply nth_error_In in H1. - simpl in H1. invert H1. + simpl in H1. destruct H1; subst. + eauto. - + eapply Forall_forall in H12. 2: eapply H3. + + eapply Forall_forall in H12. 2: apply H1. pose proof (result_has_shape_result_shape_nat _ _ H12). erewrite result_has_shape_result_shape_nat by eassumption. - rewrite <- H1. + rewrite <- H3. eapply result_has_shape_self in H12. eauto. - - invert H3. invert H9. unfold result_shape_Z. simpl. - cases l. cases (Z.to_nat i); invert H1. - invert H2. clear H8. - pose proof (nth_error_Some _ _ _ H1). - eapply nth_error_In in H1. simpl in H1. invert H1. - + simpl map. posnats. - erewrite <- in_mesh_grid_cons. simpl. propositional. - simpl in *. posnats. eq_eval_Z. lia. - + eapply Forall_forall in H10. 2: eapply H3. - eapply result_has_shape_result_shape_nat in H10. - erewrite result_has_shape_result_shape_nat by eassumption. - rewrite <- H10. simpl map. eq_eval_Z. - erewrite <- in_mesh_grid_cons__. simpl in *. - propositional. lia. + - invert H0. simpl. auto. +Qed. + +Lemma eval_get_length v rs l r sz : + eval_get v rs l r -> + result_has_shape rs sz -> + length l = length sz. +Proof. + intros H. revert sz. induction H; simpl; intros sz Hsz. + - invert Hsz; simpl. + + rewrite nth_error_nil in H1. discriminate H1. + + f_equal. apply IHeval_get. apply nth_error_In in H1. simpl in H1. + destruct H1; subst. + -- assumption. + -- rewrite Forall_forall in H6. specialize (H6 _ ltac:(eassumption)). + assumption. + - invert Hsz. reflexivity. Qed. Lemma eval_Sexpr_eval_Sstmt : forall sh (v : valuation) ec s r, - eval_Sexpr sh v ec s r -> + eval_Sexpr v ec s r -> forall st h r0, contexts_agree ec st h sh -> eval_Sstmt v st h (lowerS s sh) r0 -> @@ -132,92 +122,84 @@ Lemma eval_Sexpr_eval_Sstmt : forall sh (v : valuation) ec s r, | SX => 0%R end = r0. Proof. - induct 1; intros; simpl in *; try invert1 H2; try f_equal; eauto. - - eapply H1 in H. invs. rewrite H3 in H7. invert H7. cases r; auto. - - rewrite H0 in *. - invert H4. - rewrite map_fst_combine in H8 by auto. - rewrite map_snd_combine in H8 by auto. - unfold contexts_agree in *. - specialize (H3 x). invert H3. clear H5. - eapply H4 in H. - clear H4. invs. - + induct 1; intros; simpl in *; + try match goal with + | H: eval_Sstmt _ _ _ _ _ |- _ => invert1 H + end; f_equal; eauto. + - destruct rs as [?|rs]. + { eapply H1 in H. invs. invert H0. rewrite H3 in H2. simpl in H2. invert H2. + rewrite H4 in H7. invert H7. cases r; reflexivity. } + apply H1 in H. invs. clear H1. rewrite H3 in H2. + destruct x0 as [|n x0]; [invert1 H; invert H4; discriminate|]. + remember (n :: x0) as x2 eqn:E. clear E x0. rename x2 into x0. + assert (length x0 = length l). + { eapply eval_get_length in H0; eauto. apply Forall2_length in H. + rewrite length_map in H. lia. } + invert H2. + rewrite map_fst_combine in H9 by assumption. + rewrite map_snd_combine in H9 by assumption. + (* REVISIT *) assert (Some - (array_add - (alloc_array - (Z.to_nat - (fold_left Z.mul (map Z.of_nat (filter_until (map Z.to_nat (map (eval_Zexpr_Z_total $0) x0)) 0)) - 1%Z)) $0) - (tensor_to_array_delta - (partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => l) - (map Z.of_nat (filter_until (map Z.to_nat (map (eval_Zexpr_Z_total $0) x0)) 0)) $0) - (V rs))) = Some l0). - rewrite <- H9. eauto. - invert H6. - rewrite H0 in *. invert H. - pose proof H2. eapply eval_get_eval_Zexprlist in H2. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H8. - erewrite eval_Zexpr_Z_flatten_index_flatten in H8; eauto. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total. eauto. } - invert H8. + (array_add + (alloc_array + (Z.to_nat (fold_left Z.mul (map Z.of_nat (filter_until x1 0)) 1%Z)) $0) + (tensor_to_array_delta + (partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => l) + (map Z.of_nat (filter_until x1 0)) $0) + (V rs))) = Some l0). + rewrite <- H6. assumption. + + pose proof H0. eapply eval_get_eval_Zexprlist in H0. invs. + eapply eval_Zexpr_Z_eval_Zexpr in H9. + erewrite eval_Zexpr_Z_flatten_index_flatten in H9; eauto. + 2: { eapply eval_Zexprlist_includes_valuation; [eassumption|]. + apply empty_includes. } + invert H9. - pose proof H. + pose proof H5 as H2. eapply eval_get_lookup_result_Z in H2; eauto. subst. - erewrite <- result_has_shape_result_shape_Z in H14 by eauto. + erewrite <- result_has_shape_result_shape_Z in H15 by eauto. rewrite tensor_to_array_delta_partial_interpret_reindexer_flatten - in H14. + in H15. unfold array_add in *. rewrite lookup_merge in *. - erewrite result_has_shape_result_shape_Z in H14 by eauto. - pose proof H5. - eapply forall_nonneg_exists_zero_or_forall_pos_Z in H5. - invert H5. - + rewrite filter_until_0_id in H14. - 2: { eapply Forall_map. - eapply Forall_impl. 2: apply H8. simpl. intros. lia. } - rewrite Z2Natid_list in * by auto. - + erewrite result_has_shape_result_shape_Z in H15 by eauto. + pose proof forall_nonneg_exists_zero_or_forall_pos x1 as [H'|H']. + + rewrite filter_until_0_id in H15 by assumption. + rewrite result_lookup_Z_tensor_to_array_delta in *. - eapply eval_get_In_meshgrid in H; eauto. - erewrite result_has_shape_result_shape_Z in H; eauto. + eapply eval_get_In_meshgrid in H5; eauto. + erewrite result_has_shape_result_shape_Z in H5; eauto. repeat decomp_index. - rewrite mesh_grid_map_Nat2Z_id in *. cases rs. - { invert H4. cases x0. simpl in *. discriminate. - invert H5. rewrite map_cons in *. - repeat decomp_index. lia. } - invert H4. simpl in *. cases x0. simpl in *. discriminate. - simpl map in *. invert H11. - eapply in_mesh_grid_args_flatten_bounds in H. - invert H. - 2: { invert H2. eapply fold_left_mul_nonneg in H11. - 2: apply H13. + { invert H4. cases x2. simpl in *. contradiction. + rewrite map_cons in *. repeat decomp_index. lia. } + invert H4. cases x2. invert H. invert H7. simpl in *. discriminate. + cbn [map] in *. + eapply in_mesh_grid_args_flatten_bounds in H5. + invert H5. + 2: { invert H'. rewrite <- map_cons in H0. + replace 1%Z with (Z.of_nat 1) in H0 by reflexivity. + rewrite <- Z_of_nat_fold_left_mul in H0. lia. } - cases (alloc_array - (Z.to_nat - (fold_left Z.mul - (eval_Zexpr_Z_total $0 z :: map (eval_Zexpr_Z_total $0) x0) 1%Z)) - $0 $? - flatten (eval_Zexpr_Z_total $0 z :: map (eval_Zexpr_Z_total $0) x0) x1). - * pose proof (lookup_alloc_array - (Z.to_nat - (fold_left Z.mul - (eval_Zexpr_Z_total $0 z :: map (eval_Zexpr_Z_total $0) x0) 1%Z)) - (flatten (eval_Zexpr_Z_total $0 z :: map (eval_Zexpr_Z_total $0) x0) x1)). - invert H. rewrite H10 in *. discriminate. - rewrite H10 in *. invs. - cases (result_lookup_Z_option x1 (V (r :: rs))). invs. + match goal with + | H: match alloc_array ?arr1' _ $? ?arr2' with _ => _ end = _ |- _ => remember arr1' as arr1 eqn:E1; remember arr2' as arr2 eqn:E2 + end. + cases (alloc_array arr1 $0 $? arr2). + * pose proof (lookup_alloc_array arr1 arr2) as H''. + invert H''. rewrite H2 in *. discriminate. + rewrite H2 in *. invs. + cases (result_lookup_Z_option (z :: x2) (V (r :: rs))). invs. rewrite Rplus_0_l. eapply result_lookup_Z_option_result_lookup_Z in Heq. rewrite Heq. auto. invs. eapply result_lookup_Z_option_result_lookup_Z_None in Heq. - cases (result_lookup_Z x1 (V (r :: rs))); eauto. - * eapply result_lookup_Z_option_result_lookup_Z in H14. rewrite H14. + cases (result_lookup_Z (z :: x2) (V (r :: rs))); eauto. + * eapply result_lookup_Z_option_result_lookup_Z in H15. rewrite H15. auto. * eapply result_has_shape_self; eauto. * eapply result_has_shape_self; eauto. @@ -227,35 +209,28 @@ Proof. * unfold injective. intros. invs. eapply injective_flatten; eauto. erewrite result_has_shape_result_shape_Z by eauto. - rewrite filter_until_0_id. - 2: { eapply Forall_map. - eapply Forall_impl. 2: apply H8. simpl. intros. lia. } - rewrite Z2Natid_list in * by auto. - auto. - + eapply eval_get_In_meshgrid in H; eauto. - erewrite result_has_shape_result_shape_Z in H; eauto. - erewrite exists_0_empty_mesh_grid in H. + rewrite filter_until_0_id by assumption. + assumption. + + eapply eval_get_In_meshgrid in H5; eauto. + erewrite result_has_shape_result_shape_Z in H5; eauto. + erewrite exists_0_empty_mesh_grid in H5. simpl in *. propositional. eapply exists_0_map_Z_of_nat. eapply exists_0_filter_until_0. - eapply Exists_map. - eapply Exists_impl. 2: eapply H8. - simpl. intros. subst. lia. + assumption. eapply result_has_shape_self; eauto. - eapply IHeval_Sexpr1 in H5; eauto. eapply IHeval_Sexpr2 in H9; eauto. - cases r1; cases r2; subst; simpl; auto. + cases r1; cases r2; subst; simpl; auto. - eapply IHeval_Sexpr1 in H5; eauto. eapply IHeval_Sexpr2 in H9; eauto. - cases r1; cases r2; subst; simpl; auto. - - invert H3. - eapply IHeval_Sexpr1 in H6; eauto. + cases r1; cases r2; subst; simpl; auto. + - eapply IHeval_Sexpr1 in H6; eauto. eapply IHeval_Sexpr2 in H10; eauto. cases r1; cases r2; subst; simpl; auto. - eapply IHeval_Sexpr1 in H5; eauto. eapply IHeval_Sexpr2 in H9; eauto. cases r1; cases r2; subst; simpl; auto. - - invert H0. eauto. Qed. Lemma contexts_agree_add_heap : forall ec st h sh a val p, @@ -266,12 +241,11 @@ Lemma contexts_agree_add_heap : forall ec st h sh a val p, contexts_agree ec st (h $+ (p,array_add a val)) sh. Proof. unfold contexts_agree. propositional. - - eapply H in H3. invs. clear H. - cases (x ==v p). subst. eapply lookup_Some_dom in H3. sets. + - eapply H in H3. invs. clear H. + cases (x ==v p). subst. eapply lookup_Some_dom in H4. sets. rewrite lookup_add_ne by auto. - eexists. split. + eexists. eexists. split. eassumption. split. eassumption. split. eassumption. - split. eassumption. eexists. split. eassumption. reflexivity. - eapply H in H3. propositional. - eapply H in H3. propositional. @@ -287,17 +261,16 @@ Proof. - cases (x ==v x0). subst. rewrite H0 in *. discriminate. eapply H in H1. invs. - eexists. + eexists. eexists. split. eassumption. split. eassumption. split. eassumption. - split. eassumption. eexists. unfold alloc_array_in_heap. rewrite lookup_add_ne by auto. split. eassumption. reflexivity. - eapply H. eauto. - eapply H. eauto. -Qed. +Qed. Lemma contexts_agree_add_in_stack : forall ec st h sh p val a, @@ -310,8 +283,8 @@ Proof. unfold contexts_agree. propositional. - eapply H. auto. - cases (x ==v p). - + subst. eapply H. eauto. - + subst. eapply H. eauto. + + subst. eapply H. eauto. + + subst. eapply H. eauto. - cases (x ==v p). + subst. rewrite lookup_add_eq by auto. eapply lookup_Some_dom in H3. sets. @@ -325,7 +298,7 @@ Lemma contexts_agree_alloc_stack : forall ec st x val h sh, contexts_agree ec (st $+ (x, val)) h sh. Proof. unfold contexts_agree. propositional. - - eapply H. eauto. + - eapply H. eauto. - cases (x ==v x0). subst. rewrite H1 in *. discriminate. eapply H. eauto. - cases (x ==v x0). subst. rewrite H1 in *. discriminate. @@ -357,47 +330,34 @@ Proof. Qed. Lemma contexts_agree_add_alloc_heap : - forall ec st h sh x nz z esh1 l1, + forall ec st h sh x nz z esh1 esh1' l1, contexts_agree ec st h sh -> ec $? x = None -> - result_has_shape (V l1) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (z :: esh1))) -> - Forall (fun x : Z => (0 <= x)%Z) (map (eval_Zexpr_Z_total $0) (z :: esh1))-> - Forall (fun x : Zexpr => vars_of_Zexpr x = []) (z :: esh1) -> - fold_left Z.mul - (map Z.of_nat - (filter_until - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (z :: esh1))) 0)) - 1%Z = nz -> + eval_Zexprlist $0 (z :: esh1) (map Z.of_nat esh1') -> + result_has_shape (V l1) esh1' -> + fold_left Z.mul (map Z.of_nat (filter_until esh1' 0)) 1%Z = nz -> contexts_agree (ec $+ (x, V l1)) st (h $+ (x, array_add (alloc_array (Z.to_nat nz) $0) (tensor_to_array_delta (partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => l) - (map Z.of_nat - (filter_until - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) - (z :: esh1))) 0)) $0) + (map Z.of_nat (filter_until esh1' 0)) $0) (V l1)))) (sh $+ (x, z :: esh1)). Proof. unfold contexts_agree. propositional. - cases (x ==v x0). + subst. rewrite lookup_add_eq in * by auto. - invs. - eexists. + invs. + eexists. eexists. split. reflexivity. split. eauto. split. eauto. - split. eassumption. eexists. rewrite lookup_add_eq by auto. split. reflexivity. f_equal. + rewrite lookup_add_ne in * by auto. - eapply H in H5. clear H. invs. - eexists. - split. eassumption. + eapply H in H4. clear H. invs. + eexists. eexists. split. eassumption. split. eassumption. split. eassumption. @@ -405,30 +365,33 @@ Proof. eassumption. reflexivity. - cases (x ==v x0). + subst. rewrite lookup_add_eq in * by auto. - invert H5. + invert H4. + rewrite lookup_add_ne in * by auto. eapply H. eauto. - cases (x ==v x0). + subst. rewrite lookup_add_eq in * by auto. - invert H5. + invert H4. + rewrite lookup_add_ne in * by auto. eapply H. eauto. Qed. Lemma contexts_agree_result_has_shape : forall ec st h sh, - contexts_agree ec st h sh -> - (forall (x0 : var) (r0 : result) (size0 : list Zexpr), + contexts_agree ec st h sh -> + (forall (x0 : var) (r0 : result) (size0 : list Zexpr) size0', sh $? x0 = Some size0 -> ec $? x0 = Some r0 -> - result_has_shape r0 - (map Z.to_nat (map (eval_Zexpr_Z_total $0) size0))). + eval_Zexprlist $0 size0 (map Z.of_nat size0') -> + result_has_shape r0 size0'). Proof. unfold contexts_agree. intros. specialize (H x0). invs. cases r0. - - eapply H3 in H1. propositional. rewrite H in *. invs. econstructor. - - eapply H2 in H1; clear H2. invs. rewrite H1 in *. invs. - eauto. -Qed. - + - eapply H4 in H1. propositional. rewrite H in *. invs. + destruct size0'; [|invert0 H2]. + constructor. + - eapply H3 in H1. invs. rewrite H0 in *. invs. + eapply eval_Zexprlist_deterministic in H2; [|eapply H1]. + apply map_Z_of_nat_inj in H2. subst. + assumption. +Qed. diff --git a/src/verified_lowering/proof/Correct.v b/src/verified_lowering/proof/Correct.v index 4411cf9..7ff8fe8 100644 --- a/src/verified_lowering/proof/Correct.v +++ b/src/verified_lowering/proof/Correct.v @@ -39,12 +39,12 @@ Arguments flatten : simpl nomatch. Theorem lower_correct_weak_top : forall e, - constant_nonneg_bounds e -> - forall sh v ec r, + forall v ec r, (* functional evaluation of ATL *) - eval_expr sh v ec e r -> - forall l, size_of e l -> - forall p st h reindexer asn, + eval_expr v ec e r -> + nonneg_bounds $0 e -> + forall l, size_of $0 e l -> + forall p st h reindexer asn sh, (* our environment is well-formed *) well_formed_environment st h p sh v (vars_of e) ec -> (* reindexer is well-formed *) @@ -54,7 +54,7 @@ Theorem lower_correct_weak_top : (* expr context and imperative state agree *) contexts_agree ec st h sh -> forall pads g, - has_pad sh v g e pads -> + has_pad v g e pads -> (forall pads (x : var) (r0 : result), g $? x = Some pads -> ec $? x = Some r0 -> @@ -88,7 +88,7 @@ Theorem lower_correct_weak_top : end) . Proof. - intros e Hconst sh v ec r Heval ls Hsize p st h reindexer asm + intros e v ec r Heval Hbds ls Hsize p st h reindexer asm sh Henv Hrdx Halloc Hctx pads g Hpad Hrelate. pose proof Heval. eapply lower_correct_exists in H; eauto. invs. pose proof H. @@ -100,11 +100,11 @@ Qed. Theorem lower_correct_top : forall e, - constant_nonneg_bounds e -> forall r, (* functional evaluation of ATL *) - eval_expr $0 $0 $0 e r -> - forall l, size_of e l -> + eval_expr $0 $0 e r -> + nonneg_bounds $0 e -> + forall l, size_of $0 e l -> forall p st h asn, (h,st) = match (shape_to_index @@ -115,7 +115,7 @@ Theorem lower_correct_top : end -> ~ p \in vars_of e -> forall pads, - has_pad $0 $0 $0 e pads -> + has_pad $0 $0 e pads -> (* imperative evaluation of lowering *) eval_stmt $0 st h (lower e (fun l => l) p asn $0) (match (fun l => l) (shape_to_index @@ -255,4 +255,3 @@ Proof. - unfold contexts_agree. intros. repeat rewrite lookup_empty. propositional; discriminate. Qed. - diff --git a/src/verified_lowering/proof/InferPad.v b/src/verified_lowering/proof/InferPad.v deleted file mode 100644 index 6e02f4c..0000000 --- a/src/verified_lowering/proof/InferPad.v +++ /dev/null @@ -1,836 +0,0 @@ -From Stdlib Require Import Arith.Arith. -From Stdlib Require Import Arith.EqNat. -From Stdlib Require Import Arith.PeanoNat. Import Nat. -From Stdlib Require Import Bool.Bool. -From Stdlib Require Import Reals.Reals. Import Rdefinitions. Import RIneq. -From Stdlib Require Import ZArith.Zdiv. -From Stdlib Require Import ZArith.Int. -From Stdlib Require Import ZArith.Znat. -From Stdlib Require Import Strings.String. -From Stdlib Require Import Lists.List. -From Stdlib Require Import micromega.Lia. -From Stdlib Require Import Logic.FunctionalExtensionality. - -Set Warnings "-deprecate-hint-without-locality,-deprecated". -Import ListNotations. - -From ATL Require Import ATL Map Sets FrapWithoutSets Div Tactics TensorAdd - Zexpr Bexpr Array Range Sexpr Result ListMisc Meshgrid VarGeneration - Constant ATLDeep Pad Reify Convolution Blur Common CommonTactics Matmul - GatherScatter Im2col. - -Open Scope string_scope. - -Hint Constructors size_of. -Hint Unfold eval_Zexpr_Z_total. -Arguments sub : simpl nomatch. - -Lemma all_nat_nonneg : forall x, 0 <= x. lia. Qed. - -Fixpoint Bexpr_to_Prop v b := - match b with - | And b1 b2 => Bexpr_to_Prop v b1 /\ Bexpr_to_Prop v b2 - | Lt x1 x2 => match eval_Zexpr_Z v x1, eval_Zexpr_Z v x2 with - | Some x1z, Some x2z => (x1z < x2z)%Z - | _,_ => False - end - | Le x1 x2 => match eval_Zexpr_Z v x1, eval_Zexpr_Z v x2 with - | Some x1z, Some x2z => (x1z <= x2z)%Z - | _,_ => False - end - | Eq x1 x2 => match eval_Zexpr_Z v x1, eval_Zexpr_Z v x2 with - | Some x1z, Some x2z => (x1z = x2z)%Z - | _,_ => False - end - end. - -Fixpoint vars_of_Bexpr b := - match b with - | And b1 b2 => vars_of_Bexpr b1 ++/ vars_of_Bexpr b2 - | Lt x1 x2 => vars_of_Zexpr x1 ++/ vars_of_Zexpr x2 - | Le x1 x2 => vars_of_Zexpr x1 ++/ vars_of_Zexpr x2 - | Eq x1 x2 => vars_of_Zexpr x1 ++/ vars_of_Zexpr x2 - end. - -Lemma vars_of_Zexpr_eval_Zexpr : forall b v, - constant (vars_of_Zexpr b) \subseteq dom v -> - exists bb, eval_Zexpr v b bb. -Proof. - induct b; intros; simpl in *; repeat rewrite constant_app_no_dups in *; - try assert ( constant (vars_of_Zexpr b1) \subseteq dom v) by sets; - try assert ( constant (vars_of_Zexpr b2) \subseteq dom v) by sets; - try eapply IHb1 in H0; try eapply IHb2 in H1; invs; - try now (eexists; econstructor; eauto). - assert (x \in dom v). sets. - eapply dom_lookup_Some in H0. invs. - eexists. eauto. -Qed. - -Lemma vars_of_Bexpr_eval_Bexpr : forall b v, - constant (vars_of_Bexpr b) \subseteq dom v -> - exists bb, eval_Bexpr v b bb. -Proof. - induct b; intros; simpl in *; rewrite constant_app_no_dups in *; - try assert ( constant (vars_of_Bexpr b1) \subseteq dom v) by sets; - try assert ( constant (vars_of_Bexpr b2) \subseteq dom v) by sets; - try assert ( constant (vars_of_Zexpr a) \subseteq dom v) by sets; - try assert ( constant (vars_of_Zexpr b) \subseteq dom v) by sets; - try eapply IHb1 in H0; try eapply IHb2 in H1; invs; - try now (eexists; econstructor; eauto). - all: eapply vars_of_Zexpr_eval_Zexpr in H0,H1; invs. - eexists. econstructor; eauto. - eexists. econstructor; eauto. - eexists. econstructor; eauto. -Qed. - -Lemma Bexpr_to_Prop_eval_Bexpr_false : forall b v, - ~ Bexpr_to_Prop v b -> - constant (vars_of_Bexpr b) \subseteq dom v -> - eval_Bexpr v b false. -Proof. - induct b; propositional. - - simpl in *. rewrite constant_app_no_dups in H0. - try assert ( constant (vars_of_Bexpr b1) \subseteq dom v) by sets; - try assert ( constant (vars_of_Bexpr b2) \subseteq dom v) by sets. - eapply vars_of_Bexpr_eval_Bexpr in H1,H2. invs. - eapply Classical_Prop.not_and_or in H. invert H. - + eapply IHb1 in H1. eq_eval_B. - replace false with (false && x) by auto. - econstructor; eauto. - sets. - + eapply IHb2 in H1. eq_eval_B. - replace false with (x0 && false) by (rewrite andb_false_r;auto). - econstructor; eauto. - sets. - - simpl in *. - rewrite constant_app_no_dups in H0. - try assert ( constant (vars_of_Zexpr a) \subseteq dom v) by sets; - try assert ( constant (vars_of_Zexpr b) \subseteq dom v) by sets. - eapply vars_of_Zexpr_eval_Zexpr in H1,H2. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H2,H3. rewrite H2,H3 in *. - assert (x <= x0)%Z by lia. - eapply Z.ltb_ge in H1. rewrite <- H1. - econstructor; eapply eval_Zexpr_Z_eval_Zexpr; eauto. - - simpl in *. - rewrite constant_app_no_dups in H0. - try assert ( constant (vars_of_Zexpr a) \subseteq dom v) by sets; - try assert ( constant (vars_of_Zexpr b) \subseteq dom v) by sets. - eapply vars_of_Zexpr_eval_Zexpr in H1,H2. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H2,H3. rewrite H2,H3 in *. - assert (x < x0)%Z by lia. - eapply Z.leb_gt in H1. rewrite <- H1. - econstructor; eapply eval_Zexpr_Z_eval_Zexpr; eauto. - - simpl in *. - rewrite constant_app_no_dups in H0. - try assert ( constant (vars_of_Zexpr a) \subseteq dom v) by sets; - try assert ( constant (vars_of_Zexpr b) \subseteq dom v) by sets. - eapply vars_of_Zexpr_eval_Zexpr in H1,H2. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H2,H3. rewrite H2,H3 in *. - assert (x0 <> x)%Z by lia. - eapply Z.eqb_neq in H1. rewrite <- H1. - econstructor; eapply eval_Zexpr_Z_eval_Zexpr; eauto. -Qed. - -Ltac is_unspec_nat n := - match n with - | 0 => idtac - | _ => is_evar n - end. - -Ltac is_unspec_pad_ty p := - first [ is_evar p | - match p with - | PadCons ?k ?l ?p1 ?r ?p2 ?c => - is_unspec_nat k; is_unspec_nat l; - is_unspec_nat r; is_unspec_nat c; - is_unspec_pad_ty p1; - is_unspec_pad_ty p2 - | PadNil ?b => is_evar b - end - ]. - -Ltac list_eq := - repeat - match goal with - | |- map _ _ = map _ _ => simpl - | |- (?x::?xs)%list = (?y::?ys)%list => - f_equal; try now (autounfold; simpl; lia) - | |- [] = [] => reflexivity - end. - -Lemma mod_div_0 : forall n k, - 0 < k -> - (n mod k) / k = 0. -Proof. intros. rewrite div_small. lia. eapply Nat.mod_upper_bound. lia. Qed. - -Lemma instantiate_0 : forall x, - 0 + 0 <= x - 0. -Proof. lia. Qed. -Hint Resolve instantiate_0 : crunch. - -Ltac arith := - autounfold; simpl; - repeat match goal with - | |- context[min 0 _] => rewrite min_0_l - | |- context[min _ 0] => rewrite min_0_r - | |- context[ (0 / _)%nat ] => rewrite div_0_l - | |- context[ (0 / _)%Z ] => rewrite Z.div_0_l - | |- context[ (0 //n _)%nat ] => rewrite div_ceil_n_0 - | |- context[ (_ - 0)%Z ] => rewrite Z.sub_0_r - | |- context[ (_ + 0)%nat ] => rewrite add_0_r - | |- context[ (0 + _)%nat ] => rewrite add_0_l - | |- context[ ((_ mod ?k) / ?k)%nat ] => rewrite mod_div_0 - | |- ?a = ?b => first [ reflexivity | lia ] - | |- context[ match _ with _ => _ end ] => simpl - | |- context[min ?x ?y ] => is_evar x; is_evar y; rewrite min_id - | |- ?G => first [ has_evar G | lia ] - end. - -Ltac outer_dim e := - let outer_dim := constr:(match (sizeof e) with - | n::_ => eval_Zexpr_Z_total $0 n - | _ => 0%Z - end) in - let outer_dim := eval unfold eval_Zexpr_Z_total in outer_dim in - let outer_dim := eval simpl in outer_dim in - outer_dim. - -Ltac inner_dim e := - let inner_dim := constr:(match (sizeof e) with - | _::d::_ => eval_Zexpr_Z_total $0 d - | _ => 0%Z - end) in - let inner_dim := eval unfold eval_Zexpr_Z_total in inner_dim in - let inner_dim := eval simpl in inner_dim in - inner_dim. -Ltac infer_pad left right := - match goal with - | |- has_pad _ _ _ (Scalar _) _ => - eapply HasPadScalarNotPad - | |- has_pad _ _ _ (Split _ _) _ => - infer_split left right - | |- has_pad _ _ _ (Truncr ?k _) _ => - infer_truncr left right 0%nat - | |- has_pad _ _ _ (Truncl ?k _) _ => - infer_truncl left right 0%nat - | |- has_pad _ _ _ (Padr ?k _) _ => - infer_padr left right - | |- has_pad _ _ _ (Padl ?k _) _ => - infer_padl left right - | |- has_pad _ _ _ (Gen ?i ?lo ?hi ?e) _ => - infer_gen left right - | |- has_pad _ _ _ (Lbind ?x ?e1 ?e2) _ => - eapply HasPadLbind; - [ solve [ infer_pad 0%Z 0%Z ] | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | - solve [ infer_pad left right ] ] - | |- has_pad ?ctx ?v ?g (Guard ?p ?e) _ => - first [ solve [ eapply HasPadGuardFalse; - [ eapply Bexpr_to_Prop_eval_Bexpr_false; - [ autounfold; simpl; - repeat first - [ rewrite lookup_add_ne by inversion 1 | - rewrite lookup_add_eq by auto ]; lia | - simpl; repeat rewrite dom_add; rewrite dom_empty; simpl; sets ] | - repeat (econstructor; eauto) | - reflexivity ] ] | - eapply HasPadGuardTrue; infer_pad left right ] - | |- has_pad ?ctx ?v ?g (Concat ?e1 ?e2) _ => - infer_concat left right - | |- has_pad ?ctx ?v ?g (Sum ?i ?lo ?hi ?e) _ => - first [ eapply HasPadSumEmpty; - [ repeat (econstructor; eauto) | - autounfold; simpl; lia | - reflexivity ] | - eapply HasPadSum; - [ autounfold; simpl; intros; infer_pad left right | - autounfold; simpl; lia ] ] - | |- has_pad ?ctx ?v ?g (Flatten ?e) _ => - infer_flatten left right 0%nat - | |- has_pad _ _ _ (Transpose _) _ => - infer_transpose 0%Z 0%Z 0%nat 0%nat - end with infer_padr left right := - match goal with - | |- has_pad _ _ _ (Padr ?k ?e) _ => - let outer_dim := outer_dim e in - let right' := constr:(Z.max (right-eval_Zexpr_Z_total $0 k)%Z 0%Z) in - let right' := eval unfold eval_Zexpr_Z_total in right' in - let right' := eval simpl in right' in - first [ solve [ assert (0 < outer_dim)%Z as Hcheck by lia; - clear Hcheck; - eapply HasPadPadr; - [ autounfold; simpl; intros; try lia; - infer_pad left right' | - repeat (econstructor; eauto) | - arith | - arith | - arith | - arith ] ] | - eapply HasPadPadrEmpty; [ repeat (econstructor; eauto) | - infer_pad 0%Z 0%Z | - arith ] ] - end with infer_padl left right := - match goal with - | |- has_pad _ _ _ (Padl ?k ?e) _ => - let outer_dim := outer_dim e in - let left' := constr:(Z.max (left-eval_Zexpr_Z_total $0 k)%Z 0%Z) in - let left' := eval unfold eval_Zexpr_Z_total in left' in - let left' := eval simpl in left' in - first [ solve [ assert (0 < outer_dim)%Z as Hcheck by lia; - clear Hcheck; - eapply HasPadPadl; - [ autounfold; simpl; intros; try lia; - infer_pad left' right | - repeat (econstructor; eauto) | - arith | - arith | - arith | - arith ] ] | - eapply HasPadPadlEmpty; [ repeat (econstructor; eauto) | - infer_pad 0%Z 0%Z | - arith ] ] -end with infer_truncr left right offset := - match goal with - | |- has_pad _ _ _ (Truncr ?k ?e) _ => - let outer_dim := outer_dim e in - let right' := constr:((right+ eval_Zexpr_Z_total $0 k)%Z) in - let right' := eval unfold eval_Zexpr_Z_total in right' in - let right' := eval simpl in right' in - first [ solve [ eapply HasPadTruncr - with (y:= Z.to_nat right' + offset); - [ infer_pad left right' | - arith | - arith ] ] - ] - end with infer_truncl left right offset := - match goal with - | |- has_pad _ _ _ (Truncl ?k ?e) _ => - let outer_dim := outer_dim e in - let left' := constr:((left+ eval_Zexpr_Z_total $0 k)%Z) in - let left' := eval unfold eval_Zexpr_Z_total in left' in - let left' := eval simpl in left' in - first [ solve [ eapply HasPadTruncl - with (x:= Z.to_nat left' + offset); - [ infer_pad left' right | - arith | - arith ] ] | - assert (Z.to_nat left' + offset < Z.to_nat outer_dim) as - Hcheck by (arith; lia); clear Hcheck; - infer_truncl left right constr:(offset+1) - ] - end with infer_concat left right := - match goal with - | |- has_pad _ _ _ (Concat _ _) _ => - first [ solve [ eapply HasPadConcat with - (x:=0) (y:=0) (a:=0) (b:=0) - (l1:=0) (r1:=0) (l1:=0) (r2:=0); - [ repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | - autounfold; simpl; intros; try lia; - infer_pad 0%Z 0%Z | - autounfold; simpl; intros; try lia; - infer_pad 0%Z 0%Z | - arith | - arith | - arith | - arith ] ] | - solve [ eapply HasPadConcat; - [ repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | - autounfold; simpl; intros; try lia; - infer_pad 0%Z 0%Z | - autounfold; simpl; intros; try lia; - infer_pad 0%Z 0%Z | - arith | - arith | - arith | - arith ] ] ] - end with infer_gen left right := - match goal with - | |- has_pad _ _ _ (Gen ?i ?lo ?hi _) (PadCons ?kk ?l ?p1 ?r ?p2 ?cc) => - let kkk := match goal with - | |- _ => let _ := - (* if it's an evar let's instantiate - it as left *) - match goal with _ => is_evar kk end in - constr:(Z.to_nat left) - | |- _ => (* if it's not an evar leave it as is *) - kk - end in - let ccc := match goal with - | |- _ => let _ := - match goal with _ => is_evar cc end in - constr:(Z.to_nat right) - | |- _ => cc - end in - let lll := match goal with - | _ => let _ := - (* if it's an evar *) - match goal with _ => is_evar l end in - match goal with - | _ => - (* and there is no target structure - for the padding within it *) - let _ := - match goal with _ => is_unspec_pad_ty p1 end - in - (* we likely don't care about it *) - constr:(0) - | _ => - (* if there is padding structure try - and give it all of the padding *) - (* TODO: RETURN TO LOOP THROUGH SLICE - POSSIBILITIES *) - constr:(Z.to_nat - (eval_Zexpr_Z_total $0 hi- - eval_Zexpr_Z_total $0 lo)%Z - -kkk) - end - (* if it's not an evar it is what it is *) - | _ => l - end in - let rrr := match goal with - | _ => let _ := - match goal with _ => is_evar r end in - constr:(Z.to_nat - (eval_Zexpr_Z_total $0 hi - - eval_Zexpr_Z_total $0 lo)%Z - -kkk -ccc -lll) - (* if it's not an evar it is what it is *) - | _ => r - end in - (* idtac kkk; idtac lll; idtac rrr; idtac ccc; *) - first [ solve [ eapply HasPadGen with - (k:=kkk) (c:=ccc) (ll:=lll) (rr:=rrr); - [ arith | - arith | - arith | - repeat (econstructor; autounfold; try intros;simpl ); - try list_eq; eauto | - autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | - autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | - autounfold;simpl;intros; - first [ lia|infer_pad 0%Z 0%Z ] | - try (autounfold; simpl; - try first [ lia | reflexivity]) ] ] | - solve [ eapply HasPadGen - with (k:=kkk) (c:=ccc) (ll:=rrr) (rr:=lll); - [ arith | - arith | - arith | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | - autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | - autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | - autounfold;simpl;intros;first [ lia|infer_pad 0%Z 0%Z ] | - try (autounfold; simpl; try first [ lia | reflexivity]) ] - ] ] - | |- has_pad _ _ _ (Gen ?i ?lo ?hi ?e) _ => - (* if it doesn't have any pad type structure all bets are off *) - let kk:= constr:(Z.to_nat left) in - let cc:= constr:(Z.to_nat right) in - let lll := constr:(Z.to_nat (eval_Zexpr_Z_total $0 hi- - eval_Zexpr_Z_total $0 lo)%Z -kk) in - let rrr := constr:(Z.to_nat (eval_Zexpr_Z_total $0 hi - - eval_Zexpr_Z_total $0 lo)%Z - -kk -cc -lll) in - first [ solve [ eapply HasPadGen with - (k:=kk) (c:=cc) (ll:=lll) (rr:=rrr); - [ arith | - arith | - arith | - repeat (econstructor; autounfold; try intros;simpl ); - try list_eq; eauto | - autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | - autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | - autounfold;simpl;intros; - first [ lia|infer_pad 0%Z 0%Z ] | - try (autounfold; simpl; - try first [ lia | reflexivity]) ] ] | - solve [ eapply HasPadGen - with (k:=kk) (c:=cc) (ll:=rrr) (rr:=lll); - [ arith | - arith | - arith | - repeat (econstructor; autounfold; try intros; simpl ); - try list_eq; eauto | - autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | - autounfold; simpl; intros; try lia; infer_pad 0%Z 0%Z | - autounfold;simpl;intros;first [ lia|infer_pad 0%Z 0%Z ] | - try (autounfold; simpl; try first [ lia | reflexivity]) ] - ] ] - end -with infer_flatten left right offset := - match goal with - | |- has_pad _ _ _ (Flatten ?e) (PadCons ?xx ?ll ?p1 ?rr ?p4 ?yy) => - let inner_dim := inner_dim e in - let outer_dim := outer_dim e in - let xxx := match goal with - | |- _ => let _ := match goal with _ => is_evar xx end in - constr:(Z.to_nat left) - | |- _ => xx - end in - let yyy := match goal with - | |- _ => let _ := match goal with _ => is_evar yy end in - constr:(Z.to_nat right) - | |- _ => yy - end in - let aa := constr:(xxx mod Z.to_nat inner_dim) in - let bb := constr:(yyy mod Z.to_nat inner_dim) in - let x_ := constr:(xxx / Z.to_nat inner_dim) in - let y_ := constr:(yyy / Z.to_nat inner_dim) in - let ll := offset in - (* idtac x_; idtac ll; idtac aa; idtac bb; idtac y_; *) - first [ solve [ eapply HasPadFlattenStrong with (b:=bb) (a:=aa) - (x:=x_) (y:=y_) (l:=ll) - (l1:=0) (r1:=0) (c:=0) (l2:=0) (r2:=0) (d:=0); - [ infer_pad x_ y_ | - repeat econstructor; eauto | - arith | arith | arith | arith | arith | arith | arith | - arith | arith ] ] | - solve [ eapply HasPadFlattenStrong with (b:=bb) (a:=aa) - (x:=x_) (y:=y_) (l:=ll) - (l1:=0) (r1:=0) (c:=0); - [ infer_pad x_ y_ | - repeat econstructor; eauto | - arith | arith | arith | arith | arith | arith | arith | - arith | arith ] ] | - solve [ eapply HasPadFlattenStrong with (b:=bb) (a:=aa) - (x:=x_) (y:=y_) (l:=ll); - [ infer_pad x_ y_ | - repeat econstructor; eauto | - arith | arith | arith | arith | arith | arith | arith | - arith | arith ] ] | - solve [ eapply HasPadFlattenStrong with (b:=bb) (a:=aa) - (x:=x_) (y:=y_); - [ infer_pad x_ y_ | - repeat econstructor; eauto | - arith | arith | arith | arith | arith | arith | arith | - arith | arith ] ] | - assert (offset < Z.to_nat outer_dim - x_ - y_) - as Hcheck by (arith; lia); clear Hcheck; - solve [ infer_flatten left right constr:(offset+1) ] - ] -end with infer_transpose left right offset1 offset2 := - match goal with - | |- has_pad _ _ _ (Transpose ?e) ?pi => - is_unspec_pad_ty pi; - solve [ eapply HasPadTransposeWeak; - [ infer_pad 0%Z 0%Z | - repeat econstructor | - arith | - arith | - arith | - arith ] - ] - | |- has_pad _ _ _ (Transpose ?e) - (PadCons ?ll_ ?lll_ ?pi1 ?rrr_ ?pi2 ?rr_) => - let outer_dim := outer_dim e in - let inner_dim := inner_dim e in - let ll' := match goal with - | |- _ => let _ := match goal with _ => is_evar ll_ end in - constr:(Z.to_nat left) - | |- _ => ll_ - end in - let rr' := match goal with - | |- _ => let _ := match goal with _ => is_evar rr_ end in - constr:(Z.to_nat right) - | |- _ => rr_ - end in - let lll':= constr:(Z.to_nat inner_dim - ll' - rr' - offset1) in - let rrr' := offset1 in - let l' := constr:(Z.to_nat outer_dim - offset2) in - let r' := offset2 in - idtac ll'; idtac rr'; idtac lll'; idtac rrr'; - first [ solve [ eapply HasPadTransposeStrong - with (x:=0) (y:=0) (ll:=ll') (rr:=rr') - (lll:=lll') (rrr:=rrr') (l:=l') (r:=r'); - cycle 1; - [ repeat (econstructor; eauto) | - arith | - arith | - arith | - arith | - arith | - autounfold; simpl; intros; arith; try lia; infer_pad 0%Z 0%Z ] ] | - assert (offset2 + 1 <= Z.to_nat outer_dim - ll' - rr') - as Hcheck by (arith; try lia) ; clear Hcheck; - infer_transpose left right offset1 constr:((offset2 + 1)%nat) - ] - end with infer_split left right := - match goal with - | |- has_pad _ _ _ (Split _ _) _ => - eapply HasPadSplit; - [ infer_pad 0%Z 0%Z | - repeat econstructor | - arith | - arith | - arith | - arith ] - end. - -Goal forall v, Common.truncl 3 (GEN [ i < 10 ] (|[ 1 - 2 < m -> - consistent v (n,(m,tt)) -> - blurimmediate_partition n m v = @nil _. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall (A B C D : nat) (m1 m2 : (list (list (list (list R))))), - consistent m1 (8,(8,(8,(8,tt)))) -> - consistent m2 (8,(8,(8,(8,tt)))) -> - add_split 8 8 8 8 m1 m2 = - add 8 8 8 8 m1 m2. -Proof. - autounfold. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall B C K W RR (w : list (list (list R))) (x : list (list (list R))), - (0 < B)%Z -> - (0 < C)%Z -> - (0 < K)%Z -> - (0 < W)%Z -> - (0 < RR)%Z -> - im2col B K W C RR w x = - im2col_lifted B K W C RR w x. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall B C K W RR (w : list (list (list R))) (x : list (list (list R))), - (0 < B)%Z -> - (0 < C)%Z -> - (0 < K)%Z -> - (0 < W)%Z -> - (0 < RR)%Z -> - im2col_lifted B K W C RR w x = im2col B K W C RR w x. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall (W C B K : Z) (x w : list (list (list R))) (RR : Z) (a b :nat), - consistent w (a,(b,(Z.to_nat RR, tt))) -> - (0 < C)%Z -> - (0 < W)%Z -> - (W <=C)%Z -> - (0 < K)%Z -> - (0 < RR)%Z -> - (0 < B)%Z -> - scatter_full B K W C x w = gather_full W C B K x w RR. -Proof. - intros. unfold scatter_full. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall (W C B K : Z) (x w : list (list (list R))) (RR : Z) (a b :nat), - consistent w (a,(b,(Z.to_nat RR, tt))) -> - (0 < C)%Z -> - (0 < W)%Z -> - (W <=C)%Z -> - (0 < K)%Z -> - (0 < RR)%Z -> - (0 < B)%Z -> - gather_full W C B K x w RR = scatter_full B K W C x w. -Proof. - intros. unfold gather_full. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall (A B C : nat) (m1 m2 : (list (list R))) (k : Z), - (0 < k)%Z -> - 0 < A -> - 0 < B -> - 0 < C -> - consistent m1 (64,(64,tt)) -> - consistent m2 (64,(64,tt)) -> - matmul_tiled_split 64 64 64 m1 m2 4 = - matmul 64 64 64 m1 m2. -Proof. - autounfold with examples. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall n m (l : list (list R)), - 0 < n -> - 0 < m -> - consistent l (n,(m,tt)) -> - blur_tiles_guarded l 64 64 4 4 = @nil _. -Proof. - autounfold. unfold blur_tiles_guarded. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - eexists. - { infer_pad 0%Z 0%Z. (* Takes ~10m to run *) } -Abort. - -Goal forall n m (v : list (list R)), - 2 < n -> - 2 < m -> - consistent v (n,(m,tt)) -> - blurimmediate_isolate n m v = @nil _. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_concat 0%Z 0%Z. } -Abort. - -Goal forall N M (v : list (list R)), - 2 < N -> - 2 < M -> - consistent v (N,(M,tt)) -> - blurtwostage_partition N M v = @nil _. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall v, Common.truncl 3 (GEN [ i < 10 ] (|[ 2 - 0 < M -> - consistent v (N,(M,tt)) -> - blurimmediate v M N = blurtwostage N M v. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall N M (v : list (list R)), - 0 < N -> - 0 < M -> - consistent v (N,(M,tt)) -> - blurtwostage N M v = blurimmediate v M N. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall n m (l : list (list R)), - 0 < n -> - 0 < m -> - consistent l (n,(m,tt)) -> - fusion_no_boundary n m l - = @nil _. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall W R0 (x w : list R), - consistent w (Z.to_nat R0, tt) -> - consistent x (Z.to_nat R0, tt) -> - (0 < W)%Z -> - (Z.of_nat (length x) < W)%Z -> - GatherScatter.gather W x w = @nil _. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall W R0 (x w : list R), - consistent w (Z.to_nat R0, tt) -> - consistent x (Z.to_nat R0, tt) -> - (0 < W)%Z -> - (Z.of_nat (length x) < W)%Z -> - GatherScatter.scatter W x w = @nil _. -Proof. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall (A B C D : nat) (m1 m2 : (list (list (list (list R))))), - 0 < A -> - 0 < B -> - 0 < C -> - 0 < D -> - consistent m1 (A,(B,(C,(D,tt)))) -> - consistent m2 (A,(B,(C,(D,tt)))) -> - add (Z.of_nat A) (Z.of_nat B) (Z.of_nat C) (Z.of_nat D) m1 m2 = - add_split A B C D m1 m2. -Proof. - autounfold. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall (A B C : nat) (m1 m2 : (list (list R))) (k : Z), - (0 < k)%Z -> - 0 < A -> - 0 < B -> - 0 < C -> - consistent m1 (A,(B,tt)) -> - consistent m2 (B,(C,tt)) -> - matmul (Z.of_nat A) (Z.of_nat B) (Z.of_nat C) m1 m2 = - matmul_tiled A B C m1 m2 k. -Proof. - autounfold with examples. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - eexists. { infer_pad 0%Z 0%Z. } -Abort. - -Goal forall (A B C : nat) (m1 m2 : (list (list R))) (k : Z), - (0 < k)%Z -> - 0 < A -> - 0 < B -> - 0 < C -> - consistent m1 (64,(64,tt)) -> - consistent m2 (64,(64,tt)) -> - matmul_tiled 64 64 64 m1 m2 4 = - matmul 64 64 64 m1 m2. -Proof. - autounfold with examples. - let ast := R in - assert (exists pad, has_pad $0 $0 $0 ast pad). - eexists. { infer_pad 0%Z 0%Z. } -Abort. - diff --git a/src/verified_lowering/proof/Injective.v b/src/verified_lowering/proof/Injective.v index 9bc83a0..a121000 100644 --- a/src/verified_lowering/proof/Injective.v +++ b/src/verified_lowering/proof/Injective.v @@ -78,7 +78,7 @@ Qed. Fixpoint list_vars_of_index idx := match idx with | (a,b)::idx' => vars_of_Zexpr a ++/ vars_of_Zexpr b ++/ - list_vars_of_index idx' + list_vars_of_index idx' | _ => [] end. @@ -122,17 +122,6 @@ Proof. f_equal. eauto. Qed. -Lemma filter_ext_weak : - forall [A : Type] (f g : A -> bool), forall l, - (forall a : A, In a l -> f a = g a) -> filter f l = filter g l. -Proof. - induct l; intros. - - reflexivity. - - simpl. pose proof (H a). simpl in *. - rewrite H by auto. - cases (g a). f_equal. eauto. eauto. -Qed. - Lemma partially_eval_Z_tup_subst_var_in_Zexpr_remove : forall v a z, v $? a = Some z -> @@ -159,21 +148,21 @@ Proof. induct l; intros. - reflexivity. - simpl. f_equal. 2: eauto. - rewrite subst_var_in_Z_tup_id. reflexivity. - unfold subst_var_in_Z_tup. simpl. - rewrite vars_of_Zexpr_subst_var_in_Zexpr. - unfold not. intros. eapply filter_In in H. - rewrite String.eqb_refl in H. simpl in *. invert H. discriminate. - - unfold subst_var_in_Z_tup. simpl. - rewrite vars_of_Zexpr_subst_var_in_Zexpr. - unfold not. intros. eapply filter_In in H. - rewrite String.eqb_refl in H. simpl in *. invert H. discriminate. + rewrite subst_var_in_Z_tup_id. + + reflexivity. + + unfold subst_var_in_Z_tup. simpl. + rewrite vars_of_Zexpr_subst_var_in_Zexpr. + unfold not. intros. eapply filter_In in H. + rewrite String.eqb_refl in H. simpl in *. invert H. discriminate. + + unfold subst_var_in_Z_tup. simpl. + rewrite vars_of_Zexpr_subst_var_in_Zexpr. + unfold not. intros. eapply filter_In in H. + rewrite String.eqb_refl in H. simpl in *. invert H. discriminate. Qed. Lemma eq_partial_interpret_reindexer_split : - forall reindexer k n l0 z0 v args1, - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> + forall reindexer k kz n l0 z0 v args1, + eval_Zexpr $0 k kz -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> @@ -186,11 +175,10 @@ Lemma eq_partial_interpret_reindexer_split : (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - (0 <= eval_Zexpr_Z_total $0 n)%Z -> - (0 < eval_Zexpr_Z_total $0 k)%Z -> + (0 < kz)%Z -> In args1 - (mesh_grid (map Z.of_nat (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) -> - (0 <= z0 < Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 n)))%Z -> + (mesh_grid (map Z.of_nat l0)) -> + (0 <= z0 < Z.of_nat n)%Z -> partial_interpret_reindexer (fun l2 : list (Zexpr * Zexpr) => reindexer @@ -199,35 +187,29 @@ partial_interpret_reindexer | (v0, d) :: xs => ((v0 / k)%z, (d // k)%z) :: ((ZMod v0 k)%z, k) :: xs end) (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) 0)) v + (filter_until (n :: l0) 0)) v (z0 :: args1) = partial_interpret_reindexer reindexer (map Z.of_nat (filter_until - ( Z.to_nat ((eval_Zexpr_Z_total $0 n) // (eval_Zexpr_Z_total $0 k)) - :: Z.to_nat (eval_Zexpr_Z_total $0 k) ::map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v - ((z0 / eval_Zexpr_Z_total $0 k)%Z :: (Stdlib.ZArith.BinIntDef.Z.modulo z0 (eval_Zexpr_Z_total $0 k)) :: args1). + (n //n (Z.to_nat kz) :: Z.to_nat kz :: l0) 0)) v + ((z0 / kz)%Z :: (Stdlib.ZArith.BinIntDef.Z.modulo z0 kz) :: args1). Proof. - intros ? ? ? ? ? ? ? Heqk Hvar HeqZlistwrap Hvarsub Hmap - Hvarrdx Hmnonneg Hknonneg Harg Hle. + intros ? ? ? ? ? ? ? ? Hk Hvar HeqZlistwrap Hvarsub Hmap + Hvarrdx Hknonneg Harg Hle. unfold partial_interpret_reindexer. unfold shape_to_vars in *. simpl. - rewrite Z2Nat_div_distr in * by lia. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n)). + cases n. { lia. } - cases (Datatypes.S n0 //n (Z.to_nat (eval_Zexpr_Z_total $0 k))). - { exfalso. unfold div_ceil_n in Heq0. simpl in *. rewrite Nat.sub_0_r in *. - replace (Z.to_nat (eval_Zexpr_Z_total $0 k)) - with (1*Z.to_nat (eval_Zexpr_Z_total $0 k)) in Heq0 at 1 by lia. - rewrite Nat.add_comm in Heq0. - rewrite Nat.div_add_l in Heq0 by lia. lia. + cases (Datatypes.S n //n (Z.to_nat kz)). + { exfalso. unfold div_ceil_n in Heq. simpl in *. rewrite Nat.sub_0_r in *. + replace (Z.to_nat kz) with (1*Z.to_nat kz) in Heq at 1 by lia. + rewrite Nat.add_comm in Heq. + rewrite Nat.div_add_l in Heq by lia. lia. } - simpl. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 k))%nat). lia. + simpl. + cases (Z.to_nat kz). lia. simpl. posnats. repeat rewrite shape_to_index_cons. posnats. simpl. @@ -239,7 +221,7 @@ Proof. repeat rewrite map_subst_var_in_Z_tup_combine_not_in; eauto with reindexers. unfold subst_var_in_Z_tup. simpl. rewrite subst_var_in_Zexpr_id. - 2: { unfold eq_zexpr in *. invs. rewrite H2. sets. } + 2: { apply eval_Zexpr_vars_empty in Hk. rewrite Hk. auto. } erewrite index_to_partial_function_subst_vars. 2: { eauto with reindexers. } 2: { rewrite length_map. rewrite length_map. @@ -267,11 +249,11 @@ Proof. simpl. repeat rewrite fold_left_subst_var_in_Z_tup_ZLit. rewrite fold_left_subst_var_in_Z_tup_id. - 2: { simpl. invert Heqk. rewrite H0. sets. } - 2: { simpl. invert Heqk. rewrite H0. sets. } + 2: { simpl. erewrite eval_Zexpr_vars_empty by eassumption. reflexivity. } + 2: { simpl. erewrite eval_Zexpr_vars_empty by eassumption. reflexivity. } rewrite fold_left_subst_var_in_Z_tup_id. - 2: { simpl. invert Heqk. rewrite H0. sets. } - 2: { simpl. invert Heqk. rewrite H0. sets. } + 2: { simpl. erewrite eval_Zexpr_vars_empty by eassumption. reflexivity. } + 2: { simpl. erewrite eval_Zexpr_vars_empty by eassumption. reflexivity. } rewrite map_fold_left_subst_var_in_Z_tup_shape_to_index. 2: { rewrite length_map. rewrite length_map. rewrite length_nat_range_rec. @@ -297,14 +279,15 @@ Proof. eapply eq_zexpr_transitivity. eapply eq_zexpr_div. eapply eq_zexpr_id. auto. - eapply Heqk. - eapply eq_zexpr_div_literal. posnats. rewrite <- Heq0. + apply eval_empty_eq_zexpr. eassumption. + eapply eq_zexpr_div_literal. posnats. rewrite <- Heq. rewrite <- of_nat_div_distr. eapply eq_zexpr_comm. eapply eq_zexpr_transitivity. eapply eq_zexpr_divc. - eapply eq_zexpr_id. auto. eapply Heqk. - rewrite <- Heq. rewrite <- Heq1. + eapply eq_zexpr_id. auto. + apply eval_empty_eq_zexpr. eassumption. + rewrite <- Heq0. repeat rewrite Z2Nat.id by lia. eapply eq_zexpr_divc_literal. erewrite <- eq_Z_tuple_index_list_cons. @@ -312,9 +295,11 @@ Proof. 2: { eapply eq_Z_tuple_index_list_id. } unfold eq_Z_tup. simpl. split. eapply eq_zexpr_comm. eapply eq_zexpr_transitivity. - eapply eq_zexpr_mod. eauto. apply Heqk. - eapply eq_zexpr_mod_literal. posnats. rewrite <- Heq1. - rewrite Z2Nat.id by lia. eapply eq_zexpr_comm. eauto. + eapply eq_zexpr_mod. eauto. + apply eval_empty_eq_zexpr. eassumption. + eapply eq_zexpr_mod_literal. posnats. rewrite <- Heq0. + rewrite Z2Nat.id by lia. eapply eq_zexpr_comm. + apply eval_empty_eq_zexpr. eassumption. Qed. Lemma eq_partial_interpret_reindexer_shift_top_dim_reindexer : @@ -379,8 +364,8 @@ Proof. Qed. Lemma eq_partial_interpret_reindexer_padl : - forall reindexer k m l0 z v x1, - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> + forall reindexer k kz m l0 z v x1, + eval_Zexpr $0 k kz -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> @@ -393,8 +378,8 @@ Lemma eq_partial_interpret_reindexer_padl : (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - (0 < eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + (0 < m) -> + (0 <= kz)%Z -> partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => reindexer @@ -403,26 +388,19 @@ Lemma eq_partial_interpret_reindexer_padl : | (v0, d) :: xs => ((v0 + k)%z, (d + k)%z) :: xs end) (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v + (filter_until (m :: l0) 0)) v (z :: x1) = partial_interpret_reindexer reindexer (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 k) + - Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v - ((z + eval_Zexpr_Z_total $0 k)%Z :: x1). + (filter_until (Z.to_nat kz + m :: l0) 0)) v + ((z + kz)%Z :: x1). Proof. - intros ? ? ? ? ? ? ? Heqk Hvar HeqZlistwrap Hvarsub Hmap + intros ? ? ? ? ? ? ? ? Hk Hvar HeqZlistwrap Hvarsub Hmap Hvarrdx Hmnonneg Hknonneg. unfold partial_interpret_reindexer. unfold shape_to_vars in *. simpl. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 m))%nat). lia. + cases m. lia. simpl. rewrite Nat.add_succ_r in *. simpl shape_to_index at 1. @@ -436,7 +414,7 @@ Proof. rewrite map_subst_var_in_Z_tup_combine_not_in; eauto with reindexers. unfold subst_var_in_Z_tup. simpl. rewrite subst_var_in_Zexpr_id. - 2: { unfold eq_zexpr in *. invs. rewrite H0. sets. } + 2: { erewrite eval_Zexpr_vars_empty by eassumption. auto. } erewrite eq_index_to_partial_function. reflexivity. eapply eq_Z_tuple_index_list_partially_eval_Z_tup. eapply HeqZlistwrap. @@ -448,20 +426,20 @@ Proof. eapply eq_zexpr_transitivity. eapply eq_zexpr_add. eapply eq_zexpr_id. auto. - eapply Heqk. + apply eval_empty_eq_zexpr. eassumption. eapply eq_zexpr_add_literal. eapply eq_zexpr_transitivity. eapply eq_zexpr_add. eapply eq_zexpr_id. auto. - eapply Heqk. + apply eval_empty_eq_zexpr. eassumption. eapply eq_zexpr_transitivity. eapply eq_zexpr_add_literal. eapply eq_zexpr_id. f_equal. lia. Qed. Lemma eq_partial_interpret_reindexer_truncl : - forall reindexer k m l0 z v x1, - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> + forall reindexer k kz m l0 z v x1, + eval_Zexpr $0 k kz -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> @@ -474,9 +452,8 @@ Lemma eq_partial_interpret_reindexer_truncl : (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - (0 <= eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> - (0 < eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k)%Z -> + (0 <= kz)%Z -> + (0 < Z.of_nat m - kz)%Z -> partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => reindexer @@ -485,34 +462,26 @@ Lemma eq_partial_interpret_reindexer_truncl : | (v0, d) :: xs => ((v0 - k)%z, (d - k)%z) :: xs end) (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v - ((z + eval_Zexpr_Z_total $0 k)%Z :: x1) = + (filter_until (m :: l0) 0)) v + ((z + kz)%Z :: x1) = partial_interpret_reindexer reindexer (map Z.of_nat (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v + (m - Z.to_nat kz :: l0) 0)) v (z :: x1). Proof. - intros ? ? ? ? ? ? ? Heqk Hvar HeqZlistwrap Hvarsub Hmap - Hvarrdx Hmnonneg Hknonneg Htruncnonneg. + intros ? ? ? ? ? ? ? ? Hk Hvar HeqZlistwrap Hvarsub Hmap + Hvarrdx Hknonneg Htruncnonneg. { unfold partial_interpret_reindexer. unfold shape_to_vars in *. simpl. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 m))%nat). lia. + cases m. lia. simpl shape_to_index at 1. rewrite shape_to_index_cons. simpl nat_range at 1. posnats. - rewrite <- Heq in *. - simpl. clear Heq. clear n. + cbn -[Nat.sub]. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)). lia. + cases (Datatypes.S m - Z.to_nat kz). lia. simpl. posnats. rewrite <- Heq in *. clear Heq. clear n. repeat rewrite index_to_partial_function_vars_cons; eauto with reindexers. rewrite shape_to_index_cons. @@ -520,35 +489,35 @@ Proof. repeat rewrite map_cons. repeat rewrite map_subst_var_in_Zexpr_shape_to_index_id; eauto with reindexers. - unfold subst_var_in_Z_tup. simpl. + unfold subst_var_in_Z_tup. cbn -[Nat.sub]. rewrite subst_var_in_Zexpr_id. - 2: { unfold eq_zexpr in *. invs. rewrite H0. sets. } + 2: { erewrite eval_Zexpr_vars_empty by eassumption. auto. } erewrite eq_index_to_partial_function. reflexivity. eapply eq_Z_tuple_index_list_partially_eval_Z_tup. eapply HeqZlistwrap. erewrite <- eq_Z_tuple_index_list_cons. split. 2: eapply eq_Z_tuple_index_list_id. - unfold eq_Z_tup. simpl. propositional. + unfold eq_Z_tup. cbn -[Nat.sub]. propositional. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply Heqk. + apply eval_empty_eq_zexpr. eassumption. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_literal. eapply eq_zexpr_id. f_equal. lia. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply Heqk. + apply eval_empty_eq_zexpr. eassumption. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_literal. eapply eq_zexpr_id. f_equal. lia. } Qed. Lemma eq_partial_interpret_reindexer_truncr : - forall reindexer k m l0 z0 args1 v, - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> + forall reindexer k kz m l0 z0 args1 v, + eval_Zexpr $0 k kz -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> @@ -561,9 +530,8 @@ Lemma eq_partial_interpret_reindexer_truncr : (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - (0 <= eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> - (0 < eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k)%Z -> + (0 <= kz)%Z -> + (0 < Z.of_nat m - kz)%Z -> partial_interpret_reindexer (fun l1 : list (Zexpr * Zexpr) => reindexer @@ -572,94 +540,70 @@ Lemma eq_partial_interpret_reindexer_truncr : | (v0, d) :: xs => (v0, (d - k)%z) :: xs end) (map Z.of_nat - (filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) 0)) v + (filter_until (m :: l0) 0)) v (z0 :: args1) = partial_interpret_reindexer reindexer (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) 0)) v + (filter_until (m - Z.to_nat kz :: l0) 0)) v (z0 :: args1). Proof. - intros ? ? ? ? ? ? ? Heqk Hvar HeqZlistwrap Hvarsub Hmap - Hvarrdx Hmnonneg Hknonneg Htruncnonneg. + intros ? ? ? ? ? ? ? ? Hk Hvar HeqZlistwrap Hvarsub Hmap + Hvarrdx Hknonneg Htruncnonneg. { unfold partial_interpret_reindexer. unfold shape_to_vars in *. simpl. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 m))%nat). lia. + cases m. lia. simpl shape_to_index at 1. rewrite shape_to_index_cons. simpl nat_range at 1. posnats. - rewrite <- Heq in *. - simpl. clear Heq. clear n. + cbn -[Nat.sub]. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)). lia. - simpl. posnats. rewrite <- Heq in *. clear Heq. clear n. + cases (Datatypes.S m - Z.to_nat kz). lia. + cbn -[Nat.sub shape_to_index]. posnats. rewrite <- Heq in *. clear Heq. clear n. repeat rewrite index_to_partial_function_vars_cons; eauto with reindexers. rewrite shape_to_index_cons. repeat rewrite Hmap; eauto with reindexers. repeat rewrite map_cons. repeat rewrite map_subst_var_in_Zexpr_shape_to_index_id; eauto with reindexers. - unfold subst_var_in_Z_tup. simpl. + unfold subst_var_in_Z_tup. cbn -[Nat.sub]. rewrite subst_var_in_Zexpr_id. - 2: { unfold eq_zexpr in *. invs. rewrite H0. sets. } + 2: { erewrite eval_Zexpr_vars_empty by eassumption. auto. } erewrite eq_index_to_partial_function. reflexivity. eapply eq_Z_tuple_index_list_partially_eval_Z_tup. eapply HeqZlistwrap. erewrite <- eq_Z_tuple_index_list_cons. split. 2: eapply eq_Z_tuple_index_list_id. - unfold eq_Z_tup. simpl. propositional. + unfold eq_Z_tup. cbn -[Nat.sub]. propositional. eauto. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eauto. - eapply Heqk. + apply eval_empty_eq_zexpr. eassumption. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_literal. eapply eq_zexpr_id. f_equal. lia. } Qed. Lemma partial_injective_padl : - forall reindexer m l0 k v x0, + forall reindexer m l0 k kz v x0, partial_injective (partial_interpret_reindexer reindexer - (result_shape_Z - (V (repeat - (gen_pad - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - ++ x0))) v) + (result_shape_Z (V (repeat (gen_pad l0) (Z.to_nat kz) ++ x0))) v) (filter (fun x => negb (is_None (result_lookup_Z_option x - (V (repeat - (gen_pad - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - ++ x0))))) + (V (repeat (gen_pad l0) (Z.to_nat kz) ++ x0))))) (mesh_grid (result_shape_Z - (V (repeat - (gen_pad - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - ++ x0))))) -> + (V (repeat (gen_pad l0) (Z.to_nat kz) ++ x0))))) -> result_has_shape - (V x0) (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + (V x0) (m :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - eq_zexpr k (| (eval_Zexpr_Z_total $0 k) |)%z -> - eq_zexpr m (| (eval_Zexpr_Z_total $0 m) |)%z -> + eval_Zexpr $0 k kz -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -671,8 +615,8 @@ Lemma partial_injective_padl : (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - (0 < eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + (0 < m) -> + (0 <= kz)%Z -> partial_injective (partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => @@ -682,20 +626,15 @@ Lemma partial_injective_padl : | (v0, d) :: xs => ((v0 + k)%z, (d + k)%z) :: xs end) (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v) + (filter_until (m :: l0) 0)) v) (filter (fun x1 => negb (is_None (result_lookup_Z_option x1 (V x0)))) (mesh_grid (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))). + (filter_until (m :: l0) 0)))). Proof. - intros ? ? ? ? ? ? Hinj Hsh Hvar Hk Hm HeqZwraplist Hvarsub Hmap + intros ? ? ? ? ? ? ? Hinj Hsh Hvar Hk HeqZwraplist Hvarsub Hmap Hvarrdx Hmnonneg Hknonneg. simpl in Hsh. erewrite result_has_shape_result_shape_Z in *. @@ -703,37 +642,26 @@ Proof. eapply result_has_shape_repeat_gen_pad. eauto. } unfold partial_injective. propositional. repeat decomp_index. - simpl. cases (Z.to_nat (eval_Zexpr_Z_total $0 m)); simpl; try lia. + simpl. cases m; simpl; try lia. posnats. - rewrite <- Heq in *. rewrite <- map_cons. rewrite <- filter_until_0_cons by lia. - rewrite <- Z2Nat.inj_add in Hinj by lia. - rewrite <- map_cons. - rewrite <- eval_Zexpr_Z_total_add_distr in *; eauto. repeat rewrite <- map_cons in Hinj. pose proof filter_pad_l_mesh_grid. simpl gen_pad_list in H2. repeat rewrite map_cons in H2. rewrite H2 in Hinj. 2: { simpl. - rewrite eval_Zexpr_Z_total_add_distr; eauto. - rewrite Z2Nat.inj_add by lia. eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. auto. } erewrite eq_partial_interpret_reindexer_padl in H1; eauto. erewrite eq_partial_interpret_reindexer_padl in H1; eauto. clear H2. - repeat rewrite map_cons in Hinj. - rewrite eval_Zexpr_Z_total_add_distr in *; eauto. - rewrite Z2Nat.inj_add in Hinj by lia. - eapply Hinj in H1. propositional. invert H. left. f_equal. lia. - rewrite map_cons. erewrite eq_partial_interpret_reindexer_padl; eauto. eapply in_map_iff. @@ -754,7 +682,7 @@ Proof. Qed. Lemma partial_injective_truncl : - forall reindexer m l0 k v x0, + forall reindexer m l0 k kz v x0, partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V x0)) v) (filter @@ -763,12 +691,10 @@ Lemma partial_injective_truncl : result_has_shape (V (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) ++ x0)) - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + (Z.to_nat kz :: l0) ++ x0)) + (m :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> + eval_Zexpr $0 k kz -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -780,9 +706,8 @@ Lemma partial_injective_truncl : (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - (0 <= eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> - (0 < eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k)%Z -> + (0 <= kz)%Z -> + (0 < Z.of_nat m - kz)%Z -> partial_injective (partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => @@ -792,15 +717,12 @@ Lemma partial_injective_truncl : | (v0, d) :: xs => ((v0 - k)%z, (d - k)%z) :: xs end) (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v) + (filter_until (m :: l0) 0)) v) (map (fun l : list Z => match l with | [] => l - | x1 :: xs => (x1 + eval_Zexpr_Z_total $0 k)%Z :: xs + | x1 :: xs => (x1 + kz)%Z :: xs end) (filter (fun x1 => negb @@ -808,13 +730,11 @@ Lemma partial_injective_truncl : (mesh_grid (map Z.of_nat (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) 0))))) + (m - Z.to_nat kz :: l0) 0))))) . Proof. - intros ? ? ? ? ? ? Hinj Hsh Hvar Hk HeqZwraplist Hvarsub Hmap - Hvarrdx Hmnonneg Hknonneg Hmknonneg. + intros ? ? ? ? ? ? ? Hinj Hsh Hvar Hk HeqZwraplist Hvarsub Hmap + Hvarrdx Hknonneg Hmknonneg. simpl in Hsh. erewrite result_has_shape_result_shape_Z in *. 2: { eapply result_has_shape_app_l. @@ -823,9 +743,8 @@ Proof. eapply in_map_iff in H,H0. invs. repeat decomp_index. - simpl. cases (Z.to_nat (eval_Zexpr_Z_total $0 m)); simpl; try lia. + simpl. cases m; simpl; try lia. posnats. - rewrite <- Heq in *. rewrite <- map_cons. rewrite <- filter_until_0_cons. erewrite eq_partial_interpret_reindexer_truncl in H1; eauto. @@ -843,34 +762,20 @@ Proof. Qed. Lemma partial_injective_truncr : - forall reindexer x0 m l0 k v, + forall reindexer x0 m l0 k kz v, partial_injective (partial_interpret_reindexer reindexer (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v) + (filter_until (m - Z.to_nat kz :: l0) 0)) v) (filter (fun x => negb (is_None (result_lookup_Z_option x (V x0)))) (mesh_grid (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))) -> - result_has_shape - (V - (x0 ++ - repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))) - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + (filter_until (m - Z.to_nat kz :: l0) 0)))) -> + result_has_shape (V (x0 ++ repeat (gen_pad l0) (Z.to_nat kz))) (m :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> + eval_Zexpr $0 k kz -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -882,9 +787,8 @@ Lemma partial_injective_truncr : (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - (0 <= eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> - (0 < eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k)%Z -> + (0 <= kz)%Z -> + (0 < Z.of_nat m - kz)%Z -> partial_injective (partial_interpret_reindexer (fun l3 : list (Zexpr * Zexpr) => @@ -894,34 +798,29 @@ Lemma partial_injective_truncr : | (v0, d) :: xs => (v0, (d - k)%z) :: xs end) (map Z.of_nat - (filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) 0)) v) + (filter_until (m :: l0) 0)) v) (filter (fun x1 => negb (is_None (result_lookup_Z_option x1 (V x0)))) (mesh_grid (map Z.of_nat (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))). + (m - Z.to_nat kz :: l0) 0)))). Proof. - intros ? ? ? ? ? ? Hinj Hsh Hvar Hk HeqZwraplist Hvarsub Hmap - Hvarrdx Hmnonneg Hknonneg Hmknonneg. + intros ? ? ? ? ? ? ? Hinj Hsh Hvar Hk HeqZwraplist Hvarsub Hmap + Hvarrdx Hknonneg Hmknonneg. unfold partial_injective. propositional. repeat decomp_index. - simpl. cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). lia. + simpl. cases m. lia. simpl. posnats. erewrite eq_partial_interpret_reindexer_truncr in H1; eauto. erewrite eq_partial_interpret_reindexer_truncr in H1; eauto. - rewrite <- Heq in *. eapply Hinj in H1. propositional. repeat rewrite <- map_cons. rewrite <- filter_until_0_cons by lia. repeat rewrite <- map_cons. - rewrite eq_partial_interpret_reindexer_truncr; eauto. + erewrite eq_partial_interpret_reindexer_truncr; eauto. eapply filter_In. propositional. repeat decomp_goal_index. @@ -953,8 +852,8 @@ Lemma eq_partial_interpret_reindexer_eval_0 : ~ i \in dom v -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> ~ In i (shape_to_vars (result_shape_Z r)) -> - eq_zexpr lo (|loz|)%z -> - eq_zexpr hi (|hiz|)%z -> + eval_Zexpr $0 lo loz -> + eval_Zexpr $0 hi hiz -> (hiz - loz)%Z = Z.of_nat (Datatypes.length (r::r0)) -> partial_interpret_reindexer (fun l0 : list (Zexpr * Zexpr) => @@ -1021,9 +920,9 @@ Proof. 2: { reflexivity. } rewrite subst_var_in_Zexpr_id. - 2: { invert Hlo. rewrite H0. sets. } + 2: { erewrite eval_Zexpr_vars_empty by eassumption. auto. } rewrite subst_var_in_Zexpr_id. - 2: { invert Hhi. rewrite H0. sets. } + 2: { erewrite eval_Zexpr_vars_empty by eassumption. auto. } erewrite index_to_partial_function_subst_vars; unfold nat_range; eauto with reindexers. @@ -1048,7 +947,7 @@ Proof. 2: unfold shape_to_vars; unfold nat_range; rewrite length_map; rewrite length_nat_range_rec; lia. rewrite fold_left_subst_var_in_Z_tup_id. - 2: { simpl. invert Hlo. rewrite H0. sets. } + 2: { simpl. erewrite eval_Zexpr_vars_empty by eassumption. auto. } erewrite eq_index_to_partial_function. reflexivity. eapply eq_Z_tuple_index_list_partially_eval_Z_tup. @@ -1058,25 +957,27 @@ Proof. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. - eapply eq_zexpr_id. eauto. eauto. + eapply eq_zexpr_id. reflexivity. apply eval_empty_eq_zexpr. eassumption. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_literal. eapply eq_zexpr_id. f_equal. lia. split. eapply eq_zexpr_transitivity. - eapply eq_zexpr_sub. eauto. eauto. + eapply eq_zexpr_sub. + apply eval_empty_eq_zexpr. eassumption. + apply eval_empty_eq_zexpr. eassumption. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_literal. eapply eq_zexpr_id. f_equal. simpl in *. lia. eapply eq_Z_tuple_index_list_id. - simpl. invert Hlo. invert Hhi. rewrite H0,H2. reflexivity. + simpl. do 2 erewrite eval_Zexpr_vars_empty by eassumption. reflexivity. eapply no_dup_var_generation. auto. Qed. Lemma partial_injective_cons_reindexer : - forall reindexer r r0 v i hi lo, + forall reindexer r r0 v i hi hiz lo loz, result_has_shape (V (r :: r0)) (result_shape_nat (V (r :: r0))) -> partial_injective (partial_interpret_reindexer @@ -1099,15 +1000,15 @@ Lemma partial_injective_cons_reindexer : ~ i \in dom v -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> ~ In i (shape_to_vars (result_shape_Z r)) -> - eq_zexpr lo (| eval_Zexpr_Z_total $0 lo |)%z -> - eq_zexpr hi (| eval_Zexpr_Z_total $0 hi |)%z -> - (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)%Z = + eval_Zexpr $0 lo loz -> + eval_Zexpr $0 hi hiz -> + (hiz - loz)%Z = Z.of_nat (Datatypes.length (r::r0)) -> partial_injective (partial_interpret_reindexer (fun l0 : list (Zexpr * Zexpr) => reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l0)) - (result_shape_Z r) (v $+ (i, eval_Zexpr_Z_total $0 lo))) + (result_shape_Z r) (v $+ (i, loz))) (filter (fun x => negb (is_None (result_lookup_Z_option x r))) @@ -1122,7 +1023,7 @@ Proof. (fun l0 : list (Zexpr * Zexpr) => reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l0)) (map Z.of_nat (filter_until (result_shape_nat r) 0)) - (v $+ (i, eval_Zexpr_Z_total $0 lo)) args1). + (v $+ (i, loz)) args1). + left. assert (0%Z::args1 = 0%Z::args2 -> args1 = args2). inversion 1. auto. @@ -1368,9 +1269,9 @@ Proof. Qed. Lemma constant_partial_reindexer_subseteq : - forall r r0 reindexer lo hi i v, - eq_zexpr lo (| eval_Zexpr_Z_total $0 lo |)%z -> - eq_zexpr hi (| eval_Zexpr_Z_total $0 hi |)%z -> + forall r r0 reindexer lo loz hi hiz i v, + eval_Zexpr $0 lo loz -> + eval_Zexpr $0 hi hiz -> (forall (var : var) (k : Z) (l : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> map (subst_var_in_Z_tup var k) (reindexer l) = @@ -1378,7 +1279,7 @@ Lemma constant_partial_reindexer_subseteq : (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> - (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)%Z = + (hiz - loz)%Z = Z.of_nat (Datatypes.S (Datatypes.length r0)) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> vars_of_reindexer (reindexer []) \subseteq dom v -> @@ -1399,7 +1300,7 @@ Lemma constant_partial_reindexer_subseteq : (fun l0 : list (Zexpr * Zexpr) => reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l0)) (result_shape_Z r) - (v $+ (i, eval_Zexpr_Z_total $0 lo))) + (v $+ (i, loz))) (filter (fun x0 : list Z => negb (is_None (result_lookup_Z_option x0 r))) @@ -1713,14 +1614,11 @@ Proof. eapply in_mesh_grid_cons__ in H. eapply in_mesh_grid_cons__ in H0. invert H. invert H0. invert H1. - cases sh. - + simpl in *. propositional. subst. f_equal. auto. - + simpl in H5. - repeat rewrite (Z.mul_comm _ (fold_left _ _ _)) in H5. - eapply Z.div_mod_unique in H5. invert H5. - f_equal. auto. - eapply in_mesh_grid_args_flatten_bounds. eassumption. - eapply in_mesh_grid_args_flatten_bounds. eassumption. + repeat rewrite (Z.mul_comm _ (fold_left _ _ _)) in H5. + eapply Z.div_mod_unique in H5. invert H5. + f_equal. auto. + eapply in_mesh_grid_args_flatten_bounds. eassumption. + eapply in_mesh_grid_args_flatten_bounds. eassumption. Qed. Lemma injective_index_to_partial_function_ZLit : @@ -1854,11 +1752,10 @@ Lemma eq_partial_interpret_reindexer_transpose : (var \in vars_of_reindexer (reindexer []) -> False) -> map (subst_var_in_Z_tup var k) (reindexer l) = reindexer (map (subst_var_in_Z_tup var k) l)) -> - (0 <= z < Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m0)))%Z -> - (0 <= z0 < Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 n0)))%Z -> + (0 <= z < Z.of_nat m0)%Z -> + (0 <= z0 < Z.of_nat n0)%Z -> In x - (mesh_grid (map Z.of_nat - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) -> + (mesh_grid (map Z.of_nat l0)) -> partial_interpret_reindexer (fun l4 : list (Zexpr * Zexpr) => reindexer @@ -1868,24 +1765,17 @@ Lemma eq_partial_interpret_reindexer_transpose : | (v0, d) :: (vi, di) :: xs => (vi, di) :: (v0, d) :: xs end) (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) 0)) v - (z0 :: z :: x) = + (filter_until (n0 :: m0 :: l0) 0)) v (z0 :: z :: x) = partial_interpret_reindexer reindexer (map Z.of_nat (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) 0)) v - (z :: z0 :: x). + (m0 :: n0 :: l0) 0)) v (z :: z0 :: x). Proof. intros ? ? ? ? ? ? ? ? Henv HeqZlist Hvarsub Hmap Hzlim Hz0lim Hx. unfold partial_interpret_reindexer. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n0)). lia. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m0)). lia. + cases n0. lia. + cases m0. lia. simpl. posnats. unfold shape_to_index, shape_to_vars. simpl. repeat rewrite index_to_partial_function_vars_cons; eauto with reindexers. @@ -1894,45 +1784,26 @@ Proof. try eapply not_var_generation_in_index; eauto. simpl. repeat rewrite map_subst_var_in_Z_tup_combine_not_in; eauto with reindexers. -Qed. +Qed. Lemma partial_injective_transpose : forall l n0 m0 l0 reindexer v, - result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape (V l) (n0 :: m0 :: l0) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z - (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) l0)))) v) + (transpose_result l (m0 :: n0 :: l0))) v) (filter (fun x : list Z => negb (is_None (result_lookup_Z_option x - (transpose_result l - (Z.to_nat - (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)))))) + (transpose_result l (m0 :: n0 :: l0))))) (mesh_grid (result_shape_Z - (transpose_result - l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)))))) -> + (transpose_result l (m0 :: n0 :: l0))))) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -1983,7 +1854,6 @@ Proof. lia. lia. eauto. Qed. - Lemma eq_partial_interpret_reindexer_concat_l : forall args1 l1 l2 l0 reindexer v x2 n m, In args1 @@ -2001,7 +1871,7 @@ Lemma eq_partial_interpret_reindexer_concat_l : (var \in vars_of_reindexer (reindexer []) -> False) -> map (subst_var_in_Z_tup var k) (reindexer l) = reindexer (map (subst_var_in_Z_tup var k) l)) -> - eq_zexpr x2 (| Z.of_nat m |)%z -> + eval_Zexpr $0 x2 (Z.of_nat m) -> partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => reindexer @@ -2035,7 +1905,7 @@ Proof. unfold subst_var_in_Z_tup. simpl. rewrite subst_var_in_Zexpr_id. - 2: { invert Hx2. rewrite H4. sets. } + 2: { erewrite eval_Zexpr_vars_empty by eassumption. auto. } erewrite eq_index_to_partial_function. reflexivity. eapply eq_Z_tuple_index_list_partially_eval_Z_tup. @@ -2046,7 +1916,7 @@ Proof. eapply eq_zexpr_transitivity. eapply eq_zexpr_add. eapply eq_zexpr_id. reflexivity. - eauto. + apply eval_empty_eq_zexpr. eassumption. eapply eq_zexpr_transitivity. eapply eq_zexpr_add_literal. eapply eq_zexpr_id. f_equal. lia. @@ -2072,7 +1942,7 @@ Lemma partial_injective_concat_l : forall l1 reindexer l2 v x2 l0 n m, ~ var \in vars_of_reindexer (reindexer []) -> map (subst_var_in_Z_tup var k) (reindexer l) = reindexer (map (subst_var_in_Z_tup var k) l)) -> - (eq_zexpr x2 (|Z.of_nat m|)%z) -> + eval_Zexpr $0 x2 (Z.of_nat m) -> partial_injective (partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => @@ -2125,7 +1995,7 @@ Proof. lia. Qed. -Lemma partial_injective_concat_r : forall l1 reindexer l2 v l0 n m, +Lemma partial_injective_concat_r : forall l1 reindexer l2 v l0 n nz m, partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V (l1 ++ l2)%list)) v) @@ -2133,10 +2003,8 @@ Lemma partial_injective_concat_r : forall l1 reindexer l2 v l0 n m, (is_None (result_lookup_Z_option x (V (l1 ++ l2)%list)))) (mesh_grid (result_shape_Z (V (l1 ++ l2)%list)))) -> - result_has_shape (V l1) (map Z.to_nat (map (eval_Zexpr_Z_total $0) - (n :: l0))) -> - result_has_shape (V l2) (map Z.to_nat (map (eval_Zexpr_Z_total $0) - (m :: l0))) -> + result_has_shape (V l1) (Z.to_nat nz :: l0) -> + result_has_shape (V l2) (m :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) @@ -2146,8 +2014,8 @@ Lemma partial_injective_concat_r : forall l1 reindexer l2 v l0 n m, ~ var \in vars_of_reindexer (reindexer []) -> map (subst_var_in_Z_tup var k) (reindexer l) = reindexer (map (subst_var_in_Z_tup var k) l)) -> - eq_zexpr n (|eval_Zexpr_Z_total $0 n|)%z -> - (0 <= eval_Zexpr_Z_total $0 n)%Z -> + eval_Zexpr $0 n nz -> + (0 <= nz)%Z -> (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> @@ -2160,23 +2028,17 @@ Lemma partial_injective_concat_r : forall l1 reindexer l2 v l0 n m, | (v0, d) :: xs => (((v0+n)%z, (d +n)%z) :: xs) end) (map Z.of_nat - (filter_until (map Z.to_nat (map (eval_Zexpr_Z_total $0) - (m :: l0))) 0)) v) + (filter_until (m :: l0) 0)) v) (filter (fun x => negb (is_None (result_lookup_Z_option x (V l2)))) (mesh_grid (map Z.of_nat - (filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) - (m :: l0))) 0)))). + (filter_until (m :: l0) 0)))). Proof. unfold partial_injective in *. propositional. repeat decomp_index. - assert (0 < eval_Zexpr_Z_total $0 m \/ eval_Zexpr_Z_total $0 m <= 0)%Z - as Hcase by lia. + assert (0 < m \/ m <= 0)%nat as Hcase by lia. inversion Hcase as [ Hcase1 | Hcase2 ]; clear Hcase. - rewrite map_cons in *. - rewrite map_cons in *. erewrite eq_partial_interpret_reindexer_padl; eauto. erewrite eq_partial_interpret_reindexer_padl in H11; eauto. erewrite eq_partial_interpret_reindexer_padl in H11; eauto. @@ -2198,9 +2060,9 @@ Proof. rewrite Nat.add_sub. cases z0; try lia. simpl Z.add at 1. - cases (eval_Zexpr_Z_total $0 n); try lia. + cases nz; try lia. eauto. eauto. - cases ((Z.pos p + eval_Zexpr_Z_total $0 n)%Z); try lia. + cases ((Z.pos p + nz)%Z); try lia. eauto. lia. lia. invert H0. simpl. lia. simpl. lia. eapply filter_In. propositional. repeat decomp_goal_index. propositional. @@ -2213,9 +2075,9 @@ Proof. rewrite Nat.add_sub. cases z; try lia. simpl Z.add at 1. - cases (eval_Zexpr_Z_total $0 n); try lia. + cases nz; try lia. eauto. eauto. - cases ((Z.pos p + eval_Zexpr_Z_total $0 n)%Z); try lia. + cases ((Z.pos p + nz)%Z); try lia. eauto. lia. lia. invert H0. simpl. lia. simpl. lia. lia. Qed. @@ -2467,14 +2329,12 @@ Proof. specialize (H x a). simpl in H. propositional. subst. propositional. Qed. - + Lemma eq_partial_interpret_reindexer_flatten : forall z z0 n m x l0 v reindexer, - (0 <= z < Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 n)))%Z -> - (0 <= z0 < Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))%Z -> - In x - (mesh_grid - (map Z.of_nat (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) -> + (0 <= z < Z.of_nat n)%Z -> + (0 <= z0 < Z.of_nat m)%Z -> + In x (mesh_grid (map Z.of_nat l0)) -> (forall var : var, contains_substring "?" var -> var \in dom v -> False)-> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> @@ -2488,11 +2348,8 @@ Lemma eq_partial_interpret_reindexer_flatten : reindexer (map Z.of_nat (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) * - Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v - ((z * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) + z0)%Z :: x) = + (n * m :: l0) 0)) v + ((z * Z.of_nat m + z0)%Z :: x) = partial_interpret_reindexer (fun l4 : list (Zexpr * Zexpr) => reindexer @@ -2504,17 +2361,14 @@ Lemma eq_partial_interpret_reindexer_flatten : end) (map Z.of_nat (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v + (n :: m :: l0) 0)) v (z :: z0 :: x). Proof. intros ? ? ? ? ? ? ? ? Hz Hz0 Hx Henv HeqZlist Hvarsub Hmap. unfold partial_interpret_reindexer. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n)); try lia. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)); try lia. + cases n; try lia. + cases m; try lia. simpl. unfold shape_to_vars. simpl. rewrite shape_to_index_cons. repeat rewrite index_to_partial_function_vars_cons; eauto with reindexers. @@ -2570,10 +2424,7 @@ Qed. Lemma partial_injective_flatten : forall reindexer v n m l0 l, - result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape (V l) (n :: m :: l0) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -2589,21 +2440,13 @@ Lemma partial_injective_flatten : (partial_interpret_reindexer reindexer (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) * - Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v) + (filter_until (n * m :: l0) 0)) v) (filter (fun x : list Z => negb (is_None (result_lookup_Z_option x (V (flatten_result l))))) (mesh_grid (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) * - Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))) -> + (filter_until (n * m :: l0) 0)))) -> (forall var : var, contains_substring "?" var -> var \in dom v -> False)-> partial_injective (partial_interpret_reindexer @@ -2616,19 +2459,11 @@ Lemma partial_injective_flatten : ((v0 * di + vi)%z, (d * di)%z) :: xs end) (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v) + (filter_until (n :: m :: l0) 0)) v) (filter (fun x => negb (is_None (result_lookup_Z_option x (V l)))) (mesh_grid (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))). + (filter_until (n :: m :: l0) 0)))). Proof. intros ? ? ? ? ? ? Hsh HeqZlist Hvarsub Hmap Hvarsarg Hinj. unfold partial_injective. propositional. repeat decomp_index. @@ -2672,25 +2507,23 @@ Proof. Qed. Lemma partial_injective_split : - forall reindexer n l0 k v l, + forall reindexer n l0 k kz v l, partial_injective (partial_interpret_reindexer reindexer (result_shape_Z - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l))) v) + (V (split_result (Z.to_nat kz) l))) v) (filter (fun x : list Z => negb (is_None (result_lookup_Z_option x - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l))))) + (V (split_result (Z.to_nat kz) l))))) (mesh_grid (result_shape_Z - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l))))) -> -result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + (V (split_result (Z.to_nat kz) l))))) -> +result_has_shape (V l) (n :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> + eval_Zexpr $0 k kz -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -2702,8 +2535,7 @@ result_has_shape (V l) (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - (0 <= eval_Zexpr_Z_total $0 n)%Z -> - (0 < eval_Zexpr_Z_total $0 k)%Z -> + (0 < kz)%Z -> partial_injective (partial_interpret_reindexer (fun l2 : list (Zexpr * Zexpr) => @@ -2715,7 +2547,7 @@ result_has_shape (V l) (filter (fun x : list Z => negb (is_None (result_lookup_Z_option x (V l)))) (mesh_grid (result_shape_Z (V l)))). Proof. - intros ? ? ? ? ? ? Hinj Hsh Hvar Hk HeqZwraplist Hvarsub Hmap + intros ? ? ? ? ? ? ? Hinj Hsh Hvar Hk HeqZwraplist Hvarsub Hmap Hvarrdx Hmnonneg Hknonneg. erewrite result_has_shape_result_shape_Z in *. 2: { eapply result_has_shape_split_result. lia. eauto. } @@ -2723,58 +2555,54 @@ Proof. unfold partial_injective. propositional. repeat decomp_index. - simpl. cases (Z.to_nat (eval_Zexpr_Z_total $0 n)); simpl ; try lia. + simpl. cases n; simpl ; try lia. posnats. - rewrite <- Heq in *. rewrite <- map_cons. rewrite <- filter_until_0_cons. erewrite eq_partial_interpret_reindexer_split in H1; eauto. erewrite eq_partial_interpret_reindexer_split in H1; eauto. - rewrite <- Z2Nat_div_distr in * by lia. eapply Hinj in H1. - rewrite (Z_div_mod_eq_full z0 (eval_Zexpr_Z_total $0 k)) at 1 by lia. - rewrite (Z_div_mod_eq_full z (eval_Zexpr_Z_total $0 k)) at 1 by lia. + rewrite (Z_div_mod_eq_full z0 kz) at 1 by lia. + rewrite (Z_div_mod_eq_full z kz) at 1 by lia. propositional. + invert H. auto. - + erewrite eq_partial_interpret_reindexer_split; eauto. + + erewrite eq_partial_interpret_reindexer_split; eauto. + eapply filter_In. propositional. rewrite mesh_grid_filter_until. simpl map. repeat decomp_goal_index. propositional. eapply Z.div_pos. lia. lia. - rewrite Z2Nat.id. - 2: { unfold div_ceil. simpl. eapply div_nonneg. lia. lia. } + rewrite <- of_nat_div_distr. rewrite Z2Nat.id by lia. eapply floor_lt_ceil_mono_l. lia. lia. lia. lia. repeat decomp_goal_index. split. split. eapply mod_nonneg. lia. rewrite Z2Nat.id by lia. eapply mod_upper_bound. lia. auto. rewrite <- H5. f_equal. f_equal. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 1 by lia. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 2 by lia. + rewrite <- (Z2Nat.id kz) at 1 by lia. + rewrite <- (Z2Nat.id kz) at 2 by lia. erewrite result_lookup_Z_option_split. reflexivity. - eauto. lia. eassumption. lia. rewrite Z2Nat.id. eauto. lia. + eauto. lia. eassumption. lia. eauto. + eapply filter_In. propositional. rewrite mesh_grid_filter_until. simpl map. repeat decomp_goal_index. propositional. eapply Z.div_pos. lia. lia. - rewrite Z2Nat.id. - 2: { unfold div_ceil. simpl. eapply div_nonneg. lia. lia. } + rewrite <- of_nat_div_distr. rewrite Z2Nat.id by lia. eapply floor_lt_ceil_mono_l. lia. lia. lia. lia. repeat decomp_goal_index. split. split. eapply mod_nonneg. lia. rewrite Z2Nat.id by lia. eapply mod_upper_bound. lia. auto. rewrite <- H3. f_equal. f_equal. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 1 by lia. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 2 by lia. + rewrite <- (Z2Nat.id kz) at 1 by lia. + rewrite <- (Z2Nat.id kz) at 2 by lia. erewrite result_lookup_Z_option_split. reflexivity. - eauto. lia. eassumption. lia. rewrite Z2Nat.id. eauto. lia. + eauto. lia. eassumption. lia. eauto. + lia. Qed. Lemma eq_partial_interpret_reindexer_padr: forall (reindexer : list (Zexpr * Zexpr) -> list (Zexpr * Zexpr)) - (k m : Zexpr) (l0 : list Zexpr) (z : Z) (v : fmap var Z) + k kz m l0 (z : Z) (v : fmap var Z) (x1 : list Z), - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> + eval_Zexpr $0 k kz -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> @@ -2787,8 +2615,8 @@ Lemma eq_partial_interpret_reindexer_padr: (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - (0 < eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + (0 < m) -> + (0 <= kz)%Z -> partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => reindexer @@ -2796,23 +2624,18 @@ Lemma eq_partial_interpret_reindexer_padr: | [] => l | (v0, d) :: xs => (v0, (d + k)%z) :: xs end) - (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) 0)) v + (map Z.of_nat (filter_until (m :: l0) 0)) v (z :: x1) = partial_interpret_reindexer reindexer (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 k) + Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) 0)) v - (z :: x1). + (filter_until (Z.to_nat kz + m :: l0) 0)) v + (z :: x1). Proof. - intros ? ? ? ? ? ? ? Heqk Hvar HeqZlistwrap Hvarsub Hmap + intros ? ? ? ? ? ? ? ? Heqk Hvar HeqZlistwrap Hvarsub Hmap Hvarrdx Hmnonneg Hknonneg. unfold partial_interpret_reindexer. unfold shape_to_vars in *. simpl. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 m))%nat). lia. + cases m. lia. simpl. rewrite Nat.add_succ_r in *. simpl shape_to_index at 1. @@ -2826,7 +2649,7 @@ Proof. rewrite map_subst_var_in_Z_tup_combine_not_in; eauto with reindexers. unfold subst_var_in_Z_tup. simpl. rewrite subst_var_in_Zexpr_id. - 2: { unfold eq_zexpr in *. invs. rewrite H0. sets. } + 2: { erewrite eval_Zexpr_vars_empty by eassumption. auto. } erewrite eq_index_to_partial_function. reflexivity. eapply eq_Z_tuple_index_list_partially_eval_Z_tup. eapply HeqZlistwrap. @@ -2838,9 +2661,8 @@ Proof. eapply eq_zexpr_transitivity. eapply eq_zexpr_add. eapply eq_zexpr_id. auto. - eapply Heqk. + apply eval_empty_eq_zexpr. eassumption. eapply eq_zexpr_transitivity. eapply eq_zexpr_add_literal. eapply eq_zexpr_id. f_equal. lia. Qed. - diff --git a/src/verified_lowering/proof/InterpretReindexer.v b/src/verified_lowering/proof/InterpretReindexer.v index 5b051dc..2c97ea7 100644 --- a/src/verified_lowering/proof/InterpretReindexer.v +++ b/src/verified_lowering/proof/InterpretReindexer.v @@ -22,7 +22,7 @@ Definition shift_top_dim_reindexer (reindexer : list (Zexpr * Zexpr) -> list (Zexpr * Zexpr)) := fun l => match l with | (var,dim)::xs => reindexer - ((var + | 1 |,dim + | 1 |)%z :: xs) + ((var + | 1 |, dim + | 1 |)%z :: xs) | _ => reindexer l end. @@ -41,35 +41,15 @@ Lemma flatten_index_to_function_alt : forall sh args, index_to_function_alt (combine (map ZLit args) (map ZLit sh)) [] []. Proof. induction sh; intros; cases args; auto. - simpl. unfold flatten. cases sh; auto. - cases sh; cases args; simpl in *; try lia. - unfold index_to_function_alt. simpl. reflexivity. - simpl. rewrite IHsh. - unfold index_to_function_alt. - unfold index_to_function_rec_alt. - simpl. - erewrite eval_Zexpr_Z_flatten_index_flatten. - 2: { econstructor. eauto. rewrite map_snd_combine - by (repeat rewrite length_map; simpl; try lia). - eapply eval_Zexprlist_map_ZLit. } - 2: { econstructor. eauto. rewrite map_fst_combine - by (repeat rewrite length_map; simpl; try lia). - eapply eval_Zexprlist_map_ZLit. } - rewrite map_snd_combine - by (repeat rewrite length_map; simpl; try lia). - erewrite eval_Zexpr_Z_fold_left_ZTimes. - 2: eapply eval_Zexprlist_map_ZLit. - 2: eauto. - unfold flatten_index. simpl. - rewrite map_snd_combine - by (repeat rewrite length_map; simpl; try lia). - rewrite map_fst_combine - by (repeat rewrite length_map; simpl; try lia). + simpl. simpl in H. + unfold index_to_function_alt. simpl. + rewrite map_fst_combine by (repeat rewrite length_map; simpl; lia). + rewrite map_snd_combine by (repeat rewrite length_map; simpl; lia). erewrite eval_Zexpr_Z_flatten_index_flatten. - 2: { econstructor. eauto. eapply eval_Zexprlist_map_ZLit. } - 2: { econstructor. eauto. eapply eval_Zexprlist_map_ZLit. } + 2: { eapply eval_Zexprlist_map_ZLit. } + 2: { eapply eval_Zexprlist_map_ZLit. } + rewrite eval_Zexpr_Z_fold_left_ZTimes_ZLit. reflexivity. - simpl in *. lia. Qed. Definition interpret_reindexer @@ -88,8 +68,7 @@ Lemma interpret_reindexer_id_flatten : forall sh x v, flatten sh x. Proof. induct sh; intros. - - simpl in *. propositional. subst. - reflexivity. + - simpl in *. propositional. - cases x. eapply not_In_empty_map2_cons in H; propositional. unfold interpret_reindexer. @@ -106,16 +85,16 @@ Proof. rewrite map_cons. rewrite fold_left_subst_var_in_Z_tup_ZLit. rewrite map_fold_left_subst_var_in_Z_tup_shape_to_index. - simpl. - rewrite map_partially_eval_Z_tup_ZLit. simpl. rewrite flatten_index_to_function_alt. + simpl. + rewrite map_partially_eval_Z_tup_ZLit. reflexivity. - eapply length_mesh_grid_indices_Z. auto. + apply length_mesh_grid_indices_Z. auto. rewrite length_map. rewrite length_nat_range_rec. eapply length_mesh_grid_indices_Z in H. simpl in *. lia. eapply no_dup_var_generation. eauto with reindexers. -Qed. +Qed. Lemma constant_interpret_reindexer_id_flatten : forall sh v, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> @@ -180,7 +159,7 @@ Proof. intros. simpl in *. lia. lia. - auto. Qed. - + Lemma vars_of_shift_top_dim_reindexer : forall reindexer l, ((forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = @@ -233,15 +212,10 @@ Lemma flatten_index_to_partial_function : forall sh args, index_to_partial_function (combine (map ZLit args) (map ZLit sh)) [] []. Proof. induction sh; intros; cases args; auto. - simpl. unfold flatten. cases sh; auto. + simpl. decomp_index. unfold index_to_partial_function. simpl. propositional. - replace (0 <=? z)%Z with true. - 2: { symmetry. eapply Z.leb_le. lia. } - replace (z index_to_partial_function (map (partially_eval_Z_tup v) - (reindexer l)) (var::vars) (k :: x) = - index_to_partial_function + (reindexer l)) (var::vars) (k :: x) = + index_to_partial_function (map (partially_eval_Z_tup v) (map (fun e => (subst_var_in_Z_tup var k e)) (reindexer l))) vars x. @@ -339,14 +313,14 @@ Proof. rewrite map_cons. rewrite fold_left_subst_var_in_Z_tup_ZLit. rewrite map_fold_left_subst_var_in_Z_tup_shape_to_index. + rewrite flatten_index_to_partial_function. simpl. rewrite map_partially_eval_Z_tup_ZLit. simpl. unfold partially_eval_Z_tup. simpl. - rewrite flatten_index_to_partial_function. reflexivity. erewrite <- in_mesh_grid_cons__. propositional. - rewrite length_map. rewrite length_nat_range_rec. + rewrite length_map. rewrite length_nat_range_rec. eapply length_mesh_grid_indices_Z. auto. eapply no_dup_var_generation. eauto with reindexers. @@ -365,7 +339,7 @@ Proof. intros. apply sets_equal. propositional; eapply In_iff_in; rewrite <- In_iff_in; - eapply In_iff_in in H0. + eapply In_iff_in in H0. - rewrite <- in_extract_Some in H0. rewrite in_map_iff in *. invs. rewrite partial_interpret_reindexer_id_flatten in *; auto. @@ -374,7 +348,7 @@ Proof. rewrite in_map_iff in *. invs. eexists. rewrite partial_interpret_reindexer_id_flatten in *; auto. -Qed. +Qed. Lemma constant_partial_interpret_reindexer_id_flatten_filter: forall (v : fmap var Z) r, @@ -396,7 +370,7 @@ Proof. intros. apply sets_equal. propositional; eapply In_iff_in; rewrite <- In_iff_in; - eapply In_iff_in in H0. + eapply In_iff_in in H0. - rewrite <- in_extract_Some in H0. rewrite in_map_iff in *. invs. rewrite partial_interpret_reindexer_id_flatten in *; auto. @@ -407,7 +381,7 @@ Proof. eexists. rewrite partial_interpret_reindexer_id_flatten in *; auto. decomp_index. propositional. -Qed. +Qed. Lemma partial_interpret_reindexer_vars_None : forall reindexer sh v args, @@ -416,7 +390,7 @@ Lemma partial_interpret_reindexer_vars_None : Proof. unfold partial_interpret_reindexer. unfold index_to_partial_function. intros. unfold shape_to_vars. - rewrite length_map. unfold nat_range. rewrite length_nat_range_rec. + rewrite length_map. unfold nat_range. rewrite length_nat_range_rec. eapply Nat.eqb_neq in H. rewrite H. auto. Qed. @@ -468,4 +442,3 @@ Proof. eapply IHl. eapply H0. + simpl in *. right. eapply IHl. apply H. Qed. - diff --git a/src/verified_lowering/proof/ListMisc.v b/src/verified_lowering/proof/ListMisc.v index fb9d504..d1b46b2 100644 --- a/src/verified_lowering/proof/ListMisc.v +++ b/src/verified_lowering/proof/ListMisc.v @@ -181,7 +181,7 @@ Proof. invert H1. propositional. eapply Forall_forall in H5. 2: eassumption. propositional. -Qed. +Qed. Lemma length_concat {X} : forall (l : list (list X)) k, (Forall (fun x => length x = k) l) -> @@ -226,7 +226,7 @@ Proof. - invert H. - invert H. - simpl in H. invert H. discriminate. eapply IHl1. eassumption. -Qed. +Qed. Lemma In_cons_map_cons {X} : forall l (z : X) x k, In (z :: x) (map (fun x => k :: x) l) <-> @@ -362,7 +362,7 @@ Lemma forall_filter {X} : forall f l, Proof. induct l; intros. - econstructor. - - simpl. + - simpl. cases (f a). + econstructor. auto. auto. + auto. @@ -451,7 +451,7 @@ Proof. rewrite H. simpl. eauto. Qed. -Lemma map_fst_combine {X} : forall (l1 l2 : list X), +Lemma map_fst_combine {X Y} : forall (l1 : list X) (l2 : list Y), length l1 = length l2 -> map fst (combine l1 l2) = l1. Proof. @@ -460,7 +460,7 @@ Proof. - rewrite IHl1 by lia. auto. Qed. -Lemma map_snd_combine {X} : forall (l2 l1 : list X), +Lemma map_snd_combine {X Y} : forall (l2 : list X) (l1 : list Y), length l1 = length l2 -> map snd (combine l1 l2) = l2. Proof. @@ -501,7 +501,7 @@ Proof. - simpl. cases l2. + reflexivity. + simpl. f_equal. eauto. -Qed. +Qed. Lemma map_dom_eq {X} : forall (dom0 : list (list Z)) (f g : list Z -> X), (forall idx : list Z, In idx dom0 -> f idx = g idx) -> @@ -592,15 +592,12 @@ Proof. Qed. Lemma forall_nonneg_exists_zero_or_forall_pos : forall l, - Forall (fun x : nat => x >= 0) l -> Forall (fun x : nat => x > 0) l \/ Exists (fun x => x = 0) l. Proof. induct l; intros. - auto. - - invert H. invert H2. - + right. eauto. - + eapply IHl in H3. invert H3. left. econstructor. lia. auto. - right. eauto. + - assert (a = 0 \/ a > 0) by lia. destruct H; eauto. + destruct IHl; eauto. Qed. Lemma concat_repeat_empty {X} : forall n, @@ -713,7 +710,7 @@ Proof. + simpl. rewrite fold_left_mul_assoc. lia. + simpl. rewrite fold_left_mul_assoc. rewrite IHl. lia. eauto. Qed. - + Lemma fold_left_mul_assoc_nat : forall l b a, fold_left mul l (b * a) = fold_left mul l b * a. Proof. @@ -724,22 +721,12 @@ Proof. rewrite IHl. auto. Qed. -Lemma Z_of_nat_fold_left_mul : forall l, - Z.of_nat (fold_left mul l 1) = fold_left Z.mul (map Z.of_nat l) 1%Z. +Lemma Z_of_nat_fold_left_mul : forall l n, + Z.of_nat (fold_left mul l n) = fold_left Z.mul (map Z.of_nat l) (Z.of_nat n). Proof. induct l; intros. - reflexivity. - - simpl. replace (match Z.of_nat a with - | 0%Z => 0%Z - | Z.pos y' => Z.pos y' - | Z.neg y' => Z.neg y' - end) with (1 * Z.of_nat a)%Z. - rewrite fold_left_mul_assoc. - rewrite add_0_r. - replace a with (1 * a) at 1 by lia. - rewrite fold_left_mul_assoc_nat. - lia. - cases (Z.of_nat a); lia. + - simpl. rewrite IHl. rewrite Nat2Z.inj_mul. reflexivity. Qed. Fixpoint extract_Some {X} (l : list (option X)) := @@ -747,7 +734,7 @@ Fixpoint extract_Some {X} (l : list (option X)) := | Some v:: xs => v:: extract_Some xs | None::xs => extract_Some xs | _ => [] - end. + end. Lemma in_extract_Some {X} : forall (k : X) l, In (Some k) l <-> @@ -787,7 +774,15 @@ Proof. - reflexivity. - invert H. simpl. rewrite Z2Nat.id by lia. f_equal. eauto. -Qed. +Qed. + +Lemma map_Z_of_nat_inj l1 l2 : + map Z.of_nat l1 = map Z.of_nat l2 -> + l1 = l2. +Proof. + revert l2. induction l1; intros l2; destruct l2; simpl; try congruence. + invert 1. f_equal; [lia|]. auto. +Qed. Fixpoint truncl_list {X} n (l : list X) := match n with @@ -914,7 +909,7 @@ Proof. simpl in Heq. invert Heq. auto. -- rewrite truncl_list_app in Heq. rewrite rev_app_distr in Heq. - simpl in Heq. invert Heq. auto. + simpl in Heq. invert Heq. auto. rewrite length_rev. lia. + simpl. simpl length in H. rewrite truncl_list_app by (rewrite length_rev; lia). @@ -944,7 +939,7 @@ Proof. simpl in *. rewrite IHk by lia. reflexivity. -Qed. +Qed. Lemma truncl_list_repeat {X} : forall k (x : X) n, truncl_list k (repeat x n) = repeat x (n-k). @@ -1102,7 +1097,7 @@ Proof. rewrite <- firstn_cons. rewrite skipn_firstn_comm. simpl. eauto. -Qed. +Qed. Lemma skipn_skipn {X} : forall m n (l : list X), skipn n (skipn m l) = skipn (n + m) l. @@ -1113,7 +1108,7 @@ Proof. rewrite skipn_cons. rewrite IHm. rewrite add_succ_r. reflexivity. -Qed. +Qed. Lemma rev_skipn_rev_skipn {X} : forall m n (l : list X), rev (skipn n (rev (skipn m l))) = @@ -1134,11 +1129,11 @@ Proof. simpl length in Heq. assert (length l - n = n0) by lia. replace l with (rev (rev l)) at 1. - 2: rewrite rev_involutive; auto. + 2: rewrite rev_involutive; auto. rewrite firstn_rev. rewrite length_rev. f_equal. f_equal. f_equal. lia. -Qed. +Qed. Lemma forall_skipn_le {X} : forall m (l : list X) n P, Forall P (skipn n l) -> @@ -1165,18 +1160,18 @@ Proof. Qed. Lemma exists_filter_until_0 : forall l, - Exists (fun x => x = 0%Z) l -> - Exists (fun x2 => Z.of_nat x2 = 0%Z) (filter_until (map Z.to_nat l) 0). + Exists (fun x => x = 0) l -> + Exists (fun x2 => x2 = 0) (filter_until l 0). Proof. induct l; intros. - invert H. - invert H. + simpl. econstructor. lia. - + simpl. cases (Z.to_nat a). simpl. econstructor. lia. + + simpl. cases a. simpl. econstructor. lia. simpl. right. eauto. Qed. -Lemma nth_error_rev {X} : +Lemma nth_error_rev {X} : forall (l : list X) n m, length l = m -> n < m -> @@ -1199,7 +1194,7 @@ Proof. erewrite <- IHl. 2: reflexivity. 2: lia. f_equal. lia. -Qed. +Qed. Lemma nat_list_all_pos_or_exists_0 : forall l, Forall (fun x => 0 < x) l \/ Exists (fun x => x = 0) l. @@ -1222,7 +1217,7 @@ Proof. - cases n. simpl in *. eauto. simpl in H. simpl. eapply IHl in H. propositional. -Qed. +Qed. Lemma length_ge_filter_until : forall l, length l >= length (filter_until l 0). @@ -1312,4 +1307,12 @@ Proof. 2: { eapply le_trans. eapply Div0.mul_div_le. lia. } rewrite Div0.mod_eq by lia. eauto. Qed. - + +Lemma fold_left_mul_filter_until l n : + fold_left mul (filter_until l 0) n = fold_left mul l n. +Proof. + revert n. induction l; eauto. + assert (0 = a \/ 0 < a) as [?|?] by lia. + - subst. simpl. intros. rewrite fold_left_mul_assoc_nat. lia. + - rewrite filter_until_0_cons by lia. simpl. auto. +Qed. diff --git a/src/verified_lowering/proof/LowerCorrect.v b/src/verified_lowering/proof/LowerCorrect.v index 6bdafe5..0e36cf4 100644 --- a/src/verified_lowering/proof/LowerCorrect.v +++ b/src/verified_lowering/proof/LowerCorrect.v @@ -17,7 +17,7 @@ Import ListNotations. From ATL Require Import ATL Map Sets FrapWithoutSets Div Tactics. From Lower Require Import Zexpr Bexpr Array Range Sexpr Result ListMisc Meshgrid VarGeneration - Injective Constant InterpretReindexer + Injective Constant InterpretReindexer WellFormedEnvironment WellFormedReindexer WellFormedAllocation ResultToArrayDelta ContextsAgree Pad ATLDeep. @@ -26,6 +26,15 @@ Local Hint Constructors eval_Zexpr eval_Bexpr eval_Sexpr size_of. Local Hint Resolve eval_Zexprlist_includes_valuation includes_add_new None_dom_lookup. +Lemma eval_Zexpr_Z_eval_Zexpr' v x xz : + eval_Zexpr_Z v x = Some xz -> + eval_Zexpr v x xz. +Proof. + intros. apply eval_Zexpr_Z_eval_Zexpr. assumption. +Qed. +Local Hint Resolve eval_Zexpr_Z_eval_Zexpr' : core. + +Hint Resolve nonneg_bounds_includes size_of_includes : core. Hint Resolve no_dup_var_generation no_dup_mesh_grid forall_map_not_in_index forall_map_not_in_dom not_In_var_map2 not_In_var_map @@ -35,15 +44,15 @@ Hint Extern 3 (Datatypes.length _ = Datatypes.length _) => rewrite length_map; rewrite length_nat_range_rec; eapply length_mesh_grid_indices; eassumption : reindexers. Arguments flatten : simpl nomatch. - + Theorem lower_correct_weak : forall e, - constant_nonneg_bounds e -> - forall sh v ec r, + forall v ec r, (* functional evaluation of ATL *) - eval_expr sh v ec e r -> - forall l, size_of e l -> - forall p st h st' h' reindexer asn, + eval_expr v ec e r -> + nonneg_bounds $0 e -> + forall l, size_of $0 e l -> + forall p st h st' h' reindexer asn sh, (* imperative evaluation of lowering *) eval_stmt v st h (lower e reindexer p asn sh) st' h' -> (* our environment is well-formed *) @@ -55,7 +64,7 @@ Theorem lower_correct_weak : (* expr context and imperative state agree *) contexts_agree ec st h sh -> forall pads g, - has_pad sh v g e pads -> + has_pad v g e pads -> (forall pads (x : var) (r0 : result), g $? x = Some pads -> ec $? x = Some r0 -> @@ -81,111 +90,72 @@ Theorem lower_correct_weak : /\ st' = st) end. Proof. - intros e Hconst sh v ec r. - induct 1; intros ls Hsize p st h st' h' reindexer asm + intros e v ec r. + induct 1; intros Hbds ls Hsize p st h st' h' reindexer asm sh Heval Henv Hrdx Halloc Hctx pads g Hpad Hrelate. - 12: { (* SPLIT *) simpl in *. invert Hsize. simpl in Hconst. invert Hconst. - invert H2. pose proof H3 as Hconst. - assert (result_has_shape (V l) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (n::l0)))) - as Hsh. - { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H3. - eapply H3. eassumption. eauto. } + 11: { (* SPLIT *) simpl in *. invert Hsize. invs'. eq_eval_Z. + rename H3 into Hk. + pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'. 2: apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. rewrite Hk' in *. invs'. clear Hk'. + + assert (result_has_shape (V l) (n::sh0)) as Hsh. + { eapply size_of_eval_expr_result_has_shape in H; eauto. } pose proof Hsh as Hsh'. repeat rewrite map_cons in *. eapply result_has_shape_split_result - with (k:=(Z.to_nat (eval_Zexpr_Z_total $0 k))) in Hsh'. + with (k:=Z.to_nat kz) in Hsh'. 2: { invert Hpad. lia. } - invert Hpad. - eapply IHeval_expr in H7. - 2: { eauto. } - 2: { eauto. } - 2: { eauto. } - 2: { eauto. } + invert Hpad. + eapply IHeval_expr in Heval. + 2,3,4: eassumption. 2: { eapply well_formed_allocation_result_V in Halloc. - 2: { apply Hrdx. } invs. + 2: { apply Hrdx. } invs'. eapply well_formed_reindexer_split; eauto. - apply Henv. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eq_size_of. invert H2. - eapply constant_nonneg_bounds_size_of_nonneg in H3; eauto. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - eapply constant_nonneg_bounds_size_of_no_vars. eauto. eauto. } - invert H3. lia. - } + apply Henv. } 2: { eapply well_formed_allocation_split; eauto. - apply Hrdx. - eq_size_of. invert H2. - eapply constant_nonneg_bounds_size_of_nonneg in H3; eauto. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - eapply constant_nonneg_bounds_size_of_no_vars. eauto. eauto. } - invert H3. lia. - apply Hrdx. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eq_size_of. invert H2. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eapply constant_nonneg_bounds_size_of_no_vars in H3; eauto. - invert H3. eauto. apply Henv. apply Hrdx. apply Hrdx. } + apply Hrdx. apply Hrdx. apply Henv. apply Hrdx. apply Hrdx. } 2: { eauto. } 2: { eauto. } - - eq_size_of. invert H2. + 2: { eauto. } + + eq_size_of. invert H0. cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq. propositional. } - cases (reindexer - (let (v, d) := p0 in - ((v / k)%z, (d // k)%z) :: ((ZMod v k)%z, k) :: l0)). + destruct (reindexer (let (v, d) := p0 in _)) eqn:Heq0. { unfold result_shape_Z,shape_to_index, shape_to_vars in Heq. simpl in Heq. cases l. - simpl in *. invert Heq. eapply reindexer_not_empty_vars_in_index in Heq0. 2: { apply Hrdx. } - 2: { simpl. repeat rewrite constant_app_no_dups. - repeat rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H2. invert H2. - eapply cup_empty in H6. invert H6. - eapply cup_empty in H8. invert H8. - eapply cup_empty in H2. invert H2. - eapply constant_not_empty in H8. contradiction. - inversion 1. } + 2: { simpl. unfold not. intros. cups_empty. } propositional. - simpl in *. invert Heq. eapply reindexer_not_empty_vars_in_index in Heq0. 2: { apply Hrdx. } - 2: { simpl. repeat rewrite constant_app_no_dups. - repeat rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H2. invert H2. - eapply cup_empty in H6. invert H6. - eapply cup_empty in H8. invert H8. - eapply cup_empty in H2. invert H2. - eapply constant_not_empty in H8. contradiction. - inversion 1. } + 2: { simpl. unfold not. intros. cups_empty. } propositional. } - - invert H7. + + destruct Heval. cases (reindexer (shape_to_index - (result_shape_Z (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l))) + (result_shape_Z (V (split_result (Z.to_nat kz) l))) (shape_to_vars (result_shape_Z - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l)))))). + (V (split_result (Z.to_nat kz) l)))))). { eapply reindexer_not_empty in Heq1. propositional. apply Hrdx. erewrite result_has_shape_result_shape_Z. 2: { eauto. } - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) //n - (Z.to_nat (eval_Zexpr_Z_total $0 k))). + cases (m //n (Z.to_nat kz)). simpl. inversion 1. simpl. inversion 1. } - pose proof Halloc. - eapply well_formed_allocation_result_V in H2. - invs. - unfold lookup_total. rewrite H2. split; auto. + pose proof Halloc as Halloc'. + eapply well_formed_allocation_result_V in Halloc'. + invs'. + unfold lookup_total. rewrite H0. split; auto. 2: apply Hrdx. f_equal. f_equal. unfold tensor_to_array_delta. @@ -196,170 +166,143 @@ Proof. cases l. { simpl. invert Hsh. rewrite div_ceil_n_0. simpl. unfold tensor_to_array_delta_by_indices. reflexivity. lia. } - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). + cases m. { invert Hsh. } rewrite filter_until_0_cons by lia. symmetry. eapply eq_tensor_to_array_delta_by_indices_shuffle with (shuffle:= fun l => match l with - | x::xs => (x/eval_Zexpr_Z_total $0 k)%Z - ::(Zmod x (eval_Zexpr_Z_total $0 k))%Z::xs + | x::xs => (x/kz)%Z + ::(Zmod x kz)%Z::xs | _ => l end). - intros. cases x0. propositional. rewrite map_cons in *. - repeat decomp_index. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 1 by lia. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 2 by lia. - erewrite result_lookup_Z_option_split. reflexivity. - repeat decomp_index. eauto. lia. apply H6. lia. - rewrite Nat2Z.id by lia. eauto. + repeat decomp_index. remember (Z.to_nat _). + rewrite <- (Z2Nat.id kz) by lia. + subst. + eapply result_lookup_Z_option_split; eauto. lia. lia. lia. - rewrite map_cons. intros. cases x0. propositional. repeat decomp_index. - rewrite <- Heq2. - rewrite <- Z2Nat_div_distr by lia. erewrite <- eq_partial_interpret_reindexer_split; try apply Henv; try apply Hrdx; try lia; eauto. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { repeat decomp_index. eauto. } - 2: { repeat decomp_index. lia. } - rewrite Z2Nat.id by lia. rewrite filter_until_0_cons by lia. - rewrite map_cons. rewrite Z2Nat.id by lia. auto. - - rewrite <- Heq2. repeat rewrite map_cons. + repeat decomp_index. eauto. + repeat decomp_index. eauto. + - repeat rewrite map_cons. intros. repeat decomp_index. eapply filter_In. split. repeat decomp_goal_index. split. split. eapply Z.div_pos. lia. lia. - rewrite <- Z2Nat_div_distr by lia. - rewrite Z2Nat.id. - 2: { eapply div_nonneg. lia. lia. } + rewrite <- of_nat_div_distr by lia. + rewrite Z2Nat.id by lia. eapply floor_lt_ceil_mono_l; lia. decomp_goal_index. split. rewrite Z2Nat.id by lia. eapply Z.mod_pos_bound. lia. eauto. - rewrite <- H11. + rewrite <- H10. f_equal. f_equal. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 1 by lia. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 2 by lia. + rewrite <- (Z2Nat.id kz) at 1 by lia. + rewrite <- (Z2Nat.id kz) at 2 by lia. erewrite result_lookup_Z_option_split. reflexivity. - eauto. lia. apply H6. lia. rewrite Z2Nat.id. - rewrite Heq2. eauto. lia. - - rewrite <- Heq2. repeat rewrite map_cons. + eauto. lia. apply H4. lia. eauto. + - repeat rewrite map_cons. intros. repeat decomp_index. - eexists ((z*(eval_Zexpr_Z_total $0 k) + z0)%Z::x0). + eexists ((z*kz + z0)%Z::x0). rewrite Z.div_add_l by lia. rewrite Z.div_small by lia. rewrite Z.add_0_r. - pose proof Z.add_mul_mod_distr_r. - specialize H12 with (b:=1%Z) (c:= eval_Zexpr_Z_total $0 k). + pose proof Z.add_mul_mod_distr_r as Harith. + specialize Harith with (b:=1%Z) (c:= kz). rewrite Z.mul_1_l in *. - rewrite H12. + rewrite Harith. rewrite Z.mod_1_r. split. auto. eapply filter_In. split. repeat decomp_goal_index. split. - split. lia. rewrite Z2Nat.id by lia. - rewrite <- Z2Nat_div_distr in * by lia. + split. lia. + rewrite <- of_nat_div_distr in * by lia. rewrite Z2Nat.id in * by lia. eapply result_lookup_Z_option_split_true. eauto. - lia. lia. lia. eauto. rewrite Heq2. eauto. + lia. lia. lia. eauto. rewrite Nat2Z.id. eauto. decomp_goal_index. eauto. - rewrite <- H11. f_equal. f_equal. - erewrite <- result_lookup_Z_option_split - with (k:=Z.to_nat (eval_Zexpr_Z_total $0 k)). + rewrite <- H10. f_equal. f_equal. + erewrite <- result_lookup_Z_option_split with (k:=Z.to_nat kz). 2: { eauto. } 2: { lia. } 3: lia. - 3: { rewrite <- Heq2 in *. eauto. } + 3: { eauto. } all: try lia. - 2: { rewrite <- Z2Nat_div_distr in * by lia. + 2: { rewrite <- of_nat_div_distr in * by lia. rewrite Z2Nat.id in * by lia. eapply result_lookup_Z_option_split_true. eauto. - lia. lia. lia. eauto. rewrite Heq2. eauto. } + lia. lia. lia. eauto. rewrite Nat2Z.id. eauto. } rewrite Z2Nat.id by lia. rewrite Z.div_add_l by lia. rewrite Z.div_small by lia. rewrite Z.add_0_r. - pose proof Z.add_mul_mod_distr_r. - specialize H14 with (b:=1%Z) (c:= eval_Zexpr_Z_total $0 k). - rewrite Z.mul_1_l in *. - rewrite H14. + rewrite Harith. rewrite Z.mod_1_r. reflexivity. lia. lia. lia. - - replace (map Z.of_nat - (Datatypes.S n - :: filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) sh0)) 0)) + - replace (map Z.of_nat (Datatypes.S m :: filter_until sh1 0)) with (result_shape_Z (V (r0::l))). 2: { erewrite result_has_shape_result_shape_Z by eauto. reflexivity. } eapply partial_injective_split. apply Hrdx. - rewrite <- Heq2 in *. eauto. apply Henv. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. lia. lia. + eauto. apply Henv. assumption. + apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. lia. - replace (map Z.of_nat (filter_until - (Datatypes.S n //n (Z.to_nat (eval_Zexpr_Z_total $0 k)) - :: Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) sh0)) 0)) with + (Datatypes.S m //n (Z.to_nat kz) + :: Z.to_nat kz + :: sh1) 0)) with (result_shape_Z - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) (r0 :: l)))). + (V (split_result (Z.to_nat kz) (r0 :: l)))). apply Hrdx. erewrite result_has_shape_result_shape_Z. 2:{ eapply result_has_shape_split_result. lia. eauto. } reflexivity. - unfold injective. propositional. repeat decomp_index. - repeat rewrite map_cons in *. repeat decomp_index. - invert H13. - rewrite (Z.div_mod z (eval_Zexpr_Z_total $0 k)). - rewrite (Z.div_mod z0 (eval_Zexpr_Z_total $0 k)). - rewrite H18. rewrite H19. reflexivity. lia. lia. + repeat rewrite map_cons in *. repeat decomp_index. invs'. + rewrite (Z.div_mod z kz). + rewrite (Z.div_mod z0 kz). + rewrite H19, H20. reflexivity. lia. lia. - eapply no_dup_filter. eauto with reindexers. - eapply no_dup_filter. eauto with reindexers. } - (* EMPTY GEN *) - simpl in *. + simpl in *. invs'. rewrite array_add_empty_r. unfold lookup_total. invert Heval. - rewrite H,H0 in *. invert H6. invert H9. lia. - rewrite H,H0 in *. invert H10. invert H11. + rewrite H,H0 in *. invs'. lia. + rewrite H,H0 in *. invs'. eapply well_formed_allocation_result_V in Halloc; try apply Hrdx. cases (reindexer (shape_to_index (result_shape_Z (V [])) (shape_to_vars (result_shape_Z (V []))))). eapply reindexer_not_empty in Heq; simpl; propositional; try apply Hrdx; discriminate. - clear Heq. invs. + clear Heq. invs'. rewrite H7. rewrite add_id. auto. auto. - (* STEPPING GEN *) - simpl in Heval. + simpl in Heval. simpl in Hbds. invs'. unfold lookup_total in *. - invert Hsize. pose proof H11 as Hsize. clear H11. - assert (eq_zexpr lo (|eval_Zexpr_Z_total $0 lo|)%z) as Heqlo. - { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - invert Hconst. eauto. } - assert (eq_zexpr hi (|eval_Zexpr_Z_total $0 hi|)%z) as Heqhi. - { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - invert Hconst. invert H7. eauto. } - assert (loz = eval_Zexpr_Z_total $0 lo). - { invert Heqlo. eapply eval_Zexpr_Z_eval_Zexpr in H. eapply H6 in H. - invert H. eauto. } - assert (hiz = eval_Zexpr_Z_total $0 hi). - { invert Heqhi. eapply eval_Zexpr_Z_eval_Zexpr in H0. eapply H7 in H0. - invert H0. eauto. } - subst. - + invert Hsize. eq_eval_Z. rename H17 into Hsize. + rename H8 into Hlo. rename H7 into Hhi. + pose proof Hlo as Hlo'. pose proof Hhi as Hhi'. + eapply eval_Zexpr_includes_valuation in Hlo', Hhi'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hlo', Hhi'. rewrite Hlo', Hhi' in *. invs'. + apply eval_Zexpr_Z_eval_Zexpr in Hlo, Hhi. + assert (result_has_shape (V (r::l)) (result_shape_nat (V(r::l)))) as Hsh. - { assert (eval_expr sh v ec (Gen i lo hi body) (V (r::l))). + { assert (eval_expr v ec (Gen i lo hi body) (V (r::l))). econstructor; eauto. - eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eassumption. eauto. - econstructor. eauto. } + eapply result_has_shape_self. + eapply size_of_eval_expr_result_has_shape; eauto. + simpl. eauto 9. } pose proof Halloc as Halloc1. eapply well_formed_allocation_result_V in Halloc; try apply Hrdx. - invs. + invs'. cases (reindexer (shape_to_index (result_shape_Z (V (r :: l))) (shape_to_vars (result_shape_Z (V (r :: l)))))). @@ -367,8 +310,8 @@ Proof. discriminate. erewrite <- tensor_to_array_delta_cons with (i:=i) (hi:=hi) (lo:=lo); - try eapply result_shape_gen_length in H5; - eauto; simpl; try rewrite H; try rewrite H0; try reflexivity; try lia. + try eapply result_shape_gen_length in H5; eauto; simpl; + try rewrite H; try rewrite Hlo'; try rewrite Hhi'; try reflexivity; try lia. 2: apply Hrdx. 2: apply Hrdx. 2: apply Hrdx. @@ -376,12 +319,13 @@ Proof. 2: apply Hrdx. 2: apply Henv. 2: { unfold shape_to_vars. unfold not. intros. eapply H3. - eapply in_map_iff in H6. invs. + eapply in_map_iff in H. invs'. eapply var_generation_contains_substring. } invert Heval. - 2: { rewrite H,H0 in *. invert H16. invert H17. lia. } - rewrite H,H0 in *. invert H12. invert H15. - invert Hpad. + 2: { rewrite Hlo', Hhi' in *. invs'. lia. } + rewrite Hlo',Hhi' in *. invs'. invert Hpad. + + cbv [eval_Zexpr_Z_total] in *. cbn [eval_Zexpr_Z] in *. rewrite Hlo, Hhi in *. cases k. 2: { eapply IHeval_expr1 in H19. @@ -393,15 +337,11 @@ Proof. propositional. simpl. unfold app_no_dups. rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H9. invs. - eapply cup_empty in H6. invs. - eapply constant_not_empty in H9. propositional. inversion 1. } - invs. rewrite H7 in *. clear Heq0. clear Heq. - * clear IHeval_expr1. pose proof IHeval_expr2. simpl in H6. + unfold not. intros. cups_empty. } + invs'. + * clear IHeval_expr1. pose proof IHeval_expr2 as H. simpl in H. unfold shift_top_dim_reindexer. - specialize H6 with + specialize H with (p:=p) (reindexer:= shift_top_dim_reindexer reindexer) (h:=(h $+ (p, @@ -413,47 +353,37 @@ Proof. reindexer (((! i ! - lo)%z,(hi - lo)%z) :: l)) (result_shape_Z r) - (v $+ (i, eval_Zexpr_Z_total $0 lo))) r)))). + (v $+ (i, loz0))) r)))). rewrite lookup_add_eq in * by auto. - rewrite add_overwrite in H6. + rewrite add_overwrite in H. rewrite (array_add_comm (tensor_to_array_delta _ _)). rewrite array_add_assoc. cases (shift_top_dim_reindexer reindexer (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l))))). - { unfold shift_top_dim_reindexer in Heq. - unfold result_shape_Z, shape_to_vars, shape_to_index in Heq. - simpl in Heq. - cases l; invert Heq. - - eapply reindexer_not_empty_vars_in_index in H10. propositional. - apply Hrdx. simpl. - repeat rewrite app_no_dups_empty_r. repeat rewrite cup_empty_r. - unfold not. intros. - eapply constant_not_empty in H9. propositional. inversion 1. - - eapply reindexer_not_empty_vars_in_index in H10. propositional. - apply Hrdx. simpl. - repeat rewrite app_no_dups_empty_r. repeat rewrite cup_empty_r. - unfold not. intros. - eapply cup_empty in H9. invs. - eapply constant_not_empty in H11. propositional. inversion 1. } -eapply H6 with (st:=st) (st':=st') (asn:=asm). - -- invert Hconst. simpl. invs. rewrite H9,H11. propositional. - rewrite eval_Zexpr_Z_total_add_distr. - simpl. unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - -- econstructor. eauto. - -- clear IHeval_expr2. - invs. + { unfold shift_top_dim_reindexer in Heq1. + unfold result_shape_Z, shape_to_vars, shape_to_index in Heq1. + simpl in Heq1. + cases l; invert Heq1. + - eapply reindexer_not_empty_vars_in_index in H9. propositional. + apply Hrdx. simpl. unfold not. intros. cups_empty. + - eapply reindexer_not_empty_vars_in_index in H9. propositional. + apply Hrdx. simpl. unfold not. intros. cups_empty. } + rewrite H0 in *. eapply H with (st:=st) (st':=st') (asn:=asm). + -- split; eauto. do 2 eexists. split; [|split]; eauto. lia. + -- econstructor; eauto. + -- clear IHeval_expr2. + invs'. unfold shift_top_dim_reindexer. eapply eq_eval_stmt_for. - eassumption. simpl. rewrite H. reflexivity. - rewrite H0. eauto. + eassumption. simpl. rewrite Hlo'. reflexivity. + rewrite Hhi'. eauto. intros. eapply eq_eval_stmt_lower_eq_reindexers; simpl; intros; decomp_well_formed_reindexer. ++ eassumption. - ++ invs. eapply HeqZlist. + ++ invs'. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons. propositional. 2: apply eq_Z_tuple_index_list_id. @@ -465,22 +395,22 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. eapply eq_zexpr_comm. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_sub_distr. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. -- decomp_well_formed_environment. unfold well_formed_environment. split. auto. ++ rewrite dom_add. - eapply lookup_Some_dom in H7. - unfold well_formed_environment in *. invs. + eapply lookup_Some_dom in H0. + unfold well_formed_environment in *. invs'. simpl in *. split. replace (constant [p] \cup dom h) with (dom h) by sets. @@ -499,33 +429,27 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). rewrite cup_empty_l. eapply constant_cap_empty. auto. propositional. - -- unfold well_formed_environment in *. invs. + -- unfold well_formed_environment in *. invs'. eapply well_formed_reindexer_shift_top_dim_reindexer; eauto. -- eapply well_formed_allocation_shift_top_dim_reindexer; try apply Hrdx; try apply Henv; eauto. -- eapply contexts_agree_add_heap; try apply Henv; auto. -- eapply HasPadGen with (k:=k) (c:=c) (ll:=ll) (rr:=rr). - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. eauto. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. - intros. apply H22. lia. - intros. eapply H24. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. - intros. apply H25. lia. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo. + intros. apply H21; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhi. + intros. apply H23; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H24; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. lia. -- eauto. - * invert Hconst. propositional. + * eassumption. * eassumption. * eapply well_formed_environment_add_valuation. simpl in Henv. @@ -533,16 +457,16 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). * eapply well_formed_allocation_result_V in Halloc1. eapply well_formed_reindexer_eval0. eassumption. eapply Henv. - eauto. eauto. - unfold not. intros. - eapply shape_to_vars_contains_substring in H6. + eauto. eauto. + unfold not. intros H. + eapply shape_to_vars_contains_substring in H. propositional. - simpl in *. lia. auto. auto. eauto. + eauto. eauto. simpl in *. lia. eauto. lia. eauto. apply Hrdx. * eapply well_formed_allocation_eval_step; try apply Halloc; eauto; try apply Hrdx; try apply Henv. * eauto. - * eapply H25. lia. lia. + * eapply H24; lia. * eauto. } @@ -557,15 +481,11 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). propositional. simpl. unfold app_no_dups. rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H9. invs. - eapply cup_empty in H6. invs. - eapply constant_not_empty in H9. propositional. inversion 1. } - invs. rewrite H7 in *. clear Heq0. clear Heq. - * clear IHeval_expr1. pose proof IHeval_expr2. simpl in H6. + unfold not. intros. cups_empty. } + invs'. clear Heq0. clear Heq. + * clear IHeval_expr1. pose proof IHeval_expr2 as H. simpl in H. unfold shift_top_dim_reindexer. - specialize H6 with + specialize H with (p:=p) (reindexer:= shift_top_dim_reindexer reindexer) (h:=(h $+ (p, @@ -577,9 +497,9 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). reindexer (((! i ! - lo)%z,(hi - lo)%z) :: l)) (result_shape_Z r) - (v $+ (i, eval_Zexpr_Z_total $0 lo))) r)))). + (v $+ (i, loz0))) r)))). rewrite lookup_add_eq in * by auto. - rewrite add_overwrite in H6. + rewrite add_overwrite in H. rewrite (array_add_comm (tensor_to_array_delta _ _)). rewrite array_add_assoc. cases (shift_top_dim_reindexer @@ -590,34 +510,25 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). unfold result_shape_Z, shape_to_vars, shape_to_index in Heq. simpl in Heq. cases l; invert Heq. - - eapply reindexer_not_empty_vars_in_index in H10. propositional. - apply Hrdx. simpl. - repeat rewrite app_no_dups_empty_r. repeat rewrite cup_empty_r. - unfold not. intros. - eapply constant_not_empty in H9. propositional. inversion 1. - - eapply reindexer_not_empty_vars_in_index in H10. propositional. - apply Hrdx. simpl. - repeat rewrite app_no_dups_empty_r. repeat rewrite cup_empty_r. - unfold not. intros. - eapply cup_empty in H9. invs. - eapply constant_not_empty in H11. propositional. inversion 1. } -eapply H6 with (st:=st) (st':=st') (asn:=asm). - -- invert Hconst. simpl. invs. rewrite H9,H11. propositional. - rewrite eval_Zexpr_Z_total_add_distr. - simpl. unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - -- econstructor. eauto. + - eapply reindexer_not_empty_vars_in_index in H9. propositional. + apply Hrdx. simpl. intros ?. cups_empty. + - eapply reindexer_not_empty_vars_in_index in H9. propositional. + apply Hrdx. simpl. intros ?. cups_empty. } + rewrite H0 in *. + eapply H with (st:=st) (st':=st') (asn:=asm). + -- split; eauto. do 2 eexists. split; [|split]; eauto. lia. + -- econstructor; eauto. -- clear IHeval_expr2. - invs. + invs'. unfold shift_top_dim_reindexer. eapply eq_eval_stmt_for. - eassumption. simpl. rewrite H. reflexivity. - rewrite H0. eauto. + eassumption. simpl. rewrite Hlo'. reflexivity. + rewrite Hhi'. eauto. intros. eapply eq_eval_stmt_lower_eq_reindexers; simpl; intros; decomp_well_formed_reindexer. ++ eassumption. - ++ invs. eapply HeqZlist. + ++ invs'. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons. propositional. 2: apply eq_Z_tuple_index_list_id. @@ -629,22 +540,22 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. eapply eq_zexpr_comm. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_sub_distr. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. -- decomp_well_formed_environment. unfold well_formed_environment. split. auto. ++ rewrite dom_add. - eapply lookup_Some_dom in H7. - unfold well_formed_environment in *. invs. + eapply lookup_Some_dom in H0. + unfold well_formed_environment in *. invs'. simpl in *. split. replace (constant [p] \cup dom h) with (dom h) by sets. @@ -663,33 +574,27 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). rewrite cup_empty_l. eapply constant_cap_empty. auto. propositional. - -- unfold well_formed_environment in *. invs. + -- unfold well_formed_environment in *. invs'. eapply well_formed_reindexer_shift_top_dim_reindexer; eauto. -- eapply well_formed_allocation_shift_top_dim_reindexer; try apply Hrdx; try apply Henv; eauto. -- eapply contexts_agree_add_heap; try apply Henv; auto. -- eapply HasPadGen with (k:=0) (c:=c) (ll:=ll) (rr:=rr). - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. eauto. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. - intros. apply H22. lia. - intros. eapply H24. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. - intros. apply H25. lia. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo. + intros. apply H21; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhi. + intros. apply H23; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H24; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. lia. -- eauto. - * invert Hconst. propositional. + * eassumption. * eassumption. * eapply well_formed_environment_add_valuation. simpl in Henv. @@ -697,15 +602,15 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). * eapply well_formed_allocation_result_V in Halloc1. eapply well_formed_reindexer_eval0. eassumption. eapply Henv. - eauto. eauto. + eauto. eauto. unfold not. intros. - eapply shape_to_vars_contains_substring in H6. + eapply shape_to_vars_contains_substring in H. propositional. - simpl in *. lia. auto. auto. eauto. lia. eauto. apply Hrdx. + eauto. eauto. simpl in *. lia. eauto. lia. eauto. apply Hrdx. * eapply well_formed_allocation_eval_step; try apply Halloc; eauto; try apply Hrdx; try apply Henv. * eauto. - * eapply H22. lia. + * eapply H21; lia. * eauto. } @@ -719,15 +624,11 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). propositional. simpl. unfold app_no_dups. rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H9. invs. - eapply cup_empty in H6. invs. - eapply constant_not_empty in H9. propositional. inversion 1. } - invs. rewrite H7 in *. clear Heq0. clear Heq. - * clear IHeval_expr1. pose proof IHeval_expr2. simpl in H6. + unfold not. intros. cups_empty. } + invs'. clear Heq0. clear Heq. + * clear IHeval_expr1. pose proof IHeval_expr2 as H. simpl in H. unfold shift_top_dim_reindexer. - specialize H6 with + specialize H with (p:=p) (reindexer:= shift_top_dim_reindexer reindexer) (h:=(h $+ (p, @@ -739,9 +640,9 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). reindexer (((! i ! - lo)%z,(hi - lo)%z) :: l)) (result_shape_Z r) - (v $+ (i, eval_Zexpr_Z_total $0 lo))) r)))). + (v $+ (i, loz0))) r)))). rewrite lookup_add_eq in * by auto. - rewrite add_overwrite in H6. + rewrite add_overwrite in H. rewrite (array_add_comm (tensor_to_array_delta _ _)). rewrite array_add_assoc. cases (shift_top_dim_reindexer @@ -752,34 +653,25 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). unfold result_shape_Z, shape_to_vars, shape_to_index in Heq. simpl in Heq. cases l; invert Heq. - - eapply reindexer_not_empty_vars_in_index in H10. propositional. - apply Hrdx. simpl. - repeat rewrite app_no_dups_empty_r. repeat rewrite cup_empty_r. - unfold not. intros. - eapply constant_not_empty in H9. propositional. inversion 1. - - eapply reindexer_not_empty_vars_in_index in H10. propositional. - apply Hrdx. simpl. - repeat rewrite app_no_dups_empty_r. repeat rewrite cup_empty_r. - unfold not. intros. - eapply cup_empty in H9. invs. - eapply constant_not_empty in H11. propositional. inversion 1. } -eapply H6 with (st:=st) (st':=st') (asn:=asm). - -- invert Hconst. simpl. invs. rewrite H9,H11. propositional. - rewrite eval_Zexpr_Z_total_add_distr. - simpl. unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - -- econstructor. eauto. + - eapply reindexer_not_empty_vars_in_index in H9. propositional. + apply Hrdx. simpl. unfold not. intros. cups_empty. + - eapply reindexer_not_empty_vars_in_index in H9. propositional. + apply Hrdx. simpl. unfold not. intros. cups_empty. } + rewrite H0 in *. + eapply H with (st:=st) (st':=st') (asn:=asm). + -- split; eauto. do 2 eexists. split; [|split]; eauto. lia. + -- econstructor; eauto. -- clear IHeval_expr2. - invs. + invs'. unfold shift_top_dim_reindexer. eapply eq_eval_stmt_for. - eassumption. simpl. rewrite H. reflexivity. - rewrite H0. eauto. + eassumption. simpl. rewrite Hlo'. reflexivity. + rewrite Hhi'. eauto. intros. eapply eq_eval_stmt_lower_eq_reindexers; simpl; intros; decomp_well_formed_reindexer. ++ eassumption. - ++ invs. eapply HeqZlist. + ++ invs'. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons. propositional. 2: apply eq_Z_tuple_index_list_id. @@ -791,22 +683,22 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. eapply eq_zexpr_comm. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_sub_distr. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. -- decomp_well_formed_environment. unfold well_formed_environment. split. auto. ++ rewrite dom_add. - eapply lookup_Some_dom in H7. - unfold well_formed_environment in *. invs. + eapply lookup_Some_dom in H0. + unfold well_formed_environment in *. invs'. simpl in *. split. replace (constant [p] \cup dom h) with (dom h) by sets. @@ -825,33 +717,27 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). rewrite cup_empty_l. eapply constant_cap_empty. auto. propositional. - -- unfold well_formed_environment in *. invs. + -- unfold well_formed_environment in *. invs'. eapply well_formed_reindexer_shift_top_dim_reindexer; eauto. -- eapply well_formed_allocation_shift_top_dim_reindexer; try apply Hrdx; try apply Henv; eauto. -- eapply contexts_agree_add_heap; try apply Henv; auto. -- eapply HasPadGen with (k:=0) (c:=c) (ll:=0) (rr:=rr). - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. eauto. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. - intros. apply H22. lia. - intros. eapply H24. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. - intros. apply H25. lia. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo. + intros. apply H21; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhi. + intros. apply H23; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H24; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. lia. -- eauto. - * invert Hconst. propositional. + * eassumption. * eassumption. * eapply well_formed_environment_add_valuation. simpl in Henv. @@ -859,15 +745,15 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). * eapply well_formed_allocation_result_V in Halloc1. eapply well_formed_reindexer_eval0. eassumption. eapply Henv. - eauto. eauto. + eauto. eauto. unfold not. intros. - eapply shape_to_vars_contains_substring in H6. + eapply shape_to_vars_contains_substring in H. propositional. - simpl in *. lia. auto. auto. eauto. lia. eauto. apply Hrdx. + eauto. eauto. simpl in *. lia. eauto. lia. eauto. apply Hrdx. * eapply well_formed_allocation_eval_step; try apply Halloc; eauto; try apply Hrdx; try apply Henv. * eauto. - * eapply H24. lia. + * eapply H23; lia. * eauto. } @@ -880,15 +766,11 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). propositional. simpl. unfold app_no_dups. rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H9. invs. - eapply cup_empty in H6. invs. - eapply constant_not_empty in H9. propositional. inversion 1. } - invs. rewrite H7 in *. clear Heq0. clear Heq. - * clear IHeval_expr1. pose proof IHeval_expr2. simpl in H6. + unfold not. intros. cups_empty. } + invs'. clear Heq0. clear Heq. + * clear IHeval_expr1. pose proof IHeval_expr2 as H. simpl in H. unfold shift_top_dim_reindexer. - specialize H6 with + specialize H with (p:=p) (reindexer:= shift_top_dim_reindexer reindexer) (h:=(h $+ (p, @@ -900,9 +782,9 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). reindexer (((! i ! - lo)%z,(hi - lo)%z) :: l)) (result_shape_Z r) - (v $+ (i, eval_Zexpr_Z_total $0 lo))) r)))). + (v $+ (i, loz0))) r)))). rewrite lookup_add_eq in * by auto. - rewrite add_overwrite in H6. + rewrite add_overwrite in H. rewrite (array_add_comm (tensor_to_array_delta _ _)). rewrite array_add_assoc. cases (shift_top_dim_reindexer @@ -913,34 +795,25 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). unfold result_shape_Z, shape_to_vars, shape_to_index in Heq. simpl in Heq. cases l; invert Heq. - - eapply reindexer_not_empty_vars_in_index in H10. propositional. - apply Hrdx. simpl. - repeat rewrite app_no_dups_empty_r. repeat rewrite cup_empty_r. - unfold not. intros. - eapply constant_not_empty in H9. propositional. inversion 1. - - eapply reindexer_not_empty_vars_in_index in H10. propositional. - apply Hrdx. simpl. - repeat rewrite app_no_dups_empty_r. repeat rewrite cup_empty_r. - unfold not. intros. - eapply cup_empty in H9. invs. - eapply constant_not_empty in H11. propositional. inversion 1. } -eapply H6 with (st:=st) (st':=st') (asn:=asm). - -- invert Hconst. simpl. invs. rewrite H9,H11. propositional. - rewrite eval_Zexpr_Z_total_add_distr. - simpl. unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - -- econstructor. eauto. + - eapply reindexer_not_empty_vars_in_index in H9. propositional. + apply Hrdx. simpl. unfold not. intros. cups_empty. + - eapply reindexer_not_empty_vars_in_index in H9. propositional. + apply Hrdx. simpl. unfold not. intros. cups_empty. } + rewrite H0 in *. + eapply H with (st:=st) (st':=st') (asn:=asm). + -- split; eauto. do 2 eexists. split; [|split]; eauto. lia. + -- econstructor; eauto. -- clear IHeval_expr2. - invs. + invs'. unfold shift_top_dim_reindexer. eapply eq_eval_stmt_for. - eassumption. simpl. rewrite H. reflexivity. - rewrite H0. eauto. + eassumption. simpl. rewrite Hlo'. reflexivity. + rewrite Hhi'. eauto. intros. eapply eq_eval_stmt_lower_eq_reindexers; simpl; intros; decomp_well_formed_reindexer. ++ eassumption. - ++ invs. eapply HeqZlist. + ++ invs'. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons. propositional. 2: apply eq_Z_tuple_index_list_id. @@ -952,22 +825,22 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. eapply eq_zexpr_comm. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_sub_distr. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. -- decomp_well_formed_environment. unfold well_formed_environment. split. auto. ++ rewrite dom_add. - eapply lookup_Some_dom in H7. - unfold well_formed_environment in *. invs. + eapply lookup_Some_dom in H0. + unfold well_formed_environment in *. invs'. simpl in *. split. replace (constant [p] \cup dom h) with (dom h) by sets. @@ -986,33 +859,27 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). rewrite cup_empty_l. eapply constant_cap_empty. auto. propositional. - -- unfold well_formed_environment in *. invs. + -- unfold well_formed_environment in *. invs'. eapply well_formed_reindexer_shift_top_dim_reindexer; eauto. -- eapply well_formed_allocation_shift_top_dim_reindexer; try apply Hrdx; try apply Henv; eauto. -- eapply contexts_agree_add_heap; try apply Henv; auto. -- eapply HasPadGen with (k:=0) (c:=c-1) (ll:=0) (rr:=0). - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. eauto. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. - intros. apply H22. lia. - intros. eapply H24. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. - intros. apply H25. lia. lia. - erewrite eval_Zexpr_Z_total_add_distr by auto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo. + intros. apply H21; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhi. + intros. apply H23; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H24; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. lia. -- eauto. - * invert Hconst. propositional. + * eassumption. * eassumption. * eapply well_formed_environment_add_valuation. simpl in Henv. @@ -1020,126 +887,95 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). * eapply well_formed_allocation_result_V in Halloc1. eapply well_formed_reindexer_eval0. eassumption. eapply Henv. - eauto. eauto. + eauto. eauto. unfold not. intros. - eapply shape_to_vars_contains_substring in H6. + eapply shape_to_vars_contains_substring in H. propositional. - simpl in *. lia. auto. auto. eauto. lia. eauto. apply Hrdx. + eauto. eauto. simpl in *. lia. auto. auto. eauto. lia. eauto. apply Hrdx. * eapply well_formed_allocation_eval_step; try apply Halloc; eauto; try apply Hrdx; try apply Henv. * eauto. - * eapply H25. lia. lia. + * eapply H24; lia. * eauto. - (* STEPPING SUM *) simpl in *. unfold lookup_total in *. - invert Hsize. pose proof H12 as Hsize. clear H12. - assert (result_has_shape s - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) ls))) as Hsh. - { assert (eval_expr sh v ec (Sum i lo hi body) s). + invert Hsize. rename H12 into Hsize. + rename H into Hlo. rename H0 into Hhi. + + assert (result_has_shape s ls) as Hsh. + { assert (eval_expr v ec (Sum i lo hi body) s). econstructor; eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eassumption. eauto. - eauto. } + eapply size_of_eval_expr_result_has_shape; eauto. } pose proof H6 as Hshh. eapply result_has_shape_add_result_result in Hshh. 2: { eassumption. } inversion Hshh as [Hsh1 Hsh2 ]. clear Hshh. invert Heval; eq_eval_Z; try lia. - rewrite H11,H14 in *. invert H. invert H0. + rewrite Hlo,Hhi in *. invs'. invert Hpad. - { eapply eval_Zexpr_Z_eval_Zexpr in H11,H14. - invs. eq_eval_Z. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H,H7. invert H. invert H7. - eapply H in H14. - eapply H0 in H11. invert H14. invert H11. lia. } - - eapply IHeval_expr1 with (asn:=Reduce) in H18; clear IHeval_expr1. + { cbv [eval_Zexpr_Z_total] in *. rewrite Hhi, Hlo in *. lia. } + + eapply IHeval_expr1 with (asn:=Reduce) in H16; clear IHeval_expr1. cases (reindexer (shape_to_index (result_shape_Z s) (shape_to_vars (result_shape_Z s)))). + pose proof Halloc as Halloc1. erewrite result_has_shape_result_shape_Z in *; try eassumption. - rewrite Heq in *. invs. + rewrite Heq in *. invs'. cases r. - 2: { invert H6. eq_size_of. invert Hsh1. - rewrite <- H10 in *. simpl in *. + 2: { invert Hsh1. eapply reindexer_not_empty in Heq. propositional. apply Hrdx. inversion 1. - rewrite <- H6 in *. simpl in *. eapply reindexer_not_empty in Heq. propositional. apply Hrdx. inversion 1. } invert H6. - * invert Hsh. invert Hsh1. invert Hsh2. - rewrite <- H10 in *. simpl in *. + invert Hsh. invert Hsh1. invert Hsh2. unfold well_formed_allocation in Halloc1. unfold result_shape_Z in Halloc1. - simpl in Halloc1. rewrite Heq in Halloc1. invs. - rewrite H0. + simpl in Halloc1. simpl in Heq. rewrite Heq in Halloc1. invs'. + rewrite H in *. - cases (Z.to_nat (eval_Zexpr_Z_total $0 hi - - (eval_Zexpr_Z_total $0 lo + 1))). + cbv [eval_Zexpr_Z_total] in *. rewrite Hlo, Hhi in *. + + cases (Z.to_nat (hiz0 - (loz0 + 1))). { invert H5. - simpl in H22. rewrite H11 in *. rewrite H23 in *. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H23,H11. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H,H7. - invert H. invert H7. - eapply H5 in H11. eapply H in H23. invert H23. invert H11. lia. + cbv [eval_Zexpr_Z_total] in *. simpl in *. rewrite Hlo, Hhi in *. + invs'. lia. - simpl in H25. rewrite H11 in *. rewrite H26 in *. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H26,H11. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H,H7. - invert H. invert H7. - eapply H5 in H11. eapply H in H26. invert H26. invert H11. - assert (eval_Zexpr_Z_total $0 hi = eval_Zexpr_Z_total $0 lo + 1)%Z - by lia. rewrite H7 in *. - cases lz; simpl in *; try discriminate. invert H22. - invert H9. - * rewrite H0 in *. - assert (vars_of_Zexpr lo ++/ [] = [] /\ - vars_of_Zexpr hi = [] /\ constant_nonneg_bounds body). - { rewrite H6. propositional. } - - eapply IHeval_expr2 with (asn:=Reduce) in H9. - 2: { econstructor. eauto. } - 2: { eauto. } + cbv [eval_Zexpr_Z_total] in *. simpl in *. rewrite Hlo, Hhi in *. + invs'. + cases sz; simpl in *; try discriminate. invert H14. + invert H0. + * eapply IHeval_expr2 with (asn:=Reduce) in H17. + 2: { assumption. } + 2: { econstructor; eauto. } 2: { eapply well_formed_environment_add_stack. eauto. - eapply lookup_Some_dom in H0. sets. } + eapply lookup_Some_dom in H. sets. } 2: { replace (S SX) with (gen_pad []) by reflexivity. decomp_well_formed_reindexer. simpl. propositional. - unfold partial_injective. intros. invert H21. + unfold partial_injective. intros. invert0 H5. unfold nondestructivity. split; intros; discriminate. } 2: { eapply well_formed_allocation_same_add_stack. replace (S SX) with (gen_pad []) by reflexivity. eapply well_formed_allocation_gen_pad. eauto. econstructor. } - 2: { unfold well_formed_environment in *. invs. + 2: { unfold well_formed_environment in *. invs'. eapply contexts_agree_add_in_stack. eauto. eauto. auto. eauto. } - 2: { eapply HasPadSumEmpty. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eauto. eauto. eauto. } - rewrite Heq in *. invs. + 2: { eapply HasPadSumEmpty. eauto. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + reflexivity. } + rewrite Heq in *. invs'. rewrite lookup_add_eq in * by auto. rewrite add_overwrite. propositional. f_equal. ring. eauto. - * rewrite H0 in *. - assert (vars_of_Zexpr lo ++/ [] = [] /\ - vars_of_Zexpr hi = [] /\ constant_nonneg_bounds body). - { rewrite H6. propositional. } - - eapply IHeval_expr2 with (asn:=Reduce) in H9. - 2: { econstructor. eauto. } - 2: { eauto. } + * eapply IHeval_expr2 with (asn:=Reduce) in H17. + 2: { assumption. } + 2: { econstructor; eauto. } 2: { eapply well_formed_environment_add_stack. eauto. - eapply lookup_Some_dom in H0. sets. } + eapply lookup_Some_dom in H. sets. } 2: { replace (S SX) with (gen_pad []) by reflexivity. decomp_well_formed_reindexer. propositional. simpl. unfold nondestructivity. @@ -1148,138 +984,91 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). replace (S SX) with (gen_pad []) by reflexivity. eapply well_formed_allocation_gen_pad. eauto. econstructor. } - 2: { unfold well_formed_environment in *. invs. + 2: { unfold well_formed_environment in *. invs'. eapply contexts_agree_add_in_stack. eauto. eauto. auto. eauto. } - 2: { eapply HasPadSumEmpty. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eauto. eauto. eauto. } - rewrite Heq in *. invs. + 2: { eapply HasPadSumEmpty. eauto. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + reflexivity. } + rewrite Heq in *. invs'. rewrite lookup_add_eq in * by auto. rewrite add_overwrite. propositional. f_equal. ring. eauto. } pose proof Heq0 as Heq'. clear Heq0. - eapply IHeval_expr2 with (asn:=Reduce) in H19; clear IHeval_expr2. - rewrite Heq in *. invs. - rewrite H0. + eapply IHeval_expr2 with (asn:=Reduce) in H17; clear IHeval_expr2. + simpl in H17. rewrite Heq in *. invs'. rewrite lookup_add_eq by auto. rewrite add_overwrite. propositional. f_equal. - cases z; cases s2; cases s3; try now invert H9. - invert H9. ring. - invert H9. ring. - invert H9. ring. + cases z; cases s2; cases s3; try now invert H0. + invert H0. ring. + invert H0. ring. + invert H0. ring. ring. - eauto. - eauto. - eauto. - rewrite H. propositional. eauto. eauto. + { assumption. } + { econstructor; eauto. } eapply well_formed_environment_add_stack. eauto. eapply lookup_Some_dom. eauto. decomp_well_formed_reindexer. unfold result_shape_Z in *. simpl in *. propositional. cases s2; cases s3; simpl in *; auto. - invert H9. invert H9. simpl in *. + invert H0. invert H0. simpl in *. unfold partial_injective in *. propositional. simpl in *. propositional. - rewrite H0. unfold nondestructivity. split; intros; discriminate. unfold well_formed_allocation. unfold result_shape_Z. simpl. rewrite Heq. - eexists. rewrite H0. rewrite lookup_add_eq by auto. + eexists. rewrite lookup_add_eq by auto. reflexivity. - rewrite H0. eapply contexts_agree_add_in_stack; eauto. apply Henv. apply Henv. apply HasPadSum. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. simpl. - intros. eapply H15. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eauto. - eauto. - eauto. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. eauto. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. eapply H12; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. eauto. + pose proof Heq. eapply well_formed_allocation_reindexer_not_empty in Heq; - try apply Halloc. - invs. rewrite H10 in *. + try apply Halloc. + invs'. rewrite H7 in *. erewrite result_has_shape_result_shape_Z in *; try eassumption. - invs. rewrite H in *. invs. - cases (Z.to_nat (eval_Zexpr_Z_total $0 hi - - (eval_Zexpr_Z_total $0 lo + 1))). + invs'. rewrite H in *. invs'. + cases (Z.to_nat (hiz0 - (loz0 + 1))). { invert H5. - simpl in H21. rewrite H11 in *. rewrite H22 in *. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H22,H11. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H0,H8. - invert H0. invert H8. - eapply H5 in H11. eapply H0 in H22. invert H22. invert H11. lia. + simpl in *. rewrite Hlo, Hhi in *. invs'. lia. eq_size_of. - simpl in H21. rewrite H11 in *. rewrite H24 in *. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H24,H11. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H0,H8. - invert H0. invert H8. - eapply H5 in H11. eapply H0 in H24. invert H24. invert H11. - assert (eval_Zexpr_Z_total $0 hi = eval_Zexpr_Z_total $0 lo + 1)%Z - by lia. rewrite H8 in *. - pose proof H6 as Hh. - eapply add_result_gen_pad_r in Hh. subst. - 2: { reflexivity. } - 2: { eapply result_has_shape_add_result_result in Hh; eauto. - invs. - pose proof (result_has_shape_gen_pad (map Z.to_nat lz)). - pose proof H11. - eapply result_has_shape_result_shape_nat in H14,H18. - rewrite H14 in H18. clear H14. - eapply result_has_shape_filter_until_0. - rewrite <- H18. - erewrite <- result_has_shape_filter_until_0. eauto. } + simpl in *. rewrite Hlo, Hhi in *. invs'. - assert (vars_of_Zexpr lo ++/ [] = [] /\ - vars_of_Zexpr hi = [] /\ constant_nonneg_bounds body). - { rewrite H7. propositional. } + pose proof H6 as Hh. + eapply add_result_gen_pad_r in Hh; eauto. subst. - eapply IHeval_expr2 with (asn:=Reduce) in H11. - 2: { econstructor. eauto. } - 2: { eauto. } + eapply IHeval_expr2 with (asn:=Reduce) in H17. + 2: { assumption. } + 2: { econstructor; eauto. } 2: { eapply well_formed_environment_add_heap. eauto. eauto. } 2: { pose proof Hrdx. decomp_well_formed_reindexer. propositional. unfold partial_injective. intros. erewrite filter_negb_is_None_result_lookup_Z_option_gen_pad - in *. invert H29. + in *. contradiction. unfold nondestructivity. split; intros; discriminate. } 2: { eapply well_formed_allocation_add_heap. eapply well_formed_allocation_gen_pad. eauto. - pose proof (result_has_shape_gen_pad (map Z.to_nat lz)). - eapply result_has_shape_result_shape_nat in H14,Hsh2. - rewrite Hsh2 in *. eapply result_has_shape_filter_until_0. - rewrite <- H14. erewrite <- result_has_shape_filter_until_0. eauto. eauto. } 2: { unfold well_formed_environment in *. eapply contexts_agree_add_heap. eauto. eauto. propositional. propositional. } 2: { eapply HasPadSumEmpty. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eauto. eauto. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhi, Hlo. lia. + reflexivity. } rewrite H in *. rewrite lookup_add_eq in * by auto. - invs. propositional. + invs'. propositional. rewrite add_overwrite. rewrite tensor_to_array_delta_gen_pad. rewrite array_add_empty_r. @@ -1288,13 +1077,12 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eauto. } - eapply IHeval_expr2 with (asn:=Reduce) in H19; clear IHeval_expr2; + eapply IHeval_expr2 with (asn:=Reduce) in H17; clear IHeval_expr2; try apply Hrdx; try apply Henv; eauto. - rewrite lookup_add_eq in H19 by auto. - rewrite H in *. invs. + rewrite lookup_add_eq in H17 by auto. + rewrite H in *. invs'. rewrite add_overwrite. rewrite <- array_add_assoc. split. 2: auto. f_equal. f_equal. - 2: { rewrite H0. propositional. } 2: { eapply well_formed_environment_add_heap; eauto. } 2 :{ decomp_well_formed_reindexer. propositional. eapply partial_injective_add_result_r; try apply H6; eauto. @@ -1303,26 +1091,20 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply well_formed_allocation_add_result_r; eauto. } 2: { eapply contexts_agree_add_heap; eauto. apply Henv. apply Henv. } - - replace (map Z.of_nat - (filter_until (map Z.to_nat - (map (eval_Zexpr_Z_total $0) ls)) 0)) + + replace (map Z.of_nat (filter_until ls 0)) with (result_shape_Z r) at 1. 2: { erewrite result_has_shape_result_shape_Z; eauto. } erewrite tensor_to_array_delta_add_valuation; eauto; try apply Hrdx. 2: { eapply partial_injective_add_result_l; try apply H6; eauto. eapply partial_injective_add_valuation; try apply Hrdx; eauto. } - - replace (map Z.of_nat - (filter_until (map Z.to_nat - (map (eval_Zexpr_Z_total $0) ls)) 0)) + + replace (map Z.of_nat (filter_until ls 0)) with (result_shape_Z r') at 1. 2: { erewrite result_has_shape_result_shape_Z; eauto. } - replace (map Z.of_nat - (filter_until (map Z.to_nat - (map (eval_Zexpr_Z_total $0) ls)) 0)) - with (result_shape_Z s) at 1. + replace (map Z.of_nat (filter_until ls 0)) + with (result_shape_Z s) at 1. 2: { erewrite result_has_shape_result_shape_Z; eauto. } eapply tensor_to_array_delta_add_result. auto. @@ -1334,18 +1116,11 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. auto. apply Henv. apply HasPadSum. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. simpl. - intros. apply H15. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eauto. - eauto. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. eauto. - + propositional. - + eauto. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H12. cbv [eval_Zexpr_Z_total]. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + + eassumption. + + eassumption. + eapply well_formed_environment_add_valuation; eauto. + eapply well_formed_reindexer_add_valuation; eauto. decomp_well_formed_reindexer. @@ -1358,33 +1133,27 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eauto; try apply Hrdx. eapply well_formed_allocation_add_result_l; eauto. + eauto. - + eapply H15. invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H,H7. - invert H. invert H7. eapply eval_Zexpr_Z_eval_Zexpr in H11,H14. - eapply H0 in H11. eapply H in H14. invert H11. invert H14. lia. + + apply H12. + cbv [eval_Zexpr_Z_total] in *. rewrite Hhi, Hlo in *. lia. + eauto. - + erewrite H15 in *. erewrite H16 in *. invs. lia. + + erewrite H13 in *. erewrite H14 in *. invs'. lia. - (* EMPTY SUM *) simpl in Heval. invert Heval. - rewrite H8,H11 in *. invert H. invert H0. lia. - rewrite H12,H13 in *. invert H. invert H0. - unfold lookup_total. - simpl in Hconst. invert Hsize. eq_size_of. - inversion Hconst as [ Hlo [ Hhi Hconst' ]]; clear Hconst. - pose proof Hconst' as Hconst. - eapply constant_nonneg_bounds_sizeof_nonneg in Hconst. - 2: { erewrite size_of_sizeof by eassumption. eassumption. } - cases (reindexer + rewrite H, H0 in *. invs'. lia. + unfold lookup_total in *. + invert Hsize. rename H13 into Hsize. eq_size_of. + rename H11 into Hlo. rename H12 into Hhi. + rewrite Hlo, Hhi in *. invs'. + + destruct (reindexer (shape_to_index - (result_shape_Z (gen_pad (map Z.to_nat lz))) - (shape_to_vars (result_shape_Z (gen_pad - (map Z.to_nat lz)))))). - { unfold well_formed_allocation in *. rewrite Heq in *. invs. + (result_shape_Z (gen_pad _)) + (shape_to_vars (result_shape_Z (gen_pad _))))) eqn:Heq. + { unfold well_formed_allocation in *. rewrite Heq in *. invs'. rewrite H. split. auto. - cases lz; simpl; rewrite add_id; try rewrite Rplus_0_r; auto. } + cases sz; simpl; rewrite add_id; try rewrite Rplus_0_r; auto. } eapply well_formed_allocation_reindexer_not_empty in Heq; - try apply Halloc. invs. + try apply Halloc. invs'. rewrite H0 in *. rewrite tensor_to_array_delta_gen_pad. rewrite array_add_empty_r. @@ -1395,319 +1164,272 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). unfold lookup_total. cases (reindexer (shape_to_index - (result_shape_Z (gen_pad (map Z.to_nat lz))) + (result_shape_Z (gen_pad sz)) (shape_to_vars - (result_shape_Z (gen_pad (map Z.to_nat lz)))))). - { unfold well_formed_allocation in *. rewrite Heq in *. invs. - rewrite H3. split. auto. - cases lz; simpl; rewrite add_id; try rewrite Rplus_0_r; auto. } + (result_shape_Z (gen_pad sz))))). + { unfold well_formed_allocation in *. rewrite Heq in *. invs'. + rewrite H2. split. auto. + cases sz; simpl; rewrite add_id; try rewrite Rplus_0_r; auto. } eapply well_formed_allocation_reindexer_not_empty in Heq; - try apply Halloc. invs. - rewrite H4. rewrite tensor_to_array_delta_gen_pad. + try apply Halloc. invs'. + rewrite H3. rewrite tensor_to_array_delta_gen_pad. rewrite array_add_empty_r. rewrite add_id. propositional. auto. - (* TRUE IVERSON *) cases (reindexer (shape_to_index (result_shape_Z r) (shape_to_vars (result_shape_Z r)))). + unfold well_formed_allocation in *. - rewrite Heq in *. invs. + rewrite Heq in *. invs. simpl in Heval. invert Heval; eq_eval_B; try lia. - invert Hpad. eq_eval_B. discriminate. + invert Hpad. eq_eval_B. discriminate. eapply IHeval_expr in H7; eauto. rewrite Heq in *. auto. rewrite Heq. eauto. + simpl in Heval. invert Heval; eq_eval_B; try lia. - invert Hpad. eq_eval_B. discriminate. + invert Hpad. eq_eval_B. discriminate. eapply IHeval_expr in H5; eauto. rewrite Heq in H5. auto. invs. eauto. - - (* SCALAR LET *) - simpl in *. - erewrite size_of_sizeof in Heval by eassumption. simpl in Heval. - invert Heval. invert H12. invert H14. invert H15. invert H9. - inversion Hconst as [ Hconst1 Hconst2]. - invert Hpad. - eapply IHeval_expr1 in H10; try eassumption. - 2: { eapply well_formed_environment_alloc_stack; eauto. sets. - sets. } - 2: { decomp_well_formed_reindexer. propositional. - simpl. unfold partial_injective. - { destruct r1. - - simpl. intros. propositional. subst. propositional. - - simpl. propositional. } - simpl. sets. - simpl. sets. - unfold nondestructivity. simpl. - rewrite lookup_add_eq by eauto. rewrite dom_add. - split; intros. sets. invert H12. sets. } - 2: { apply well_formed_allocation_scalar_id. } - 2: { eapply contexts_agree_alloc_stack; eauto. } - simpl in H10. rewrite lookup_add_eq in * by auto. - rewrite add_overwrite in H10. invert H10. - clear IHeval_expr1. - eapply IHeval_expr2 in H11. - 2: eauto. - 2: { invert Hsize. eauto. } - 2: { rewrite Rplus_0_l. - eapply well_formed_environment_let_bind1_scalar. - eauto. sets. sets. sets. } - 2: { decomp_well_formed_reindexer. propositional. - unfold nondestructivity in *. rewrite dom_add. - invert Henv. rewrite lookup_add_ne. - 2: { sets. } - split; intros. - eapply Hnondstr. eauto. eauto. sets. - eauto. eapply Hnondstr. eauto. eauto. sets. } - 2: { eapply well_formed_allocation_add_stack. auto. - unfold well_formed_environment in *. sets. } - 2: { rewrite Rplus_0_l. - eapply contexts_agree_let_bind1_scalar. auto. } - 2: { eq_size_of. eassumption. } - 2: { intros. cases (x0 ==v x). - - subst. rewrite lookup_add_eq in * by auto. invs. - simpl. eq_size_of. - eapply has_pad_gen_pad in H13. - 2: { eauto. } - 2: { eauto. } - 2: { econstructor. } - eauto. eauto. eauto. - eapply contexts_agree_result_has_shape. eauto. - eauto. - - rewrite lookup_add_ne in * by eauto. eauto. } - - pose proof Halloc as Halloc1. - unfold well_formed_allocation in Halloc1. - cases (reindexer - (shape_to_index (result_shape_Z l2) - (shape_to_vars (result_shape_Z l2)))). - + rewrite lookup_add_ne in *. - 2: { decomp_well_formed_environment. sets. } - invs. propositional. - rewrite H8 in *. - eq_size_of. - rewrite Rplus_0_l. - rewrite add_comm. - 2: { decomp_well_formed_environment. sets. } - erewrite <- add_remove_id. reflexivity. - rewrite dom_add. - decomp_well_formed_environment. - rewrite cap_distr in Hsthec. - eapply cup_empty in Hsthec. invs. - rewrite cap_distr in H10. - eapply cup_empty in H10. invs. - eapply constant_cap_empty in H12. - sets. - + invs. unfold lookup_total. - rewrite H9. split. auto. - erewrite <- add_remove_id. reflexivity. - decomp_well_formed_environment. - rewrite cap_distr in Hsthec. - eapply cup_empty in Hsthec. invs. - rewrite cap_distr in H8. - eapply cup_empty in H8. invs. - eapply constant_cap_empty in H12. - sets. - - (* VECTOR LET *) - simpl in *. - cases esh1; simpl in *; try now propositional. - erewrite size_of_sizeof in Heval by eassumption. simpl in Heval. - invs. - assert (result_has_shape (V l1) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (z::esh1)))) - as Hsh1. - { - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eassumption. eauto. eauto. } - invs. - assert (result_has_shape (l2) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) ls))) - as Hsh2. - { - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eassumption. eauto. eauto. } - invert Hpad. eq_size_of. - eapply IHeval_expr1 in H17; clear IHeval_expr1. - 2: eauto. - 2: { eassumption. } - 2: { eapply well_formed_environment_letbind1; eauto. } - 2: { decomp_well_formed_reindexer. propositional. - eapply partial_injective_id_reindexer. apply Henv. - simpl. sets. simpl. sets. - unfold nondestructivity. unfold alloc_array_in_heap. - rewrite lookup_add_eq by auto. rewrite dom_add. - split; intros. - 2: sets. invert H10. clear H1. rewrite add_0_r. - eapply dom_lookup_Some in H16. invert H16. - unfold flat_sizeof in *. - erewrite size_of_sizeof in * by eauto. - simpl in H21. - eapply eval_Zexpr_ZTimes_no_vars in H21. - subst. - pose proof (lookup_alloc_array (Z.to_nat - (fold_left Z.mul - (map Z.of_nat - (filter_until (map Z.to_nat (map (eval_Zexpr_Z_total $0) (z :: esh1))) - 0)) 1%Z)) x0). invert H10. - 2: eauto. - eapply lookup_None_dom in H16. - rewrite dom_alloc_array in H16. - rewrite Z2Nat.id in H16. - 2: { eapply fold_left_mul_nonneg. - eapply Forall_map. eapply Forall_forall. intros. lia. lia. } - exfalso. apply H16. - erewrite <- In_iff_in. - eapply In_zrange. clear H16. - unfold tensor_to_array_delta in *. - eapply lookup_Some_dom in H1. - unfold tensor_to_array_delta_by_indices in H1. - erewrite partial_dom_fold_left_array_add in H1. - rewrite dom_empty in *. rewrite cup_empty_r in *. - rewrite filter_idempotent in H1. - eapply In_iff_in in H1. - eapply in_extract_Some in H1. eapply in_map_iff in H1. invert H1. - invert H10. decomp_index. - rewrite partial_interpret_reindexer_id_flatten in H1; eauto. - invert H1. - erewrite result_has_shape_result_shape_Z by eauto. - eapply In_zrange. - eapply in_mesh_grid_flatten_in_range. - eapply Forall_map. eapply Forall_forall. intros. lia. - erewrite result_has_shape_result_shape_Z in H10 by eauto. - eauto. - apply Henv. + - (* LET *) + simpl in Hbds. invs'. + invert Hsize. + cases sz1; simpl in *. + + (* SCALAR LET *) + assert (result_has_shape l1 []) as Hl1. + { eauto using size_of_eval_expr_result_has_shape. } + invert Hl1. + epose proof (nonneg_bounds_includes _ _ _ ltac:(apply empty_includes) ltac:(apply H5)) as H'. + rewr_sizeof. + invert Heval. invert H17. invert H19. invert H20. invert H14. + invert Hpad. + eapply IHeval_expr1 in H15; try eassumption. + 2: { eapply well_formed_environment_alloc_stack; eauto. sets. } + 2: { decomp_well_formed_reindexer. propositional. + simpl. unfold partial_injective. + { destruct s. + - simpl. intros. propositional. subst. propositional. + - simpl. propositional. } + simpl. sets. + simpl. sets. + unfold nondestructivity. simpl. + rewrite lookup_add_eq by eauto. rewrite dom_add. + split; intros. sets. invs'. sets. } + 2: { apply well_formed_allocation_scalar_id. } + 2: { eapply contexts_agree_alloc_stack; eauto. } + simpl in H15. rewrite lookup_add_eq in * by auto. + rewrite add_overwrite in H15. invert H15. + clear IHeval_expr1. + eapply IHeval_expr2 in H16. + 2: eauto. + 2: eauto. + 2: { rewrite Rplus_0_l. + eapply well_formed_environment_let_bind1_scalar. + eauto. sets. sets. sets. } + 2: { decomp_well_formed_reindexer. propositional. + unfold nondestructivity in *. rewrite dom_add. + invert Henv. rewrite lookup_add_ne. + 2: { sets. } + split; intros. + eapply Hnondstr. eauto. eauto. sets. + eauto. eapply Hnondstr. eauto. eauto. sets. } + 2: { eapply well_formed_allocation_add_stack. auto. + unfold well_formed_environment in *. sets. } + 2: { rewrite Rplus_0_l. + eapply contexts_agree_let_bind1_scalar. auto. } + 2: { eq_size_of. eassumption. } + 2: { intros. cases (x0 ==v x). + - subst. rewrite lookup_add_eq in * by auto. invs'. + simpl. eq_size_of. + eapply has_pad_gen_pad in H17. + 2: { eauto. } + 2: { econstructor. } + eauto. eauto. eauto. eauto. + - rewrite lookup_add_ne in * by eauto. eauto. } - eauto. - eapply partial_injective_id_reindexer; eauto. apply Henv. - eapply constant_nonneg_bounds_size_of_no_vars. - 2: eauto. eauto. - eapply constant_nonneg_bounds_size_of_nonneg. 2: apply H0. - eauto. rewrite <- map_cons. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v). - eapply constant_nonneg_bounds_size_of_no_vars. - 2: apply H0. - eauto. } - 2: { eapply well_formed_allocation_letbind1. - try apply Henv. clear IHeval_expr2. - eapply well_formed_environment_not_in_stack_heap. apply Henv. + pose proof Halloc as Halloc1. + unfold well_formed_allocation in Halloc1. + cases (reindexer + (shape_to_index (result_shape_Z l2) + (shape_to_vars (result_shape_Z l2)))). + -- rewrite lookup_add_ne in *. + 2: { decomp_well_formed_environment. sets. } + invs'. propositional. + rewrite H1 in *. + eq_size_of. + rewrite Rplus_0_l. + rewrite add_comm. + 2: { decomp_well_formed_environment. sets. } + erewrite <- add_remove_id. reflexivity. + rewrite dom_add. + decomp_well_formed_environment. + rewrite cap_distr in Hsthec. + eapply cup_empty in Hsthec. invs'. + rewrite cap_distr in H. + eapply cup_empty in H. invs'. + eapply constant_cap_empty in H13. sets. - unfold flat_sizeof in *. - erewrite size_of_sizeof in * by eassumption. - simpl in *|-. - pose proof H3. - eapply constant_nonneg_bounds_sizeof_no_vars in H3. - erewrite size_of_sizeof in * by eassumption. - pose proof H3. eq_size_of. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H3. - invert H3. eq_eval_Z. eq_eval_Zlist. - eapply constant_nonneg_bounds_sizeof_nonneg in H1. - 2: { erewrite size_of_sizeof by eassumption. - econstructor. eauto. eauto. } - erewrite result_has_shape_result_shape_Z by eauto. - eapply eval_Zexpr_ZTimes_no_vars; eauto. } - 3: { eassumption. } - 3: { eauto. } - cases (shape_to_index (result_shape_Z (V l1)) - (shape_to_vars (result_shape_Z (V l1)))). - { eapply shape_to_index_not_empty_Z in Heq. propositional. } - invs. - eapply IHeval_expr2 in H18. - 2: { eauto. } - 2: eassumption. - 2: { unfold alloc_array_in_heap. rewrite add_overwrite. - eapply well_formed_environment_alloc_heap; try apply Henv; eauto. - sets. } - 2: { unfold alloc_array_in_heap. - rewrite add_overwrite. - unfold lookup_total. rewrite lookup_add_eq by auto. - decomp_well_formed_reindexer. propositional. - eapply WellFormedReindexer.nondestructivity_add_heap. eauto. - eauto. } - 2: { unfold alloc_array_in_heap. - rewrite add_overwrite. - cases (p ==v x). subst. - unfold well_formed_environment in *. invs. + -- invs'. unfold lookup_total. + rewrite H10. split. auto. + erewrite <- add_remove_id. reflexivity. + decomp_well_formed_environment. + rewrite cap_distr in Hsthec. + eapply cup_empty in Hsthec. invs'. + rewrite cap_distr in H1. + eapply cup_empty in H1. invs'. + eapply constant_cap_empty in H14. sets. - eapply well_formed_allocation_add_heap_var; eauto. } - 2: { unfold alloc_array_in_heap. - rewrite add_overwrite. - rewrite lookup_total_add_eq. simpl. - rewrite add_0_r. - unfold result_shape_Z. - erewrite result_has_shape_result_shape_nat by eassumption. - pose proof H3. eq_size_of. - eapply constant_nonneg_bounds_sizeof_no_vars in H1. - erewrite size_of_sizeof in H1 by eassumption. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1. - invert H1. - eq_eval_Z. eq_eval_Zlist. - erewrite tensor_to_array_delta_id_valuation. - 2: { apply Henv. } - eapply contexts_agree_add_alloc_heap; eauto. - eapply constant_nonneg_bounds_sizeof_nonneg in H3. - 2: { erewrite size_of_sizeof by eassumption. - econstructor; eauto. } - eauto. econstructor; eauto. - eapply constant_nonneg_bounds_size_of_no_vars in H0. - invert H0. propositional. eauto. - eapply constant_nonneg_bounds_size_of_no_vars in H0. - invert H0. propositional. eauto. - unfold flat_sizeof in *. - erewrite size_of_sizeof in * by eassumption. - simpl in H21. - eapply eval_Zexpr_ZTimes_no_vars in H21. - auto. - eapply constant_nonneg_bounds_size_of_no_vars; try apply H3; eauto. - eapply constant_nonneg_bounds_size_of_nonneg; try apply H3; eauto. } - 2: { eauto. } - 2: { intros. cases (x==v x0). - - subst. rewrite lookup_add_eq in * by auto. invs. - eapply has_pad_gen_pad. eauto. eauto. eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in H5; eauto. - eapply result_has_shape_self in H5. eauto. - eauto. - eapply contexts_agree_result_has_shape. eauto. + + (* VECTOR LET *) + assert (result_has_shape l1 (n :: sz1)) as Hsh1. + { eauto using size_of_eval_expr_result_has_shape. } + destruct l1 as [|l1]; [invert Hsh1|]; []. + assert (result_has_shape l2 ls) as Hsh2. + { eauto using size_of_eval_expr_result_has_shape. } + invert Hpad. eq_size_of. + unfold flat_sizeof in *. rewr_sizeof. + invs. + pose proof eval_Zexpr_Z_fold_left_ZTimes as H''. + specialize (H'' l _ v ltac:(eauto) x0 _ ltac:(eauto using eval_Zexpr_includes_valuation)). + apply eval_Zexpr_Z_eval_Zexpr in H''. eq_eval_Z. + + eapply IHeval_expr1 in H19; clear IHeval_expr1. + 2: eassumption. + 2: eassumption. + 2: { eapply well_formed_environment_letbind1; eauto. } + 2: { decomp_well_formed_reindexer. propositional. + eapply partial_injective_id_reindexer. apply Henv. + simpl. sets. simpl. sets. + unfold nondestructivity. unfold alloc_array_in_heap. + rewrite lookup_add_eq by auto. rewrite dom_add. + split; intros. + 2: sets. invs'. rewrite add_0_r. + eapply dom_lookup_Some in H18. invs'. + rewrite <- Z_of_nat_fold_left_mul. rewrite Nat2Z.id. + pose proof (lookup_alloc_array (fold_left mul sz1 n) x1) as H'. + destruct H' as [H'|H']. + 2: eassumption. + eapply lookup_None_dom in H'. + rewrite dom_alloc_array in H'. + exfalso. apply H'. + erewrite <- In_iff_in. + eapply In_zrange. clear H'. + unfold tensor_to_array_delta in *. + eapply lookup_Some_dom in H9. + unfold tensor_to_array_delta_by_indices in H9. + erewrite partial_dom_fold_left_array_add in H9. + rewrite dom_empty in *. rewrite cup_empty_r in *. + rewrite filter_idempotent in H9. + eapply In_iff_in in H9. + eapply in_extract_Some in H9. eapply in_map_iff in H9. invert H9. + invs'. decomp_index. + rewrite partial_interpret_reindexer_id_flatten in H9; eauto. + invert H9. + eapply In_zrange. eassert (zrange _ _ = _) as ->; cycle 1. + eapply in_mesh_grid_flatten_in_range. + eapply Forall_map. eapply Forall_forall. intros. lia. eauto. - - rewrite lookup_add_ne in * by auto. eauto. } - 2: { eapply contexts_agree_alloc_array_in_heap; eauto. } - cases (reindexer - (shape_to_index (result_shape_Z l2) - (shape_to_vars (result_shape_Z l2)))). - + unfold well_formed_allocation in *. rewrite Heq0 in *. - invs. rewrite H1. - rewrite add_remove. - unfold alloc_array_in_heap. - rewrite add_remove. - split. 2: auto. - decomp_well_formed_environment. - eapply remove_id. - rewrite cap_distr in Hsthec. eapply cup_empty in Hsthec. invs. - rewrite cap_distr in H10. eapply cup_empty in H10. invs. - eapply constant_cap_empty in H12. sets. - + unfold well_formed_allocation in *. rewrite Heq0 in *. - invs. unfold lookup_total. rewrite H10. - unfold alloc_array_in_heap. - repeat rewrite add_overwrite. - rewrite lookup_add_eq by auto. - rewrite lookup_add_ne. - rewrite H10. - rewrite add_remove_comm. - 2: { intros. pose proof var_eq. specialize (H1 k k'). - invert H1; propositional. } - 2: { unfold well_formed_environment in *. invs. - sets. } - 2: { unfold well_formed_environment in *. invs. + f_equal. erewrite result_has_shape_result_shape_Z by eauto. + replace 1%Z with (Z.of_nat 1%nat) by reflexivity. + rewrite <- Z_of_nat_fold_left_mul. f_equal. + rewrite fold_left_mul_filter_until. simpl. f_equal. lia. + apply Henv. + + eapply partial_injective_id_reindexer; eauto. apply Henv. } + 2: { eapply well_formed_allocation_letbind1. + apply Henv. + eapply well_formed_environment_not_in_stack_heap. apply Henv. + sets. + erewrite result_has_shape_result_shape_Z by eauto. + rewrite <- Z_of_nat_fold_left_mul. + replace 1%Z with (Z.of_nat 1%nat) by reflexivity. + rewrite <- Z_of_nat_fold_left_mul. + rewrite fold_left_mul_filter_until. + simpl. f_equal. f_equal. lia. } + 3: { eassumption. } + cases (shape_to_index (result_shape_Z (V l1)) + (shape_to_vars (result_shape_Z (V l1)))). + { eapply shape_to_index_not_empty_Z in Heq. propositional. } + invs'. + pose proof H12 as Hsize. pose proof Hsize as Hsize'. + eapply IHeval_expr2 in Hsize'. + 3: { eauto. } + 2: { eassumption. } + 2: { unfold alloc_array_in_heap. rewrite add_overwrite. + eapply well_formed_environment_alloc_heap; try apply Henv; eauto. sets. } - rewrite <- add_remove_id. - 2: { eapply well_formed_environment_not_in_stack_heap. - eapply Henv. sets. } - auto. + 2: { unfold alloc_array_in_heap. + rewrite add_overwrite. + unfold lookup_total. rewrite lookup_add_eq by auto. + decomp_well_formed_reindexer. propositional. + eapply WellFormedReindexer.nondestructivity_add_heap. eauto. + eauto. } + 2: { unfold alloc_array_in_heap. + rewrite add_overwrite. + cases (p ==v x). subst. + unfold well_formed_environment in *. invs'. + sets. + eapply well_formed_allocation_add_heap_var; eauto. } + 2: { unfold alloc_array_in_heap. + rewrite add_overwrite. + rewrite lookup_total_add_eq. simpl. + rewrite add_0_r. + unfold result_shape_Z. + erewrite result_has_shape_result_shape_nat by eassumption. + + erewrite tensor_to_array_delta_id_valuation. + 2: { apply Henv. } + eapply contexts_agree_add_alloc_heap; eauto. + { simpl. constructor; auto. } + replace 1%Z with (Z.of_nat 1) by reflexivity. + rewrite <- Z_of_nat_fold_left_mul. + rewrite <- Z_of_nat_fold_left_mul. + rewrite fold_left_mul_filter_until. + simpl. f_equal. f_equal. lia. } + 2: { eauto. } + 2: { intros. cases (x==v x1). + - subst. rewrite lookup_add_eq in * by auto. invs. + eapply has_pad_gen_pad. eauto. eauto. + eapply result_has_shape_self; eauto. + eauto. eauto. eauto. + - rewrite lookup_add_ne in * by auto. eauto. } + 2: { eapply contexts_agree_alloc_array_in_heap; eauto. } + cases (reindexer + (shape_to_index (result_shape_Z l2) + (shape_to_vars (result_shape_Z l2)))). + -- unfold well_formed_allocation in *. rewrite Heq0 in *. + invs'. rewrite H1. + rewrite add_remove. + unfold alloc_array_in_heap. + rewrite add_remove. + split. 2: auto. + decomp_well_formed_environment. + eapply remove_id. + rewrite cap_distr in Hsthec. eapply cup_empty in Hsthec. invs'. + rewrite cap_distr in H9. eapply cup_empty in H9. invs'. + eapply constant_cap_empty in H15. sets. + -- unfold well_formed_allocation in *. rewrite Heq0 in *. + invs'. unfold lookup_total. rewrite H9. + unfold alloc_array_in_heap. + repeat rewrite add_overwrite. + rewrite lookup_add_eq by auto. + rewrite lookup_add_ne. + rewrite H9. + rewrite add_remove_comm. + 2: { intros. pose proof var_eq as Hor. specialize (Hor k k'). + destruct Hor; auto. } + 2: { unfold well_formed_environment in *. invs'. + sets. } + 2: { unfold well_formed_environment in *. invs'. + sets. } + rewrite <- add_remove_id. + 2: { eapply well_formed_environment_not_in_stack_heap. + eapply Henv. sets. } + auto. + -- auto. - (* CONCAT *) + simpl in Hbds. invs'. pose proof Halloc as Halloc1. eapply well_formed_allocation_result_V in Halloc1. - invert Halloc1. invert H1. + invert Halloc1. invs'. simpl in *. cases (reindexer (shape_to_index (result_shape_Z (V (l1 ++ l2))) @@ -1716,133 +1438,64 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). apply Hrdx. unfold result_shape_Z. simpl. cases l1; cases l2; simpl; inversion 1. } unfold lookup_total in *. - invert Hsize. pose proof H5 as Hsize1. pose proof H6 as Hsize2. - clear H6. clear H5. - assert (result_has_shape (V l1) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (n::l0)))) - as Hsh1. - { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eassumption. propositional. eassumption. } - assert (result_has_shape (V l2) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (m::l0)))) - as Hsh2. - { simpl. - rewrite H8. repeat rewrite <- map_cons. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eassumption. propositional. eassumption. } - simpl map in *. + invert Hsize. rename H7 into Hsize1. rename H8 into Hsize2. + assert (result_has_shape (V l1) (n::sh2)) as Hsh1. + { eauto using size_of_eval_expr_result_has_shape. } + assert (result_has_shape (V l2) (m::sh2)) as Hsh2. + { eauto using size_of_eval_expr_result_has_shape. } pose proof (result_has_shape_length _ _ _ Hsh1). pose proof (result_has_shape_length _ _ _ Hsh2). subst. pose proof (result_has_shape_concat _ _ _ _ _ Hsh1 Hsh2). - invert Hconst. pose proof H6. pose proof H7. - eapply constant_nonneg_bounds_sizeof_no_vars in H6,H7. - erewrite size_of_sizeof in * by eassumption. - invert H6. invert H7. - pose proof H13. pose proof H12. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H13,H12. - invert H13. invert H12. - pose proof (H11 $0). pose proof (H13 $0). - eapply eval_Zexpr_Z_eval_Zexpr in H12,H16. - unfold eval_Zexpr_Z_total in Hsh1 at 1. - unfold eval_Zexpr_Z_total in Hsh2 at 1. - unfold eval_Zexpr_Z_total in H1,H4. - unfold eval_Zexpr_Z_total in H5 at 1. - unfold eval_Zexpr_Z_total in H5 at 1. - rewrite H12,H16 in *. - pose proof H9. pose proof H10. - eapply constant_nonneg_bounds_sizeof_nonneg in H17,H18. - 2: { erewrite size_of_sizeof by eassumption. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - econstructor. eauto. eauto. } - 2: { erewrite size_of_sizeof by eassumption. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - econstructor. eauto. eauto. } - invert H17. invert H18. - unfold eval_Zexpr_Z_total in H21,H20. - rewrite H12,H16 in *. - assert (eq_zexpr n (| eval_Zexpr_Z_total $0 n|)%z) as Heqn. - { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - assert (eq_zexpr m (| eval_Zexpr_Z_total $0 m|)%z) as Heqm. - { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - assert (x0 = eval_Zexpr_Z_total $0 n)%Z as Heqx0. - { unfold eval_Zexpr_Z_total. rewrite H12. auto. } - assert (x1 = eval_Zexpr_Z_total $0 m)%Z as Heqx1. - { unfold eval_Zexpr_Z_total. rewrite H16. auto. } - subst. - - invert Heval. invert Hpad. eq_size_of. invert H17. invert H18. - eapply IHeval_expr1 in H25; auto; clear IHeval_expr1. + + invert Heval. invert Hpad. eq_size_of. invs'. + rewr_sizeof. rewr_sizeof. + + eapply IHeval_expr1 in H10; auto; clear IHeval_expr1. 2: { eauto. } 2: { eapply well_formed_environment_subseteq_vars. eassumption. sets. } - 2: { rewrite <- H1 in *. rewrite <- H4 in *. - eapply well_formed_allocation_result_V in Halloc. + 2: { eapply well_formed_allocation_result_V in Halloc. eapply well_formed_reindexer_concat_l; try apply Hrdx. - rewrite H4 in *. eauto. rewrite H1 in *. eauto. - lia. lia. - eauto. eauto. + rewrite Nat2Z.id. eassumption. + rewrite Nat2Z.id. eassumption. + lia. + lia. + eassumption. + eassumption. apply Henv. - eauto. apply Hrdx. } + eauto. + apply Hrdx. } 2: { eapply well_formed_allocation_concat_l; eauto; - try eapply Henv; try eapply Hrdx. - rewrite Z2Nat.id. eauto. lia. } + try eapply Henv; try eapply Hrdx. } cases (shape_to_index (result_shape_Z (V l1)) (shape_to_vars (result_shape_Z (V l1)))). { eapply shape_to_index_not_empty_Z in Heq0. propositional. } - cases (reindexer - (let (v, d) := p1 in ((v, (d + dim2)%z) :: l0)) ). + destruct (reindexer (let (v, d) := p1 in _)) eqn:Heq1. { unfold result_shape_Z, shape_to_index, shape_to_vars in Heq0. simpl in Heq0. cases l1; invert Heq0. - eapply reindexer_not_empty_vars_in_index in Heq1. propositional. apply Hrdx. simpl. - unfold not. intros. - eapply cup_empty in H17. invs. - eapply cup_empty in H18. invs. - eapply constant_not_empty in H17. propositional. - inversion 1. + unfold not. intros. cups_empty. - eapply reindexer_not_empty_vars_in_index in Heq1. propositional. apply Hrdx. simpl. - unfold not. intros. - eapply cup_empty in H17. invs. - eapply cup_empty in H18. invs. - eapply constant_not_empty in H17. propositional. - inversion 1. } - invs. rewrite H2 in *. - eapply IHeval_expr2 in H28; clear IHeval_expr2. + unfold not. intros. cups_empty. } + invs'. rewrite H4 in *. + eapply IHeval_expr2 in H13; clear IHeval_expr2. cases (shape_to_index (result_shape_Z (V l2)) - (shape_to_vars (result_shape_Z (V l2)))). - { eapply shape_to_index_not_empty_Z in Heq2. propositional. } - cases (reindexer - (let (v, d) := p3 in - ((v + match sizeof e1 with - | [] => | 0 | - | n :: _ => n - end)%z, - (d + match sizeof e1 with - | [] => | 0 | - | n :: _ => n - end)%z) :: l6)). + (shape_to_vars (result_shape_Z (V l2)))). + { eapply shape_to_index_not_empty_Z in Heq2. propositional. } + destruct (reindexer (let (v, d) := p3 in _)) eqn:Heq3. { unfold result_shape_Z, shape_to_index, shape_to_vars in Heq2. cases l2; invert Heq2. - eapply reindexer_not_empty_vars_in_index in Heq3. propositional. apply Hrdx. simpl. - unfold not. intros. - eapply cup_empty in H17. invs. - eapply cup_empty in H18. invs. - eapply constant_not_empty in H17. propositional. - inversion 1. + unfold not. intros. cups_empty. - eapply reindexer_not_empty_vars_in_index in Heq3. propositional. apply Hrdx. simpl. - unfold not. intros. - eapply cup_empty in H17. invs. - eapply cup_empty in H18. invs. - eapply constant_not_empty in H17. propositional. - inversion 1. } - - rewrite lookup_add_eq in * by auto. invs. + unfold not. intros. cups_empty. } + invs'. + rewrite lookup_add_eq in * by auto. invs'. rewrite add_overwrite. split; auto. rewrite <- array_add_assoc. f_equal. f_equal. symmetry. @@ -1855,50 +1508,34 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). repeat rewrite <- in_extract_Some. repeat rewrite in_map_iff. propositional. - - invs. + - invs'. repeat erewrite result_has_shape_result_shape_Z in * by eauto. repeat decomp_index. - repeat rewrite mesh_grid_map_Nat2Z_id in *. - rewrite <- H18 in H17. - clear Heq. clear Heq0. clear Heq2. clear H3. + rewrite <- H10 in H8. + clear Heq. clear Heq0. clear Heq2. clear H5. decomp_well_formed_reindexer. erewrite result_has_shape_result_shape_Z in Hinj by eauto. - replace (fun e : Zexpr => - match eval_Zexpr_Z $0 e with - | Some x => x - | None => 0%Z - end) with - (eval_Zexpr_Z_total $0) in *. - 2: { reflexivity. } - erewrite eq_partial_interpret_reindexer_padl in H18,H17; - try assumption; try apply Henv; try lia. - 2: { erewrite size_of_sizeof by eauto. simpl. auto. } - 2: { erewrite size_of_sizeof by eauto. simpl. lia. } - 2: { erewrite size_of_sizeof by eauto. simpl. auto. } - 2: { erewrite size_of_sizeof by eauto. simpl. lia. } - erewrite size_of_sizeof in * by eauto. - simpl eval_Zexpr_Z_total in H18,H17. - erewrite eq_partial_interpret_reindexer_concat_l in H17; + erewrite eq_partial_interpret_reindexer_padl in H8,H10; + try eassumption; try apply Henv; try lia. + erewrite eq_partial_interpret_reindexer_concat_l in H8; try assumption; try apply Henv; try lia. 3: apply Hsh1. 3: apply Hsh2. 2: { erewrite result_has_shape_result_shape_Z by eauto. eapply filter_In. propositional. repeat decomp_goal_index. - propositional. - rewrite mesh_grid_map_Nat2Z_id. auto. } - 2: { rewrite Z2Nat.id by lia. auto. } - pose proof H17. - eapply Hinj in H17. - invert H17. - + invert H19. lia. - + rewrite H3 in H19. rewrite H19 in *. + propositional. } + rewrite Nat2Z.id in *. + pose proof H8 as H8'. + eapply Hinj in H8. + invert H8. + + invs'. lia. + + rewrite H8' in H5. rewrite H5 in *. discriminate. + eapply filter_In. propositional. repeat decomp_goal_index. - propositional. lia. - rewrite mesh_grid_map_Nat2Z_id. auto. - rewrite <- H32. + propositional. lia. + rewrite <- H25. simpl. rewrite nth_error_app1. auto. @@ -1907,180 +1544,139 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). + eapply filter_In. propositional. repeat decomp_goal_index. propositional. lia. lia. - rewrite mesh_grid_map_Nat2Z_id. auto. - rewrite <- H32. + rewrite <- H25. simpl. - rewrite nth_error_app2. + rewrite nth_error_app2 by lia. rewrite Z2Nat.inj_add by lia. + rewrite Nat2Z.id. erewrite result_has_shape_length by eauto. rewrite add_sub. cases z; try lia. simpl Z.add. - cases (eval_Zexpr_Z_total $0 dim1); try lia. + cases (Z.of_nat (length l1)); try lia. + eauto. + cases (Z.pos p0 + Z.of_nat (length l1))%Z; try lia. eauto. - cases (Z.pos p0 + eval_Zexpr_Z_total $0 dim1)%Z; try lia. - eauto. lia. - - invs. + + eassumption. + - invs'. repeat erewrite result_has_shape_result_shape_Z in * by eauto. repeat decomp_index. - repeat rewrite mesh_grid_map_Nat2Z_id in *. - rewrite <- H18 in H17. - clear Heq. clear Heq0. clear Heq2. clear H3. + rewrite <- H10 in H8. + clear Heq. clear Heq0. clear Heq2. clear H5. decomp_well_formed_reindexer. erewrite result_has_shape_result_shape_Z in Hinj by eauto. - replace (fun e : Zexpr => - match eval_Zexpr_Z $0 e with - | Some x => x - | None => 0%Z - end) with - (eval_Zexpr_Z_total $0) in *. - 2: { reflexivity. } - erewrite eq_partial_interpret_reindexer_padl in H17; + erewrite eq_partial_interpret_reindexer_padl in H8; try assumption; try apply Henv; try lia. - 2: { erewrite size_of_sizeof by eauto. simpl. auto. } - 2: { erewrite size_of_sizeof by eauto. simpl. lia. } - erewrite size_of_sizeof in * by eauto. - simpl eval_Zexpr_Z_total in H17. - erewrite eq_partial_interpret_reindexer_concat_l in H18,H17; + 2: { eassumption. } + erewrite eq_partial_interpret_reindexer_concat_l in H10,H8; try assumption; try apply Henv; try lia. 3: apply Hsh1. 3: apply Hsh2. - 5: apply Hsh1. - 5: apply Hsh2. + 3: eassumption. + 4: apply Hsh1. + 4: apply Hsh2. + 4: eassumption. 2: { erewrite result_has_shape_result_shape_Z by eauto. eapply filter_In. propositional. repeat decomp_goal_index. - propositional. - rewrite mesh_grid_map_Nat2Z_id. auto. } - 2: { rewrite Z2Nat.id by lia. auto. } + propositional. } 2: { erewrite result_has_shape_result_shape_Z by eauto. eapply filter_In. propositional. repeat decomp_goal_index. - propositional. - rewrite mesh_grid_map_Nat2Z_id. auto. } - 2: { rewrite Z2Nat.id by lia. auto. } - pose proof H17. - eapply Hinj in H17. - invert H17. - + invert H19. lia. - + rewrite H3 in H19. rewrite H19 in *. + propositional. } + rewrite Nat2Z.id in *. + pose proof H8 as H8'. + eapply Hinj in H8. + invert H8. + + invs'. lia. + + rewrite H8' in H5. rewrite H5 in *. discriminate. + eapply filter_In. propositional. repeat decomp_goal_index. propositional. lia. lia. - rewrite mesh_grid_map_Nat2Z_id. auto. - rewrite <- H28. + rewrite <- H23. simpl. - rewrite nth_error_app2. + rewrite nth_error_app2 by lia. rewrite Z2Nat.inj_add by lia. erewrite result_has_shape_length by eauto. - rewrite add_sub. + rewrite Nat2Z.id. rewrite add_sub. cases z0; try lia. simpl Z.add. - cases (eval_Zexpr_Z_total $0 dim1); try lia. + cases (Z.of_nat (length l1)); try lia. + eauto. + cases (Z.pos p0 + Z.of_nat (length l1))%Z; try lia. eauto. - cases (Z.pos p0 + eval_Zexpr_Z_total $0 dim1)%Z; try lia. - eauto. lia. + eapply filter_In. propositional. repeat decomp_goal_index. - propositional. lia. - rewrite mesh_grid_map_Nat2Z_id. auto. - rewrite <- H28. + propositional. lia. + rewrite <- H23. simpl. - rewrite nth_error_app1. + rewrite nth_error_app1 by lia. auto. - erewrite result_has_shape_length by eauto. - lia. - } + + lia. } 2: { eauto. } 2: { eauto. } 2: { decomp_well_formed_reindexer. unfold well_formed_reindexer. propositional. erewrite result_has_shape_result_shape_Z by eauto. - replace (fun e : Zexpr => - match eval_Zexpr_Z $0 e with - | Some x => x - | None => 0%Z - end) with - (eval_Zexpr_Z_total $0) in * by reflexivity. - eapply partial_injective_concat_l; eauto; try apply Henv. - rewrite Z2Nat.id by lia. auto. } + eapply partial_injective_concat_l; eauto; try apply Henv. } 2: { decomp_well_formed_reindexer. - erewrite size_of_sizeof by eassumption. simpl. erewrite result_has_shape_result_shape_Z by eauto. - replace (fun e : Zexpr => - match eval_Zexpr_Z $0 e with - | Some x => x - | None => 0%Z - end) with - (eval_Zexpr_Z_total $0) in * by reflexivity. - eapply partial_injective_concat_r; eauto. - apply Henv. } - 2: { eauto. } + eapply partial_injective_concat_r; eauto. + 3: lia. 2: apply Henv. rewrite Nat2Z.id. assumption. } + 2: { eassumption. } 2: { eassumption. } 2: { eapply well_formed_environment_add_heap. eapply well_formed_environment_subseteq_vars. eassumption. sets. auto. } - 2: { erewrite size_of_sizeof by eassumption. simpl. - eapply well_formed_allocation_result_V in Halloc. - invert Halloc. invert H17. + 2: { eapply well_formed_allocation_result_V in Halloc. + invert Halloc. invs'. eapply well_formed_reindexer_concat_r; try apply Henv; eauto. - apply Hrdx. - } + rewrite Nat2Z.id. eassumption. + rewrite Nat2Z.id. eassumption. + lia. lia. + apply Hrdx. } 2: { eapply well_formed_allocation_add_heap. - erewrite size_of_sizeof by eauto. eapply well_formed_allocation_concat_r; eauto; try apply Henv; try apply Hrdx. - simpl. eauto. - simpl. eauto. - auto. } + rewrite Nat2Z.id. eassumption. + lia. + eassumption. } 2: { eapply contexts_agree_add_heap; eauto; try apply Henv. } eapply eq_tensor_to_array_delta_by_indices. intros. 2: { eapply Hrdx. } - 2: { erewrite size_of_sizeof by eauto. simpl. - decomp_well_formed_reindexer. + 2: { decomp_well_formed_reindexer. repeat erewrite result_has_shape_result_shape_Z by eauto. - replace (fun e : Zexpr => - match eval_Zexpr_Z $0 e with - | Some x0 => x0 - | None => 0%Z - end) with - (eval_Zexpr_Z_total $0) in * by reflexivity. cases l1. invert Hsh1. - { assert (eval_Zexpr_Z_total $0 dim1 = 0)%Z by lia. - simpl length. simpl Z.of_nat. + { simpl length. simpl Z.of_nat. rewrite add_0_l. rewrite app_nil_l. unfold partial_injective. rewrite app_nil_l in Hinj. erewrite result_has_shape_result_shape_Z in Hinj by eauto. - rewrite <- H17 in *. rewrite add_0_l in *. propositional. repeat decomp_index. cases (z0 - match eval_Zexpr_Z $0 e with - | Some x => x - | None => 0%Z - end) with - (eval_Zexpr_Z_total $0) in * by reflexivity. assert (z < Z.of_nat (length l1) \/ Z.of_nat (length l1) <= z)%Z as Hcase by lia. inversion Hcase as [ Hcase1 | Hcase2 ]; clear Hcase. @@ -2366,54 +1922,34 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply filter_In. propositional. repeat decomp_goal_index. propositional. - lia. - rewrite <- H19. + rewrite <- H13. simpl. rewrite nth_error_app1. auto. lia. - apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. - rewrite Z2Nat.id by lia. auto. } + apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. assumption. } pose proof Hcase2 as Hcase2'. eapply Z.ltb_ge in Hcase2'. rewrite Hcase2'. clear Hcase2'. - rewrite H1 in *. repeat erewrite result_has_shape_result_shape_Z by eauto. erewrite eq_partial_interpret_reindexer_padl. - f_equal. f_equal. lia. - eauto. + f_equal. f_equal. f_equal. f_equal. rewrite Nat2Z.id. reflexivity. + f_equal. lia. assumption. apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. lia. lia. eauto. eauto. eauto. eauto. apply Hrdx. - (* TRANSPOSE *) - simpl in *. + simpl in *. invs'. pose proof Halloc as Halloc1. eapply well_formed_allocation_result_V in Halloc1. inversion Halloc1 as [ a Htmp ]. clear Halloc1. inversion Htmp as [ Heq Hsub ]. clear Htmp. - assert (result_has_shape (V l) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) - (n::m::esh)))) as Hsh. - { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - eauto. eauto. eauto. } - invert Hsize. pose proof H3 as Hsize. clear H3. - eq_size_of. invert H2. - pose proof Hconst. - eapply constant_nonneg_bounds_sizeof_no_vars in H2. - erewrite size_of_sizeof in H2. - 2: { eassumption. } - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H2. - eq_eval_Zlist. simpl in H3. invert H3. - pose proof Hconst. - eapply constant_nonneg_bounds_sizeof_no_vars in H2. - erewrite size_of_sizeof in * by eassumption. - invert H2. invert H6. - pose proof H4. pose proof H5. - repeat rewrite map_cons in *. + assert (result_has_shape (V l) (n::m::esh)) as Hsh. + { eauto using size_of_eval_expr_result_has_shape. } + invert Hsize. eq_size_of. invs'. pose proof H2 as Hsize. clear H2. invert Hpad. - { - eapply IHeval_expr in Heval; eauto. invs. clear IHeval_expr. + { + eapply IHeval_expr in Heval; eauto. invs'. clear IHeval_expr. cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq0. propositional. } @@ -2421,46 +1957,29 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). (shape_to_index (result_shape_Z (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) + (m :: n :: esh))) (shape_to_vars (result_shape_Z (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))))). + (m :: n :: esh)))))). { eapply reindexer_not_empty in Heq1. propositional. apply Hrdx. erewrite result_has_shape_result_shape_Z. 2: eapply result_has_shape_transpose_result; eauto. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m0)); simpl. + cases m; simpl. inversion 1. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n0)). + cases n. simpl. inversion 1. simpl. inversion 1. } - cases (reindexer - (let (v, d) := p0 in - match l4 with - | [] => p0 :: l4 - | (vi, di) :: xs => (vi, di) :: (v, d) :: xs - end)). + destruct (reindexer (let (v, d) := p0 in _)) eqn:Heq2. { unfold result_shape_Z, shape_to_index, shape_to_vars in Heq0. cases l; invert Heq0. - eapply reindexer_not_empty_vars_in_index in Heq2. - propositional. apply Hrdx. - simpl. repeat rewrite cup_empty_r. - unfold not. intros. eapply constant_not_empty in H1. propositional. - inversion 1. + propositional. apply Hrdx. simpl. destruct l4; simpl; intros ?; cups_empty. - eapply reindexer_not_empty_vars_in_index in Heq2. propositional. apply Hrdx. simpl. repeat rewrite cup_empty_r. - cases (result_shape_nat r0); simpl; repeat rewrite cup_empty_r; - unfold not; intros. - eapply constant_not_empty in H1. propositional. inversion 1. - eapply cup_empty in H1. invs. - eapply constant_not_empty in H6. propositional. inversion 1. - } - invs. + cases (result_shape_nat r0); simpl; intros ?; cups_empty. } + invs'. split; auto. f_equal. f_equal. { unfold tensor_to_array_delta. @@ -2469,17 +1988,16 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). | x::y::xs => y::x::xs | _ => l end)). - - intros. - erewrite result_has_shape_result_shape_Z in H1. + - intros ? H0. + erewrite result_has_shape_result_shape_Z in H0. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. eauto. } repeat decomp_index. - rewrite mesh_grid_map_Nat2Z_id in *. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. - - intros. - erewrite result_has_shape_result_shape_Z in H1. + - intros ? H0. + erewrite result_has_shape_result_shape_Z in H0. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. eauto. } @@ -2491,8 +2009,8 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). repeat decomp_index. rewrite eq_partial_interpret_reindexer_transpose; try apply Henv; try apply Hrdx; eauto. - - intros. - erewrite result_has_shape_result_shape_Z in H1. + - intros ? H0. + erewrite result_has_shape_result_shape_Z in H0. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. eauto. } @@ -2503,12 +2021,12 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). propositional. repeat decomp_goal_index. propositional. - rewrite <- H11. + rewrite <- H5. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. - - intros. - erewrite result_has_shape_result_shape_Z in H1 by eauto. + - intros ? H0. + erewrite result_has_shape_result_shape_Z in H0 by eauto. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. @@ -2517,9 +2035,9 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eexists (z0::z::x0). split. auto. eapply filter_In. propositional. - repeat decomp_goal_index. propositional. repeat decomp_goal_index. propositional. - rewrite <- H11. + repeat decomp_goal_index. propositional. + rewrite <- H5. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. @@ -2533,15 +2051,15 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eauto. } unfold injective. propositional. repeat decomp_index. - invert H12. auto. + invs'. auto. - eapply no_dup_filter. eapply no_dup_mesh_grid. - eapply no_dup_filter. eapply no_dup_mesh_grid. } eapply well_formed_reindexer_transpose; try apply Henv; eauto. eapply well_formed_allocation_transpose; try apply Henv; try apply Hrdx; eauto. } - { - eapply IHeval_expr in Heval; eauto. invs. clear IHeval_expr. + { + eapply IHeval_expr in Heval; eauto. invs'. clear IHeval_expr. cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq0. propositional. } @@ -2549,46 +2067,30 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). (shape_to_index (result_shape_Z (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) + (m :: n :: esh))) (shape_to_vars (result_shape_Z (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))))). + (m :: n :: esh)))))). { eapply reindexer_not_empty in Heq1. propositional. apply Hrdx. erewrite result_has_shape_result_shape_Z. 2: eapply result_has_shape_transpose_result; eauto. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m0)); simpl. + cases m; simpl. inversion 1. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n0)). + cases n. simpl. inversion 1. simpl. inversion 1. } - cases (reindexer - (let (v, d) := p0 in - match l4 with - | [] => p0 :: l4 - | (vi, di) :: xs => (vi, di) :: (v, d) :: xs - end)). + destruct (reindexer (let (v, d) := p0 in _)) eqn:Heq2. { unfold result_shape_Z, shape_to_index, shape_to_vars in Heq0. cases l; invert Heq0. - eapply reindexer_not_empty_vars_in_index in Heq2. propositional. apply Hrdx. - simpl. repeat rewrite cup_empty_r. - unfold not. intros. eapply constant_not_empty in H1. propositional. - inversion 1. + simpl. intros ?. cups_empty. - eapply reindexer_not_empty_vars_in_index in Heq2. propositional. apply Hrdx. - simpl. repeat rewrite cup_empty_r. - cases (result_shape_nat r0); simpl; repeat rewrite cup_empty_r; - unfold not; intros. - eapply constant_not_empty in H1. propositional. inversion 1. - eapply cup_empty in H1. invs. - eapply constant_not_empty in H6. propositional. inversion 1. - } - invs. + simpl. + cases (result_shape_nat r0); simpl; intros ?; cups_empty. } + invs'. split; auto. f_equal. f_equal. { unfold tensor_to_array_delta. @@ -2597,17 +2099,16 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). | x::y::xs => y::x::xs | _ => l end)). - - intros. - erewrite result_has_shape_result_shape_Z in H1. + - intros ? H0. + erewrite result_has_shape_result_shape_Z in H0. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. eauto. } repeat decomp_index. - rewrite mesh_grid_map_Nat2Z_id in *. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. - - intros. - erewrite result_has_shape_result_shape_Z in H1. + - intros ? H0. + erewrite result_has_shape_result_shape_Z in H0. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. eauto. } @@ -2619,8 +2120,8 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). repeat decomp_index. rewrite eq_partial_interpret_reindexer_transpose; try apply Henv; try apply Hrdx; eauto. - - intros. - erewrite result_has_shape_result_shape_Z in H1. + - intros ? H0. + erewrite result_has_shape_result_shape_Z in H0. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. eauto. } @@ -2631,12 +2132,12 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). propositional. repeat decomp_goal_index. propositional. - rewrite <- H10. + rewrite <- H4. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. - - intros. - erewrite result_has_shape_result_shape_Z in H1 by eauto. + - intros ? H0. + erewrite result_has_shape_result_shape_Z in H0 by eauto. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. @@ -2645,9 +2146,9 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eexists (z0::z::x0). split. auto. eapply filter_In. propositional. - repeat decomp_goal_index. propositional. repeat decomp_goal_index. propositional. - rewrite <- H10. + repeat decomp_goal_index. propositional. + rewrite <- H4. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. @@ -2661,21 +2162,18 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eauto. } unfold injective. propositional. repeat decomp_index. - invert H11. auto. + invs'. auto. - eapply no_dup_filter. eapply no_dup_mesh_grid. - eapply no_dup_filter. eapply no_dup_mesh_grid. } eapply well_formed_reindexer_transpose; try apply Henv; eauto. eapply well_formed_allocation_transpose; try apply Henv; try apply Hrdx; eauto. } - apply Hrdx. + apply Hrdx. - (* FLATTEN *) simpl in *. invert Hsize. - assert (result_has_shape (V l) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (n::m::l0)))). - { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - eassumption. eassumption. eauto. } + assert (result_has_shape (V l) (n::m::sh0)). + { eauto using size_of_eval_expr_result_has_shape. } simpl map in *. cases (reindexer (shape_to_index (result_shape_Z (V (flatten_result l))) @@ -2684,8 +2182,7 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). { eapply reindexer_not_empty in Heq. propositional. apply Hrdx. erewrite result_has_shape_result_shape_Z. 2: eapply result_has_shape_flatten; eassumption. - simpl. cases ((Z.to_nat (eval_Zexpr_Z_total $0 n) - * Z.to_nat (eval_Zexpr_Z_total $0 m) =? 0)%nat). + simpl. cases (n * m =? 0)%nat. inversion 1. inversion 1. } clear Heq. pose proof Halloc as Halloc1. @@ -2695,35 +2192,22 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). unfold lookup_total. rewrite Heq. invert Hpad. - + eapply IHeval_expr in Heval; eauto. cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq0. propositional. } - cases (reindexer - (let (v, d) := p1 in - match l5 with - | [] => p1 :: l5 - | (vi, di) :: xs => ((v * di + vi)%z, (d * di)%z) :: xs - end)). + destruct (reindexer (let (v, d) := p1 in _)) eqn:Heq1. { erewrite result_has_shape_result_shape_Z in Heq0 by eassumption. simpl in Heq0. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n) =? 0)%nat; invert Heq0. + cases (n =? 0)%nat; invert Heq0. - eapply reindexer_not_empty_vars_in_index in Heq1. propositional. apply Hrdx. - simpl. repeat rewrite cup_empty_r. - unfold not. intros. eapply constant_not_empty in H3. propositional. - inversion 1. + simpl. intros ?. cups_empty. - eapply reindexer_not_empty_vars_in_index in Heq1. propositional. apply Hrdx. - simpl. repeat rewrite cup_empty_r. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) =? 0)%nat; simpl; - repeat rewrite cup_empty_r; unfold app_no_dups; - simpl; unfold not; intros. - eapply constant_not_empty in H3. propositional. inversion 1. - eapply cup_empty in H3. invs. - eapply constant_not_empty in H11. propositional. inversion 1. } - invs. split; auto. + cases (m =? 0)%nat; simpl; intros ?; cups_empty. } + invs'. split; auto. unfold lookup_total. rewrite Heq. f_equal. f_equal. unfold tensor_to_array_delta. @@ -2735,9 +2219,7 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). with (shuffle:= fun l => match l with | x::y::xs => - (x*(Z.of_nat - (Z.to_nat - (eval_Zexpr_Z_total $0 m))) + y)%Z::xs + (x*Z.of_nat m + y)%Z::xs | _ => l end). - intros. repeat decomp_index. @@ -2756,52 +2238,45 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). erewrite result_lookup_Z_option_flatten. reflexivity. lia. eauto. eauto. lia. eauto. eauto. - intros. repeat decomp_index. - pose proof (Z_div_mod - z (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))). - assert (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) > 0)%Z by lia. + pose proof (Z_div_mod z (Z.of_nat m)). + assert (Z.of_nat m > 0)%Z by lia. propositional. - cases (Z.div_eucl z (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))). - invert H17. - clear H3. + cases (Z.div_eucl z (Z.of_nat m)). + invs'. eexists (z0::z1::x0). rewrite Z.mul_comm. split. auto. eapply filter_In. propositional. repeat decomp_goal_index. propositional. - assert (-1 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) < - z0 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))%Z + assert (-1 * Z.of_nat m < z0 * Z.of_nat m)%Z by lia. - apply Zorder.Zmult_lt_reg_r in H17. + apply Zorder.Zmult_lt_reg_r in H18. lia. lia. rewrite Nat2Z.inj_mul in H16. rewrite - (Z.mul_comm (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 n)))) in H16. + (Z.mul_comm (Z.of_nat n)) in H16. eapply div_eucl_bound in H16. lia. - assert (-1 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) < - z0 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))%Z + assert (-1 * Z.of_nat m < z0 * Z.of_nat m)%Z by lia. - eapply Zorder.Zmult_lt_reg_r in H17. + eapply Zorder.Zmult_lt_reg_r in H18. lia. lia. lia. repeat decomp_goal_index. propositional. rewrite <- H12. erewrite <- result_lookup_Z_option_flatten. rewrite Z.mul_comm. reflexivity. - assert (-1 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) < - z0 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))%Z + assert (-1 * Z.of_nat m < z0 * Z.of_nat m)%Z by lia. - eapply Zorder.Zmult_lt_reg_r in H17. + eapply Zorder.Zmult_lt_reg_r in H18. lia. lia. rewrite Nat2Z.inj_mul in H16. - rewrite - (Z.mul_comm (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 n)))) in H16. + rewrite (Z.mul_comm (Z.of_nat n)) in H16. eapply div_eucl_bound in H16. - apply H16. - assert (-1 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) < - z0 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))%Z + apply H16. + assert (-1 * Z.of_nat m < z0 * Z.of_nat m)%Z by lia. - eapply Zorder.Zmult_lt_reg_r in H17. + eapply Zorder.Zmult_lt_reg_r in H18. lia. lia. eauto. eauto. lia. lia. @@ -2815,11 +2290,11 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 2: { eapply result_has_shape_flatten; eauto. } eauto. - unfold injective. propositional. - repeat decomp_index. invert H14. - rewrite Z.mul_comm in H21. symmetry in H21. - rewrite Z.mul_comm in H21. symmetry in H21. - eapply Z.div_mod_unique in H21. - invs. auto. + repeat decomp_index. invs'. + rewrite Z.mul_comm in H25. symmetry in H25. + rewrite Z.mul_comm in H25. symmetry in H25. + eapply Z.div_mod_unique in H25. + invs'. auto. lia. lia. - eapply no_dup_filter. eapply no_dup_mesh_grid. @@ -2828,74 +2303,44 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply well_formed_reindexer_flatten; try apply Henv; eauto. eapply well_formed_allocation_flatten; try apply Henv; try apply Hrdx; eauto. - apply Hrdx. - - (* TRUNCR *) simpl in *. invert Hsize. invert Hconst. - assert (result_has_shape (V l) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (m::l0)))) - as Hsh. - { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2. - eapply H2. eassumption. eauto. } - invs. - eq_size_of. - pose proof H2 as Hconst. - eapply constant_nonneg_bounds_size_of_no_vars in H2; eauto. - invert H2. - assert (eval_Zexpr_Z_total $0 k = kz)%Z. - { pose proof H4. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H2. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=v) in H4. - invert H2. invert H4. simpl in *. - pose proof H. - eapply eval_Zexpr_Z_eval_Zexpr in H,H4. - eapply H2 in H. invert H. - eapply H6 in H4. invert H4. auto. } - subst. erewrite size_of_sizeof in H7 by eauto. simpl in H7. - - assert (Forall (fun x => (0 < x)%Z) (map (eval_Zexpr_Z_total $0) l0) \/ - Exists (fun x => x = 0%Z) (map (eval_Zexpr_Z_total $0) l0)). - { eapply forall_nonneg_exists_zero_or_forall_pos_Z. - pose proof H5. - eapply constant_nonneg_bounds_size_of_nonneg in H5. - 2: { eauto. } - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - econstructor; eauto. } - invert H5. eauto. } + apply Hrdx. + - (* TRUNCR *) simpl in *. invert Hsize. + rename H3 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. + rewrite Hk' in *. invs'. apply eval_Zexpr_Z_eval_Zexpr in Hk. + assert (result_has_shape (V l) (m::sh0)) as Hsh. + { eauto using size_of_eval_expr_result_has_shape. } - assert (eval_Zexpr_Z_total $0 m = eval_Zexpr_Z_total $0 k \/ - eval_Zexpr_Z_total $0 k < eval_Zexpr_Z_total $0 m)%Z - as HHcase by lia. + rewr_sizeof. invs'. eq_eval_Z. + apply eval_Zexpr_Z_eval_Zexpr in H3. rewrite Hk in *. invs'. + rename x0 into kz. + assert (m = Z.to_nat kz \/ Z.to_nat kz < m) as HHcase by lia. inversion HHcase as [ HHcase1 | HHcase2]; clear HHcase. - { pose proof (truncl_list_length_empty - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - (rev l)). - erewrite length_rev in H6. - erewrite result_has_shape_length in H6. + { pose proof (truncl_list_length_empty (Z.to_nat kz) (rev l)) as H8. + erewrite length_rev in H8. + erewrite result_has_shape_length in H8. 2: { simpl map in *. eauto. } - assert (Z.to_nat (eval_Zexpr_Z_total $0 m) <= - Z.to_nat (eval_Zexpr_Z_total $0 k)) by lia. - eapply H6 in H8. - rewrite H8 in *. clear H6. simpl rev. + assert (H10: m <= Z.to_nat kz) by lia. + eapply H8 in H10. + rewrite H10 in *. clear H8. simpl rev. invert Hpad. - pose proof Hconst as HH. pose proof H12 as Hpad. - eapply has_pad_gen_pad in H12. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + rename H8 into Hpad. pose proof Hpad as Hpad'. + eapply has_pad_gen_pad in Hpad'. 2: { eauto. } 2: { eauto. } 2: { eauto. } 2: { eauto. } - 2: { eapply contexts_agree_result_has_shape. eauto. } 2: { eauto. } - simpl in H12. invs. - rewrite firstn_all2 in H12. + simpl in Hpad'. destruct Hpad' as (_&Hpad'&Hpad''&_). + rewrite firstn_all2 in Hpad'. 2: { erewrite length_rev. erewrite result_has_shape_length. 2: simpl in *; eauto. lia. } - clear H9. clear H14. clear H6. eapply Forall_rev in H12. + eapply Forall_rev in Hpad'. rewrite rev_involutive in *. - eapply forall_eq_gen_pad in H12. rewrite H12 in *. - clear H7. - eapply IHeval_expr in HH. + eapply forall_eq_gen_pad in Hpad'. rewrite Hpad' in *. + eapply IHeval_expr in H5. 2: { eauto. } 2: { eauto. } 2: { eauto. } @@ -2907,61 +2352,68 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). decomp_well_formed_reindexer. rewrite filter_negb_is_None_result_lookup_Z_option_gen_pad in *. split. - unfold partial_injective. intros. invert H7. + unfold partial_injective. intros. simpl in *. contradiction. split. - intros. destruct l2; destruct l3. - eauto. invert H7. simpl in *. lia. invert H7. simpl in *. lia. + intros l2 l3 HeqZlist'. destruct l2; destruct l3. + eauto. + invert HeqZlist'. invert H3. + invert HeqZlist'. invert H3. destruct p0. destruct p1. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons_tup. - erewrite <- eq_Z_tuple_index_list_cons_tup in H7. - propositional. eapply eq_zexpr_sub. eauto. eauto. - eapply eq_zexpr_sub. eauto. eauto. + erewrite <- eq_Z_tuple_index_list_cons_tup in HeqZlist'. + propositional. + apply eq_zexpr_sub. + assumption. + apply eq_zexpr_id. reflexivity. split. auto. - split. intros. + split. intros var k0 l2 H3. destruct l2. simpl. rewrite Hmap. eauto. eauto. destruct p0. simpl. rewrite Hmap. simpl. - unfold subst_var_in_Z_tup at 1. simpl. - erewrite subst_var_in_Zexpr_id with (lo:=k). eauto. - rewrite H4. sets. eauto. + cbv [subst_var_in_Z_tup]. simpl. f_equal. f_equal. f_equal. + f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + auto. + assumption. split. - intros. + intros l2. destruct l2. rewrite Hvarsarg. sets. destruct p0. simpl. rewrite Hvarsarg. simpl. - rewrite H4. rewrite app_no_dups_empty_r. sets. + erewrite (eval_Zexpr_vars_empty k) by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + rewrite app_no_dups_empty_r. reflexivity. unfold nondestructivity. split; intros. - unfold tensor_to_array_delta in H14. + unfold tensor_to_array_delta in H12. rewrite filter_negb_is_None_result_lookup_Z_option_gen_pad in *. unfold tensor_to_array_delta_by_indices in *. simpl in *. rewrite dom_empty in *. sets. - invert H6. - eapply lookup_Some_dom in H14. sets. } + invs'. + eapply lookup_Some_dom in H12. sets. } 2: { simpl. rewrite <- gen_pad_cons. + replace kz with (Z.of_nat (Z.to_nat kz)) by lia. eapply well_formed_allocation_gen_pad. eapply well_formed_allocation_truncr - with (x:=[]) (l0:=l0). + with (x:=[]). simpl. rewrite rev_repeat. pose proof (truncl_list_length_empty - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - (repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))). + (Z.to_nat kz) + (repeat (gen_pad sh0) (Z.to_nat kz))) as H8. rewrite repeat_length in *. - assert (Z.to_nat (eval_Zexpr_Z_total $0 k) <= Z.to_nat (eval_Zexpr_Z_total $0 k)) by lia. - eapply H6 in H7. - rewrite H7. eauto. - eapply Hrdx. + assert (Z.to_nat kz <= Z.to_nat kz) as H12 by lia. + eapply H8 in H12. + rewrite H12. eauto. + eapply Hrdx. simpl. eapply result_has_shape_repeat. eapply result_has_shape_gen_pad. - lia. apply Hrdx. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. + lia. + apply Hrdx. + apply eval_Zexpr_Z_eval_Zexpr. assumption. apply Henv. apply Hrdx. apply Hrdx. simpl. - rewrite H12. simpl. rewrite repeat_length. + rewrite Hpad'. simpl. rewrite repeat_length. simpl in Hsh. eapply result_has_shape_length in Hsh. rewrite repeat_length in Hsh. rewrite Hsh. - rewrite HHcase1. eapply result_has_shape_repeat. eapply result_has_shape_gen_pad. } 2: { eauto. } @@ -2971,63 +2423,41 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). (shape_to_index (result_shape_Z (V [])) (shape_to_vars (result_shape_Z (V []))))). { eapply reindexer_not_empty_vars_in_index in Heq. propositional. - apply Hrdx. simpl. unfold not. intros. - eapply cup_empty in H6. invert H6. - eapply cup_empty in H7. invert H7. - eapply constant_not_empty in H6. propositional. - inversion 1. } - cases ((fun l : list (Zexpr * Zexpr) => - reindexer - match l with - | [] => l - | (v, d) :: xs => (v, (d - k)%z) :: xs - end) - (shape_to_index - (result_shape_Z - (V - (gen_pad_list - (Datatypes.length l - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))) + apply Hrdx. simpl. intros ?. cups_empty. } + cbv beta in H4. + cases (reindexer + match + shape_to_index + (result_shape_Z (V (gen_pad_list (Datatypes.length l :: sh0)))) + (shape_to_vars + (result_shape_Z (V (gen_pad_list (Datatypes.length l :: sh0))))) + with + | [] => + shape_to_index + (result_shape_Z (V (gen_pad_list (Datatypes.length l :: sh0)))) (shape_to_vars - (result_shape_Z - (V - (gen_pad_list - (Datatypes.length l - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))))))). - { cases (shape_to_index - (result_shape_Z - (V - (gen_pad_list - (length l - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))) - (shape_to_vars - (result_shape_Z - (V - (gen_pad_list - (length l - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))))). + (result_shape_Z (V (gen_pad_list (Datatypes.length l :: sh0))))) + | (v, d) :: xs => (v, (d - k)%z) :: xs + end). + { cases (shape_to_index (result_shape_Z (V (gen_pad_list (Datatypes.length l :: sh0)))) + (shape_to_vars + (result_shape_Z (V (gen_pad_list (Datatypes.length l :: sh0)))))). eapply shape_to_index_not_empty_Z in Heq1. propositional. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. apply Hrdx. unfold result_shape_Z,shape_to_index,shape_to_vars in Heq1. simpl in *. cases l. simpl in *. - - invert Heq1. simpl. unfold not. intros. - eapply cup_empty in H6. invert H6. - eapply cup_empty in H7. invert H7. - eapply constant_not_empty in H6. propositional. inversion 1. - - invert Heq1. simpl. unfold not. intros. - eapply cup_empty in H6. invert H6. - eapply cup_empty in H7. invert H7. - eapply constant_not_empty in H6. propositional. inversion 1. } - unfold lookup_total in *. invs. split; auto. + - invert Heq1. simpl. intro. cups_empty. + - invert Heq1. simpl. intro. cups_empty. } + unfold lookup_total in *. invs'. split; auto. eapply well_formed_allocation_result_V in Halloc. - invs. rewrite H7 in *. f_equal. f_equal. + invs'. f_equal. f_equal. rewrite tensor_to_array_delta_empty_tensor. simpl. rewrite <- gen_pad_cons. rewrite tensor_to_array_delta_gen_pad. reflexivity. apply Hrdx. - } - invert H2. + } + pose proof (forall_nonneg_exists_zero_or_forall_pos sh0) as [H3|H3]. 2: { pose proof Hpad as Hpad'. invert Hpad'. eapply IHeval_expr in Heval. 2: { eauto. } @@ -3038,142 +2468,126 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). { erewrite result_has_shape_result_shape_Z by eauto. unfold partial_injective. intros. repeat decomp_index. - eapply mesh_grid_shape_pos in H18. - pose proof H6. - apply Forall_Exists_neg in H13. invert H13. - erewrite Forall_map in H18. - erewrite Forall_map in H18. - eapply Forall_impl. 2: apply H18. - simpl. intros. lia. } + eapply mesh_grid_shape_pos in H17. + apply Forall_Exists_neg in H3. contradiction. + eapply Forall_impl. 2: apply Forall_map; eassumption. + simpl. lia. } split. - { intros. + { intros l2 l3 Hl. cases l2; cases l3. - eapply HeqZlist. eauto. - - invert H2. invs. invert H2. - simpl in *. lia. - - invert H2. invs. invert H2. - simpl in *. lia. + - destruct Hl as (Hl&_). invert Hl. + - destruct Hl as (Hl&_). invert Hl. - cases p0. cases p1. - erewrite <- eq_Z_tuple_index_list_cons_tup in H2. invs. + erewrite <- eq_Z_tuple_index_list_cons_tup in Hl. invs'. eapply HeqZlist. - erewrite <- eq_Z_tuple_index_list_cons_tup. invs. - split. auto. split. - eapply eq_zexpr_sub; eauto. eauto. } + erewrite <- eq_Z_tuple_index_list_cons_tup. invs'. + auto using eq_zexpr_sub. } split. auto. split. intros. rewrite Hmap by auto. cases l2. reflexivity. cases p0. simpl. unfold subst_var_in_Z_tup at 1. simpl. - rewrite (subst_var_in_Zexpr_id k). reflexivity. - rewrite H4. sets. + f_equal. f_equal. f_equal. f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + auto. split. { intros. rewrite Hvarsarg. - cases l2. reflexivity. cases p0. f_equal. - simpl. - rewrite H4. rewrite app_no_dups_empty_r. reflexivity. } - { invert Hpad. - pose proof Hconst as HH. pose proof H18 as Hpad. - eapply has_pad_gen_pad in H18. + cases l2. reflexivity. cases p0. f_equal. simpl. + erewrite (eval_Zexpr_vars_empty k) by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + rewrite app_no_dups_empty_r. reflexivity. } + { invert Hpad. cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + rename H16 into Hpad. + eapply has_pad_gen_pad in Hpad. 2: { eauto. } 2: { eauto. } 2: { eauto. } 2: { eauto. } - 2: { eapply contexts_agree_result_has_shape. eauto. } 2: { eauto. } - simpl in H18. invs. + simpl in Hpad. invs'. unfold nondestructivity in *. split; intros. - unfold tensor_to_array_delta in H18. - rewrite exists_0_empty_mesh_grid in H18. - 2: { erewrite result_has_shape_result_shape_Z by eauto. - pose proof H6. - eapply Exists_map. - eapply exists_filter_until_0. simpl. - right. eauto. } - simpl in H18. unfold tensor_to_array_delta_by_indices in H18. - simpl in H18. rewrite dom_empty in H18. sets. + unfold tensor_to_array_delta in H17. + rewrite exists_0_empty_mesh_grid in H17. + 2: { cbv [result_shape_Z]. apply Exists_map. + erewrite result_has_shape_result_shape_nat by eauto. + eapply Exists_impl. + 2: { apply exists_filter_until_0. auto. } + simpl. lia. } + simpl in H17. unfold tensor_to_array_delta_by_indices in H17. + simpl in H17. rewrite dom_empty in H17. sets. eapply well_formed_allocation_result_V in Halloc. - invert Halloc. invert H18. eapply lookup_Some_dom in H16. - sets. eauto. + invert Halloc. invs'. eapply lookup_Some_dom in H15. + sets. eauto. } } 2: { unfold well_formed_allocation. rewrite exists_0_empty_mesh_grid. simpl. eapply well_formed_allocation_result_V in Halloc. - invs. rewrite H8. + invs'. rewrite H8. cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq. propositional. } - cases (reindexer (let (v0, d) := p0 in (v0, (d - k)%z) :: l2)). + destruct (reindexer (let (v0, d) := p0 in _)) eqn:Heq0. { unfold result_shape_Z, shape_to_index, shape_to_vars in Heq. simpl in *. invert Heq. rewrite length_map in *. cases l. - - simpl in *. invert H13. + - simpl in *. invs'. eapply reindexer_not_empty_vars_in_index in Heq0. - propositional. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H2. invs. - eapply cup_empty in H13. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. - - simpl in *. invert H13. + contradiction. + apply Hrdx. + simpl. intro. cups_empty. + - simpl in *. invs'. eapply reindexer_not_empty_vars_in_index in Heq0. - propositional. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H2. invs. - eapply cup_empty in H13. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. } + contradiction. + apply Hrdx. + simpl. intro. cups_empty. } eexists. split. reflexivity. sets. apply Hrdx. - erewrite result_has_shape_result_shape_Z by eauto. - eapply Exists_map. - eapply exists_filter_until_0. simpl. right. eauto. } + cbv [result_shape_Z]. apply Exists_map. + erewrite result_has_shape_result_shape_nat by eauto. + eapply Exists_impl. + 2: { apply exists_filter_until_0. auto. } + simpl. lia. } 2: { eauto. } 2: { eauto. } - + cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq. propositional. } - cases (reindexer (let (v, d) := p0 in (v, (d - k)%z) :: l2)). + destruct (reindexer (let (v, d) := p0 in _)) eqn:Heq0. { unfold result_shape_Z, shape_to_index, shape_to_vars in Heq. simpl in *. invert Heq. rewrite length_map in *. cases l. - - simpl in *. invert H8. + - simpl in *. invs'. eapply reindexer_not_empty_vars_in_index in Heq0. - propositional. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H2. invs. - eapply cup_empty in H8. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. - - simpl in *. invert H8. + contradiction. + apply Hrdx. + simpl. intro. cups_empty. + - simpl in *. invs'. eapply reindexer_not_empty_vars_in_index in Heq0. - propositional. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H2. invs. - eapply cup_empty in H8. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. } + contradiction. + apply Hrdx. + simpl. intro. cups_empty. } invs. unfold lookup_total. eapply well_formed_allocation_result_V in Halloc. invs. - rewrite H8. + rewrite H8. cases (reindexer (shape_to_index (result_shape_Z (V (rev (truncl_list - (Z.to_nat (eval_Zexpr_Z_total $0 k)) + (Z.to_nat kz) (rev l))))) (shape_to_vars (result_shape_Z (V (rev (truncl_list (Z.to_nat - (eval_Zexpr_Z_total $0 k)) + kz) (rev l)))))))). { erewrite result_has_shape_result_shape_Z in Heq1. 2: { eapply result_has_shape_rev. @@ -3182,26 +2596,19 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). erewrite <- result_has_shape_filter_until_0. simpl in *. eauto. } unfold result_shape_Z, shape_to_index, shape_to_vars in Heq1. - simpl in *. + simpl in *. rewrite length_map in *. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)). - - simpl in *. + cases (m - Z.to_nat kz). + - simpl in *. eapply reindexer_not_empty_vars_in_index in Heq1. - propositional. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H2. invs. - eapply cup_empty in H13. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. - - simpl in *. + contradiction. + apply Hrdx. + simpl. intro. cups_empty. + - simpl in *. eapply reindexer_not_empty_vars_in_index in Heq1. - propositional. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H2. invs. - eapply cup_empty in H13. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. } + contradiction. + apply Hrdx. + simpl. intro. cups_empty. } split. 2: auto. f_equal. f_equal. unfold tensor_to_array_delta, @@ -3216,91 +2623,67 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). erewrite <- result_has_shape_filter_until_0. simpl in *. eauto. } erewrite Exists_map. - rewrite <- Z2Nat.inj_sub by lia. - rewrite <- map_cons. - eapply exists_filter_until_0. + eapply Exists_impl; [|apply exists_filter_until_0]. + simpl. lia. right. eauto. erewrite result_has_shape_result_shape_Z by eauto. erewrite Exists_map. - eapply exists_filter_until_0. + eapply Exists_impl; [|apply exists_filter_until_0]. + simpl. lia. simpl. right. eauto. apply Hrdx. eauto. } - - assert (exists l', l = - l' ++ - gen_pad_list - (Z.to_nat - (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)))%list. + + assert (exists l', l = l' ++ + gen_pad_list + (Z.to_nat kz :: sh0))%list. { invert Hpad. - eapply has_pad_gen_pad in H11. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + eapply has_pad_gen_pad in H10. 2: { eauto. } - 2: { eauto. } 2: { eauto. } 2: { eauto. } - 2: { eapply contexts_agree_result_has_shape; eauto. } + 2: eauto. 2: eauto. simpl in *. invs. rewrite <- (rev_involutive l). erewrite <- firstn_skipn - with (l:=rev l) (n:=(Z.to_nat (eval_Zexpr_Z_total $0 k))). + with (l:=rev l) (n:=(Z.to_nat kz)). rewrite rev_app_distr. - eexists (rev (skipn (Z.to_nat (eval_Zexpr_Z_total $0 k)) (rev l))). + eexists (rev (skipn (Z.to_nat kz) (rev l))). f_equal. - eapply forall_firstn_ge in H11. - 2: { apply H15. } - eapply forall_eq_gen_pad in H11. - simpl in H11. - rewrite H11. + eapply forall_firstn_ge in H10. + 2: { apply H13. } + eapply forall_eq_gen_pad in H10. + simpl in H10. + rewrite H10. rewrite rev_repeat. rewrite length_firstn. rewrite length_rev. erewrite result_has_shape_length by eauto. f_equal. lia. } - invs. + invs'. invert Hpad. - + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + eapply IHeval_expr in Heval; clear IHeval_expr; eauto. 2: { eapply well_formed_allocation_result_V in Halloc. - invert Halloc. + invert Halloc. invs'. + rewrite <- (Z2Nat.id kz) by lia. rewrite Nat2Z.id. eapply well_formed_reindexer_truncr. eauto. repeat rewrite map_cons in Hsh. eauto. - try apply Henv. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. lia. apply H2. - eauto. lia. apply Hrdx. - } - 2: { eapply well_formed_allocation_truncr. eauto. - apply Hrdx. repeat rewrite map_cons in *. eauto. lia. - try apply Henv; try apply Hrdx; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - apply Henv. apply Hrdx. apply Hrdx. } - cases (reindexer - (shape_to_index - (result_shape_Z - (V - (rev - (truncl_list - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - (rev - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)))))))) - (shape_to_vars - (result_shape_Z - (V - (rev - (truncl_list - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - (rev - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))))))))))). + apply Henv. + eauto. + lia. + eassumption. + lia. + apply Hrdx. } + 2: { rewrite <- (Z2Nat.id kz) by lia. rewrite Nat2Z.id. + eapply well_formed_allocation_truncr. eauto. + apply Hrdx. eauto. lia. + apply Hrdx. eauto. apply Henv. apply Hrdx. apply Hrdx. } + match goal with + | |- context[reindexer ?x] => destruct (reindexer x) eqn:Heq + end. { eapply reindexer_not_empty in Heq. propositional. apply Hrdx. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_rev. @@ -3310,49 +2693,33 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). repeat rewrite map_cons in Hsh. eauto. } simpl. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k) =? 0)%nat); - inversion 1. } + cases (m - Z.to_nat kz =? 0)%nat; inversion 1. } cases (shape_to_index (result_shape_Z (V - (x ++ + (x0 ++ gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))) + (Z.to_nat kz :: sh0)))) (shape_to_vars (result_shape_Z (V - (x ++ + (x0 ++ gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))))). + (Z.to_nat kz :: sh0)))))). { eapply shape_to_index_not_empty_Z in Heq0. propositional. } - cases (reindexer (let (v, d) := p1 in (v, (d - k)%z) :: l2)). + destruct (reindexer (let (v, d) := p1 in _)) eqn:Heq1. { unfold shape_to_index, shape_to_vars, result_shape_Z in Heq0. simpl in Heq0. - cases ((x ++ - repeat - (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))%list); + cases ((x0 ++ repeat (gen_pad sh0) (Z.to_nat kz))%list); invert Heq0. - eapply reindexer_not_empty_vars_in_index in Heq1. propositional. - apply Hrdx. simpl. unfold app_no_dups. simpl. - unfold not. intros. - eapply cup_empty in H2. invs. - eapply cup_empty in H8. invs. - eapply constant_not_empty in H2. propositional. inversion 1. + apply Hrdx. simpl. intro. cups_empty. - eapply reindexer_not_empty_vars_in_index in Heq1. propositional. - apply Hrdx. simpl. unfold app_no_dups. simpl. - unfold not. intros. - eapply cup_empty in H2. invs. - eapply cup_empty in H8. invs. - eapply constant_not_empty in H2. propositional. inversion 1. } - invs. + apply Hrdx. simpl. intro. cups_empty. } + invs'. pose proof Halloc as Halloc1. eapply well_formed_allocation_result_V in Halloc1; - try apply Hrdx. invs. + try apply Hrdx. invs'. unfold lookup_total. rewrite H8. split. 2: auto. f_equal. f_equal. @@ -3365,43 +2732,37 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply result_has_shape_rev. repeat rewrite map_cons in Hsh. eassumption. } - repeat rewrite <- map_cons. - unfold tensor_to_array_delta. rewrite rev_app_distr in *. simpl gen_pad_list in *. rewrite rev_repeat in *. - pose proof truncl_list_gen_pad_id. - simpl gen_pad_list in H2. - rewrite H2 in *. clear H2. + pose proof truncl_list_gen_pad_id as Hgp. + simpl gen_pad_list in Hgp. + rewrite Hgp in *. clear Hgp. rewrite rev_involutive in *. - + erewrite result_has_shape_result_shape_Z by eassumption. repeat rewrite <- map_cons. - pose proof filter_pad_r_mesh_grid. simpl gen_pad_list in H2. - rewrite H2. clear H2. + pose proof filter_pad_r_mesh_grid as Hgp. simpl gen_pad_list in Hgp. + rewrite Hgp. clear Hgp. 2: { repeat rewrite map_cons in Hsh. pose proof Hsh. eapply result_has_shape_app_l in Hsh. - eapply result_has_shape_app_r in H13. + eapply result_has_shape_app_r in H2. 2: { rewrite repeat_length. reflexivity. } 2: { reflexivity. } simpl map. - simpl. replace (Z.to_nat (eval_Zexpr_Z_total $0 m)) with - (Z.to_nat (eval_Zexpr_Z_total $0 k) + - (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k))) by lia. + simpl. replace m with (Z.to_nat kz + (m - Z.to_nat kz)) by lia. eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. eauto. } - 2: { lia. } eapply eq_tensor_to_array_delta_by_indices_shuffle with (shuffle:=fun x => x). - + intros. - erewrite result_has_shape_result_shape_Z in H2. + + intros ? H'. + erewrite result_has_shape_result_shape_Z in H'. 2: { repeat rewrite map_cons in Hsh. eapply result_has_shape_app_r; eauto. } rewrite repeat_length in *. @@ -3411,19 +2772,17 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 2: { repeat rewrite map_cons in Hsh. eapply result_has_shape_app_r; eauto. } rewrite repeat_length. lia. - + intros. - erewrite result_has_shape_result_shape_Z in H2. + + intros ? H'. + erewrite result_has_shape_result_shape_Z in H'. 2: { repeat rewrite map_cons in Hsh. eapply result_has_shape_app_r; eauto. } rewrite repeat_length in *. repeat decomp_index. - rewrite eq_partial_interpret_reindexer_truncr; - try apply Henv; try apply Hrdx. - reflexivity. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. lia. lia. - + intros. - erewrite result_has_shape_result_shape_Z in H2. + rewrite <- (Z2Nat.id kz) by lia. rewrite Nat2Z.id. + erewrite eq_partial_interpret_reindexer_truncr; + try apply Henv; try apply Hrdx; try (eauto || lia). + + intros ? H'. + erewrite result_has_shape_result_shape_Z in H'. 2: { repeat rewrite map_cons in Hsh. eapply result_has_shape_app_r; eauto. } rewrite repeat_length in *. eauto. @@ -3433,8 +2792,8 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply result_has_shape_app_r; eauto. } rewrite repeat_length in *. eauto. + decomp_well_formed_reindexer. - pose proof Hinj. - erewrite result_has_shape_result_shape_Z in H2. + pose proof Hinj as H'. + erewrite result_has_shape_result_shape_Z in H'. 2: { repeat rewrite map_cons in Hsh. eapply result_has_shape_app_r; eauto. } erewrite result_has_shape_result_shape_Z. @@ -3445,74 +2804,51 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). erewrite result_has_shape_result_shape_Z in Hinj. 2: { repeat rewrite map_cons in Hsh. eapply result_has_shape_app_r; eauto. } - rewrite repeat_length in *. eauto. + rewrite repeat_length in *. + rewrite <- (Z2Nat.id kz) by lia. rewrite Nat2Z.id. eapply partial_injective_truncr; eauto. apply Henv. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. lia. + lia. + unfold injective. propositional. + eapply no_dup_filter. eapply no_dup_mesh_grid. + eapply no_dup_filter. eapply no_dup_mesh_grid. - - (* TRUNCL *) simpl in *. invert Hsize. invert Hconst. - assert (result_has_shape (V l) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (m::l0)))) - as Hsh. - { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2. - eapply H2. eassumption. eauto. } - invs. eq_size_of. erewrite size_of_sizeof in * by eauto. simpl in H7. - assert (eval_Zexpr_Z_total $0 k = kz)%Z. - { pose proof H4. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H4. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=v) in H6. - invert H6. invert H4. simpl in *. - pose proof H. - eapply eval_Zexpr_Z_eval_Zexpr in H,H4. - eapply H6 in H. invert H. - eapply H6 in H4. invert H4. auto. } - subst. + - (* TRUNCL *) simpl in *. invert Hsize. + rename H3 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. + rewrite Hk' in *. invs'. apply eval_Zexpr_Z_eval_Zexpr in Hk. - assert (Forall (fun x => (0 < x)%Z) (map (eval_Zexpr_Z_total $0) l0) \/ - Exists (fun x => x = 0%Z) (map (eval_Zexpr_Z_total $0) l0)). - { eapply forall_nonneg_exists_zero_or_forall_pos_Z. - pose proof H5. - eapply constant_nonneg_bounds_size_of_nonneg in H5. - 2: { eauto. } - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - eapply constant_nonneg_bounds_size_of_no_vars. eauto. eauto. } - invert H5. eauto. } - assert (eval_Zexpr_Z_total $0 m = eval_Zexpr_Z_total $0 k \/ - eval_Zexpr_Z_total $0 k < eval_Zexpr_Z_total $0 m)%Z - as HHcase by lia. + assert (result_has_shape (V l) (m::sh0)) as Hsh. + { eauto using size_of_eval_expr_result_has_shape. } + + rewr_sizeof. invs'. eq_eval_Z. + apply eval_Zexpr_Z_eval_Zexpr in H3. rewrite Hk in *. invs'. + rename x0 into kz. + assert (m = Z.to_nat kz \/ Z.to_nat kz < m) as HHcase by lia. inversion HHcase as [ HHcase1 | HHcase2]; clear HHcase. - { pose proof (truncl_list_length_empty - (Z.to_nat (eval_Zexpr_Z_total $0 k)) l). + { pose proof (truncl_list_length_empty (Z.to_nat kz) l) as H8. erewrite result_has_shape_length in H8. 2: { simpl map in *. eauto. } - assert (Z.to_nat (eval_Zexpr_Z_total $0 m) <= - Z.to_nat (eval_Zexpr_Z_total $0 k)) by lia. - eapply H8 in H9. - rewrite H9 in *. clear H8. - invert Hpad. - pose proof H2 as HH. pose proof H11 as Hpad. - eapply has_pad_gen_pad in H11. + assert (m <= Z.to_nat kz) as H11 by lia. + eapply H8 in H11. + rewrite H11 in *. clear H8. + invert Hpad. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + rename H8 into Hpad. pose proof Hpad as Hpad'. + eapply has_pad_gen_pad in Hpad'. 2: { eauto. } 2: { eauto. } 2: { eauto. } 2: { eauto. } - 2: { eapply contexts_agree_result_has_shape. eauto. } 2: { eauto. } - simpl in H11. invs. - rewrite firstn_all2 in H8. + simpl in Hpad'. destruct Hpad' as (Hpad'&_&_&_). + rewrite firstn_all2 in Hpad'. 2: { erewrite result_has_shape_length. 2: simpl in *; eauto. lia. } - clear H13. clear H10. clear H11. - eapply forall_eq_gen_pad in H8. rewrite H8 in *. - eapply IHeval_expr in HH. + eapply forall_eq_gen_pad in Hpad'. rewrite Hpad' in *. + eapply IHeval_expr in H5. 2: { eauto. } 2: { eauto. } 2: { eauto. } @@ -3522,56 +2858,59 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). decomp_well_formed_reindexer. erewrite filter_negb_is_None_result_lookup_Z_option_gen_pad. split. - unfold partial_injective. intros. invert H11. + unfold partial_injective. intros. + simpl in *. contradiction. split. - intros. destruct l2; destruct l3. eauto. - invert H11. simpl in *. lia. - invert H11. simpl in *. lia. + intros l2 l3 Hl. destruct l2; destruct l3. + eauto. + destruct Hl as (Hl&_). invert Hl. + destruct Hl as (Hl&_). invert Hl. destruct p0. destruct p1. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons_tup. - erewrite <- eq_Z_tuple_index_list_cons_tup in H11. + erewrite <- eq_Z_tuple_index_list_cons_tup in Hl. propositional. - eapply eq_zexpr_sub; eauto. - eapply eq_zexpr_sub; eauto. - eapply eq_zexpr_sub; eauto. - eapply eq_zexpr_sub; eauto. + auto using eq_zexpr_sub. + auto using eq_zexpr_sub. split. auto. split. intros. destruct l2. simpl. rewrite Hmap. eauto. eauto. destruct p0. rewrite Hmap. simpl. unfold subst_var_in_Z_tup at 1. simpl. - rewrite subst_var_in_Zexpr_id with (lo:=k). eauto. - rewrite H4. sets. eauto. + f_equal. f_equal. f_equal. f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + auto. + f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + auto. + auto. split. - intros. destruct l2. rewrite Hvarsarg. sets. + intros l2. destruct l2. rewrite Hvarsarg. sets. destruct p0. simpl. rewrite Hvarsarg. simpl. - rewrite H4. rewrite app_no_dups_empty_r. - rewrite app_no_dups_empty_r. sets. + erewrite (eval_Zexpr_vars_empty k) by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + do 2 rewrite app_no_dups_empty_r. reflexivity. unfold nondestructivity. unfold tensor_to_array_delta. erewrite filter_negb_is_None_result_lookup_Z_option_gen_pad. unfold tensor_to_array_delta_by_indices. simpl. rewrite dom_empty. split; intros. sets. - invert H10. - eapply lookup_Some_dom in H14. sets. apply Hrdx. } + invs'. + eapply lookup_Some_dom in H12. sets. apply Hrdx. } 2: { simpl. rewrite <- gen_pad_cons. eapply well_formed_allocation_gen_pad. eapply well_formed_allocation_truncl - with (x:=[]) (l0:=l0). + with (x:=[]). eauto. - eapply Hrdx. + eapply Hrdx. simpl. rewrite app_nil_r. eapply result_has_shape_repeat. eapply result_has_shape_gen_pad. - lia. apply Hrdx. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. + eauto. lia. apply Hrdx. apply Henv. apply Hrdx. apply Hrdx. simpl. - rewrite H8. simpl. rewrite repeat_length. + rewrite Hpad'. simpl. rewrite repeat_length. simpl in Hsh. eapply result_has_shape_length in Hsh. rewrite repeat_length in Hsh. rewrite Hsh. - rewrite HHcase1. rewrite app_nil_r. + rewrite app_nil_r. eapply result_has_shape_repeat. eapply result_has_shape_gen_pad. } 2: { eauto. } @@ -3581,63 +2920,42 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). (shape_to_index (result_shape_Z (V [])) (shape_to_vars (result_shape_Z (V []))))). { eapply reindexer_not_empty_vars_in_index in Heq. propositional. - apply Hrdx. simpl. unfold not. intros. - eapply cup_empty in H10. invert H10. - eapply cup_empty in H11. invert H11. - eapply constant_not_empty in H10. propositional. - inversion 1. } + apply Hrdx. simpl. intro. cups_empty. } cases ((fun l : list (Zexpr * Zexpr) => - reindexer - match l with - | [] => l - | (v, d) :: xs => ((v-k)%z, (d - k)%z) :: xs - end) - (shape_to_index - (result_shape_Z - (V - (gen_pad_list - (Datatypes.length l - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))) - (shape_to_vars - (result_shape_Z - (V - (gen_pad_list - (Datatypes.length l - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))))))). + reindexer + match l with + | [] => l + | (v, d) :: xs => ((v - k)%z, (d - k)%z) :: xs + end) + (shape_to_index (result_shape_Z (V (gen_pad_list (Datatypes.length l :: sh0)))) + (shape_to_vars + (result_shape_Z (V (gen_pad_list (Datatypes.length l :: sh0))))))). { cases (shape_to_index (result_shape_Z (V (gen_pad_list - (length l - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))) + (length l :: sh0)))) (shape_to_vars (result_shape_Z (V (gen_pad_list - (length l - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))))). + (length l :: sh0)))))). eapply shape_to_index_not_empty_Z in Heq1. propositional. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. apply Hrdx. unfold result_shape_Z,shape_to_index,shape_to_vars in Heq1. simpl in *. cases l. simpl in *. - - invert Heq1. simpl. unfold not. intros. - eapply cup_empty in H10. invert H10. - eapply cup_empty in H11. invert H11. - eapply constant_not_empty in H10. propositional. inversion 1. - - invert Heq1. simpl. unfold not. intros. - eapply cup_empty in H10. invert H10. - eapply cup_empty in H11. invert H11. - eapply constant_not_empty in H10. propositional. inversion 1. } + - invert Heq1. simpl. intro. cups_empty. + - invert Heq1. simpl. intro. cups_empty. } unfold lookup_total in *. invs. split; auto. eapply well_formed_allocation_result_V in Halloc. - invs. rewrite H8 in *. f_equal. f_equal. + invs. rewrite H3 in *. f_equal. f_equal. rewrite tensor_to_array_delta_empty_tensor. simpl. rewrite <- gen_pad_cons. rewrite tensor_to_array_delta_gen_pad. reflexivity. apply Hrdx. } - - invert H6. + + pose proof (forall_nonneg_exists_zero_or_forall_pos sh0) as [H3|H3]. 2: { pose proof Hpad as Hpad'. invert Hpad'. eapply IHeval_expr in Heval. 2: { eauto. } @@ -3649,158 +2967,127 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). unfold partial_injective. intros. repeat decomp_index. eapply mesh_grid_shape_pos in H17. - pose proof H8. - apply Forall_Exists_neg in H12. invert H12. - erewrite Forall_map in H17. - erewrite Forall_map in H17. - eapply Forall_impl. 2: apply H17. - simpl. intros. lia. } + apply Forall_Exists_neg in H3. contradiction. + eapply Forall_impl. 2: apply Forall_map; eassumption. + simpl. lia. } split. - { intros. + { intros l2 l3 Hl. cases l2; cases l3. - eapply HeqZlist. eauto. - - invert H6. invs. invert H6. - simpl in *. lia. - - invert H6. invs. invert H6. - simpl in *. lia. + - destruct Hl as (Hl&_). invert Hl. + - destruct Hl as (Hl&_). invert Hl. - cases p0. cases p1. - erewrite <- eq_Z_tuple_index_list_cons_tup in H6. invs. + erewrite <- eq_Z_tuple_index_list_cons_tup in Hl. invs'. eapply HeqZlist. - erewrite <- eq_Z_tuple_index_list_cons_tup. - split. eapply eq_zexpr_sub; auto. split. - eapply eq_zexpr_sub; eauto. eauto. } + erewrite <- eq_Z_tuple_index_list_cons_tup. invs'. + auto using eq_zexpr_sub. } split. auto. split. intros. rewrite Hmap by auto. cases l2. reflexivity. cases p0. simpl. unfold subst_var_in_Z_tup at 1. simpl. - rewrite (subst_var_in_Zexpr_id k). reflexivity. - rewrite H4. sets. + f_equal. f_equal. f_equal. f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + auto. + f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + auto. split. { intros. rewrite Hvarsarg. cases l2. reflexivity. cases p0. f_equal. simpl. - rewrite H4. repeat rewrite app_no_dups_empty_r. - reflexivity. } + erewrite (eval_Zexpr_vars_empty k) by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + do 2 rewrite app_no_dups_empty_r. reflexivity. } { unfold nondestructivity in *. split; intros. unfold tensor_to_array_delta in H12. rewrite exists_0_empty_mesh_grid in H12. - 2: { erewrite result_has_shape_result_shape_Z by eauto. - eapply Exists_map. - eapply exists_filter_until_0. simpl. - right. eauto. } + 2: { cbv [result_shape_Z]. apply Exists_map. + erewrite result_has_shape_result_shape_nat by eauto. + eapply Exists_impl. + 2: { apply exists_filter_until_0. auto. } + simpl. lia. } simpl in H12. unfold tensor_to_array_delta_by_indices in H12. simpl in H12. rewrite dom_empty in H12. sets. eapply well_formed_allocation_result_V in Halloc. - invert Halloc. invert H12. eapply lookup_Some_dom in H9. + invert Halloc. invs'. eapply lookup_Some_dom in H8. sets. eauto. } } 2: { unfold well_formed_allocation. rewrite exists_0_empty_mesh_grid. simpl. eapply well_formed_allocation_result_V in Halloc. - invs. rewrite H9. + invs'. rewrite H8. cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq. propositional. } - cases (reindexer (let (v0, d) := p0 in - ((v0 - k)%z, (d - k)%z) :: l2)). + destruct (reindexer (let (v0, d) := p0 in _)) eqn:Heq0. { unfold shape_to_index,result_shape_Z,shape_to_vars in Heq. simpl in Heq. invert Heq. repeat rewrite length_map in *. cases l. - - simpl in *. invert H12. + - simpl in *. invs'. eapply reindexer_not_empty_vars_in_index in Heq0. - propositional. apply Hrdx. - simpl. unfold app_no_dups. - rewrite <- union_constant. - simpl. unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H12. invs. - eapply cup_empty in H6. invs. - eapply constant_not_empty in H12. propositional. - inversion 1. - - simpl in *. invert H12. + contradiction. + apply Hrdx. + simpl. intro. cups_empty. + - simpl in *. invs'. eapply reindexer_not_empty_vars_in_index in Heq0. - propositional. apply Hrdx. - simpl. unfold app_no_dups. - rewrite <- union_constant. - simpl. unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H12. invs. - eapply cup_empty in H6. invs. - eapply constant_not_empty in H12. propositional. - inversion 1. } + contradiction. + apply Hrdx. + simpl. intro. cups_empty. } eexists. split. reflexivity. sets. apply Hrdx. erewrite result_has_shape_result_shape_Z by eauto. - eapply Exists_map. - eapply exists_filter_until_0. simpl. right. eauto. } + erewrite Exists_map. + eapply Exists_impl; [|apply exists_filter_until_0]. + simpl. lia. + simpl. right. eauto. } 2: { eauto. } 2: { eauto. } - + cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq. propositional. } - cases (reindexer (let (v, d) := p0 in ((v - k)%z, (d - k)%z) :: l2)). + destruct (reindexer (let (v, d) := p0 in _)) eqn:Heq0. { unfold shape_to_index,result_shape_Z,shape_to_vars in Heq. simpl in Heq0. invert Heq. repeat rewrite length_map in *. cases l. - - simpl in *. invert H9. + - simpl in *. invs'. eapply reindexer_not_empty_vars_in_index in Heq0. - propositional. apply Hrdx. - simpl. unfold app_no_dups. - rewrite <- union_constant. - simpl. unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H9. invs. - eapply cup_empty in H6. invs. - eapply constant_not_empty in H9. propositional. - inversion 1. - - simpl in *. invert H9. + contradiction. + apply Hrdx. + simpl. intro. cups_empty. + - simpl in *. invs'. eapply reindexer_not_empty_vars_in_index in Heq0. - propositional. apply Hrdx. - simpl. unfold app_no_dups. - rewrite <- union_constant. - simpl. unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H9. invs. - eapply cup_empty in H6. invs. - eapply constant_not_empty in H9. propositional. - inversion 1. } - invs. + contradiction. + apply Hrdx. + simpl. intro. cups_empty. } + invs'. unfold lookup_total. - eapply well_formed_allocation_result_V in Halloc. invs. - rewrite H9. - cases (reindexer - (shape_to_index - (result_shape_Z (V (truncl_list (Z.to_nat (eval_Zexpr_Z_total $0 k)) l))) - (shape_to_vars - (result_shape_Z (V (truncl_list (Z.to_nat (eval_Zexpr_Z_total $0 k)) l)))))). + eapply well_formed_allocation_result_V in Halloc. invs'. + rewrite H8. + match goal with + | |- context[reindexer ?x] => destruct (reindexer x) eqn:Heq1 + end. { erewrite result_has_shape_result_shape_Z in Heq1. 2: { eapply result_has_shape_truncl_list. erewrite <- result_has_shape_filter_until_0. simpl in *. eauto. } simpl in *. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)). + cases (m - Z.to_nat kz). - simpl in *. eapply reindexer_not_empty_vars_in_index in Heq1. - propositional. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H12. invs. - eapply constant_not_empty in H6. propositional. inversion 1. + contradiction. + apply Hrdx. + simpl. intro. cups_empty. - simpl in *. eapply reindexer_not_empty_vars_in_index in Heq1. - propositional. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H12. invs. - eapply constant_not_empty in H6. propositional. inversion 1. } + contradiction. + apply Hrdx. + simpl. intro. cups_empty. } split. 2: auto. f_equal. f_equal. unfold tensor_to_array_delta, @@ -3812,115 +3099,91 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 2: { eapply result_has_shape_truncl_list. erewrite <- result_has_shape_filter_until_0. simpl in *. eauto. } - eapply Exists_map. - rewrite <- Z2Nat.inj_sub by lia. - rewrite <- map_cons. - eapply exists_filter_until_0. + erewrite Exists_map. + eapply Exists_impl; [|apply exists_filter_until_0]. + simpl. lia. right. eauto. erewrite result_has_shape_result_shape_Z by eauto. - eapply Exists_map. - eapply exists_filter_until_0. + erewrite Exists_map. + eapply Exists_impl; [|apply exists_filter_until_0]. + simpl. lia. simpl. right. eauto. apply Hrdx. eauto. } - - assert (exists l', l = - gen_pad_list - (Z.to_nat - (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))++l')%list. - { invert Hpad. - eapply has_pad_gen_pad in H10. - 2: { eauto. } - 2: { eauto. } - 2: { eauto. } - 2: { eauto. } - 2: { eapply contexts_agree_result_has_shape. eauto. } - 2: { eauto. } - simpl in *. invs. - erewrite <- firstn_skipn - with (l:=l) (n:=(Z.to_nat (eval_Zexpr_Z_total $0 k))). - eexists (skipn (Z.to_nat (eval_Zexpr_Z_total $0 k)) l). - f_equal. - eapply forall_firstn_ge in H6. - 2: apply H14. - eapply forall_eq_gen_pad in H6. - simpl in H6. - rewrite H6. - rewrite length_firstn. - erewrite result_has_shape_length by eauto. f_equal. lia. } - invs. + + assert (exists l', l = gen_pad_list (Z.to_nat kz :: sh0)++l')%list. + { invert Hpad. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + eapply has_pad_gen_pad in H10. + 2: { eauto. } + 2: { eauto. } + 2: { eauto. } + 2: { eauto. } + 2: { eauto. } + simpl in *. destruct H10 as (H10&_&_&_). + erewrite <- firstn_skipn + with (l:=l) (n:=(Z.to_nat kz)). + eexists (skipn (Z.to_nat kz) l). + f_equal. + eapply forall_firstn_ge in H10. + 2: apply H13. + eapply forall_eq_gen_pad in H10. + simpl in H10. + rewrite H10. + rewrite length_firstn. + erewrite result_has_shape_length by eauto. f_equal. lia. } + invs'. rewrite truncl_list_gen_pad_id in *. invert Hpad. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. eapply IHeval_expr in Heval; clear IHeval_expr; eauto. 2: { eapply well_formed_allocation_result_V in Halloc. - invert Halloc. - eapply well_formed_reindexer_truncl; + invert Halloc. invs'. + eapply well_formed_reindexer_truncl; try apply Henv. - auto. simpl in *. eassumption. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - lia. lia. eapply H6. lia. apply Hrdx. } + auto. simpl in *. eassumption. eauto. lia. + eassumption. lia. apply Hrdx. } 2: { eapply well_formed_allocation_truncl; try apply Henv; try apply Hrdx; auto. - simpl in *. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply constant_nonneg_bounds_sizeof_no_vars in H2. - erewrite size_of_sizeof in H2; eauto. invert H2. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - } + simpl in *. eauto. } cases (reindexer - (shape_to_index (result_shape_Z (V x)) - (shape_to_vars (result_shape_Z (V x))))). + (shape_to_index (result_shape_Z (V x0)) + (shape_to_vars (result_shape_Z (V x0))))). { eapply reindexer_not_empty in Heq. propositional. apply Hrdx. - cases x; unfold result_shape_Z; simpl; inversion 1. } - + cases x0; unfold result_shape_Z; simpl; inversion 1. } + cases (shape_to_index (result_shape_Z (V (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) ++ x))) + (Z.to_nat kz :: sh0) ++ x0))) (shape_to_vars (result_shape_Z (V (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) ++ - x))))). + (Z.to_nat kz :: sh0) ++ + x0))))). { eapply shape_to_index_not_empty_Z in Heq0. propositional. } - cases (reindexer - (let (v, d) := p1 in - ((v - k)%z, (d - k)%z) :: l2)). + destruct (reindexer (let (v, d) := p1 in _)) eqn:Heq1. { erewrite result_has_shape_result_shape_Z in Heq0. 2: { eauto. } unfold shape_to_index, shape_to_vars, result_shape_Z in Heq0. simpl in Heq0. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). lia. + cases m. lia. cases l; invert Heq0. - eapply reindexer_not_empty_vars_in_index in Heq1. propositional. - apply Hrdx. simpl. unfold app_no_dups. simpl. - unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H9. invs. - eapply constant_not_empty in H6. propositional. inversion 1. + apply Hrdx. simpl. intro. cups_empty. - eapply reindexer_not_empty_vars_in_index in Heq1. propositional. - apply Hrdx. simpl. unfold app_no_dups. simpl. - unfold not. intros. - eapply cup_empty in H6. invs. - eapply cup_empty in H9. invs. - eapply constant_not_empty in H6. propositional. inversion 1. } - invs. + apply Hrdx. simpl. intro. cups_empty. } + invs'. pose proof Halloc as Halloc1. - + eapply well_formed_allocation_result_V in Halloc1; try apply Hrdx. invs. - unfold lookup_total. rewrite H9. - split. 2: auto. f_equal. + unfold lookup_total. rewrite H8. + split. 2: auto. f_equal. f_equal. invs. subst. unfold tensor_to_array_delta. @@ -3930,52 +3193,48 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 2: { simpl in *. eapply result_has_shape_app_l. 2: eauto. simpl. rewrite repeat_length. reflexivity. } - repeat rewrite map_cons. - rewrite <- map_cons. - rewrite <- map_cons. rewrite filter_pad_l_mesh_grid; auto. eapply eq_tensor_to_array_delta_by_indices_shuffle with (shuffle:=(fun l => match l with | [] => l - | x::xs => (x+eval_Zexpr_Z_total $0 k)%Z::xs + | x::xs => (x+kz)%Z::xs end)). + intros. repeat decomp_index. eapply result_lookup_Z_option_concat_l; lia. + intros. repeat decomp_index. eapply eq_partial_interpret_reindexer_truncl. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. + eauto. apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. - lia. lia. lia. + lia. lia. + intros. repeat decomp_index. - eapply in_map_iff. eexists (z::x2). + eapply in_map_iff. eexists (z::x3). propositional. eapply filter_In. propositional. repeat decomp_goal_index. propositional. - + intros. eapply in_map_iff in H6. invs. + + intros ? H'. eapply in_map_iff in H'. invs. repeat decomp_index. - eexists (z::x3). propositional. + eexists (z::x4). propositional. eapply filter_In. propositional. repeat decomp_goal_index. propositional. - + decomp_well_formed_reindexer. pose proof Hinj. - erewrite result_has_shape_result_shape_Z in H6. - eapply H6. + + decomp_well_formed_reindexer. pose proof Hinj as H'. + erewrite result_has_shape_result_shape_Z in H'. + eapply H'. eapply result_has_shape_app_l; eauto. simpl. rewrite repeat_length. reflexivity. + decomp_well_formed_reindexer. eapply partial_injective_truncl. eauto. eassumption. - apply Henv. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - auto. auto. auto. auto. lia. lia. lia. + apply Henv. + auto. auto. auto. auto. auto. lia. lia. + unfold injective. propositional. repeat decomp_index. - invert H15. f_equal. lia. + invs'. f_equal. lia. + eapply no_dup_filter. eapply no_dup_mesh_grid. + eapply no_dup_injective_map. 2: { eapply no_dup_filter. @@ -3983,88 +3242,38 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). unfold injective. propositional. repeat decomp_index. - invert H15. f_equal. lia. - - (* PADR *) simpl in *. invert Hconst. invert Hsize. eq_size_of. - invert H6. - assert (result_has_shape (V l) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (m::l0)))) - as Hsh. - { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - eassumption. eassumption. eauto. } - pose proof H4. - eapply constant_nonneg_bounds_sizeof_nonneg in H6. - 2: { erewrite size_of_sizeof by eassumption. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - eapply constant_nonneg_bounds_sizeof_no_vars in H6. - erewrite size_of_sizeof in * by eassumption. - eauto. } - invert H6. - pose proof H4. - eapply constant_nonneg_bounds_sizeof_no_vars in H6. - erewrite size_of_sizeof in * by eassumption. - invert H6. invs. + invs'. f_equal. lia. + - (* PADR *) simpl in *. invert Hsize. eq_size_of. invs'. eq_eval_Z. + + rename H4 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. + rewrite Hk' in *. invs'. apply eval_Zexpr_Z_eval_Zexpr in Hk. + + assert (result_has_shape (V l) (n::s)) as Hsh. + { eauto using size_of_eval_expr_result_has_shape. } + pose proof Halloc as Halloc1. eapply well_formed_allocation_result_V in Halloc1. inversion Halloc1 as [a Htmp]. clear Halloc1. inversion Htmp as [Heq Hsub]. clear Htmp. - assert (eval_Zexpr_Z_total $0 k = kz)%Z. - { pose proof H6. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H6. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=v) in H5. - invert H6. invert H5. simpl in *. - pose proof H. - eapply eval_Zexpr_Z_eval_Zexpr in H,H5. - eapply H8 in H. invert H. - eapply H6 in H5. invert H5. auto. } - - assert ((map (eval_Zexpr_Z_total $0) l0) = sz). - { eapply constant_nonneg_bounds_size_of_no_vars in H4; eauto. - invert H4. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H15. - eq_eval_Zlist. auto. } - assert (eq_zexpr k (|eval_Zexpr_Z_total $0 k|)%z) as Heqk. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - assert (eq_zexpr m (|eval_Zexpr_Z_total $0 m|)%z) as Heqm. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - - invert Hpad; eq_size_of. - { invert H5. repeat rewrite map_cons in *. - rewrite H21 in *. invert Hsh. rewrite app_nil_l in *. + invert Hpad; eq_size_of; invs'. + { invert Hsh. rewrite app_nil_l in *. rewrite <- gen_pad_cons in *. rewrite filter_negb_is_None_result_lookup_Z_option_gen_pad in *. unfold lookup_total. rewrite Heq. - cases (reindexer - (shape_to_index - (result_shape_Z - (gen_pad - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) rest)))) - (shape_to_vars - (result_shape_Z - (gen_pad - (Z.to_nat - (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) rest))))))). - { eapply reindexer_not_empty_vars_in_index in Heq0. propositional. + match goal with + | |- context[reindexer ?x] => destruct (reindexer x) eqn:Heq0 + end. + { eapply reindexer_not_empty_vars_in_index in Heq0. + contradiction. apply Hrdx. erewrite result_has_shape_result_shape_Z by eapply result_has_shape_gen_pad. - simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). - simpl. unfold not. intros. - eapply cup_empty in H5. invs. eapply cup_empty in H8. invs. - eapply constant_not_empty in H5. propositional. inversion 1. - simpl. unfold not. intros. - eapply cup_empty in H5. invs. eapply cup_empty in H8. invs. - eapply constant_not_empty in H5. propositional. inversion 1. } + cases (Z.to_nat kz); simpl; intro; cups_empty. } unfold result_shape_Z in IHeval_expr. - unfold shape_to_index, shape_to_vars in IHeval_expr. + unfold shape_to_index, shape_to_vars in IHeval_expr. simpl in IHeval_expr. rewrite tensor_to_array_delta_gen_pad in *. rewrite array_add_empty_r. rewrite add_id by auto. @@ -4072,25 +3281,28 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 2: { apply well_formed_allocation_result_V in Halloc. invert Halloc. decomp_well_formed_reindexer. - propositional. simpl. unfold partial_injective. intros. - invert H5. + propositional. simpl. unfold partial_injective. + intros. simpl in *. contradiction. destruct l1; destruct l2; eauto. - invert H5; simpl in *; try lia. - invert H5; simpl in *; try lia. + destruct H as (H&_). invert H. + destruct H as (H&_). invert H. destruct p1. destruct p2. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons_tup. - erewrite <- eq_Z_tuple_index_list_cons_tup in H5. - propositional. - eapply eq_zexpr_add; eauto. + erewrite <- eq_Z_tuple_index_list_cons_tup in H. + propositional. auto using eq_zexpr_add. destruct l0. simpl. rewrite Hmap. eauto. eauto. destruct p1. simpl. rewrite Hmap. simpl. unfold subst_var_in_Z_tup at 1. simpl. - rewrite subst_var_in_Zexpr_id with (lo:=k). eauto. - invert Heqk. rewrite H15. sets. auto. - destruct l0. rewrite Hvarsarg. sets. destruct p1. + f_equal. f_equal. f_equal. f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + auto. + assumption. + destruct l0. simpl. sets. + destruct p1. simpl. rewrite Hvarsarg. simpl. - invert Heqk. rewrite H14. simpl. - rewrite app_no_dups_empty_r. sets. + erewrite (eval_Zexpr_vars_empty k) by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + rewrite app_no_dups_empty_r. + reflexivity. unfold nondestructivity. unfold tensor_to_array_delta. simpl. unfold tensor_to_array_delta_by_indices. simpl. @@ -4098,21 +3310,17 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply lookup_Some_dom in Heq. sets. apply Hrdx. } cases (reindexer [((! "?" !)%z, (| 0 | + k)%z)]). eapply reindexer_not_empty_vars_in_index in Heq1. propositional. - apply Hrdx. simpl. - unfold not. intros. - eapply cup_empty in H5. invs. - eapply cup_empty in H8. invs. - apply constant_not_empty in H5. propositional. inversion 1. - invs. subst. unfold lookup_total. rewrite Heq. + apply Hrdx. simpl. intro. cups_empty. + invs'. subst. unfold lookup_total. rewrite Heq. rewrite tensor_to_array_delta_empty_tensor. rewrite array_add_empty_r. rewrite add_id. propositional. auto. + eapply well_formed_allocation_padr. + constructor. + eauto. + lia. + eassumption. + apply Hrdx. apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. } - eapply well_formed_allocation_padr with (m:=dim) (l0:=rest). - simpl. rewrite H21. econstructor. eauto. eauto. - simpl. eauto. apply Hrdx. apply Henv. apply Hrdx. apply Hrdx. - apply Hrdx. - } - eapply IHeval_expr in Heval; eauto. subst. erewrite result_has_shape_result_shape_Z. @@ -4120,51 +3328,27 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). simpl in Hsh. apply Hsh. eapply result_has_shape_repeat_gen_pad. } - cases (reindexer - (shape_to_index - (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) + - Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) - (shape_to_vars - (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) + - Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0))))). + match goal with + | |- context[reindexer ?x] => destruct (reindexer x) eqn:Heq0 + end. { eapply reindexer_not_empty in Heq0. propositional. apply Hrdx. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - + Z.to_nat (eval_Zexpr_Z_total $0 k))%nat; - inversion 1. } + cases (dim + Z.to_nat kz)%nat; inversion 1. } cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq1. propositional. } unfold lookup_total. rewrite Heq. - - cases (reindexer (let (v, d) := p1 in (v, (d + k)%z) :: l3)). - { erewrite result_has_shape_result_shape_Z in Heq1; eauto. + + destruct (reindexer (let (v, d) := p1 in _)) eqn:Heq2. + { erewrite result_has_shape_result_shape_Z in Heq1; eauto. unfold result_shape_Z, shape_to_index, shape_to_vars in Heq1. simpl in *. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)); invert Heq1. + cases dim; invert Heq1. - eapply reindexer_not_empty_vars_in_index in Heq2. propositional. - apply Hrdx. simpl. unfold app_no_dups. - rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H8. invs. - eapply cup_empty in H13. invs. - eapply constant_not_empty in H8. propositional. inversion 1. + apply Hrdx. simpl. intro. cups_empty. - eapply reindexer_not_empty_vars_in_index in Heq2. propositional. - apply Hrdx. simpl. unfold app_no_dups. - rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H8. invs. - eapply cup_empty in H13. invs. - eapply constant_not_empty in H8. propositional. inversion 1. } - invs. + apply Hrdx. simpl. intro. cups_empty. } + invs'. split; auto. f_equal. unfold lookup_total. rewrite Heq. f_equal. @@ -4175,20 +3359,11 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 2: { eapply result_has_shape_concat. simpl in Hsh. eauto. eapply result_has_shape_repeat_gen_pad. } - - pose proof filter_pad_r_mesh_grid. simpl gen_pad_list in H8. - rewrite <- Z2Nat.inj_add. - rewrite <- map_cons. - rewrite <- eval_Zexpr_Z_total_add_distr; - try eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - rewrite <- map_cons. - rewrite H8. - rewrite map_cons. - rewrite eval_Zexpr_Z_total_add_distr; - try eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. + + pose proof filter_pad_r_mesh_grid as H. simpl gen_pad_list in H. + rewrite H. erewrite result_has_shape_result_shape_Z by eauto. - rewrite Z2Nat.inj_add by lia. rewrite add_sub. eapply eq_tensor_to_array_delta_by_indices_shuffle with (shuffle:=fun l1 => l1). @@ -4200,10 +3375,10 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). lia. + intros. repeat decomp_index. - repeat rewrite map_cons. + rewrite <- (Z2Nat.id kz) by lia. rewrite Nat2Z.id. erewrite eq_partial_interpret_reindexer_concat_l; try apply Hrdx; try apply Henv. - rewrite Z2Nat.inj_add by lia. reflexivity. + reflexivity. 2: eauto. 2: { eapply result_has_shape_repeat_gen_pad. } erewrite result_has_shape_result_shape_Z by eauto. @@ -4211,7 +3386,7 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). repeat decomp_goal_index. propositional. rewrite Z2Nat.id by lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. + eauto. + intros. auto. + intros. repeat decomp_index. @@ -4225,136 +3400,81 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). simpl in Hsh. eauto. eapply result_has_shape_repeat_gen_pad. } - repeat rewrite map_cons. eapply partial_injective_concat_l; auto; try apply Henv. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_concat. simpl in Hsh. eassumption. eapply result_has_shape_repeat_gen_pad - with (k:=Z.to_nat (eval_Zexpr_Z_total $0 k)). } + with (k:=Z.to_nat kz). } rewrite filter_fun_pad_r in *. auto. eapply result_has_shape_repeat_gen_pad. - rewrite Z2Nat.id by lia. auto. + rewrite Z2Nat.id. auto. lia. + decomp_well_formed_reindexer. erewrite result_has_shape_result_shape_Z in Hinj. 2: { eapply result_has_shape_concat. simpl in Hsh. eauto. - eapply result_has_shape_repeat_gen_pad. } + eapply result_has_shape_repeat_gen_pad. } rewrite filter_fun_pad_r in *. simpl filter_until at 2. simpl filter_until at 2 in Hinj. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). + cases dim. { simpl in *. unfold partial_injective. simpl in *. propositional. } - simpl map at 4. posnats. - simpl map at 4 in Hinj. posnats. + simpl map at 2. posnats. + simpl map at 2 in Hinj. posnats. rewrite <- add_succ_l in Hinj. - rewrite <- Heq3 in *. - clear Heq3. clear n. rewrite Nat2Z.inj_add in Hinj. rewrite mesh_grid_app in Hinj by lia. rewrite filter_app in Hinj. eapply partial_injective_app_l in Hinj. - rewrite map_cons. - rewrite Z2Nat.inj_add by lia. eassumption. + unfold injective. propositional. + eapply no_dup_filter. eapply no_dup_mesh_grid. + eapply no_dup_filter. eapply no_dup_mesh_grid. - + simpl. rewrite eval_Zexpr_Z_total_add_distr by eauto. - rewrite Z2Nat.inj_add by lia. - rewrite Nat.add_comm. + + simpl. rewrite Nat.add_comm. eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. eauto. - + lia. - + lia. - + lia. + subst. eapply well_formed_reindexer_padr; try apply Henv; eauto. - invert H5. lia. + subst. eapply well_formed_allocation_padr; try apply Hrdx; try apply Henv; eauto. + apply Hrdx. - - (* PADL *) simpl in *. invert Hconst. invert Hsize. eq_size_of. - invert H6. - assert (result_has_shape (V l) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (m::l0)))) - as Hsh. - { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - eassumption. eassumption. eauto. } - pose proof H4. - eapply constant_nonneg_bounds_sizeof_nonneg in H6. - 2: { erewrite size_of_sizeof by eassumption. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - eapply constant_nonneg_bounds_sizeof_no_vars in H6. - erewrite size_of_sizeof in * by eassumption. - eauto. } - invert H6. - pose proof H4. - eapply constant_nonneg_bounds_sizeof_no_vars in H6. - erewrite size_of_sizeof in * by eassumption. - invert H6. invs. + - (* PADL *) simpl in *. invert Hsize. eq_size_of. invs'. eq_eval_Z. + + rename H4 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. + rewrite Hk' in *. invs'. apply eval_Zexpr_Z_eval_Zexpr in Hk. + + assert (result_has_shape (V l) (n::s)) as Hsh. + { eauto using size_of_eval_expr_result_has_shape. } pose proof Halloc as Halloc1. eapply well_formed_allocation_result_V in Halloc1. inversion Halloc1 as [a Htmp]. clear Halloc1. inversion Htmp as [Heq Hsub]. clear Htmp. - assert (eval_Zexpr_Z_total $0 k = kz)%Z. - { pose proof H6. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H6. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=v) in H5. - invert H6. invert H5. simpl in *. - pose proof H. - eapply eval_Zexpr_Z_eval_Zexpr in H,H5. - eapply H8 in H. invert H. - eapply H6 in H5. invert H5. auto. } - - assert ((map (eval_Zexpr_Z_total $0) l0) = sz). - { eapply constant_nonneg_bounds_size_of_no_vars in H4; eauto. - invert H4. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H15. - eq_eval_Zlist. auto. } - invert Hpad; eq_size_of. - { invert H5. repeat rewrite map_cons in *. rewrite H21 in *. - invert Hsh. rewrite app_nil_r in *. + invert Hpad; eq_size_of; invs'. + { invert Hsh. rewrite app_nil_r in *. rewrite <- gen_pad_cons in *. rewrite filter_negb_is_None_result_lookup_Z_option_gen_pad in *. unfold lookup_total. rewrite Heq. - cases (reindexer - (shape_to_index - (result_shape_Z - (gen_pad - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) rest)))) - (shape_to_vars - (result_shape_Z - (gen_pad - (Z.to_nat - (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) rest))))))). + match goal with + | |- context[reindexer ?x] => destruct (reindexer x) eqn:Heq0 + end. { eapply reindexer_not_empty_vars_in_index in Heq0. propositional. apply Hrdx. erewrite result_has_shape_result_shape_Z by eapply result_has_shape_gen_pad. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). - simpl. unfold not. intros. - eapply cup_empty in H5. invs. eapply cup_empty in H8. invs. - eapply constant_not_empty in H5. propositional. inversion 1. - simpl. unfold not. intros. - eapply cup_empty in H5. invs. eapply cup_empty in H8. invs. - eapply constant_not_empty in H5. propositional. inversion 1. } + cases (Z.to_nat kz). + simpl. intro. cups_empty. + simpl. intro. cups_empty. } unfold result_shape_Z in IHeval_expr. - unfold shape_to_index, shape_to_vars in IHeval_expr. + unfold shape_to_index, shape_to_vars in IHeval_expr. simpl in IHeval_expr. rewrite tensor_to_array_delta_gen_pad in *. rewrite array_add_empty_r. rewrite add_id by auto. @@ -4366,21 +3486,27 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). propositional. unfold partial_injective. simpl. propositional. destruct l1; destruct l2; eauto. - invert H14; simpl in *; lia. - invert H14; simpl in *; lia. + destruct H4 as (H4&_). invert H4. + destruct H4 as (H4&_). invert H4. destruct p1. destruct p2. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons_tup. - erewrite <- eq_Z_tuple_index_list_cons_tup in H14. - propositional. eapply eq_zexpr_add; eauto. - eapply eq_zexpr_add; eauto. + erewrite <- eq_Z_tuple_index_list_cons_tup in H4. + propositional. + auto using eq_zexpr_add. + auto using eq_zexpr_add. destruct l0. rewrite Hmap. eauto. eauto. - destruct p1. simpl. rewrite Hmap. simpl. - unfold subst_var_in_Z_tup at 1. simpl. - rewrite subst_var_in_Zexpr_id with (lo:=k). eauto. - rewrite H6. sets. eauto. + destruct p1. simpl. rewrite Hmap. cbv [subst_var_in_Z_tup]. simpl. + f_equal. f_equal. f_equal. f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + auto. + f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + auto. + assumption. destruct l0. rewrite Hvarsarg. sets. destruct p1. rewrite Hvarsarg. simpl. - rewrite H6. repeat rewrite app_no_dups_empty_r. sets. + erewrite (eval_Zexpr_vars_empty k) by (apply eval_Zexpr_Z_eval_Zexpr; eassumption). + do 2 rewrite app_no_dups_empty_r. reflexivity. unfold nondestructivity. unfold tensor_to_array_delta, tensor_to_array_delta_by_indices. simpl. rewrite dom_empty. split; intros. sets. @@ -4389,78 +3515,45 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). } 2: { eapply well_formed_allocation_padl. rewrite app_nil_r. eauto. - simpl. rewrite H21. econstructor. - apply Hrdx. lia. lia. apply Hrdx. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. + econstructor. + apply Hrdx. lia. apply Hrdx. auto. apply Henv. apply Hrdx. apply Hrdx. } - invs. cases (reindexer [((! "?" ! + k)%z, (| 0 | + k)%z)]). eapply reindexer_not_empty_vars_in_index in Heq1. propositional. - apply Hrdx. simpl. - unfold not. intros. - eapply cup_empty in H5. invs. - eapply cup_empty in H8. invs. - apply constant_not_empty in H5. propositional. inversion 1. - invs. subst. unfold lookup_total. rewrite Heq. + apply Hrdx. simpl. intro. cups_empty. + invs'. subst. unfold lookup_total. rewrite Heq. rewrite tensor_to_array_delta_empty_tensor. rewrite array_add_empty_r. rewrite add_id. propositional. auto. } - + eapply IHeval_expr in Heval. subst. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. simpl in *. eassumption. } - cases (reindexer - (shape_to_index - (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 k) + - Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) - (shape_to_vars - (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 k) + - Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0))))). + match goal with + | |- context[reindexer ?x] => destruct (reindexer x) eqn:Heq0 + end. { eapply reindexer_not_empty in Heq0. propositional. apply Hrdx. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 k) - + Z.to_nat (eval_Zexpr_Z_total $0 m))%nat; - inversion 1. } + cases (Z.to_nat kz + dim)%nat; inversion 1. } cases (shape_to_index (result_shape_Z (V l)) (shape_to_vars (result_shape_Z (V l)))). { eapply shape_to_index_not_empty_Z in Heq1. propositional. } unfold lookup_total. rewrite Heq. - - cases (reindexer (let (v, d) := p1 in ((v + k)%z, (d + k)%z) :: l3)). - { erewrite result_has_shape_result_shape_Z in Heq1; eauto. + + destruct (reindexer (let (v, d) := p1 in _)) eqn:Heq2. + { erewrite result_has_shape_result_shape_Z in Heq1; eauto. unfold result_shape_Z, shape_to_index, shape_to_vars in Heq1. simpl in *. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)); invert Heq1. + cases dim; invert Heq1. - eapply reindexer_not_empty_vars_in_index in Heq2. propositional. - apply Hrdx. simpl. unfold app_no_dups. - rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H8. invs. - eapply cup_empty in H13. invs. - eapply cup_empty in H8. invs. - eapply constant_not_empty in H13. propositional. inversion 1. + apply Hrdx. simpl. intro. cups_empty. - eapply reindexer_not_empty_vars_in_index in Heq2. propositional. - apply Hrdx. simpl. unfold app_no_dups. - rewrite <- union_constant. - unfold not. intros. - eapply cup_empty in H8. invs. - eapply cup_empty in H13. invs. - eapply cup_empty in H8. invs. - eapply constant_not_empty in H13. propositional. inversion 1. } - invs. + apply Hrdx. simpl. intro. cups_empty. } + invs'. split; auto. f_equal. unfold lookup_total. rewrite Heq. f_equal. @@ -4470,37 +3563,26 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. - eauto. simpl in *. eauto. } - pose proof filter_pad_l_mesh_grid. simpl gen_pad_list in H8. - rewrite <- Z2Nat.inj_add. - rewrite <- map_cons. - rewrite <- eval_Zexpr_Z_total_add_distr; - try eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - rewrite <- map_cons. - rewrite H8. - rewrite map_cons. - rewrite eval_Zexpr_Z_total_add_distr; - try eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. + eauto. } + pose proof filter_pad_l_mesh_grid as H. simpl gen_pad_list in H. + rewrite H. erewrite result_has_shape_result_shape_Z by eauto. eapply eq_tensor_to_array_delta_by_indices_shuffle with (shuffle:=fun l1 : list Z => match l1 with | [] => l1 - | x1 :: xs => (x1 + eval_Zexpr_Z_total $0 k)%Z :: xs + | x1 :: xs => (x1 + kz)%Z :: xs end). + intros. repeat decomp_index. - pose proof result_lookup_Z_option_concat_l. - simpl gen_pad_list in H14. rewrite H14. reflexivity. lia. lia. + pose proof result_lookup_Z_option_concat_l as H'. + simpl gen_pad_list in H'. rewrite H'. reflexivity. lia. lia. + intros. repeat decomp_index. repeat rewrite map_cons. erewrite eq_partial_interpret_reindexer_padl; eauto. - rewrite Z2Nat.inj_add by lia. auto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. - lia. + intros. repeat decomp_index. eapply in_map_iff. eexists (z::x0). @@ -4508,100 +3590,68 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply filter_In. propositional. repeat decomp_goal_index. propositional. lia. - + intros. - eapply in_map_iff in H13. invs. - repeat decomp_index. + + intros ? H14. + eapply in_map_iff in H14. invs. + repeat decomp_index. eexists (z::x1). propositional. eapply filter_In. propositional. repeat decomp_goal_index. propositional. lia. - + repeat rewrite map_cons. - assert (eval_Zexpr_Z_total $0 m = 0 \/ - eval_Zexpr_Z_total $0 m <> 0)%Z by lia. invert H13. + + assert (dim = 0 \/ dim <> 0) as [H14|H14] by lia. { rewrite H14. simpl. - unfold partial_injective. propositional. invert H16. } + unfold partial_injective. propositional. simpl in *. contradiction. } decomp_well_formed_reindexer. eapply partial_injective_padl; eauto. apply Henv. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - lia. + decomp_well_formed_reindexer. erewrite result_has_shape_result_shape_Z in Hinj. 2: { eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. simpl in Hsh. eauto. } - rewrite <- Z2Nat.inj_add in Hinj by lia. - rewrite <- map_cons in Hinj. - rewrite <- eval_Zexpr_Z_total_add_distr in Hinj; - try eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - rewrite <- map_cons in Hinj. - pose proof filter_pad_l_mesh_grid. + pose proof filter_pad_l_mesh_grid as H8. simpl gen_pad_list in H8. rewrite H8 in Hinj. clear H8. - rewrite map_cons in Hinj. - rewrite eval_Zexpr_Z_total_add_distr in Hinj; - try eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. + apply Hinj. - repeat rewrite map_cons. - rewrite eval_Zexpr_Z_total_add_distr; - try eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - rewrite Z2Nat.inj_add by lia. eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. eauto. lia. + unfold injective. propositional. - repeat decomp_index. invert H19. f_equal. lia. + repeat decomp_index. invs'. f_equal. lia. + eapply no_dup_filter. eapply no_dup_mesh_grid. + eapply no_dup_injective_map. unfold injective. propositional. - repeat decomp_index. invert H19. f_equal. lia. + repeat decomp_index. invs'. f_equal. lia. eapply no_dup_filter. eapply no_dup_mesh_grid. + simpl. - rewrite eval_Zexpr_Z_total_add_distr; - try eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - rewrite Z2Nat.inj_add by lia. simpl. eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. auto. + lia. - + lia. - + lia. + eauto. + eauto. + eauto. + decomp_well_formed_reindexer. subst. eapply well_formed_allocation_result_V in Halloc. invert Halloc. - eapply well_formed_reindexer_padl; auto. eauto. - simpl in Hsh. eauto. apply Henv. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - invert H5. lia. - eapply H8. - eauto. - apply H8. - eauto. + invs'. + eapply well_formed_reindexer_padl; eauto. apply Henv. eauto. + decomp_well_formed_reindexer. subst. - eapply well_formed_allocation_padl; auto. - eauto. eauto. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - apply Henv. + eapply well_formed_allocation_padl; eauto. apply Henv. + eauto. + eauto. + eauto. + apply Hrdx. - (* SCALAR *) - simpl in *. + simpl in *. invert Heval. + unfold result_shape_Z in *. simpl in *. unfold shape_to_index, shape_to_vars in *. simpl in *. rewrite H10 in *. invs. rewrite H9 in *. invs. split. auto. - + eapply eval_Sexpr_eval_Sstmt in H8; eauto. subst. eapply Hrdx in H9. subst. f_equal. ring. reflexivity. eapply lookup_Some_dom in H9. unfold well_formed_environment in *. @@ -4627,7 +3677,6 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). unfold nondestructivity in Hnondstr. invert Hnondstr. clear H1. invert H. - cases r; try discriminate. - - cases r; try discriminate. - cases r1; cases r2; simpl in *; try discriminate. - cases r1; cases r2; simpl in *; try discriminate. - cases r1; cases r2; simpl in *; try discriminate. @@ -4638,12 +3687,12 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). decomp_well_formed_reindexer. rewrite map_id. eapply vars_of_reindexer_subseteq_map_partially_eval_Z_tup in Hvarsub. - invs. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0) in H0,H1. + destruct Hvarsub as (Hv1&Hv2). + eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0) in Hv1, Hv2. rewrite map_fst_map_partially_eval_Z_tup in *. rewrite map_snd_map_partially_eval_Z_tup in *. rewrite map_eval_Zexpr_Z_total_map_partially_eval_Zexpr_join in *. - + propositional. f_equal. eapply eval_Zexpr_Z_eval_Zexpr in H11. @@ -4651,7 +3700,6 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). rewrite partially_eval_Zexpr_flatten_shape_index in H11. erewrite eval_Zexpr_Z_flatten_index_flatten in H11. 2: { eauto. } - 2: { eauto. } invs. rewrite join_empty_r in *. rewrite map_eval_Zexpr_Z_tup_total_map_partially_eval_Z_tup. @@ -4663,9 +3711,9 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). rewrite merge_add2. 2: { intros. cases x; discriminate. } 2: { rewrite dom_empty. sets. } - rewrite H12. + rewrite H1. rewrite merge_empty2. - f_equal. + f_equal. eapply eval_Sexpr_eval_Sstmt in H. 2: { eauto. } 2: { eauto. } @@ -4677,7 +3725,7 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). in H10; eauto. 2: { eapply lookup_Some_dom in H10. unfold well_formed_environment in *. sets. } - 2: { clear H2. unfold result_shape_Z. simpl. + 2: { clear H0. unfold result_shape_Z. simpl. unfold tensor_to_array_delta. simpl. unfold tensor_to_array_delta_by_indices. simpl. rewrite array_add_empty_l. unfold shape_to_index,shape_to_vars. @@ -4689,8 +3737,10 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). rewrite eval_Zexprlist_map_match_fst_map_eval_Zexpr_Z_tup_total; eauto. sets. } - rewrite H10 in *. invert H12. ring. + rewrite <- H1 in *. + rewrite H10 in *. invert H12. f_equal. ring. intros; cases x; auto. + rewrite join_empty_r in *. assumption. + unfold well_formed_allocation in Halloc. unfold result_shape_Z in *. simpl in *. unfold shape_to_index, shape_to_vars in *. @@ -4731,12 +3781,12 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). decomp_well_formed_reindexer. rewrite map_id. eapply vars_of_reindexer_subseteq_map_partially_eval_Z_tup in Hvarsub. - invs. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0) in H0,H1. + destruct Hvarsub as (Hv1&Hv2). + eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0) in Hv1, Hv2. rewrite map_fst_map_partially_eval_Z_tup in *. rewrite map_snd_map_partially_eval_Z_tup in *. rewrite map_eval_Zexpr_Z_total_map_partially_eval_Zexpr_join in *. - + propositional. f_equal. eapply eval_Zexpr_Z_eval_Zexpr in H11. @@ -4744,7 +3794,6 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). rewrite partially_eval_Zexpr_flatten_shape_index in H11. erewrite eval_Zexpr_Z_flatten_index_flatten in H11. 2: { eauto. } - 2: { eauto. } invs. rewrite join_empty_r in *. rewrite map_eval_Zexpr_Z_tup_total_map_partially_eval_Z_tup. @@ -4756,22 +3805,23 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). rewrite merge_add2. 2: { intros. cases x; discriminate. } 2: { rewrite dom_empty. sets. } - rewrite H12. + rewrite <- H1 in *. rewrite H12. rewrite merge_empty2. rewrite Rplus_comm. f_equal. f_equal. eapply eval_Sexpr_eval_Sstmt in H. rewrite H. reflexivity. eauto. eauto. intros; cases x; auto. + rewrite join_empty_r in *. assumption. Qed. Theorem lower_correct : forall e, - constant_nonneg_bounds e -> forall r, (* functional evaluation of ATL *) - eval_expr $0 $0 $0 e r -> - forall l, size_of e l -> + eval_expr $0 $0 e r -> + nonneg_bounds $0 e -> + forall l, size_of $0 e l -> forall p st h st' h' asn, (h,st) = match (shape_to_index @@ -4784,7 +3834,7 @@ Theorem lower_correct : eval_stmt $0 st h (lower e (fun l => l) p asn $0) st' h' -> ~ p \in vars_of e -> forall pads, - has_pad $0 $0 $0 e pads -> + has_pad $0 $0 e pads -> match (fun l => l) (shape_to_index (result_shape_Z r) (shape_to_vars (result_shape_Z r))) with @@ -4812,13 +3862,13 @@ Proof. cases r. + simpl in *. invert H2. unfold well_formed_environment. - rewrite dom_add. + rewrite dom_add. repeat rewrite dom_empty. repeat rewrite cup_empty_r. repeat rewrite cap_empty_r. split. sets. split. auto. - split. sets. + split. sets. split. sets. split. sets. split. sets. @@ -4827,13 +3877,13 @@ Proof. * invert H2. unfold alloc_array_in_heap. simpl. unfold well_formed_environment. - rewrite dom_add. + rewrite dom_add. repeat rewrite dom_empty. repeat rewrite cup_empty_r. repeat rewrite cap_empty_r. split. sets. split. auto. - split. sets. + split. sets. split. sets. split. sets. split. sets. @@ -4841,13 +3891,13 @@ Proof. * invert H2. unfold alloc_array_in_heap. simpl. unfold well_formed_environment. - rewrite dom_add. + rewrite dom_add. repeat rewrite dom_empty. repeat rewrite cup_empty_r. repeat rewrite cap_empty_r. split. sets. split. auto. - split. sets. + split. sets. split. sets. split. sets. split. sets. @@ -4874,8 +3924,8 @@ Proof. split; intros. invert H2. 2: { discriminate. } destruct v. simpl in *. - unfold tensor_to_array_delta in H8. simpl in H8. - unfold tensor_to_array_delta_by_indices in H8. simpl in H8. + unfold tensor_to_array_delta in H7. simpl in H7. + unfold tensor_to_array_delta_by_indices in H7. simpl in H7. rewrite dom_empty in *. sets. pose proof (lookup_alloc_array (fold_left mul (Datatypes.S (length v) :: @@ -4896,7 +3946,7 @@ Proof. erewrite partial_interpret_reindexer_id_flatten in H8. 2: { decomp_index. eauto. } 2: { rewrite dom_empty. sets. } - invert H8. + invs'. unfold result_shape_Z. simpl result_shape_nat. erewrite Z_of_nat_fold_left_mul. eapply in_mesh_grid_flatten_in_range. @@ -4915,7 +3965,7 @@ Proof. * invert H2. unfold well_formed_allocation. unfold shape_to_index, shape_to_vars. - set (mesh_grid (map Z.of_nat (result_shape_nat (V (r :: v))))). + set (l0 := mesh_grid (map Z.of_nat (result_shape_nat (V (r :: v))))). subst l0. unfold alloc_array_in_heap. rewrite lookup_add_eq by auto. eexists. split. reflexivity. @@ -4930,4 +3980,3 @@ Proof. - unfold contexts_agree. intros. repeat rewrite lookup_empty. propositional; discriminate. Qed. - diff --git a/src/verified_lowering/proof/LowerExists.v b/src/verified_lowering/proof/LowerExists.v index 8a0cc3d..af77c49 100644 --- a/src/verified_lowering/proof/LowerExists.v +++ b/src/verified_lowering/proof/LowerExists.v @@ -24,6 +24,7 @@ Open Scope string_scope. Local Hint Constructors eval_Zexpr eval_Bexpr eval_Sexpr size_of. Local Hint Resolve eval_Zexprlist_includes_valuation includes_add_new None_dom_lookup. +Local Hint Resolve eval_Zexpr_Z_eval_Zexpr' : core. Hint Resolve no_dup_var_generation no_dup_mesh_grid forall_map_not_in_index forall_map_not_in_dom @@ -35,21 +36,11 @@ Hint Extern 3 (Datatypes.length _ = Datatypes.length _) => eapply length_mesh_grid_indices; eassumption : reindexers. Arguments flatten : simpl nomatch. -Lemma fold_left_mul_filter_until_0 : forall l x, - fold_left mul l x = fold_left mul (filter_until l 0) x. -Proof. - induct l; intros. - - reflexivity. - - simpl. cases a. simpl. rewrite mul_0_r. - replace 0 with (0*0) by lia. rewrite fold_left_mul_assoc_nat. - lia. simpl. eauto. -Qed. - Lemma eval_Sexpr_eval_Sstmt_exists - : forall (sh : context) (v : valuation) (ec : expr_context) + : forall (v : valuation) (ec : expr_context) (s : Sexpr) (r : scalar_result), - eval_Sexpr sh v ec s r -> - forall (st : stack) (h : heap), + eval_Sexpr v ec s r -> + forall (st : stack) (h : heap) sh, contexts_agree ec st h sh -> eval_Sstmt v st h (lowerS s sh) match r with | SS s0 => s0 @@ -57,78 +48,73 @@ Lemma eval_Sexpr_eval_Sstmt_exists end. Proof. induct 1; intros; simpl in *. - - econstructor. eapply H1 in H. invs. rewrite H3. f_equal. - cases r; auto. - - eapply H3 in H. invs. rewrite H0 in H. invert H. rewrite H0. - pose proof H2. eapply eval_get_eval_Zexprlist in H. invs. + - destruct rs as [?|rs]. + { invert H0. apply H1 in H. invs'. rewrite H0. econstructor. + rewrite H2. f_equal. cases r; auto. } + eapply H1 in H. invs'. rewrite H2. + pose proof H0 as H0'. eapply eval_get_eval_Zexprlist in H0'. invs'. + assert (length x0 = length l). + { eapply eval_get_length in H0; eauto. apply Forall2_length in H. + rewrite length_map in H. lia. } + destruct x0 as [|? x0]; [invert H; invert H3; discriminate|]; []. + remember (_ :: x0) as x0' eqn:E. clear x0 E. rename x0' into x0. econstructor. eauto. eapply eval_Zexpr_Z_eval_Zexpr. eapply eval_Zexpr_Z_flatten_index_flatten. - eapply forall_no_vars_eval_Zexpr_Z_total. - rewrite map_fst_combine by lia. eauto. - rewrite map_snd_combine by lia. eauto. - eapply flatten_sh_nonneg. eapply eval_get_In_meshgrid in H2. - erewrite result_has_shape_result_shape_Z in H2. + rewrite map_snd_combine by assumption. eauto. + rewrite map_fst_combine by assumption. eauto. + eapply flatten_sh_nonneg. eapply eval_get_In_meshgrid in H0. + erewrite result_has_shape_result_shape_Z in H0. 2: { eauto. } - repeat decomp_index. rewrite map_fst_combine by lia. - rewrite mesh_grid_map_Nat2Z_id in *. eauto. + repeat decomp_index. eassumption. eapply result_has_shape_self; eauto. eauto. - replace ((map Z.of_nat - (filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) x0)) 0))) - with (result_shape_Z (V rs)). + replace (map Z.of_nat (filter_until x1 0)) with (result_shape_Z (V rs)). 2: { erewrite result_has_shape_result_shape_Z by eauto. reflexivity. } rewrite tensor_to_array_delta_partial_interpret_reindexer_flatten. unfold array_add. rewrite lookup_merge. erewrite result_has_shape_result_shape_Z by eauto. - pose proof H7. eapply eval_get_In_meshgrid in H; eauto. - erewrite result_has_shape_result_shape_Z in H by eauto. + pose proof H0 as H0'. eapply eval_get_In_meshgrid in H0'; eauto. + erewrite result_has_shape_result_shape_Z in H0' by eauto. rewrite mesh_grid_filter_until in *. - rewrite mesh_grid_map_Nat2Z_id in H. 2: { eapply result_has_shape_self; eauto. } - rewrite map_fst_combine in * by lia. rewrite filter_until_0_id. - 2: { eapply mesh_grid_shape_pos in H. eapply Forall_map. - eapply Forall_impl. 2: eassumption. simpl. lia. } - rewrite Z2Natid_list. - 2: { eapply mesh_grid_shape_pos in H. + 2: { eapply mesh_grid_shape_pos in H0'. rewrite Forall_map in H0'. eapply Forall_impl. 2: eassumption. simpl. lia. } rewrite result_lookup_Z_tensor_to_array_delta in *. 2: { eapply result_has_shape_self; eauto. } 2: { erewrite result_has_shape_result_shape_Z by eauto. - decomp_goal_index. rewrite mesh_grid_map_Nat2Z_id. eauto. } + decomp_goal_index. assumption. } 2: { erewrite result_has_shape_result_shape_Z by eauto. - rewrite mesh_grid_filter_until. rewrite mesh_grid_map_Nat2Z_id. - unfold injective. intros. invs. eapply injective_flatten. - eauto. eauto. eauto. } - cases x0. invert H5. + rewrite mesh_grid_filter_until. unfold injective. intros. invs. + eapply injective_flatten. eauto. eauto. eauto. } + cases x0. invert H. destruct x1; invert H3; discriminate H7. pose proof (lookup_alloc_array - (Z.to_nat (fold_left Z.mul (map (eval_Zexpr_Z_total $0) (z :: x0)) 1%Z)) - (flatten (map (eval_Zexpr_Z_total $0) (z :: x0)) x1)). - pose proof H. rewrite map_cons in *. - eapply in_mesh_grid_args_flatten_bounds in H. - invert H9. - + eapply lookup_None_dom in H11. - rewrite dom_alloc_array in H11. - rewrite Z2Nat.id in H11. - 2: { eapply fold_left_mul_nonneg. eapply mesh_grid_shape_pos in H10. + (Z.to_nat (fold_left Z.mul (map Z.of_nat x1) 1%Z)) + (flatten (map Z.of_nat x1) x2)) as H7. + pose proof H0' as H0''. + eapply in_mesh_grid_args_flatten_bounds in H0'. + destruct H7 as [H7|H7]. + + eapply lookup_None_dom in H7. + rewrite dom_alloc_array in H7. + rewrite Z2Nat.id in H7. + 2: { eapply fold_left_mul_nonneg. eapply mesh_grid_shape_pos in H0''. eapply Forall_impl. 2: eassumption. simpl. lia. lia. } - exfalso. apply H11. + exfalso. apply H7. erewrite <- In_iff_in. eapply in_mesh_grid_flatten_in_range. - eapply mesh_grid_shape_pos in H10. + eapply mesh_grid_shape_pos in H0''. eapply Forall_impl. 2: eassumption. simpl. lia. eauto. - + rewrite H11. - pose proof H2. eapply eval_get_lookup_result_Z in H9; eauto. + + rewrite H7. + pose proof H0 as H9. eapply eval_get_lookup_result_Z in H9; eauto. subst. - - cases (result_lookup_Z_option x1 (V rs)). + + cases (result_lookup_Z_option x2 (V rs)). * eapply result_lookup_Z_option_result_lookup_Z in Heq. rewrite Heq. f_equal. ring. * eapply result_lookup_Z_option_result_lookup_Z_None in Heq. - cases (result_lookup_Z x1 (V rs)); subst; eauto. + cases (result_lookup_Z x2 (V rs)); subst; eauto. - cases r1; cases r2; simpl; econstructor; eauto. - cases r1; cases r2; simpl; econstructor; eauto. - cases r1; cases r2; simpl; econstructor; eauto. @@ -136,9 +122,9 @@ Proof. - econstructor. Qed. -Lemma snd_vars_of_reindexer_vars_of_Zexpr_subseteq : +Lemma fst_vars_of_reindexer_vars_of_Zexpr_subseteq : forall l x1, - In x1 (map snd l) -> + In x1 (map fst l) -> constant (vars_of_Zexpr x1) \subseteq (vars_of_reindexer l). Proof. induct l; intros. @@ -148,9 +134,9 @@ Proof. + eapply IHl in H0. sets. Qed. -Lemma fst_vars_of_reindexer_vars_of_Zexpr_subseteq : +Lemma snd_vars_of_reindexer_vars_of_Zexpr_subseteq : forall l x1, - In x1 (map fst l) -> + In x1 (map snd l) -> constant (vars_of_Zexpr x1) \subseteq (vars_of_reindexer l). Proof. induct l; intros. @@ -162,12 +148,12 @@ Qed. Theorem lower_correct_exists : forall e, - constant_nonneg_bounds e -> - forall sh v ec r, + forall v ec r, (* functional evaluation of ATL *) - eval_expr sh v ec e r -> - forall l, size_of e l -> - forall p st h reindexer asn, + eval_expr v ec e r -> + nonneg_bounds $0 e -> + forall l, size_of $0 e l -> + forall p st h reindexer asn sh, (* imperative evaluation of lowering *) (* our environment is well-formed *) well_formed_environment st h p sh v (vars_of e) ec -> @@ -178,80 +164,66 @@ Theorem lower_correct_exists : (* expr context and imperative state agree *) contexts_agree ec st h sh -> forall pads g, - has_pad sh v g e pads -> + has_pad v g e pads -> (forall pads (x : var) (r0 : result), g $? x = Some pads -> ec $? x = Some r0 -> relate_pads pads r0 (result_shape_nat r0)) -> exists st' h', eval_stmt v st h (lower e reindexer p asn sh) st' h'. Proof. - intros e Hconst sh v ec r. - induct 1; intros ls Hsize p st h reindexer asm + intros e v ec r. + induct 1; intros Hbds ls Hsize p st h reindexer asm sh Henv Hrdx Halloc Hctx pads g Hpad Hrelate. - simpl. eexists. eexists. eapply EvalForBase; eauto. - - simpl in *. invs. pose proof H10. - invert Hpad. pose proof H6 as Hlo. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H6. - pose proof H as HHlo. - eapply eval_Zexpr_Z_eval_Zexpr in H. - eapply H6 in H. invert H. + - simpl in *. invs. eq_eval_Z. + + rename H17 into Hsize. + rename H8 into Hlo. rename H7 into Hhi. + pose proof Hlo as Hlo'. pose proof Hhi as Hhi'. + eapply eval_Zexpr_includes_valuation in Hlo', Hhi'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hlo', Hhi'. rewrite Hlo', Hhi' in *. invs'. + apply eval_Zexpr_Z_eval_Zexpr in Hlo, Hhi. + + invert Hpad. eq_size_of. pose proof Hsize as Hsize'. + cbv [eval_Zexpr_Z_total] in *. cbn [eval_Zexpr_Z] in *. rewrite Hhi, Hlo in *. cases k. - 2: { eapply IHeval_expr1 in H9; eauto. + 2: { eapply IHeval_expr1 in Hsize; eauto. 2: { eapply well_formed_environment_add_valuation; eauto. } - 2: { eapply well_formed_allocation_result_V in Halloc. + 2: { eapply well_formed_allocation_result_V in Halloc. invert Halloc. - eapply well_formed_reindexer_eval0. - 8: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - apply H8. } - all: eauto. apply Henv. + eapply well_formed_reindexer_eval0 with (hi := hi) (lo := lo); eauto. + apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. eapply HHlo. - eapply H0. lia. eassumption. eauto. eauto. eauto. } - simpl. invert H6. rewrite H12. propositional. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. eapply Hlo'. + eapply Hhi'. lia. eassumption. eauto. eauto. eauto. } + simpl. eauto 9. + eauto. unfold not. intros. apply H3. eapply shape_to_vars_contains_substring. eauto. simpl length. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } - rewrite H5. lia. apply H. lia. apply Hrdx. } + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } + rewrite H5. lia. apply H. apply Hrdx. } 2: { pose proof Halloc. eapply well_formed_allocation_result_V in H. invs. eapply well_formed_allocation_eval_step. eauto. eauto. eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. eapply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. eapply Hlo'. eapply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. + eauto. eauto. eauto. eauto. eauto. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } rewrite H5. lia. eapply Hrdx. eapply Hrdx. } - 2: { eapply H26. lia. lia. } - invs. - pose proof H9 as Hfirst. - eapply lower_correct_weak in H9. + 2: { eapply H19; lia. } + invs'. + pose proof H0 as Hfirst. + eapply lower_correct_weak in H0. 2: { eauto. } 2: { eauto. } 2: { eauto. } @@ -259,173 +231,105 @@ Proof. 2: { eapply well_formed_allocation_result_V in Halloc. invs. eapply well_formed_reindexer_eval0; eauto. apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. unfold not. intros. eapply H3. eapply shape_to_vars_contains_substring; eauto. simpl. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } rewrite H5. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. apply Hrdx. + apply Hrdx. } 2: { pose proof Halloc. - eapply well_formed_allocation_result_V in H. invs. + eapply well_formed_allocation_result_V in H. invs'. eapply well_formed_allocation_eval_step; eauto. eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. eapply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } rewrite H5. lia. apply Hrdx. apply Hrdx. } 2: { eauto. } - 2: { eapply H26. lia. lia. } + 2: { eapply H19; lia. } 2: { eauto. } cases (reindexer - (((! i ! - lo)%z, (hi - lo)%z) - :: shape_to_index (result_shape_Z r) - (shape_to_vars (result_shape_Z r)))). + (((! i ! - lo)%z, (hi - lo)%z) + :: shape_to_index (result_shape_Z r) (shape_to_vars (result_shape_Z r)))). { eapply reindexer_not_empty_vars_in_index in Heq. invert Heq. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H11. invs. - rewrite constant_app_no_dups in H. - eapply cup_empty in H. invs. - eapply constant_not_empty in H11. propositional. inversion 1. } + simpl. intro. cups_empty. } pose proof Halloc. eapply well_formed_allocation_result_V in H. invs. - assert (vars_of_Zexpr lo ++/ [] = [] /\ - vars_of_Zexpr hi = [] /\ - (0 <= eval_Zexpr_Z_total $0 hi - - eval_Zexpr_Z_total $0 (lo + | 1 |)%z)%Z /\ - constant_nonneg_bounds body). - { erewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - rewrite H8. - invert H6. rewrite H12. sets. } - eapply IHeval_expr2 with (reindexer:= - fun l => - (shift_top_dim_reindexer reindexer l)) - in H9. - 2: { eauto. } + eassert (size_of _ _ _) as Hsize1. + 2: eapply IHeval_expr2 with (reindexer:= + fun l => + (shift_top_dim_reindexer reindexer l)) + in Hsize1. + { econstructor; eauto. } + 2: { split; eauto. do 2 eexists. split; [|split]; eauto. lia. } 3: { pose proof Halloc as Halloc2. - eapply well_formed_allocation_result_V in Halloc. invs. + eapply well_formed_allocation_result_V in Halloc. eapply well_formed_reindexer_shift_top_dim_reindexer with (lo:=lo) (hi:=hi). eauto. apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. eauto. eauto. eauto. - lia. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. eauto. + all: eauto. erewrite result_has_shape_length. - 2: { eapply - constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in H5. - 2: { simpl. propositional. } - 2: { eauto. } - simpl in H5. eauto. } - erewrite eval_Zexpr_Z_total_sub_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; - eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - simpl. eauto. } - f_equal. f_equal. - rewrite eval_Zexpr_Z_total_add_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - simpl. eauto. } - 2: eauto. - unfold eval_Zexpr_Z_total at 2. eauto. apply Hrdx. - } + 2: { eapply size_of_eval_expr_result_has_shape in H5. + 3: { econstructor; eauto. } + eassumption. + simpl. split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + lia. apply Hrdx. } 3: { eapply well_formed_allocation_shift_top_dim_reindexer. - eauto. eauto. apply Hrdx. apply Henv. apply Hrdx. + eauto. eauto. apply Hrdx. apply Henv. eauto. apply Hrdx. apply Hrdx. apply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. apply Hrdx. } 2: { eapply well_formed_environment_add_heap. eauto. eauto. } 2: { eapply contexts_agree_add_heap; try apply Henv; eauto. } 2: { eapply HasPadGen with (k:=k) (c:=c) (ll:=ll) (rr:=rr). - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. eauto. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. intros. - eapply H23. lia. - eapply H25. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. intros. - apply H26. lia. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - lia. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo. + intros. apply H16; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhi. + intros. apply H18; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H19; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. lia. } 2: { eauto. } 2: apply Hrdx. - invs. + invs'. eexists. eexists. eapply EvalForStep. - eapply eval_Zexpr_Z_eval_Zexpr. apply H6. econstructor. eauto. + eassumption. eassumption. lia. pose proof Hfirst. eapply Hfirst. unfold shift_top_dim_reindexer in *. unfold lookup_total. rewrite H. eapply eq_eval_stmt_for. eassumption. - simpl. rewrite HHlo. reflexivity. + simpl. rewrite Hlo'. reflexivity. eassumption. intros. eapply eq_eval_stmt_lower_eq_reindexers. eassumption. @@ -438,244 +342,159 @@ Proof. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. split. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_sub_distr. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. eapply eq_Z_tuple_index_list_id. } simpl Z.of_nat in *. rewrite Z.sub_0_r in *. cases ll. - 2: { eapply IHeval_expr1 in H9; eauto. + 2: { eapply IHeval_expr1 in Hsize'; eauto. 2: { eapply well_formed_environment_add_valuation; eauto. } 2: { pose proof Halloc as Halloc2. - eapply well_formed_allocation_result_V in Halloc2. invs. - eapply well_formed_reindexer_eval0. - 8: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - apply H8. } - all: eauto. apply Henv. + eapply well_formed_allocation_result_V in Halloc2. invs'. + eapply well_formed_reindexer_eval0 with (lo:=lo) (hi:= hi); eauto. + apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. eapply HHlo. - eapply H0. lia. eassumption. eauto. eauto. eauto. } - simpl. invert H6. rewrite H13. propositional. eauto. - unfold not. intros. apply H3. - eapply shape_to_vars_contains_substring. eauto. - simpl length. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. + unfold not. intros. eapply H3. + eapply shape_to_vars_contains_substring; eauto. + simpl. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } - rewrite H5. lia. lia. apply Hrdx. } + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } + rewrite H5. lia. + apply Hrdx. } 2: { pose proof Halloc. - eapply well_formed_allocation_result_V in H. invs. + eapply well_formed_allocation_result_V in H. invs'. eapply well_formed_allocation_eval_step. eauto. eauto. eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. eapply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. + all: eauto. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } rewrite H5. lia. eapply Hrdx. eapply Hrdx. } - 2: { eapply H23. lia. } - invs. - pose proof H9 as Hfirst. - eapply lower_correct_weak in H9. + 2: { apply H16; lia. } + invs'. + pose proof H0 as Hfirst. + eapply lower_correct_weak in H0. 2: { eauto. } 2: { eauto. } 2: { eauto. } 2: { eapply well_formed_environment_add_valuation; eauto. } 2: { pose proof Halloc as Halloc2. - eapply well_formed_allocation_result_V in Halloc2. invs. + eapply well_formed_allocation_result_V in Halloc2. invs'. eapply well_formed_reindexer_eval0; eauto. apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. unfold not. intros. eapply H3. eapply shape_to_vars_contains_substring; eauto. simpl. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } rewrite H5. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. apply Hrdx. + apply Hrdx. } 2: { pose proof Halloc. - eapply well_formed_allocation_result_V in H. invs. + eapply well_formed_allocation_result_V in H. invs'. eapply well_formed_allocation_eval_step; eauto. eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. eapply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } + 2: { simpl. rewrite Hlo', Hhi'. reflexivity. } rewrite H5. lia. apply Hrdx. apply Hrdx. } 2: { eauto. } - 2: { eapply H23. lia. } + 2: { apply H16. lia. } 2: { eauto. } cases (reindexer (((! i ! - lo)%z, (hi - lo)%z) - :: shape_to_index (result_shape_Z r) - (shape_to_vars (result_shape_Z r)))). + :: shape_to_index (result_shape_Z r) (shape_to_vars (result_shape_Z r)))). { eapply reindexer_not_empty_vars_in_index in Heq. invert Heq. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H11. invs. - rewrite constant_app_no_dups in H. - eapply cup_empty in H. invs. - eapply constant_not_empty in H11. propositional. inversion 1. } + simpl. intro. cups_empty. } pose proof Halloc. eapply well_formed_allocation_result_V in H. - invs. - assert (vars_of_Zexpr lo ++/ [] = [] /\ - vars_of_Zexpr hi = [] /\ - (0 <= eval_Zexpr_Z_total $0 hi - - eval_Zexpr_Z_total $0 (lo + | 1 |)%z)%Z /\ - constant_nonneg_bounds body). - { erewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - rewrite H8. - invert H6. rewrite H12. sets. } - eapply IHeval_expr2 with (reindexer:= - fun l => - (shift_top_dim_reindexer reindexer l)) - in H9. - 2: { eauto. } + invs'. + eassert (size_of _ _ _) as Hsize1. + 2: eapply IHeval_expr2 with (reindexer:= + fun l => + (shift_top_dim_reindexer reindexer l)) + in Hsize1. + { econstructor; eauto. } + 2: { split; eauto. do 2 eexists. split; [|split]; eauto. lia. } 3: { pose proof Halloc as Halloc2. eapply well_formed_allocation_result_V in Halloc2. invs. eapply well_formed_reindexer_shift_top_dim_reindexer with (lo:=lo) (hi:=hi). eauto. apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. eauto. eauto. eauto. - eauto. lia. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eauto. erewrite result_has_shape_length. - 2: { eapply - constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in H5. - 2: { simpl. propositional. } - 2: { eauto. } - simpl in H5. eauto. } - rewrite eval_Zexpr_Z_total_sub_distr. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - apply Hrdx. - } + all: eauto. + erewrite result_has_shape_length. + 2: { eapply size_of_eval_expr_result_has_shape in H5; eauto. + simpl. split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + lia. + apply Hrdx. } 3: { eapply well_formed_allocation_shift_top_dim_reindexer. - eauto. eauto. apply Hrdx. apply Henv. apply Hrdx. + eauto. eauto. apply Hrdx. apply Henv. auto. apply Hrdx. apply Hrdx. apply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. apply Hrdx. } 2: { eapply well_formed_environment_add_heap. eauto. eauto. } 2: { eapply contexts_agree_add_heap; try apply Henv; eauto. } 2: { eapply HasPadGen with (k:=0) (c:=c) (ll:=ll) (rr:=rr). - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. eauto. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. intros. - eapply H23. lia. - eapply H25. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. intros. - apply H26. lia. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - lia. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo. + intros. apply H16; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhi. + intros. apply H18; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H19; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. lia. } 2: { eauto. } 2: { apply Hrdx. } - invs. + invs'. eexists. eexists. - eapply EvalForStep. - eapply eval_Zexpr_Z_eval_Zexpr. apply H6. econstructor. eauto. - lia. - pose proof Hfirst. + eapply EvalForStep. eassumption. eassumption. lia. eapply Hfirst. unfold shift_top_dim_reindexer in *. unfold lookup_total. rewrite H. eapply eq_eval_stmt_for. eassumption. - simpl. rewrite HHlo. reflexivity. + simpl. rewrite Hlo'. reflexivity. eassumption. intros. eapply eq_eval_stmt_lower_eq_reindexers. eassumption. @@ -688,243 +507,159 @@ Proof. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. split. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_sub_distr. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. eapply eq_Z_tuple_index_list_id. } - simpl in *. cases rr. - 2: { eapply IHeval_expr1 in H9; eauto. + 2: { eapply IHeval_expr1 in Hsize'; eauto. 2: { eapply well_formed_environment_add_valuation; eauto. } 2: { pose proof Halloc as Halloc2. - eapply well_formed_allocation_result_V in Halloc2. invs. - eapply well_formed_reindexer_eval0. - 8: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - apply H8. } - all: eauto. apply Henv. + eapply well_formed_allocation_result_V in Halloc2. invs'. + eapply well_formed_reindexer_eval0 with (lo:=lo) (hi:=hi); eauto. + apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. eapply HHlo. - eapply H0. lia. eassumption. eauto. eauto. eauto. } - simpl. invert H6. rewrite H13. propositional. eauto. - unfold not. intros. apply H3. - eapply shape_to_vars_contains_substring. eauto. - simpl length. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. + unfold not. intros. eapply H3. + eapply shape_to_vars_contains_substring; eauto. + simpl. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } - rewrite H5. lia. lia. apply Hrdx. } + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } + rewrite H5. lia. + apply Hrdx. } 2: { pose proof Halloc. eapply well_formed_allocation_result_V in H. invs. eapply well_formed_allocation_eval_step. eauto. eauto. eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. eapply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. + all: eauto. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } - rewrite H5. lia. - eapply Hrdx. eapply Hrdx. - } - 2: { eapply H25. lia. } - invs. - pose proof H9 as Hfirst. - eapply lower_correct_weak in H9. + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } + apply H5. + eapply Hrdx. eapply Hrdx. } + 2: { apply H18. lia. } + invs'. + pose proof H0 as Hfirst. + eapply lower_correct_weak in H0. 2: { eauto. } 2: { eauto. } 2: { eauto. } 2: { eapply well_formed_environment_add_valuation; eauto. } 2: { pose proof Halloc as Halloc2. eapply well_formed_allocation_result_V in Halloc2. invs. - eapply well_formed_reindexer_eval0; eauto. apply Henv. + eapply well_formed_reindexer_eval0 with (lo:=lo) (hi:=hi); eauto. + apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. unfold not. intros. eapply H3. eapply shape_to_vars_contains_substring; eauto. simpl. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } rewrite H5. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. apply Hrdx. - } + apply Hrdx. } 2: { pose proof Halloc. - eapply well_formed_allocation_result_V in H. invs. + eapply well_formed_allocation_result_V in H. invs'. eapply well_formed_allocation_eval_step; eauto. eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. eapply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - lia. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } + 2: { simpl. rewrite Hlo', Hhi'. reflexivity. } rewrite H5. lia. apply Hrdx. apply Hrdx. } 2: { eauto. } - 2: { eapply H25. lia. } + 2: { apply H18. lia. } 2: { eauto. } cases (reindexer - (((! i ! - lo)%z, (hi - lo)%z) - :: shape_to_index (result_shape_Z r) - (shape_to_vars (result_shape_Z r)))). + (((! i ! - lo)%z, (hi - lo)%z) + :: shape_to_index (result_shape_Z r) (shape_to_vars (result_shape_Z r)))). { eapply reindexer_not_empty_vars_in_index in Heq. invert Heq. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H11. invs. - rewrite constant_app_no_dups in H. - eapply cup_empty in H. invs. - eapply constant_not_empty in H11. propositional. inversion 1. } + simpl. intro. cups_empty. } pose proof Halloc. eapply well_formed_allocation_result_V in H. - invs. - assert (vars_of_Zexpr lo ++/ [] = [] /\ - vars_of_Zexpr hi = [] /\ - (0 <= eval_Zexpr_Z_total $0 hi - - eval_Zexpr_Z_total $0 (lo + | 1 |)%z)%Z /\ - constant_nonneg_bounds body). - { erewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - rewrite H8. - invert H6. rewrite H12. sets. } - eapply IHeval_expr2 with (reindexer:= - fun l => - (shift_top_dim_reindexer reindexer l)) - in H9. - 2: { eauto. } + invs'. + eassert (size_of _ _ _) as Hsize1. + 2: eapply IHeval_expr2 with (reindexer:= + fun l => + (shift_top_dim_reindexer reindexer l)) + in Hsize1. + { econstructor; eauto. } + 2: { split; eauto. do 2 eexists. split; [|split]; eauto. lia. } 3: { pose proof Halloc as Halloc2. eapply well_formed_allocation_result_V in Halloc2. invs. eapply well_formed_reindexer_shift_top_dim_reindexer with (lo:=lo) (hi:=hi). eauto. apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. eauto. eauto. eauto. lia. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eauto. erewrite result_has_shape_length. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H5. - 2: { simpl. propositional. } - 2: { eauto. } - simpl in *. eauto. } - erewrite eval_Zexpr_Z_total_sub_distr. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. + all: eauto. + erewrite result_has_shape_length. + 2: { eapply size_of_eval_expr_result_has_shape in H5; eauto. + simpl. split; eauto. do 2 eexists. split; [|split]; eauto. lia. } lia. - eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. apply Hrdx. } 3: { eapply well_formed_allocation_shift_top_dim_reindexer. - eauto. eauto. apply Hrdx. apply Henv. apply Hrdx. + eauto. eauto. apply Hrdx. apply Henv. auto. apply Hrdx. apply Hrdx. apply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. apply Hrdx. } 2: { eapply well_formed_environment_add_heap. eauto. eauto. } 2: { eapply contexts_agree_add_heap; try apply Henv; eauto. } 2: { eapply HasPadGen with (k:=0) (c:=c) (ll:=0) (rr:=rr). - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. eauto. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. intros. - eapply H23. lia. - intros. eapply H25. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. intros. - apply H26. lia. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - lia. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo. + intros. apply H16; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhi. + intros. apply H18; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H19; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. lia. } 2: { eauto. } 2: apply Hrdx. - invs. + invs'. eexists. eexists. - eapply EvalForStep. - eapply eval_Zexpr_Z_eval_Zexpr. apply H6. econstructor. eauto. - lia. + eapply EvalForStep. eassumption. eassumption. lia. pose proof Hfirst. eapply Hfirst. unfold shift_top_dim_reindexer in *. unfold lookup_total. rewrite H. eapply eq_eval_stmt_for. eassumption. - simpl. rewrite HHlo. reflexivity. + simpl. rewrite Hlo'. reflexivity. eassumption. intros. eapply eq_eval_stmt_lower_eq_reindexers. eassumption. @@ -937,296 +672,156 @@ Proof. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. split. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_sub_distr. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. + eapply eq_Z_tuple_index_list_id. } + eapply IHeval_expr1 with (asn:=asm) in Hsize'; eauto. + 2: { eapply well_formed_environment_add_valuation; eauto. } + 2: { pose proof Halloc as Halloc2. + eapply well_formed_allocation_result_V in Halloc2. invs. + eapply well_formed_reindexer_eval0 with (lo:=lo) (hi:=hi); eauto. + apply Henv. + eapply result_has_shape_self. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. eauto. - eapply eq_Z_tuple_index_list_id. - } - eapply IHeval_expr1 with (asn:=asm) in H9; eauto. + unfold not. intros. eapply H3. + eapply shape_to_vars_contains_substring; eauto. + simpl. + eapply length_eval_expr_gen in H5. + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } + rewrite H5. lia. + apply Hrdx. } + 2: { pose proof Halloc. + eapply well_formed_allocation_result_V in H. invs'. + eapply well_formed_allocation_eval_step; eauto. + eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. + eapply Hrdx. + eapply result_has_shape_self. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. + eapply length_eval_expr_gen in H5. + 2: { simpl. rewrite Hlo', Hhi'. reflexivity. } + rewrite H5. lia. + apply Hrdx. apply Hrdx. } + 2: { apply H19; lia. } + invs'. + pose proof H0 as Hfirst. + eapply lower_correct_weak in H0. + 2: { eauto. } + 2: { eauto. } + 2: { eauto. } 2: { eapply well_formed_environment_add_valuation; eauto. } 2: { pose proof Halloc as Halloc2. eapply well_formed_allocation_result_V in Halloc2. invs. - eapply well_formed_reindexer_eval0. - 8: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - apply H8. } - all: eauto. apply Henv. + eapply well_formed_reindexer_eval0; eauto. apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. eapply HHlo. - eapply H0. lia. eassumption. eauto. eauto. eauto. } - simpl. invert H6. rewrite H13. propositional. eauto. - unfold not. intros. apply H3. - eapply shape_to_vars_contains_substring. eauto. - simpl length. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. + unfold not. intros. eapply H3. + eapply shape_to_vars_contains_substring; eauto. + simpl. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } - rewrite H5. eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply H8 in H0. invert H0. - lia. - pose proof H8. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H. invert H. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H13 in H0. invert H0. lia. - apply Hrdx. - } - 2: { pose proof Halloc. - eapply well_formed_allocation_result_V in H. invs. - eapply well_formed_allocation_eval_step. eauto. eauto. - eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. eapply Hrdx. - eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply H8 in H0. invert H0. - lia. - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } - rewrite H5. lia. - eapply Hrdx. eapply Hrdx. - } - 2: { eapply H26. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply H8 in H0. invert H0. - lia. lia. } - invs. - pose proof H9 as Hfirst. - eapply lower_correct_weak in H9. - 2: { eauto. } - 2: { eauto. } - 2: { eauto. } - 2: { eapply well_formed_environment_add_valuation; eauto. } - 2: { pose proof Halloc as Halloc2. - eapply well_formed_allocation_result_V in Halloc2. invs. - eapply well_formed_reindexer_eval0; eauto. apply Henv. - eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. - unfold not. intros. eapply H3. - eapply shape_to_vars_contains_substring; eauto. - simpl. - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } - rewrite H5. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply H8 in H0. invert H0. - lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - pose proof H8. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H. invert H. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H13 in H0. invert H0. lia. + 2: { simpl. rewrite Hhi', Hlo'. reflexivity. } + rewrite H5. lia. apply Hrdx. } - 2: { pose proof Halloc. - eapply well_formed_allocation_result_V in H. invs. - eapply well_formed_allocation_eval_step; eauto. - eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. - eapply Hrdx. - eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply H8 in H0. invert H0. - lia. - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. - rewrite HHlo. reflexivity. } - rewrite H5. lia. - apply Hrdx. apply Hrdx. } - 2: { eauto. } - 2: { eapply H26. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply H8 in H0. invert H0. - lia. lia. } - 2: { eauto. } - cases (reindexer - (((! i ! - lo)%z, (hi - lo)%z) - :: shape_to_index (result_shape_Z r) - (shape_to_vars (result_shape_Z r)))). + 2: { pose proof Halloc. + eapply well_formed_allocation_result_V in H. invs'. + eapply well_formed_allocation_eval_step; eauto. + eapply Hrdx. eapply Henv. eapply Hrdx. eapply Hrdx. + eapply Hrdx. + eapply result_has_shape_self. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. + eapply length_eval_expr_gen in H5. + 2: { simpl. rewrite Hlo', Hhi'. reflexivity. } + rewrite H5. lia. + apply Hrdx. apply Hrdx. } + 2: { eauto. } + 2: { apply H19; lia. } + 2: { eauto. } + cases (reindexer + (((! i ! - lo)%z, (hi - lo)%z) + :: shape_to_index (result_shape_Z r) (shape_to_vars (result_shape_Z r)))). { eapply reindexer_not_empty_vars_in_index in Heq. invert Heq. apply Hrdx. - simpl. unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H11. invs. - rewrite constant_app_no_dups in H. - eapply cup_empty in H. invs. - eapply constant_not_empty in H11. propositional. inversion 1. } + simpl. intro. cups_empty. } pose proof Halloc. eapply well_formed_allocation_result_V in H. invs. - assert (vars_of_Zexpr lo ++/ [] = [] /\ - vars_of_Zexpr hi = [] /\ - (0 <= eval_Zexpr_Z_total $0 hi - - eval_Zexpr_Z_total $0 (lo + | 1 |)%z)%Z /\ - constant_nonneg_bounds body). - { erewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - rewrite H8. - invert H6. rewrite H12. sets. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply H8 in H0. invert H0. lia. - } - eapply IHeval_expr2 with (reindexer:= - fun l => - (shift_top_dim_reindexer reindexer l)) - (asn:=asm) - in H9. - 2: { eauto. } + eassert (size_of _ _ _) as Hsize1. + 2: eapply IHeval_expr2 with (reindexer:= + fun l => + (shift_top_dim_reindexer reindexer l)) + in Hsize1. + { econstructor; eauto. } + 2: { split; eauto. do 2 eexists. split; [|split]; eauto. lia. } 3: { pose proof Halloc as Halloc2. eapply well_formed_allocation_result_V in Halloc2. invs. - eapply well_formed_reindexer_shift_top_dim_reindexer - with (lo:=lo) (hi:=hi). + eapply well_formed_reindexer_shift_top_dim_reindexer with + (lo:=lo) (hi:=hi). eauto. apply Henv. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. eauto. eauto. eauto. - pose proof H8. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H14. invert H14. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H24 in H0. invert H0. lia. - eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. eauto. + all: eauto. erewrite result_has_shape_length. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H5; eauto. - simpl. propositional. simpl in *. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H5; eauto. - simpl map in H5. - erewrite eval_Zexpr_Z_total_sub_distr in H5. - erewrite eval_Zexpr_Z_total_add_distr in H5. - unfold eval_Zexpr_Z_total in H5 at 3. simpl in H5. eauto. - eauto. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - simpl. propositional. apply Hrdx. - } + 2: { eapply size_of_eval_expr_result_has_shape in H5; eauto. + simpl. split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + lia. + apply Hrdx. } 3: { eapply well_formed_allocation_shift_top_dim_reindexer. - eauto. eauto. apply Hrdx. apply Henv. apply Hrdx. + eauto. eauto. apply Hrdx. apply Henv. auto. apply Hrdx. apply Hrdx. apply Hrdx. eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: { eapply EvalGenStep. - eapply HHlo. eapply H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H8 in H0. invert H0. lia. - eauto. eauto. eauto. eauto. } - econstructor; eauto. eauto. + eapply size_of_eval_expr_result_has_shape. + { eapply EvalGenStep. apply Hlo'. apply Hhi'. all: eauto. } + simpl. eauto 9. + eauto. apply Hrdx. } 2: { eapply well_formed_environment_add_heap. eauto. eauto. } 2: { eapply contexts_agree_add_heap; try apply Henv; eauto. } 2: { eapply HasPadGen with (k:=0) (c:=c-1) (ll:=0) (rr:=0). - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H8. - eapply H8 in H0. invert H0. - lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. lia. eauto. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. intros. - eapply H23. lia. - intros. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. intros. - apply H26. lia. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - lia. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo. + intros. apply H16; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhi. + intros. apply H18; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H19; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. lia. } 2: { eauto. } 2: apply Hrdx. - invs. + invs'. eexists. eexists. - eapply EvalForStep. - eapply eval_Zexpr_Z_eval_Zexpr. apply H6. econstructor. eauto. - lia. + eapply EvalForStep. eassumption. eassumption. lia. pose proof Hfirst. eapply Hfirst. unfold shift_top_dim_reindexer in *. unfold lookup_total. rewrite H. eapply eq_eval_stmt_for. eassumption. - simpl. rewrite HHlo. reflexivity. + simpl. rewrite Hlo'. reflexivity. eassumption. intros. eapply eq_eval_stmt_lower_eq_reindexers. eassumption. @@ -1239,40 +834,37 @@ Proof. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. split. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub_sub_distr. eapply eq_zexpr_transitivity. eapply eq_zexpr_sub. eapply eq_zexpr_id. auto. - eapply eq_zexpr_add_sub_id. - eauto. + apply eq_zexpr_add_sub_id. + apply eq_zexpr_id. reflexivity. eapply eq_Z_tuple_index_list_id. - (* STEPPING SUM *) - simpl. - pose proof Hconst as Hcont'. - simpl in Hcont'. invs. - pose proof H7 as Hlo. - pose proof H9 as Hhi. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total with (v:=$0) in - Hlo, Hhi. + simpl in *. pose proof Hsize as Hsize0. invert Hsize. + + rename H12 into Hsize. pose proof Hsize as Hsize'. + rename H into Hlo. rename H0 into Hhi. + invert Hpad. - { eapply eval_Zexpr_Z_eval_Zexpr in H,H0. - eapply Hlo in H. eapply Hhi in H0. invert H. invert H0. lia. } - pose proof Hconst as Hsh. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in Hsh. - 2: { eauto. } - 2: { eapply EvalSumStep. eauto. eauto. lia. eauto. eauto. eauto. eauto. - eauto. } - pose proof H10 as HI1. - eapply IHeval_expr1 with (asn:=Reduce) in HI1; eauto. + { cbv [eval_Zexpr_Z_total] in *. cbn [eval_Zexpr_Z] in *. rewrite Hhi, Hlo in *. + lia. } + cbv [eval_Zexpr_Z_total] in *. cbn [eval_Zexpr_Z] in *. rewrite Hhi, Hlo in *. + eapply size_of_includes in Hsize0. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize0. + 2: { eapply EvalSumStep; eauto. } + 2: { simpl. eauto. } + eapply IHeval_expr1 with (asn:=Reduce) in Hsize'; eauto. 2: { simpl in Henv. eapply well_formed_environment_add_valuation. eauto. sets. eauto. } 2: { pose proof H6. - eapply result_has_shape_add_result_result in H6; eauto. + eapply result_has_shape_add_result_result in H6; eauto. eapply well_formed_reindexer_add_valuation; eauto. decomp_well_formed_reindexer. propositional. @@ -1285,14 +877,13 @@ Proof. eauto; try apply Hrdx. eapply well_formed_allocation_add_result_l; eauto. eapply result_has_shape_add_result_result in H6; eauto. - propositional. + propositional. eapply result_has_shape_add_result_result in H6; eauto. propositional. } 2: eauto. - invs. - - pose proof H11 as Heval1. - eapply lower_correct_weak with (asn:=Reduce) in H11. + invs'. + pose proof H0 as Heval1. + eapply lower_correct_weak with (asn:=Reduce) in H0. 2: { eauto. } 2: { eauto. } 2: { eauto. } @@ -1300,44 +891,39 @@ Proof. 2: { eapply well_formed_reindexer_add_valuation; eauto. decomp_well_formed_reindexer. propositional. - pose proof Hsh. + pose proof Hsize0 as Hsh. eapply result_has_shape_add_result_result in Hsh. 2: { eauto. } - invs. + invs'. eapply partial_injective_add_result_l. 4: eauto. eauto. eauto. eauto. eauto. eapply nondestructivity_reduce. - apply Henv. + apply Henv. eapply result_has_shape_self; eauto. eapply result_has_shape_add_result_result in H6; eauto. - eapply H6. + eapply H6. } 2: { eapply well_formed_allocation_add_valuation; eauto. - pose proof Hsh. + pose proof Hsize0 as Hsh. eapply result_has_shape_add_result_result in Hsh. 2: { eauto. } - invs. + invs. eapply well_formed_allocation_add_result_l; eauto. eapply result_has_shape_add_result_result in H6; eauto. propositional. eapply Hrdx. propositional. apply Hrdx. } 2: eauto. - 2: { eapply H19. eapply eval_Zexpr_Z_eval_Zexpr in H. - eapply Hlo in H. invert H. lia. } + 2: { apply H12; lia. } 2: eauto. - 2: { eapply H19. eapply eval_Zexpr_Z_eval_Zexpr in H. - eapply Hlo in H. invert H. lia. } - - assert (constant_nonneg_bounds (Sum i (lo + | 1 |)%z hi body)). - { econstructor. simpl. rewrite H7. sets. propositional. } + 2: { apply H12; lia. } cases (reindexer (shape_to_index (result_shape_Z r) (shape_to_vars (result_shape_Z r)))). - { assert (loz + 1 < hiz \/ loz + 1 = hiz)%Z by lia. invert H12. + { assert (loz + 1 < hiz \/ loz + 1 = hiz)%Z as [H|H] by lia. { unfold result_shape_Z in *. simpl in *. - pose proof Halloc. - unfold well_formed_allocation in H12. - unfold result_shape_Z in H12. + pose proof Halloc as Halloc'. + unfold well_formed_allocation in Halloc'. + unfold result_shape_Z in Halloc'. replace (result_shape_nat s) with (result_shape_nat r) in *. 2: { eapply result_has_shape_add_result_result in H6. 2: { eauto. } @@ -1345,50 +931,46 @@ Proof. erewrite result_has_shape_result_shape_nat by eauto. symmetry. erewrite result_has_shape_result_shape_nat by eauto. symmetry. auto. } - rewrite Heq in H12. invert H12. rewrite H14 in *. - eapply IHeval_expr2 with (asn:=Reduce) (st:= x) (h:=x0) in H8; - invert H11. - 2: { econstructor; eauto. } - 2: eauto. + invs'. + rewrite Heq in Halloc'. invs'. rewrite H0 in *. + eassert (size_of _ _ _) as Hsize1. + 2: eapply IHeval_expr2 with (asn:=Reduce) in Hsize1. + { eauto. } + 2: { eauto. } 2: { eapply well_formed_environment_add_stack. eauto. eapply lookup_Some_dom. eauto. } 2: { decomp_well_formed_reindexer. clear IHeval_expr1. propositional. - pose proof H6. eapply result_has_shape_add_result_result in H22. - 2: { eauto. } invert H22. + pose proof H6 as H8. eapply result_has_shape_add_result_result in H8. + 2: { eauto. } invs'. eapply partial_injective_add_result_r. 4: eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. - eapply nondestructivity_reduce. - } + eapply nondestructivity_reduce. } 2: { eapply well_formed_allocation_same_add_stack. eapply well_formed_allocation_add_result_r; eauto. eapply result_has_shape_add_result_result in H6; eauto. - propositional. + propositional. eapply result_has_shape_add_result_result in H6; eauto. propositional. } 2: { eapply contexts_agree_add_in_stack. eauto. eauto. apply Henv. apply Henv. } 2: { eapply HasPadSum. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. simpl. intros. - eapply H19. lia. eauto. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - eapply eval_Zexpr_Z_eval_Zexpr in H,H0. - eapply Hlo in H. eapply Hhi in H0. invert H. invert H0. lia. - eauto. eauto. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H12; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + lia. } 2: { eauto. } - invs. + invs'. eexists. eexists. eapply EvalForStep. eauto. eauto. lia. eassumption. eapply H8. } { unfold result_shape_Z in *. simpl in *. - pose proof Halloc. - unfold well_formed_allocation in H12. - unfold result_shape_Z in H12. + pose proof Halloc as Halloc'. + unfold well_formed_allocation in Halloc'. + unfold result_shape_Z in Halloc'. replace (result_shape_nat s) with (result_shape_nat r) in *. 2: { eapply result_has_shape_add_result_result in H6. 2: { eauto. } @@ -1396,21 +978,21 @@ Proof. erewrite result_has_shape_result_shape_nat by eauto. symmetry. erewrite result_has_shape_result_shape_nat by eauto. symmetry. auto. } - rewrite Heq in H12. invert H12. rewrite H13 in *. - invs. + rewrite Heq in Halloc'. invs'. rewrite H in *. + invs'. eexists. eexists. eapply EvalForStep. eauto. eauto. lia. eassumption. eapply EvalForBase. - simpl. rewrite H. reflexivity. eassumption. lia. + simpl. rewrite Hlo. reflexivity. eassumption. lia. } } - { assert (loz + 1 < hiz \/ loz + 1 = hiz)%Z by lia. invert H12. + { assert (loz + 1 < hiz \/ loz + 1 = hiz)%Z as [H11|H11] by lia. { unfold result_shape_Z in *. simpl in *. - pose proof Halloc. - unfold well_formed_allocation in H12. - unfold result_shape_Z in H12. + pose proof Halloc as Halloc'. + unfold well_formed_allocation in Halloc'. + unfold result_shape_Z in Halloc'. replace (result_shape_nat s) with (result_shape_nat r) in *. 2: { eapply result_has_shape_add_result_result in H6. 2: { eauto. } @@ -1418,17 +1000,18 @@ Proof. erewrite result_has_shape_result_shape_nat by eauto. symmetry. erewrite result_has_shape_result_shape_nat by eauto. symmetry. auto. } - rewrite Heq in H12. invert H12. invert H14. unfold lookup_total in *. - rewrite H12 in *. - eapply IHeval_expr2 with (asn:=Reduce) (st:= x) (h:=x0) in H8; - invert H11. - 2: { econstructor; eauto. } + rewrite Heq in Halloc'. invs'. unfold lookup_total in *. + rewrite H0 in *. + eassert (size_of _ _ _) as Hsize1. + 2: eapply IHeval_expr2 with (asn:=Reduce) in Hsize1. + { eauto. } + 2: { eauto. } 2: { eapply well_formed_environment_add_heap. eauto. eauto. } 2: { decomp_well_formed_reindexer. clear IHeval_expr1. propositional. - pose proof H6. eapply result_has_shape_add_result_result in H23. - 2: { eauto. } invert H23. + pose proof H6 as H8. eapply result_has_shape_add_result_result in H8. + 2: { eauto. } invs'. eapply partial_injective_add_result_r. 4: eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. @@ -1436,19 +1019,15 @@ Proof. 2: { eapply well_formed_allocation_add_heap; eauto. eapply well_formed_allocation_add_result_r; eauto. eapply result_has_shape_add_result_result in H6; eauto. - propositional. + propositional. eapply result_has_shape_add_result_result in H6; eauto. propositional. } 2: { eapply contexts_agree_add_heap; eauto. apply Henv. apply Henv. } 2: { eapply HasPadSum. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. simpl. intros. - eapply H19. lia. eauto. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - eapply eval_Zexpr_Z_eval_Zexpr in H,H0. - eapply Hlo in H. eapply Hhi in H0. invert H. invert H0. lia. - eauto. eauto. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + intros. apply H12; lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hlo, Hhi. + lia. } 2: { eauto. } invs. eexists. eexists. @@ -1457,9 +1036,9 @@ Proof. eassumption. eapply H8. } { unfold result_shape_Z in *. simpl in *. - pose proof Halloc. - unfold well_formed_allocation in H12. - unfold result_shape_Z in H12. + pose proof Halloc as Halloc'. + unfold well_formed_allocation in Halloc'. + unfold result_shape_Z in Halloc'. replace (result_shape_nat s) with (result_shape_nat r) in *. 2: { eapply result_has_shape_add_result_result in H6. 2: { eauto. } @@ -1467,626 +1046,398 @@ Proof. erewrite result_has_shape_result_shape_nat by eauto. symmetry. erewrite result_has_shape_result_shape_nat by eauto. symmetry. auto. } - rewrite Heq in H12. invert H12. invert H13. unfold lookup_total in *. - rewrite H12 in *. invs. + rewrite Heq in Halloc'. invs'. unfold lookup_total in *. + rewrite H0 in *. eexists. eexists. eapply EvalForStep. eauto. eauto. lia. eassumption. eapply EvalForBase. - simpl. rewrite H. reflexivity. eassumption. lia. + simpl. rewrite Hlo. reflexivity. eassumption. lia. } } - simpl in *. invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H4,H6. - eapply eval_Zexpr_Z_eval_Zexpr in H,H0. - eapply H4 in H. eapply H6 in H0. invert H. invert H0. - invert Hpad. 2: lia. + + rename H into Hlo. rename H0 into Hhi. + + invert Hpad. + 2: { cbv [eval_Zexpr_Z_total] in *. rewrite Hlo, Hhi in *. lia. } eexists. eexists. - eapply EvalForBase. - eapply eval_Zexpr_Z_eval_Zexpr. eapply H4. econstructor. - eapply eval_Zexpr_Z_eval_Zexpr. eapply H6. econstructor. - lia. + eapply EvalForBase; eauto. - eexists. eexists. simpl. eapply EvalIfFalse. eauto. - simpl. invert Hpad. eq_eval_B. discriminate. eapply IHeval_expr in Halloc. invs. eexists. eexists. eapply EvalIfTrue. eapply H2. all: simpl in *; invs; eauto. - - simpl in *. invs. erewrite size_of_sizeof in * by eauto. simpl. - pose proof H1 as Heval1. invert Hpad. eq_size_of. - eapply IHeval_expr1 with (asn:=Assign) (st:= st $+ (x,0%R)) (reindexer:= - fun x => x) in Heval1; - eauto. - 2: { eapply well_formed_environment_alloc_stack. - eassumption. sets. sets. sets. } - 2: { decomp_well_formed_reindexer. - propositional. eapply partial_injective_id_reindexer. apply Henv. - sets. sets. - unfold nondestructivity. rewrite lookup_add_eq. rewrite dom_add. - split; intros. sets. invert H10. eauto. eauto. } - 2: { unfold well_formed_allocation. - unfold shape_to_index. unfold result_shape_Z. simpl. - eexists. rewrite lookup_add_eq by auto. reflexivity. } - 2: { eapply contexts_agree_alloc_stack. eauto. sets. } - invs. pose proof H9. - eapply lower_correct_weak in H8. - 2: { eauto. } - 2: { eauto. } - 2: { eauto. } - 2: { eapply well_formed_environment_alloc_stack. - eassumption. sets. sets. sets. } - 2: { decomp_well_formed_reindexer. - propositional. eapply partial_injective_id_reindexer. apply Henv. - sets. sets. - unfold nondestructivity. rewrite lookup_add_eq. rewrite dom_add. - split; intros. sets. invert H13. eauto. eauto. } - 2: { unfold well_formed_allocation. - unfold shape_to_index. unfold result_shape_Z. simpl. - eexists. rewrite lookup_add_eq by auto. reflexivity. } - 2: { eapply contexts_agree_alloc_stack. eauto. sets. } - 2: { eauto. } - 2: { eauto. } - unfold result_shape_Z in H8. simpl in H8. - invert H8. rewrite add_overwrite in H9. - rewrite lookup_add_eq in H9 by auto. pose proof H7. - eapply IHeval_expr2 with (reindexer:= reindexer) (asn:=asm) in H8. - 2: { eauto. } - 2: { invs. - eapply well_formed_environment_let_bind1_scalar. eauto. - sets. sets. sets. } - 2: { decomp_well_formed_reindexer. - propositional. - unfold nondestructivity. rewrite dom_add. - rewrite lookup_add_ne. - split; intros. eapply Hnondstr; eauto. sets. - eapply Hnondstr; eauto. - invert Henv. sets. } + - cases sz1; simpl in *. + + invs. invert Hpad. eq_size_of. pose proof H16 as Heval1. - 2: { eapply well_formed_allocation_add_stack. eauto. - unfold well_formed_environment in Henv. sets. } - 2: { eapply contexts_agree_let_bind1_scalar. eauto. } - 2: { eauto. } - 2: { intros. cases (x0 =? x). eapply String.eqb_eq in Heq. subst. - repeat rewrite lookup_add_eq in * by auto. invert H11. - simpl. invert H10. - eapply has_pad_gen_pad. eauto. eauto. eauto. econstructor. eauto. - eapply contexts_agree_result_has_shape. eauto. eauto. - eapply String.eqb_neq in Heq. rewrite lookup_add_ne in * by eauto. - eauto. } - invs. - pose proof H8. - eexists. eexists. econstructor. econstructor. - econstructor. eassumption. econstructor. - rewrite Rplus_0_l. eauto. econstructor. - - simpl in *. invs. erewrite size_of_sizeof in * by eauto. - cases esh1. propositional. invert H1. - pose proof H3 as Heval1. invert Hpad. eq_size_of. - eapply IHeval_expr1 with - (h:=(alloc_array_in_heap - [(fold_left mul (map Z.to_nat zs) (Z.to_nat z0))] h x)) - (asn:=Assign) (reindexer:= fun x => x) in Heval1; eauto. - 2: { eapply well_formed_environment_letbind1. - 3: sets. sets. - 2: { eauto. } - sets. } - 2: { decomp_well_formed_reindexer. - propositional. eapply partial_injective_id_reindexer. apply Henv. - eauto. sets. - unfold nondestructivity. unfold alloc_array_in_heap. - rewrite lookup_add_eq by eauto. - rewrite dom_add. split; intros. 2: sets. - invert H11. rewrite add_0_r. - pose proof (lookup_alloc_array - (fold_left mul (map Z.to_nat zs) (Z.to_nat z0)) x0). - invert H11; eauto. - eapply lookup_None_dom in H19. - rewrite dom_alloc_array in H19. - exfalso. apply H19. - erewrite <- In_iff_in in *. clear H19. - unfold tensor_to_array_delta in H17. - unfold tensor_to_array_delta_by_indices in H17. - erewrite partial_dom_fold_left_array_add in H17. - 2: { eapply partial_injective_id_reindexer. apply Henv. } - rewrite dom_empty in H17. rewrite cup_empty_r in H17. - eapply In_iff_in in H17. - eapply in_extract_Some in H17. - eapply in_map_iff in H17. invs. - rewrite filter_idempotent in H19. - decomp_index. - replace (fold_left mul (map Z.to_nat zs) (Z.to_nat z0)) - with (fold_left mul (map Z.to_nat (z0::zs)) 1). - 2: { simpl. rewrite add_0_r. eauto. } - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H19; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H19. - invert H19. - eq_eval_Z. eq_eval_Zlist. - rewrite partial_interpret_reindexer_id_flatten in H17. invert H17. - erewrite result_has_shape_result_shape_Z. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H5; eauto. } - erewrite fold_left_mul_filter_until_0. - erewrite Z_of_nat_fold_left_mul. - rewrite <- map_cons. - eapply in_mesh_grid_flatten_in_range. - eapply Forall_map. eapply Forall_forall. intros. lia. - erewrite result_has_shape_result_shape_Z in H11. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H5; eauto. } - eauto. eauto. apply Henv. - } - 2: { rewrite <- (Nat2Z.id (fold_left _ _ _)). - eapply well_formed_allocation_letbind1. eapply Henv. - unfold well_formed_environment in *. sets. - erewrite result_has_shape_result_shape_Z. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eauto. eauto. eauto. } - eapply constant_nonneg_bounds_size_of_nonneg in Heval1. - 2: { eauto. } - 2: { econstructor. eauto. eauto. } - eapply constant_nonneg_bounds_size_of_no_vars in H3. - 2: { eauto. } - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H3. - invert H3. eq_eval_Z. eq_eval_Zlist. - rewrite <- Z_of_nat_fold_left_mul. f_equal. - simpl. cases (Z.to_nat (eval_Zexpr_Z_total $0 z)). - simpl. replace 0 with (0*0) at 1 by lia. - rewrite fold_left_mul_assoc_nat. lia. - simpl. rewrite add_0_r. rewrite <- Heq. - rewrite <- fold_left_mul_filter_until_0. reflexivity. } - 2: { eapply contexts_agree_alloc_array_in_heap. eauto. eauto. } - invert Heval1. invert H1. pose proof H10. - eapply lower_correct_weak in H1. - 2: { eauto. } - 2: { eauto. } - 2: { eauto. } - 2: { eapply well_formed_environment_letbind1. - 3: sets. sets. - 2: { eauto. } - sets. } - 2: { decomp_well_formed_reindexer. propositional. - eapply partial_injective_id_reindexer. apply Henv. sets. sets. - unfold nondestructivity. unfold alloc_array_in_heap. - rewrite lookup_add_eq by eauto. - rewrite dom_add. split; intros. 2: sets. - invert H15. rewrite add_0_r. - pose proof (lookup_alloc_array - (fold_left mul (map Z.to_nat zs) (Z.to_nat z0)) x2). - invert H15; eauto. - eapply lookup_None_dom in H22. - rewrite dom_alloc_array in H22. - exfalso. apply H22. - erewrite <- In_iff_in in *. clear H22. - unfold tensor_to_array_delta in H20. - unfold tensor_to_array_delta_by_indices in H20. - erewrite partial_dom_fold_left_array_add in H20. - 2: { eapply partial_injective_id_reindexer. apply Henv. } - rewrite dom_empty in H20. rewrite cup_empty_r in H20. - eapply In_iff_in in H20. - eapply in_extract_Some in H20. - eapply in_map_iff in H20. invs. - rewrite filter_idempotent in H22. - decomp_index. - replace (fold_left mul (map Z.to_nat zs) (Z.to_nat z0)) - with (fold_left mul (map Z.to_nat (z0::zs)) 1). - 2: { simpl. rewrite add_0_r. eauto. } - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H22; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H22. - invert H22. - eq_eval_Z. eq_eval_Zlist. - rewrite partial_interpret_reindexer_id_flatten in H20. invert H20. - erewrite result_has_shape_result_shape_Z. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H5; eauto. } - erewrite fold_left_mul_filter_until_0. - erewrite Z_of_nat_fold_left_mul. - rewrite <- map_cons. - eapply in_mesh_grid_flatten_in_range. - eapply Forall_map. eapply Forall_forall. intros. lia. - erewrite result_has_shape_result_shape_Z in H15. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H5; eauto. } - eauto. eauto. apply Henv. } - 2: { rewrite <- (Nat2Z.id (fold_left _ _ _)). - eapply well_formed_allocation_letbind1. eapply Henv. - unfold well_formed_environment in *. -sets. - erewrite result_has_shape_result_shape_Z. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eauto. eauto. eauto. } - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H11. - 2: { eauto. } - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H11. - invert H11. eq_eval_Z. eq_eval_Zlist. - rewrite <- Z_of_nat_fold_left_mul. f_equal. - simpl. cases (Z.to_nat (eval_Zexpr_Z_total $0 z)). - simpl. replace 0 with (0*0) at 1 by lia. - rewrite fold_left_mul_assoc_nat. lia. - simpl. rewrite add_0_r. rewrite <- Heq. - rewrite <- fold_left_mul_filter_until_0. reflexivity. } + assert (result_has_shape l1 []) as Hl1. + { eauto using size_of_eval_expr_result_has_shape. } + invert Hl1. rewr_sizeof. + eapply IHeval_expr1 with (asn:=Assign) (st:= st $+ (x,0%R)) (reindexer:= + fun x => x) in Heval1; + eauto. + 2: { eapply well_formed_environment_alloc_stack. + eassumption. sets. sets. sets. } + 2: { decomp_well_formed_reindexer. + propositional. eapply partial_injective_id_reindexer. apply Henv. + sets. sets. + unfold nondestructivity. rewrite lookup_add_eq. rewrite dom_add. + split; intros. sets. invs'. eauto. eauto. } + 2: { unfold well_formed_allocation. + unfold shape_to_index. unfold result_shape_Z. simpl. + eexists. rewrite lookup_add_eq by auto. reflexivity. } + 2: { eapply contexts_agree_alloc_stack. eauto. sets. } + invs'. pose proof H9 as H10. + eapply lower_correct_weak in H10. + 2: { eauto. } + 2: { eauto. } + 2: { eauto. } + 2: { eapply well_formed_environment_alloc_stack. + eassumption. sets. sets. sets. } + 2: { decomp_well_formed_reindexer. + propositional. eapply partial_injective_id_reindexer. apply Henv. + sets. sets. + unfold nondestructivity. rewrite lookup_add_eq. rewrite dom_add. + split; intros. sets. invs'. eauto. eauto. } + 2: { unfold well_formed_allocation. + unfold shape_to_index. unfold result_shape_Z. simpl. + eexists. rewrite lookup_add_eq by auto. reflexivity. } + 2: { eapply contexts_agree_alloc_stack. eauto. sets. } + 2: { eauto. } + 2: { eauto. } + unfold result_shape_Z in H10. simpl in H10. + invs'. rewrite add_overwrite in H9. + rewrite lookup_add_eq in H9 by auto. pose proof H12 as Heval2. + eapply IHeval_expr2 with (reindexer:= reindexer) (asn:=asm) in Heval2. + 2: { eauto. } + 2: { invs. + eapply well_formed_environment_let_bind1_scalar. eauto. + sets. sets. sets. } + 2: { decomp_well_formed_reindexer. + propositional. + unfold nondestructivity. rewrite dom_add. + rewrite lookup_add_ne. + split; intros. eapply Hnondstr; eauto. sets. + eapply Hnondstr; eauto. + invert Henv. sets. } + + 2: { eapply well_formed_allocation_add_stack. eauto. + unfold well_formed_environment in Henv. sets. } + 2: { eapply contexts_agree_let_bind1_scalar. eauto. } + 2: { eauto. } + 2: { intros. cases (x0 =? x). eapply String.eqb_eq in Heq. subst. + repeat rewrite lookup_add_eq in * by auto. invs'. simpl. + eapply has_pad_gen_pad. eauto. eauto. eauto. econstructor. eauto. + eauto. eauto. + eapply String.eqb_neq in Heq. rewrite lookup_add_ne in * by eauto. + eauto. } + invs'. + pose proof H8. + eexists. eexists. econstructor. econstructor. + econstructor. eassumption. econstructor. + rewrite Rplus_0_l. eauto. econstructor. + + simpl in *. invs. + eassert (result_has_shape l1 _) as Hl1. + { eauto using size_of_eval_expr_result_has_shape. } + destruct l1 as [|l1]; [solve[invert Hl1] |]. + invert Hpad. eq_size_of. pose proof H14 as Heval1. + eapply IHeval_expr1 with + (h:=(alloc_array_in_heap + [(fold_left mul sz1 n)] h x)) + (asn:=Assign) (reindexer:= fun x => x) in Heval1; eauto. + 2: { eapply well_formed_environment_letbind1. + 3: sets. sets. + 2: { eauto. } + sets. } + 2: { decomp_well_formed_reindexer. + propositional. eapply partial_injective_id_reindexer. apply Henv. + eauto. sets. + unfold nondestructivity. unfold alloc_array_in_heap. + rewrite lookup_add_eq by eauto. + rewrite dom_add. split; intros. 2: sets. + invs'. rewrite add_0_r. + epose proof (lookup_alloc_array (fold_left mul sz1 _) _) as [H20|H20]. + 2: eassumption. + eapply lookup_None_dom in H20. + rewrite dom_alloc_array in H20. + exfalso. apply H20. + erewrite <- In_iff_in in *. clear H20. + unfold tensor_to_array_delta in H13. + unfold tensor_to_array_delta_by_indices in H13. + erewrite partial_dom_fold_left_array_add in H13. + 2: { eapply partial_injective_id_reindexer. apply Henv. } + rewrite dom_empty in H13. rewrite cup_empty_r in H13. + eapply In_iff_in in H13. + eapply in_extract_Some in H13. + eapply in_map_iff in H13. invs'. + rewrite filter_idempotent in H15. + decomp_index. + replace (fold_left mul sz1 n) with (fold_left mul (n :: sz1) 1). + 2: { simpl. rewrite add_0_r. reflexivity. } + rewrite partial_interpret_reindexer_id_flatten in H13. invert H13. + erewrite result_has_shape_result_shape_Z. + 2: { eapply size_of_eval_expr_result_has_shape in H4; eauto. } + erewrite <- fold_left_mul_filter_until. + erewrite Z_of_nat_fold_left_mul. + eapply in_mesh_grid_flatten_in_range. + eapply Forall_map. eapply Forall_forall. intros. lia. + erewrite result_has_shape_result_shape_Z in H9. + 2: { eapply size_of_eval_expr_result_has_shape in H4; eauto. } + eauto. eauto. apply Henv. } + 2: { rewrite <- (Nat2Z.id (fold_left _ _ _)). + eapply well_formed_allocation_letbind1. eapply Henv. + unfold well_formed_environment in *. invs'. sets. + erewrite result_has_shape_result_shape_Z. + 2: { eapply size_of_eval_expr_result_has_shape; eauto. } + replace 1%Z with (Z.of_nat 1) by reflexivity. + rewrite <- Z_of_nat_fold_left_mul. + f_equal. rewrite fold_left_mul_filter_until. + simpl. invs. eq_size_of. eq_eval_Z. simpl. f_equal. lia. } + 2: { eapply contexts_agree_alloc_array_in_heap. eauto. eauto. } + invs'. pose proof H1 as Hlower. + eapply lower_correct_weak in Hlower. + 2: { eauto. } + 2: { eauto. } + 2: { eauto. } + 2: { eapply well_formed_environment_letbind1. + 3: sets. sets. + 2: { eauto. } + sets. } + 2: { decomp_well_formed_reindexer. propositional. + eapply partial_injective_id_reindexer. apply Henv. sets. sets. + unfold nondestructivity. unfold alloc_array_in_heap. + rewrite lookup_add_eq by eauto. + rewrite dom_add. split; intros. 2: sets. + invs'. rewrite add_0_r. + pose proof (lookup_alloc_array (fold_left mul sz1 n) x2) as [H22|H22]. + 2: solve [eauto]. + eapply lookup_None_dom in H22. + rewrite dom_alloc_array in H22. + exfalso. apply H22. + erewrite <- In_iff_in in *. clear H22. + unfold tensor_to_array_delta in H15. + unfold tensor_to_array_delta_by_indices in H15. + erewrite partial_dom_fold_left_array_add in H15. + 2: { eapply partial_injective_id_reindexer. apply Henv. } + rewrite dom_empty in H15. rewrite cup_empty_r in H15. + eapply In_iff_in in H15. + eapply in_extract_Some in H15. + eapply in_map_iff in H15. invs'. + rewrite filter_idempotent in H18. + decomp_index. + replace (fold_left mul sz1 n) with (fold_left mul (n :: sz1) 1). + 2: { simpl. rewrite add_0_r. eauto. } + rewrite partial_interpret_reindexer_id_flatten in H15. invs'. + erewrite result_has_shape_result_shape_Z. + 2: { eapply size_of_eval_expr_result_has_shape in H4; eauto. } + erewrite <- fold_left_mul_filter_until. + erewrite Z_of_nat_fold_left_mul. + eapply in_mesh_grid_flatten_in_range. + eapply Forall_map. eapply Forall_forall. intros. lia. + erewrite result_has_shape_result_shape_Z in H10. + 2: { eapply size_of_eval_expr_result_has_shape in H4; eauto. } + eauto. eauto. apply Henv. } + 2: { rewrite <- (Nat2Z.id (fold_left _ _ _)). + eapply well_formed_allocation_letbind1. eapply Henv. + unfold well_formed_environment in *. sets. + erewrite result_has_shape_result_shape_Z. + 2: { eapply size_of_eval_expr_result_has_shape in H4; eauto. } + replace 1%Z with (Z.of_nat 1) by reflexivity. + rewrite <- Z_of_nat_fold_left_mul. + rewrite fold_left_mul_filter_until. f_equal. + invs. eq_size_of. eq_eval_Z. simpl. f_equal. lia. } - cases (shape_to_index (result_shape_Z (V l1)) - (shape_to_vars (result_shape_Z (V l1)))). - { eapply shape_to_index_not_empty_Z in Heq. propositional. } - unfold alloc_array_in_heap in H1. rewrite add_overwrite in H1. - unfold lookup_total in H1. rewrite lookup_add_eq in H1 by auto. + cases (shape_to_index (result_shape_Z (V l1)) + (shape_to_vars (result_shape_Z (V l1)))). + { eapply shape_to_index_not_empty_Z in Heq. propositional. } + unfold alloc_array_in_heap in Hlower. rewrite add_overwrite in Hlower. + unfold lookup_total in Hlower. rewrite lookup_add_eq in Hlower by auto. + rewr_sizeof. - pose proof H9. - eapply IHeval_expr2 with (h:=x1) (asn:=asm) (reindexer:=reindexer) in H11. - 2: { eauto. } - 2: { invs. - eapply well_formed_environment_alloc_heap. eauto. eauto. - sets. sets. sets. } - 2: { invert H1. - decomp_well_formed_reindexer. propositional. - unfold nondestructivity. rewrite dom_add. - rewrite lookup_add_ne. - 2: { invert Henv. sets. } - split; intros. apply Hnondstr; eauto. - apply Hnondstr; eauto. sets. } - 2: { invert H1. eapply well_formed_allocation_add_heap_var. - invs. eauto. unfold well_formed_environment in*. sets. } - 2: { invert H1. + pose proof H12 as Heval2. + eapply IHeval_expr2 with (h:=x1) (asn:=asm) (reindexer:=reindexer) in Heval2. + 2: { eauto. } + 2: { invs'. + eapply well_formed_environment_alloc_heap. eauto. eauto. + sets. sets. sets. } + 2: { invs'. + decomp_well_formed_reindexer. propositional. + unfold nondestructivity. rewrite dom_add. + rewrite lookup_add_ne. + 2: { invert Henv. sets. } + split; intros. apply Hnondstr; eauto. + apply Hnondstr; eauto. sets. } + 2: { invs'. eapply well_formed_allocation_add_heap_var. + eauto. unfold well_formed_environment in*. sets. } + 2: { invs'. + erewrite result_has_shape_result_shape_Z. + 2: { eapply size_of_eval_expr_result_has_shape in H4; eauto. } + simpl fold_left. rewrite add_0_r. + replace (fold_left mul sz1 n) with (fold_left mul (n :: sz1) 1). + 2: { simpl. rewrite add_0_r. eauto. } - erewrite result_has_shape_result_shape_Z. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in H5; eauto. } - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H1; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1. - invert H1. eq_eval_Z. eq_eval_Zlist. - simpl fold_left. rewrite add_0_r. - replace (fold_left mul - (map Z.to_nat (map (eval_Zexpr_Z_total $0) esh1)) - (Z.to_nat (eval_Zexpr_Z_total $0 z))) with - (fold_left mul (map Z.to_nat (map (eval_Zexpr_Z_total $0) - (z::esh1))) 1). - 2: { simpl. rewrite add_0_r. eauto. } + rewrite <- (Nat2Z.id ((fold_left _ _ _))). + rewrite tensor_to_array_delta_id_valuation. 2: apply Henv. + eapply contexts_agree_add_alloc_heap. eauto. eauto. + eapply size_of_eval_expr_result_has_shape in H4; eauto. + simpl. constructor. eassumption. eassumption. + eassumption. + replace 1%Z with (Z.of_nat 1) by reflexivity. + rewrite <- Z_of_nat_fold_left_mul. + erewrite fold_left_mul_filter_until. eauto. } + 2: { eauto. } + 2: { intros. cases (x3 =? x). eapply String.eqb_eq in Heq0. subst. + repeat rewrite lookup_add_eq in * by auto. invs'. simpl. + eapply has_pad_gen_pad. eauto. eauto. eauto. + eapply result_has_shape_self. + eapply size_of_eval_expr_result_has_shape in H4; eauto. + eauto. eauto. eauto. + eapply String.eqb_neq in Heq0. rewrite lookup_add_ne in * by eauto. + eauto. } + invs'. - rewrite <- (Nat2Z.id ((fold_left - mul - (map Z.to_nat - (map - (eval_Zexpr_Z_total $0) - (z :: esh1))) 1))). - rewrite tensor_to_array_delta_id_valuation. 2: apply Henv. - - eapply contexts_agree_add_alloc_heap. invs. eauto. eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eauto. eauto. eauto. - eapply constant_nonneg_bounds_size_of_nonneg. - 3: { eapply forall_no_vars_eval_Zexpr_Z_total. - eapply constant_nonneg_bounds_size_of_no_vars. - 2: eauto. eauto. } - 2: { eauto. } - eauto. eapply constant_nonneg_bounds_size_of_no_vars. - 2: eauto. eauto. - rewrite <- Z_of_nat_fold_left_mul. - erewrite <- fold_left_mul_filter_until_0. eauto. - } - 2: { eauto. } - 2: { intros. cases (x2 =? x). eapply String.eqb_eq in Heq0. subst. - repeat rewrite lookup_add_eq in * by auto. invert H12. - simpl. invert H15. - eapply has_pad_gen_pad. eauto. eauto. eauto. - eapply result_has_shape_self. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - 3: eauto. eauto. eauto. eauto. - eapply contexts_agree_result_has_shape. eauto. eauto. - eapply String.eqb_neq in Heq0. rewrite lookup_add_ne in * by eauto. - eauto. } - invs. - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H1; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1. - invert H1. eq_eval_Z. eq_eval_Zlist. + eexists. eexists. econstructor. + unfold flat_sizeof. rewrite <- H. + econstructor. + apply eval_Zexpr_Z_eval_Zexpr. + apply eval_Zexpr_Z_fold_left_ZTimes. + eapply eval_Zexprlist_includes_valuation. eassumption. apply empty_includes. + eapply eval_Zexpr_includes_valuation. eassumption. apply empty_includes. + rewrite <- Z_of_nat_fold_left_mul. rewrite Nat2Z.id. + econstructor. + eapply H1. simpl. rewrite add_0_r in *. + econstructor. + simpl in H1. rewrite add_0_r in H1. + erewrite result_has_shape_result_shape_Z in H1. + 2: { eapply size_of_eval_expr_result_has_shape in H4; eauto. } + eassert (array_add _ _ = _) as ->. 2: eassumption. - eexists. eexists. econstructor. - unfold flat_sizeof. erewrite size_of_sizeof by eauto. simpl. - econstructor. - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H1; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1; eauto. - invert H1. eq_eval_Z. eq_eval_Zlist. - eapply eval_Zexpr_Z_eval_Zexpr. - eapply eval_Zexpr_Z_fold_left_ZTimes. - eauto. eauto. - - econstructor. - rewrite <- (Nat2Z.id (fold_left _ _ _)) in H10. - replace (Z.to_nat (Z.of_nat - (fold_left mul - (map Z.to_nat (map (eval_Zexpr_Z_total $0) esh1)) - (Z.to_nat (eval_Zexpr_Z_total $0 z))))) - with (Z.to_nat - (fold_left Z.mul (map (eval_Zexpr_Z_total $0) esh1) - (eval_Zexpr_Z_total $0 z))) in H10. - 2: { rewrite <- (mul_1_l (Z.to_nat (eval_Zexpr_Z_total $0 _))). - rewrite fold_left_mul_assoc_nat. - rewrite Nat2Z.inj_mul. rewrite Z_of_nat_fold_left_mul. - f_equal. - rewrite <- fold_left_mul_assoc. rewrite Z.mul_1_l. - pose proof H3. - eapply constant_nonneg_bounds_size_of_nonneg in H1. - 2: { eauto. } - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v). - eapply constant_nonneg_bounds_size_of_no_vars; eauto. } - invert H1. - rewrite Z2Nat.id by lia. - rewrite map_map. - symmetry. erewrite map_extensionality. - 2: { intros. erewrite Z2Nat.id. reflexivity. - eapply Forall_forall in H1. - 2: { eauto. } simpl in *. lia. } - rewrite map_id. reflexivity. - } - eapply H10. simpl. rewrite add_0_r in *. - econstructor. - replace (array_add - (alloc_array - (Z.to_nat - (fold_left Z.mul (map (eval_Zexpr_Z_total $0) esh1) - (eval_Zexpr_Z_total $0 z))) $0) - (tensor_to_array_delta - (partial_interpret_reindexer (fun l3 : list (Zexpr * Zexpr) => l3) - (result_shape_Z (V l1)) v) (V l1))) with - (array_add - (alloc_array - ( - (fold_left mul - ( - (filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (z :: esh1))) - 0)) 1)) $0) - (tensor_to_array_delta - (partial_interpret_reindexer (fun l : list (Zexpr * Zexpr) => l) - (map Z.of_nat - (filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (z :: esh1))) 0)) - $0) (V l1))). - simpl in H11. rewrite add_0_r in H11. - erewrite result_has_shape_result_shape_Z in H11. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - apply H3. eauto. eauto. } - rewrite <- fold_left_mul_filter_until_0. - rewrite map_cons in *. simpl fold_left. rewrite add_0_r. - erewrite tensor_to_array_delta_id_valuation in H11. eauto. apply Henv. - - f_equal. - erewrite <- fold_left_mul_filter_until_0. - rewrite <- (Nat2Z.id (fold_left _ _ _)). - rewrite Z_of_nat_fold_left_mul. - simpl. rewrite Z.mul_1_l. - pose proof H0. - eapply constant_nonneg_bounds_size_of_nonneg in H1; eauto. - invert H1. rewrite Z2Nat.id by lia. - rewrite Z2Natid_list by eauto. eauto. - erewrite <- tensor_to_array_delta_id_valuation. - erewrite result_has_shape_result_shape_Z. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - apply H3. eauto. eauto. } - eauto. apply Henv. - econstructor. - eapply contexts_agree_alloc_array_in_heap. eauto. eauto. eauto. - eauto. - - simpl in *. invs. repeat erewrite size_of_sizeof in * by eauto. simpl. - invert Hpad. - pose proof H1. pose proof H2. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H3; - eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H4; + f_equal. f_equal. simpl. lia. + econstructor. + eapply contexts_agree_alloc_array_in_heap. eauto. eauto. eauto. eauto. - pose proof H1. pose proof H2. - eapply constant_nonneg_bounds_size_of_no_vars in H14. - 2: { eauto. } - eapply constant_nonneg_bounds_size_of_no_vars in H15. - 2: { eauto. } - pose proof H14. pose proof H15. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H16. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H18. - invert H16. invert H18. - eq_size_of. invert H9. invert H16. - rewrite H8 in *. - pose proof H1. - eapply IHeval_expr1 in H7. + - simpl in *. invs. simpl. + invert Hpad. eq_size_of. invs'. + rename H5 into Hsize1. rename H6 into Hsize2. + pose proof Hsize1 as Hsize1'. pose proof Hsize2 as Hsize2'. + eapply size_of_includes in Hsize1'. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize1'; eauto. + eapply size_of_includes in Hsize2'. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize2'; eauto. + rewr_sizeof. rewr_sizeof. + + pose proof Hsize1 as Heval1. + eapply IHeval_expr1 in Heval1. 2: { eauto. } 2: { eapply well_formed_environment_subseteq_vars. eauto. sets. } - 2: { pose proof H1. pose proof H2. - eapply constant_nonneg_bounds_sizeof_nonneg in H7,H16. - 2: { erewrite size_of_sizeof by eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v); eauto. } - 2: { erewrite size_of_sizeof by eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v); eauto. } - pose proof Halloc. - eapply well_formed_allocation_result_V in H18. invs. + 2: { pose proof Halloc as Halloc'. + eapply well_formed_allocation_result_V in Halloc'. invs'. eapply well_formed_reindexer_concat_l. apply Hrdx. - rewrite map_cons in H4. rewrite map_cons in H4. eauto. - rewrite map_cons in H3. rewrite map_cons in H3. - rewrite H8 in *. eauto. - invert H7. eauto. invert H16. eauto. - invert H14. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - invert H15. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - apply Henv. - eauto. apply Hrdx. } + rewrite Nat2Z.id. eassumption. + rewrite Nat2Z.id. eassumption. + lia. lia. + eassumption. eassumption. + apply Henv. eauto. apply Hrdx. } 2: { eapply well_formed_allocation_concat_l. eauto. - repeat rewrite map_cons in *. eauto. - repeat rewrite map_cons in *. rewrite H8. eauto. - eapply Henv. apply Hrdx. apply Hrdx. apply Hrdx. - pose proof H2. - eapply constant_nonneg_bounds_size_of_nonneg in H9; eauto. - invert H9. - rewrite Z2Nat.id by lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - invert H15. eauto. - apply Hrdx. } - invs. - pose proof H7. - eapply lower_correct_weak with (asn:=asm) in H9; eauto. + eassumption. eassumption. + eapply Henv. apply Hrdx. apply Hrdx. apply Hrdx. eassumption. apply Hrdx. } + invs'. + pose proof H8 as Hlower. + eapply lower_correct_weak with (asn:=asm) in Hlower; eauto. 2: { eapply well_formed_environment_subseteq_vars. eauto. sets. } - 2: { pose proof H1. pose proof H2. - eapply constant_nonneg_bounds_sizeof_nonneg in H16,H18. - 2: { erewrite size_of_sizeof by eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v); eauto. } - 2: { erewrite size_of_sizeof by eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v); eauto. } - pose proof Halloc. - eapply well_formed_allocation_result_V in H20. invs. + 2: { pose proof Halloc as Halloc'. + eapply well_formed_allocation_result_V in Halloc'. invs. eapply well_formed_reindexer_concat_l. apply Hrdx. - rewrite map_cons in H4. rewrite map_cons in H4. eauto. - rewrite map_cons in H3. rewrite map_cons in H3. - rewrite H8 in *. eauto. - invert H16. eauto. invert H18. eauto. - invert H14. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - invert H15. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - apply Henv. - eauto. apply Hrdx. } + rewrite Nat2Z.id. eassumption. + rewrite Nat2Z.id. eassumption. + lia. lia. eassumption. eassumption. apply Henv. eauto. apply Hrdx. } 2: { eapply well_formed_allocation_concat_l. eauto. - repeat rewrite map_cons in *. eauto. - repeat rewrite map_cons in *. rewrite H8. eauto. - eapply Henv. apply Hrdx. apply Hrdx. apply Hrdx. - invert H15. - pose proof H2. - eapply constant_nonneg_bounds_size_of_nonneg in H15; eauto. - invert H15. - rewrite Z2Nat.id by lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - apply Hrdx. } + eauto. eauto. apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. + eassumption. apply Hrdx. } 2: { eauto. } 2: { eauto. } 2: { eauto. } - cases (reindexer - match - shape_to_index (result_shape_Z (V l1)) - (shape_to_vars (result_shape_Z (V l1))) - with - | [] => - shape_to_index (result_shape_Z (V l1)) - (shape_to_vars (result_shape_Z (V l1))) - | (v0, d) :: xs => - (v0, (d + dim2)%z) - :: xs - end). + destruct (reindexer match shape_to_index _ _ with _ => _ end) eqn:Heq. { cases (shape_to_index (result_shape_Z (V l1)) (shape_to_vars (result_shape_Z (V l1)))). eapply shape_to_index_not_empty_Z in Heq0. propositional. eapply reindexer_not_empty_vars_in_index in Heq. propositional. apply Hrdx. destruct p0. - unfold not. intros. - simpl in H16. + unfold not. intros H'. + simpl in H'. unfold shape_to_index,shape_to_vars, result_shape_Z in Heq0. simpl in *. cases l1. - - simpl in *. invert Heq0. simpl in H16. - eapply cup_empty in H16. invs. - eapply cup_empty in H18. invs. - eapply constant_not_empty in H9. propositional. inversion 1. - - simpl in *. invert Heq0. simpl in H16. - eapply cup_empty in H16. invs. - eapply cup_empty in H18. invs. - eapply constant_not_empty in H9. propositional. inversion 1. } + - simpl in *. invs'. simpl in *. cups_empty. + - simpl in *. invs'. simpl in *. cups_empty. } - pose proof H2. - pose proof Halloc. - eapply well_formed_allocation_result_V in H18. invert H18. invert H20. - unfold lookup_total in *. rewrite H18 in *. - invert H9. - eapply IHeval_expr2 with (st:=st) (h:= h $+ (p, - array_add x2 - (tensor_to_array_delta - (partial_interpret_reindexer - (fun l3 : list (Zexpr * Zexpr) => - reindexer - match l3 with - | [] => l3 - | (v0, d) :: xs => (v0, (d + dim2)%z) :: xs - end) (result_shape_Z (V l1)) v) (V l1)))) in H16; eauto. + pose proof Hsize2 as Heval2. + pose proof Halloc as Halloc'. + eapply well_formed_allocation_result_V in Halloc'. invs'. + unfold lookup_total in *. rewrite H16 in *. + match goal with + | H: context[h $+ (?a, ?b)] |- _ => + eapply IHeval_expr2 with (st:=st) (h:= h $+ (a, b)) in Heval2; eauto + end. 2: { eapply well_formed_environment_add_heap. eapply well_formed_environment_subseteq_vars. eauto. sets. eauto. } 2: { eapply well_formed_reindexer_concat_r. eauto. - simpl in H3. eauto. rewrite H8. simpl in H4. eauto. - apply Henv. - invert H14. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eapply constant_nonneg_bounds_size_of_nonneg in H1; eauto. - invert H1. lia. eauto. - eapply constant_nonneg_bounds_size_of_nonneg in H16; eauto. - invert H16. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - invert H15. eauto. - } + rewrite Nat2Z.id. eassumption. + rewrite Nat2Z.id. eassumption. + apply Henv. eassumption. lia. assumption. lia. eassumption. } 2: { eapply well_formed_allocation_add_heap. - eapply well_formed_allocation_concat_r. eauto. - simpl in *. eauto. simpl in *. rewrite H8. eauto. - eapply Henv. apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. - invert H14. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eapply constant_nonneg_bounds_size_of_nonneg in H1; eauto. - invert H1. lia. eauto. } + eapply well_formed_allocation_concat_r. eauto. + rewrite Nat2Z.id. eassumption. + eassumption. + apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. + assumption. lia. assumption. } 2: { eapply contexts_agree_add_heap. eauto. eauto. unfold well_formed_environment in *. sets. unfold well_formed_environment in *. sets. } - invs. + invs'. eexists. eexists. econstructor. - 2: { eapply constant_nonneg_bounds_size_of_nonneg in H2; eauto. } + 2: { eauto. } 2: { apply Hrdx. } eapply eq_eval_stmt_lower_eq_reindexers. eassumption. - intros. cases l0. eapply eq_Z_tuple_index_list_id. - cases p1. eapply Hrdx. + intros. simpl. cases l6. eapply eq_Z_tuple_index_list_id. + cases p1. + eapply Hrdx. erewrite <- eq_Z_tuple_index_list_cons_tup. split. eauto. split. eauto. eapply eq_Z_tuple_index_list_id. - - simpl in *. invs. eq_size_of. invert H1. - pose proof Hconst. invert Hpad. - + pose proof H1. eq_size_of. invert H8. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. simpl in *. - pose proof H1. - eapply constant_nonneg_bounds_size_of_no_vars in H4; eauto. invert H4. - invert H13. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H12,H10. - eapply H10 in H5. - eapply H12 in H6. invert H5. invert H6. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H14. - eq_eval_Zlist. - eapply IHeval_expr in H1. + - simpl in *. invs. eq_size_of. invs'. invert Hpad. + + eq_size_of. invs'. rename H2 into Hsize. pose proof Hsize as Hsh. + eapply size_of_includes in Hsh. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh; eauto; []. + pose proof Hsize as Heval. + eapply IHeval_expr in Heval. 2: { eauto. } 2: { eauto. } 2: { eapply well_formed_allocation_result_V in Halloc. - invert Halloc. invs. + invert Halloc. invs'. eapply well_formed_reindexer_transpose. simpl in *. eauto. eauto. apply Henv. eauto. - apply H12. apply H10. apply Hrdx. - } + apply Hrdx. } 2: { eapply well_formed_allocation_transpose; try apply Hrdx; try apply Henv; eauto. } 2: { eauto. } 2: { eauto. } 2: { eauto. } eauto. - + pose proof H1. eq_size_of. invert H7. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. simpl in *. - pose proof H1. - eapply constant_nonneg_bounds_size_of_no_vars in H4; eauto. invert H4. - invert H11. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H10,H8. - eapply H8 in H5. - eapply H10 in H6. invert H5. invert H6. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H12. - eq_eval_Zlist. - eapply IHeval_expr in H1. + + eq_size_of. invs'. pose proof H2 as Hsize. pose proof Hsize as Hsh. + eapply size_of_includes in Hsh. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh; eauto; []. + pose proof Hsize as Heval. + eapply IHeval_expr in Heval. 2: { eauto. } 2: { eauto. } 2: { eapply well_formed_allocation_result_V in Halloc. - invert Halloc. invs. + invert Halloc. invs'. eapply well_formed_reindexer_transpose. simpl in *. eauto. eauto. apply Henv. eauto. - apply H10. apply H8. apply Hrdx. } + apply Hrdx. } 2: { eapply well_formed_allocation_transpose; try apply Hrdx; try apply Henv; eauto. } 2: { eauto. } @@ -2094,115 +1445,99 @@ sets. 2: { eauto. } eauto. - simpl in *. invs. invert Hpad. - eq_size_of. invert H1. - pose proof Hconst. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H1; - eauto. simpl in *. - pose proof Hconst. - eapply constant_nonneg_bounds_size_of_no_vars in H4; eauto. invert H4. - invert H13. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H12,H11. - eapply IHeval_expr in Hconst; eauto. + eq_size_of. invs'. + rename H2 into Hsize. pose proof Hsize as Hsh. + eapply size_of_includes in Hsh. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh; eauto; []. + pose proof Hsize as Heval. + eapply IHeval_expr in Heval; eauto. pose proof Halloc as Halloc2. eapply well_formed_allocation_result_V in Halloc2. invert Halloc2. invs. eapply well_formed_reindexer_flatten; try apply Henv; try apply Hrdx; eauto. apply Hrdx. eapply well_formed_allocation_flatten; try apply Henv; try apply Hrdx; eauto. - - simpl in *. invs. invert Hpad. eq_size_of. invert H2. - pose proof H3. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. simpl in *. - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H5; eauto. invert H5. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H12,H1. - pose proof H3. - eapply constant_nonneg_bounds_size_of_nonneg in H5; eauto. - 2: { econstructor. eapply H12 with (v:=v). econstructor. - eapply forall_no_vars_eval_Zexpr_Z_total. eauto. } - invert H5. - eapply IHeval_expr in H3; eauto. + - simpl in *. invs. invert Hpad. eq_size_of. eq_eval_Z. invs'. + rename H8 into Hsize. pose proof Hsize as Hsh. + eapply size_of_includes in Hsh. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh; eauto; []. + rename H2 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'. 2: apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. rewrite Hk' in *. invs'. clear Hk'. + apply eval_Zexpr_Z_eval_Zexpr in Hk. cbv [eval_Zexpr_Z_total] in *. + + pose proof Hsize as Heval. + eapply IHeval_expr in Heval; eauto. pose proof Halloc as Halloc2. - eapply well_formed_allocation_result_V in Halloc2. invert Halloc2. invs. + eapply well_formed_allocation_result_V in Halloc2. invert Halloc2. invs'. eapply well_formed_reindexer_split; - try apply Hrdx; try apply Henv; eauto. apply Hrdx. + try apply Hrdx; try apply Henv; eauto. + apply Hrdx. eapply well_formed_allocation_split; try apply Hrdx; try apply Henv; eauto. - - simpl in *. invs. invert Hpad. erewrite size_of_sizeof in * by eauto. - eq_size_of. simpl in *. - pose proof H2. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H5; - eauto. simpl in *. - pose proof H2. - eapply constant_nonneg_bounds_size_of_no_vars in H7; eauto. invert H7. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H12,H4. - pose proof H2. - eapply constant_nonneg_bounds_size_of_nonneg in H7; eauto. - 2: { econstructor. eapply H12 with (v:=v). econstructor. - eapply forall_no_vars_eval_Zexpr_Z_total. eauto. } - invert H7. pose proof H8. - eapply has_pad_gen_pad in H8; eauto. - 2: { eapply contexts_agree_result_has_shape; eauto. } - simpl in H8. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H. eapply H4 in H. invert H. + - simpl in *. invs. invert Hpad. rewr_sizeof. invs'. eq_eval_Z. + rename H7 into Hsize. pose proof Hsize as Hsh. + eapply size_of_includes in Hsh. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh; eauto; []. + rename H5 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. + rewrite Hk' in *. invs'. apply eval_Zexpr_Z_eval_Zexpr in Hk. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + pose proof H6 as Hpad. + eapply has_pad_gen_pad in Hpad; eauto. + simpl in Hpad. invs'. - eapply IHeval_expr in H2; eauto. - rewrite <- (firstn_skipn (length l - (Z.to_nat (eval_Zexpr_Z_total $0 k))) l). + pose proof Hsize as Heval. + eapply IHeval_expr in Heval; eauto. + rewrite <- (firstn_skipn (length l - (Z.to_nat kz)) l). rewrite <- (rev_involutive (skipn _ _)). rewrite <- firstn_rev. - eapply forall_firstn_ge with (m:= Z.to_nat (eval_Zexpr_Z_total $0 k)) - in H8. + eapply forall_firstn_ge with (m:= Z.to_nat kz) in H4. 2: { lia. } - eapply forall_eq_gen_pad in H8. rewrite H8. + eapply forall_eq_gen_pad in H4. rewrite H4. simpl gen_pad_list. rewrite rev_repeat. - + rewrite length_firstn. rewrite length_rev. erewrite result_has_shape_length. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in H2; eauto. } + 2: { eauto using size_of_eval_expr_result_has_shape. } rewrite min_l by lia. pose proof Halloc as Halloc2. - eapply well_formed_allocation_result_V in Halloc2. invert Halloc2. invs. + eapply well_formed_allocation_result_V in Halloc2. invert Halloc2. invs'. - destruct (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)) eqn:hmk. + destruct (m - Z.to_nat kz) eqn:hmk. { simpl. - replace (V - (repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))) with - (gen_pad (Z.to_nat (eval_Zexpr_Z_total $0 k) :: - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) + replace (V (repeat (gen_pad sh0) (Z.to_nat kz))) with + (gen_pad (Z.to_nat kz :: sh0)) by eauto. decomp_well_formed_reindexer. propositional. rewrite filter_negb_is_None_result_lookup_Z_option_gen_pad. unfold partial_injective. simpl. propositional. destruct l2; destruct l3; eauto. - invert H20. simpl in *. lia. - invert H20. simpl in *. lia. + destruct H15 as (H15&_). invert H15. + destruct H15 as (H15&_). invert H15. destruct p0. destruct p1. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons_tup in *. - propositional. eapply eq_zexpr_sub; eauto. + invs'. auto using eq_zexpr_sub. destruct l2; simpl; rewrite Hmap; eauto. destruct p0. simpl. unfold subst_var_in_Z_tup at 1. simpl. - erewrite subst_var_in_Zexpr_id with (lo:=k). eauto. - invert H4. rewrite H22. sets. - erewrite Hvarsarg. destruct l2. eauto. + f_equal. f_equal. f_equal. f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by eauto. + auto. + erewrite Hvarsarg. destruct l2. reflexivity. destruct p0. simpl. - invert H4. rewrite H21. simpl. rewrite app_no_dups_empty_r. - sets. + erewrite (eval_Zexpr_vars_empty k) by eauto. + rewrite app_no_dups_empty_r. reflexivity. unfold nondestructivity. unfold tensor_to_array_delta. rewrite filter_negb_is_None_result_lookup_Z_option_gen_pad. unfold tensor_to_array_delta_by_indices. simpl. rewrite dom_empty. split; intros. sets. - eapply lookup_Some_dom in H17. sets. - } + eapply lookup_Some_dom in H12. sets. } rewrite <- hmk in *. + rewrite <- (Z2Nat.id kz) by lia. rewrite Nat2Z.id. eapply well_formed_reindexer_truncr. rewrite rev_app_distr. rewrite truncl_list_app. @@ -2210,7 +1545,7 @@ sets. rewrite truncl_list_skipn. rewrite skipn_all2. 2: { rewrite length_rev. simpl. rewrite repeat_length. lia. } - replace (Z.to_nat (eval_Zexpr_Z_total $0 m)) with (length l). + replace m with (length l). 2: { erewrite result_has_shape_length by eauto. reflexivity. } rewrite <- skipn_rev. simpl. rewrite <- truncl_list_skipn. eauto. @@ -2221,25 +1556,23 @@ sets. rewrite length_app. simpl. rewrite length_firstn. rewrite repeat_length. erewrite result_has_shape_length by eauto. rewrite min_l by lia. rewrite sub_add. reflexivity. lia. - apply Henv. eauto. lia. lia. - eauto. eapply H12. lia. apply Hrdx. + apply Henv. eauto. lia. eassumption. lia. apply Hrdx. - rewrite <- (firstn_skipn - (length l-(Z.to_nat (eval_Zexpr_Z_total $0 k))) l). + rewrite <- (firstn_skipn (length l-(Z.to_nat kz)) l). rewrite <- (rev_involutive (skipn _ _)). rewrite <- firstn_rev. - eapply forall_firstn_ge with (m:= Z.to_nat (eval_Zexpr_Z_total $0 k)) - in H8. + eapply forall_firstn_ge with (m:= Z.to_nat kz) in H4. 2: { lia. } - eapply forall_eq_gen_pad in H8. rewrite H8. + eapply forall_eq_gen_pad in H4. rewrite H4. simpl gen_pad_list. rewrite rev_repeat. - + rewrite length_firstn. rewrite length_rev. erewrite result_has_shape_length. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in H2; eauto. } + 2: { eauto using size_of_eval_expr_result_has_shape. } + + rewrite min_l by lia. - rewrite min_l by lia. + rewrite <- (Z2Nat.id kz) by lia. rewrite Nat2Z.id. eapply well_formed_allocation_truncr. rewrite rev_app_distr. rewrite truncl_list_app. @@ -2247,7 +1580,7 @@ sets. rewrite truncl_list_skipn. rewrite skipn_all2. 2: { rewrite length_rev. simpl. rewrite repeat_length. lia. } - replace (Z.to_nat (eval_Zexpr_Z_total $0 m)) with (length l). + replace m with (length l). 2: { erewrite result_has_shape_length by eauto. reflexivity. } simpl. rewrite <- skipn_rev. simpl. @@ -2260,72 +1593,65 @@ sets. rewrite repeat_length. erewrite result_has_shape_length by eauto. rewrite min_l by lia. rewrite sub_add. reflexivity. lia. lia. apply Hrdx. eauto. apply Henv. apply Hrdx. apply Hrdx. - - simpl in *. invs. invert Hpad. erewrite size_of_sizeof in * by eauto. - eq_size_of. simpl in *. - pose proof H2. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H5; - eauto. simpl in *. - pose proof H2. - eapply constant_nonneg_bounds_size_of_no_vars in H7; eauto. invert H7. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H12,H4. - pose proof H2. - eapply constant_nonneg_bounds_size_of_nonneg in H7; eauto. - 2: { econstructor. eapply H12 with (v:=v). econstructor. - eapply forall_no_vars_eval_Zexpr_Z_total. eauto. } - invert H7. pose proof H8. - eapply has_pad_gen_pad in H8; eauto. - 2: { eapply contexts_agree_result_has_shape; eauto. } - simpl in H8. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H. eapply H4 in H. invert H. + - simpl in *. invs. invert Hpad. rewr_sizeof. invs'. eq_eval_Z. + rename H7 into Hsize. pose proof Hsize as Hsh. + eapply size_of_includes in Hsh. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh; eauto. + rename H5 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. + rewrite Hk' in *. invs'. apply eval_Zexpr_Z_eval_Zexpr in Hk. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + pose proof H6 as Hpad. + eapply has_pad_gen_pad in Hpad; eauto. + simpl in Hpad. invs'. - eapply IHeval_expr in H2; eauto. - rewrite <- (firstn_skipn - (Z.to_nat (eval_Zexpr_Z_total $0 k)) l). - eapply forall_firstn_ge with (m:= Z.to_nat (eval_Zexpr_Z_total $0 k)) - in H10. + pose proof Hsize as Heval. + eapply IHeval_expr in Heval; eauto. + rewrite <- (firstn_skipn (Z.to_nat kz) l). + eapply forall_firstn_ge with (m:= Z.to_nat kz) in H. 2: { lia. } - eapply forall_eq_gen_pad in H10. rewrite H10. + eapply forall_eq_gen_pad in H. rewrite H. simpl gen_pad_list. - - rewrite length_firstn. + + rewrite length_firstn. erewrite result_has_shape_length. - 2: { eauto. } + 2: { eauto. } rewrite min_l by lia. pose proof Halloc as Halloc2. eapply well_formed_allocation_result_V in Halloc2. invert Halloc2. invs. - destruct (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)) eqn:hmk. + destruct (m - Z.to_nat kz) eqn:hmk. { rewrite skipn_all2. rewrite app_nil_r. 2: { erewrite result_has_shape_length. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H1; eauto. } lia. } - replace (V (repeat (gen_pad (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))) with - (gen_pad (Z.to_nat (eval_Zexpr_Z_total $0 k):: - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)))) + 2: { eauto using size_of_eval_expr_result_has_shape. } + lia. } + replace (V (repeat (gen_pad sh0) (Z.to_nat kz))) with + (gen_pad (Z.to_nat kz :: sh0)) by eauto. decomp_well_formed_reindexer. propositional. erewrite filter_negb_is_None_result_lookup_Z_option_gen_pad. unfold partial_injective. simpl. propositional. destruct l2; destruct l3; eauto. - invert H20; simpl in *; lia. - invert H20; simpl in *; lia. + destruct H15 as (H15&_). invert H15. + destruct H15 as (H15&_). invert H15. destruct p0. destruct p1. eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons_tup in *. - propositional. eapply eq_zexpr_sub; eauto. eapply eq_zexpr_sub; eauto. - destruct l2; rewrite Hmap. eauto. eauto. + invs'. auto using eq_zexpr_sub. + destruct l2; rewrite Hmap. eauto. eauto. destruct p0. simpl. unfold subst_var_in_Z_tup at 1. simpl. - rewrite subst_var_in_Zexpr_id with (lo:=k). - 2: { invert H4. rewrite H22. sets. } - eauto. eauto. + f_equal. f_equal. f_equal. f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by eauto. + auto. + f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by eauto. + auto. + eauto. destruct l2; rewrite Hvarsarg; eauto. destruct p0. simpl. - invert H4. rewrite H21. simpl. repeat rewrite app_no_dups_empty_r. - eauto. + erewrite (eval_Zexpr_vars_empty k) by eauto. + do 2 rewrite app_no_dups_empty_r. reflexivity. unfold nondestructivity in *. unfold tensor_to_array_delta. rewrite filter_negb_is_None_result_lookup_Z_option_gen_pad. @@ -2343,20 +1669,18 @@ sets. rewrite length_app. simpl. rewrite length_skipn. rewrite repeat_length. erewrite result_has_shape_length by eauto. instantiate (1 := m). lia. - apply Henv. eauto. lia. lia. eauto. - lia. apply Hrdx. + apply Henv. eauto. eauto. eassumption. lia. apply Hrdx. - rewrite <- (firstn_skipn (Z.to_nat (eval_Zexpr_Z_total $0 k)) l). - eapply forall_firstn_ge with (m:= Z.to_nat (eval_Zexpr_Z_total $0 k)) - in H10. + rewrite <- (firstn_skipn (Z.to_nat kz) l). + eapply forall_firstn_ge with (m:= Z.to_nat kz) in H. 2: { lia. } - eapply forall_eq_gen_pad in H10. rewrite H10. + eapply forall_eq_gen_pad in H. rewrite H. simpl gen_pad_list. rewrite length_firstn. erewrite result_has_shape_length by eauto. - rewrite min_l by lia. + rewrite min_l by lia. eapply well_formed_allocation_truncl. erewrite <- truncl_list_skipn. eauto. apply Hrdx. simpl. eapply forall_result_has_shape. @@ -2365,170 +1689,145 @@ sets. eapply forall_skipn. eapply result_has_shape_forall. eauto. rewrite length_app. simpl. rewrite length_skipn. rewrite repeat_length. erewrite result_has_shape_length by eauto. - instantiate (1 := m). lia. lia. + instantiate (1 := m). lia. auto. lia. apply Hrdx. eauto. eauto. apply Henv. apply Hrdx. apply Hrdx. - - invert Hsize. eq_size_of. invert H4. invert Hconst. invs. pose proof H4. + - invert Hsize. eq_size_of. simpl in Hbds. invs'. eq_eval_Z. + rename H6 into Hsize. pose proof Hsize as Hsh. + eapply size_of_includes in Hsh. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh; eauto. + rename H4 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. + rewrite Hk' in *. invs'. apply eval_Zexpr_Z_eval_Zexpr in Hk. + invert Hpad. - + eq_size_of. invert H8. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. - invert H2. 2: lia. - eapply IHeval_expr in H5; eauto. + + eq_size_of. invs'. invert Hsh. + pose proof Hsize as Heval. + eapply IHeval_expr in Heval; eauto. { decomp_well_formed_reindexer. propositional. - unfold result_shape_Z. unfold partial_injective. simpl. propositional. - eapply HeqZlist. cases l1; cases l2. - eauto. invert H8. simpl in *. lia. - eauto. invert H8. simpl in *. lia. + eauto. + destruct H2 as (H2&_). invert H2. + destruct H2 as (H2&_). invert H2. cases p0. cases p1. - erewrite <- eq_Z_tuple_index_list_cons_tup in H8. invs. - erewrite <- eq_Z_tuple_index_list_cons_tup. split. eauto. split. - eapply eq_zexpr_add; eauto. eauto. + erewrite <- eq_Z_tuple_index_list_cons_tup in H2. invs'. + erewrite <- eq_Z_tuple_index_list_cons_tup. + auto using eq_zexpr_add. - rewrite Hmap by eauto. cases l; eauto. simpl. - cases p0. simpl. f_equal. f_equal. - unfold subst_var_in_Z_tup. simpl. f_equal. - f_equal. eapply subst_var_in_Zexpr_id. rewrite H6. sets. + cases p0. cbv [subst_var_in_Z_tup]. simpl. + f_equal. f_equal. f_equal. f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by eauto. + auto. - rewrite Hvarsarg. cases l; eauto. cases p0. simpl. - rewrite H6. simpl. repeat rewrite app_no_dups_empty_r. + erewrite (eval_Zexpr_vars_empty k) by eauto. + rewrite app_no_dups_empty_r. reflexivity. - unfold nondestructivity. unfold tensor_to_array_delta. simpl. unfold tensor_to_array_delta_by_indices. simpl. rewrite dom_empty. split; intros. sets. eapply well_formed_allocation_result_V in Halloc. invs. - eapply lookup_Some_dom in H9. sets. eauto. } + eapply lookup_Some_dom in H3. sets. eauto. } { unfold well_formed_allocation. cases (shape_to_index (result_shape_Z (V [])) (shape_to_vars (result_shape_Z (V [])))). eapply shape_to_index_not_empty_Z in Heq. propositional. - cases (reindexer (let (v0, d) := p0 in ((v0)%z, (d + k)%z) :: l)). + destruct (reindexer (let (v0, d) := p0 in _)) eqn:Heq0. { eapply reindexer_not_empty_vars_in_index in Heq0. propositional. apply Hrdx. unfold not. intros. unfold shape_to_index, shape_to_vars, result_shape_Z in *. - simpl in Heq. invert Heq. simpl in H2. - eapply cup_empty in H2. invs. - eapply cup_empty in H8. invs. - rewrite H6 in *. simpl in *. rewrite app_no_dups_empty_r in *. - eapply constant_not_empty in H2. propositional. - inversion 1. } - pose proof Halloc. - eapply well_formed_allocation_result_V in H2. invs. + simpl in Heq. invert Heq. simpl in *. cups_empty. } + pose proof Halloc as Halloc'. + eapply well_formed_allocation_result_V in Halloc'. invs. eexists. split. eassumption. unfold result_shape_Z. simpl. sets. apply Hrdx. } - + eq_size_of. invert H8. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. - eapply IHeval_expr in H5; eauto. + + eq_size_of. invs'. invert Hsh. lia. + pose proof Hsize as Heval. + eapply IHeval_expr in Heval; eauto. { pose proof Halloc as Halloc2. - eapply well_formed_allocation_result_V in Halloc2. invs. + eapply well_formed_allocation_result_V in Halloc2. invs'. eapply well_formed_reindexer_padr. eauto. - simpl gen_pad_list in *. - eapply constant_nonneg_bounds_size_of_no_vars in H1; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1. - invert H1. eq_eval_Zlist. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total with (v:=$0) - in H6. - eapply eval_Zexpr_Z_eval_Zexpr in H. eapply H6 in H. invert H. - eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply constant_nonneg_bounds_size_of_no_vars in H5; eauto. invert H5. - eauto. lia. lia. - apply Henv. eauto. apply Hrdx. } - { eapply well_formed_allocation_padr. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. lia. - eapply constant_nonneg_bounds_size_of_no_vars in H1; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1. - invert H1. eq_eval_Zlist. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total with (v:=$0) - in H6. - eapply eval_Zexpr_Z_eval_Zexpr in H. eapply H6 in H. invert H. - simpl gen_pad_list in *. eauto. apply Hrdx. apply Henv. + simpl gen_pad_list in *. econstructor; eauto. + eauto. auto. lia. lia. apply Henv. eauto. apply Hrdx. } + { eapply well_formed_allocation_padr. econstructor; eauto. + eauto. lia. simpl gen_pad_list in *. eauto. apply Hrdx. apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. } - - invert Hsize. eq_size_of. invert H4. invert Hconst. invs. pose proof H4. + - invert Hsize. eq_size_of. simpl in Hbds. invs'. eq_eval_Z. + rename H6 into Hsize. pose proof Hsize as Hsh. + eapply size_of_includes in Hsh. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh; eauto. + rename H4 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. + rewrite Hk' in *. invs'. apply eval_Zexpr_Z_eval_Zexpr in Hk. + invert Hpad. - + eq_size_of. invert H8. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. - invert H2. 2: lia. - eapply IHeval_expr in H5; eauto. + + eq_size_of. invs'. invert Hsh. + pose proof Hsize as Heval. + eapply IHeval_expr in Heval; eauto. { decomp_well_formed_reindexer. propositional. - unfold result_shape_Z. unfold partial_injective. simpl. propositional. - eapply HeqZlist. cases l1; cases l2. - eauto. invert H8. simpl in *. lia. - eauto. invert H8. simpl in *. lia. + eauto. + destruct H2 as (H2&_). invert H2. + destruct H2 as (H2&_). invert H2. cases p0. cases p1. - erewrite <- eq_Z_tuple_index_list_cons_tup in H8. invs. - erewrite <- eq_Z_tuple_index_list_cons_tup. split. - eapply eq_zexpr_add; eauto. split. - eapply eq_zexpr_add; eauto. eauto. + erewrite <- eq_Z_tuple_index_list_cons_tup in H2. invs'. + erewrite <- eq_Z_tuple_index_list_cons_tup. + auto using eq_zexpr_add. - rewrite Hmap by eauto. cases l; eauto. simpl. - cases p0. simpl. f_equal. f_equal. - unfold subst_var_in_Z_tup. simpl. f_equal. - f_equal. eapply subst_var_in_Zexpr_id. rewrite H6. sets. - f_equal. eapply subst_var_in_Zexpr_id. rewrite H6. sets. + cases p0. cbv [subst_var_in_Z_tup]. simpl. + f_equal. f_equal. f_equal. f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by eauto. + auto. + f_equal. apply subst_var_in_Zexpr_id. + erewrite eval_Zexpr_vars_empty by eauto. + auto. - rewrite Hvarsarg. cases l; eauto. cases p0. simpl. - rewrite H6. simpl. repeat rewrite app_no_dups_empty_r. - reflexivity. + erewrite (eval_Zexpr_vars_empty k) by eauto. + do 2 rewrite app_no_dups_empty_r. reflexivity. - unfold nondestructivity. unfold tensor_to_array_delta, tensor_to_array_delta_by_indices. simpl. rewrite dom_empty. split; intros. sets. - eapply well_formed_allocation_result_V in Halloc. invs. - eapply lookup_Some_dom in H9. sets. eauto. + eapply well_formed_allocation_result_V in Halloc. invs'. + eapply lookup_Some_dom in H3. sets. eauto. } { unfold well_formed_allocation. cases (shape_to_index (result_shape_Z (V [])) (shape_to_vars (result_shape_Z (V [])))). eapply shape_to_index_not_empty_Z in Heq. propositional. - cases (reindexer (let (v0, d) := p0 in ((v0 + k)%z, (d + k)%z) :: l)). + destruct (reindexer (let (v0, d) := p0 in _)) eqn:Heq0. { eapply reindexer_not_empty_vars_in_index in Heq0. propositional. apply Hrdx. unfold not. intros. unfold shape_to_index, shape_to_vars, result_shape_Z in *. - simpl in Heq. invert Heq. simpl in H2. - eapply cup_empty in H2. invs. - eapply cup_empty in H8. invs. - rewrite H6 in *. simpl in *. rewrite app_no_dups_empty_r in *. - eapply constant_not_empty in H2. propositional. - inversion 1. } - pose proof Halloc. rewrite app_nil_r in *. - eapply well_formed_allocation_result_V in H2. invs. + simpl in Heq. invs'. simpl in *. cups_empty. } + pose proof Halloc as Halloc'. rewrite app_nil_r in *. + eapply well_formed_allocation_result_V in Halloc'. invs. eexists. split. eassumption. unfold result_shape_Z. simpl. sets. apply Hrdx. } - + eq_size_of. invert H8. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. - + + eq_size_of. invs'. + simpl gen_pad_list in *. - pose proof H1 as Hsize. - eapply constant_nonneg_bounds_size_of_no_vars in H1; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1. - invert H1. eq_eval_Zlist. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total with (v:=$0) - in H6. - eapply eval_Zexpr_Z_eval_Zexpr in H. eapply H6 in H. invert H. - - eapply IHeval_expr in H5; eauto. + + pose proof Hsize as Heval. + eapply IHeval_expr in Heval; eauto. { pose proof Halloc as Halloc2. - eapply well_formed_allocation_result_V in Halloc2. invs. + eapply well_formed_allocation_result_V in Halloc2. invs'. eapply well_formed_reindexer_padl. apply Hrdx. simpl map in *. eauto. apply Henv. eauto. - eapply constant_nonneg_bounds_size_of_no_vars in H5; eauto. - invert H5. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. lia. - lia. apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. eauto. + lia. lia. apply Hrdx. apply Hrdx. apply Hrdx. apply Hrdx. eauto. eapply Hrdx. eauto. apply Hrdx. } { pose proof Halloc as Halloc2. eapply well_formed_allocation_result_V in Halloc2. invs. eapply well_formed_allocation_padl. eauto. eauto. - apply Hrdx. lia. lia. apply Hrdx. eauto. - eapply constant_nonneg_bounds_size_of_no_vars in Hsize; eauto. - invert Hsize. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. + apply Hrdx. lia. apply Hrdx. eauto. apply Henv. apply Hrdx. apply Hrdx. apply Hrdx. } - simpl in *. invert Hsize. pose proof Halloc as Halloc1. @@ -2545,7 +1844,7 @@ sets. invert Hpad. eauto. } unfold result_shape_Z, shape_to_index, shape_to_vars in Hrdx. simpl in Hrdx. rewrite Heq in *. invs. - rewrite H0 in *. + rewrite H0 in *. eexists. eexists. econstructor. eauto. eassumption. auto. * eapply lower_correct_weak with (e:= Scalar s) in Hrdx; eauto. 2: { econstructor. eauto. } @@ -2554,11 +1853,10 @@ sets. invert Hpad. eauto. } unfold result_shape_Z, shape_to_index, shape_to_vars in Hrdx. simpl in Hrdx. rewrite Heq in *. invs. - rewrite H0 in *. + rewrite H0 in *. eexists. eexists. econstructor. eauto. eassumption. auto. + cases r. 2: { invert H. cases r; try discriminate. - cases r; try discriminate. cases r1; cases r2; try discriminate. cases r1; cases r2; try discriminate. cases r1; cases r2; try discriminate. @@ -2573,32 +1871,32 @@ sets. in H3. rewrite eval_Zexprlist_map_match_snd_map_eval_Zexpr_Z_tup_total in H3. - eapply dom_lookup_Some in H3. invs. - + eapply dom_lookup_Some in H3. invs. + eapply lower_correct_weak with (e:= Scalar s) in Hsnd; eauto. 2: { econstructor. eauto. } 2: { simpl. eapply EvalAssignV. eauto. rewrite Heq. inversion 1. eapply H2. - eapply eval_Zexpr_Z_flatten_index_flatten. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - eapply Forall_map. eapply Forall_forall. - intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - eapply Forall_map. eapply Forall_forall. - intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - eassumption. } + { eapply eval_Zexpr_Z_flatten_index_flatten. + - eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + eapply Forall_map. eapply Forall_forall. + intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + - eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + eapply Forall_map. eapply Forall_forall. + intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. } + eauto. } eexists. eexists. eapply EvalAssignV. unfold shape_to_index, shape_to_vars, result_shape_Z in *. simpl in *. rewrite Heq in *. unfold lookup_total in *. @@ -2606,96 +1904,96 @@ sets. rewrite <- Heq in *. decomp_well_formed_reindexer. - eapply eval_Zexpr_Z_flatten_index_flatten. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - eapply Forall_map. eapply Forall_forall. - intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - eapply Forall_map. eapply Forall_forall. - intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - - eassumption. rewrite <- Heq. + { eapply eval_Zexpr_Z_flatten_index_flatten. + - eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + eapply Forall_map. eapply Forall_forall. + intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + - eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + eapply Forall_map. eapply Forall_forall. + intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. } + eassumption. + rewrite <- Heq. rewrite map_snd_map_partially_eval_Z_tup. rewrite map_fst_map_partially_eval_Z_tup. sets. - rewrite <- Heq in *. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - rewrite map_snd_map_partially_eval_Z_tup. - eapply Forall_map. eapply Forall_forall. intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - rewrite map_fst_map_partially_eval_Z_tup. - eapply Forall_map. eapply Forall_forall. intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - rewrite <- Heq in *. eauto. - rewrite <- Heq in *. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - rewrite map_snd_map_partially_eval_Z_tup. - eapply Forall_map. eapply Forall_forall. intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - rewrite <- Heq in *. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - rewrite map_fst_map_partially_eval_Z_tup. - eapply Forall_map. eapply Forall_forall. intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. + ** rewrite <- Heq in *. + eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + rewrite map_snd_map_partially_eval_Z_tup. + eapply Forall_map. eapply Forall_forall. intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + ** rewrite <- Heq in *. + eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + rewrite map_fst_map_partially_eval_Z_tup. + eapply Forall_map. eapply Forall_forall. intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + ** rewrite <- Heq in *. + eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + rewrite map_snd_map_partially_eval_Z_tup. + eapply Forall_map. eapply Forall_forall. intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + ** rewrite <- Heq in *. + eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + rewrite map_fst_map_partially_eval_Z_tup. + eapply Forall_map. eapply Forall_forall. intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. * invs. pose proof Hrdx as Hsnd. rewrite eval_Zexprlist_map_match_fst_map_eval_Zexpr_Z_tup_total in H3. rewrite eval_Zexprlist_map_match_snd_map_eval_Zexpr_Z_tup_total in H3. - eapply dom_lookup_Some in H3. invs. + eapply dom_lookup_Some in H3. invs. eapply lower_correct_weak with (e:= Scalar s) in Hrdx; eauto. 2: { econstructor. eauto. } 2: { simpl. eapply EvalReduceV. eauto. rewrite Heq. inversion 1. eauto. - eapply eval_Zexpr_Z_flatten_index_flatten. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - eapply Forall_map. eapply Forall_forall. - intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - eapply Forall_map. eapply Forall_forall. - intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. + { eapply eval_Zexpr_Z_flatten_index_flatten. + - eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + eapply Forall_map. eapply Forall_forall. + intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + - eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + eapply Forall_map. eapply Forall_forall. + intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. } eassumption. } eexists. eexists. eapply EvalReduceV. unfold shape_to_index, shape_to_vars, result_shape_Z in *. @@ -2704,68 +2002,68 @@ sets. rewrite <- Heq in *. decomp_well_formed_reindexer. - eapply eval_Zexpr_Z_flatten_index_flatten. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - eapply Forall_map. eapply Forall_forall. - intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - eapply Forall_map. eapply Forall_forall. - intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. + { eapply eval_Zexpr_Z_flatten_index_flatten. + - eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + eapply Forall_map. eapply Forall_forall. + intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + - eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + eapply Forall_map. eapply Forall_forall. + intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. } + eassumption. - eassumption. rewrite <- Heq. + rewrite <- Heq. rewrite map_snd_map_partially_eval_Z_tup. rewrite map_fst_map_partially_eval_Z_tup. sets. - rewrite <- Heq in *. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - rewrite map_snd_map_partially_eval_Z_tup. - eapply Forall_map. eapply Forall_forall. intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - rewrite map_fst_map_partially_eval_Z_tup. - eapply Forall_map. eapply Forall_forall. intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - rewrite <- Heq in *. eauto. - rewrite <- Heq in *. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - rewrite map_snd_map_partially_eval_Z_tup. - eapply Forall_map. eapply Forall_forall. intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - rewrite <- Heq in *. - eapply eval_Zexprlist_map_partially_eval_Zexpr. - eapply forall_no_vars_eval_Zexpr_Z_total. - decomp_well_formed_reindexer. - rewrite map_fst_map_partially_eval_Z_tup. - eapply Forall_map. eapply Forall_forall. intros. - eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. - eapply subseteq_transitivity. - eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. - eauto. - Unshelve. eauto. - eauto. + + ** rewrite <- Heq in *. + eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + rewrite map_snd_map_partially_eval_Z_tup. + eapply Forall_map. eapply Forall_forall. intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + ** rewrite <- Heq in *. + eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + rewrite map_fst_map_partially_eval_Z_tup. + eapply Forall_map. eapply Forall_forall. intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + ** rewrite <- Heq in *. + eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + rewrite map_snd_map_partially_eval_Z_tup. + eapply Forall_map. eapply Forall_forall. intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply snd_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + ** rewrite <- Heq in *. + eapply eval_Zexprlist_map_partially_eval_Zexpr. + eapply forall_no_vars_eval_Zexpr_Z_total. + decomp_well_formed_reindexer. + rewrite map_fst_map_partially_eval_Z_tup. + eapply Forall_map. eapply Forall_forall. intros. + eapply vars_of_Zexpr_subseteq_partially_eval_Zexpr. + eapply subseteq_transitivity. + eapply fst_vars_of_reindexer_vars_of_Zexpr_subseteq. eauto. + eauto. + Unshelve. all: exact nil. Qed. - diff --git a/src/verified_lowering/proof/Meshgrid.v b/src/verified_lowering/proof/Meshgrid.v index 24859c3..ac84101 100644 --- a/src/verified_lowering/proof/Meshgrid.v +++ b/src/verified_lowering/proof/Meshgrid.v @@ -22,7 +22,7 @@ Fixpoint mesh_grid sh : list (list Z) := | x::xs => let rest := mesh_grid xs in let new_range := concat (map (fun k => repeat k (length rest)) - (zrange 0%Z x)) in + (zrange 0%Z x)) in map2 List.cons new_range (concat (repeat rest (Z.to_nat x))) end. @@ -110,11 +110,11 @@ Proof. rewrite repeat_length. reflexivity. erewrite length_concat. rewrite repeat_length. reflexivity. eapply Forall_repeat. reflexivity. } - eapply in_app_or in H. + eapply in_app_or in H. assert (x = Z.of_nat k \/ x < Z.of_nat k)%Z by lia. invert H2; invert H. + eapply not_In_cons_l1 in H2. eapply in_concat in H2. - firstorder. + firstorder. eapply in_map_iff in H. firstorder. subst. eapply repeat_spec in H2. subst. @@ -125,7 +125,7 @@ Proof. firstorder. invert H. auto. + eapply IHk;try eassumption. lia. + eapply not_In_cons_l2 in H2. - eapply in_concat in H2. + eapply in_concat in H2. firstorder. subst. auto. Qed. @@ -135,7 +135,7 @@ Lemma in_mesh_grid_cons_ : In x0 (mesh_grid xs) <-> In (x::x0) (mesh_grid (Z.of_nat k::xs)). Proof. - induct k; propositional. + induct k; propositional. - lia. - simpl in *. propositional. - simpl in *. propositional. @@ -167,7 +167,7 @@ Proof. - simpl in H. eapply not_In_cons_l1 in H. eapply in_concat in H. firstorder. - eapply in_map_iff in H. firstorder. subst. + eapply in_map_iff in H. firstorder. subst. eapply repeat_spec in H0. subst. unfold zrange in H1. eapply in_zrange'_upper_bound in H1. lia. @@ -215,12 +215,12 @@ Proof. posnats. setoid_rewrite Nat2Z.id in H. eapply H; clear H. - eapply not_In_cons_l1 in H0. - eapply in_concat in H0. firstorder. + eapply in_concat in H0. firstorder. eapply in_map_iff in H. firstorder. subst. eapply repeat_spec in H0. subst. unfold zrange in H1. pose proof (in_zrange'_lower_bound _ _ _ H1). - simpl in *. lia. + simpl in *. lia. eapply in_map_iff in H. firstorder. subst. eapply repeat_spec in H0. subst. pose proof (in_zrange'_upper_bound _ _ _ H1). @@ -230,7 +230,7 @@ Proof. eapply result_has_shape_result_shape_nat in H4. rewrite H4. eapply result_has_shape_result_shape_nat in H2. rewrite H2 in *. auto. eapply repeat_spec in H. subst. - eapply result_has_shape_result_shape_nat in H4. + eapply result_has_shape_result_shape_nat in H4. invert H6. eapply result_has_shape_result_shape_nat in H2. rewrite H2 in *. rewrite H4 in *. auto. @@ -306,7 +306,7 @@ Proof. 2: { eapply Forall_repeat. reflexivity. } rewrite repeat_length. rewrite min_id. rewrite fold_left_mul_assoc. rewrite IHsh. lia. auto. -Qed. +Qed. Lemma mesh_grid_shape_pos : forall sh args, In args (mesh_grid sh) -> @@ -340,23 +340,19 @@ Proof. - simpl in *. propositional. subst. simpl. lia. - cases args. eapply not_In_empty_map2_cons in H. propositional. eapply in_mesh_grid_cons__ in H. invert H. - cases sh. simpl in *. propositional. subst. simpl. lia. - cases args. eapply not_In_empty_map2_cons in H1. propositional. - eapply in_mesh_grid_cons__ in H1. invert H1. simpl. eapply Z.add_nonneg_nonneg. + eapply Z.mul_nonneg_nonneg. lia. eapply fold_left_mul_nonneg. eapply mesh_grid_shape_nonneg. eassumption. lia. - + eapply IHsh. - erewrite <- in_mesh_grid_cons__. auto. + + eapply IHsh. assumption. Qed. Lemma flatten_cons_cons : forall x xs y ys z z0, (y * fold_left Z.mul xs z + flatten (z :: xs) (z0 :: ys))%Z = flatten (x :: z :: xs) (y :: z0 :: ys). Proof. - reflexivity. + simpl. intros. replace (1 * z)%Z with z by lia. reflexivity. Qed. Lemma in_range_in_flatten : forall sh x, @@ -369,7 +365,7 @@ Proof. - simpl in *. lia. - simpl in * |-. rewrite fold_left_mul_assoc in *. pose proof (Z_div_mod x (fold_left Z.mul sh 1%Z)). - assert (fold_left Z.mul sh 1 > 0)%Z. + assert (fold_left Z.mul sh 1 > 0)%Z. invert H1. lia. eapply H2 in H3. clear H2. destruct (Z.div_eucl x (fold_left Z.mul sh 1%Z)) eqn:ee. @@ -385,7 +381,9 @@ Proof. rewrite map_map2. unfold flatten in *. rewrite Z.add_0_r. rewrite map2_repeat2. - rewrite map_id. + simpl. + erewrite map_ext. 1: rewrite map_id. + 2: { simpl. lia. } eapply in_concat. eexists [z]. split. eapply in_map with (f:= fun x => [x]). unfold zrange. @@ -411,7 +409,7 @@ Proof. eapply div_eucl_pos. 3: apply H. eapply mesh_grid_shape_pos in H5. eapply fold_left_mul_pos. auto. lia. - auto. + auto. propositional. eapply div_eucl_bound in H0. auto. auto. auto. @@ -423,58 +421,28 @@ Lemma in_mesh_grid_flatten_in_range : forall sh x0, In (flatten sh x0) (zrange 0 (fold_left Z.mul sh 1%Z)). Proof. induct sh; intros. - - simpl in *. propositional. subst. simpl. propositional. + - simpl in *. propositional. - cases x0. eapply not_In_empty_map2_cons in H0. propositional. - cases sh. - + pose proof H0. - eapply not_In_cons_l2 in H0. - rewrite <- repeat_to_concat in H0. - eapply repeat_spec in H0. subst. - eapply in_mesh_grid_cons__ in H1. invs. - simpl. - unfold zrange. - eapply in_zrange'. - lia. - + eapply in_mesh_grid_cons__ in H0. invs. - cases x0. - eapply not_In_empty_map2_cons in H2. propositional. - pose proof H2. - eapply in_mesh_grid_cons__ in H2. invs. - simpl. - rewrite Z.mul_1_l. - rewrite (Z.mul_comm a). - rewrite fold_left_mul_assoc. - eapply IHsh in H1. - unfold zrange in H1. - rewrite Z.sub_0_r in H1. - simpl in H1. - rewrite Z.mul_1_l in H1. - pose proof (in_zrange'_lower_bound _ _ _ H1). - pose proof (in_zrange'_upper_bound _ _ _ H1). - eapply in_zrange'. - rewrite Z.sub_0_r. rewrite Z.add_0_l. - invert H. - rewrite Z2Nat.id. - 2: { eapply Z.mul_nonneg_nonneg. - eapply fold_left_mul_nonneg. invert H11. auto. - invert H11. auto. auto. } - rewrite (Z.mul_comm _ a). - split. - * eapply Z.add_nonneg_nonneg. + simpl. eapply in_mesh_grid_cons__ in H0. invert H. destruct H0. + pose proof H0. + eapply IHsh in H0; eauto. + rewrite fold_left_mul_assoc. + apply In_zrange in H0. + apply In_zrange. + invert H. + split. + * eapply Z.add_nonneg_nonneg. eapply Z.mul_nonneg_nonneg. auto. eapply fold_left_mul_nonneg. - invert H11. auto. invert H11. auto. - eapply flatten_sh_nonneg. - erewrite <- in_mesh_grid_cons__. - auto. - * eapply mul_add_lt. + assumption. + lia. + lia. + * rewrite (Z.mul_comm _ a). apply mul_add_lt. auto. auto. eapply flatten_sh_nonneg. - erewrite <- in_mesh_grid_cons__. auto. lia. - * invert H. auto. Qed. Lemma constant_map_flatten_zrange : forall l, @@ -495,29 +463,13 @@ Proof. auto. Qed. -Lemma in_mesh_grid_args_flatten_bounds : forall sh args1 z1, - In args1 (mesh_grid (z1 :: sh)) -> - (0 <= flatten (z1 :: sh) args1 < fold_left Z.mul sh z1)%Z \/ - (fold_left Z.mul sh z1 < flatten (z1 :: sh) args1 <= 0)%Z. +Lemma in_mesh_grid_args_flatten_bounds : forall sh args1, + In args1 (mesh_grid sh) -> + (0 <= flatten sh args1 < fold_left Z.mul sh 1)%Z \/ + (fold_left Z.mul sh 1 < flatten sh args1 <= 0)%Z. Proof. induct sh; intros. - - simpl in *. - cases args1. eapply not_In_empty_map2_cons in H. propositional. - pose proof H. - eapply not_In_cons_l2 in H. - eapply not_In_cons_l1 in H0. - rewrite <- repeat_to_concat in H. - eapply repeat_spec in H. subst. simpl. - unfold zrange in *. - rewrite Z.sub_0_r in H0. - eapply in_concat in H0. - invs. - eapply in_map_iff in H0. invs. - invert H1. - pose proof (in_zrange'_lower_bound _ _ _ H2). - pose proof (in_zrange'_upper_bound _ _ _ H2). - lia. - simpl in *. propositional. + - simpl in *. lia. - cases args1. simpl in *. eapply not_In_empty_map2_cons in H. propositional. simpl in *. @@ -532,43 +484,35 @@ Proof. invs. eapply in_map_iff in H0. invs. eapply repeat_spec in H1. subst. - unfold zrange in H2. - pose proof (in_zrange'_lower_bound _ _ _ H2). - pose proof (in_zrange'_upper_bound _ _ _ H2). - clear H2. + apply In_zrange in H2. invert H3. - + cases z1; try lia. - left. - rewrite (Z.mul_comm (Z.pos p)). + + left. rewrite fold_left_mul_assoc. - assert (x0 < Z.pos p)%Z by lia. clear H0. + assert (x0 < a)%Z by lia. clear H0. split. eapply Z.add_nonneg_nonneg. eapply Z.mul_nonneg_nonneg. lia. lia. lia. - rewrite (Z.mul_comm _ (Z.pos p)). + rewrite (Z.mul_comm _ a). eapply mul_add_lt. lia. lia. lia. lia. - + cases z1; try lia. - right. + + right. split. - rewrite (Z.mul_comm (Z.pos p)). rewrite fold_left_mul_assoc. - rewrite (Z.mul_comm _ (Z.pos p)). + rewrite (Z.mul_comm _ a). assert (forall x y, -x < -y -> y < x)%Z. - intros. lia. eapply H2. + intros. lia. eapply H0. rewrite Z.opp_add_distr. rewrite Zopp_mult_distr_r. rewrite Zopp_mult_distr_r. rewrite Z.add_opp_r. eapply mul_add_lt. lia. lia. lia. lia. assert (forall x y, -x <= -y -> y <= x)%Z. - lia. eapply H2. + lia. eapply H0. simpl. rewrite Z.opp_add_distr. rewrite Zopp_mult_distr_r. - assert (flatten (a::sh) args1 = 0 \/ flatten (a::sh) args1 <> 0)%Z - by lia. invert H3. - * rewrite H4. - lia. + assert (flatten sh args1 = 0 \/ flatten sh args1 <> 0)%Z + by lia. invert H1. + * rewrite H3. lia. * eapply auxiliary.Zle_mult_approx. lia. lia. lia. Qed. @@ -585,7 +529,7 @@ Proof. simpl. rewrite map_constant_repeat. rewrite concat_repeat_empty. reflexivity. -Qed. +Qed. Lemma mesh_grid_cons : forall x xs, mesh_grid (x::xs) = @@ -613,7 +557,7 @@ Proof. rewrite map_map2. rewrite map2_f_l1 with (f:=fun a => (a+n)%Z). rewrite concat_map. rewrite map_map. - replace + replace (fun x : Z => map (fun a0 : Z => (a0 + n)%Z) (repeat x (Datatypes.length (mesh_grid xs)))) with @@ -643,7 +587,7 @@ Proof. rewrite length_map. rewrite length_zrange'. rewrite repeat_length. lia. rewrite map_id. reflexivity. -Qed. +Qed. Lemma result_lookup_Z_concat_l : forall x x1 xs r1 r2 x2, result_has_shape (V r1) (x1 :: xs) -> @@ -747,7 +691,7 @@ Lemma constant_map_flatten_zrange_gt_0 : forall l, (map (flatten l) (mesh_grid l)) = constant (zrange 0 (fold_left Z.mul l 1%Z)). Proof. - intros. apply sets_equal. + intros. apply sets_equal. induct l; intros; split; intros. - simpl in *. auto. - simpl in *. auto. @@ -759,7 +703,7 @@ Proof. eapply in_mesh_grid_flatten_in_range. eapply mesh_grid_shape_nonneg. eassumption. auto. - - eapply In_iff_in in H0. + - eapply In_iff_in in H0. eapply In_iff_in. erewrite <- In_iff_in. eapply in_map_iff. simpl zrange in *. @@ -794,7 +738,7 @@ Proof. assert (Forall (fun x : Z => (0 <= x)%Z) l). eapply Forall_impl. 2: { invert H. eapply H9. } - simpl. lia. apply H1 in H6. + simpl. lia. apply H1 in H6. eapply In_zrange in H6. auto. auto. invert H. auto. invert H. auto. @@ -864,8 +808,8 @@ Proof. eapply Z.ltb_lt in H2. eapply Z.leb_le in H1. propositional. reflexivity. + rewrite IHargs2; eauto. rewrite andb_false_r. reflexivity. -Qed. - +Qed. + Lemma mesh_grid_filter_until : forall sh, mesh_grid (map Z.of_nat (filter_until sh 0)) = @@ -874,11 +818,11 @@ Proof. intros. pose proof (list_nat_nonneg sh). invert H. erewrite exists_0_empty_mesh_grid. - 2: { eapply exists_0_map_of_nat. + 2: { eapply exists_0_map_of_nat. eapply exists_0_filter_until_0. eauto. } erewrite exists_0_empty_mesh_grid. - 2: { eapply exists_0_map_of_nat. + 2: { eapply exists_0_map_of_nat. eauto. } reflexivity. erewrite filter_until_0_id by auto. reflexivity. @@ -905,19 +849,13 @@ Definition is_None {X} (x : option X) := end. Lemma filter_pad_r_empty : forall k l0 x, - (0 <= k)%Z -> filter (fun x1 : list Z => negb (is_None (result_lookup_Z_option x1 - (V - (x ++ - gen_pad_list - (Z.to_nat k :: - map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))))))) + (V (x ++ gen_pad_list (k :: l0)))))) (map (fun l : list Z => match l with @@ -925,16 +863,14 @@ Lemma filter_pad_r_empty : forall k l0 x, | i :: is => (i + Z.of_nat (length x))%Z :: is end) (mesh_grid - (Z.of_nat (Z.to_nat k) - :: map Z.of_nat - (filter_until - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))) = []. + (Z.of_nat k + :: map Z.of_nat + (filter_until l0 0)))) = []. Proof. intros. eapply filter_empty. eapply Forall_forall. intros. - eapply in_map_iff in H0. invs. + eapply in_map_iff in H. invs. repeat decomp_index. eapply negb_false_iff. unfold is_None. @@ -947,12 +883,7 @@ Proof. Qed. Lemma filter_pad_r_mesh_grid : forall m x l0 k, - result_has_shape - (V (gen_pad_list - (Z.to_nat k - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) ++ x)) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) -> - (0 <= k)%Z -> + result_has_shape (V (gen_pad_list (k :: l0) ++ x)) (m :: l0) -> filter (fun x1 : list Z => negb @@ -960,48 +891,39 @@ Lemma filter_pad_r_mesh_grid : forall m x l0 k, (result_lookup_Z_option x1 (V (x ++ - gen_pad_list - (Z.to_nat k - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))))))) + gen_pad_list (k :: l0)))))) (mesh_grid (map Z.of_nat (filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) 0))) = + (m :: l0) 0))) = (filter (fun x0 => negb (is_None (result_lookup_Z_option x0 (V x)))) (mesh_grid (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat k :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))). + (filter_until (m - k :: l0) 0)))). Proof. intros. simpl in H. repeat rewrite map_cons. pose proof (result_has_shape_length _ _ _ H). - rewrite length_app in H1. - rewrite repeat_length in H1. + rewrite length_app in H0. + rewrite repeat_length in H0. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). + cases m. - reflexivity. - rewrite filter_until_0_cons by lia. - rewrite <- H1. - replace (Z.to_nat k + length x - Z.to_nat k) with (length x) by lia. + rewrite <- H0. + replace (k + length x - k) with (length x) by lia. rewrite map_cons at 1. rewrite Nat2Z.inj_add by lia. rewrite Z.add_comm. rewrite mesh_grid_app by lia. rewrite filter_app. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m)) with - (Z.to_nat k + (Z.to_nat (eval_Zexpr_Z_total $0 m) - Z.to_nat k)) - by lia. rewrite filter_pad_r_empty. simpl map. cases x. simpl. auto. simpl map. simpl length. posnats. rewrite app_nil_r. eapply filter_ext_in. - 2: lia. intros. + intros. repeat decomp_index. f_equal. f_equal. simpl. @@ -1019,14 +941,13 @@ Lemma filter_pad_l_empty : forall k l0 x, x0 (V (gen_pad_list - (k :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) ++ + (k :: l0) ++ x))))) (mesh_grid (Z.of_nat k :: map Z.of_nat (filter_until - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0))) = []. + l0 0))) = []. Proof. intros. eapply filter_empty. @@ -1045,9 +966,8 @@ Qed. Lemma filter_pad_l_mesh_grid : forall m x l0 k, result_has_shape (V (gen_pad_list - (Z.to_nat k - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) ++ x)) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) -> + (Z.to_nat k :: l0) ++ x)) + (m :: l0) -> (0 <= k)%Z -> filter (fun x0 => @@ -1056,13 +976,10 @@ Lemma filter_pad_l_mesh_grid : forall m x l0 k, (result_lookup_Z_option x0 (V (gen_pad_list - (Z.to_nat k - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) ++ x))))) + (Z.to_nat k :: l0) ++ x))))) (mesh_grid (map Z.of_nat - (filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) 0))) = + (filter_until (m :: l0) 0))) = map (fun l1 => match l1 with @@ -1072,10 +989,7 @@ Lemma filter_pad_l_mesh_grid : forall m x l0 k, (filter (fun x0 => negb (is_None (result_lookup_Z_option x0 (V x)))) (mesh_grid (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat k :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))). + (filter_until (m - Z.to_nat k :: l0) 0)))). Proof. intros. simpl in H. @@ -1085,7 +999,7 @@ Proof. rewrite length_app in H1. rewrite repeat_length in H1. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). + cases m. - reflexivity. - rewrite filter_until_0_cons by lia. rewrite <- H1. @@ -1094,8 +1008,8 @@ Proof. rewrite Nat2Z.inj_add by lia. rewrite mesh_grid_app by lia. rewrite filter_app. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m)) with - (Z.to_nat k + (Z.to_nat (eval_Zexpr_Z_total $0 m) - Z.to_nat k)) + replace (Datatypes.S m) with + (Z.to_nat k + (Datatypes.S m - Z.to_nat k)) by lia. rewrite filter_pad_l_empty. rewrite app_nil_l. @@ -1222,9 +1136,7 @@ Lemma filter_fun_pad_r : forall l k l0, (V (l ++ repeat - (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))))))) = + (gen_pad l0) k))))) = (fun x : list Z => negb (is_None @@ -1243,18 +1155,15 @@ Proof. - rewrite nth_error_app2 by lia. assert (length l <= Z.to_nat 0) by lia. eapply nth_error_None in H. rewrite H. simpl. - cases ( - (repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))). - + auto. - + cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). invert Heq. invert Heq. + cases ((repeat (gen_pad l0) k)). + + auto. + + cases k. invert Heq. invert Heq. rewrite result_lookup_Z_option_gen_pad. reflexivity. - rewrite nth_error_app2 by lia. assert (length l <= Z.to_nat (Z.pos p)) by lia. eapply nth_error_None in H. rewrite H. simpl. cases (nth_error - (repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))) + (repeat (gen_pad l0) k) (Pos.to_nat p - Datatypes.length l)). + pose proof Heq. eapply nth_error_Some in Heq. @@ -1267,7 +1176,7 @@ Proof. cases z; try lia. - rewrite nth_error_app1. auto. lia. - rewrite nth_error_app1. auto. lia. -Qed. +Qed. Lemma result_lookup_Z_option_None : forall x2 r, result_has_shape r (result_shape_nat r) -> @@ -1282,7 +1191,7 @@ Proof. simpl in *. cases z; simpl in *; propositional. - simpl in *. cases a; auto. - + erewrite filter_In in *. + + erewrite filter_In in *. unfold result_shape_Z in *. simpl map in *. cases r; auto. simpl map in *. @@ -1292,7 +1201,7 @@ Proof. eapply Classical_Prop.not_and_or in H0. simpl. invert H0. * eapply Classical_Prop.not_and_or in H1. invert H1. lia. - eapply IHx2. invert H. eauto. + eapply IHx2. invert H. eauto. unfold not. intros. apply H0. eapply filter_In in H1. propositional. * eapply IHx2. invert H. eauto. @@ -1302,7 +1211,7 @@ Proof. unfold result_shape_Z in *. simpl map in *. cases v. rewrite nth_error_empty. auto. simpl map in *. - erewrite filter_In in *. + erewrite filter_In in *. rewrite <- in_mesh_grid_cons__ in H0. posnats. eapply Classical_Prop.not_and_or in H0. simpl. invert H0. @@ -1354,9 +1263,9 @@ Qed. Lemma result_lookup_Z_option_split : forall l k n z args1 sh, In args1 (mesh_grid (map Z.of_nat sh)) -> (0 <= z)%Z -> - (z < n)%Z -> + (z < Z.of_nat n)%Z -> 0 < k -> - result_has_shape (V l) (Z.to_nat n::sh) -> + result_has_shape (V l) (n::sh) -> result_lookup_Z_option ((z / Z.of_nat k)%Z :: (z mod Z.of_nat k)%Z :: args1) (V (split_result k l)) = @@ -1428,23 +1337,23 @@ Proof. cases r0; auto. rewrite Z2Nat.inj_mod by lia. simpl. rewrite Nat2Z.id. lia. - reflexivity. -Qed. +Qed. Lemma result_lookup_Z_option_split_true : forall z z0 x0 l k m sh, negb (is_None (result_lookup_Z_option (z :: z0 :: x0) - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l)))) = + (V (split_result (Z.to_nat k) l)))) = true -> - (0 <= z < m // (eval_Zexpr_Z_total $0 k))%Z -> - (0 <= z0 < eval_Zexpr_Z_total $0 k)%Z -> + (0 <= z < m // k)%Z -> + (0 <= z0 < k)%Z -> (0 <= m)%Z -> In x0 (mesh_grid (map Z.of_nat sh)) -> result_has_shape (V l) (Z.to_nat m::sh) -> - (z * eval_Zexpr_Z_total $0 k + z0 < m)%Z. + (z * k + z0 < m)%Z. Proof. - intros. + intros. erewrite <- result_lookup_Z_option_flatten in H; eauto; try lia. 4: { eapply result_has_shape_split_result. lia. eauto. } 2: { erewrite <- Z2Nat_div_distr by lia. rewrite Z2Nat.id by lia. lia. } @@ -1455,7 +1364,7 @@ Proof. 2 : lia. rewrite Z2Nat.id in * by lia. simpl in H. - cases (z * eval_Zexpr_Z_total $0 k + z0)%Z. + cases (z * k + z0)%Z. 3: { lia. } { cases l. rewrite nth_error_app2 in *. 2: simpl; lia. simpl in H. rewrite mod_0_l in * by lia. rewrite sub_0_r in * by lia. @@ -1467,9 +1376,9 @@ Proof. 2: { lia. } cases (nth_error (repeat (gen_pad sh) - ((Z.to_nat (eval_Zexpr_Z_total $0 k) - - Datatypes.length l mod Z.to_nat (eval_Zexpr_Z_total $0 k)) - mod Z.to_nat (eval_Zexpr_Z_total $0 k))) + ((Z.to_nat k - + Datatypes.length l mod Z.to_nat k) + mod Z.to_nat k)) (Z.to_nat (Z.pos p) - Datatypes.length l)). - pose proof Heq0. eapply nth_error_Some in H6. rewrite nth_error_repeat in Heq0. @@ -1477,5 +1386,4 @@ Proof. rewrite result_lookup_Z_option_gen_pad in *. simpl in *. discriminate. rewrite repeat_length in *. lia. - discriminate. -Qed. - +Qed. diff --git a/src/verified_lowering/proof/Pad.v b/src/verified_lowering/proof/Pad.v index 0d6900e..95babb3 100644 --- a/src/verified_lowering/proof/Pad.v +++ b/src/verified_lowering/proof/Pad.v @@ -18,19 +18,20 @@ From ATL Require Import ATL Map Sets FrapWithoutSets Div Tactics. From Lower Require Import Zexpr Bexpr Array Range Sexpr Result ListMisc Meshgrid VarGeneration Constant ATLDeep ResultToArrayDelta. +Local Hint Resolve nonneg_bounds_includes size_of_includes : core. Open Scope string_scope. Inductive pad_type := | PadCons (l : nat) (l' : nat) (padl : pad_type) (r' : nat) (padr : pad_type) - (r : nat) + (r : nat) | PadNil (b : bool). Fixpoint shape_to_pad_type sh := match sh with | dim::dims => let inner := shape_to_pad_type dims in - PadCons (Z.to_nat dim) 0 inner 0 inner 0 + PadCons dim 0 inner 0 inner 0 | _ => PadNil true end. (* @@ -63,7 +64,7 @@ Inductive is_pad : eval_Zexprlist v l lz -> is_get_pad pads lz (map (eval_Zexpr_Z_total $0) size) -> c $? x = Some size -> - is_pad c v g (Get x l) + is_pad c v g (Get x l) | IsPadMul : forall e1 e2 v g c, is_pad c v g e1 -> is_pad c v g e2 -> @@ -84,176 +85,175 @@ Inductive is_pad : *) (* We should only truncate program-introduced 0-values *) Inductive has_pad : - context -> valuation -> fmap string pad_type -> ATLexpr -> + valuation -> fmap string pad_type -> ATLexpr -> pad_type -> Prop := -| HasPadGen : forall lo hi k c e (l : list Zexpr) v i g ctx pad1 pad2 ll rr, +| HasPadGen : forall lo hi k c e (l : list nat) v i g pad1 pad2 ll rr, (k <= Z.to_nat (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)%Z) -> (c <= Z.to_nat (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)%Z) -> (k + c <= Z.to_nat (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)%Z) -> - size_of e l -> + size_of $0 e l -> (forall iz, (eval_Zexpr_Z_total $0 lo + Z.of_nat k <= iz < eval_Zexpr_Z_total $0 lo + Z.of_nat k + Z.of_nat ll)%Z -> - has_pad ctx (v $+ (i,iz)) g e pad1) -> + has_pad (v $+ (i,iz)) g e pad1) -> (forall iz, (eval_Zexpr_Z_total $0 hi - Z.of_nat c - Z.of_nat rr <= iz < eval_Zexpr_Z_total $0 hi - Z.of_nat c)%Z -> - has_pad ctx (v $+ (i,iz)) g e pad2) -> + has_pad (v $+ (i,iz)) g e pad2) -> (forall iz, (eval_Zexpr_Z_total $0 lo <= iz < eval_Zexpr_Z_total $0 hi)%Z -> (iz - eval_Zexpr_Z_total $0 lo < Z.of_nat k)%Z \/ (eval_Zexpr_Z_total $0 hi - Z.of_nat c <= iz)%Z -> - has_pad ctx (v $+ (i,iz)) g e (shape_to_pad_type - (map (eval_Zexpr_Z_total $0) l))) -> + has_pad (v $+ (i,iz)) g e (shape_to_pad_type l)) -> ll + rr = (Z.to_nat (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo - Z.of_nat k - Z.of_nat c)) -> - has_pad ctx v g (Gen i lo hi e) (PadCons + has_pad v g (Gen i lo hi e) (PadCons k ll pad1 rr pad2 c) -| HasPadGuardFalse : forall v p e sh g ctx pads, +| HasPadGuardFalse : forall v p e sh g pads, eval_Bexpr v p false -> - size_of e sh -> - pads = shape_to_pad_type (map (eval_Zexpr_Z_total $0) sh) -> - has_pad ctx v g (Guard p e) pads -| HasPadGuardTrue : forall v p e l g ctx, - has_pad ctx v g e l -> - has_pad ctx v g (Guard p e) l -| HasPadSumEmpty : forall v i lo hi e l g ctx pads, - size_of e l -> - (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo <= 0)%Z -> - pads = shape_to_pad_type (map (eval_Zexpr_Z_total $0) l) -> - has_pad ctx v g (Sum i lo hi e) pads -| HasPadSum : forall v i lo hi e l g ctx, + size_of $0 e sh -> + pads = shape_to_pad_type sh -> + has_pad v g (Guard p e) pads +| HasPadGuardTrue : forall v p e l g, + has_pad v g e l -> + has_pad v g (Guard p e) l +| HasPadSumEmpty : forall v i lo hi e l g pads, + size_of $0 e l -> + (eval_Zexpr_Z_total v hi - eval_Zexpr_Z_total v lo <= 0)%Z -> + pads = shape_to_pad_type l -> + has_pad v g (Sum i lo hi e) pads +| HasPadSum : forall v i lo hi e l g, (forall iz, - (eval_Zexpr_Z_total $0 lo <= iz < eval_Zexpr_Z_total $0 hi)%Z -> - has_pad ctx (v $+(i,iz)) g e l) -> - (0 < eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)%Z -> - has_pad ctx v g (Sum i lo hi e) l -| HasPadLbind : forall v x e1 e2 l1 l2 g ctx size, - has_pad ctx v g e1 l1 -> - size_of e1 size -> - has_pad (ctx $+ (x,size)) v (g $+ (x,l1)) e2 l2 -> - has_pad ctx v g (Lbind x e1 e2) l2 + (eval_Zexpr_Z_total v lo <= iz < eval_Zexpr_Z_total v hi)%Z -> + has_pad (v $+(i,iz)) g e l) -> + (0 < eval_Zexpr_Z_total v hi - eval_Zexpr_Z_total v lo)%Z -> + has_pad v g (Sum i lo hi e) l +| HasPadLbind : forall v x e1 e2 l1 l2 g size, + has_pad v g e1 l1 -> + size_of $0 e1 size -> + has_pad v (g $+ (x,l1)) e2 l2 -> + has_pad v g (Lbind x e1 e2) l2 | HasPadConcat : forall v e1 e2 x y a b g l1 l2 r1 r2 pad1 pad2 pad3 pad4 - ctx dim1 dim2 rest1 rest2, - size_of e1 (dim1::rest1) -> - size_of e2 (dim2::rest2) -> - has_pad ctx v g e1 (PadCons x l1 pad1 r1 pad2 y) -> - has_pad ctx v g e2 (PadCons a l2 pad3 r2 pad4 b) -> - x+y <= Z.to_nat (eval_Zexpr_Z_total $0 dim1) -> - a+b <= Z.to_nat (eval_Zexpr_Z_total $0 dim2) -> - l1+r1 <= Z.to_nat (eval_Zexpr_Z_total $0 dim1) - x -y -> - l2+r2 <= Z.to_nat (eval_Zexpr_Z_total $0 dim2) - a -b -> - has_pad ctx v g (Concat e1 e2) (PadCons x l1 pad1 r2 pad4 b) -| HasPadFlattenStrong : forall v e x y n m sh g ctx xx yy a b l r c d + dim1 dim2 rest1 rest2, + size_of $0 e1 (dim1::rest1) -> + size_of $0 e2 (dim2::rest2) -> + has_pad v g e1 (PadCons x l1 pad1 r1 pad2 y) -> + has_pad v g e2 (PadCons a l2 pad3 r2 pad4 b) -> + x+y <= dim1 -> + a+b <= dim2 -> + l1+r1 <= dim1 - x -y -> + l2+r2 <= dim2 - a -b -> + has_pad v g (Concat e1 e2) (PadCons x l1 pad1 r2 pad4 b) +| HasPadFlattenStrong : forall v e x y n m sh g xx yy a b l r c d pad1 pad2 pad3 pad4 l1 l2 r1 r2 ll rr, - has_pad ctx v g e (PadCons x l + has_pad v g e (PadCons x l (PadCons a l1 pad1 r1 pad2 c) r (PadCons d l2 pad3 r2 pad4 b) y) -> - size_of e (n::m::sh) -> - x+y < Z.to_nat (eval_Zexpr_Z_total $0 n) -> - l1+r1 <= Z.to_nat (eval_Zexpr_Z_total $0 m) - a - c -> - l2+r2 <= Z.to_nat (eval_Zexpr_Z_total $0 m) - d - b -> - a < Z.to_nat (eval_Zexpr_Z_total $0 m) -> - b < Z.to_nat (eval_Zexpr_Z_total $0 m) -> - xx = x*(Z.to_nat (eval_Zexpr_Z_total $0 m)) + (min 1 l) * a -> - yy = y*(Z.to_nat (eval_Zexpr_Z_total $0 m)) + (min 1 r) * b -> + size_of $0 e (n::m::sh) -> + x+y < n -> + l1+r1 <= m - a - c -> + l2+r2 <= m - d - b -> + a < m -> + b < m -> + xx = x*m + (min 1 l) * a -> + yy = y*m + (min 1 r) * b -> ll = min 1 l * - match a,c,l1 =? Z.to_nat (eval_Zexpr_Z_total $0 m) with - | 0,0,true => l*Z.to_nat (eval_Zexpr_Z_total $0 m) + match a,c,l1 =? m with + | 0,0,true => l*m | _,_,_ => l1 end -> rr = min 1 r * - match d,b,r2 =? Z.to_nat (eval_Zexpr_Z_total $0 m) with - | 0,0,true => r*Z.to_nat (eval_Zexpr_Z_total $0 m) + match d,b,r2 =? m with + | 0,0,true => r*m | _,_,_ => r2 end -> - has_pad ctx v g (Flatten e) (PadCons xx ll pad1 rr pad4 yy) -| HasPadTruncr : forall v k e x y g ctx a l r pad1 pad2, - has_pad ctx v g e (PadCons x l pad1 r pad2 y) -> + has_pad v g (Flatten e) (PadCons xx ll pad1 rr pad4 yy) +| HasPadTruncr : forall v k e x y g a l r pad1 pad2, + has_pad v g e (PadCons x l pad1 r pad2 y) -> (Z.to_nat (eval_Zexpr_Z_total $0 k) <= y) -> a = y- Z.to_nat (eval_Zexpr_Z_total $0 k) -> - has_pad ctx v g (Truncr k e) (PadCons x l pad1 r pad2 a) -| HasPadTruncl : forall v k e x y g ctx b l r pad1 pad2, - has_pad ctx v g e (PadCons x l pad1 r pad2 y) -> + has_pad v g (Truncr k e) (PadCons x l pad1 r pad2 a) +| HasPadTruncl : forall v k e x y g b l r pad1 pad2, + has_pad v g e (PadCons x l pad1 r pad2 y) -> (Z.to_nat (eval_Zexpr_Z_total $0 k) <= x) -> b = x - Z.to_nat (eval_Zexpr_Z_total $0 k) -> - has_pad ctx v g (Truncl k e) (PadCons b l pad1 r pad2 y) -| HasPadPadrEmpty : forall v k e g ctx dim rest pad, - size_of e (dim::rest) -> - has_pad ctx v g e pad -> - (eval_Zexpr_Z_total $0 dim = 0)%Z -> - has_pad ctx v g (Padr k e) (shape_to_pad_type - (map (eval_Zexpr_Z_total $0) (k::rest))) -| HasPadPadlEmpty : forall k e v g ctx dim rest pad, - size_of e (dim::rest) -> - has_pad ctx v g e pad -> - (eval_Zexpr_Z_total $0 dim = 0)%Z -> - has_pad ctx v g (Padl k e) (shape_to_pad_type - (map (eval_Zexpr_Z_total $0) (k::rest))) -| HasPadPadr : forall v k e x y g ctx dim rest l r pad1 pad2 yy, - has_pad ctx v g e (PadCons x l pad1 r pad2 y) -> - size_of e (dim::rest) -> - (0 < eval_Zexpr_Z_total $0 dim)%Z -> + has_pad v g (Truncl k e) (PadCons b l pad1 r pad2 y) +| HasPadPadrEmpty : forall v k e g dim rest pad, + size_of $0 e (dim::rest) -> + has_pad v g e pad -> + dim = 0 -> + has_pad v g (Padr k e) (shape_to_pad_type + (Z.to_nat (eval_Zexpr_Z_total $0 k) :: rest)) +| HasPadPadlEmpty : forall k e v g dim rest pad, + size_of $0 e (dim::rest) -> + has_pad v g e pad -> + dim = 0 -> + has_pad v g (Padl k e) (shape_to_pad_type + (Z.to_nat (eval_Zexpr_Z_total $0 k) :: rest)) +| HasPadPadr : forall v k e x y g dim rest l r pad1 pad2 yy, + has_pad v g e (PadCons x l pad1 r pad2 y) -> + size_of $0 e (dim::rest) -> + 0 < dim -> yy = (y+ Z.to_nat (eval_Zexpr_Z_total $0 k)) -> - x + y <= Z.to_nat (eval_Zexpr_Z_total $0 dim) -> - l + r <= Z.to_nat (eval_Zexpr_Z_total $0 dim) - x -y -> - has_pad ctx v g (Padr k e) (PadCons x l pad1 r pad2 yy) -| HasPadPadl : forall k e x y v g ctx dim rest l r pad1 pad2 xx, - has_pad ctx v g e (PadCons x l pad1 r pad2 y) -> - size_of e (dim::rest) -> - (0 < eval_Zexpr_Z_total $0 dim)%Z -> + x + y <= dim -> + l + r <= dim - x -y -> + has_pad v g (Padr k e) (PadCons x l pad1 r pad2 yy) +| HasPadPadl : forall k e x y v g dim rest l r pad1 pad2 xx, + has_pad v g e (PadCons x l pad1 r pad2 y) -> + size_of $0 e (dim::rest) -> + 0 < dim -> xx = (x+ Z.to_nat (eval_Zexpr_Z_total $0 k)) -> - x + y <= Z.to_nat (eval_Zexpr_Z_total $0 dim) -> - l + r <= Z.to_nat (eval_Zexpr_Z_total $0 dim) - x -y -> - has_pad ctx v g (Padl k e) (PadCons xx l pad1 r pad2 y) + x + y <= dim -> + l + r <= dim - x -y -> + has_pad v g (Padl k e) (PadCons xx l pad1 r pad2 y) (*| HasPadScalar : forall v g s ctx, is_pad ctx v g s -> has_pad ctx v g (Scalar s) (PadNil true) *) -| HasPadScalarNotPad : forall v g s ctx, - has_pad ctx v g (Scalar s) (PadNil false) -| HasPadTransposeStrong : forall v e x y g ctx n xs l r a b c d pad1 pad2 pad3 +| HasPadScalarNotPad : forall v g s, + has_pad v g (Scalar s) (PadNil false) +| HasPadTransposeStrong : forall v e x y g n xs l r a b c d pad1 pad2 pad3 pad4 l1 l2 r1 r2 ll rr m lll rrr, - has_pad ctx v g e (PadCons x l + has_pad v g e (PadCons x l (PadCons a l1 pad1 r1 pad2 c) r (PadCons d l2 pad3 r2 pad4 b) y) -> - size_of e (n::m::xs) -> - l + r >= Z.to_nat (eval_Zexpr_Z_total $0 n) - x - y -> + size_of $0 e (n::m::xs) -> + l + r >= n - x - y -> ll = min a d -> rr = min c b -> - lll + rrr >= Z.to_nat (eval_Zexpr_Z_total $0 m) - ll - rr -> - x + y <= Z.to_nat (eval_Zexpr_Z_total $0 n) -> - has_pad ctx v g (Transpose e) + lll + rrr >= m - ll - rr -> + x + y <= n -> + has_pad v g (Transpose e) (PadCons ll lll (PadCons x 0 pad1 0 pad1 y) rrr (PadCons x 0 pad1 0 pad1 y) rr) -| HasPadTransposeWeak : forall v e x y g ctx n xs l r a b c d +| HasPadTransposeWeak : forall v e x y g n xs l r a b c d pad1 pad2 pad3 pad4 l1 l2 r1 r2 ll rr lll rrr, - has_pad ctx v g e (PadCons x l + has_pad v g e (PadCons x l (PadCons a l1 pad1 r1 pad2 c) r (PadCons d l2 pad3 r2 pad4 b) y) -> - size_of e (n::xs) -> + size_of $0 e (n::xs) -> ll = 0 -> rr = 0 -> lll = min a d -> rrr = min b c -> - has_pad ctx v g (Transpose e) + has_pad v g (Transpose e) (PadCons ll lll (PadCons (x+l) 0 pad1 0 pad1 (y+r)) rrr (PadCons (x+l) 0 pad1 0 pad1 (y+r)) rr) -| HasPadSplit : forall ctx v g e n k c l r pad1 pad2 m sh nn mm, - has_pad ctx v g e (PadCons k l pad1 r pad2 c) -> - size_of e (m::sh) -> - k + c <= Z.to_nat (eval_Zexpr_Z_total $0 m) -> - l + r <= Z.to_nat (eval_Zexpr_Z_total $0 m) - k - c -> +| HasPadSplit : forall v g e n k c l r pad1 pad2 m sh nn mm, + has_pad v g e (PadCons k l pad1 r pad2 c) -> + size_of $0 e (m::sh) -> + k + c <= m -> + l + r <= m - k - c -> nn = (Z.to_nat (eval_Zexpr_Z_total $0 n)) -> - mm = (Z.to_nat (eval_Zexpr_Z_total $0 m)) -> + mm = m -> let cc := c + ((nn - mm mod nn) mod nn) in - has_pad ctx v g (Split n e) + has_pad v g (Split n e) (PadCons (k / nn) (k//n nn - k / nn) (PadCons (k mod nn) @@ -273,7 +273,7 @@ Fixpoint relate_pads (pad : pad_type) e sh := match sh with | _::xs => Forall (fun x => x = gen_pad xs) (firstn a l) /\ Forall (fun x => x = gen_pad xs) (firstn b (rev l)) /\ - Forall (fun r' => relate_pads pad1 r' xs) + Forall (fun r' => relate_pads pad1 r' xs) (firstn ll (skipn a l)) /\ Forall (fun r' => relate_pads pad2 r' xs) (firstn rr (skipn b (rev l))) @@ -293,7 +293,7 @@ Lemma add_result_relate_pads : relate_pads pads r2 rsh -> relate_pads pads r3 rsh. Proof. - eapply (add_result_mut + eapply (add_result_mut (fun r1 r2 r3 H => forall pads rsh, relate_pads pads r1 rsh -> @@ -310,7 +310,7 @@ Proof. (firstn ll (skipn a l3)))); propositional. - cases pads; simpl in *; propositional. - cases b; simpl in *; propositional. + cases b; simpl in *; propositional. invert H2. invert H3. invert a. propositional. - cases pads. simpl in *. @@ -341,7 +341,7 @@ Proof. split. eapply H. eauto. eauto. auto. auto. eauto. eauto. - + rewrite skipn_rev in H5,H8. rewrite skipn_rev. rewrite firstn_rev in H5,H8. rewrite firstn_rev. eapply Forall_rev. eapply Forall_rev in H5,H8. @@ -361,19 +361,17 @@ Proof. specialize H0 with (a:=0). simpl in *. eapply H0. eauto. eauto. invert H1. eauto. invert H2. eauto. + simpl in *. - eapply H0. eauto. eauto. + eapply H0. eauto. eauto. Qed. Lemma relate_pads_gen_pad : forall xs_shape r l0, - relate_pads (shape_to_pad_type (map (eval_Zexpr_Z_total $0) l0)) - r xs_shape-> + relate_pads (shape_to_pad_type l0) r xs_shape-> result_has_shape r xs_shape -> - result_has_shape r (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape r l0 -> r = gen_pad xs_shape. Proof. induct xs_shape; intros. - - invert H0. invert H1. simpl in *. - cases l0; simpl in *; try discriminate. propositional. + - invert H0. invert H1. simpl in *. propositional. - cases r. invert H0. cases l0. invert H1. repeat rewrite map_cons in *. simpl in *. invs. cases a. @@ -382,7 +380,7 @@ Proof. eapply result_has_shape_result_shape_nat in H4,H6. rewrite H4 in H6. clear H4. simpl in H6. - cases (Z.to_nat (eval_Zexpr_Z_total $0 z)). simpl in H6. invert H6. + cases n. simpl in H6. invert H6. simpl in H6. invert H6. simpl. rewrite <- repeat_cons. f_equal. cases v. invert H1. simpl in *. @@ -394,9 +392,7 @@ Proof. Qed. Lemma relate_pads_gen_pad_id : forall size, -relate_pads (shape_to_pad_type (map (eval_Zexpr_Z_total $0) size)) - (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) size))) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) size)). +relate_pads (shape_to_pad_type size) (gen_pad size) size. Proof. induct size; intros; simpl in *. - propositional. @@ -542,7 +538,7 @@ Proof. intros. inversion 1. + cases (Z.to_nat (Z.pos p)). lia. simpl. cases (nth_error r0 n). - 2: { eapply nth_error_None in Heq0. lia. } + 2: { eapply nth_error_None in Heq0. lia. } invert H. cases l. lia. simpl in H4. invert H4. { rewrite <- firstn_skipn with (n:=l) (l:=r0) in Heq0. @@ -576,7 +572,7 @@ Proof. simpl length in *. lia. } eapply nth_error_In in HH. eapply Forall_forall in H7. 2: eassumption. - + cases r2. { eapply result_has_shape_forall in H1. @@ -659,7 +655,7 @@ Proof. 2: { simpl in *. cases b. invs. discriminate. propositional. } cases v. { replace (nth_error r0 n) with (nth_error (r::r0) (Datatypes.S n)) - in Heq0 by auto. + in Heq0 by auto. eapply nth_error_In in Heq0. eapply result_has_shape_forall in H1. eapply Forall_forall in H1. @@ -667,7 +663,7 @@ Proof. invert H1. rewrite <- H0 in H5. simpl in *. propositional. } replace (nth_error r0 n) with (nth_error (r::r0) (Datatypes.S n)) - in Heq0 by auto. + in Heq0 by auto. eapply nth_error_In in Heq0. pose proof H1 as Hsh. eapply result_has_shape_forall in H1. @@ -737,7 +733,7 @@ Proof. eapply mesh_grid_shape_pos in H5. eapply Forall_impl. 2: eassumption. - simpl. lia. + simpl. lia. eapply mesh_grid_shape_pos in H5. eapply Forall_map. eapply Forall_impl. @@ -770,29 +766,23 @@ Lemma minus_plus a b : a + b - a = b. Proof. lia. Qed. Lemma has_pad_size_of_relate_pads_gen_pad : - forall e v size sh g pads, - size_of e size -> - constant_nonneg_bounds e -> - has_pad sh v g e pads -> + forall e v size g pads, + nonneg_bounds $0 e -> + size_of $0 e size -> + has_pad v g e pads -> relate_pads pads - (gen_pad (filter_until - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) size)) 0)) - (filter_until - (map Z.to_nat (map (eval_Zexpr_Z_total $0) size)) 0). + (gen_pad (filter_until size 0)) + (filter_until size 0). Proof. - induct e; intros. - - invert H. invert H0. invert H1. invs. - simpl. rewrite eval_Zexpr_Z_total_sub_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. } - cases (Z.to_nat (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)). + induct e; intros; simpl in *; invs'. + - invert H0. invert H1. invs. + cases (Z.to_nat (hiz - loz)). + simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. - + remember rev. simpl. + + cbn -[rev]. repeat rewrite <- repeat_cons. subst. rewrite rev_repeat. split. eapply forall_firstn. eapply Forall_repeat. eauto. split. eapply forall_firstn. eapply Forall_repeat. eauto. - repeat rewrite skipn_repeat. repeat rewrite firstn_repeat. + repeat rewrite skipn_repeat. repeat rewrite firstn_repeat. cases ll. * rewrite min_0_r. split. econstructor. cases rr. rewrite min_0_r. econstructor. @@ -800,86 +790,65 @@ Proof. Z.of_nat (Datatypes.S rr) <= eval_Zexpr_Z_total $0 hi - Z.of_nat c - Z.of_nat (Datatypes.S rr) < - eval_Zexpr_Z_total $0 hi - Z.of_nat c)%Z) by lia. - eapply H16 in H1. eapply IHe in H1; eauto. + eval_Zexpr_Z_total $0 hi - Z.of_nat c)%Z) as H' by lia. + eapply H19 in H'. eapply IHe in H'; eauto. eapply Forall_repeat. eq_size_of. eauto. * assert (eval_Zexpr_Z_total $0 lo + Z.of_nat k <= eval_Zexpr_Z_total $0 lo + Z.of_nat k < - eval_Zexpr_Z_total $0 lo + Z.of_nat k + Z.of_nat (Datatypes.S ll))%Z. + eval_Zexpr_Z_total $0 lo + Z.of_nat k + Z.of_nat (Datatypes.S ll))%Z as H'. lia. - eapply H14 in H1. - eapply IHe in H1; eauto. + eapply H17 in H'. + eapply IHe in H'; eauto. split. eapply Forall_repeat. eq_size_of. eauto. cases rr. rewrite min_0_r. econstructor. assert ((eval_Zexpr_Z_total $0 hi - Z.of_nat c - Z.of_nat (Datatypes.S rr) <= eval_Zexpr_Z_total $0 hi - Z.of_nat c - Z.of_nat (Datatypes.S rr) < - eval_Zexpr_Z_total $0 hi - Z.of_nat c)%Z) by lia. - eapply H16 in H4. eapply IHe in H4; eauto. + eval_Zexpr_Z_total $0 hi - Z.of_nat c)%Z) as H'' by lia. + eapply H19 in H''. eapply IHe in H''; eauto. eapply Forall_repeat. eq_size_of. eauto. - - invert H. invs. invert H1. + - invert H0. invert H1. + eq_size_of. rewrite <- gen_pad_filter_until_0. eapply relate_pads_filter_until_0. eapply result_has_shape_gen_pad. eapply relate_pads_gen_pad_id. - + invert H0. invs. - eapply IHe. eauto. eauto. eapply (H10 (eval_Zexpr_Z_total $0 lo)). - lia. - - invert H. simpl in *. invert H1. + + eapply IHe. eauto. eauto. apply (H9 (eval_Zexpr_Z_total v lo)). lia. + - invert H0. simpl in *. invert H1. + eq_size_of. rewrite <- gen_pad_filter_until_0. eapply relate_pads_filter_until_0. eapply result_has_shape_gen_pad. eapply relate_pads_gen_pad_id. + eapply IHe; eauto. - - invert H. simpl in *. invs. invert H1. eq_size_of. - eapply IHe2. eauto. eauto. eauto. - - invert H0. invert H. invert H1. - eq_size_of. invert H. invert H0. - pose proof H5. pose proof H6. - eapply constant_nonneg_bounds_size_of_no_vars in H,H0. - invert H. invert H0. rewrite map_cons. - rewrite eval_Zexpr_Z_total_add_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - rewrite map_cons. - pose proof H5. pose proof H6. - eapply constant_nonneg_bounds_size_of_nonneg in H,H0; eauto. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - econstructor; eauto. } - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - econstructor; eauto. } - invert H. invert H0. - rewrite Z2Nat.inj_add by lia. + - invert H0. invert H1. eapply IHe2. eauto. eauto. eauto. + - invert H0. invert H1. + eq_size_of. invs'. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 dim1)). - * cases (Z.to_nat (eval_Zexpr_Z_total $0 dim2)). + cases dim1. + * cases dim2. simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. remember rev. simpl. repeat rewrite <- repeat_cons. subst. rewrite rev_repeat. repeat rewrite skipn_repeat. - repeat rewrite firstn_repeat. simpl in H16. - replace l0 with 0 in * by lia. replace r1 with 0 in * by lia. + repeat rewrite firstn_repeat. + replace l1 with 0 in * by lia. replace r1 with 0 in * by lia. replace x with 0 in * by lia. replace y with 0 in * by lia. repeat rewrite min_0_r. split. simpl. eauto. - repeat rewrite min_r by lia. rewrite H8 in *. - eapply IHe2 in H10; eauto. simpl in H10. - remember rev. - rewrite Heq0 in * . simpl in H10. invs. + repeat rewrite min_r by lia. + eapply IHe2 in H6; eauto. cbn -[rev] in H6. + invs. rewrite <- @repeat_cons in *. rewrite @rev_repeat in *. split. eapply Forall_repeat; eauto. split. econstructor. - repeat rewrite @firstn_repeat in H21. - repeat rewrite @skipn_repeat in H21. - repeat rewrite @firstn_repeat in H21. - rewrite min_r in H21 by lia. eauto. + repeat rewrite @firstn_repeat in *. + repeat rewrite @skipn_repeat in *. + repeat rewrite @firstn_repeat in *. + rewrite min_r in * by lia. eauto. * eapply IHe1 in H5; eauto. eapply IHe2 in H6; eauto. - cases (Z.to_nat (eval_Zexpr_Z_total $0 dim2)). - -- simpl in H5,H6. - rewrite Heq in *. rewrite Heq0 in *. - remember rev. - simpl in H5,H6. clear H6. + cases dim2. + -- cbn -[rev] in H5,H6. + clear H6. simpl. repeat rewrite <- @repeat_cons in *. subst. repeat rewrite @rev_repeat in *. @@ -888,52 +857,32 @@ Proof. repeat rewrite min_r in * by lia. invs. replace a with 0 in * by lia. replace b with 0 in * by lia. - replace l3 with 0 in * by lia. + replace l2 with 0 in * by lia. replace r2 with 0 in * by lia. simpl in *. split. eapply Forall_repeat. eauto. split. eauto. split. eauto. econstructor. - -- simpl in H5,H6. - rewrite Heq in *. rewrite Heq0 in *. - remember rev. - simpl in H5,H6. - simpl. + -- cbn -[rev] in H5,H6. cbn -[rev]. repeat rewrite <- @repeat_cons in *. subst. repeat rewrite @rev_repeat in *. repeat rewrite @skipn_repeat in *. repeat rewrite @firstn_repeat in *. repeat rewrite min_r in * by lia. invs. - rewrite H8 in *. split. eapply Forall_repeat. eauto. split. eapply Forall_repeat. eauto. split. eauto. eauto. - * eauto. - * eauto. - - invert H. simpl in *. invs. - pose proof H0. eapply constant_nonneg_bounds_size_of_nonneg in H; eauto. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - eapply constant_nonneg_bounds_size_of_no_vars; eauto. } - invert H. invert H6. - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H; eauto. - invert H. invert H9. - rewrite eval_Zexpr_Z_total_mul_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - rewrite Z2Nat.inj_mul by lia. - invert H1. eq_size_of. invert H. - eapply IHe in H2; eauto. + - invert H0. simpl in *. invs. + invert H1. eq_size_of. invs'. + eapply IHe in H3; eauto. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n0)). - + lia. - + cases (Z.to_nat (eval_Zexpr_Z_total $0 m0)). + cases n0. + + lia. + + cases m0. * lia. - * simpl in H2. remember rev. - rewrite Heq0,Heq in *. - simpl in H2. simpl. + * cbn -[rev] in H3. cbn -[rev]. repeat rewrite <- @repeat_cons. - repeat rewrite <- repeat_cons in H2. + repeat rewrite <- repeat_cons in H3. subst. repeat rewrite @rev_repeat in *. repeat rewrite @skipn_repeat in *. @@ -942,210 +891,190 @@ Proof. split. eapply Forall_repeat. eauto. split. eapply Forall_repeat. eauto. split. - -- rewrite <- add_succ_l. cases l0. + -- rewrite <- add_succ_l. cases l. ++ rewrite min_0_r in *. simpl in*. econstructor. ++ rewrite (min_l 1) by lia. simpl mul. repeat rewrite add_0_r. cases a. { rewrite add_0_r. cases c. - - cases (l1 =? Datatypes.S n1)%nat. - + eapply Nat.eqb_eq in Heq1. subst. + - cases (l1 =? Datatypes.S m0)%nat. + + eapply Nat.eqb_eq in Heq. subst. replace r1 with 0 in * by lia. - replace (Datatypes.S n1 + n * Datatypes.S n1) with - (Datatypes.S n * Datatypes.S n1) by lia. + replace (Datatypes.S m0 + n0 * Datatypes.S m0) with + (Datatypes.S n0 * Datatypes.S m0) by lia. rewrite <- mul_sub_distr_r. - pose proof H1. - cases (Datatypes.S n - x). lia. - rewrite <- succ_min_distr in H9. - rewrite repeat_cons in H9. invert H9. - clear H20. + pose proof H2 as H4. + cases (Datatypes.S n0 - x). lia. + rewrite <- succ_min_distr in H1. + rewrite repeat_cons in H1. invert H1. + clear H14. repeat rewrite <- @repeat_cons in *. repeat rewrite @rev_repeat in *. - invs. clear H20. simpl skipn in H17. - rewrite <- repeat_cons in H17. - rewrite firstn_all2 in H17. + invs. clear H14. simpl skipn in H11. + rewrite <- repeat_cons in H11. + rewrite firstn_all2 in H11. 2: { rewrite repeat_length. lia. } - invert H17. eapply Forall_repeat. eauto. - + apply Nat.eqb_neq in Heq1. - replace (Datatypes.S n1 + n * Datatypes.S n1) with - (Datatypes.S n * Datatypes.S n1) by lia. + invert H11. eapply Forall_repeat. eauto. + + apply Nat.eqb_neq in Heq. + replace (Datatypes.S m0 + n0 * Datatypes.S m0) with + (Datatypes.S n0 * Datatypes.S m0) by lia. rewrite <- mul_sub_distr_r. - pose proof H1. - cases (Datatypes.S n - x). lia. - rewrite <- succ_min_distr in H9. - rewrite repeat_cons in H9. invert H9. - clear H20. + pose proof H2 as H4. + cases (Datatypes.S n0 - x). lia. + rewrite <- succ_min_distr in H1. + rewrite repeat_cons in H1. invert H1. + clear H14. repeat rewrite <- @repeat_cons in *. repeat rewrite @rev_repeat in *. - invs. clear H20. simpl skipn in H17. - rewrite <- repeat_cons in H17. - rewrite firstn_repeat in H17. + invs. clear H14. simpl skipn in H11. + rewrite <- repeat_cons in H11. + rewrite firstn_repeat in H11. cases l1. econstructor. - rewrite <- succ_min_distr in H17. invert H17. + rewrite <- succ_min_distr in H11. invert H11. eapply Forall_repeat. eauto. - - replace (Datatypes.S n1 + n * Datatypes.S n1) with - (Datatypes.S n * Datatypes.S n1) by lia. + - replace (Datatypes.S m0 + n0 * Datatypes.S m0) with + (Datatypes.S n0 * Datatypes.S m0) by lia. rewrite <- mul_sub_distr_r. - pose proof H1. - cases (Datatypes.S n - x). lia. - rewrite <- succ_min_distr in H9. - rewrite repeat_cons in H9. invert H9. - clear H20. + pose proof H2 as H4. + cases (Datatypes.S n0 - x). lia. + rewrite <- succ_min_distr in H1. + rewrite repeat_cons in H1. invert H1. + clear H14. repeat rewrite <- @repeat_cons in *. repeat rewrite @rev_repeat in *. - invs. clear H20. simpl skipn in H17. - rewrite <- repeat_cons in H17. - rewrite firstn_repeat in H17. + invs. clear H14. simpl skipn in H11. + rewrite <- repeat_cons in H11. + rewrite firstn_repeat in H11. cases l1. econstructor. - rewrite <- succ_min_distr in H17. invert H17. + rewrite <- succ_min_distr in H11. invert H11. eapply Forall_repeat. eauto. } - repeat rewrite (min_r (Datatypes.S n) y) in * by lia. - replace (Datatypes.S n1 + n * Datatypes.S n1) with - (Datatypes.S n * Datatypes.S n1) by lia. + repeat rewrite (min_r (Datatypes.S n0) y) in * by lia. + replace (Datatypes.S m0 + n0 * Datatypes.S m0) with + (Datatypes.S n0 * Datatypes.S m0) by lia. rewrite sub_add_distr. rewrite <- mul_sub_distr_r. - cases (Datatypes.S n - x). lia. - clear H. clear H2. + cases (Datatypes.S n0 - x). lia. + clear H0. clear H3. rewrite <-succ_min_distr in H1. invert H1. rewrite <- @repeat_cons in *. - rewrite rev_repeat in H9. + rewrite rev_repeat in H4. repeat rewrite @skipn_repeat in *. repeat rewrite @firstn_repeat in *. invs. - cases (Datatypes.S n1 - Datatypes.S a). lia. + cases (Datatypes.S m0 - Datatypes.S a). lia. cases l1. rewrite min_0_r. econstructor. rewrite <- succ_min_distr in H1. invert H1. eapply Forall_repeat. eauto. -- rewrite <- add_succ_l. cases r. ++ rewrite min_0_r in *. simpl in*. econstructor. ++ rewrite (min_l 1) by lia. simpl mul. repeat rewrite add_0_r. - repeat rewrite (min_r (Datatypes.S n) y) in * by lia. - repeat rewrite (min_r (Datatypes.S n) x) in * by lia. - replace (Datatypes.S n1 + n * Datatypes.S n1) with - (Datatypes.S n * Datatypes.S n1) by lia. + repeat rewrite (min_r (Datatypes.S n0) y) in * by lia. + repeat rewrite (min_r (Datatypes.S n0) x) in * by lia. + replace (Datatypes.S m0 + n0 * Datatypes.S m0) with + (Datatypes.S n0 * Datatypes.S m0) by lia. rewrite sub_add_distr. rewrite <- mul_sub_distr_r. - cases (Datatypes.S n - y). lia. - clear H. clear H2. - rewrite <-succ_min_distr in H16. invert H16. + cases (Datatypes.S n0 - y). lia. + clear H0. clear H3. + rewrite <-succ_min_distr in H10. invert H10. rewrite <- @repeat_cons in *. - rewrite rev_repeat in H9. + rewrite rev_repeat in *. repeat rewrite @skipn_repeat in *. repeat rewrite @firstn_repeat in *. invs. - cases (Datatypes.S n1 - b). lia. + cases (Datatypes.S m0 - b). lia. cases d. { cases b. - rewrite sub_0_r. cases (r2 =? Datatypes.S n1)%nat. - + eapply Nat.eqb_eq in Heq3. subst. - rewrite <- succ_min_distr in H18. invert H18. + + eapply Nat.eqb_eq in Heq1. subst. + rewrite <- succ_min_distr in *. invert H12. eapply Forall_repeat. eauto. + cases r2. econstructor. - rewrite <- succ_min_distr in H18. invert H18. + rewrite <- succ_min_distr in *. invert H12. eapply Forall_repeat; eauto. - cases r2. rewrite min_0_r. econstructor. - rewrite <- succ_min_distr in H18. invert H18. + rewrite <- succ_min_distr in *. invert H12. eapply Forall_repeat; eauto. - } + } cases r2. rewrite min_0_r. econstructor. - rewrite <- succ_min_distr in H18. invert H18. + rewrite <- succ_min_distr in *. invert H12. eapply Forall_repeat. eauto. - - simpl in *. invs. invert H1. eq_size_of. invert H. - pose proof H0. eapply constant_nonneg_bounds_size_of_no_vars in H; eauto. - invert H. eapply IHe in H5; eauto. simpl in H5. - repeat rewrite map_cons in *. - erewrite eval_Zexpr_Z_total_ceil_div_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - rewrite Z2Nat_div_distr. - 2: { lia. } - 2: { eapply constant_nonneg_bounds_size_of_nonneg in H0. - 2: { eauto. } - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0); eauto. } - invert H0. lia. } + - simpl in *. invs. eq_eval_Z. invert H1. eq_size_of. invert H. + eapply IHe in H5; eauto. simpl in H5. simpl in *. subst. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). - + simpl in *. unfold div_ceil_n at 1. - rewrite div_small by lia. simpl. - unfold div_ceil_n at 1. - rewrite div_small by lia. simpl. + cbv [eval_Zexpr_Z_total] in *. apply eval_Zexpr_Z_eval_Zexpr in H3. + rewrite H3 in *. + cases m. + + unfold div_ceil_n at 1. + rewrite div_small by lia. unfold div_ceil_n. rewrite add_0_l. - rewrite rev_repeat. - rewrite (div_small (Z.to_nat (eval_Zexpr_Z_total $0 k) - 1)) by lia. + rewrite (div_small (Z.to_nat kz - 1)) by lia. simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. - + remember rev. simpl in H5. repeat rewrite <- @repeat_cons in *. - subst. repeat rewrite @rev_repeat in *. subst cc. - cases (Datatypes.S n //n (Z.to_nat (eval_Zexpr_Z_total $0 k))). - assert (0 < Z.to_nat (eval_Zexpr_Z_total $0 k)) by lia. - eapply ndiv_pos with (n:=Datatypes.S n) in H. + + cbn -[rev]. repeat rewrite <- @repeat_cons in *. + subst. repeat rewrite @rev_repeat in *. subst cc. rewrite H3 in *. + cases (Datatypes.S m //n (Z.to_nat kz)). + assert (0 < Z.to_nat kz) by lia. + eapply ndiv_pos with (n:=Datatypes.S m) in H. 2: { lia. } lia. - remember rev. simpl in H5. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). lia. + cases (Z.to_nat kz). lia. simpl gen_pad in *. repeat rewrite <- @repeat_cons in *. subst. repeat rewrite @rev_repeat in *. repeat rewrite @skipn_repeat in *. repeat rewrite @firstn_repeat in *. split. eapply Forall_repeat. reflexivity. split. eapply Forall_repeat. reflexivity. - invs. - clear H. clear H3. - rewrite <- Heq0 in *. rewrite <- Heq1 in *. + cbn -[sub] in H5. + invs. rewrite <- Heq in *. - rewrite Heq1 in *. split. - * remember modulo. remember div. remember sub. + * cbn -[modulo div sub]. remember modulo. remember div. remember sub. simpl. rewrite <- repeat_cons. - subst. rewrite <- Heq1. - cases (k0 //n (Z.to_nat (eval_Zexpr_Z_total $0 k)) - - k0 / Z.to_nat (eval_Zexpr_Z_total $0 k)). + subst. rewrite <- Heq0. + cases (k0 //n (Z.to_nat kz) - + k0 / Z.to_nat kz). -- rewrite min_0_r. econstructor. - -- assert (n2 = 0). + -- assert (n1 = 0). pose proof (ceil_sub_floor_le_1 k0 - (Z.to_nat (eval_Zexpr_Z_total $0 k))). - rewrite Heq2 in H. lia. + (Z.to_nat kz)). + lia. subst. - simpl in *. - cases (k0 mod Z.to_nat (eval_Zexpr_Z_total $0 k)). - pose proof Heq3 as HH. + cases (k0 mod Z.to_nat kz). + pose proof Heq2 as HH. eapply mod_0_iff_ceil_sub_floor_0 in HH. lia. lia. (*k does not divide k0 *) - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - k0). - ++ assert (k0 = Z.to_nat (eval_Zexpr_Z_total $0 m)) by lia. + cases (Datatypes.S m - k0). + ++ assert (k0 = Datatypes.S m) by lia. assert (c = 0) by lia. subst. rewrite sub_0_r in *. - rewrite Heq2. rewrite min_id. + rewrite Heq1. rewrite min_id. econstructor. split. eapply forall_firstn. eapply Forall_repeat. eauto. split. eauto. split; eauto. - replace l0 with 0 in * by lia. + replace l with 0 in * by lia. replace r with 0 in * by lia. rewrite min_0_l. econstructor. econstructor. ++ cases (min - (Z.to_nat (eval_Zexpr_Z_total $0 m) //n - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - - k0 / Z.to_nat (eval_Zexpr_Z_total $0 k)) 1). + (Datatypes.S m //n + (Z.to_nat kz) - + k0 / Z.to_nat kz) 1). econstructor. eapply Forall_repeat. split. eapply forall_firstn. eapply Forall_repeat. eauto. split. auto. split; auto. - cases l0. rewrite min_0_l. econstructor. - rewrite <- succ_min_distr in H1. invert H1. + cases l. rewrite min_0_l. econstructor. + rewrite <- succ_min_distr in *. invs. invert1 H0. eapply forall_firstn. eapply forall_skipn. eapply Forall_repeat. eauto. - * remember rev. remember sub. remember div. remember modulo. - simpl. subst. rewrite <- repeat_cons. - rewrite <- Heq1. - remember (Z.to_nat (eval_Zexpr_Z_total $0 m)) as mm. - remember (Z.to_nat (eval_Zexpr_Z_total $0 k)) as kk. - rewrite min_r in H11 by lia. + * cbn -[rev sub div modulo]. + rewrite <- repeat_cons. + rewrite <- Heq0. + rewrite min_r in * by lia. cases r. -- rewrite min_0_l. simpl firstn. eapply Forall_repeat. split; eauto. split; eauto. eapply forall_firstn. eapply Forall_rev. eapply Forall_repeat. eauto. - -- simpl in H11. invert H11. - remember (Z.to_nat (eval_Zexpr_Z_total $0 m)) as mm. - remember (Z.to_nat (eval_Zexpr_Z_total $0 k)) as kk. + -- simpl in H6. invert1 H6. eapply Forall_repeat. split. eauto. split. eapply forall_firstn. eapply Forall_rev. eapply Forall_repeat. @@ -1153,15 +1082,14 @@ Proof. split. eauto. eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. eapply Forall_repeat. eauto. - - invert H. simpl in *. invert H1. - + eq_size_of. invert H. + - invert H0. simpl in *. invert H1. + + eq_size_of. invs'. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m0)). + cases m0. * simpl in *. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. - * cases (Z.to_nat (eval_Zexpr_Z_total $0 n0)). - -- remember rev. simpl. rewrite <- repeat_cons. - subst. rewrite rev_repeat. + * cases n0. + -- cbn -[rev]. rewrite <- repeat_cons. rewrite rev_repeat. replace x with 0 in * by lia. replace y with 0 in * by lia. rewrite skipn_repeat. repeat rewrite firstn_repeat. split. eapply Forall_repeat. eauto. @@ -1169,8 +1097,7 @@ Proof. split. eapply Forall_repeat. simpl. eauto. rewrite skipn_repeat. rewrite firstn_repeat. eapply Forall_repeat. simpl. eauto. - -- remember rev. simpl. repeat rewrite <- repeat_cons. - subst. repeat rewrite rev_repeat. + -- cbn -[rev]. repeat rewrite <- repeat_cons. repeat rewrite rev_repeat. repeat rewrite skipn_repeat. repeat rewrite firstn_repeat. split. eapply Forall_repeat. reflexivity. split. eapply Forall_repeat. reflexivity. @@ -1185,10 +1112,10 @@ Proof. split. eapply Forall_repeat. reflexivity. eauto. + simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). + cases m. * simpl. repeat rewrite firstn_nil. eauto. * remember rev. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n)). + cases n. -- simpl. repeat rewrite <- repeat_cons. subst. rewrite rev_repeat. repeat rewrite firstn_repeat. split. eauto. split. eauto. @@ -1208,113 +1135,82 @@ Proof. repeat rewrite firstn_repeat. split. eapply Forall_repeat. eauto. split. eapply Forall_repeat. eauto. eauto. - - simpl in *. invs. erewrite size_of_sizeof in * by eauto. - simpl in *. invert H1. - eapply IHe in H6; eauto. - eapply constant_nonneg_bounds_size_of_no_vars in H2; eauto. invert H2. - repeat rewrite map_cons. - rewrite eval_Zexpr_Z_total_sub_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - rewrite Z2Nat.inj_sub by lia. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 n))). + - simpl in *. invs. rewr_sizeof. invs'. eq_eval_Z. invert H1. + cbv [eval_Zexpr_Z_total] in *. + apply eval_Zexpr_Z_eval_Zexpr in H5. rewrite H5 in *. + eapply IHe in H7; eauto. + rename x0 into kz. + cases (m - Z.to_nat kz). { simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } remember gen_pad. simpl. remember rev. rewrite Heqr0. simpl. rewrite <- repeat_cons. subst. rewrite rev_repeat. - repeat rewrite map_cons in H6. - rewrite filter_until_cons in H6 by lia. - simpl in H6. + rewrite filter_until_cons in H7 by lia. + simpl in H7. simpl. repeat rewrite <- repeat_cons. repeat rewrite @rev_repeat in *. repeat rewrite @skipn_repeat in *. repeat rewrite @firstn_repeat in *. invs. split. eapply Forall_repeat. eauto. split. eapply Forall_repeat. eauto. - split. pose proof H1. - { cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - x). - + rewrite <- Heq. simpl in *. rewrite min_l in H6 by lia. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 n) - - x) with 0 by lia. - rewrite min_l by lia. econstructor. + split. + { cases (m - x1). + + rewrite <- Heq. simpl in *. rewrite min_l in * by lia. + replace (m - Z.to_nat kz - x1) with 0 by lia. + constructor. + cases l0. rewrite min_0_r in *. simpl. econstructor. - rewrite <- succ_min_distr in H6. simpl in H6. invert H6. + rewrite <- succ_min_distr in *. simpl in *. invert H1. eapply Forall_repeat. eauto. } - { cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - y). - + rewrite <- Heq. simpl in *. rewrite min_l in H9 by lia. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 n) - - (y - Z.to_nat (eval_Zexpr_Z_total $0 n)))with 0 by lia. - rewrite min_l by lia. econstructor. + { cases (m - y). + + rewrite <- Heq. simpl in *. rewrite min_l in * by lia. + replace (m - Z.to_nat kz - (y - Z.to_nat kz)) with 0 by lia. + constructor. + cases r. rewrite min_0_r in *. simpl. econstructor. - rewrite <- succ_min_distr in H9. simpl in H9. invert H9. + rewrite <- succ_min_distr in *. simpl in *. invert H11. eapply Forall_repeat. eauto. } - - simpl in *. invs. erewrite size_of_sizeof in * by eauto. - simpl in *. invert H1. - eapply IHe in H6; eauto. - eapply constant_nonneg_bounds_size_of_no_vars in H2; eauto. invert H2. - repeat rewrite map_cons. - rewrite eval_Zexpr_Z_total_sub_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - rewrite Z2Nat.inj_sub by lia. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 n))). + - simpl in *. invs. rewr_sizeof. invs'. eq_eval_Z. invert H1. + cbv [eval_Zexpr_Z_total] in *. + apply eval_Zexpr_Z_eval_Zexpr in H5. rewrite H5 in *. + eapply IHe in H7; eauto. rename x0 into kz. + cases (m - Z.to_nat kz). { simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } remember gen_pad. simpl. remember rev. rewrite Heqr0. simpl. rewrite <- repeat_cons. subst. rewrite rev_repeat. - repeat rewrite map_cons in H6. - rewrite filter_until_cons in H6 by lia. - simpl in H6. - simpl. + rewrite filter_until_cons in H7 by lia. + simpl in *. repeat rewrite <- repeat_cons. repeat rewrite @rev_repeat in *. repeat rewrite @skipn_repeat in *. repeat rewrite @firstn_repeat in *. invs. split. eapply Forall_repeat. eauto. split. eapply Forall_repeat. eauto. - split. pose proof H1. - { cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - x). - + rewrite <- Heq. simpl in *. rewrite min_l in H6 by lia. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 n) - - (x-Z.to_nat (eval_Zexpr_Z_total $0 n))) with 0 by lia. - rewrite min_l by lia. econstructor. + split. + { cases (m - x1). + + rewrite <- Heq. simpl in *. rewrite min_l in * by lia. + replace (m - Z.to_nat kz - (x1 - Z.to_nat kz)) with 0 by lia. + constructor. + cases l0. rewrite min_0_r in *. simpl. econstructor. - rewrite <- succ_min_distr in H6. simpl in H6. invert H6. + rewrite <- succ_min_distr in *. simpl in *. invert H1. eapply Forall_repeat. eauto. } - { cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - y). - + rewrite <- Heq. simpl in *. rewrite min_l in H9 by lia. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 n) - y)with 0 by lia. - rewrite min_l by lia. econstructor. + { cases (m - y). + + rewrite <- Heq. simpl in *. rewrite min_l in * by lia. + replace (m - Z.to_nat kz - y) with 0 by lia. + constructor. + cases r. rewrite min_0_r in *. simpl. econstructor. - rewrite <- succ_min_distr in H9. simpl in H9. invert H9. + rewrite <- succ_min_distr in *. simpl in *. invert H11. eapply Forall_repeat. eauto. } - - simpl in *. invs. invert H1. - + eq_size_of. invert H. - repeat rewrite map_cons. - pose proof H2. - eapply constant_nonneg_bounds_size_of_no_vars in H; eauto. invert H. - erewrite eval_Zexpr_Z_total_add_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - rewrite H12. simpl Z.to_nat. - repeat rewrite <- map_cons. + - simpl in *. invs. eq_eval_Z. invert H1. + + cbv [eval_Zexpr_Z_total] in *. + apply eval_Zexpr_Z_eval_Zexpr in H3. rewrite H3 in *. + eq_size_of. invert H. rewrite <- gen_pad_filter_until_0. eapply relate_pads_filter_until_0. - eapply result_has_shape_gen_pad. - eapply relate_pads_gen_pad_id. - + eq_size_of. invert H. - pose proof H2. - eapply constant_nonneg_bounds_size_of_no_vars in H; eauto. invert H. - repeat rewrite map_cons. - erewrite eval_Zexpr_Z_total_add_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - eapply IHe in H5; eauto. + apply result_has_shape_gen_pad. + apply relate_pads_gen_pad_id. + + cbv [eval_Zexpr_Z_total] in *. + apply eval_Zexpr_Z_eval_Zexpr in H3. rewrite H3 in *. + eq_size_of. invs'. + eapply IHe in H8; eauto. repeat rewrite map_cons in *. repeat rewrite filter_until_cons in * by lia. simpl in *. @@ -1322,111 +1218,76 @@ Proof. repeat rewrite @firstn_repeat in *. invs. split. eapply Forall_repeat; eauto. split. eapply Forall_repeat; eauto. - split. cases l0. rewrite min_0_r. econstructor. - rewrite min_r by lia. rewrite min_r in H1 by lia. eauto. - rewrite min_r by lia. rewrite min_r in H10 by lia. eauto. - - simpl in *. invs. invert H1. - + eq_size_of. invert H. - repeat rewrite map_cons. - pose proof H2. - eapply constant_nonneg_bounds_size_of_no_vars in H; eauto. invert H. - erewrite eval_Zexpr_Z_total_add_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - rewrite H12. simpl Z.to_nat. - repeat rewrite <- map_cons. + split. cases l. rewrite min_0_r. econstructor. + rewrite min_r by lia. rewrite min_r in H0 by lia. assumption. + rewrite min_r by lia. rewrite min_r in * by lia. assumption. + - invs. eq_eval_Z. invert H1. + + cbv [eval_Zexpr_Z_total] in *. + apply eval_Zexpr_Z_eval_Zexpr in H3. rewrite H3 in *. + eq_size_of. invert H. rewrite <- gen_pad_filter_until_0. - eapply relate_pads_filter_until_0. - eapply result_has_shape_gen_pad. - eapply relate_pads_gen_pad_id. - + eq_size_of. invert H. - pose proof H2. - eapply constant_nonneg_bounds_size_of_no_vars in H; eauto. invert H. - repeat rewrite map_cons. - erewrite eval_Zexpr_Z_total_add_distr. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - eapply IHe in H5; eauto. - repeat rewrite map_cons in *. + apply relate_pads_filter_until_0. + apply result_has_shape_gen_pad. + apply relate_pads_gen_pad_id. + + cbv [eval_Zexpr_Z_total] in *. + apply eval_Zexpr_Z_eval_Zexpr in H3. rewrite H3 in *. + eq_size_of. invert H. + eapply IHe in H8; eauto. repeat rewrite filter_until_cons in * by lia. simpl in *. repeat rewrite @rev_repeat in *. repeat rewrite @skipn_repeat in *. repeat rewrite @firstn_repeat in *. invs. split. eapply Forall_repeat; eauto. split. eapply Forall_repeat; eauto. - split. cases l0. rewrite min_0_r. econstructor. - rewrite min_r by lia. rewrite min_r in H1 by lia. eauto. - rewrite min_r by lia. rewrite min_r in H10 by lia. eauto. + split. cases l. rewrite min_0_r. econstructor. + rewrite min_r by lia. rewrite min_r in * by lia. assumption. + rewrite min_r by lia. rewrite min_r in * by lia. eauto. - simpl in *. invs. invert H1. + simpl. propositional. Qed. -Lemma has_pad_gen_pad : forall sh v ec r e, - eval_expr sh v ec e r -> - constant_nonneg_bounds e -> +Lemma has_pad_gen_pad : forall v ec r e, + eval_expr v ec e r -> forall rsh pads g, - has_pad sh v g e pads -> + has_pad v g e pads -> result_has_shape r rsh -> (forall pads (x : var) (r0 : result), g $? x = Some pads -> ec $? x = Some r0 -> relate_pads pads r0 (result_shape_nat r0)) -> - (forall (x : var) (r0 : result) (size0 : list Zexpr), - sh $? x = Some size0 -> - ec $? x = Some r0 -> - result_has_shape r0 (map Z.to_nat - (map (eval_Zexpr_Z_total $0) size0))) -> forall size, - size_of e size -> + nonneg_bounds $0 e -> + size_of $0 e size -> relate_pads pads r rsh. Proof. - induct 1; intros Hconst rsh pads g Hpad Hsh (* Hpos *) Hrelate - Hhasshape size Hsize. - 11: { invert Hpad. - invert Hsize. eq_size_of. invert H1. + induct 1; intros rsh pads g Hpad Hsh Hrelate size Hbds Hsize. + 10: { invert Hpad. + invert Hsize. eq_size_of. invs'. simpl in *|-. pose proof H3 as Hsize. - eapply constant_nonneg_bounds_size_of_no_vars in Hsize; eauto. - pose proof Hconst as Hconst'. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in Hconst'. - 2: { eauto. } - 2: { eauto. } - pose proof Hconst as Hconst''. + eapply size_of_includes in Hsize. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize; eauto. - assert (0 < eval_Zexpr_Z_total $0 n0 \/ eval_Zexpr_Z_total $0 n0 <= 0)%Z - as Hcasen by lia. - assert (0 < eval_Zexpr_Z_total $0 m0 \/ eval_Zexpr_Z_total $0 m0 <= 0)%Z - as Hcasem by lia. + assert (0 < n0 \/ n0 = 0) as Hcasen by lia. + assert (0 < m0 \/ m0 = 0) as Hcasem by lia. inversion Hcasen as [ Hcasen1 | Hcasen2 ]; clear Hcasen. - 2: { eapply constant_nonneg_bounds_size_of_nonneg in Hconst''; eauto. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total - with (v:=$0); eauto. } - invert Hconst''. invert H11. - assert (eval_Zexpr_Z_total $0 n0 = 0)%Z by lia. simpl in *. - rewrite H1 in *. invert Hconst'. simpl in *. invert Hsh. + 2: { subst. simpl in *. invert Hsh. repeat rewrite firstn_nil. repeat rewrite skipn_nil. simpl. repeat rewrite firstn_nil. simpl. - propositional; econstructor. } + propositional; econstructor. lia. } inversion Hcasem as [ Hcasem1 | Hcasem2 ]; clear Hcasem. - 2: { eapply constant_nonneg_bounds_size_of_nonneg in Hconst''; eauto. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total - with (v:=$0); eauto. } - invert Hconst''. invert H11. - assert (eval_Zexpr_Z_total $0 m0 = 0)%Z by lia. simpl in *. - rewrite H1 in *. - eapply result_has_shape_flatten in Hconst'. + 2: { subst. eapply result_has_shape_flatten in Hsize. simpl in *. rewrite mul_0_r in *. - eapply result_has_shape_result_shape_nat in Hsh,Hconst'. - rewrite Hsh in Hconst'. simpl in Hconst'. + eapply result_has_shape_result_shape_nat in Hsh,Hsize. + rewrite Hsh in Hsize. simpl in Hsize. cases rsh. simpl in *. discriminate. simpl in *. rewrite mul_0_r. - + cases n. - - simpl in *. + - simpl in *. cases (flatten_result l). simpl in *. eauto. repeat rewrite firstn_nil. repeat rewrite skipn_nil. simpl. @@ -1434,41 +1295,36 @@ Proof. propositional; econstructor. simpl in *. invert Hsh. - - invert Hconst'. } + - invert Hsize. } simpl in *|-. - pose proof Hconst' as Hsh'. + pose proof Hsize as Hsh'. + pose proof Hsize as Hsh'''. pose proof Hsh as Hsh''. - + eapply result_has_shape_flatten in Hsh'. eapply result_has_shape_result_shape_nat in Hsh', Hsh''. rewrite Hsh' in Hsh''. cases rsh. simpl in *. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n0) * - Z.to_nat (eval_Zexpr_Z_total $0 m0)); - simpl in *; try discriminate. + cases (n0 * m0); + simpl in *; discriminate. cases n. simpl in Hsh''. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n0) * - Z.to_nat (eval_Zexpr_Z_total $0 m0)). lia. + cases (n0 * m0). lia. simpl in Hsh''. invert Hsh''. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n0) * - Z.to_nat (eval_Zexpr_Z_total $0 m0)). lia. + cases (n0 * m0). lia. simpl in Hsh''. invert Hsh''. clear Hsh'. rewrite <- Heq in *. clear Heq. clear n. - - eapply IHeval_expr in Hconst''. - 3: { eauto. } + + eapply IHeval_expr in Hsize. 3: { eauto. } 3: { eauto. } 2: { eauto. } - 2: { eauto. } - repeat rewrite map_cons in *. - simpl in Hconst''. + simpl in Hsize. invs. rewrite <- gen_pad_cons in *. @@ -1478,13 +1334,12 @@ Proof. rewrite <- gen_pad_filter_until_0. split. - rewrite <- (firstn_skipn (x * Z.to_nat (eval_Zexpr_Z_total $0 m0)) - (flatten_result l)). + rewrite <- (firstn_skipn (x * m0) (flatten_result l)). rewrite firstn_app. rewrite length_firstn. erewrite result_has_shape_length. 2: { eauto. } rewrite mul_min_distr_r. - replace (min x (Z.to_nat (eval_Zexpr_Z_total $0 n0))) with x by lia. + replace (min x n0) with x by lia. rewrite minus_plus. rewrite firstn_all2. 2: { rewrite length_firstn. erewrite result_has_shape_length by eauto. @@ -1495,11 +1350,11 @@ Proof. eapply Forall_app. split. - eapply forall_firstn_flatten_result. eauto. eauto. + eapply forall_firstn_flatten_result. eauto. eauto. eauto. { erewrite skipn_stride_flatten_result by eauto. cases l0. - - simpl in *. + - simpl in *. rewrite min_r by lia. simpl. eauto. - rewrite min_l by lia. simpl. rewrite add_0_r. eapply forall_firstn_flatten_result_lt. @@ -1511,13 +1366,12 @@ Proof. lia. } split. - rewrite <- (firstn_skipn (y * Z.to_nat (eval_Zexpr_Z_total $0 m0)) - (rev (flatten_result l))). + rewrite <- (firstn_skipn (y * m0) (rev (flatten_result l))). rewrite firstn_app. rewrite length_firstn. rewrite length_rev. erewrite result_has_shape_length. 2: { eauto. } rewrite mul_min_distr_r. - replace (min y (Z.to_nat (eval_Zexpr_Z_total $0 n0))) with y by lia. + replace (min y n0) with y by lia. rewrite minus_plus. rewrite firstn_all2. 2: { rewrite length_firstn. @@ -1533,7 +1387,7 @@ Proof. erewrite firstn_stride_flatten_result. 2: { eauto. } rewrite <- (rev_involutive (firstn _ l)). - replace (Z.to_nat (eval_Zexpr_Z_total $0 n0)) with (length l). + replace n0 with (length l). 2: { erewrite result_has_shape_length. reflexivity. eauto. } rewrite <- skipn_rev. cases r. @@ -1556,7 +1410,7 @@ Proof. rewrite <- mul_sub_distr_r. erewrite firstn_stride_flatten_result by eauto. rewrite <- (rev_involutive (firstn _ l)). - replace (Z.to_nat (eval_Zexpr_Z_total $0 n0)) with (length l). + replace n0 with (length l). 2: { erewrite result_has_shape_length. reflexivity. eauto. } rewrite <- skipn_rev. @@ -1566,12 +1420,10 @@ Proof. - simpl. rewrite min_l by lia. simpl. repeat rewrite add_0_r. cases a. { simpl. cases c. - - simpl. cases (l1 =? Z.to_nat (eval_Zexpr_Z_total $0 m0))%nat. + - simpl. cases (l1 =? m0)%nat. + eapply Nat.eqb_eq in Heq. subst. replace r1 with 0 in * by lia. clear H13. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m0) + - l0 * Z.to_nat (eval_Zexpr_Z_total $0 m0)) with - (Datatypes.S l0 * Z.to_nat (eval_Zexpr_Z_total $0 m0)) by lia. + replace (m0 + l0 * m0) with (Datatypes.S l0 * m0) by lia. erewrite firstn_stride_flatten_result. 2: { eapply forall_result_has_shape. eapply forall_skipn. eapply result_has_shape_forall. eauto. reflexivity. } @@ -1580,7 +1432,7 @@ Proof. eapply Forall_forall. intros. eapply Forall_forall in H9. 2: eassumption. cases x0. propositional. invs. - eapply result_has_shape_forall in Hconst'. + eapply result_has_shape_forall in Hsh'''. eapply Forall_forall in H12. 2: { eapply forall_firstn. eapply forall_skipn. eauto. } simpl in H12. @@ -1609,13 +1461,13 @@ Proof. eapply Forall_forall. intros. eapply Forall_forall in H9. 2: eassumption. cases x0. propositional. invs. - eapply result_has_shape_forall in Hconst'. + eapply result_has_shape_forall in Hsh'''. eapply Forall_forall in H12. 2: { eapply forall_firstn. eapply forall_skipn. - eapply Hconst'. } + eapply Hsh'''. } simpl in *. eapply Forall_forall. intros. eapply Forall_forall in H15. - 2: eassumption. + 2: eassumption. eapply result_has_shape_forall in H12. eapply Forall_forall in H16. 2: { eapply forall_firstn. eapply H12. } @@ -1638,12 +1490,12 @@ Proof. eapply Forall_forall. intros. eapply Forall_forall in H9. 2: eassumption. cases x0. propositional. invs. - eapply result_has_shape_forall in Hconst'. + eapply result_has_shape_forall in Hsh'''. eapply Forall_forall in H1. 2: { eapply forall_firstn. eapply forall_skipn. - eapply Hconst'. } + eapply Hsh'''. } eapply Forall_forall. intros. eapply Forall_forall in H12. - 2: eassumption. + 2: eassumption. eapply result_has_shape_forall in H1. eapply Forall_forall in H14. 2: { eapply forall_firstn. eapply forall_skipn. eapply H1. } @@ -1653,7 +1505,7 @@ Proof. erewrite <- result_has_shape_filter_until_0. eauto. rewrite <- H10. eapply relate_pads_filter_until_0. - eauto. eauto. } + eauto. eauto. } eapply forall_firstn_skipn_flatten_result. eapply Forall_forall. intros. eapply Forall_forall in H9. 2: { eassumption. } @@ -1668,7 +1520,7 @@ Proof. 2: { eapply forall_firstn. eapply forall_skipn. eapply Forall_forall in H12. 2: { eapply forall_firstn. eapply forall_skipn. - eapply result_has_shape_forall. apply Hconst'. } + eapply result_has_shape_forall. apply Hsh'''. } simpl in H12. eapply result_has_shape_forall. eapply H12. } simpl in H16. eapply relate_pads_filter_until_0. @@ -1676,17 +1528,15 @@ Proof. erewrite <- result_has_shape_filter_until_0. auto. rewrite <- H10. eapply relate_pads_filter_until_0. eauto. eauto. } - + cases r. simpl in *. rewrite min_r by lia. simpl. auto. rewrite min_l by lia. simpl. repeat rewrite add_0_r. cases d. { cases b. - - cases (r2 =? Z.to_nat (eval_Zexpr_Z_total $0 m0))%nat. + - cases (r2 =? m0)%nat. + eapply Nat.eqb_eq in Heq. subst. simpl. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m0) + - r * Z.to_nat (eval_Zexpr_Z_total $0 m0)) with - (Datatypes.S r * Z.to_nat (eval_Zexpr_Z_total $0 m0)) by lia. + replace (m0 + r * m0) with (Datatypes.S r * m0) by lia. clear H9. remember (skipn y (rev l)). rewrite firstn_rev. subst. erewrite result_has_shape_length. @@ -1706,8 +1556,7 @@ Proof. rewrite skipn_rev. rewrite length_skipn. rewrite length_rev. erewrite result_has_shape_length by eauto. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n0) - y - - Datatypes.S r). simpl. + cases (n0 - y - Datatypes.S r). simpl. * rewrite sub_0_r. rewrite firstn_all2 in H13. 2: { rewrite length_skipn. rewrite length_rev. @@ -1721,9 +1570,9 @@ Proof. eapply result_has_shape_forall. eauto. reflexivity. } eapply Forall_forall. intros. eapply Forall_forall in H13. 2: eassumption. cases x0. propositional. invs. - eapply result_has_shape_forall in Hconst'. + eapply result_has_shape_forall in Hsh'''. eapply Forall_forall in H9. - 2: { eapply forall_skipn. eapply Forall_rev. eapply Hconst'. } + 2: { eapply forall_skipn. eapply Forall_rev. eapply Hsh'''. } simpl in *. rewrite firstn_all2 in H16. 2: { rewrite length_rev. @@ -1739,20 +1588,18 @@ Proof. rewrite <- H10. eapply relate_pads_filter_until_0; eauto. * rewrite <- Heq. - replace (Z.to_nat (eval_Zexpr_Z_total $0 n0) - y - - (Z.to_nat (eval_Zexpr_Z_total $0 n0) - y - - Datatypes.S r)) with - (Datatypes.S r) by lia. + replace (n0 - y - (n0 - y - Datatypes.S r)) with + (Datatypes.S r) by lia. eapply forall_flatten_result_rev. 2: { eapply forall_result_has_shape. eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. eapply result_has_shape_forall. eauto. reflexivity. } eapply Forall_forall. intros. eapply Forall_forall in H13. 2: eassumption. cases x0. propositional. invs. - eapply result_has_shape_forall in Hconst'. + eapply result_has_shape_forall in Hsh'''. eapply Forall_forall in H9. 2: { eapply forall_firstn. - eapply forall_skipn. eapply Forall_rev. eapply Hconst'. } + eapply forall_skipn. eapply Forall_rev. eapply Hsh'''. } simpl in *. rewrite firstn_all2 in H16. 2: { rewrite length_rev. @@ -1777,10 +1624,10 @@ Proof. invs. eapply Forall_forall. intros. eapply Forall_forall in H17. 2: eassumption. - eapply result_has_shape_forall in Hconst'. + eapply result_has_shape_forall in Hsh'''. eapply Forall_forall in H12. 2: { eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. - eapply Hconst'. } + eapply Hsh'''. } simpl in H12. eapply result_has_shape_forall in H12. eapply Forall_forall in H16. 2: { eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. @@ -1802,10 +1649,10 @@ Proof. invs. eapply Forall_forall. intros. eapply Forall_forall in H17. 2: eassumption. - eapply result_has_shape_forall in Hconst'. + eapply result_has_shape_forall in Hsh'''. eapply Forall_forall in H12. 2: { eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. - eapply Hconst'. } + eapply Hsh'''. } simpl in H12. eapply result_has_shape_forall in H12. eapply Forall_forall in H16. 2: { eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. @@ -1834,49 +1681,48 @@ Proof. eapply Forall_forall in H12. 2: { eapply forall_firstn. eapply forall_skipn. eapply result_has_shape_forall. - eapply result_has_shape_rev. apply Hconst'. } + eapply result_has_shape_rev. apply Hsh'''. } simpl in H12. eapply result_has_shape_forall. eapply H12. } simpl in H16. eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. rewrite <- H10. erewrite <- result_has_shape_filter_until_0. auto. rewrite <- H10. - eapply relate_pads_filter_until_0. eauto. eauto. } - 11: { (* SPLIT *) - simpl in *. invs. invert Hpad. eq_size_of. invert H2. - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H2; eauto. invert H2. - pose proof H3. - eapply constant_nonneg_bounds_size_of_nonneg in H2; eauto. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total with (v:=$0). - econstructor; eauto. } - invert H2. - pose proof H3. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. + eapply relate_pads_filter_until_0. eauto. eauto. eauto. } + 10: { (* SPLIT *) + simpl in *. invs. eq_eval_Z. invert Hpad. eq_size_of. invs'. + rename H2 into Hk. pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'. 2: apply empty_includes. + eapply eval_Zexpr_deterministic in Hk'. 2: apply eval_Zexpr_Z_eval_Zexpr; eassumption. + subst. clear H0. + cbv [eval_Zexpr_Z_total] in *. + apply eval_Zexpr_Z_eval_Zexpr in Hk. rewrite Hk in *. rename kz0 into kz. + pose proof H8 as Hsh'''. + eapply size_of_includes in Hsh'''. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh'''; eauto. repeat rewrite map_cons in *. pose proof H6 as HP. eapply IHeval_expr in H6; eauto. simpl in *. cases rsh. invert Hsh. - pose proof Hsh as Hsh'. pose proof H2 as Hsh''. + pose proof Hsh as Hsh'. pose proof Hsh''' as Hsh''. eapply result_has_shape_split_result in Hsh''. eapply result_has_shape_result_shape_nat in Hsh',Hsh''. rewrite Hsh' in Hsh''. - pose proof H2 as Hlen. + pose proof Hsh''' as Hlen. eapply result_has_shape_length in Hlen. symmetry in Hsh''. - pose proof H2 as HH. + pose proof Hsh''' as HH. eapply result_has_shape_split_result - with (k:=(Z.to_nat (eval_Zexpr_Z_total $0 k))) in HH. + with (k:=(Z.to_nat kz)) in HH. pose proof HH as HHH. eapply result_has_shape_result_shape_nat in HHH. pose proof Hsh as HHHH. eapply result_has_shape_result_shape_nat in HHHH. rewrite HHH in HHHH. - subst cc. 2: lia. 2: lia. + subst cc. rewrite Hk in *. 2: lia. 2: lia. cases l. - { simpl. unfold split_result. simpl. + { simpl. unfold split_result. simpl. unfold div_ceil_n. - rewrite (div_small (0 + Z.to_nat (eval_Zexpr_Z_total $0 k) - 1)) by lia. + rewrite (div_small (0 + Z.to_nat kz - 1)) by lia. unfold nat_range. simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } erewrite filter_until_cons in Hsh''. @@ -1885,7 +1731,7 @@ Proof. cases n. simpl in Hsh''. invert Hsh''. simpl in Hsh''. invert Hsh''. invs. - erewrite gen_pad_filter_until_0. rewrite <- H15. + erewrite gen_pad_filter_until_0. rewrite <- H3. rewrite <- filter_until_cons by lia. erewrite <- gen_pad_filter_until_0. split. @@ -1893,19 +1739,19 @@ Proof. eapply forall_gen_pad_flatten_result. eapply forall_result_has_shape. eapply forall_firstn. eapply result_has_shape_forall. - pose proof Hsh. eapply result_has_shape_filter_until_0 in H17. - rewrite filter_until_0_cons in H17 by lia. - rewrite <- H15 in H17. - rewrite <- filter_until_0_cons in H17 by lia. - rewrite <- filter_until_0_cons in H17 by lia. - erewrite <- result_has_shape_filter_until_0 in H17. eauto. + pose proof Hsh as Hsh''. eapply result_has_shape_filter_until_0 in Hsh''. + rewrite filter_until_0_cons in Hsh'' by lia. + rewrite <- H3 in Hsh''. + rewrite <- filter_until_0_cons in Hsh'' by lia. + rewrite <- filter_until_0_cons in Hsh'' by lia. + erewrite <- result_has_shape_filter_until_0 in Hsh''. eauto. reflexivity. erewrite firstn_split_result. 2: lia. 2: { erewrite result_has_shape_length by eauto. pose proof (div_mul_upper_bound k0 - (Z.to_nat (eval_Zexpr_Z_total $0 k))). lia. } + (Z.to_nat kz)). lia. } 2: { eauto. } eapply forall_firstn_ge. eassumption. eapply div_mul_upper_bound. lia. } @@ -1915,43 +1761,44 @@ Proof. eapply forall_result_has_shape. eapply forall_firstn. eapply Forall_rev. eapply result_has_shape_forall. - pose proof Hsh. eapply result_has_shape_filter_until_0 in H17. - rewrite filter_until_0_cons in H17 by lia. - rewrite <- H15 in H17. - rewrite <- filter_until_0_cons in H17 by lia. - rewrite <- filter_until_0_cons in H17 by lia. - erewrite <- result_has_shape_filter_until_0 in H17. eauto. + pose proof Hsh as Hsh''. eapply result_has_shape_filter_until_0 in Hsh''. + rewrite filter_until_0_cons in Hsh'' by lia. + rewrite <- H3 in Hsh''. + rewrite <- filter_until_0_cons in Hsh'' by lia. + rewrite <- filter_until_0_cons in Hsh'' by lia. + erewrite <- result_has_shape_filter_until_0 in Hsh''. eauto. reflexivity. unfold split_result. simpl. rewrite app_comm_cons. rewrite <- map_rev. erewrite (map_extensionality (rev _)). - 2: { intros. eapply in_rev in H17. + 2: { intros. eapply in_rev in H7. rewrite skipn_app. rewrite firstn_app. rewrite skipn_repeat. rewrite firstn_repeat. - replace (Z.to_nat (eval_Zexpr_Z_total $0 k) * x - + replace (Z.to_nat kz * x - length (r0 :: l)) with 0. - 2: { eapply In_nat_range in H17. simpl length. + 2: { eapply In_nat_range in H7. simpl length. erewrite (Nat.div_mod_eq (Datatypes.S (length l)) - (Z.to_nat (eval_Zexpr_Z_total $0 k))). + (Z.to_nat kz)). rewrite sub_add_distr. rewrite <- mul_sub_distr_l. replace (x - Datatypes.S (length l) / - Z.to_nat (eval_Zexpr_Z_total $0 k)) with 0. + Z.to_nat kz) with 0. lia. pose proof (ceil_sub_floor_le_1 (Datatypes.S (Datatypes.length l)) - (Z.to_nat (eval_Zexpr_Z_total $0 k))). + (Z.to_nat kz)). lia. } rewrite sub_0_r. rewrite length_skipn. reflexivity. } rewrite firstn_map. unfold nat_range. rewrite firstn_rev_nat_range_rec. rewrite add_0_l. - remember (Z.to_nat (eval_Zexpr_Z_total $0 k)) as kk. - remember (Z.to_nat (eval_Zexpr_Z_total $0 m)) as mm. - simpl length in *. rewrite map_rev. + remember (Z.to_nat kz) as kk. + cbn [length] in *. + remember (Datatypes.S (length l)) as mm. + rewrite map_rev. cases (mm mod kk). 2: { (* k does not divide m *) - rewrite <- Heq. rewrite Hlen. + rewrite <- Heq. rewrite min_l. 2: { replace (mm //n kk) with (mm/kk + 1)%nat. rewrite (Nat.div_mod_eq c kk). @@ -1963,7 +1810,7 @@ Proof. enough (c / kk <= mm / kk) by lia. eapply div_le_mono. lia. lia. enough (c / kk <= mm / kk) by lia. - eapply div_le_mono. lia. lia. + eapply div_le_mono. lia. lia. cases (mm //n kk - mm / kk). eapply mod_0_iff_ceil_sub_floor_0 in Heq0. lia. lia. pose proof (ceil_sub_floor_le_1 mm kk). lia. } @@ -1979,8 +1826,8 @@ Proof. rewrite (Nat.div_mod_eq c kk). rewrite <- add_assoc. rewrite mul_comm. rewrite div_add_l by lia. pose proof (add_mod_div_bound c (kk- mm mod kk) kk). - assert (c <= mm) by lia. - eapply div_le_mono with (c:=kk) in H19. 2: lia. + assert (c <= mm) as Hcmm by lia. + eapply div_le_mono with (c:=kk) in Hcmm. 2: lia. lia. } rewrite <- add_sub_swap by lia. @@ -1994,15 +1841,14 @@ Proof. rewrite min_l. 2: { eapply mod_le. lia. } erewrite map_nat_range_rec_extensionality. - 2: { intros. cases H17. - rewrite add_sub_assoc in H19. + 2: { intros ? (?&?). rewrite add_sub_assoc in *. 2: { rewrite (Nat.div_mod_eq c kk). rewrite <- add_assoc. rewrite mul_comm. rewrite div_add_l by lia. pose proof (add_mod_div_bound c (kk- mm mod kk) kk). - assert (c <= mm) by lia. - eapply div_le_mono with (c:=kk) in H21. 2: lia. lia. } - rewrite <- add_sub_swap in H19 by lia. - rewrite add_assoc in H19. + assert (c <= mm) as Hcmm by lia. + eapply div_le_mono with (c:=kk) in Hcmm. 2: lia. lia. } + rewrite <- add_sub_swap in * by lia. + rewrite add_assoc in *. rewrite add_sub in *. rewrite minus_plus in *. rewrite (Nat.div_mod_eq mm kk) at 2. rewrite add_sub_swap. @@ -2018,21 +1864,21 @@ Proof. - replace (kk * (mm / kk)) with (length (r0::l) - (length (r0::l) - (kk * (mm / kk)))). 2: { rewrite sub_sub_distr. - lia. simpl length. rewrite Hlen. + lia. simpl length. rewrite <- Heqmm. rewrite (Nat.div_mod_eq mm kk) at 2. lia. lia. } rewrite <- (rev_involutive (skipn _ _)). - rewrite <- firstn_rev. simpl length. rewrite Hlen. + rewrite <- firstn_rev. simpl length. rewrite <- Heqmm. rewrite <- mod_eq. rewrite firstn_all2. 2: { rewrite length_rev. rewrite length_firstn. pose proof (Nat.mod_upper_bound mm kk). lia. } eapply Forall_rev. eapply forall_firstn_ge. eauto. assert ((c + (kk - mm mod kk) mod kk) < kk \/ - kk <= (c + (kk - mm mod kk) mod kk)). lia. + kk <= (c + (kk - mm mod kk) mod kk)) as H17 by lia. cases H17. eapply div_small_iff in H17. lia. lia. rewrite <- (mod_id mm kk) in H17 at 1. lia. lia. lia. lia. - - invert H2. eapply result_has_shape_result_shape_nat in H23. - rewrite H23. rewrite <- gen_pad_filter_until_0. + - invert Hsh'''. eapply result_has_shape_result_shape_nat in H16. + rewrite H16. rewrite <- gen_pad_filter_until_0. eapply Forall_repeat. eauto. - eapply forall_flatten_result_rev_all. rewrite rev_involutive. 2: { eapply Forall_rev. eapply Forall_map. eapply Forall_forall. @@ -2042,20 +1888,20 @@ Proof. rewrite skipn_app. rewrite firstn_app. rewrite length_skipn. rewrite length_firstn. rewrite <- (rev_involutive (skipn _ (r0::l))). - rewrite <- firstn_rev. + rewrite <- firstn_rev. rewrite Forall_app. split. - 2: { simpl length. rewrite Hlen. + 2: { simpl length. rewrite <- Heqmm. rewrite (min_l (mm-c)) by lia. eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. eauto. } - simpl length. rewrite Hlen. + simpl length. rewrite <- Heqmm. rewrite skipn_all2. rewrite firstn_nil. econstructor. rewrite length_firstn. simpl length. rewrite min_l by lia. rewrite mul_sub_distr_r. rewrite mul_add_distr_r. rewrite (Nat.div_mod_eq mm kk) at 1. rewrite mul_comm. assert ((c + (kk - mm mod kk) mod kk) < kk \/ - kk <= (c + (kk - mm mod kk) mod kk)). lia. + kk <= (c + (kk - mm mod kk) mod kk)) as H17 by lia. cases H17. eapply div_small_iff in H17. lia. lia. rewrite <- (mod_id mm kk) in H17 at 1. rewrite (Nat.add_comm (mm mod kk)) in H17. @@ -2087,29 +1933,25 @@ Proof. eapply le_trans. 2: { eapply sub_le_mono_l. eapply div_mul_upper_bound. lia. } - lia. + lia. } - { (* k divides m *) + { (* k divides m *) rewrite sub_0_r in *. rewrite mod_same by lia. rewrite add_0_r. - rewrite Hlen. rewrite min_l. 2: { eapply mod_0_iff_ceil_eq_floor_0 in Heq. rewrite Heq. eapply div_le_mono. lia. lia. lia. } cases (c / kk). simpl. econstructor. rewrite succ_nat_range_rec_app_end. rewrite map_app. - simpl map at 4. rewrite <- Heq0. erewrite map_nat_range_rec_extensionality. - 2: { intros. rewrite Heq. rewrite sub_0_r. rewrite mod_same by lia. - rewrite min_0_l. simpl. rewrite app_nil_r. reflexivity. } - repeat rewrite mul_add_distr_l. repeat rewrite mul_sub_distr_l. - rewrite Heq. rewrite sub_0_r. rewrite mod_same. rewrite min_0_l. - simpl repeat. rewrite app_nil_r. + 2: { intros. rewrite min_0_l. simpl. rewrite app_nil_r. reflexivity. } + simpl. repeat rewrite mul_add_distr_l. repeat rewrite mul_sub_distr_l. + rewrite Heq0. rewrite min_0_l. simpl repeat. rewrite app_nil_r. replace (mm //n kk) with (mm / kk). 2: { eapply mod_0_iff_ceil_eq_floor_0 in Heq. rewrite Heq. auto. lia. } - pose proof Heq. - eapply div_exact in H17. rewrite <- H17. rewrite Heq0. + pose proof Heq as H17. + eapply div_exact in H17. rewrite <- H17. rewrite (mul_comm _ (Datatypes.S _)). simpl. rewrite sub_add_distr. 2: lia. rewrite mul_comm. rewrite <- Heq0. @@ -2121,8 +1963,8 @@ Proof. rewrite <- Heq0. rewrite add_sub_assoc. 2: { rewrite <- H17. - assert (kk <= mm \/ mm < kk) by lia. inversion H19. - lia. eapply div_small in H20. rewrite H20 in H17. + assert (kk <= mm \/ mm < kk) as H19 by lia. inversion H19. + lia. eapply div_small in H7. rewrite H7 in *. rewrite mul_0_r in *. lia. } rewrite mul_comm. rewrite minus_plus. @@ -2134,28 +1976,27 @@ Proof. rewrite Forall_map. split. eapply Forall_forall. intros. auto. eauto. } - 2: { lia. } erewrite flatten_result_app. simpl. rewrite app_nil_r. rewrite flatten_result_nat_range_rec. rewrite mul_sub_distr_r. rewrite (mul_comm (mm/kk) kk). rewrite <- H17. - rewrite <- Hlen at 1. + rewrite Heqmm at 1. replace (Datatypes.S (length l)) with (length (r0::l)) by reflexivity. - rewrite <- (rev_involutive (skipn _ _)). + rewrite <- (rev_involutive (skipn _ _)). rewrite <- firstn_rev. rewrite Forall_app. split. eapply forall_firstn. eapply Forall_rev. eapply forall_firstn_ge. eauto. eapply div_mul_upper_bound. lia. - rewrite <- Hlen at 1. + rewrite Heqmm at 1. replace (Datatypes.S (length l)) with (length (r0::l)) by reflexivity. - rewrite <- (rev_involutive (skipn _ _)). + rewrite <- (rev_involutive (skipn _ _)). rewrite <- firstn_rev. rewrite firstn_all2. 2: { rewrite length_rev. rewrite length_firstn. lia. } eapply Forall_rev. eapply forall_firstn_ge. eauto. - assert (kk <= c \/ c < kk) by lia. cases H19. lia. + assert (kk <= c \/ c < kk) as H19 by lia. cases H19. lia. eapply div_small_iff in H19. lia. lia. eapply Forall_map. eapply Forall_forall. intros. eauto. eauto. } } @@ -2165,28 +2006,26 @@ Proof. rewrite filter_until_0_cons in HHHH by lia. split. { (* middle part of split *) - cases (k0 //n (Z.to_nat (eval_Zexpr_Z_total $0 k)) - - k0 / Z.to_nat (eval_Zexpr_Z_total $0 k)). econstructor. + cases (k0 //n (Z.to_nat kz) - k0 / Z.to_nat kz). econstructor. pose proof (ceil_sub_floor_le_1 k0 - (Z.to_nat (eval_Zexpr_Z_total $0 k))). + (Z.to_nat kz)). assert (n0 = 0) by lia. subst. unfold split_result. simpl. rewrite skipn_map. rewrite skipn_nat_range. cases (Datatypes.S (Datatypes.length l) //n - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - - k0 / Z.to_nat (eval_Zexpr_Z_total $0 k)). - { remember (Z.to_nat (eval_Zexpr_Z_total $0 k)). simpl length in *. - rewrite <- Hlen in *. + (Z.to_nat kz) - + k0 / Z.to_nat kz). + { remember (Z.to_nat kz). simpl length in *. assert (Datatypes.S (length l) //n n0 <= k0 /n0). lia. cases (Datatypes.S (length l) mod n0). - - pose proof Heq1. eapply mod_0_iff_ceil_eq_floor_0 in H20. 2: lia. + - pose proof Heq1 as H20. eapply mod_0_iff_ceil_eq_floor_0 in H20. 2: lia. rewrite H20 in *. - assert (k0 <= Datatypes.S (length l)) by lia. + assert (k0 <= Datatypes.S (length l)) as H21 by lia. exfalso. rewrite (Nat.div_mod_eq k0 n0) in H21. - eapply mul_le_mono_l with (p:=n0) in H19. + eapply mul_le_mono_l with (p:=n0) in H12. cases (k0 mod n0). eapply mod_0_iff_ceil_eq_floor_0 in Heq2. lia. lia. eapply div_exact in Heq1. lia. lia. @@ -2197,12 +2036,12 @@ Proof. assert (Datatypes.S (Datatypes.length l) //n n0 = Datatypes.S (Datatypes.length l) / n0 + 1) by lia. exfalso. - assert (k0 <= Datatypes.S (length l)) by lia. + assert (k0 <= Datatypes.S (length l)) as H22 by lia. eapply div_le_mono with (c:=n0) in H22. lia. lia. - } + } simpl. econstructor. 2: eauto. cases rsh. - { invert H15. } + { invert H3. } split. rewrite app_comm_cons. rewrite skipn_app. rewrite firstn_app. rewrite firstn_app. rewrite skipn_repeat. rewrite firstn_repeat. rewrite firstn_repeat. rewrite length_firstn. rewrite length_skipn. @@ -2211,94 +2050,89 @@ Proof. { rewrite firstn_firstn. rewrite min_l. 2: { eapply lt_le_incl. eapply Nat.mod_upper_bound. lia. } - rewrite (Nat.div_mod_eq k0 - (Z.to_nat (eval_Zexpr_Z_total $0 k))) in H5. - pose proof H5. rewrite firstn_add in H5. - rewrite Forall_app in H5. invert H5. - invert H2. eapply result_has_shape_result_shape_nat in H26. + rewrite (Nat.div_mod_eq k0 (Z.to_nat kz)) in H0. + pose proof H0. rewrite firstn_add in H0. + rewrite Forall_app in H0. invert H0. + invert Hsh'''. eapply result_has_shape_result_shape_nat in H19. invert HHHH. - cases n1. simpl in *. invert H22. lia. invert H22. + cases n1. simpl in *. invs'. lia. invert H16. erewrite gen_pad_filter_until_0. - rewrite <- H25. - erewrite gen_pad_filter_until_0 in H21. eauto. } - { invert H2. eapply result_has_shape_result_shape_nat in H24. + rewrite <- H21. + rewrite gen_pad_filter_until_0 in *|-. eauto. } + { invert Hsh'''. eapply result_has_shape_result_shape_nat in H17. invert HHHH. - cases n1. simpl in *. invert H20. lia. invert H20. - rewrite H24. - rewrite gen_pad_filter_until_0. rewrite <- H23. - eapply Forall_repeat. eauto. } + cases n1. simpl in *. invs'. lia. invert H14. + rewrite H15. + rewrite gen_pad_filter_until_0. rewrite <- H19. + eapply Forall_repeat. f_equal. eauto. } split. auto. split. rewrite app_comm_cons. rewrite skipn_app. rewrite firstn_app. rewrite skipn_app. rewrite firstn_app. rewrite Forall_app. split. - { rewrite (Nat.div_mod_eq k0 - (Z.to_nat (eval_Zexpr_Z_total $0 k))) in H16. - rewrite Nat.add_comm in H16. - rewrite <- skipn_skipn in H16. - pose proof H16. + { rewrite (Nat.div_mod_eq k0 (Z.to_nat kz)) in H5. + rewrite Nat.add_comm in H5. + rewrite <- skipn_skipn in H5. + pose proof H5. rewrite skipn_firstn_comm. rewrite firstn_firstn. - eapply forall_firstn_ge with (n:=l1). + eapply forall_firstn_ge with (n:=l0). eapply Forall_forall. intros. - eapply Forall_forall in H19. + eapply Forall_forall in H12. 2: { eassumption. } - invert H15. cases n1. invert H22. lia. invert H22. - eapply result_has_shape_forall in H2. - eapply Forall_forall in H20. - 2: { eapply forall_firstn. eapply forall_skipn. eapply forall_skipn. - apply H2. } simpl in H20. + cases n1. invert H3. lia. invert H3. + eapply result_has_shape_forall in Hsh'''. + eapply Forall_forall in H13. + 2: { apply forall_firstn. eapply forall_skipn. eapply forall_skipn. + apply Hsh'''. } simpl in *. eapply relate_pads_filter_until_0. - eapply result_has_shape_filter_until_0. rewrite <- H23. + eapply result_has_shape_filter_until_0. rewrite <- H16. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite <- H23. + rewrite <- H16. eapply relate_pads_filter_until_0. eauto. eauto. lia. } { rewrite skipn_repeat. rewrite firstn_repeat. rewrite skipn_repeat. rewrite firstn_repeat. - pose proof H2. invert H19. - eapply result_has_shape_result_shape_nat in H25. rewrite H25. - eapply has_pad_size_of_relate_pads_gen_pad in H7. - 2: { eauto. } - 2: { eapply HP. } - simpl in H7. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). lia. - remember rev in H7. simpl in H7. rewrite <- repeat_cons in H7. - subst. rewrite @rev_repeat in *. invs. + pose proof Hsh''' as H19. invert H19. + eapply result_has_shape_result_shape_nat in H17. rewrite H17. + eapply has_pad_size_of_relate_pads_gen_pad in H8. + 2,3: eassumption. + cbn -[rev] in H8. rewrite <- repeat_cons in H8. + rewrite @rev_repeat in *. invs. rewrite @skipn_repeat in *. rewrite @firstn_repeat in *. - rewrite <- Heq1 in *. - rewrite min_r in H20 by lia. - cases l1. simpl. rewrite min_0_l. rewrite sub_0_l. - rewrite min_0_r. econstructor. + cbn [length] in *. rewrite min_r in * by lia. + cases l0. rewrite min_0_l. rewrite sub_0_l. + rewrite min_0_r. constructor. eapply Forall_repeat. - invert H15. cases n1. invert H24. lia. invert H24. + invert H13. cases n1. invert H3. lia. invert H3. eapply relate_pads_filter_until_0. - eapply result_has_shape_filter_until_0. rewrite <- H27. + eapply result_has_shape_filter_until_0. rewrite <- H19. eapply result_has_shape_gen_pad. - rewrite <- H27. invert H20. eauto. } + rewrite <- H19. eauto. } eauto. } - + (* last part of split *) - remember (Z.to_nat (eval_Zexpr_Z_total $0 k)) as kk. - remember (Z.to_nat (eval_Zexpr_Z_total $0 m)) as mm. - unfold split_result. simpl length in * . rewrite Hlen. - simpl. + remember (Z.to_nat kz) as kk. + cbn [length] in *. + remember (Datatypes.S (length l)) as mm. + unfold split_result. simpl length in * . rewrite <- Heqmm. + simpl. cases ((c + (kk - mm mod kk) mod kk) //n kk - (c + (kk - mm mod kk) mod kk) / kk). econstructor. (* k doesn't divide c + added padding *) assert (n0 = 0). { pose proof (ceil_sub_floor_le_1 (c + (kk - mm mod kk) mod kk) kk). lia. } - rewrite H17 in *. clear H17. clear n0. + subst n0. + - cases (mm mod kk). - (* kk divides mm *) rewrite sub_0_r in *. rewrite mod_same in * by lia. rewrite add_0_r in *. - pose proof Heq0. eapply mod_0_iff_ceil_eq_floor_0 in H17. 2: lia. + pose proof Heq0 as H17. eapply mod_0_iff_ceil_eq_floor_0 in H17. 2: lia. rewrite H17 in *. simpl repeat. rewrite app_nil_r. rewrite <- map_rev. rewrite skipn_map. rewrite firstn_map. @@ -2312,19 +2146,19 @@ Proof. rewrite add_0_l. cases (mm / kk - c / kk). rewrite min_0_r. econstructor. rewrite (min_l 1) by lia. rewrite <- Heq1. simpl. - econstructor. cases rsh. invert H15. + econstructor. cases rsh. invert HHHH. split. auto. split. replace (kk * (mm / kk - c / kk - 1)) with (length (r0::l) - (length (r0::l) - (kk*(mm/kk- c / kk - 1)))) at 1. 2: { rewrite sub_sub_distr. lia. - simpl length. rewrite Hlen. rewrite (Nat.div_mod_eq mm kk) at 2. + simpl length. rewrite <- Heqmm. rewrite (Nat.div_mod_eq mm kk) at 2. repeat rewrite mul_sub_distr_l. lia. lia. } rewrite <- (rev_involutive (skipn _ (r0::l))). - rewrite <- firstn_rev. simpl length. rewrite Hlen. + rewrite <- firstn_rev. simpl length. rewrite <- Heqmm. rewrite <- (firstn_skipn (length (r0::l) - c) (r0::l)). rewrite <- (rev_involutive (firstn _ (r0::l))). - rewrite <- skipn_rev. simpl length. rewrite Hlen. + rewrite <- skipn_rev. simpl length. rewrite <- Heqmm. rewrite rev_app_distr. rewrite firstn_app. rewrite rev_app_distr. rewrite firstn_app. rewrite rev_app_distr. rewrite firstn_app. @@ -2332,9 +2166,9 @@ Proof. repeat rewrite length_skipn. repeat rewrite length_rev. repeat rewrite length_skipn. repeat rewrite length_firstn. repeat rewrite length_rev. rewrite length_skipn. - simpl length. rewrite Hlen. + simpl length. rewrite <- Heqmm. rewrite (sub_sub_distr mm mm c) by lia. - rewrite sub_diag. rewrite add_0_l. + rewrite sub_diag. rewrite add_0_l. rewrite rev_involutive. repeat rewrite mul_sub_distr_l. eapply div_exact in Heq0. rewrite <- Heq0. replace (skipn (mm - c) (r0 :: l)) with @@ -2343,11 +2177,11 @@ Proof. rewrite firstn_rev. rewrite rev_involutive. reflexivity. } rewrite rev_involutive. rewrite Forall_app. split. - cases n1. invert H15. lia. invert H15. - remember (Z.to_nat (eval_Zexpr_Z_total $0 m)) as mm. - remember (Z.to_nat (eval_Zexpr_Z_total $0 k)) as kk. - rewrite <- H20. - rewrite gen_pad_filter_until_0. rewrite <- H21. + cases n1. invert1 HHHH. lia. invert1 HHHH. + remember (Datatypes.S (length l)) as mm. + remember (Z.to_nat kz) as kk. + rewrite <- H13. + rewrite gen_pad_filter_until_0. rewrite <- H14. rewrite <- gen_pad_filter_until_0. eapply forall_firstn. eapply Forall_rev. eapply forall_firstn. eapply Forall_rev. @@ -2361,13 +2195,13 @@ Proof. rewrite <- add_sub_swap. 2: { rewrite Heq0. assert (mm / kk = Datatypes.S n0 + c /kk). lia. - rewrite H19. rewrite mul_add_distr_l. + rewrite H7. rewrite mul_add_distr_l. rewrite (Nat.add_comm _ (kk*(c/kk))). rewrite (mul_comm _ (Datatypes.S _)). simpl. lia. } replace (kk * (c / kk) + kk) with (c + ((kk - c mod kk) mod kk)). 2: { rewrite (Nat.div_mod_eq c kk) at 1. rewrite <- add_assoc. rewrite mod_id. auto. lia. unfold not. - intros. eapply mod_0_iff_ceil_eq_floor_0 in H19. lia. lia. } + intros. eapply mod_0_iff_ceil_eq_floor_0 in H7. lia. lia. } rewrite sub_add_distr. rewrite add_sub. rewrite (sub_sub_distr mm). @@ -2378,18 +2212,18 @@ Proof. rewrite add_sub. rewrite min_l. 2: { eapply mod_le. lia. } rewrite sub_diag. econstructor. lia. - unfold not. intros. eapply mod_0_iff_ceil_eq_floor_0 in H19. lia. lia. - lia. + unfold not. intros. eapply mod_0_iff_ceil_eq_floor_0 in H7. lia. lia. + lia. } split. auto. - + replace (kk * (mm / kk - c / kk - 1)) with (length (r0::l) - (length (r0::l) - (kk * (mm / kk - c / kk - 1)))). 2: { repeat rewrite sub_sub_distr. lia. - simpl length. rewrite Hlen. rewrite (Nat.div_mod_eq mm kk) at 2. + simpl length. rewrite <- Heqmm. rewrite (Nat.div_mod_eq mm kk) at 2. repeat rewrite mul_sub_distr_l. lia. lia. } rewrite <- (rev_involutive (skipn _ (r0::l))). - rewrite <- firstn_rev. simpl length. rewrite Hlen. + rewrite <- firstn_rev. simpl length. rewrite <- Heqmm. rewrite <- (firstn_skipn c (rev (r0::l))). rewrite firstn_app. rewrite rev_app_distr. rewrite firstn_app. rewrite rev_app_distr. rewrite skipn_app. @@ -2397,12 +2231,12 @@ Proof. repeat rewrite length_firstn. repeat rewrite length_skipn. repeat rewrite length_rev. repeat rewrite length_firstn. repeat rewrite length_rev. repeat rewrite length_firstn. - rewrite length_rev. simpl length. rewrite Hlen. + rewrite length_rev. simpl length. rewrite <- Heqmm. rewrite (min_l c mm) by lia. rewrite (min_l (mm - kk * (mm / kk - c / kk - 1) - c) (mm-c)) by lia. 2: eauto. eapply div_exact in Heq0. repeat rewrite mul_sub_distr_l. - rewrite <- Heq0. + rewrite <- Heq0. rewrite <- (sub_add_distr _ _ c). rewrite (Nat.add_comm _ c). rewrite (sub_add_distr _ c _). 2: lia. replace (kk * (c / kk)) with (c - c mod kk). @@ -2416,27 +2250,27 @@ Proof. repeat rewrite sub_add_distr. rewrite sub_add. 2: { assert (c <= mm) by lia. - rewrite (Nat.div_mod_eq c kk) in H19. lia. } + rewrite (Nat.div_mod_eq c kk) in H7. lia. } rewrite <- (sub_add_distr _ _ kk). replace (kk * (c / kk) + kk) with (c + (kk - c mod kk)mod kk). 2: { rewrite ( Nat.div_mod_eq c kk) at 1. rewrite <- add_assoc. rewrite mod_id. reflexivity. lia. unfold not. - intros. eapply mod_0_iff_ceil_eq_floor_0 in H19. lia. lia. } + intros. eapply mod_0_iff_ceil_eq_floor_0 in H7. lia. lia. } rewrite sub_add_distr. rewrite (sub_sub_distr (mm-c) (mm-c)). - 2: { assert (mm - c < kk \/ kk <= mm - c) by lia. cases H19. + 2: { assert (mm - c < kk \/ kk <= mm - c) by lia. cases H7. 2: { pose proof (Nat.mod_upper_bound (kk- c mod kk) kk). lia. } rewrite (Nat.div_mod_eq c kk) at 2. rewrite sub_add_distr. cut (c mod kk + (kk - c mod kk) mod kk <= mm - kk * (c / kk)). lia. rewrite mod_id. rewrite Heq0. rewrite <- mul_sub_distr_l. rewrite Heq1. rewrite mul_comm. simpl. lia. lia. - unfold not. intros. - eapply mod_0_iff_ceil_eq_floor_0 in H20. lia. lia. } + intros Hnot. + eapply mod_0_iff_ceil_eq_floor_0 in Hnot. lia. lia. } rewrite sub_diag. rewrite add_0_l. 2: lia. rewrite <- (mod_id c kk) at 4. 2: lia. - 2: { unfold not. intros. - eapply mod_0_iff_ceil_eq_floor_0 in H19. lia. lia. } + 2: { intros Hnot. + eapply mod_0_iff_ceil_eq_floor_0 in Hnot. lia. lia. } rewrite add_sub. rewrite skipn_all2. rewrite firstn_nil. 2: { rewrite length_rev. rewrite length_firstn. lia. } @@ -2450,42 +2284,42 @@ Proof. rewrite (Nat.div_mod_eq c kk) at 21. repeat rewrite sub_add_distr. rewrite sub_add. - 2: { assert (c <= mm) by lia. - rewrite (Nat.div_mod_eq c kk) in H19. lia. } + 2: { assert (c <= mm) as Hle by lia. + rewrite (Nat.div_mod_eq c kk) in Hle. lia. } rewrite <- (sub_add_distr _ _ kk). replace (kk * (c / kk) + kk) with (c + (kk - c mod kk)mod kk). 2: { rewrite ( Nat.div_mod_eq c kk) at 1. rewrite <- add_assoc. - rewrite mod_id. reflexivity. lia. unfold not. - intros. eapply mod_0_iff_ceil_eq_floor_0 in H19. lia. lia. } + rewrite mod_id. reflexivity. lia. intros Hnot. + eapply mod_0_iff_ceil_eq_floor_0 in Hnot. lia. lia. } rewrite sub_add_distr. rewrite (sub_sub_distr (mm-c) (mm-c)). - 2: { assert (mm - c < kk \/ kk <= mm - c) by lia. cases H19. + 2: { assert (mm - c < kk \/ kk <= mm - c) as Hor by lia. cases Hor. 2: { pose proof (Nat.mod_upper_bound (kk- c mod kk) kk). lia. } rewrite (Nat.div_mod_eq c kk) at 2. rewrite sub_add_distr. cut (c mod kk + (kk - c mod kk) mod kk <= mm - kk * (c / kk)). lia. rewrite mod_id. rewrite Heq0. rewrite <- mul_sub_distr_l. rewrite Heq1. rewrite mul_comm. simpl. lia. lia. - unfold not. intros. - eapply mod_0_iff_ceil_eq_floor_0 in H20. lia. lia. } + intros Hnot. + eapply mod_0_iff_ceil_eq_floor_0 in Hnot. lia. lia. } rewrite sub_diag. rewrite add_0_l. 2: lia. rewrite <- (mod_id c kk) at 4. 2: lia. - 2: { unfold not. intros. - eapply mod_0_iff_ceil_eq_floor_0 in H19. lia. lia. } + 2: { intros Hnot. + eapply mod_0_iff_ceil_eq_floor_0 in Hnot. lia. lia. } rewrite minus_plus. replace (kk - ((kk - c mod kk) mod kk) mod kk) with (c mod kk). 2: { rewrite mod_mod by lia. rewrite <- (mod_id c kk) at 2. rewrite add_sub. auto. lia. - unfold not. intros. - eapply mod_0_iff_ceil_eq_floor_0 in H19. lia. lia. } + intros Hnot. + eapply mod_0_iff_ceil_eq_floor_0 in Hnot. lia. lia. } replace (kk - (kk - c mod kk) mod kk) with (c mod kk). 2: { rewrite <- (mod_id c kk) at 2. rewrite add_sub. auto. lia. - unfold not. intros. - eapply mod_0_iff_ceil_eq_floor_0 in H19. lia. lia. } + intros Hnot. + eapply mod_0_iff_ceil_eq_floor_0 in Hnot. lia. lia. } rewrite <- sub_add_distr. replace (Init.Nat.min (c mod kk) - (Init.Nat.min (mm - (mm - (c + (kk - c mod kk) mod kk))) c) - + (Init.Nat.min (mm - (mm - (c + (kk - c mod kk) mod kk))) c) - c mod kk) with 0 by lia. rewrite sub_0_r. rewrite firstn_all2 with (n:=kk). @@ -2501,37 +2335,37 @@ Proof. cut (kk <= (kk *(mm/kk) - kk*(c/kk))). lia. rewrite <- mul_sub_distr_l. rewrite Heq1. rewrite mul_comm. simpl. lia. lia. - unfold not. - intros. eapply mod_0_iff_ceil_eq_floor_0 in H19. lia. lia. } + intros Hnot. eapply mod_0_iff_ceil_eq_floor_0 in Hnot. lia. lia. } 2: lia. rewrite sub_diag. rewrite add_0_l. rewrite (min_l (c mod kk)). 2: { eapply le_trans. eapply mod_le. lia. lia. } - rewrite sub_diag. remember rev. simpl. subst l0. + rewrite sub_diag. remember rev. simpl. subst l1. rewrite firstn_firstn. eapply forall_firstn_ge with (n:=r). 2: { lia. } - cases n1. invert H15. lia. invert H15. - eapply result_has_shape_forall in H2. + cases n1. invert HHHH. lia. invert HHHH. + eapply result_has_shape_forall in Hsh'''. eapply Forall_forall. intros. - eapply Forall_forall in H18. - eapply Forall_forall in H2. + eapply Forall_forall in H11. + eapply Forall_forall in Hsh'''. 2: { eapply In_rev. eapply in_skipn. eapply in_firstn. eauto. } eapply relate_pads_filter_until_0. - eapply result_has_shape_filter_until_0. rewrite <-H21. + eapply result_has_shape_filter_until_0. rewrite <- H14. rewrite <- result_has_shape_filter_until_0. eauto. - rewrite <- H21. + rewrite <- H14. eapply relate_pads_filter_until_0. eauto. eauto. eauto. - (* k doesn't divide m *) rewrite <- Heq0 in *. assert (c < mm) as Hnew. - { assert (c = mm \/ c < mm) by lia. cases H17. rewrite H17 in *. + { assert (c = mm \/ c < mm) as Hor by lia. destruct Hor as [Hor|Hor]. + rewrite Hor in *. rewrite (Nat.div_mod_eq mm kk) in Heq at 3. rewrite (Nat.div_mod_eq mm kk) in Heq at 1. rewrite <- add_assoc in Heq. rewrite mod_id in Heq by lia. assert ((kk* (mm/kk) + kk ) mod kk = 0). rewrite <- mul_succ_r. rewrite mul_comm. rewrite mod_mul. lia. lia. - eapply mod_0_iff_ceil_sub_floor_0 in H19. lia. lia. lia. } - + eapply mod_0_iff_ceil_sub_floor_0 in H7. lia. lia. lia. } + replace (mm //n kk) with (Datatypes.S (mm/kk)). 2: { cases (mm //n kk - mm /kk). eapply mod_0_iff_ceil_sub_floor_0 in Heq1. lia. lia. @@ -2543,14 +2377,14 @@ Proof. simpl rev. rewrite add_0_r. rewrite app_comm_cons. repeat rewrite skipn_app. simpl length. - rewrite Hlen. replace (kk * (mm / kk) - mm) with 0. + rewrite <- Heqmm. replace (kk * (mm / kk) - mm) with 0. 2: { rewrite (Nat.div_mod_eq mm kk) at 2. rewrite sub_add_distr. rewrite sub_diag. lia. } simpl skipn. erewrite map_nat_range_rec_extensionality. 2: { intros. rewrite app_comm_cons. rewrite skipn_app. rewrite firstn_app. - rewrite length_skipn. simpl length. rewrite Hlen. + rewrite length_skipn. simpl length. rewrite <- Heqmm. replace (kk - (mm - kk * x)) with 0. 2: { rewrite (Nat.div_mod_eq mm kk). rewrite add_sub_swap . @@ -2560,12 +2394,12 @@ Proof. rewrite mul_comm. simpl. repeat rewrite sub_add_distr. rewrite sub_diag. lia. } simpl. rewrite app_nil_r. reflexivity. } - cases rsh. invert H15. cases n1. invert H15. lia. invert H15. - rewrite <- H19. pose proof H2 as Hshs. - invert H2. - remember (Z.to_nat (eval_Zexpr_Z_total $0 k)) as kk. - remember (Z.to_nat (eval_Zexpr_Z_total $0 m)) as mm. - rewrite firstn_app. rewrite length_skipn. simpl length. rewrite Hlen. + cases rsh. invert HHHH. cases n1. invert HHHH. lia. invert HHHH. + rewrite <- H13. pose proof Hsh''' as Hshs. + invert Hsh'''. + remember (Z.to_nat kz) as kk. + remember (Datatypes.S (length l)) as mm. + rewrite firstn_app. rewrite length_skipn. simpl length. rewrite <- map_rev. rewrite skipn_map. rewrite firstn_map. rewrite skipn_rev_nat_range_rec. @@ -2573,7 +2407,7 @@ Proof. cases ((c + (kk - mm mod kk) mod kk) / kk). { simpl. rewrite min_0_l. simpl. rewrite firstn_app. rewrite firstn_repeat. rewrite length_skipn. - simpl length. rewrite Hlen. rewrite <- mod_eq by lia. + simpl length. rewrite <- Heqmm. rewrite <- mod_eq by lia. rewrite (min_l (_ mod _)). 2: { eapply mod_le. lia. } rewrite (mod_small (c + (kk - mm mod kk) mod kk)). @@ -2582,7 +2416,7 @@ Proof. assert (c < mm mod kk). { eapply div_small_iff in Heq1. rewrite <- (mod_id mm kk) in Heq1 at 4. lia. lia. lia. lia. } - rewrite gen_pad_filter_until_0. rewrite <- H20. + rewrite gen_pad_filter_until_0. rewrite <- H14. rewrite <- gen_pad_filter_until_0. split. econstructor. split. @@ -2590,19 +2424,19 @@ Proof. rewrite length_rev. rewrite rev_repeat. rewrite repeat_length. rewrite firstn_repeat. rewrite Forall_app. split. eapply Forall_repeat. - eapply result_has_shape_result_shape_nat in H24. - rewrite H24. rewrite <- gen_pad_filter_until_0. eauto. + erewrite result_has_shape_result_shape_nat by eassumption. + rewrite <- gen_pad_filter_until_0. eauto. replace (kk * (mm / kk)) with (length (r0::l) - (length (r0::l) - kk*(mm/kk))). - 2: { rewrite sub_sub_distr. lia. simpl length. rewrite Hlen. + 2: { rewrite sub_sub_distr. lia. simpl length. rewrite <- Heqmm. rewrite (Nat.div_mod_eq mm kk) at 2. lia. lia. } rewrite <- (rev_involutive (skipn _ _)). rewrite <- firstn_rev. - simpl length. rewrite Hlen. rewrite add_sub. + simpl length. rewrite <- Heqmm. rewrite add_sub. rewrite firstn_all2 with (n:=kk). 2: { rewrite length_rev. rewrite length_firstn. - rewrite length_rev. simpl length. rewrite Hlen. + rewrite length_rev. simpl length. rewrite <- Heqmm. rewrite min_l by lia. rewrite (Nat.div_mod_eq mm kk) at 1. rewrite minus_plus. pose proof (Nat.mod_upper_bound mm kk). @@ -2622,15 +2456,15 @@ Proof. rewrite sub_0_r. replace (kk * (mm / kk)) with (length (r0::l) - (length (r0::l) - kk*(mm/kk))). - 2: { rewrite sub_sub_distr. lia. simpl length. rewrite Hlen. + 2: { rewrite sub_sub_distr. lia. simpl length. rewrite <- Heqmm. rewrite (Nat.div_mod_eq mm kk) at 2. lia. lia. } rewrite <- (rev_involutive (skipn _ (r0::l))). rewrite <- firstn_rev. - simpl length. rewrite Hlen. rewrite add_sub. + simpl length. rewrite <- Heqmm. rewrite add_sub. rewrite firstn_all2 with (n:=kk). 2: { rewrite length_rev. rewrite length_firstn. rewrite length_rev. - simpl length. rewrite Hlen. + simpl length. rewrite <- Heqmm. rewrite min_l by lia. rewrite (Nat.div_mod_eq mm kk) at 1. pose proof (Nat.mod_upper_bound mm kk). lia. } @@ -2641,28 +2475,28 @@ Proof. 2: { lia. } eapply Forall_forall. intros. eapply result_has_shape_forall in Hshs. - eapply Forall_forall in H18. + eapply Forall_forall in H11. eapply Forall_forall in Hshs. 2: { eapply In_rev. eapply in_skipn. eapply in_firstn. eauto. } eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite <- H20. - erewrite <- result_has_shape_filter_until_0. eauto. - rewrite <- H20. + rewrite <- H14. + erewrite <- result_has_shape_filter_until_0. eauto. + rewrite <- H14. eapply relate_pads_filter_until_0. eauto. eauto. eauto. auto. } { simpl skipn. rewrite skipn_nil. rewrite app_nil_l. rewrite sub_0_r. rewrite <- Heq1. rewrite map_rev. eapply Forall_rev. eapply Forall_map. eapply Forall_forall. intros. - assert (mm mod kk <= c). - { assert ( c < mm mod kk \/ mm mod kk <= c) by lia. cases H15. + assert (mm mod kk <= c) as Hle. + { assert ( c < mm mod kk \/ mm mod kk <= c) as H16 by lia. cases H16. 2: lia. rewrite div_small in Heq1. lia. rewrite <- (mod_id mm kk) at 4. lia. lia. lia. } - rewrite <- Heq1 in *. eapply In_nat_range_rec in H2. cases H2. + rewrite <- Heq1 in *. eapply In_nat_range_rec in H7. cases H7. assert (x = mm / kk - ((c + (kk - mm mod kk) mod kk) / kk - 1) - 1). - lia. rewrite H22 in *. clear H22. clear x. clear H2. clear H17. + lia. subst x. clear H7 H15. split. auto. (* k doesn't divide c *) (* k doesn't divide m *) @@ -2676,17 +2510,17 @@ Proof. rewrite <- firstn_rev. rewrite skipn_app. rewrite firstn_app. rewrite length_firstn. rewrite length_skipn. rewrite length_firstn. - simpl length. rewrite Hlen. rewrite (min_l (mm-c)) by lia. + simpl length. rewrite <- Heqmm. rewrite (min_l (mm-c)) by lia. rewrite rev_app_distr. rewrite firstn_app. rewrite length_rev. rewrite length_firstn. rewrite length_skipn. rewrite length_rev. rewrite Forall_app. split. { eapply forall_firstn. eapply Forall_rev. eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. - rewrite gen_pad_filter_until_0. rewrite <- H20. + rewrite gen_pad_filter_until_0. rewrite <- H14. rewrite <- gen_pad_filter_until_0. eauto. } rewrite length_firstn. rewrite length_rev. simpl length. - rewrite Hlen. rewrite (min_l c mm) by lia. + rewrite <- Heqmm. rewrite (min_l c mm) by lia. repeat rewrite <- sub_add_distr. rewrite sub_add by lia. repeat rewrite sub_add_distr. assert (kk * (mm / kk - (c + (kk - mm mod kk) mod kk) / kk) <= @@ -2702,8 +2536,7 @@ Proof. 2: { rewrite mul_comm. eapply mul_le_mono_l. eapply div_le_mono. lia. lia. } rewrite (mul_comm (c/kk) kk). - assert (c mod kk < mm mod kk \/ mm mod kk <= c mod kk) by lia. - cases H2. + assert (c mod kk < mm mod kk \/ mm mod kk <= c mod kk) as [?|?] by lia. rewrite (div_small (_ + _) kk). 2: { rewrite <- (mod_id mm kk) at 5. lia. lia. lia. } rewrite mul_0_r. rewrite sub_0_r. lia. @@ -2711,7 +2544,7 @@ Proof. cases ((c mod kk + (kk - mm mod kk) mod kk) / kk). { eapply div_small_iff in Heq2. 2: lia. rewrite <- (mod_id mm kk) in Heq2 at 5 by lia. lia. } - assert (n3 = 0) by lia. rewrite H22 in *. clear H22. clear n3. + assert (n3 = 0) by lia. subst n3. rewrite mul_1_r. pose proof (Nat.mod_upper_bound c kk). lia. } replace (kk * (mm / kk - (c + (kk - mm mod kk) mod kk) / kk) @@ -2721,21 +2554,20 @@ Proof. { unfold not. intros. rewrite (Nat.div_mod_eq c kk) in Heq. repeat rewrite <- add_assoc in Heq. - rewrite H17 in Heq. + rewrite H15 in Heq. rewrite mod_id in * by lia. replace (kk* (c/kk) + kk) with (kk * (c/kk + 1)) in * by lia. rewrite mul_comm in Heq. rewrite nat_mul_div_id in Heq by lia. rewrite div_mul in Heq by lia. lia. } - assert (c mod kk < mm mod kk \/ mm mod kk < c mod kk) by lia. - cases H22. + assert (c mod kk < mm mod kk \/ mm mod kk < c mod kk) as [?|?] by lia. - replace ((c + (kk - mm mod kk) mod kk) / kk) with (c/kk) in *. 2: { rewrite (Nat.div_mod_eq c kk) at 2. rewrite <- add_assoc. rewrite (mul_comm kk). rewrite div_add_l by lia. rewrite (div_small (_ + _) kk). lia. pose proof (mod_id c kk). pose proof (mod_id mm kk). lia. } - assert (kk <= c \/ c < kk) by lia. cases H23. + assert (kk <= c \/ c < kk) as [?|?] by lia. 2: { rewrite (mod_small c) in * by lia. lia. } rewrite mul_sub_distr_l. rewrite (Nat.div_mod_eq mm kk) at 2. @@ -2787,14 +2619,14 @@ Proof. rewrite add_mod_idemp_r by lia. rewrite add_mod by lia. rewrite add_mod_idemp_r by lia. - assert (c < kk \/ kk <= c) by lia. cases H23. + assert (c < kk \/ kk <= c) as [?|?] by lia. + rewrite min_r by lia. rewrite (mod_small c) in * by lia. rewrite (div_small c kk) in * by lia. rewrite sub_0_r in *. simpl in *. rewrite mul_0_r in *. eapply div_small_iff in Heq2. 2: { lia. } - rewrite mod_small in H22 by lia. lia. - + rewrite min_l by lia. + rewrite mod_small in H16 by lia. lia. + + rewrite min_l by lia. replace ((c mod kk + (kk - mm mod kk)) mod kk - kk) with 0. 2: { pose proof (Nat.mod_upper_bound (c mod kk + (kk - mm mod kk)) kk). lia. } @@ -2832,10 +2664,10 @@ Proof. ((kk - c mod kk) mod kk + (kk - mm mod kk - ((kk - c mod kk) mod kk))). 2: { rewrite add_sub_assoc. lia. pose proof (mod_id c kk). pose proof (mod_id mm kk). lia. } - + rewrite add_assoc. rewrite mod_id. 2: lia. - 2: { lia. } + 2: { lia. } rewrite <-sub_add_distr. replace kk with (1*kk) at 1 by lia. rewrite Nat.add_comm. rewrite mod_add by lia. @@ -2855,22 +2687,22 @@ Proof. split. auto. rewrite <- (firstn_skipn (length (r0::l) - c) (r0::l)). rewrite <- (rev_involutive (firstn _ (r0::l))). - rewrite <- skipn_rev. + rewrite <- skipn_rev. rewrite skipn_app. rewrite firstn_app. rewrite length_skipn. rewrite length_rev. rewrite length_skipn. - rewrite length_rev. - simpl length. rewrite Hlen. + rewrite length_rev. + simpl length. rewrite <- Heqmm. rewrite rev_app_distr. rewrite skipn_app. rewrite length_rev. rewrite length_firstn. rewrite length_skipn. rewrite length_skipn. simpl length. - rewrite Hlen. rewrite firstn_app. + rewrite <- Heqmm. rewrite firstn_app. rewrite length_skipn. rewrite length_rev. rewrite length_firstn. rewrite length_skipn. rewrite length_skipn. - simpl length. rewrite Hlen. + simpl length. rewrite <- Heqmm. rewrite (sub_sub_distr mm mm c). 2: { lia. } 2: { lia. } - rewrite sub_diag. rewrite add_0_l. + rewrite sub_diag. rewrite add_0_l. repeat rewrite <- sub_add_distr. rewrite sub_add by lia. assert (kk * (mm / kk - (c + (kk - mm mod kk) mod kk) / kk) <= @@ -2886,8 +2718,7 @@ Proof. 2: { rewrite mul_comm. eapply mul_le_mono_l. eapply div_le_mono. lia. lia. } rewrite (mul_comm (c/kk) kk). - assert (c mod kk < mm mod kk \/ mm mod kk <= c mod kk) by lia. - cases H2. + assert (c mod kk < mm mod kk \/ mm mod kk <= c mod kk) as [?|?] by lia. rewrite (div_small (_ + _) kk). 2: { rewrite <- (mod_id mm kk) at 5. lia. lia. lia. } rewrite mul_0_r. rewrite sub_0_r. lia. @@ -2895,7 +2726,7 @@ Proof. cases ((c mod kk + (kk - mm mod kk) mod kk) / kk). { eapply div_small_iff in Heq2. 2: lia. rewrite <- (mod_id mm kk) in Heq2 at 5 by lia. lia. } - assert (n3 = 0) by lia. rewrite H22 in *. clear H22. clear n3. + assert (n3 = 0) by lia. subst n3. rewrite mul_1_r. pose proof (Nat.mod_upper_bound c kk). lia. } replace (kk * (mm / kk - (c + (kk - mm mod kk) mod kk) / kk) @@ -2905,7 +2736,7 @@ Proof. { unfold not. intros. rewrite (Nat.div_mod_eq c kk) in Heq. repeat rewrite <- add_assoc in Heq. - rewrite H17 in Heq. + rewrite H15 in Heq. rewrite mod_id in * by lia. replace (kk* (c/kk) + kk) with (kk * (c/kk + 1)) in * by lia. rewrite mul_comm in Heq. @@ -2915,19 +2746,18 @@ Proof. rewrite Forall_app. split. { simpl. - assert (c mod kk < mm mod kk \/ mm mod kk < c mod kk) by lia. - cases H22. + assert (c mod kk < mm mod kk \/ mm mod kk < c mod kk) as [?|?] by lia. - rewrite skipn_all2. rewrite firstn_nil. econstructor. rewrite length_rev. rewrite length_firstn. - rewrite length_skipn. simpl length. rewrite H21. + rewrite length_skipn. simpl length. rewrite <- Heqmm. rewrite (sub_sub_distr mm mm c) by lia. rewrite sub_diag. - rewrite add_0_l. + rewrite add_0_l. rewrite (Nat.div_mod_eq c kk) at 2. rewrite <- add_assoc. rewrite (mul_comm kk (c/kk)). rewrite div_add_l by lia. - rewrite (Nat.div_mod_eq c kk) in H2 at 1. - rewrite <- add_assoc in H2. rewrite (mul_comm kk (c/kk)) in H2. - rewrite div_add_l in H2 by lia. + rewrite (Nat.div_mod_eq c kk) in H7 at 1. + rewrite <- add_assoc in H7. rewrite (mul_comm kk (c/kk)) in H7. + rewrite div_add_l in H7 by lia. rewrite sub_add_distr in *. replace ((c mod kk + (kk - mm mod kk) mod kk) / kk) with 0 in *. 2: { rewrite div_small. lia. @@ -2943,10 +2773,10 @@ Proof. cases (mm / kk - c /kk). + rewrite mul_0_r. rewrite sub_0_r. rewrite sub_add_distr. - assert (mm / kk = c / kk). + assert (mm / kk = c / kk) as H21. { assert (c / kk <= mm/ kk). eapply div_le_mono. lia. lia. lia. } - rewrite H23. rewrite minus_plus. + rewrite H21. rewrite minus_plus. rewrite sub_sub_distr. 2: { lia. } 2: { pose proof (Nat.mod_upper_bound mm kk). lia. } @@ -2956,7 +2786,6 @@ Proof. rewrite sub_0_r in *. eapply div_small_iff in Heq2. rewrite (mod_small mm kk) in * by lia. lia. lia. lia. } rewrite (Nat.div_mod_eq c kk) at 2. - rewrite min_l by lia. rewrite <- (mod_small (kk - mm mod kk + c mod kk) kk). 2: { rewrite <- (mod_id mm kk) at 4 by lia. rewrite (mod_small (kk - mm mod kk) kk) by lia. @@ -2974,8 +2803,8 @@ Proof. rewrite <- mul_sub_distr_l. rewrite <- add_sub_assoc by lia. rewrite minus_plus. rewrite min_l. - 2: { assert (c < kk \/ kk <= c) by lia. cases H23. - eapply div_small_iff in H23. lia. lia. lia. } + 2: { assert (c < kk \/ kk <= c) as H21 by lia. cases H21. + eapply div_small_iff in H21. lia. lia. lia. } rewrite sub_sub_distr. 2: lia. 2: { pose proof (Nat.mod_upper_bound mm kk). lia. } rewrite (Nat.div_mod_eq c kk) at 2. @@ -2988,11 +2817,11 @@ Proof. rewrite (add_mod (c mod kk)) by lia. repeat rewrite mod_mod by lia. rewrite (mod_small (kk - mm mod kk)) by lia. - rewrite Nat.add_comm. lia. - - rewrite (Nat.div_mod_eq c kk) in H2 at 1. + rewrite Nat.add_comm. lia. + - rewrite (Nat.div_mod_eq c kk) in H7 at 1. rewrite <- add_assoc in *. - rewrite (mul_comm kk (c/kk)) in H2. - rewrite div_add_l in H2 by lia. + rewrite (mul_comm kk (c/kk)) in H7. + rewrite div_add_l in H7 by lia. rewrite (Nat.div_mod_eq c kk) at 4. rewrite <- add_assoc. rewrite (mul_comm kk (c/kk)). rewrite div_add_l by lia. @@ -3017,10 +2846,10 @@ Proof. cases (mm / kk - c /kk). { rewrite (Nat.div_mod_eq c kk) in Hnew. rewrite (Nat.div_mod_eq mm kk) in Hnew. - assert (mm / kk = c / kk). + assert (mm / kk = c / kk) as H21. { assert (c / kk <= mm/ kk). eapply div_le_mono. lia. lia. lia. } - rewrite H23 in *. lia. } + rewrite H21 in *. lia. } rewrite <- Heq2. rewrite add_sub_swap. 2: { pose proof (Nat.mod_upper_bound c kk). rewrite Heq2. @@ -3042,7 +2871,7 @@ Proof. rewrite mod_mod. rewrite skipn_all2. rewrite firstn_nil. econstructor. rewrite length_rev. rewrite length_firstn. - rewrite length_skipn. simpl length. rewrite H21. + rewrite length_skipn. simpl length. rewrite <- Heqmm. rewrite sub_sub_distr by lia. rewrite sub_diag. simpl. rewrite min_l. 2: { pose proof (mod_le c kk). lia. } @@ -3052,7 +2881,7 @@ Proof. replace (kk - mm mod kk) with (kk - c mod kk + (kk - mm mod kk - (kk - c mod kk))). 2: { lia. } - rewrite (Nat.add_comm). + rewrite (Nat.add_comm). repeat rewrite add_assoc. rewrite <- (mod_small (kk - c mod kk) kk) at 1 by lia. rewrite mod_id by lia. @@ -3065,16 +2894,16 @@ Proof. 2: { pose proof (Nat.mod_upper_bound c kk). lia. } 2: lia. rewrite sub_diag. lia. } - assert (c mod kk < mm mod kk \/ mm mod kk < c mod kk) by lia. - cases H22. + assert (c mod kk < mm mod kk \/ mm mod kk < c mod kk) as H21 by lia. + cases H21. - rewrite (Nat.div_mod_eq c kk) at 10. rewrite (Nat.div_mod_eq c kk) at 8. rewrite (Nat.div_mod_eq c kk) at 3. rewrite <- add_assoc. rewrite (mul_comm kk (c/kk)). rewrite div_add_l by lia. - rewrite (Nat.div_mod_eq c kk) in H2 at 1. - rewrite <- add_assoc in H2. rewrite (mul_comm kk (c/kk)) in H2. - rewrite div_add_l in H2 by lia. + rewrite (Nat.div_mod_eq c kk) in H7 at 1. + rewrite <- add_assoc in H7. rewrite (mul_comm kk (c/kk)) in H7. + rewrite div_add_l in H7 by lia. rewrite sub_add_distr in *. replace ((c mod kk + (kk - mm mod kk) mod kk) / kk) with 0 in *. 2: { rewrite div_small. lia. @@ -3099,15 +2928,15 @@ Proof. rewrite skipn_skipn. rewrite firstn_skipn_comm. rewrite firstn_firstn. rewrite length_firstn. rewrite length_skipn. - rewrite length_rev. simpl length. rewrite H21. + rewrite length_rev. simpl length. rewrite <- Heqmm. rewrite (min_l (mm - c - _) (mm-c)). 2: eapply le_sub_l. cases (c / kk). - eapply div_small_iff in Heq2. rewrite mod_small in H22 by lia. lia. + eapply div_small_iff in Heq2. rewrite mod_small in H21 by lia. lia. lia. rewrite <- Heq2. assert (kk <= c). - { assert (kk <= c \/ c < kk) by lia. cases H23. lia. - eapply div_small_iff in H23. lia. lia. } + { assert (kk <= c \/ c < kk) as H22 by lia. cases H22. lia. + eapply div_small_iff in H22. lia. lia. } rewrite (min_l _ c) by lia. rewrite add_mod by lia. rewrite mod_mod by lia. rewrite (mod_small (c mod kk + (kk - mm mod kk) mod kk) kk). @@ -3141,13 +2970,13 @@ Proof. eapply Forall_forall. intros. eapply Forall_forall in Hshs. 2: { eapply in_rev. eapply in_skipn. eapply in_firstn. eauto. } - eapply Forall_forall in H18. + eapply Forall_forall in H11. 2: { eassumption. } eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite <- H20. + rewrite <- H14. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite <- H20. + rewrite <- H14. eapply relate_pads_filter_until_0. eauto. eauto. lia. } @@ -3160,7 +2989,7 @@ Proof. rewrite (Nat.div_mod_eq c kk) at 1. rewrite sub_add_distr. rewrite add_sub_swap. 2: { eapply mul_le_mono_l. eapply div_le_mono. lia. lia. } - rewrite <- mul_sub_distr_l. + rewrite <- mul_sub_distr_l. rewrite <- add_sub_assoc. rewrite minus_plus. replace (mm mod kk - c mod kk - kk) with 0. @@ -3172,13 +3001,13 @@ Proof. eapply Forall_forall. intros. eapply Forall_forall in Hshs. 2: { eapply in_rev. eapply in_skipn. eapply in_firstn. eauto. } - eapply Forall_forall in H18. + eapply Forall_forall in H11. 2: { eassumption. } eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite <- H20. + rewrite <- H14. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite <- H20. + rewrite <- H14. eapply relate_pads_filter_until_0. eauto. eauto. lia. lia. } @@ -3187,9 +3016,9 @@ Proof. rewrite (Nat.div_mod_eq c kk) at 3. rewrite <- add_assoc. rewrite (mul_comm kk (c/kk)). rewrite div_add_l by lia. - rewrite (Nat.div_mod_eq c kk) in H2 at 1. - rewrite <- add_assoc in H2. rewrite (mul_comm kk (c/kk)) in H2. - rewrite div_add_l in H2 by lia. + rewrite (Nat.div_mod_eq c kk) in H7 at 1. + rewrite <- add_assoc in H7. rewrite (mul_comm kk (c/kk)) in H7. + rewrite div_add_l in H7 by lia. rewrite sub_add_distr in *. replace ((c mod kk + (kk - mm mod kk) mod kk) / kk) with 1 in *. 2: { pose proof (add_mod_div_bound c (kk - mm mod kk) kk). @@ -3202,7 +3031,7 @@ Proof. rewrite (Nat.div_mod_eq c kk) at 1. lia. } repeat rewrite sub_add_distr. rewrite add_sub_swap. - 2: { eapply mul_le_mono_l. eapply div_le_mono. lia. lia. } + 2: { eapply mul_le_mono_l. eapply div_le_mono. lia. lia. } rewrite mul_sub_distr_l. rewrite mul_1_r. repeat rewrite <- sub_add_distr. rewrite (Nat.add_comm (c mod kk)). @@ -3211,7 +3040,7 @@ Proof. rewrite <- mul_sub_distr_l. rewrite Heq2. rewrite mul_0_r. simpl. replace (mm mod kk - c mod kk) with 0 by lia. rewrite sub_0_r. - assert (c < kk \/ kk <= c) by lia. cases H23. + assert (c < kk \/ kk <= c) as [?|?] by lia. rewrite (mod_small c kk) in * by lia. rewrite (div_small c kk) in * by lia. rewrite sub_0_r in *. eapply div_small_iff in Heq2. @@ -3220,7 +3049,7 @@ Proof. rewrite firstn_rev. rewrite rev_involutive. rewrite length_skipn. rewrite length_app. rewrite length_rev. simpl. - rewrite add_succ_r. rewrite add_0_r. rewrite H21. + rewrite add_succ_r. rewrite add_0_r. rewrite <- Heqmm. replace (mm - c - kk) with 0. 2: { rewrite (Nat.div_mod_eq mm kk). rewrite (Nat.div_mod_eq c kk). @@ -3234,19 +3063,19 @@ Proof. (c + (kk - mm mod kk) mod kk) kk). lia. } simpl. replace (rev l ++ [r0])%list with (rev (r0::l)) by auto. - eapply result_has_shape_forall in Hshs. + eapply result_has_shape_forall in Hshs. eapply forall_firstn_ge. eapply Forall_forall. intros. eapply Forall_forall in Hshs. 2: { eapply in_rev. eapply in_skipn. eapply in_firstn. eauto. } - eapply Forall_forall in H18. + eapply Forall_forall in H11. 2: { eassumption. } eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite <- H20. + rewrite <- H14. erewrite <- result_has_shape_filter_until_0. eauto. - erewrite <- H20. eapply relate_pads_filter_until_0. - eauto. eauto. lia. + erewrite <- H14. eapply relate_pads_filter_until_0. + eauto. eauto. lia. } rewrite <- Heq2. rewrite add_sub_swap. @@ -3274,7 +3103,7 @@ Proof. rewrite firstn_firstn. rewrite length_firstn. rewrite length_skipn. rewrite length_app. rewrite length_rev. simpl. rewrite add_succ_r. rewrite add_0_r. - rewrite H21. rewrite (min_l _ (mm -c)) by lia. + rewrite <- Heqmm. rewrite (min_l _ (mm -c)) by lia. replace (mm - c) with (kk * (mm /kk) + mm mod kk - (kk *(c/kk) + c mod kk)). 2: { symmetry. rewrite (Nat.div_mod_eq mm kk) at 1. @@ -3283,13 +3112,13 @@ Proof. rewrite add_sub_swap. 2: { eapply mul_le_mono_l. eapply div_le_mono. lia. lia. } rewrite add_mod by lia. rewrite mod_mod by lia. - rewrite <- mul_sub_distr_l. + rewrite <- mul_sub_distr_l. eapply forall_skipn. rewrite <- sub_add_distr. rewrite sub_add. 2: { rewrite Heq2. rewrite mul_comm. simpl. lia. } replace (kk * (mm / kk - c / kk) + mm mod kk - c mod kk - kk * (mm / kk - c / kk)) with 0. - 2: { symmetry. eapply sub_0_le. + 2: { symmetry. eapply sub_0_le. rewrite add_sub_swap. rewrite <- sub_sub_distr. 2: lia. @@ -3299,20 +3128,20 @@ Proof. pose proof (Nat.mod_upper_bound c kk). lia. } eapply le_sub_l. } rewrite add_0_r. - rewrite (mod_small (kk - mm mod kk)) by lia. + rewrite (mod_small (kk - mm mod kk)) by lia. replace (rev l ++ [ r0])%list with (rev (r0::l)) by reflexivity. eapply forall_firstn_ge. eapply result_has_shape_forall in Hshs. eapply Forall_forall. intros. eapply Forall_forall in Hshs. 2: { eapply in_rev. eapply in_skipn. eapply in_firstn. eauto. } - eapply Forall_forall in H18. + eapply Forall_forall in H11. 2: { eassumption. } eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite <- H20. + rewrite <- H14. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite <- H20. + rewrite <- H14. eapply relate_pads_filter_until_0. eauto. eauto. remember (min r _) as X. @@ -3336,7 +3165,7 @@ Proof. rewrite minus_plus. remember ((kk - mm mod kk - (kk - c mod kk)) mod kk) as XX. remember (c mod kk - mm mod kk) as XXX. - assert (XX - XXX = 0). + assert (XX - XXX = 0) as H22. { rewrite HeqXX,HeqXXX. rewrite (mod_small (kk - mm mod kk - (kk - c mod kk)) kk). 2: { lia. } @@ -3344,97 +3173,74 @@ Proof. rewrite Nat.add_comm. rewrite <- (mod_small (kk - c mod kk) kk) by lia. rewrite mod_id by lia. rewrite sub_diag. reflexivity. } - rewrite H23. rewrite add_0_l. - rewrite HeqX, HeqXX, HeqXXX. - lia. lia. + rewrite H22. rewrite add_0_l. subst. clear. lia. + subst. clear -H21. lia. } } - - (* EMPTY GEN *) invert Hpad. invert Hsh. - pose proof Hconst as Hconst'. - eapply constant_nonneg_bounds_size_of_no_vars in Hconst'. - 2: { econstructor. eauto. } - invert Hconst'. simpl in *. - eapply app_no_dups_empty_args in H4. invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total with (v:=$0) - in H2,H3. repeat rewrite skipn_nil. - repeat rewrite firstn_nil. - propositional; econstructor. + repeat rewrite firstn_nil. + auto. - (* STEP GEN *) invert Hsh. invert Hpad. - pose proof Hconst as Hconst'. - eapply constant_nonneg_bounds_size_of_no_vars in Hconst'. - 2: { econstructor. eauto. } - simpl in Hconst'. invert Hconst'. simpl in H8. - eapply app_no_dups_empty_args in H8. invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total with (v:=$0) - in H7,H6. + simpl in Hbds. + invs. + eq_eval_Z. eq_size_of. - assert (eval_Zexpr_Z_total $0 lo = loz). - { invert H7. - eapply eval_Zexpr_Z_eval_Zexpr in H. - eapply H8 in H. invert H. reflexivity. } - assert (eval_Zexpr_Z_total $0 hi = hiz). - { invert H6. - eapply eval_Zexpr_Z_eval_Zexpr in H0. - eapply H16 in H0. invert H0. reflexivity. } - subst. - simpl in *. + + rename H8 into Hlo. rename H7 into Hhi. + pose proof Hlo as Hlo'. pose proof Hhi as Hhi'. + eapply eval_Zexpr_includes_valuation in Hlo, Hhi; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hlo, Hhi. + rewrite Hlo, Hhi in *. invs. clear Hlo Hhi. + apply eval_Zexpr_Z_eval_Zexpr in Hlo', Hhi'. + cbv [eval_Zexpr_Z_total] in *. rewrite Hlo', Hhi' in *. + rename Hlo' into Hloz. rename Hhi' into Hhiz. simpl in *. + + pose proof H5 as H32. + eapply length_eval_expr_gen in H32; eauto. + 2: { simpl. apply eval_Zexpr_Z_eval_Zexpr in Hloz, Hhiz. + eapply eval_Zexpr_includes_valuation in Hloz, Hhiz; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hloz, Hhiz. rewrite Hhiz, Hloz. + reflexivity. } + assert (result_has_shape (V l) (length l::xs_shape)) as Hsh'. { eapply forall_result_has_shape; eauto. } assert (k > 0 \/ k = 0) as Hcase by lia. inversion Hcase as [ Hcase1 | Hcase2 ]; clear Hcase. + (* 0 < k *) - assert (has_pad sh v g (Gen i (lo + | 1 |)%z hi body) + assert (has_pad v g (Gen i (lo + | 1 |)%z hi body) (PadCons (k-1) ll pad1 rr pad2 c)). { econstructor. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. lia. eassumption. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. - intros. - apply H19. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz. + intros. apply H18. lia. - auto. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhiz. + intros. apply H20. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. - intros. - eapply H22. lia. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. + eq_size_of. intros. apply H21. lia. lia. - rewrite eval_Zexpr_Z_total_add_distr by eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. lia. } cases l. - { simpl in *. eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H,H0. reflexivity. } - simpl in *. - replace (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)%Z with - 1%Z in * by lia. + { simpl in *. + replace (hiz - loz)%Z with 1%Z in * by lia. assert (k = 1) by lia. subst. simpl. assert (c = 0) by lia. subst. simpl in *. - assert (eval_Zexpr_Z_total $0 lo <= - eval_Zexpr_Z_total $0 lo < eval_Zexpr_Z_total $0 hi)%Z - by lia. + assert (loz <= loz < hiz)%Z by lia. rewrite firstn_nil. replace ll with 0 in * by lia. replace rr with 0 in * by lia. simpl in *. @@ -3444,54 +3250,48 @@ Proof. eapply relate_pads_gen_pad. eapply IHeval_expr1. invs. eauto. - eapply H22. lia. lia. - eauto. eauto. eauto. eauto. eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape; - eauto. invs. eauto. } + eapply H21. lia. lia. + eauto. eauto. eauto. eauto. eauto. + eapply size_of_eval_expr_result_has_shape; eauto. } + - eapply IHeval_expr2 in Hsh'; clear IHeval_expr2. - 2: { invert H7. invert H6. - rewrite H18,H17. simpl. - rewrite app_no_dups_empty_r. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - propositional. lia. - econstructor; eauto. eauto. } - 2: { eauto. } + 2,3: eassumption. + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hloz, Hhiz. + econstructor; eauto. do 2 eexists. split; [|split]; eauto. lia. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hloz, Hhiz. + econstructor; eauto. } simpl in Hsh'. - invs. - cases k. lia. + invs. + cases k. lia. replace (Datatypes.S k-1) with k in * by lia. simpl in *. - 2: { eauto. } propositional. * econstructor. - + eapply relate_pads_gen_pad. - eapply H27. - eapply H22. lia. - lia. eauto. eauto. eauto. eauto. eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - eauto. eauto. eauto. eauto. + eapply IHeval_expr1. + eapply H21. lia. + lia. eauto. eauto. eauto. eauto. eauto. + eapply size_of_eval_expr_result_has_shape; eauto. + eauto. * rewrite firstn_app. rewrite length_app. rewrite length_rev. simpl. eapply Forall_app. propositional. cases (c - (Datatypes.length l + 1)). simpl in *. econstructor. simpl. rewrite firstn_nil. econstructor. 2: eauto. eapply relate_pads_gen_pad. - eapply H27. - eapply H22. lia. lia. eauto. - eauto. eauto. + eapply IHeval_expr1. + eapply H21. lia. lia. eauto. + eauto. eauto. eauto. eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - eauto. eauto. eauto. - * posnats. pose proof H24. + eapply size_of_eval_expr_result_has_shape; eauto. + * posnats. pose proof H17 as H'. rewrite skipn_app in *. rewrite firstn_app in *. rewrite length_skipn in *. rewrite length_rev in *. - eapply Forall_app in H29. invs. + eapply Forall_app in H'. invs. repeat erewrite Forall_app. rewrite skipn_app. rewrite firstn_app. rewrite Forall_app. @@ -3504,12 +3304,7 @@ Proof. assert (c <= Datatypes.S (length l)) by lia. cases (rr - (Datatypes.length l + 1 - c)). simpl. eauto. simpl. rewrite firstn_nil. econstructor. 2: eauto. - pose proof H5. - eapply length_eval_expr_gen in H32; eauto. - 2: { simpl. rewrite H,H0. reflexivity. } - simpl in H32. lia. - * eauto. - * econstructor. eauto. + lia. + (* k = 0 *) subst. simpl. split. auto. assert (c = 0 \/ 0 < c) as Hcase by lia. @@ -3524,120 +3319,70 @@ Proof. { simpl. split. auto. rewrite firstn_app. rewrite length_rev. cases (rr - length l). - - simpl. rewrite app_nil_r. + - lia. + - rewrite H32 in *. + assert (rr =Z.to_nat (hiz - loz)) by lia. pose proof Hsh' as HH. eapply IHeval_expr2 in HH. - 2: { invert H6. invert H7. rewrite H16,H17. simpl. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. propositional. - lia. econstructor; eauto. eauto. } - 2: { eapply HasPadGen with (k:=0) (ll:=0) (c:=0) (rr:=rr). - lia. lia. lia. eauto. - - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. - unfold eval_Zexpr_Z_total at 3. simpl. intros. eapply H19. - lia. eauto. eauto. - intros. eapply H21. lia. - - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. - unfold eval_Zexpr_Z_total at 4. simpl. intros. lia. - eauto. eauto. - - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H,H0. reflexivity. } - lia. eauto. eauto. } - 2: eauto. - 2: eauto. - 2: { econstructor; eauto. } - simpl in HH. invs. eauto. - - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H,H0. reflexivity. } - rewrite H5 in *. - assert (rr =Z.to_nat (eval_Zexpr_Z_total $0 hi - - eval_Zexpr_Z_total $0 lo)) by lia. - pose proof Hsh' as HH. - eapply IHeval_expr2 in HH. - 2: { invert H6. invert H7. rewrite H8,H17. simpl. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. propositional. - lia. econstructor; eauto. eauto. } 2: { eapply HasPadGen with (k:=0) (ll:=0) (c:=0) (rr:=rr-1). lia. lia. lia. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. - unfold eval_Zexpr_Z_total at 3. simpl. intros. eapply H19. - lia. eauto. eauto. - intros. eapply H21. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz. + intros. apply H18. lia. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. - unfold eval_Zexpr_Z_total at 4. simpl. intros. lia. - eauto. eauto. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhiz. + intros. apply H20. lia. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - lia. eauto. eauto. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhiz. + intros. apply H21. lia. lia. + + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. + lia. } 2: eauto. 2: eauto. - 2: { econstructor; eauto. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. + split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. econstructor; eauto. } eapply IHeval_expr1 in H9. - 2: { propositional. } - 2: { eapply H21. lia. } + 2: { eapply H20. lia. } 2: { eauto. } - 2: { eauto. } - 2: eauto. + 2: { eassumption. } + 2: { eassumption. } simpl. rewrite firstn_nil. simpl in HH. invs. rewrite Forall_app. split. rewrite firstn_all2. 2: { rewrite length_rev. lia. } - rewrite firstn_all2 in H20. + rewrite firstn_all2 in *. 2: { rewrite length_rev. lia. } eauto. econstructor; eauto. } simpl. split. econstructor. eapply IHeval_expr1. invs. eauto. - eapply H19. lia. eauto. auto. auto. eauto. - + eapply H18. lia. eauto. auto. auto. eauto. + cases l. - { rewrite firstn_nil. eauto. } + { rewrite firstn_nil. eauto. } eapply IHeval_expr2 with (pads:= PadCons 0 ll pad1 rr pad2 0) in Hsh'. - 2: { invert H7. invert H6. rewrite H16,H17. simpl. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - propositional. lia. - econstructor; eauto. eauto. } - 2: { eapply eval_Zexpr_Z_eval_Zexpr in H,H0. invs. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H8,H17. invs. - pose proof H18. pose proof H17. - specialize (H17 v). specialize (H18 v). - specialize (H8 $0). specialize (H24 $0). - eq_eval_Z. eapply eval_Zexpr_Z_eval_Zexpr in H,H0,H8,H24. - econstructor. - unfold eval_Zexpr_Z_total. simpl. rewrite H8,H24. lia. - unfold eval_Zexpr_Z_total. simpl. rewrite H8,H24. lia. - unfold eval_Zexpr_Z_total. simpl. rewrite H8,H24. lia. + 2: { econstructor. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. eauto. - unfold eval_Zexpr_Z_total. simpl. rewrite H24. intros. - eapply H19. lia. - unfold eval_Zexpr_Z_total. simpl. rewrite H8. intros. - eapply H21. lia. - intros. - unfold eval_Zexpr_Z_total in H17,H18. simpl eval_Zexpr_Z in *. - rewrite H8,H24 in *. - eapply H22. lia. lia. - unfold eval_Zexpr_Z_total. simpl. rewrite H8,H24. lia. } + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz. intros. + eapply H18. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz. intros. + eapply H20. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz, Hhiz. intros. + eapply H21. lia. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz, Hhiz. lia. } 2: { eauto. } - 2: { eauto. } - 2: { econstructor. eauto. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. + split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. econstructor; eauto. } simpl in Hsh'. invs. eauto. rewrite firstn_app. rewrite length_rev. @@ -3645,140 +3390,82 @@ Proof. with (pads:= PadCons 0 ll pad1 rr pad2 0) in Hsh'. - 2: { invert H7. invert H6. rewrite H16,H17. simpl. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - propositional. lia. - econstructor; eauto. eauto. } - 2: { eapply eval_Zexpr_Z_eval_Zexpr in H,H0. invs. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H8,H17. invs. - pose proof H18. pose proof H17. - specialize (H17 v). specialize (H18 v). - specialize (H8 $0). specialize (H24 $0). - eq_eval_Z. eapply eval_Zexpr_Z_eval_Zexpr in H,H0,H8,H24. - econstructor. - unfold eval_Zexpr_Z_total. simpl. rewrite H8,H24. lia. - unfold eval_Zexpr_Z_total. simpl. rewrite H8,H24. lia. - unfold eval_Zexpr_Z_total. simpl. rewrite H8,H24. lia. + 2: { econstructor. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. eauto. - unfold eval_Zexpr_Z_total. simpl. rewrite H24. intros. - eapply H19. lia. - unfold eval_Zexpr_Z_total. simpl. rewrite H8. intros. - eapply H21. lia. - intros. - unfold eval_Zexpr_Z_total in H17,H18. simpl eval_Zexpr_Z in *. - rewrite H8,H24 in *. - eapply H22. lia. lia. - unfold eval_Zexpr_Z_total. simpl. rewrite H8,H24. lia. } - 2: { eauto. } + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz. intros. + eapply H18. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz. intros. + eapply H20. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz, Hhiz. intros. + eapply H21. lia. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz, Hhiz. lia. } 2: { eauto. } - 2: { econstructor. eauto. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. + split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. econstructor; eauto. } simpl in Hsh'. invs. eauto. eapply Forall_app. split. eauto. - - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H,H0. reflexivity. } + cases (rr - length l). 2: lia. simpl. eauto. * (* 0 < c *) - assert (c = Z.to_nat - (eval_Zexpr_Z_total $0 hi-eval_Zexpr_Z_total $0 lo) \/ - c < Z.to_nat - (eval_Zexpr_Z_total $0 hi-eval_Zexpr_Z_total $0 lo)) + assert (c = Z.to_nat (hiz - loz) \/ c < Z.to_nat (hiz - loz)) as Hcase by lia. inversion Hcase as [ Hcase3 | Hcase4 ]; clear Hcase. -- (* entire thing is right padding *) subst. - assert (has_pad sh v g (Gen i (lo + | 1 |)%z hi body) + assert (has_pad v g (Gen i (lo + | 1 |)%z hi body) (PadCons 0 0 pad1 0 pad2 - (Z.to_nat - (eval_Zexpr_Z_total $0 hi- - eval_Zexpr_Z_total $0 lo - 1)%Z))). + (Z.to_nat (hiz - loz - 1)%Z))). { econstructor. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 5. simpl. lia. - eauto. eauto. - - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 5. simpl. lia. - eauto. eauto. - - eassumption. - - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. - intros. apply H19. lia. - eauto. eauto. - - intros. - eapply H21. lia. - - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. - intros. eapply H22. lia. lia. - eauto. eauto. - - rewrite eval_Zexpr_Z_total_add_distr; eauto. - unfold eval_Zexpr_Z_total at 3. simpl. - rewrite Z.sub_0_r. rewrite Z2Nat.id. - 2: lia. lia. } + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + eauto. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz. intros. + eapply H18. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz. intros. + eapply H20. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz, Hhiz. intros. + eapply H21. lia. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz, Hhiz. lia. } cases l. { simpl in *. clear Hsh'. invs. - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H. rewrite H0. reflexivity. } simpl in *. - assert ((eval_Zexpr_Z_total $0 hi) = - (eval_Zexpr_Z_total $0 lo + 1))%Z by lia. - rewrite H20 in *. - replace (Z.to_nat (eval_Zexpr_Z_total $0 lo + 1 - - eval_Zexpr_Z_total $0 lo))%Z with 1 by lia. + assert (hiz = loz + 1)%Z by lia. + subst. + replace (Z.to_nat (loz + 1 - loz))%Z with 1 by lia. simpl. split. econstructor. eapply relate_pads_gen_pad. eapply IHeval_expr1. - eauto. eapply H22. lia. lia. eauto. eauto. - eauto. eauto. eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape; - eauto. econstructor. - + eauto. eapply H21. lia. lia. eauto. eauto. + eauto. eauto. eauto. + eapply size_of_eval_expr_result_has_shape; eauto. + constructor. rewrite firstn_nil. split; eauto. cases ll. simpl. eauto. simpl. rewrite firstn_nil. econstructor. 2: eauto. eapply IHeval_expr1. - eauto. eapply H19. lia. auto. auto. auto. eauto. } + eauto. eapply H18. lia. auto. auto. auto. eauto. } eapply IHeval_expr2 in Hsh'; clear IHeval_expr2. - 2: { invert H7. invert H6. - rewrite H18,H17. - simpl. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - rewrite app_no_dups_empty_r. - propositional. lia. - econstructor; eauto. - eauto. } 2: eauto. simpl in Hsh'. invs. - cases (Z.to_nat (eval_Zexpr_Z_total $0 hi - - eval_Zexpr_Z_total $0 lo)). lia. - 2: { eauto. } + cases (Z.to_nat (hiz - loz)). lia. 2: { eauto. } - 2: { econstructor; eauto. } - - eapply result_shape_gen_length in H5. - 2: { simpl. rewrite H. reflexivity. } - 2: { rewrite H0. reflexivity. } - rewrite firstn_all2 in H18. + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. + split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. econstructor; eauto. } + + rewrite firstn_all2 in H8. 2: { rewrite length_app. rewrite length_rev. simpl in *. lia. } - eapply Forall_app in H18. invs. + eapply Forall_app in H8. invs. simpl rev. repeat rewrite skipn_app. repeat rewrite firstn_app. @@ -3789,20 +3476,18 @@ Proof. split. split. split. eapply forall_firstn. eauto. eapply forall_firstn. eauto. simpl in H5. - simpl length. + simpl length in *. replace (Datatypes.S n - length l - 1) with 1 by lia. simpl. econstructor. eapply relate_pads_gen_pad. eapply IHeval_expr1. eauto. - eapply H22. lia. lia. eauto. eauto. eauto. eauto. eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape. - eauto. eauto. eauto. eauto. - simpl length. - + eapply H21. lia. lia. eauto. eauto. eauto. eauto. eauto. + eapply size_of_eval_expr_result_has_shape; eauto. + constructor. + simpl length in *. + simpl in H5. - assert (length l = - Z.to_nat (eval_Zexpr_Z_total $0 hi - - eval_Zexpr_Z_total $0 lo - 1) -1) by lia. + assert (length l = Z.to_nat (hiz - loz - 1) -1) by lia. rewrite skipn_all2. 2: { rewrite length_rev. lia. } rewrite firstn_nil. @@ -3818,268 +3503,173 @@ Proof. cases ll. simpl. eauto. lia. -- cases ll. - { simpl. pose proof H5. - eapply length_eval_expr_gen in H8. - 2: { simpl. rewrite H,H0. reflexivity. } + { simpl. rewrite skipn_app. repeat rewrite firstn_app. rewrite length_skipn. rewrite length_rev. cases (c - length l). - simpl. rewrite app_nil_r. - simpl in H23. rewrite Z.sub_0_r in H23. - rewrite Z2Nat.inj_sub in H23 by lia. - rewrite Z.sub_add_distr in H8. - rewrite Z2Nat.inj_sub in H8 by lia. rewrite H8 in Heq. + simpl in H22. rewrite Z.sub_0_r in H22. + rewrite Z2Nat.inj_sub in H22 by lia. + rewrite Z.sub_add_distr in H32. + rewrite Z2Nat.inj_sub in H32 by lia. rewrite H32 in Heq. cases (rr - (Datatypes.length l - c)). + simpl. rewrite app_nil_r. eapply IHeval_expr2 in Hsh'. - 2: { invert H6. invert H7. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - rewrite H17,H18. - propositional. lia. econstructor; eauto. eauto. } - 2: { eapply HasPadGen with (ll:=0) (k:=0) (rr:=rr) (c:=c). - lia. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. - unfold eval_Zexpr_Z_total at 3. simpl. intros. - eapply H19. lia. eauto. eauto. - intros. eapply H21. lia. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. - unfold eval_Zexpr_Z_total at 4. simpl. intros. - eapply H22. lia. lia. eauto. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. - simpl. lia. eauto. eauto. } - 2: { eauto. } + 2: { eapply HasPadGen with (k:=0) (ll:=0) (c:=0) (rr:=rr-1). + lia. lia. lia. eauto. + + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz. + intros. apply H18. lia. + + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhiz. + intros. apply H20. lia. + + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhiz. + intros. apply H21. lia. lia. + + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. + lia. } 2: { eauto. } - 2: econstructor; eauto. + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. + split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. econstructor; eauto. } simpl in Hsh'. invs. - split. eauto. eauto. + replace c with 0 in * by lia. simpl in *. + eassert (_ - _ = _) as ->. 2: solve[eauto]. lia. + simpl. rewrite firstn_nil. rewrite firstn_all2 with (n:=rr). 2: { rewrite length_skipn. rewrite length_rev. lia. } - rewrite <- H8 in *. + rewrite <- H32 in *. eapply IHeval_expr2 in Hsh'. - 2: { invert H6. invert H7. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. - rewrite H17,H18. - propositional. lia. econstructor; eauto. eauto. } 2: { eapply HasPadGen with (ll:=0) (k:=0) (rr:=rr-1) (c:=c). lia. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. - unfold eval_Zexpr_Z_total at 3. simpl. intros. - eapply H19. lia. eauto. eauto. - intros. eapply H21. lia. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. - unfold eval_Zexpr_Z_total at 4. simpl. intros. - eapply H22. lia. lia. eauto. eauto. - erewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. - simpl. lia. eauto. eauto. } - 2: { eauto. } + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. lia. + eassumption. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz. lia. + + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhiz. + intros. apply H20. lia. + + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hhiz. + intros. apply H21. lia. lia. + + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. lia. } 2: { eauto. } - 2: econstructor; eauto. + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. + split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. econstructor; eauto. } simpl in Hsh'. invs. split. eauto. split. eauto. rewrite Forall_app. - split. auto. - rewrite firstn_all2 in H23. + rewrite firstn_all2 in H10. 2: { rewrite length_skipn. rewrite length_rev. - rewrite H8. lia. } - eauto. - eauto. econstructor. 2: eauto. - eapply IHeval_expr1. eauto. eapply H21. + rewrite H32. lia. } + split. auto. + econstructor. 2: eauto. + eapply IHeval_expr1. eauto. eapply H20. lia. eauto. eauto. eauto. eauto. - lia. } - assert (has_pad sh v g (Gen i (lo + | 1 |)%z hi body) + assert (has_pad v g (Gen i (lo + | 1 |)%z hi body) (PadCons 0 ll pad1 rr pad2 c)). { econstructor. - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. - - eassumption. - - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 3. simpl. - intros. apply H19. lia. - eauto. eauto. - - intros. eapply H21. lia. - - rewrite eval_Zexpr_Z_total_add_distr. - unfold eval_Zexpr_Z_total at 2. simpl. - unfold eval_Zexpr_Z_total at 4. simpl. - intros. eapply H22. lia. lia. - eauto. eauto. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz, Hloz. lia. + eauto. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz. intros. + eapply H18. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hhiz. intros. + eapply H20. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz, Hhiz. intros. + eapply H21. lia. lia. + unfold eval_Zexpr_Z_total. simpl. rewrite Hloz, Hhiz. lia. } - rewrite eval_Zexpr_Z_total_add_distr; eauto. - unfold eval_Zexpr_Z_total at 3. simpl. lia. } - cases l. - { simpl in *. - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H,H0. reflexivity. } - simpl in *. lia. } + { simpl in *. lia. } eapply IHeval_expr2 in Hsh'; eauto. - 2: { invert H7. invert H6. - rewrite H18,H17. - rewrite eval_Zexpr_Z_total_add_distr. - simpl. - unfold eval_Zexpr_Z_total at 3. - simpl. - propositional. lia. - econstructor; eauto. eauto. } - 2: { econstructor; eauto. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. + split; eauto. do 2 eexists. split; [|split]; eauto. lia. } + 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. econstructor; eauto. } simpl in Hsh'. invs. split. eauto. - rewrite firstn_app in *. + rewrite firstn_app in *. repeat rewrite length_rev in *. simpl length. simpl rev. rewrite firstn_app. rewrite length_rev. - eapply Forall_app in H18. invs. + eapply Forall_app in H8. invs. repeat rewrite Forall_app. split. split. eauto. eauto. - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H,H0. reflexivity. } - simpl in H5. + simpl length in *. replace (c - Datatypes.S (Datatypes.length l)) with 0 by lia. simpl. eauto. - pose proof H5 as HH. - eapply length_eval_expr_gen in H5. - 2: { simpl. rewrite H,H0. reflexivity. } - simpl in H5. simpl. split. econstructor. 2: { eauto. } - eapply IHeval_expr1. eauto. eapply H19. lia. eauto. eauto. + eapply IHeval_expr1. eauto. eapply H18. lia. eauto. eauto. eauto. eauto. rewrite skipn_app. rewrite firstn_app. rewrite Forall_app. split. eauto. rewrite length_skipn. rewrite length_app. rewrite length_rev. - simpl. + simpl in *. replace (c - (Datatypes.length l + 1)) with 0 by lia. simpl. replace (rr - (Datatypes.length l + 1 - c)) with 0 by lia. simpl. econstructor. - (* STEP SUM *) simpl in *. - inversion Hconst as [ Hconstlo [ Hconsthi Hconst' ] ]; clear Hconst. - assert (eq_zexpr lo (| eval_Zexpr_Z_total $0 lo|)%z) as Hlo. - { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. } - assert (eq_zexpr hi (| eval_Zexpr_Z_total $0 hi|)%z) as Hhi. - { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. } - pose proof Hconst' as Hconst. + invert Hsize. + rename H into Hloz. rename H0 into Hhiz. + invert Hpad. - { invert Hlo. invert Hhi. - eapply eval_Zexpr_Z_eval_Zexpr in H,H0. - eapply H7 in H. eapply H9 in H0. invert H. invert H0. - lia. } - eapply IHeval_expr1 in Hconst'. - 2: { eapply H15. - eapply eval_Zexpr_Z_eval_Zexpr in H,H0. - invert Hlo. eapply H7 in H. invert H. - invert Hhi. eapply H in H0. invert H0. lia. } + { cbv [eval_Zexpr_Z_total] in *. rewrite Hloz, Hhiz in *. lia. } + cbv [eval_Zexpr_Z_total] in *. rewrite Hloz, Hhiz in *. + eassert (Hsz: size_of _ _ _) by eassumption. + eapply IHeval_expr1 in Hsz. + 2: { eapply result_has_shape_add_result_result in Hsh; eauto. invs. + apply H13. lia. } 2: { eapply result_has_shape_add_result_result in Hsh; eauto. invs. eauto. } - assert (vars_of_Zexpr lo ++/ [] = [] /\ - vars_of_Zexpr hi = [] /\ constant_nonneg_bounds body) - as Hconst''. - { invert Hlo. invert Hhi. propositional. rewrite Hconstlo. reflexivity. } - - assert (0 < eval_Zexpr_Z_total $0 hi - (eval_Zexpr_Z_total $0 lo + 1) \/ - eval_Zexpr_Z_total $0 hi = eval_Zexpr_Z_total $0 lo + 1)%Z - as Hcase by lia. + assert (0 < hiz - (loz + 1) \/ hiz = loz + 1)%Z as Hcase by lia. inversion Hcase as [ Hcase1 | Hcase2 ]; clear Hcase. - + simpl in *. - eapply IHeval_expr2 in Hconst''. - 2: { eapply HasPadSum. - intros. eapply H15. - rewrite eval_Zexpr_Z_total_add_distr in *. - unfold eval_Zexpr_Z_total in *. simpl in *. lia. - eauto. eauto. - rewrite eval_Zexpr_Z_total_add_distr in *. - unfold eval_Zexpr_Z_total at 3. simpl. lia. - eauto. eauto. } - 2: { eapply result_has_shape_add_result_result in Hsh; eauto. invs. - eauto. } - 2: { eauto. } - - eapply add_result_relate_pads. eauto. - eauto. eauto. eauto. econstructor; eauto. - invs. eauto. - + invert H5. - * simpl in *. rewrite H in H11. invs. rewrite H12 in *. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H12, H. - invert Hlo. invert Hhi. - eapply H0 in H. eapply H10 in H12. invert H. invert H12. - rewrite Hcase2 in *. lia. - * simpl in *. rewrite H in H11. invs. rewrite H14 in *. invs. - eapply eval_Zexpr_Z_eval_Zexpr in H14, H. - invert Hlo. invert Hhi. - eapply H0 in H. eapply H10 in H14. invert H. invert H14. - rewrite Hcase2 in *. - pose proof H6. eapply result_has_shape_add_result_result in H; eauto. + + eapply add_result_relate_pads. + 3: { eapply IHeval_expr2. + { eapply HasPadSum. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. + intros. apply H13. lia. + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. lia. } + eapply result_has_shape_add_result_result in Hsh; eauto. + invs. eauto. eauto. eauto. econstructor; eauto. } + eauto. eauto. + + subst. invert H5. + * simpl in *. rewrite Hhiz, Hloz in *. invs'. lia. + * simpl in *. rewrite Hhiz, Hloz in *. invs'. + pose proof H6 as H. eapply result_has_shape_add_result_result in H; eauto. invs. - pose proof (result_has_shape_gen_pad (map Z.to_nat lz)). - eapply result_has_shape_result_shape_nat in H13,H. - rewrite H in H13. clear H. symmetry in H13. + pose proof (result_has_shape_gen_pad sz). + eapply result_has_shape_result_shape_nat in H5,H. + rewrite H in H5. clear H. symmetry in H5. eapply add_result_gen_pad_r in H6. 2: { reflexivity. } 2: { eapply result_has_shape_filter_until_0. - rewrite <- H13. + rewrite <- H5. erewrite <- result_has_shape_filter_until_0. eauto. } subst. eauto. - + eauto. - + eauto. - + invs. eauto. + + eauto. + + eauto. - (* EMPTY SUM *) - pose proof Hpad as Hpad'. + invert Hsize. + rename H into Hloz. rename H0 into Hhiz. + invert Hpad. - 2: { simpl in *. invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H4,H6. - invert H4. invert H6. - eapply eval_Zexpr_Z_eval_Zexpr in H,H0. - eapply H5 in H. eapply H4 in H0. invert H. invert H0. lia. } + 2: { cbv [eval_Zexpr_Z_total] in *. rewrite Hloz, Hhiz in *. lia. } - simpl in *. invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H4,H6. - pose proof H4. pose proof H6. - invert H4. invert H6. - eapply eval_Zexpr_Z_eval_Zexpr in H,H0. - eapply H5 in H. eapply H4 in H0. invert H. invert H0. - - pose proof (result_has_shape_gen_pad (map Z.to_nat lz)). + cbv [eval_Zexpr_Z_total] in *. rewrite Hloz, Hhiz in *. + + pose proof (result_has_shape_gen_pad sz). pose proof H as HH. pose proof Hsh as HshHsh. eapply result_has_shape_result_shape_nat in H,Hsh. eapply relate_pads_filter_until_0. @@ -4088,265 +3678,227 @@ Proof. rewrite H in Hsh. rewrite gen_pad_filter_until_0. rewrite <- Hsh. eq_size_of. - - pose proof H7. eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0. - eq_eval_Zlist. eapply relate_pads_filter_until_0. rewrite <- gen_pad_filter_until_0. eapply result_has_shape_gen_pad. - rewrite <- gen_pad_filter_until_0. + rewrite <- gen_pad_filter_until_0. eapply relate_pads_gen_pad_id. - (* FALSE GUARD *) - invert Hsize. pose proof H5 as Hsize. + simpl in *. + pose proof Hsize as Hsize'. + invert Hsize'. invert Hpad. - + (* FALSE *) eq_size_of. pose proof Hconst as Hconst'. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape - with (sh:=sh) (v:=v) (ec:=ec) in Hconst'. - 2: { econstructor; eauto. } - 2: { econstructor. eauto. eauto. eauto. } - pose proof Hsh as Hsh'. pose proof Hconst' as Hsh''. - eapply result_has_shape_result_shape_nat in Hsh',Hsh''. - rewrite Hsh' in Hsh''. clear Hsh'. - cases sh0. invert H1. - simpl. propositional. simpl in Hsh''. cases rsh. reflexivity. + + (* FALSE *) + eq_size_of. + eapply size_of_includes in Hsize. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize. + simpl in *. + 2: { econstructor; eauto. } + 2: { eauto. } + pose proof Hsh as Hsh'. pose proof Hsize as Hsize'. + eapply result_has_shape_result_shape_nat in Hsh', Hsize'. + rewrite Hsh' in Hsize'. clear Hsh'. + cases sz. + simpl. propositional. simpl in Hsh. cases rsh. reflexivity. simpl in *. cases n; simpl in *; try discriminate. - invert H1. cases rsh. simpl in *. invert Hsh. - pose proof H0. - eapply constant_nonneg_bounds_size_of_no_vars in H1; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1. - invert H1. eq_eval_Z. eq_eval_Zlist. - pose proof Hsh. + cases rsh. simpl in *. invert Hsh. + pose proof Hsh as H1. simpl in H1. eapply result_has_shape_length in H1. rewrite repeat_length in H1. subst. - repeat rewrite <- map_cons. - + eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. rewrite gen_pad_filter_until_0. - rewrite <- Hsh''. - eapply result_has_shape_gen_pad. - - repeat rewrite <- map_cons. - rewrite Hsh''. + rewrite <- Hsize'. + apply result_has_shape_gen_pad. + + rewrite Hsize'. eapply relate_pads_filter_until_0. eapply result_has_shape_gen_pad. eapply relate_pads_gen_pad_id. - + eq_size_of. clear H2. eapply relate_pads_filter_until_0. eauto. - pose proof (result_has_shape_gen_pad (map Z.to_nat lz)). - eapply result_has_shape_result_shape_nat in Hsh,H2. - rewrite Hsh in H2. - rewrite H2. - rewrite gen_pad_filter_until_0. pose proof H0. - eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0. - eq_eval_Zlist. + + eq_size_of. clear Hsize. eapply relate_pads_filter_until_0. eauto. + pose proof (result_has_shape_gen_pad sz) as Hsh'. + eapply result_has_shape_result_shape_nat in Hsh,Hsh'. + rewrite Hsh in Hsh'. + rewrite Hsh'. + rewrite gen_pad_filter_until_0. eapply has_pad_size_of_relate_pads_gen_pad. eauto. eauto. eauto. - (* TRUE GUARD *) - invert Hsize. eq_size_of. + invert Hsize. eq_size_of. invert Hpad. + eq_eval_B. discriminate. - + simpl in *. + + simpl in *. eapply IHeval_expr; eauto. - - (* LET SCALAR *) - invert Hsize. eq_size_of. - invert Hpad. simpl in *. invs. - eq_size_of. - eapply IHeval_expr1 in H12. - 2: { eauto. } - 2: { econstructor. } - 2: { eauto. } - 2: { eauto. } - 2: { eauto. } - eapply IHeval_expr2; eauto. - { intros. - cases (x0 ==v x); subst. - + rewrite lookup_add_eq in * by auto. invert H10. invert H1. - simpl. assumption. - + rewrite lookup_add_ne in * by auto. eauto. } - { intros. - cases (x0 ==v x); subst. - + rewrite lookup_add_eq in * by auto. invert H10. invert H1. - simpl. econstructor. - + rewrite lookup_add_ne in * by auto. eauto. } - - (* LET VECTOR *) + - (* LET *) invert Hsize. eq_size_of. invert Hpad. simpl in *. invs. eq_size_of. - eapply IHeval_expr1 in H14. - 2: { eauto. } - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape; - try apply H5; eauto. } + eapply IHeval_expr1 in H11. + 2: { eauto using size_of_eval_expr_result_has_shape, size_of_includes, nonneg_bounds_includes, empty_includes. } 2: { eauto. } 2: { eauto. } 2: { eauto. } eapply IHeval_expr2; eauto. { intros. cases (x0 ==v x); subst. - + rewrite lookup_add_eq in * by auto. invert H12. invert H3. + + rewrite lookup_add_eq in * by auto. invs. erewrite result_has_shape_result_shape_nat. - 2: { eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape; - try apply H5; eauto. } + 2: { eauto using size_of_eval_expr_result_has_shape, size_of_includes, nonneg_bounds_includes, empty_includes. } eapply relate_pads_filter_until_0; eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in H0; eauto. - + rewrite lookup_add_ne in * by auto. eauto. } - { intros. - cases (x0 ==v x); subst. - + rewrite lookup_add_eq in * by auto. invert H12. invert H3. - simpl. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape; - try apply H5; eauto. + eauto using size_of_eval_expr_result_has_shape, size_of_includes, nonneg_bounds_includes, empty_includes. + rewrite lookup_add_ne in * by auto. eauto. } - (* CONCAT *) - invert Hsize. pose proof H3 as Hsize1. pose proof H4 as Hsize2. - clear H3. clear H4. + invert Hsize. rename H3 into Hsize1. rename H4 into Hsize2. invert Hpad. - eq_size_of. invert H1. invert H2. + eq_size_of. invs'. simpl in *. invs. cases rsh. invert Hsh. - + pose proof Hsh as Hsh'. eapply result_has_shape_app_r in Hsh'. 2: { reflexivity. } pose proof Hsh as Hsh''. eapply result_has_shape_app_l in Hsh''. 2: { reflexivity. } - pose proof H1. pose proof H2. + pose proof Hsize1 as Hsh1. pose proof Hsize2 as Hsh2. - pose proof H1 as Hsh1'. pose proof H2 as Hsh2'. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in Hsh1'; - eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in Hsh2'; - eauto. + eapply size_of_includes in Hsh1. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh1; eauto. + eapply size_of_includes in Hsh2. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh2; eauto. eapply result_has_shape_length in Hsh. rewrite length_app in *. - pose proof Hsh1' as Hsh1''. pose proof Hsh2' as Hsh2''. + pose proof Hsh1 as Hsh1''. pose proof Hsh2 as Hsh2''. pose proof Hsh' as HH. pose proof Hsh'' as HHH. eapply result_has_shape_result_shape_nat in HH,HHH,Hsh1'',Hsh2''. rewrite Hsh1'',Hsh2'' in *. clear Hsh''. clear Hsh2''. subst. rewrite add_sub in *. rewrite minus_plus in *. - pose proof Hsh1' as Hlen1. pose proof Hsh2' as Hlen2. + pose proof Hsh1 as Hlen1. pose proof Hsh2 as Hlen2. eapply result_has_shape_length in Hlen1,Hlen2. - repeat rewrite map_cons in *. rewrite <- Hlen1 in *. rewrite <- Hlen2 in *. - + cases l1; cases l2. { simpl in *. repeat rewrite firstn_nil. repeat rewrite skipn_nil. simpl. repeat rewrite firstn_nil. simpl. propositional; econstructor. } - { simpl in *. - invert HHH. symmetry in H11. - subst. - eapply IHeval_expr2 in Hsh2'; eauto. - simpl in *. invs. + { cbn -[Nat.sub] in *. + invs'. + eapply IHeval_expr2 in Hsh2; eauto. + cbn -[Nat.sub] in *. invs. replace x with 0 in * by lia. replace y with 0 in * by lia. simpl. split. auto. split. rewrite gen_pad_filter_until_0. - rewrite H11. rewrite <- gen_pad_filter_until_0. auto. + rewrite <-H4. rewrite <- gen_pad_filter_until_0. auto. replace (rev l2 ++ [r])%list with (rev (r::l2)) by auto. split. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H3; - eauto. - invert H3. - replace l4 with 0 by lia. simpl. econstructor. + pose proof Hsize1 as Hsh1'''. + eapply size_of_includes in Hsh1'''. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh1'''; eauto. + invert Hsh1'''. + replace l0 with 0 by lia. simpl. econstructor. simpl. - eapply Forall_forall. intros. eapply Forall_forall in H17. + eapply Forall_forall. intros. eapply Forall_forall in H14. 2: eassumption. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H0; - eauto. + pose proof Hsize2 as Hsh2'''. + eapply size_of_includes in Hsh2'''. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsh2'''; eauto. replace (rev l2 ++ [r])%list with (rev (r::l2)) in * by auto. - simpl map in H0. - eapply result_has_shape_forall in H0. + simpl map in Hsh2'''. + eapply result_has_shape_forall in Hsh2'''. eapply relate_pads_filter_until_0. - eapply Forall_rev in H0. eapply forall_skipn in H0. - eapply forall_firstn in H0. - eapply Forall_forall in H0. - 2: { apply H16. } - eapply result_has_shape_filter_until_0. rewrite H11. - erewrite <- result_has_shape_filter_until_0. eauto. - rewrite H11. + eapply Forall_rev in Hsh2'''. eapply forall_skipn in Hsh2'''. + eapply forall_firstn in Hsh2'''. + eapply Forall_forall in Hsh2'''. + 2: { eassumption. } + eapply result_has_shape_filter_until_0. rewrite <- H4. + erewrite <- result_has_shape_filter_until_0. eauto. + rewrite <- H4. eapply relate_pads_filter_until_0. - eapply Forall_rev in H0. eapply forall_skipn in H0. - eapply forall_firstn in H0. - eapply Forall_forall in H0. - 2: { apply H16. } + eapply Forall_rev in Hsh2'''. eapply forall_skipn in Hsh2'''. + eapply forall_firstn in Hsh2'''. + eapply Forall_forall in Hsh2'''. + 2: { eassumption. } eauto. eauto. } - { simpl in *. rewrite app_nil_r in *. - invert HH. symmetry in H11. - eapply IHeval_expr1 in H1; eauto. simpl in *. invs. + { simpl in *. rewrite app_nil_r in *. + invert HH. symmetry in H4. + pose proof Hsize1 as Hsh1'''. + eapply IHeval_expr1 in Hsh1'''; eauto. simpl in *. invs. replace a with 0 in * by lia. replace b with 0 in * by lia. simpl. split. - rewrite gen_pad_filter_until_0. rewrite H11. + rewrite gen_pad_filter_until_0. rewrite H4. rewrite <- gen_pad_filter_until_0. auto. split. auto. split. - eapply Forall_forall. intros. eapply Forall_forall in H12. + eapply Forall_forall. intros. eapply Forall_forall in H9. 2: eassumption. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H; - eauto. - simpl map in H. eapply result_has_shape_forall in H. + eapply size_of_eval_expr_result_has_shape in H. + 2: eapply nonneg_bounds_includes; [|eassumption]; solve[sets]. + 2: eapply size_of_includes; [apply empty_includes|eassumption]. + eapply result_has_shape_forall in H. eapply relate_pads_filter_until_0. eapply forall_skipn in H. eapply forall_firstn in H. - eapply Forall_forall in H. 2: apply H14. + eapply Forall_forall in H. 2: eassumption. eapply result_has_shape_filter_until_0. - rewrite H11. + rewrite H4. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite H11. + rewrite H4. eapply relate_pads_filter_until_0. eapply forall_skipn in H. eapply forall_firstn in H. - eapply Forall_forall in H. 2: apply H14. + eapply Forall_forall in H. 2: eassumption. eauto. eauto. replace r2 with 0 by lia. simpl. econstructor. } invert HHH. invert HH. - - eapply IHeval_expr1 in H1; eauto. - eapply IHeval_expr2 in H2; eauto. - simpl in H1,H2. invs. + + pose proof Hsize1 as Hsh1'''. pose proof Hsize2 as Hsh2'''. + eapply IHeval_expr1 in Hsh1'''; eauto. + eapply IHeval_expr2 in Hsh2'''; eauto. + simpl in Hsh1''',Hsh2'''. invs. rewrite firstn_app. replace (x - length (r::l1)) with 0 by lia. split. simpl. rewrite app_nil_r. auto. - eapply Forall_forall. intros. eapply Forall_forall in H16. + eapply Forall_forall. intros. eapply Forall_forall in H18. 2: eassumption. subst. - rewrite gen_pad_filter_until_0. rewrite H12. - rewrite <- gen_pad_filter_until_0. auto. + rewrite gen_pad_filter_until_0. simpl in *. + rewrite <- H4. subst. + rewrite <- gen_pad_filter_until_0. reflexivity. rewrite rev_app_distr. rewrite firstn_app. rewrite length_rev. replace (b - Datatypes.length (r0 :: l2)) with 0 by lia. split. simpl. rewrite app_nil_r. - eapply Forall_forall. intros. eapply Forall_forall in H2. + eapply Forall_forall. intros. eapply Forall_forall in H12. 2: { eassumption. } subst. - rewrite gen_pad_filter_until_0. rewrite H11. - rewrite <- gen_pad_filter_until_0. auto. + rewrite gen_pad_filter_until_0. rewrite H4. + rewrite <- gen_pad_filter_until_0. reflexivity. rewrite skipn_app. rewrite firstn_app. rewrite length_skipn. - replace (l4 - (Datatypes.length (r :: l1) - x)) with 0 by lia. + replace (l0 - (Datatypes.length (r :: l1) - x)) with 0 by lia. split. simpl. rewrite app_nil_r. - eapply Forall_forall. intros. eapply Forall_forall in H18. + eapply Forall_forall. intros. eapply Forall_forall in H16. 2: { eassumption. } - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H; - eauto. + eapply size_of_eval_expr_result_has_shape in H. + 2: eapply nonneg_bounds_includes; [|eassumption]; solve[sets]. + 2: eapply size_of_includes; [apply empty_includes|eassumption]. simpl map in H. eapply result_has_shape_forall in H. eapply relate_pads_filter_until_0. eapply forall_skipn in H. eapply forall_firstn in H. eapply Forall_forall in H. 2: eassumption. eapply result_has_shape_filter_until_0. - rewrite <- H12. + rewrite <- H4. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite <- H12. + rewrite <- H4. eapply relate_pads_filter_until_0. eapply forall_skipn in H. eapply forall_firstn in H. eapply Forall_forall in H. 2: eassumption. @@ -4358,20 +3910,21 @@ Proof. replace (r2 - (Datatypes.length (r0 :: l2) - b)) with 0 by lia. simpl firstn at 2. rewrite app_nil_r. simpl. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H0; - eauto. + eapply size_of_eval_expr_result_has_shape in H0. + 2: eapply nonneg_bounds_includes; [|eassumption]; solve[sets]. + 2: eapply size_of_includes; [apply empty_includes|eassumption]. simpl map in H0. eapply result_has_shape_forall in H0. - eapply Forall_forall. intros. eapply Forall_forall in H17. + eapply Forall_forall. intros. eapply Forall_forall in H15. 2: eassumption. eapply relate_pads_filter_until_0. eapply Forall_rev in H0. eapply forall_skipn in H0. eapply forall_firstn in H0. eapply Forall_forall in H0. 2: eassumption. eapply result_has_shape_filter_until_0. - rewrite <- H11. + rewrite <- H4. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite <- H11. + rewrite <- H4. eapply relate_pads_filter_until_0. eapply Forall_rev in H0. eapply forall_skipn in H0. eapply forall_firstn in H0. @@ -4380,55 +3933,47 @@ Proof. - (* TRANSPOSE *) invert Hpad; invert Hsize; eq_size_of. { (* STRONG *) - invert H2. invert H6. + invert H1. invert H5. + rename H3 into Hsize. simpl in *|-. - pose proof Hconst as Hconst'. + pose proof Hsize as Hsize'. cases rsh. unfold transpose_result in Hsh. invert Hsh. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in Hconst'. - 2: { eauto. } - 2: { eauto. } + eapply size_of_includes in Hsize'. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize'; eauto. - pose proof Hconst as Hconst''. - eapply constant_nonneg_bounds_size_of_no_vars in Hconst''; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in Hconst''; eauto. - eq_eval_Zlist. simpl map in *. invert H2. - - pose proof Hconst' as Hsh'. + pose proof Hsize' as Hsh'. eapply result_has_shape_transpose_result in Hsh'. - pose proof Hsh'. pose proof Hsh. - eapply result_has_shape_result_shape_nat in H2,H4. - rewrite H2 in H4. clear H2. + pose proof Hsh' as Hsh''. pose proof Hsh as Hsh'''. + eapply result_has_shape_result_shape_nat in Hsh'',Hsh'''. + rewrite Hsh''' in Hsh''. clear Hsh'''. unfold transpose_result in * |-. simpl. - pose proof Hconst as Hconst''. - eapply IHeval_expr in Hconst''; eauto. - simpl in Hconst''. + pose proof Hsize as Hsize''. + eapply IHeval_expr in Hsize''; eauto. + simpl in Hsize''. invs. simpl. cases l. - { simpl. invert Hconst'. rewrite <- H1 in *. - simpl in *. - clear H2. clear H7. clear H10. clear H6. + { simpl. invert Hsize'. simpl in *. repeat rewrite rev_repeat in *. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m1)). + cases m. - simpl in *. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. - - simpl in H4. cases n. simpl in H4. - invert H4. simpl in H4. invert H4. + - simpl in Hsh''. cases n0. simpl in Hsh''. + invert Hsh''. simpl in Hsh''. invert Hsh''. cases rsh. simpl in *. discriminate. - simpl in H7. cases n0; invert H7. + simpl in H9. cases n; invert H9. split. eapply forall_firstn. eapply Forall_repeat. reflexivity. split. eapply forall_firstn. eapply Forall_repeat. reflexivity. split. eapply forall_firstn. eapply forall_skipn. eapply Forall_repeat. simpl. repeat rewrite firstn_nil. eauto. eapply forall_firstn. eapply forall_skipn. eapply Forall_repeat. simpl. repeat rewrite firstn_nil. eauto. } - + erewrite result_has_shape_row_length in *. 2: { inversion 1. } 2: { eauto. } @@ -4436,41 +3981,40 @@ Proof. 2: { eauto. } 2: { inversion 1. } 2: { eauto. } - + rewrite <- gen_pad_cons in *. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m1)). + cases m. { simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } - rewrite filter_until_cons in * by lia. - cases n. simpl in H4. invert H4. - symmetry in H4. - rewrite filter_until_cons in H4 by lia. invert H4. + cases n0. simpl in Hsh''. invert Hsh''. + symmetry in Hsh''. + rewrite filter_until_cons in Hsh'' by lia. invert Hsh''. erewrite pad_list_result_shape_id in *; eauto. - 2: { invert Hconst'. lia. } - 2: { invert Hconst'. lia. } - 2: { invert Hconst'. lia. } - + 2: { invert Hsize'. lia. } + 2: { invert Hsize'. lia. } + 2: { invert Hsize'. lia. } + erewrite firstn_transpose_result_list; eauto. - 2: { invert Hconst'. lia. } - 2: { invert Hconst'. lia. } + 2: { invert Hsize'. lia. } + 2: { invert Hsize'. lia. } - rewrite sub_diag. + rewrite sub_diag. erewrite Forall_map. erewrite firstn_rev_transpose_result_list; eauto. - 2: { invert Hconst'. lia. } - 2: { invert Hconst'. lia. } + 2: { invert Hsize'. lia. } + 2: { invert Hsize'. lia. } erewrite Forall_map. - invert Hconst'. - rewrite <- H9 in H11. simpl in H11. - cases rsh. invert H11. - cases n. invert H11. invert H11. - + invert Hsize'. + simpl in H9. + cases rsh. invert H9. + cases n. invert H9. invert H9. + split. { - eapply Forall_forall. intros. - eapply In_nat_range in H1. - rewrite add_0_r. + eapply Forall_forall. intros ? H5. + eapply In_nat_range in H5. + rewrite add_0_r. erewrite <- (firstn_skipn x (r0::l)). erewrite get_col_app. 2: { eapply forall_result_has_shape. @@ -4487,8 +4031,8 @@ Proof. 2: { eauto. } 2: lia. rewrite length_firstn. - rewrite firstn_rev in H7. pose proof H7. - eapply Forall_rev in H4. rewrite rev_involutive in H4. + rewrite firstn_rev in H3. pose proof H3. + eapply Forall_rev in H8. rewrite rev_involutive in H8. simpl length in *. erewrite <- (firstn_skipn (Datatypes.S (Datatypes.length l) - y) @@ -4529,7 +4073,6 @@ Proof. rewrite add_0_l. replace (Datatypes.S (length l) - (Datatypes.S (length l) - y)) with y by lia. - clear H4. rewrite <- (rev_involutive (firstn _ _)). replace (Datatypes.S (length l)) with (length (r0::l)) by auto. @@ -4562,7 +4105,6 @@ Proof. eapply Forall_rev. econstructor; eauto. rewrite length_firstn. rewrite length_skipn. rewrite length_rev. simpl. reflexivity. } - pose proof H10. eapply Forall_rev in H4. erewrite (forall_get_col_relate_pads_gen_pad (rev (firstn r (skipn y (rev (r0 :: l)))))). 4: { eapply forall_result_has_shape. @@ -4571,10 +4113,10 @@ Proof. rewrite length_rev. rewrite length_firstn. rewrite length_skipn. rewrite length_rev. simpl length. reflexivity. } 2: { eapply Forall_impl. - 2: { eapply H4. } + 2: { apply Forall_rev. eassumption. } simpl. intros. cases a0. propositional. invs. eassumption. } 2: lia. - + rewrite length_rev. rewrite length_firstn. rewrite length_skipn. rewrite length_rev. simpl length. remember (Init.Nat.min r (Datatypes.S (Datatypes.length l) - y)). @@ -4584,7 +4126,6 @@ Proof. repeat rewrite <- app_assoc. rewrite <- repeat_app. subst. - clear H4. pose proof H6. rewrite skipn_skipn. rewrite <- rev_skipn_rev_skipn. @@ -4597,7 +4138,7 @@ Proof. econstructor; eauto. rewrite length_firstn. rewrite length_skipn. simpl length. rewrite min_l. reflexivity. - lia. } + simpl in *. lia. } 2: { eapply forall_firstn_ge. eapply Forall_impl. 2:eassumption. simpl. intros. cases a0. propositional. invs. @@ -4610,55 +4151,13 @@ Proof. repeat rewrite <- repeat_app. subst. simpl length. rewrite gen_pad_cons. - rewrite gen_pad_filter_until_0. rewrite <- H13. + rewrite gen_pad_filter_until_0. rewrite H11. rewrite <- gen_pad_filter_until_0. f_equal. f_equal. - rewrite min_l by lia. - repeat rewrite add_assoc. - rewrite add_sub_assoc. - 2: { lia. } - repeat rewrite <- sub_add_distr. - rewrite (Nat.add_comm r y). - rewrite (Nat.add_comm x (y+r)). - rewrite <- add_assoc. - rewrite sub_add_distr. - rewrite sub_add_distr. - assert (r <= (Datatypes.S (Datatypes.length l) - y) \/ - r > (Datatypes.S (Datatypes.length l) - y)) - as Hcase by lia. - inversion Hcase as [ Hcase1 | Hcase2 ]; clear Hcase. - - rewrite min_l by eauto. - cases (x - (Datatypes.S (Datatypes.length l) - y - r)). - + rewrite sub_0_r. - rewrite <- add_sub_swap. - 2: { lia. } - rewrite sub_add by auto. - rewrite <- sub_add_distr. - rewrite Nat.add_comm. - rewrite add_assoc. rewrite add_sub_assoc, minus_plus. reflexivity. - rewrite Nat.add_comm. rewrite H9. auto. - + rewrite <- Heq0. - replace (_ - x) with 0 by lia. - rewrite add_0_l. rewrite add_sub_swap. - replace (x - (x - (Datatypes.S (Datatypes.length l) - y - r))) with - ((Datatypes.S (Datatypes.length l) - y - r)). - 2: { lia. } - rewrite <- sub_add_distr. - rewrite (Nat.add_comm y). - rewrite <- add_assoc. - rewrite sub_add. reflexivity. - lia. - eapply le_sub_l. - - rewrite min_r by lia. - replace (_ - r) with 0 by lia. - rewrite sub_0_r. rewrite sub_0_l. rewrite add_0_l. - rewrite minus_plus. - rewrite sub_add. reflexivity. - lia. - - lia. } + clear -H10. lia. + clear -H5. lia. } split. - { eapply Forall_forall. intros. - eapply In_nat_range in H1. - rewrite <- Heq in *. + { eapply Forall_forall. intros ? H5. + eapply In_nat_range in H5. erewrite get_col_rev. 2: { econstructor. reflexivity. eauto. eauto. } @@ -4666,7 +4165,7 @@ Proof. erewrite <- (firstn_skipn x (r0::l)). rewrite map_app. - erewrite get_col_app with (b:=(Z.to_nat (eval_Zexpr_Z_total $0 m1))). + erewrite get_col_app with (b:=Datatypes.S n0). 2: { eapply result_has_shape_map_rev. eapply forall_result_has_shape. eapply forall_firstn. econstructor; eauto. rewrite length_firstn. reflexivity. } @@ -4677,8 +4176,8 @@ Proof. erewrite forall_gen_pad_get_col. 2: { eapply Forall_map. eapply Forall_impl. 2: eassumption. - simpl. intros. subst. erewrite rev_repeat. - reflexivity. } + simpl. intros. subst. rewrite <- repeat_cons. + rewrite rev_repeat. reflexivity. } rewrite length_map. rewrite length_firstn. rewrite min_l. 2: { simpl. lia. } @@ -4686,7 +4185,7 @@ Proof. rewrite <- (firstn_skipn y (rev (r0::l))). rewrite rev_app_distr. rewrite skipn_app. rewrite map_app. rewrite length_rev. rewrite length_skipn. rewrite length_rev. - erewrite get_col_app with (b:=(Z.to_nat (eval_Zexpr_Z_total $0 m1))). + erewrite get_col_app with (b:=Datatypes.S n0). 2: { eapply result_has_shape_map_rev. eapply forall_result_has_shape. eapply forall_skipn. eapply Forall_rev. eapply forall_skipn. eapply Forall_rev. @@ -4708,23 +4207,23 @@ Proof. (rev (firstn y (rev (r0 :: l))))))). 2: { eapply Forall_map. eapply forall_skipn. eapply Forall_rev. eapply Forall_impl. 2: eassumption. - simpl. intros. subst. rewrite rev_repeat. - reflexivity. } + simpl. intros. subst. rewrite <- repeat_cons. + rewrite rev_repeat. reflexivity. } 2: lia. 2: lia. rewrite length_map. rewrite length_skipn. rewrite length_rev. rewrite length_firstn. rewrite length_rev. rewrite min_l. 2: simpl; lia. - simpl length. pose proof H12. rewrite H9. - eapply le_add_le_sub_r in H4. - eapply sub_0_le in H4. - rewrite H4. rewrite sub_0_r. + simpl length. pose proof H10. + eapply le_add_le_sub_r in H10. + eapply sub_0_le in H10. + rewrite H10. rewrite sub_0_r. rewrite <- (firstn_skipn r (skipn y (rev (r0 :: l)))). rewrite rev_app_distr. rewrite skipn_app. rewrite map_app. - erewrite get_col_app with (b:=(Z.to_nat (eval_Zexpr_Z_total $0 m1))). + erewrite get_col_app with (b:=Datatypes.S n0). 2: { eapply result_has_shape_map_rev. eapply forall_result_has_shape. eapply forall_skipn. eapply Forall_rev. eapply forall_skipn. eapply forall_skipn. @@ -4751,7 +4250,7 @@ Proof. end) (skipn (x - (Datatypes.S (Datatypes.length l) - y - r)) (rev (firstn r (skipn y (rev (r0 :: l)))))))) - with (m:=(Z.to_nat (eval_Zexpr_Z_total $0 m1))). + with (m:=Datatypes.S n0). 2: { eapply Forall_map. eapply forall_skipn. eapply Forall_rev. eapply Forall_impl. 2: eassumption. simpl. @@ -4776,7 +4275,7 @@ Proof. pose proof H5. erewrite forall_get_col_relate_pads_gen_pad - with (m:=(Z.to_nat (eval_Zexpr_Z_total $0 m1))). + with (m:=Datatypes.S n0). 2: { eapply Forall_map. eapply forall_firstn_ge. eapply Forall_impl. 2: eassumption. @@ -4797,13 +4296,11 @@ Proof. repeat rewrite <- repeat_app. subst. rewrite gen_pad_filter_until_0. - rewrite <- H13. - rewrite <- gen_pad_filter_until_0. f_equal. f_equal. - rewrite <- H9 in *. - rewrite min_l. - 2: { eapply le_sub_l. } + rewrite H11. + rewrite <- gen_pad_filter_until_0. f_equal. + rewrite <- repeat_cons. f_equal. - clear -H12. lia. + clear -H8. lia. eapply result_has_shape_map_rev. eapply forall_result_has_shape. eapply forall_firstn. @@ -4826,13 +4323,13 @@ Proof. rewrite skipn_map. rewrite firstn_nat_range_rec. rewrite sub_diag. rewrite add_0_l. - rewrite skipn_nat_range. rewrite <- Heq. rewrite <- sub_min_distr_r. + rewrite skipn_nat_range. rewrite <- sub_min_distr_r. rewrite minus_plus. split. { eapply Forall_map. - eapply Forall_forall. intros. - eapply In_nat_range_rec in H1. + eapply Forall_forall. intros ? H5. + eapply In_nat_range_rec in H5. erewrite firstn_get_col. 2: { econstructor; eauto. } erewrite rev_get_col. @@ -4846,22 +4343,22 @@ Proof. 2: { eauto. } 2: { lia. } simpl. eapply Forall_repeat. rewrite gen_pad_filter_until_0. - rewrite <- H13. rewrite <- gen_pad_filter_until_0. + rewrite H11. rewrite <- gen_pad_filter_until_0. reflexivity. erewrite forall_gen_pad_get_col. 2: { eauto. } 2: { lia. } simpl. eapply Forall_repeat. rewrite gen_pad_filter_until_0. - rewrite <- H13. rewrite <- gen_pad_filter_until_0. + rewrite H11. rewrite <- gen_pad_filter_until_0. reflexivity. } { eapply Forall_map. - eapply Forall_forall. intros. - eapply In_nat_range_rec in H1. + eapply Forall_forall. intros ? H5. + eapply In_nat_range_rec in H5. split. 2: split; eauto. erewrite get_col_rev. 2: { econstructor. reflexivity. - rewrite Heq in *. eauto. rewrite Heq in *. eauto. } + eauto. eauto. } 2: { lia. } erewrite firstn_get_col. 2: { eapply result_has_shape_map_rev. econstructor; eauto. } @@ -4873,65 +4370,56 @@ Proof. reflexivity. } 2: { lia. } eapply Forall_repeat. erewrite gen_pad_filter_until_0. - rewrite <- H13. erewrite <- gen_pad_filter_until_0. reflexivity. + rewrite H11. erewrite <- gen_pad_filter_until_0. reflexivity. erewrite rev_get_col. 2: { econstructor; eauto. } - 2: { rewrite Heq. lia. } + 2: { clear -H5. lia. } erewrite firstn_get_col. 2: { eapply result_has_shape_rev. econstructor; eauto. } erewrite forall_gen_pad_get_col. 2: { eauto. } 2: { lia. } eapply Forall_repeat. rewrite gen_pad_filter_until_0. - rewrite <- H13. rewrite <- gen_pad_filter_until_0. reflexivity. } + rewrite H11. rewrite <- gen_pad_filter_until_0. reflexivity. } } { (* WEAK *) - invert H2. invert H5. + invert H1. invert H4. simpl in *|-. - pose proof Hconst as Hconst'. + rename H3 into Hsize. pose proof Hsize as Hsize'. cases rsh. unfold transpose_result in Hsh. invert Hsh. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape - in Hconst'. - 2: { eauto. } - 2: { eauto. } - - pose proof Hconst as Hconst''. - eapply constant_nonneg_bounds_size_of_no_vars in Hconst''; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in Hconst''; eauto. - eq_eval_Zlist. simpl map in *. invert H2. + eapply size_of_includes in Hsize'. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize'; eauto. - pose proof Hconst' as Hsh'. + pose proof Hsize' as Hsh'. eapply result_has_shape_transpose_result in Hsh'. - pose proof Hsh'. pose proof Hsh. - eapply result_has_shape_result_shape_nat in H2,H4. - rewrite H2 in H4. clear H2. + pose proof Hsh' as Hsh'''. pose proof Hsh as Hsh''. + eapply result_has_shape_result_shape_nat in Hsh''',Hsh''. + rewrite Hsh''' in Hsh''. clear Hsh'''. unfold transpose_result in * |-. - pose proof Hconst as Hconst''. - eapply IHeval_expr in Hconst''; eauto. - simpl in Hconst''. + pose proof Hsize as Hsize''. + eapply IHeval_expr in Hsize''; eauto. + simpl in Hsize''. invs. simpl. cases l. - { simpl. invert Hconst'. - clear H2. clear H6. clear H5. clear H8. + { simpl. invert Hsize'. repeat rewrite rev_repeat in *. simpl. split. auto. split. auto. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m0)). + cases m. - simpl in *. repeat rewrite firstn_nil. eauto. - - simpl in H4. cases n. simpl in H4. - invert H4. simpl in H4. invert H4. - rewrite <- H1 in *. simpl in H6. + - simpl in Hsh''. cases n0. simpl in Hsh''. + invert Hsh''. simpl in Hsh''. invert Hsh''. cases rsh. simpl in *. discriminate. split. eapply forall_firstn. eapply Forall_repeat. simpl. repeat rewrite firstn_nil. eauto. eapply forall_firstn. eapply Forall_repeat. simpl. repeat rewrite firstn_nil. eauto. } - + erewrite result_has_shape_row_length in *. 2: { inversion 1. } 2: { eauto. } @@ -4939,41 +4427,41 @@ Proof. 2: { eauto. } 2: { inversion 1. } 2: { eauto. } - + rewrite <- gen_pad_cons in *. split. auto. split. auto. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m0)). + cases m. { simpl. repeat rewrite firstn_nil. eauto. } rewrite filter_until_cons in * by lia. - cases n. simpl in H4. invert H4. - symmetry in H4. - rewrite filter_until_cons in H4 by lia. invert H4. + cases n0. simpl in Hsh''. invert Hsh''. + symmetry in Hsh''. + rewrite filter_until_cons in Hsh'' by lia. invert Hsh''. erewrite pad_list_result_shape_id in *; eauto. - 2: { invert Hconst'. lia. } - 2: { invert Hconst'. lia. } - 2: { invert Hconst'. lia. } - + 2: { invert Hsize'. lia. } + 2: { invert Hsize'. lia. } + 2: { invert Hsize'. lia. } + erewrite firstn_transpose_result_list; eauto. - 2: { invert Hconst'. lia. } - 2: { invert Hconst'. lia. } + 2: { invert Hsize'. lia. } + 2: { invert Hsize'. lia. } - rewrite sub_diag. + rewrite sub_diag. erewrite Forall_map. erewrite firstn_rev_transpose_result_list; eauto. - 2: { invert Hconst'. lia. } - 2: { invert Hconst'. lia. } + 2: { invert Hsize'. lia. } + 2: { invert Hsize'. lia. } erewrite Forall_map. - invert Hconst'. - rewrite <- H7 in H9. simpl in H9. - cases rsh. invert H9. - cases n. invert H9. invert H9. - + invert Hsize'. + simpl in H7. + cases rsh. invert H7. + cases n. invert H7. invert H7. + split. { - eapply Forall_forall. intros. - eapply In_nat_range in H1. + eapply Forall_forall. intros ? H6. + eapply In_nat_range in H6. rewrite add_0_r. rewrite firstn_add. rewrite Forall_app. @@ -5020,7 +4508,7 @@ Proof. rewrite length_firstn. rewrite length_skipn. rewrite length_rev. reflexivity. } 2: { lia. } - rewrite gen_pad_filter_until_0. rewrite H10. + rewrite gen_pad_filter_until_0. rewrite H8. rewrite <- gen_pad_filter_until_0. split. split. eapply Forall_repeat. auto. eapply Forall_repeat. auto. @@ -5028,7 +4516,7 @@ Proof. split. eapply Forall_repeat. auto. eapply Forall_repeat. auto. eauto. } - { eapply Forall_forall. intros. eapply In_nat_range in H1. + { eapply Forall_forall. intros ? H6. eapply In_nat_range in H6. erewrite firstn_get_col. 2: { econstructor; eauto. } erewrite rev_get_col. @@ -5095,7 +4583,7 @@ Proof. rewrite length_skipn. rewrite length_rev. reflexivity. } 2: { lia. } - rewrite gen_pad_filter_until_0. rewrite H10. + rewrite gen_pad_filter_until_0. rewrite H8. rewrite <- gen_pad_filter_until_0. split. split. eapply Forall_repeat. auto. eapply Forall_repeat. auto. split. split. eapply Forall_repeat. auto. eapply Forall_repeat. auto. @@ -5103,62 +4591,55 @@ Proof. } } - (* TRUNCR *) - invert Hpad. invert Hconst. invert Hsize. pose proof H9 as Hsize. - erewrite size_of_sizeof in * by eauto. simpl in H3. - assert (eval_Zexpr_Z_total $0 k = kz)%Z. - { invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H5. - eapply eval_Zexpr_Z_eval_Zexpr in H. - invert H5. eapply H6 in H. invert H. reflexivity. } - subst. invs. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H9; - eauto. + invert Hpad. invert Hsize. simpl in Hbds. invs'. rewr_sizeof. invs'. eq_eval_Z. + rename H7 into Hsize. rename H4 into Hk. + pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. rewrite Hk' in *. invs. clear Hk'. + apply eval_Zexpr_Z_eval_Zexpr in Hk. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + + pose proof Hsize as Hsize'. + eapply size_of_includes in Hsize'. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize'; eauto. cases rsh. invert Hsh. pose proof Hsh as Hsh'. eapply result_has_shape_rev in Hsh'. rewrite rev_involutive in Hsh'. - pose proof H9 as Hsh''. + pose proof Hsize' as Hsh''. eapply result_has_shape_filter_until_0 in Hsh''. repeat rewrite map_cons in Hsh''. eapply result_has_shape_rev in Hsh''. - eapply result_has_shape_truncl_list - with (k:=(Z.to_nat (eval_Zexpr_Z_total $0 k))) in Hsh''. + eapply result_has_shape_truncl_list with (k:=Z.to_nat kz) in Hsh''. eapply result_has_shape_result_shape_nat in Hsh',Hsh''. rewrite Hsh' in Hsh''. clear Hsh'. simpl in Hsh''. cases n. simpl in *. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)). + cases (m - Z.to_nat kz). { simpl in *. - pose proof (truncl_list_length_empty - (Z.to_nat (eval_Zexpr_Z_total $0 k)) (rev l)). + pose proof (truncl_list_length_empty (Z.to_nat kz) (rev l)). rewrite length_rev in *. - erewrite result_has_shape_length in H6. + erewrite result_has_shape_length in H. 2: { eauto. } - assert (Z.to_nat (eval_Zexpr_Z_total $0 m) <= - Z.to_nat (eval_Zexpr_Z_total $0 k)) by lia. - eapply H6 in H10. rewrite H10. + assert (m <= Z.to_nat kz) as Hm by lia. + eapply H in Hm. rewrite Hm. simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } simpl in *. invert Hsh''. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)). + cases (m - Z.to_nat kz). { simpl in *. - pose proof (truncl_list_length_empty - (Z.to_nat (eval_Zexpr_Z_total $0 k)) (rev l)). + pose proof (truncl_list_length_empty (Z.to_nat kz) (rev l)). rewrite length_rev in *. - erewrite result_has_shape_length in H6. + erewrite result_has_shape_length in H. 2: { eauto. } - assert (Z.to_nat (eval_Zexpr_Z_total $0 m) <= - Z.to_nat (eval_Zexpr_Z_total $0 k)) by lia. - eapply H6 in H10. rewrite H10. + assert (m <= Z.to_nat kz) as Hm by lia. + eapply H in Hm. rewrite Hm. simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } simpl in *. invert Hsh''. - + rewrite rev_involutive. - eapply IHeval_expr in H2. - 2: eauto. + pose proof Hsize' as Hsize''. + eapply IHeval_expr in Hsize'. 2: eauto. 2: eauto. 2: eauto. @@ -5166,7 +4647,7 @@ Proof. simpl in *. invs. rewrite truncl_list_skipn. rewrite gen_pad_filter_until_0. - rewrite H11. + rewrite H4. rewrite <- gen_pad_filter_until_0. split. eapply forall_firstn_sub. eauto. @@ -5175,108 +4656,103 @@ Proof. split. - rewrite <- rev_involutive with (l:=l) in H10. + rename H2 into H'. + rewrite <- rev_involutive with (l:=l) in H'. rewrite <- firstn_skipn - with (n:=(Z.to_nat (eval_Zexpr_Z_total $0 k))) (l:=rev l) in H10. - rewrite rev_app_distr in H10. - rewrite skipn_app in H10. rewrite firstn_app in H10. - rewrite length_skipn in H10. rewrite length_rev in H10. - rewrite length_skipn in H10. rewrite length_rev in H10. - eapply Forall_app in H10. invs. - eapply Forall_forall. intros. eapply Forall_forall in H12. 2: eauto. - - eapply result_has_shape_forall in H9. - eapply Forall_rev in H9. - eapply forall_skipn in H9. - eapply Forall_rev in H9. - eapply forall_skipn in H9. - eapply forall_firstn in H9. - eapply Forall_forall in H9. + with (n:=(Z.to_nat kz)) (l:=rev l) in H'. + rewrite rev_app_distr in H'. + rewrite skipn_app in H'. rewrite firstn_app in H'. + rewrite length_skipn in H'. rewrite length_rev in H'. + rewrite length_skipn in H'. rewrite length_rev in H'. + eapply Forall_app in H'. invs. + eapply Forall_forall. intros. eapply Forall_forall in H2. 2: eauto. + + eapply result_has_shape_forall in Hsize''. + eapply Forall_rev in Hsize''. + eapply forall_skipn in Hsize''. + eapply Forall_rev in Hsize''. + eapply forall_skipn in Hsize''. + eapply forall_firstn in Hsize''. + eapply Forall_forall in Hsize''. 2: eassumption. eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite H11. + rewrite H4. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite H11. + rewrite H4. eapply relate_pads_filter_until_0. eauto. eauto. rewrite skipn_skipn. rewrite sub_add by lia. - eapply Forall_forall. intros. eapply Forall_forall in H13. 2: eauto. - eapply result_has_shape_forall in H9. - eapply Forall_rev in H9. - eapply forall_skipn in H9. - eapply forall_firstn in H9. - eapply Forall_forall in H9. + eapply Forall_forall. intros ? H'. eapply Forall_forall in H12. 2: eauto. + eapply result_has_shape_forall in Hsize''. + eapply Forall_rev in Hsize''. + eapply forall_skipn in Hsize''. + eapply forall_firstn in Hsize''. + eapply Forall_forall in Hsize''. 2: eassumption. eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite H11. + rewrite H4. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite H11. + rewrite H4. eapply relate_pads_filter_until_0. eauto. eauto. - (* TRUNCL *) - invert Hpad. invert Hconst. invert Hsize. pose proof H9 as Hsize. - erewrite size_of_sizeof in * by eauto. simpl in H3. - assert (eval_Zexpr_Z_total $0 k = kz)%Z. - { invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H5. - eapply eval_Zexpr_Z_eval_Zexpr in H. - invert H5. eapply H6 in H. invert H. reflexivity. } - subst. invs. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H9; - eauto. + invert Hpad. invert Hsize. simpl in Hbds. invs'. rewr_sizeof. invs'. eq_eval_Z. + rename H7 into Hsize. rename H4 into Hk. + pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. rewrite Hk' in *. invs. clear Hk'. + apply eval_Zexpr_Z_eval_Zexpr in Hk. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + + pose proof Hsize as Hsize'. + eapply size_of_includes in Hsize'. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize'; eauto. cases rsh. invert Hsh. pose proof Hsh as Hsh'. eapply result_has_shape_rev in Hsh'. - pose proof H9 as Hsh''. + pose proof Hsize' as Hsh''. eapply result_has_shape_filter_until_0 in Hsh''. repeat rewrite map_cons in Hsh''. eapply result_has_shape_truncl_list - with (k:=(Z.to_nat (eval_Zexpr_Z_total $0 k))) in Hsh''. + with (k:=Z.to_nat kz) in Hsh''. eapply result_has_shape_rev in Hsh''. eapply result_has_shape_result_shape_nat in Hsh',Hsh''. rewrite Hsh' in Hsh''. clear Hsh'. simpl in Hsh''. cases n. simpl in *. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)). + cases (m - Z.to_nat kz). { simpl in *. - pose proof (truncl_list_length_empty - (Z.to_nat (eval_Zexpr_Z_total $0 k)) l). - erewrite result_has_shape_length in H6. + pose proof (truncl_list_length_empty (Z.to_nat kz) l). + erewrite result_has_shape_length in H. 2: { eauto. } - assert (Z.to_nat (eval_Zexpr_Z_total $0 m) <= - Z.to_nat (eval_Zexpr_Z_total $0 k)) by lia. - eapply H6 in H10. rewrite H10. + assert (m <= Z.to_nat kz) as Hm by lia. + eapply H in Hm. rewrite Hm. simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } simpl in *. invert Hsh''. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)). + cases (m - Z.to_nat kz). { simpl in *. - pose proof (truncl_list_length_empty - (Z.to_nat (eval_Zexpr_Z_total $0 k)) l). - erewrite result_has_shape_length in H6. + pose proof (truncl_list_length_empty (Z.to_nat kz) l). + erewrite result_has_shape_length in H. 2: { eauto. } - assert (Z.to_nat (eval_Zexpr_Z_total $0 m) <= - Z.to_nat (eval_Zexpr_Z_total $0 k)) by lia. - eapply H6 in H10. rewrite H10. + assert (m <= Z.to_nat kz) as Hm by lia. + apply H in Hm. rewrite Hm. simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } simpl in *. invert Hsh''. - eapply IHeval_expr in H2. + pose proof Hsize' as Hsize''. + eapply IHeval_expr in Hsize''. 2: eauto. 2: eauto. 2: eauto. 2: eauto. - 2: eauto. - simpl in H2. invs. + simpl in Hsize''. invs. rewrite truncl_list_skipn in *. rewrite gen_pad_filter_until_0. - rewrite H11. + rewrite H4. rewrite <- gen_pad_filter_until_0. split. eapply forall_firstn_skipn. eauto. @@ -5289,129 +4765,116 @@ Proof. rewrite sub_add by lia. split. - eapply Forall_forall. intros. eapply Forall_forall in H10. 2: eassumption. - eapply result_has_shape_forall in H9. - eapply forall_skipn in H9. - eapply forall_firstn in H9. - eapply Forall_forall in H9. 2: eassumption. + eapply Forall_forall. intros. eapply Forall_forall in H2. 2: eassumption. + eapply result_has_shape_forall in Hsize'. + eapply forall_skipn in Hsize'. + eapply forall_firstn in Hsize'. + eapply Forall_forall in Hsize'. 2: eassumption. eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite H11. + rewrite H4. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite H11. + rewrite H4. eapply relate_pads_filter_until_0. eauto. eauto. - rewrite <- firstn_skipn - with (l:=l) (n:=(Z.to_nat (eval_Zexpr_Z_total $0 k))) in H13. + rewrite <- firstn_skipn with (l:=l) (n:=Z.to_nat kz) in H12. rewrite rev_app_distr in *. rewrite skipn_app in *. rewrite firstn_app in *. rewrite length_skipn in *. rewrite length_rev in *. - rewrite length_skipn in *. eapply Forall_app in H13. invs. - eapply Forall_forall. intros. eapply Forall_forall in H12. + rewrite length_skipn in *. eapply Forall_app in H12. invs. + eapply Forall_forall. intros. eapply Forall_forall in H8. 2: eassumption. - eapply result_has_shape_forall in H9. - eapply forall_skipn in H9. eapply Forall_rev in H9. - eapply forall_skipn in H9. eapply forall_firstn in H9. - eapply Forall_forall in H9. 2: eassumption. + eapply result_has_shape_forall in Hsize'. + eapply forall_skipn in Hsize'. eapply Forall_rev in Hsize'. + eapply forall_skipn in Hsize'. eapply forall_firstn in Hsize'. + eapply Forall_forall in Hsize'. 2: eassumption. eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite H11. + rewrite H4. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite H11. + rewrite H4. eapply relate_pads_filter_until_0. eauto. eauto. - (* PADR *) - invert Hsize. - invert Hpad. - { simpl in Hconst. invs. eq_size_of. invert H5. invert H6. - pose proof H2 as Hh. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. - simpl in H2. rewrite H13 in H2. simpl in H2. - invert H2. rewrite app_nil_l in *. + invert Hsize. simpl in Hbds. invs'. + invert Hpad; eq_size_of. + { invs'. + rename H6 into Hsize. rename H4 into Hk. + pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. rewrite Hk' in *. invs. clear Hk'. + apply eval_Zexpr_Z_eval_Zexpr in Hk. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + + pose proof H1 as Hh. + eapply size_of_includes in Hsize. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in H1. 3: eassumption. + 2: eapply nonneg_bounds_includes; [|eassumption]; solve[sets]. + invert H1. rewrite app_nil_l in *. simpl gen_pad_list in *. rewrite <- gen_pad_cons in *. - pose proof (result_has_shape_gen_pad (Z.to_nat kz :: map Z.to_nat sz)). - eapply result_has_shape_result_shape_nat in Hsh,H2. - rewrite Hsh in H2. clear Hsh. - - pose proof H1 as Hsize. - eapply constant_nonneg_bounds_size_of_no_vars in Hsize; eauto. - invert Hsize. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H10. - eq_eval_Zlist. - eapply eval_Zexpr_Z_eval_Zexpr in H. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H; eauto. invert H. - repeat rewrite <- map_cons. + pose proof (result_has_shape_gen_pad (Z.to_nat kz :: rest)) as Hsh'. + eapply result_has_shape_result_shape_nat in Hsh,Hsh'. + rewrite Hsh in Hsh'. clear Hsh. + eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite H2. + rewrite Hsh'. erewrite <- result_has_shape_filter_until_0. - repeat rewrite map_cons. eapply result_has_shape_gen_pad. - rewrite H2. - repeat rewrite <- map_cons in *. + eapply result_has_shape_gen_pad. + rewrite Hsh'. eapply relate_pads_filter_until_0. eapply result_has_shape_gen_pad. eapply relate_pads_gen_pad_id. } - - subst. invert Hconst. eq_size_of. invert H8. invert H10. - assert (eval_Zexpr_Z_total $0 k = kz)%Z. - { invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H7. invert H7. - eapply eval_Zexpr_Z_eval_Zexpr in H. eapply H5 in H. invert H. - auto. } - subst. + invs'. + + rename H6 into Hsize. rename H4 into Hk. + pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. rewrite Hk' in *. invs. clear Hk'. + apply eval_Zexpr_Z_eval_Zexpr in Hk. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + cases rsh. invert Hsh. - - pose proof H4. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H4. - 2: eauto. - 2: eauto. - pose proof Hsh. - pose proof Hsh. - eapply result_has_shape_app_l in H8. - eapply result_has_shape_app_r in H10. + + pose proof Hsize as Hsize'. + eapply size_of_includes in Hsize'. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize'; eauto. + pose proof Hsh as Hsh'. + pose proof Hsh as Hsh''. + eapply result_has_shape_app_l in Hsh'. + eapply result_has_shape_app_r in Hsh''. 2: { simpl. rewrite repeat_length. reflexivity. } 2: { reflexivity. } - repeat rewrite map_cons in *. - simpl in H8. + simpl in Hsh'. simpl. - pose proof H8. - eapply result_has_shape_length in H11. - rewrite repeat_length in H11. - pose proof H7. - eapply constant_nonneg_bounds_size_of_no_vars in H12. - 2: { eauto. } - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H12. - invert H12. - eq_eval_Z. eq_eval_Zlist. - pose proof H4. pose proof H10. - eapply result_has_shape_result_shape_nat in H12, H13. - rewrite H13 in H12. clear H13. - pose proof Hsh. eapply result_has_shape_length in H13. + pose proof Hsh' as Hsh'''. + eapply result_has_shape_length in Hsh'''. + rewrite repeat_length in Hsh'''. + pose proof Hsh'' as Hsh1. pose proof Hsize' as Hsh2. + eapply result_has_shape_result_shape_nat in Hsh1, Hsh2. + rewrite Hsh1 in Hsh2. clear Hsh1. + pose proof Hsh as Hlen. eapply result_has_shape_length in Hlen. rewrite length_app in *. simpl length in *. rewrite repeat_length in *. subst. rewrite add_sub in *. rewrite minus_plus in *. - pose proof H8. + pose proof Hsh' as Hsh'1. rewrite <- gen_pad_cons in *. - pose proof (result_has_shape_gen_pad (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))). - eapply result_has_shape_result_shape_nat in H13,H15. - rewrite H13 in H15. clear H13. - - assert (length l = Z.to_nat (eval_Zexpr_Z_total $0 dim)) as Heqq. - { simpl in H11. - cases (Z.to_nat (eval_Zexpr_Z_total $0 dim)). simpl in *. lia. - simpl in *. cases l. simpl in *. invert H12. simpl in *. - invert H12. lia. } - - pose proof H7. eapply IHeval_expr in H13; eauto. - simpl in H13. invs. + pose proof (result_has_shape_gen_pad (Z.to_nat kz :: rest)) as Hsh'2. + eapply result_has_shape_result_shape_nat in Hsh'1,Hsh'2. + rewrite Hsh'1 in Hsh'2. clear Hsh'1. + + assert (length l = dim) as Heqq. + { simpl in *. + cases dim. simpl in *. lia. + simpl in *. cases l. simpl in *. invert Hsh2. simpl in *. + invert Hsh2. lia. } + + pose proof Hsize as Hsize''. eapply IHeval_expr in Hsize''; eauto. + simpl in Hsize''. invs. rewrite rev_app_distr. repeat rewrite firstn_app. @@ -5424,130 +4887,115 @@ Proof. split. eapply Forall_app. split. auto. - simpl in H15. - cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). simpl. + simpl in Hsh'2. + cases (Z.to_nat kz). simpl. rewrite firstn_nil. eauto. eapply forall_firstn. eapply Forall_repeat. - rewrite gen_pad_filter_until_0. invert H15. + rewrite gen_pad_filter_until_0. invert Hsh'2. rewrite <- gen_pad_filter_until_0. auto. split. eapply Forall_app. split. 2: auto. - cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). simpl. + cases (Z.to_nat kz). simpl. rewrite firstn_nil. eauto. eapply forall_firstn. eapply Forall_repeat. - rewrite gen_pad_filter_until_0. invert H15. + rewrite gen_pad_filter_until_0. invert Hsh'2. rewrite <- gen_pad_filter_until_0. auto. split. eapply Forall_app. split. eauto. - eapply has_pad_size_of_relate_pads_gen_pad in H6; eauto. - simpl in H6. - remember rev. cases (Z.to_nat (eval_Zexpr_Z_total $0 dim)). lia. - simpl in H6. repeat rewrite <- @repeat_cons in *. + eapply has_pad_size_of_relate_pads_gen_pad in H9; eauto. + simpl in H9. + remember rev. cases (length l). lia. + simpl in H9. repeat rewrite <- @repeat_cons in *. subst. rewrite @rev_repeat in *. - rewrite skipn_repeat. rewrite firstn_repeat. invs. clear H25. - rewrite skipn_repeat in H23. rewrite firstn_repeat in H23. - rewrite min_r in H23 by lia. - rewrite Heqq in *. - replace (x - Datatypes.S n) with 0 by lia. rewrite sub_0_r. - replace (l1 - (Datatypes.S n - x)) with 0 by lia. rewrite min_0_r. + rewrite skipn_repeat. rewrite firstn_repeat. invs. clear H12. + rewrite skipn_repeat in H8. rewrite firstn_repeat in H8. + rewrite min_r in H8 by lia. + replace (x0 - Datatypes.S n) with 0 by lia. rewrite sub_0_r. + replace (l0 - (Datatypes.S n - x0)) with 0 by lia. rewrite min_0_r. econstructor. rewrite Forall_app. rewrite skipn_repeat. rewrite firstn_repeat. - replace (Z.to_nat (eval_Zexpr_Z_total $0 k) - - (y + Z.to_nat (eval_Zexpr_Z_total $0 k))) with 0 by lia. + replace (Z.to_nat kz - (y + Z.to_nat kz)) with 0 by lia. rewrite min_0_l. split. econstructor. rewrite sub_0_r. eauto. - (* PADL *) - invert Hsize. - invert Hpad. - { simpl in Hconst. invs. eq_size_of. invert H5. invert H6. - pose proof H2 as Hh. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H2; - eauto. - simpl in H2. rewrite H13 in H2. simpl in H2. - invert H2. rewrite app_nil_r in *. + invert Hsize. simpl in Hbds. invs'. + invert Hpad; eq_size_of. + { invs'. + rename H6 into Hsize. rename H4 into Hk. + pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. rewrite Hk' in *. invs. clear Hk'. + apply eval_Zexpr_Z_eval_Zexpr in Hk. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + + pose proof H1 as Hh. + eapply size_of_eval_expr_result_has_shape in H1. + 2: eapply nonneg_bounds_includes; [|eassumption]; solve[sets]. + 2: eapply size_of_includes; [apply empty_includes|eassumption]. + invert H1. rewrite app_nil_r in *. simpl gen_pad_list in *. rewrite <- gen_pad_cons in *. - pose proof (result_has_shape_gen_pad (Z.to_nat kz :: map Z.to_nat sz)). - eapply result_has_shape_result_shape_nat in Hsh,H2. - rewrite Hsh in H2. clear Hsh. - - pose proof H1 as Hsize. - eapply constant_nonneg_bounds_size_of_no_vars in Hsize; eauto. - invert Hsize. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H10. - eq_eval_Zlist. - eapply eval_Zexpr_Z_eval_Zexpr in H. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H; eauto. invert H. - repeat rewrite <- map_cons. + pose proof (result_has_shape_gen_pad (Z.to_nat kz :: rest)) as Hsh'. + eapply result_has_shape_result_shape_nat in Hsh,Hsh'. + rewrite Hsh in Hsh'. clear Hsh. eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. - rewrite H2. + rewrite Hsh'. erewrite <- result_has_shape_filter_until_0. - repeat rewrite map_cons. eapply result_has_shape_gen_pad. - rewrite H2. - repeat rewrite <- map_cons. + eapply result_has_shape_gen_pad. + rewrite Hsh'. eapply relate_pads_filter_until_0. eapply result_has_shape_gen_pad. eapply relate_pads_gen_pad_id. } - - subst. invert Hconst. eq_size_of. invert H8. invert H10. - assert (eval_Zexpr_Z_total $0 k = kz)%Z. - { invs. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H7. invert H7. - eapply eval_Zexpr_Z_eval_Zexpr in H. eapply H5 in H. invert H. - auto. } - subst. + + invs'. + rename H6 into Hsize. rename H4 into Hk. + pose proof Hk as Hk'. + eapply eval_Zexpr_includes_valuation in Hk'; try apply empty_includes. + apply eval_Zexpr_Z_eval_Zexpr in Hk'. rewrite Hk' in *. invs. clear Hk'. + apply eval_Zexpr_Z_eval_Zexpr in Hk. + cbv [eval_Zexpr_Z_total] in *. rewrite Hk in *. + cases rsh. invert Hsh. - - pose proof H4. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape in H4. - 2: eauto. - 2: eauto. - pose proof Hsh. - pose proof Hsh. - eapply result_has_shape_app_l in H8. - eapply result_has_shape_app_r in H10. + + pose proof Hsize as Hsize'. + eapply size_of_includes in Hsize'. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize'; eauto. + pose proof Hsh as Hsh'. + pose proof Hsh as Hsh''. + eapply result_has_shape_app_l in Hsh'. + eapply result_has_shape_app_r in Hsh''. 2: { reflexivity. } 2: { simpl. rewrite repeat_length. reflexivity. } - repeat rewrite map_cons in *. - simpl in H10. + simpl in Hsh''. simpl. - pose proof H10. - eapply result_has_shape_length in H11. - rewrite repeat_length in H11. - pose proof H7. - eapply constant_nonneg_bounds_size_of_no_vars in H12. - 2: { eauto. } - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H12. - invert H12. - eq_eval_Z. eq_eval_Zlist. - pose proof H4. pose proof H8. - eapply result_has_shape_result_shape_nat in H12, H13. - rewrite H13 in H12. clear H13. - pose proof Hsh. eapply result_has_shape_length in H13. + pose proof Hsh'' as Hsh''0. + eapply result_has_shape_length in Hsh''0. + rewrite repeat_length in Hsh''0. + + pose proof Hsh' as Hsh'0. pose proof Hsize' as Hsize'0. + eapply result_has_shape_result_shape_nat in Hsh'0, Hsize'0. + rewrite Hsh'0 in Hsize'0. clear Hsize'0. + pose proof Hsh as Hlen. eapply result_has_shape_length in Hlen. rewrite length_app in *. simpl length in *. rewrite repeat_length in *. subst. rewrite add_sub in *. rewrite minus_plus in *. - pose proof H10. + pose proof Hsh'' as Hsh''1. rewrite <- gen_pad_cons in *. - pose proof (result_has_shape_gen_pad (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))). - eapply result_has_shape_result_shape_nat in H13,H15. - rewrite H13 in H15. clear H13. - - assert (length l = Z.to_nat (eval_Zexpr_Z_total $0 dim)) as Heqq. - { simpl in H12. - cases (Z.to_nat (eval_Zexpr_Z_total $0 dim)). simpl in *. lia. - simpl in *. cases l. simpl in *. invert H12. simpl in *. - invert H12. lia. } - - pose proof H6. eapply IHeval_expr in H13; eauto. - simpl in H13. invs. + pose proof (result_has_shape_gen_pad (Z.to_nat kz :: rest)) as Hsh''2. + eapply result_has_shape_result_shape_nat in Hsh''1,Hsh''2. + rewrite Hsh''1 in Hsh''2. clear Hsh''1. + + assert (length l = dim) as Heqq. + { cases dim. simpl in *. lia. + simpl in *. cases l. simpl in *. invert Hsize'. simpl in *. + invert Hsize'. lia. } + + pose proof H9 as H9'. eapply IHeval_expr in H9'; eauto. + simpl in H9'. invs. repeat rewrite firstn_app. repeat rewrite rev_app_distr. repeat rewrite firstn_app. rewrite rev_repeat. rewrite length_rev. @@ -5555,26 +5003,25 @@ Proof. repeat rewrite length_rev. repeat rewrite length_skipn. rewrite repeat_length. repeat rewrite add_sub. rewrite length_rev. - replace (Z.to_nat (eval_Zexpr_Z_total $0 k) - - (x + Z.to_nat (eval_Zexpr_Z_total $0 k))) with 0 by lia. + replace (Z.to_nat kz - (x0 + Z.to_nat kz)) with 0 by lia. rewrite sub_0_r. split. rewrite firstn_all2. 2: { rewrite repeat_length. lia. } eapply Forall_app. split. - cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). econstructor. - eapply Forall_repeat. invert H15. - rewrite gen_pad_filter_until_0. rewrite <- H23. + cases (Z.to_nat kz). econstructor. + eapply Forall_repeat. invert Hsh''2. + rewrite gen_pad_filter_until_0. rewrite <- H8. rewrite <- gen_pad_filter_until_0. auto. eauto. - split. + split. eapply Forall_app. split. eauto. eapply forall_firstn. - cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). econstructor. - eapply Forall_repeat. invert H15. - rewrite gen_pad_filter_until_0. rewrite <- H23. + cases (Z.to_nat kz). econstructor. + eapply Forall_repeat. invert Hsh''2. + rewrite gen_pad_filter_until_0. rewrite <- H8. rewrite <- gen_pad_filter_until_0. auto. split. @@ -5585,11 +5032,12 @@ Proof. eapply Forall_app. split. eauto. rewrite skipn_repeat. rewrite firstn_repeat. - cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). econstructor. + cases (Z.to_nat kz). econstructor. replace (y - Datatypes.length l) with 0 by lia. rewrite sub_0_r. replace (r - (Datatypes.length l - y)) with 0 by lia. rewrite min_0_r. econstructor. - (* SCALAR *) - invert Hconst. invert Hpad. + invert Hpad. + invert Hsh. simpl. reflexivity. + Unshelve. all: assumption. Qed. diff --git a/src/verified_lowering/proof/Result.v b/src/verified_lowering/proof/Result.v index 5125627..c54088f 100644 --- a/src/verified_lowering/proof/Result.v +++ b/src/verified_lowering/proof/Result.v @@ -1116,18 +1116,18 @@ Qed. Lemma result_lookup_Z_option_Some_pad_r : forall z x2 x sh k r, (0 <= z)%Z -> result_lookup_Z_option - (z :: x2) (V (x ++ repeat (gen_pad sh) (Z.to_nat k))) = Some r -> + (z :: x2) (V (x ++ repeat (gen_pad sh) k)) = Some r -> (z < Z.of_nat (length x))%Z. Proof. intros. simpl in *. cases z; try lia. simpl in *. - cases (x ++ repeat (gen_pad sh) (Z.to_nat k)). discriminate. - cases x. simpl in *. cases (Z.to_nat k). simpl in *. discriminate. + cases (x ++ repeat (gen_pad sh) k). discriminate. + cases x. simpl in *. cases k. simpl in *. discriminate. simpl in *. invert Heq. rewrite result_lookup_Z_option_gen_pad in H0. discriminate. simpl. lia. - cases (nth_error (x ++ repeat (gen_pad sh) (Z.to_nat k)) + cases (nth_error (x ++ repeat (gen_pad sh) k) (Z.to_nat (Z.pos p))). 2 : { discriminate. } pose proof Heq. diff --git a/src/verified_lowering/proof/ResultToArrayDelta.v b/src/verified_lowering/proof/ResultToArrayDelta.v index 1b78216..dc316ab 100644 --- a/src/verified_lowering/proof/ResultToArrayDelta.v +++ b/src/verified_lowering/proof/ResultToArrayDelta.v @@ -559,11 +559,10 @@ Lemma tensor_to_array_delta_empty_tensor : Proof. reflexivity. Qed. Lemma tensor_to_array_delta_cons : - forall r0 v i lo hi reindexer, - eq_zexpr lo (| eval_Zexpr_Z_total $0 lo |)%z -> - eq_zexpr hi (| eval_Zexpr_Z_total $0 hi |)%z -> - Z.to_nat (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo) = - Datatypes.S (Datatypes.length r0) -> + forall r0 v i lo loz hi hiz reindexer, + eval_Zexpr $0 lo loz -> + eval_Zexpr $0 hi hiz -> + Z.to_nat (hiz - loz) = Datatypes.S (Datatypes.length r0) -> forall r, result_has_shape (V (r::r0)) (result_shape_nat (V (r::r0))) -> partial_injective @@ -597,12 +596,12 @@ Lemma tensor_to_array_delta_cons : (((! i ! - lo)%z, (hi - lo)%z) :: l0)) (result_shape_Z r) - (v $+ (i, eval_Zexpr_Z_total $0 lo))) r) = + (v $+ (i, loz))) r) = tensor_to_array_delta (partial_interpret_reindexer reindexer (result_shape_Z (V (r :: r0))) v) (V (r :: r0)). Proof. - intros ? ? ? ? ? ? ? ? ? ? ? Hinj HeqZlist Hvarsub Hmap Hvarsarg. intros. + intros ? ? ? ? ? ? ? ? ? ? ? ? ? Hinj HeqZlist Hvarsub Hmap Hvarsarg. intros. cases r0. { unfold tensor_to_array_delta at 1. unfold tensor_to_array_delta_by_indices at 1. simpl. @@ -696,7 +695,7 @@ Proof. eapply no_dup_filter. eapply no_dup_mesh_grid. Qed. - + Lemma tensor_to_array_delta_add_valuation : forall reindexer sh r v i loz0, ~ i \in dom v -> @@ -1385,245 +1384,123 @@ Proof. propositional. Qed. -Lemma constant_nonneg_bounds_size_of_eval_expr_result_has_shape : - forall e l, - constant_nonneg_bounds e -> - size_of e l -> - forall v sh ec r, - eval_expr sh v ec e r -> - result_has_shape r (map Z.to_nat (map (eval_Zexpr_Z_total $0) l)). +Ltac rewr_sizeof' e := + let Hsizeof := fresh "Hsizeof" in + pose proof (size_of_sizeof _ e _ ltac:(eassumption) ltac:(eassumption)) as Hsizeof; + destruct Hsizeof as (?&Hsizeof&?); subst; + simpl in Hsizeof; + try invert1 Hsizeof; + repeat match goal with + | H: _ = sizeof _ |- _ => rewrite <- H in * + end. + +Ltac rewr_sizeof := + match goal with + | H: context[sizeof ?e] |- _ => + lazymatch type of H with + | eval_Zexprlist _ (sizeof _) _ => fail + | _ = sizeof _ => fail + | _ => idtac + end; + rewr_sizeof' e + | |- context[sizeof ?e] => rewr_sizeof' e + end. + +Lemma size_of_eval_expr_result_has_shape : + forall e v sz ec r, + eval_expr v ec e r -> + nonneg_bounds v e -> + size_of v e sz -> + result_has_shape r sz. Proof. - intros ? ? ? ? ?. - pose proof H0. - eapply constant_nonneg_bounds_size_of_no_vars in H1; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1. - induct e; intros; simpl in *. - - (* GEN *) invs. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H. - eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H3. - invs. invert H2. + intros e. induct e; intros; simpl in *. + - (* GEN *) invs. invert H. + (* EMPTY GEN *) - eapply eval_Zexpr_Z_eval_Zexpr in H17,H16. - eq_eval_Z. - simpl map. rewrite <- H5. - simpl. replace (Z.to_nat (hiz - loz)) with 0 by lia. econstructor. + rename H10 into Hlo. rename H11 into Hhi. + eapply eval_Zexpr_Z_eval_Zexpr in Hhi,Hlo. + rewrite Hlo, Hhi in *. invs. + replace (Z.to_nat (hiz0 - loz0)) with 0 by lia. constructor. + (* STEP GEN *) - eapply eval_Zexpr_Z_eval_Zexpr in H14,H13. - eq_eval_Z. simpl map. - simpl. cases (Z.to_nat (hiz - loz) =? 0)%nat. - eapply Nat.eqb_eq in Heq. lia. clear Heq. - rewrite <- H5. - simpl. cases (Z.to_nat (hiz-loz)%Z). lia. + rename H10 into Hlo. rename H11 into Hhi. + eapply eval_Zexpr_Z_eval_Zexpr in Hhi,Hlo. + rewrite Hlo, Hhi in *. invs. + simpl. cases (Z.to_nat (hiz0-loz0)%Z). lia. econstructor. erewrite length_eval_expr_gen. 2: { eassumption. } - 2: { simpl. eapply eval_Zexpr_Z_eval_Zexpr in H7,H8. - rewrite H7,H8. eauto. } + 2: { simpl. rewrite Hlo,Hhi. eauto. } lia. clear Heq. clear n. - eapply IHe. eauto. eassumption. - eapply eval_Zexprlist_add. 2: eassumption. - 2: eassumption. auto. + eapply IHe. eassumption. + { eapply nonneg_bounds_includes; [|eassumption]. sets. } + { eapply size_of_includes. 2: eassumption. sets. } pose proof (eval_expr_for_gen_result_has_shape - n sh v ec i (lo+|1|)%z hi (loz+1) hiz e l). - assert (eval_Zexpr_Z v (lo + | 1 |)%z = Some (loz+1)%Z). - simpl. eapply eval_Zexpr_Z_eval_Zexpr in H8. rewrite H8. eauto. - assert ((hiz - (loz + 1))%Z = Z.of_nat n). lia. - eapply eval_Zexpr_Z_eval_Zexpr in H7. - specialize (H1 H2 H7 H3 H22). - eapply Forall_forall. intros. - eapply In_nth with (d:= S (SS 0)) in H9. invs. - eapply IHe. eauto. eauto. - 2: { eapply H1. eapply length_eval_expr_gen in H22; eauto. - 2: { simpl. eapply eval_Zexpr_Z_eval_Zexpr in H8. - rewrite H7,H8. reflexivity. } lia. } - eapply eval_Zexprlist_add. eauto. eauto. + n v ec i (lo+|1|)%z hi (loz0+1) hiz0 e l). + assert (eval_Zexpr_Z v (lo + | 1 |)%z = Some (loz0+1)%Z). + simpl. eapply eval_Zexpr_Z_eval_Zexpr in Hhi. rewrite Hlo. eauto. + assert ((hiz0 - (loz0 + 1))%Z = Z.of_nat n). lia. + specialize (H ltac:(assumption) ltac:(assumption) ltac:(assumption) ltac:(assumption)). + eapply Forall_forall. intros ? Hin. + eapply In_nth with (d:= S (SS 0)) in Hin. invs. + eapply IHe. eapply H. + eapply length_eval_expr_gen in H20; eauto. + 2: { simpl. rewrite Hlo,Hhi. reflexivity. } + lia. + { eapply nonneg_bounds_includes; [|eassumption]. sets. } + { eapply size_of_includes; [|eassumption]. sets. } - (* SUM *) - invert H0. invert H2. + invert H1. invert H. + (* STEP SUM *) eapply result_has_shape_add_result. eassumption. - eapply IHe. 2: eassumption. propositional. - eapply eval_Zexprlist_add. eassumption. eassumption. eassumption. - eapply result_has_shape_for_sum with (n:=(Z.to_nat (hiz - (loz+1))%Z)). - eapply IHe. propositional. - 6: apply H16. - eassumption. eassumption. - simpl. rewrite H6. reflexivity. eauto. lia. + eapply IHe. eassumption. + { eapply nonneg_bounds_includes; [|eassumption]. sets. } + { eapply size_of_includes; [|eassumption]. sets. } + eapply result_has_shape_for_sum. + { intros. eapply IHe; eauto. } + 6: eassumption. all: eauto. + simpl. rewrite H5. reflexivity. + rewrite Z2Nat.id. reflexivity. lia. + (* EMPTY SUM *) - eq_size_of. eq_eval_Zlist. + eq_size_of. eapply result_has_shape_gen_pad. - - invs. invert H2. - eq_size_of. eq_eval_Zlist. - eapply result_has_shape_gen_pad. + - invs. invert H. + eq_size_of. + apply result_has_shape_gen_pad. eauto. - - invs. invert H2. - + eauto. - + eauto. - - invs. invert H2. simpl. - rewrite <- H1. - rewrite Z2Nat.inj_add. - 2: { pose proof H3. - eapply constant_nonneg_bounds_sizeof_nonneg in H3. - eapply constant_nonneg_bounds_sizeof_no_vars in H. - erewrite size_of_sizeof in * by eauto. - 2: { erewrite size_of_sizeof in * by eauto. - econstructor. eauto. eauto. } - invert H. invert H3. - lia. } - 2: { pose proof H4. - eapply constant_nonneg_bounds_sizeof_nonneg in H4. - eapply constant_nonneg_bounds_sizeof_no_vars in H. - erewrite size_of_sizeof in * by eauto. - 2: { erewrite size_of_sizeof in * by eauto. - econstructor. eauto. - eapply forall_no_vars_eval_Zexpr_Z_total. - eapply constant_nonneg_bounds_size_of_no_vars in H4. - 2: { eauto. } - invert H4. eauto. } - invert H. invert H4. - lia. } - pose proof H3. pose proof H4. - eapply constant_nonneg_bounds_size_of_no_vars in H3,H4; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H3,H4; eauto. - eapply result_has_shape_concat; rewrite <- map_cons. - + invert H3. invert H4. eq_eval_Zlist. - eq_eval_Z. rewrite <- map_cons. - eapply IHe1; eauto. - simpl. econstructor; eauto. - + invert H3. invert H4. eq_eval_Zlist. - rewrite H9. - eq_eval_Z. rewrite <- map_cons. - eapply IHe2. - eauto. eauto. - simpl. econstructor; eauto. eauto. - - invs. invert H2. - simpl. rewrite <- H3. - rewrite Z2Nat.inj_mul. - 2: { eapply constant_nonneg_bounds_size_of_nonneg in H; eauto. - invert H. lia. } - 2: { pose proof H. - eapply constant_nonneg_bounds_size_of_nonneg in H; eauto. - invert H. invert H6. - eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0; eauto. - invert H0. invert H16. invert H13. - eq_eval_Z. invert H11. lia. invert H11. lia. invert H11. lia. - invert H11. lia. - invert H11. lia. - invert H11. lia. - invert H11. lia. - invert H11. lia. } - eapply result_has_shape_flatten. - repeat rewrite <- map_cons. - pose proof H. - eapply constant_nonneg_bounds_size_of_no_vars in H; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H; eauto. - invert H. invert H14. eq_eval_Z. - rewrite <- map_cons. - rewrite <- map_cons. - eapply IHe; eauto. - simpl. econstructor; eauto. - - invs. eq_eval_Z. repeat rewrite map_cons. pose proof H8. - eapply constant_nonneg_bounds_size_of_no_vars in H0. - invert H0. - erewrite eval_Zexpr_Z_total_ceil_div_distr in *. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. } - 2: eauto. - invert H2. eapply IHe in H14; eauto. - 2: { eapply forall_no_vars_eval_Zexpr_Z_total. - econstructor; eauto. } - repeat rewrite map_cons in *. pose proof H. - eapply constant_nonneg_bounds_size_of_nonneg in H0; eauto. - invert H0. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total - with (v:=$0) in H10. - eapply H10 in H6. invert H6. - rewrite Z2Nat_div_distr by lia. + - invs. invert H. eauto. + - invs. invert H. eauto using result_has_shape_concat. + - invs. invert H. eauto using result_has_shape_flatten. + - invs. eq_eval_Z. invert H. + apply eval_Zexpr_Z_eval_Zexpr in H3. rewrite H3 in *. invs. eapply result_has_shape_split_result. lia. eauto. - - invs. invert H2. - simpl. - eq_size_of. invert H0. invert H9. - invert H12. eq_eval_Zlist. eq_eval_Z. + - invs. invert H. + eq_size_of. invs'. eapply result_has_shape_transpose_result. - repeat rewrite <- map_cons. - eapply IHe; eauto. - econstructor; eauto. - - invs. invert H2. - eapply result_has_shape_rev. - eapply eval_Zexpr_Z_eval_Zexpr in H10. eq_eval_Z. - simpl. rewrite <- H5. - rewrite Z2Nat.inj_sub. - 2: lia. + eapply IHe. 3: eassumption. eauto. eauto. + - invs. rewr_sizeof. invs'. eq_eval_Z. invert H. + eapply result_has_shape_rev. + apply eval_Zexpr_Z_eval_Zexpr in H12. eq_eval_Z. eapply result_has_shape_truncl_list. eapply result_has_shape_rev. erewrite <- result_has_shape_filter_until_0. - rewrite <- map_cons. - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0; eauto. - invert H0. eq_eval_Z. - rewrite <- map_cons. - eapply IHe; eauto. econstructor; eauto. - - invs. invert H2. - eapply eval_Zexpr_Z_eval_Zexpr in H10. eq_eval_Z. - simpl. rewrite <- H5. - rewrite Z2Nat.inj_sub. - 2: lia. + eapply IHe; eauto. + - invs. rewr_sizeof. invs'. eq_eval_Z. invert H. + apply eval_Zexpr_Z_eval_Zexpr in H12. eq_eval_Z. eapply result_has_shape_truncl_list. erewrite <- result_has_shape_filter_until_0. - rewrite <- map_cons. - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0; eauto. - invert H0. eq_eval_Z. - rewrite <- map_cons. - eapply IHe; eauto. econstructor; eauto. - - invs. invert H2. - eq_size_of. invert H0. eq_eval_Zlist. - eapply eval_Zexpr_Z_eval_Zexpr in H6. - eq_eval_Z. simpl. - rewrite <- H4. - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0; eauto. - invert H0. - eapply eval_Zexpr_Z_eval_Zexpr in H6,H9. - eq_eval_Z. eq_eval_Zlist. - simpl. rewrite Z2Nat.inj_add. - 2: { eapply constant_nonneg_bounds_size_of_nonneg in H3; eauto. - invert H3. - lia. } + eapply IHe; eauto. + - invs. eq_eval_Z. invert H. + eq_size_of. invert H. + apply eval_Zexpr_Z_eval_Zexpr in H5. eq_eval_Z. eapply result_has_shape_concat. - rewrite <- map_cons. - rewrite <- map_cons. - eapply IHe; eauto. econstructor; eauto. - eapply result_has_shape_repeat_gen_pad. lia. - - invs. invert H2. - eq_size_of. invert H0. eq_eval_Zlist. - eapply eval_Zexpr_Z_eval_Zexpr in H6. - eq_eval_Z. - simpl. - pose proof H3. - eapply constant_nonneg_bounds_size_of_no_vars in H0; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H0; eauto. - invert H0. - eapply eval_Zexpr_Z_eval_Zexpr in H6,H9. - eq_eval_Z. eq_eval_Zlist. - rewrite <- H4. - rewrite Z2Nat.inj_add. - 2: { eapply constant_nonneg_bounds_size_of_nonneg in H3; eauto. - invert H3. - lia. } + eapply IHe; eauto. + eapply result_has_shape_repeat_gen_pad. + - invs. eq_eval_Z. invert H. + eq_size_of. invert H. + apply eval_Zexpr_Z_eval_Zexpr in H5. eq_eval_Z. rewrite Nat.add_comm. eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. - rewrite <- map_cons. - rewrite <- map_cons. - eapply IHe; eauto. econstructor; eauto. - lia. - - invs. invert H2. econstructor. + eapply IHe; eauto. + - invs. invert H. econstructor. Qed. - diff --git a/src/verified_lowering/proof/Sexpr.v b/src/verified_lowering/proof/Sexpr.v index 944ec51..98983c0 100644 --- a/src/verified_lowering/proof/Sexpr.v +++ b/src/verified_lowering/proof/Sexpr.v @@ -7,6 +7,7 @@ From Stdlib Require Import ZArith.Znat. From Stdlib Require Import Lists.List. From Stdlib Require Import micromega.Lia. From Stdlib Require Import Reals.Rpower. +From Stdlib Require Import QArith. From Stdlib Require Import Logic.FunctionalExtensionality. From Stdlib Require Import Reals.Reals. Import Rdefinitions. Import RIneq. @@ -22,13 +23,12 @@ Definition expr_context := fmap string result. Definition stack := fmap string R. Inductive Sexpr := -| Var (v : string) | Get (v : string) (i : list Zexpr) | Mul (x y : Sexpr) | Add (x y : Sexpr) | Div (x y : Sexpr) | Sub (x y : Sexpr) -| Lit (r : R). +| Lit (r : Q). Inductive Sstmt := | SVar (v : string) @@ -37,16 +37,16 @@ Inductive Sstmt := | SAdd (x y : Sstmt) | SDiv (x y : Sstmt) | SSub (x y : Sstmt) -| SLit (r : R). +| SLit (r : Q). Fixpoint lowerS (s : Sexpr) (sh : context) : Sstmt := match s with | Lit r => SLit r - | Var v => SVar v | Get v i => match sh $? v with + | Some [] => SVar v | Some str => SGet v (List.combine str i) - | None => SVar v + | None => SVar v (*should not happen*) end | Mul x y => SMul (lowerS x sh) (lowerS y sh) | Add x y => SAdd (lowerS x sh) (lowerS y sh) @@ -55,18 +55,15 @@ Fixpoint lowerS (s : Sexpr) (sh : context) : Sstmt := end. Inductive eval_get (v : valuation) : - list result -> list Zexpr -> scalar_result -> Prop := + result -> list Zexpr -> scalar_result -> Prop := | EvalGetV : forall x xs i l l' r, eval_Zexpr v x i -> (0 <= i)%Z -> - nth_error l (Z.to_nat i) = Some (V l') -> + nth_error l (Z.to_nat i) = Some l' -> eval_get v l' xs r -> - eval_get v l (x::xs) r -| EvalGetS : forall x i l r, - eval_Zexpr v x i -> - (0 <= i)%Z -> - nth_error l (Z.to_nat i) = Some (S r) -> - eval_get v l [x] r + eval_get v (V l) (x::xs) r +| EvalGetS : forall r, + eval_get v (S r) [] r . Definition bin_scalar_result f r1 r2 := @@ -77,46 +74,37 @@ Definition bin_scalar_result f r1 r2 := | SX,SX => SS (f 0%R 0%R) end. -Inductive eval_Sexpr (sh : context) : +Inductive eval_Sexpr : valuation -> expr_context -> Sexpr -> scalar_result -> Prop := -| EvalVar : forall s v ec r, - ec $? s = Some (S r) -> - sh $? s = Some [] -> - eval_Sexpr sh v ec (Var s) (match r with - | SS s => r - | _ => SS 0%R - end) -| EvalGet : forall x l v r ec rs s, - ec $? x = Some (V rs) -> - sh $? x = Some s -> - length s = length l -> +| EvalGet : forall x l v r ec rs, + ec $? x = Some rs -> eval_get v rs l r -> - eval_Sexpr sh v ec (Get x l) (match r with - | SS s => r - | _ => SS 0%R - end) + eval_Sexpr v ec (Get x l) (match r with + | SS s => r + | _ => SS 0%R + end) | EvalMul : forall ec s1 s2 v r1 r2, - eval_Sexpr sh v ec s1 r1 -> - eval_Sexpr sh v ec s2 r2 -> - eval_Sexpr sh v ec (Mul s1 s2) (bin_scalar_result Rmult r1 r2) + eval_Sexpr v ec s1 r1 -> + eval_Sexpr v ec s2 r2 -> + eval_Sexpr v ec (Mul s1 s2) (bin_scalar_result Rmult r1 r2) | EvalAdd : forall ec s1 s2 v r1 r2, - eval_Sexpr sh v ec s1 r1 -> - eval_Sexpr sh v ec s2 r2 -> - eval_Sexpr sh v ec (Add s1 s2) (bin_scalar_result Rplus r1 r2) + eval_Sexpr v ec s1 r1 -> + eval_Sexpr v ec s2 r2 -> + eval_Sexpr v ec (Add s1 s2) (bin_scalar_result Rplus r1 r2) | EvalDiv : forall ec s1 s2 v r1 r2, - eval_Sexpr sh v ec s1 r1 -> - eval_Sexpr sh v ec s2 r2 -> + eval_Sexpr v ec s1 r1 -> + eval_Sexpr v ec s2 r2 -> match r2 with | SS s => s | SX => 0%R end <> 0%R -> - eval_Sexpr sh v ec (Div s1 s2) (bin_scalar_result Rdiv r1 r2) + eval_Sexpr v ec (Div s1 s2) (bin_scalar_result Rdiv r1 r2) | EvalSub : forall ec s1 s2 v r1 r2, - eval_Sexpr sh v ec s1 r1 -> - eval_Sexpr sh v ec s2 r2 -> - eval_Sexpr sh v ec (Sub s1 s2) (bin_scalar_result Rminus r1 r2) + eval_Sexpr v ec s1 r1 -> + eval_Sexpr v ec s2 r2 -> + eval_Sexpr v ec (Sub s1 s2) (bin_scalar_result Rminus r1 r2) |EvalLit : forall v ec r, - eval_Sexpr sh v ec (Lit r) (SS r). + eval_Sexpr v ec (Lit r) (SS (Q2R r)). Inductive eval_Sstmt : valuation -> stack -> heap -> Sstmt -> R -> Prop := @@ -150,5 +138,4 @@ Inductive eval_Sstmt : (r1 - r2 = r)%R -> eval_Sstmt v st h (SSub s1 s2) r | EvalSLit: forall v st h r, - eval_Sstmt v st h (SLit r) r. - + eval_Sstmt v st h (SLit r) (Q2R r). diff --git a/src/verified_lowering/proof/VarGeneration.v b/src/verified_lowering/proof/VarGeneration.v index 838e8e4..83d7474 100644 --- a/src/verified_lowering/proof/VarGeneration.v +++ b/src/verified_lowering/proof/VarGeneration.v @@ -19,7 +19,7 @@ Definition shape_to_index (shape : list Z) (vars : list var) := Lemma shape_to_index_cons : forall var vars s sh, shape_to_index (s::sh) (var::vars) = - (! var !,| s |)%z :: (shape_to_index sh vars). + (! var !, | s |)%z :: (shape_to_index sh vars). Proof. auto. Qed. Lemma map_subst_var_in_Zexpr_shape_to_index_id : diff --git a/src/verified_lowering/proof/WellFormedAllocation.v b/src/verified_lowering/proof/WellFormedAllocation.v index ffa80a2..9a9c142 100644 --- a/src/verified_lowering/proof/WellFormedAllocation.v +++ b/src/verified_lowering/proof/WellFormedAllocation.v @@ -38,18 +38,6 @@ Definition well_formed_allocation (mesh_grid (result_shape_Z r))))) \subseteq dom a end. -Lemma constant_not_empty {X} : forall (l : list X), - l <> [] -> - constant l = constant [] -> - False. -Proof. - intros. - erewrite <- sets_equal in H0. - cases l. propositional. - specialize (H0 x). - propositional. simpl in H1. sets. -Qed. - Lemma reindexer_not_empty : forall reindexer sh, (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = @@ -63,12 +51,7 @@ Proof. specialize (H (shape_to_index (z :: sh) (shape_to_vars (z :: sh)))). rewrite H0 in *. unfold shape_to_index, shape_to_vars in *. - simpl in *. - repeat rewrite cup_empty_r in H. - symmetry in H. - eapply cup_empty in H. invs. - eapply cup_empty in H2. invs. - eapply constant_not_empty in H. propositional. inversion 1. + simpl in *. symmetry in H. cups_empty. Qed. Lemma well_formed_allocation_result_V : @@ -119,24 +102,19 @@ Proof. Qed. Lemma well_formed_allocation_padl : - forall reindexer st h p v k l0 l m, + forall reindexer st h p v k kz l0 l m, well_formed_allocation - reindexer - (V (repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) ++ l)) st h p v -> - result_has_shape (V l) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) -> + reindexer (V (repeat (gen_pad l0) (Z.to_nat kz) ++ l)) st h p v -> + result_has_shape (V l) (m :: l0) -> (forall l0 : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l0) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l0) -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> - (0 <= eval_Zexpr_Z_total $0 m)%Z -> + (0 <= kz)%Z -> (forall (var : var) (k0 : Z) (l2 : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> map (subst_var_in_Z_tup var k0) (reindexer l2) = reindexer (map (subst_var_in_Z_tup var k0) l2)) -> - (eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z) -> - (eq_zexpr m (| eval_Zexpr_Z_total $0 m |)%z) -> + eval_Zexpr $0 k kz -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> vars_of_reindexer (reindexer []) \subseteq dom v -> (forall l2 l3 : list (Zexpr * Zexpr), @@ -151,7 +129,7 @@ Lemma well_formed_allocation_padl : end) (V l) st h p v. Proof. - intros ? ? ? ? ? ? ? ? ? Halloc Hsh Hvarsub Hknonneg Hmnonneg Hmap Hkz Hm + intros ? ? ? ? ? ? ? ? ? ? Halloc Hsh Hvarsub Hknonneg Hmap Hkz Henv Hvarsubdom HeqZlist. eapply well_formed_allocation_result_V in Halloc; eauto. invs. unfold well_formed_allocation. @@ -165,36 +143,20 @@ Proof. unfold result_shape_Z,shape_to_index,shape_to_vars in Heq. simpl in *. cases l. - simpl in *. invert Heq. simpl. - repeat rewrite constant_app_no_dups. unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H2. invs. - eapply cup_empty in H. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. + cups_empty. - simpl in *. invert Heq. simpl. - repeat rewrite constant_app_no_dups. unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H2. invs. - eapply cup_empty in H. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. } + cups_empty. } erewrite result_has_shape_result_shape_Z by eauto. erewrite result_has_shape_result_shape_Z in H1. 2: { eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. simpl in *. eauto. } - rewrite <- Z2Nat.inj_add in H1 by lia. - rewrite <- map_cons in H1. - rewrite <- eval_Zexpr_Z_total_add_distr in H1; eauto. - rewrite <- map_cons in H1. pose proof filter_pad_l_mesh_grid. simpl gen_pad_list in H. rewrite H in H1; eauto. clear H. 2: { repeat rewrite map_cons. - rewrite eval_Zexpr_Z_total_add_distr; eauto. - rewrite Z2Nat.inj_add by lia. eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. eauto. } eexists. split. eauto. @@ -208,42 +170,32 @@ Proof. rewrite <- H. repeat rewrite map_cons. erewrite eq_partial_interpret_reindexer_padl. - eexists ((z + eval_Zexpr_Z_total $0 k)%Z :: x1). + eexists ((z + kz)%Z :: x1). split. - f_equal. f_equal. f_equal. f_equal. rewrite <- Z2Nat.inj_add by lia. - f_equal. - eapply eval_Zexpr_Z_total_add_distr; eauto. + reflexivity. eapply in_map_iff. eexists (z::x1). propositional. eapply filter_In. propositional. repeat decomp_goal_index. propositional. - rewrite eval_Zexpr_Z_total_add_distr; eauto. lia. eauto. auto. auto. auto. auto. auto. lia. lia. Qed. Lemma well_formed_allocation_truncl : - forall reindexer st h p v k l0 x m, + forall reindexer st h p v k kz l0 x m, well_formed_allocation reindexer (V x) st h p v -> (forall l0 : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l0) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l0) -> - result_has_shape - (V - (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) ++ x)) - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + result_has_shape (V (gen_pad_list (Z.to_nat kz :: l0) ++ x)) (m :: l0) -> + eval_Zexpr $0 k kz -> + (0 <= kz)%Z -> (forall (var : var) (k0 : Z) (l2 : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> map (subst_var_in_Z_tup var k0) (reindexer l2) = reindexer (map (subst_var_in_Z_tup var k0) l2)) -> - (eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z) -> - (eq_zexpr m (| eval_Zexpr_Z_total $0 m |)%z) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> vars_of_reindexer (reindexer []) \subseteq dom v -> (forall l2 l3 : list (Zexpr * Zexpr), @@ -256,13 +208,9 @@ Lemma well_formed_allocation_truncl : | [] => l | (v0, d) :: xs => ((v0 - k)%z, (d - k)%z) :: xs end) - (V - (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) ++ x)) st h p v. + (V (gen_pad_list (Z.to_nat kz :: l0) ++ x)) st h p v. Proof. - intros ? ? ? ? ? ? ? ? ? Halloc Hvarsub Hsh Hknonneg Hmap Hkz Hm Henv + intros ? ? ? ? ? ? ? ? ? ? Halloc Hvarsub Hsh Hkz Hknonneg Hmap Henv Hvarsubdom HeqZlist. eapply well_formed_allocation_result_V in Halloc; eauto. invs. unfold well_formed_allocation. @@ -270,17 +218,12 @@ Proof. (result_shape_Z (V (gen_pad_list - (Z.to_nat - (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) ++ x))) + (Z.to_nat kz :: l0) ++ x))) (shape_to_vars (result_shape_Z (V (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) ++ x))))). + (Z.to_nat kz :: l0) ++ x))))). { eapply shape_to_index_not_empty_Z in Heq. propositional. } cases (reindexer (let (v0, d) := p0 in ((v0 - k)%z, (d - k)%z) :: l)). @@ -288,29 +231,14 @@ Proof. 2: eauto. eapply reindexer_not_empty_vars_in_index in Heq0; auto. propositional. unfold result_shape_Z in Heq. simpl in Heq. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). + cases m. - invert Heq. simpl. unfold app_no_dups. - repeat rewrite <- union_constant. - repeat rewrite cup_empty_r. - repeat rewrite cup_empty_l. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H2. invs. - eapply constant_not_empty in H. propositional. inversion 1. + unfold not. intros. cups_empty. - invert Heq. simpl. unfold app_no_dups. - repeat rewrite <- union_constant. - repeat rewrite cup_empty_r. - repeat rewrite cup_empty_l. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H2. invs. - eapply cup_empty in H. invs. - eapply constant_not_empty in H2. propositional. inversion 1. } + unfold not. intros. cups_empty. } erewrite result_has_shape_result_shape_Z. 2: eauto. - rewrite <- map_cons. - rewrite <- map_cons. rewrite filter_pad_l_mesh_grid; eauto. eexists. split. eassumption. eapply subseteq_transitivity. 2: eassumption. @@ -328,49 +256,36 @@ Proof. repeat decomp_index. exists (z::x3). split. - rewrite map_cons. - rewrite map_cons. erewrite eq_partial_interpret_reindexer_truncl. reflexivity. eauto. auto. auto. auto. auto. auto. - lia. lia. lia. + lia. lia. eapply filter_In. propositional. repeat decomp_goal_index. propositional. Qed. Lemma well_formed_allocation_truncr : - forall reindexer x st h p v k l0 m, + forall reindexer x st h p v k kz l0 m, well_formed_allocation reindexer (V (rev (truncl_list - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - (rev - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))))))) + (Z.to_nat kz) + (rev (x ++ gen_pad_list (Z.to_nat kz :: l0)))))) st h p v -> (forall l0 : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l0) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l0) -> result_has_shape - (V - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + (V (x ++ gen_pad_list (Z.to_nat kz :: l0))) (m :: l0) -> + (0 <= kz)%Z -> (forall (var : var) (k0 : Z) (l2 : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> map (subst_var_in_Z_tup var k0) (reindexer l2) = reindexer (map (subst_var_in_Z_tup var k0) l2)) -> - (eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z) -> + eval_Zexpr $0 k kz -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> vars_of_reindexer (reindexer []) \subseteq dom v -> (forall l2 l3 : list (Zexpr * Zexpr), @@ -382,58 +297,30 @@ Lemma well_formed_allocation_truncr : | [] => l | (v0, d) :: xs => (v0, (d - k)%z) :: xs end) - (V - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)))) st h p v. + (V (x ++ gen_pad_list (Z.to_nat kz :: l0))) st h p v. Proof. - intros ? ? ? ? ? ? ? ? ? Halloc Hvarsub Hsh Hknonneg Hmap Hkz Henv + intros ? ? ? ? ? ? ? ? ? ? Halloc Hvarsub Hsh Hknonneg Hmap Hkz Henv Hvarsubdom HeqZlist. eapply well_formed_allocation_result_V in Halloc; eauto. invs. unfold well_formed_allocation. cases (shape_to_index (result_shape_Z - (V - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))) + (V (x ++ gen_pad_list (Z.to_nat kz :: l0)))) (shape_to_vars (result_shape_Z - (V - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))))). + (V (x ++ gen_pad_list (Z.to_nat kz :: l0)))))). { eapply shape_to_index_not_empty_Z in Heq. propositional. } cases (reindexer (let (v0, d) := p0 in (v0, (d - k)%z) :: l)). { eapply reindexer_not_empty_vars_in_index in Heq0; auto. propositional. unfold result_shape_Z in Heq. simpl in Heq. - cases ((x ++ - repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))%list). + cases ((x ++ repeat (gen_pad l0) (Z.to_nat kz))%list). - invert Heq. simpl. unfold app_no_dups. - repeat rewrite <- union_constant. - repeat rewrite cup_empty_r. - repeat rewrite cup_empty_l. - unfold not. intros. - eapply cup_empty in H. invs. - eapply constant_not_empty in H2. propositional. inversion 1. + unfold not. intros. cups_empty. - invert Heq. simpl. unfold app_no_dups. - repeat rewrite <- union_constant. - repeat rewrite cup_empty_r. - repeat rewrite cup_empty_l. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H2. invs. - eapply constant_not_empty in H. propositional. inversion 1. } - assert (0 < eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k \/ - eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k <= 0)%Z - as Hcase by lia. + unfold not. intros. cups_empty. } + assert (0 < Z.of_nat m - kz \/ Z.of_nat m - kz <= 0)%Z as Hcase by lia. inversion Hcase as [ Hcase1 | Hcase2 ]; clear Hcase. 2: { eapply result_has_shape_app_r in Hsh; eauto. simpl gen_pad_list in Hsh. rewrite repeat_length in Hsh. @@ -467,11 +354,7 @@ Proof. 2: { rewrite repeat_length. reflexivity. } cases (result_lookup_Z_option (z :: x2) - (V - (x ++ - repeat (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))))); + (V (x ++ repeat (gen_pad l0) (Z.to_nat kz)))); try (simpl in *; discriminate). eapply result_lookup_Z_option_Some_pad_r in Heq1; auto. erewrite result_has_shape_length in Heq1. @@ -484,11 +367,7 @@ Proof. rewrite repeat_length. cases (result_lookup_Z_option (z :: x2) - (V - (x ++ - repeat (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))))); + (V (x ++ repeat (gen_pad l0) (Z.to_nat kz)))); try (simpl in *; discriminate). eapply result_lookup_Z_option_Some_pad_r in Heq1; auto. erewrite result_has_shape_length in Heq1. @@ -1187,7 +1066,7 @@ Proof. Qed. *) Lemma well_formed_allocation_eval_step : - forall reindexer r l st h v p hi lo i a, + forall reindexer r l st h v p hi hiz lo loz i a, well_formed_allocation reindexer (V (r :: l)) st h p v -> h $? p = Some a -> @@ -1206,11 +1085,10 @@ Lemma well_formed_allocation_eval_step : result_has_shape (V (r :: l)) (result_shape_nat (V (r :: l))) -> ~ contains_substring "?" i -> ~ i \in dom v -> - eq_zexpr lo (| eval_Zexpr_Z_total $0 lo |)%z -> - eq_zexpr hi (| eval_Zexpr_Z_total $0 hi |)%z -> - (eval_Zexpr_Z_total $0 lo < eval_Zexpr_Z_total $0 hi)%Z -> - Datatypes.length l = - Z.to_nat (eval_Zexpr_Z_total $0 hi - (eval_Zexpr_Z_total $0 lo + 1)) -> + eval_Zexpr $0 lo loz -> + eval_Zexpr $0 hi hiz -> + (loz < hiz)%Z -> + Datatypes.length l = Z.to_nat (hiz - (loz + 1)) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V (r :: l))) v) @@ -1223,7 +1101,7 @@ Lemma well_formed_allocation_eval_step : (fun l1 : list (Zexpr * Zexpr) => reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l1)) - r st h p (v $+ (i, eval_Zexpr_Z_total $0 lo)). + r st h p (v $+ (i, loz)). Proof. unfold well_formed_allocation in *. propositional. cases (reindexer @@ -1240,10 +1118,7 @@ Proof. + eapply reindexer_not_empty_vars_in_index in Heq. propositional. auto. simpl. unfold app_no_dups. rewrite <- union_constant. - unfold not. intros. eapply cup_empty in H14. invs. - eapply cup_empty in H15. invs. - eapply cup_empty in H14. invs. - eapply constant_not_empty in H15. propositional. inversion 1. + unfold not. intros. cups_empty. + clear Heq. invs. eexists. split. eassumption. eapply subseteq_transitivity. @@ -1341,7 +1216,7 @@ Proof. Qed. Lemma well_formed_allocation_shift_top_dim_reindexer : - forall reindexer r l st h v p hi lo i a, + forall reindexer r l st h v p hi lo loz i a, well_formed_allocation reindexer (V (r :: l)) st h p v -> h $? p = Some a -> @@ -1349,6 +1224,7 @@ Lemma well_formed_allocation_shift_top_dim_reindexer : eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> (forall var, contains_substring "?" var -> var \in dom v -> False) -> + eval_Zexpr $0 lo loz -> vars_of_reindexer (reindexer []) \subseteq dom v -> (forall (var : var) (k : Z) (l0 : list (Zexpr * Zexpr)), (var \in vars_of_reindexer (reindexer []) -> False) -> @@ -1376,9 +1252,9 @@ Lemma well_formed_allocation_shift_top_dim_reindexer : reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l1)) (result_shape_Z r) - (v $+ (i, eval_Zexpr_Z_total $0 lo))) r))) p v. + (v $+ (i, loz))) r))) p v. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? Halloc Heq HeqZlist Hvar Hvarsub Hmap + intros ? ? ? ? ? ? ? ? ? ? ? ? Halloc Heq HeqZlist Hvar Hlo Hvarsub Hmap Hvarindexsub Hsh Hinj. cases l. { eapply well_formed_allocation_result_V in Halloc. invs. @@ -1390,8 +1266,7 @@ Proof. cases (reindexer [((! "?" ! + | 1 |)%z, (| 0 | + | 1 |)%z)]). eapply reindexer_not_empty_vars_in_index in Heq. propositional. auto. simpl. unfold app_no_dups. simpl. repeat rewrite cup_empty_r. - unfold not. intros. - eapply constant_not_empty in H. propositional. inversion 1. + unfold not. intros. cups_empty. rewrite lookup_add_eq by auto. eexists. split. reflexivity. sets. auto. } eapply well_formed_allocation_result_V in Halloc. invs. @@ -1406,16 +1281,12 @@ Proof. cases l. - simpl in Heq. eapply reindexer_not_empty_vars_in_index in Heq. propositional. auto. - simpl. unfold app_no_dups. simpl. repeat rewrite cup_empty_r. - unfold not. intros. eapply cup_empty in H. invert H. - eapply constant_not_empty in H2. propositional. - inversion 1. + simpl. unfold app_no_dups. simpl. + unfold not. intros. cups_empty. - simpl in Heq. eapply reindexer_not_empty_vars_in_index in Heq. propositional. auto. - simpl. unfold app_no_dups. simpl. repeat rewrite cup_empty_r. - unfold not. intros. eapply cup_empty in H. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. } + simpl. unfold app_no_dups. simpl. + unfold not. intros. cups_empty. } rewrite lookup_add_eq by auto. eexists. split. reflexivity. rewrite dom_array_add. @@ -1604,15 +1475,11 @@ Proof. (shape_to_vars (result_shape_Z sh)))). - eauto. - rewrite lookup_add_ne by auto. eauto. -Qed. +Qed. Lemma constant_subseteq_transpose : forall l n0 m0 l0 v reindexer, - result_has_shape - (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape (V l) (n0 :: m0 :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall (var : var) (k : Z) (l0 : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> @@ -1645,32 +1512,16 @@ Lemma constant_subseteq_transpose : (partial_interpret_reindexer reindexer (result_shape_Z - (transpose_result - l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)))) v) + (transpose_result l (m0 :: n0 :: l0))) v) (filter (fun x0 : list Z => negb (is_None (result_lookup_Z_option x0 - (transpose_result - l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)))))) + (transpose_result l (m0 :: n0 :: l0))))) (mesh_grid - (result_shape_Z - (transpose_result - l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)))))))). + (result_shape_Z (transpose_result l (m0 :: n0 :: l0))))))). Proof. intros ? ? ? ? ? ? Hsh Henv Hmap Hvarsub Hvarsarg HeqZlist. eapply subseteq_In. intros. @@ -1693,19 +1544,10 @@ Qed. Lemma well_formed_allocation_transpose : forall l n0 m0 l0 reindexer st h p v, - result_has_shape (V l) - (Z.to_nat - (eval_Zexpr_Z_total $0 n0) - :: Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape (V l) (n0 :: m0 :: l0) -> well_formed_allocation reindexer - (transpose_result l - (Z.to_nat - (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))) st h p v -> + (transpose_result l (m0 :: n0 :: l0)) st h p v -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall (var : var) (k : Z) (l0 : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> @@ -1742,69 +1584,32 @@ Proof. unfold result_shape_Z, shape_to_index, shape_to_vars in Heq. simpl in Heq. cases l. - simpl in *. invert Heq. simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. + unfold not. intros. cups_empty. - simpl in Heq. invert Heq. cases r. simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. + unfold not. intros. cups_empty. simpl. - unfold not. intros. cases v0. simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. + unfold not. intros. cups_empty. simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. } + unfold not. intros. cups_empty. } cases (reindexer (shape_to_index (result_shape_Z - (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) + (transpose_result l (m0 :: n0 :: l0))) (shape_to_vars (result_shape_Z - (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))))))). + (transpose_result l (m0 :: n0 :: l0)))))). { eapply reindexer_not_empty_vars_in_index in Heq1. propositional. auto. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_transpose_result. eauto. } simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m0)); - cases (Z.to_nat (eval_Zexpr_Z_total $0 n0)). - - simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H2. propositional. inversion 1. - - simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H2. propositional. inversion 1. - - simpl. - simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H2. propositional. inversion 1. - - simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H2. propositional. inversion 1. } + cases m0; cases n0. + - simpl. unfold not. intros. cups_empty. + - simpl. unfold not. intros. cups_empty. + - simpl. unfold not. intros. cups_empty. + - simpl. unfold not. intros. cups_empty. } invs. eexists. split. eassumption. eapply subseteq_transitivity. 2: eassumption. @@ -1827,7 +1632,7 @@ Lemma well_formed_allocation_concat_l : (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> - eq_zexpr x2 (|Z.of_nat m|)%z -> + eval_Zexpr $0 x2 (Z.of_nat m) -> (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> @@ -1852,21 +1657,11 @@ Proof. - invert Heq. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. auto. - simpl. - rewrite app_no_dups_empty_l. - rewrite cup_empty_r. - unfold not. intros. - eapply cup_empty in H9. invs. - eapply constant_not_empty in H10. propositional. inversion 1. + simpl. unfold not. intros. cups_empty. - invert Heq. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. auto. - simpl. - rewrite app_no_dups_empty_l. - unfold not. intros. - eapply cup_empty in H9. invs. - eapply cup_empty in H10. invs. - eapply constant_not_empty in H9. propositional. inversion 1. } + simpl. unfold not. intros. cups_empty. } cases (reindexer (shape_to_index (result_shape_Z (V (l1 ++ l2))) (shape_to_vars (result_shape_Z (V (l1 ++ l2)))))). @@ -1906,14 +1701,12 @@ Proof. Qed. Lemma well_formed_allocation_concat_r : - forall l1 l2 st h p v reindexer l0 n m, + forall l1 l2 st h p v reindexer l0 n nz m, well_formed_allocation reindexer (V (l1 ++ l2)%list) st h p v-> - result_has_shape (V l1) (map Z.to_nat (map (eval_Zexpr_Z_total $0) - (n :: l0))) -> - result_has_shape (V l2) (map Z.to_nat (map (eval_Zexpr_Z_total $0) - (m :: l0))) -> + result_has_shape (V l1) (Z.to_nat nz :: l0) -> + result_has_shape (V l2) (m :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall (var : var) (k : Z) (l0 : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> @@ -1926,8 +1719,8 @@ Lemma well_formed_allocation_concat_r : (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - eq_zexpr n (| eval_Zexpr_Z_total $0 n |)%z -> - (0 <= eval_Zexpr_Z_total $0 n)%Z -> + eval_Zexpr $0 n nz -> + (0 <= nz)%Z -> well_formed_allocation (fun l : list (Zexpr * Zexpr) => reindexer @@ -1949,21 +1742,11 @@ Proof. - invert Heq. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. auto. - simpl. - rewrite app_no_dups_empty_l. - rewrite cup_empty_r. unfold app_no_dups. - unfold not. intros. - eapply cup_empty in H10. invs. - eapply constant_not_empty in H11. propositional. inversion 1. + simpl. unfold not. intros. cups_empty. - invert Heq. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. auto. - simpl. - rewrite app_no_dups_empty_l. unfold app_no_dups. - unfold not. intros. - eapply cup_empty in H10. invs. - eapply cup_empty in H11. invs. - eapply constant_not_empty in H10. propositional. inversion 1. } + simpl. unfold not. intros. cups_empty. } cases (reindexer (shape_to_index (result_shape_Z (V (l1 ++ l2))) (shape_to_vars (result_shape_Z (V (l1 ++ l2)))))). @@ -1971,12 +1754,9 @@ Proof. auto. erewrite result_has_shape_result_shape_Z; eauto. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 n) + - Z.to_nat (eval_Zexpr_Z_total $0 m)); - inversion 1. } + cases (Z.to_nat nz + m); inversion 1. } - assert (0 < eval_Zexpr_Z_total $0 m \/ eval_Zexpr_Z_total $0 m <= 0)%Z - as Hcase by lia. + assert (0 < m \/ m <= 0) as Hcase by lia. inversion Hcase as [ Hcase1 | Hcase2 ]; clear Hcase. invs. @@ -2008,25 +1788,21 @@ Proof. rewrite add_sub. cases z; try lia. simpl Z.add. - cases (eval_Zexpr_Z_total $0 n); try lia. + cases nz; try lia. eauto. eauto. - cases (Z.pos p3 + eval_Zexpr_Z_total $0 n)%Z; try lia. - eauto. lia. lia. invert H0. simpl. lia. simpl. lia. + cases (Z.pos p3 + nz)%Z; try lia. + eauto. lia. lia. invert H0. simpl. lia. simpl. lia. erewrite result_has_shape_result_shape_Z by eauto. simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). 2: lia. + cases m. 2: lia. simpl. invs. eexists. split. eauto. sets. Qed. Lemma constant_subseteq_flatten : forall l n m l0 v reindexer, - result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape (V l) (n :: m :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall (var : var) (k : Z) (l0 : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> @@ -2052,20 +1828,12 @@ Lemma constant_subseteq_flatten : ((v0 * di + vi)%z, (d * di)%z) :: xs0 end) (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v) + (filter_until (n :: m :: l0) 0)) v) (filter (fun x0 => negb (is_None (result_lookup_Z_option x0 (V l)))) (mesh_grid (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))))) + (filter_until (n :: m :: l0) 0)))))) \subseteq constant (extract_Some @@ -2073,22 +1841,14 @@ Lemma constant_subseteq_flatten : (partial_interpret_reindexer reindexer (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) * - Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)) v) + (filter_until (n * m :: l0) 0)) v) (filter (fun x0 => negb (is_None (result_lookup_Z_option x0 (V (flatten_result l))))) (mesh_grid (map Z.of_nat - (filter_until - (Z.to_nat (eval_Zexpr_Z_total $0 n) * - Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) 0)))))). + (filter_until (n * m :: l0) 0)))))). Proof. intros ? ? ? ? ? ? Hsh Henv Hmap Hvarsub Hvarsarg HeqZlist. eapply subseteq_In. intros. @@ -2112,11 +1872,7 @@ Lemma well_formed_allocation_flatten : forall l st h p v reindexer n m xs, well_formed_allocation reindexer (V (flatten_result l)) st h p v -> - result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) xs)) -> + result_has_shape (V l) (n :: m :: xs) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> (forall (var : var) (k : Z) (l0 : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> @@ -2155,35 +1911,17 @@ Proof. cases l. - invert Heq. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. auto. simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. + unfold not. intros. cups_empty. - simpl in Heq. invert Heq. cases r. + simpl in *. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. auto. simpl. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. + unfold not. intros. cups_empty. + simpl in *. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. auto. simpl. cases v0. - * simpl in *. repeat rewrite constant_app_no_dups. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. - * simpl in *. repeat rewrite constant_app_no_dups. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. } + * simpl in *. unfold not. intros. cups_empty. + * simpl in *. unfold not. intros. cups_empty. } cases (reindexer (shape_to_index (result_shape_Z (V (flatten_result l))) @@ -2193,16 +1931,9 @@ Proof. 2: { eapply result_has_shape_flatten; eauto. } simpl. unfold shape_to_index, shape_to_vars, result_shape_Z. simpl. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 n) * - Z.to_nat (eval_Zexpr_Z_total $0 m))). - - simpl. unfold not. intros. - apply cup_empty in H. invs. - apply cup_empty in H0. invs. - apply constant_not_empty in H2. propositional. inversion 1. - - simpl. unfold not. intros. - apply cup_empty in H. invs. - apply cup_empty in H0. invs. - apply constant_not_empty in H2. propositional. inversion 1. } + cases (n * m). + - simpl. unfold not. intros. cups_empty. + - simpl. unfold not. intros. cups_empty. } invs. eexists. split. eassumption. eapply subseteq_transitivity. 2: eassumption. @@ -2210,20 +1941,16 @@ Proof. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_flatten; eauto. } eapply constant_subseteq_flatten; eauto. -Qed. +Qed. Lemma well_formed_allocation_padr : - forall l m l0 k st h p v reindexer, - result_has_shape (V l) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + forall l m l0 k kz st h p v reindexer, + result_has_shape (V l) (m :: l0) -> + eval_Zexpr $0 k kz -> + (0 <= kz)%Z -> well_formed_allocation reindexer - (V - (l ++ - repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))) st h p v -> + (V (l ++ repeat (gen_pad l0) (Z.to_nat kz))) st h p v -> (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> @@ -2243,7 +1970,7 @@ Lemma well_formed_allocation_padr : | (v0, d) :: xs => (v0, (d + k)%z) :: xs end) (V l) st h p v. Proof. - intros ? ? ? ? ? ? ? ? ? Hsh Hk Hknonneg Halloc Hvarsarg Henv HeqZlist + intros ? ? ? ? ? ? ? ? ? ? Hsh Hk Hknonneg Halloc Hvarsarg Henv HeqZlist Hvarsub Hmap. unfold well_formed_allocation in *. simpl in *. @@ -2257,51 +1984,27 @@ Proof. cases l. - invert Heq. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. auto. simpl. auto. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. + unfold not. intros. cups_empty. - simpl in Heq. invert Heq. eapply reindexer_not_empty_vars_in_index in Heq0. propositional. auto. simpl. - repeat rewrite constant_app_no_dups. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H. propositional. inversion 1. } + unfold not. intros. cups_empty. } cases (reindexer (shape_to_index (result_shape_Z - (V - (l ++ - repeat - (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))))) + (V (l ++ repeat (gen_pad l0) (Z.to_nat kz)))) (shape_to_vars (result_shape_Z - (V - (l ++ - repeat - (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))))))). + (V (l ++ repeat (gen_pad l0) (Z.to_nat kz))))))). { eapply reindexer_not_empty_vars_in_index in Heq1. propositional. auto. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_concat. eauto. eapply result_has_shape_repeat_gen_pad. } simpl. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m) + - Z.to_nat (eval_Zexpr_Z_total $0 k)). - - simpl. unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H2. propositional. inversion 1. - - simpl. unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H0. invs. - eapply constant_not_empty in H2. propositional. inversion 1. } + cases (m + Z.to_nat kz). + - simpl. unfold not. intros. cups_empty. + - simpl. unfold not. intros. cups_empty. } invs. eexists. split. eassumption. eapply subseteq_transitivity. 2: eassumption. rewrite filter_fun_pad_r. @@ -2363,23 +2066,19 @@ Proof. Qed. Lemma well_formed_allocation_split : - forall reindexer st h p v k l0 l n, + forall reindexer st h p v k kz l0 l n, well_formed_allocation reindexer - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l)) st h p v -> -result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + (V (split_result (Z.to_nat kz) l)) st h p v -> +result_has_shape (V l) (n :: l0) -> (forall l0 : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l0) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l0) -> - (0 < eval_Zexpr_Z_total $0 k)%Z -> - (0 <= eval_Zexpr_Z_total $0 n)%Z -> + (0 < kz)%Z -> (forall (var : var) (k0 : Z) (l2 : list (Zexpr * Zexpr)), ~ var \in vars_of_reindexer (reindexer []) -> map (subst_var_in_Z_tup var k0) (reindexer l2) = reindexer (map (subst_var_in_Z_tup var k0) l2)) -> - (eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z) -> - (eq_zexpr n (| eval_Zexpr_Z_total $0 n |)%z) -> + eval_Zexpr $0 k kz -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> vars_of_reindexer (reindexer []) \subseteq dom v -> (forall l2 l3 : list (Zexpr * Zexpr), @@ -2393,7 +2092,7 @@ well_formed_allocation | (v0, d) :: xs => ((v0 / k)%z, (d // k)%z) :: ((ZMod v0 k)%z, k) :: xs end) (V l) st h p v. Proof. - intros ? ? ? ? ? ? ? ? ? Halloc Hsh Hvarsub Hknonneg Hmnonneg Hmap Hkz Hm + intros ? ? ? ? ? ? ? ? ? ? Halloc Hsh Hvarsub Hknonneg Hmap Hkz Henv Hvarsubdom HeqZlist. eapply well_formed_allocation_result_V in Halloc; eauto. invs. unfold well_formed_allocation. @@ -2408,25 +2107,12 @@ Proof. unfold result_shape_Z,shape_to_index,shape_to_vars in Heq. simpl in *. cases l. - simpl in *. invert Heq. simpl. - repeat rewrite constant_app_no_dups. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H2. invs. - eapply cup_empty in H. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. + unfold not. intros. cups_empty. - simpl in *. invert Heq. simpl. - repeat rewrite constant_app_no_dups. - unfold not. intros. - eapply cup_empty in H. invs. - eapply cup_empty in H2. invs. - eapply cup_empty in H. invs. - eapply constant_not_empty in H2. propositional. - inversion 1. } + unfold not. intros. cups_empty. } erewrite result_has_shape_result_shape_Z by eauto. erewrite result_has_shape_result_shape_Z in H1. 2: { eapply result_has_shape_split_result. lia. eauto. } - rewrite <- map_cons in H1. eexists. split. eauto. eapply subseteq_transitivity. 2: eassumption. eapply subseteq_In. @@ -2438,17 +2124,14 @@ Proof. rewrite <- H. repeat rewrite map_cons. erewrite eq_partial_interpret_reindexer_split. - eexists ((z / eval_Zexpr_Z_total $0 k)%Z :: - (z mod eval_Zexpr_Z_total $0 k)%Z :: x1). - split. - rewrite Z2Nat_div_distr by lia. reflexivity. + eexists ((z / kz)%Z :: (z mod kz)%Z :: x1). + split. reflexivity. eapply filter_In. propositional. repeat decomp_goal_index. propositional. eapply Z.div_pos. lia. lia. - rewrite <- Z2Nat_div_distr by lia. - rewrite Z2Nat.id. - 2: { unfold div_ceil. eapply Z.div_pos. lia. lia. } + rewrite <- of_nat_div_distr. + rewrite Z2Nat.id by lia. eapply floor_lt_ceil_mono_l. lia. lia. lia. lia. repeat decomp_goal_index. propositional. eapply mod_nonneg. lia. @@ -2456,9 +2139,9 @@ Proof. eapply mod_upper_bound. lia. rewrite <- H4. f_equal. f_equal. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 1 by lia. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 2 by lia. + rewrite <- (Z2Nat.id kz) at 1 by lia. + rewrite <- (Z2Nat.id kz) at 2 by lia. erewrite result_lookup_Z_option_split. reflexivity. - eauto. lia. eassumption. lia. rewrite Z2Nat.id by lia. eauto. - eauto. eauto. eauto. eauto. eauto. eauto. lia. lia. eauto. lia. + eauto. lia. eassumption. lia. eauto. + eauto. eauto. eauto. eauto. eauto. eauto. lia. eauto. lia. Qed. diff --git a/src/verified_lowering/proof/WellFormedReindexer.v b/src/verified_lowering/proof/WellFormedReindexer.v index c541c3f..ea28047 100644 --- a/src/verified_lowering/proof/WellFormedReindexer.v +++ b/src/verified_lowering/proof/WellFormedReindexer.v @@ -72,21 +72,20 @@ Ltac decomp_well_formed_reindexer := end. Lemma nondestructivity_split : - forall st h p reindexer n k l v asm l0 x, + forall st h p reindexer n k kz l v asm l0 x, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer - (result_shape_Z - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l))) v) + (result_shape_Z (V (split_result (Z.to_nat kz) l))) v) (filter (fun x : list Z => negb (is_None (result_lookup_Z_option x - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l))))) + (V (split_result (Z.to_nat kz) l))))) (mesh_grid (result_shape_Z - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l))))) -> + (V (split_result (Z.to_nat kz) l))))) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -100,13 +99,10 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> nondestructivity st h p reindexer - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l)) v asm -> - vars_of_Zexpr k = [] -> - (0 < eval_Zexpr_Z_total $0 k)%Z -> - (0 <= eval_Zexpr_Z_total $0 n)%Z -> - result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + (V (split_result (Z.to_nat kz) l)) v asm -> + eval_Zexpr $0 k kz -> + (0 < kz)%Z -> + result_has_shape (V l) (n :: l0) -> h $? p = Some x -> nondestructivity st h p (fun l2 : list (Zexpr * Zexpr) => @@ -116,40 +112,35 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> | (v0, d) :: xs => ((v0 / k)%z, (d // k)%z) :: ((ZMod v0 k)%z, k) :: xs end) (V l) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg - Hassign Hk Hkpos Hnnonneg Hsh Hheap. + intros ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg + Hassign Hk Hkpos Hsh Hheap. unfold nondestructivity. split; intros. 2: { eapply lookup_Some_dom in Hheap. sets. } assert (Some x = Some arr). rewrite <- H,<-Hheap. auto. invert H3. eapply Hassign; try apply Hrdx; eauto. unfold tensor_to_array_delta in *. pose proof Hsh as Hshsplit. - eapply result_has_shape_split_result - with (k:= Z.to_nat (eval_Zexpr_Z_total $0 k)) in Hshsplit. + eapply result_has_shape_split_result with (k:= Z.to_nat kz) in Hshsplit. erewrite eq_tensor_to_array_delta_by_indices_shuffle with (shuffle:= fun l => match l with - | x::xs => (x/eval_Zexpr_Z_total $0 k)%Z - ::(Zmod x (eval_Zexpr_Z_total $0 k))%Z::xs + | x::xs => (x/kz)%Z :: (Zmod x kz)%Z::xs | _ => l end). eassumption. - intros. cases x. propositional. erewrite result_has_shape_result_shape_Z in H0 by eauto. repeat decomp_index. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 1 by lia. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 2 by lia. + rewrite <- (Z2Nat.id kz) at 1 by lia. + rewrite <- (Z2Nat.id kz) at 2 by lia. erewrite result_lookup_Z_option_split. reflexivity. repeat decomp_index. eauto. lia. apply H0. lia. - rewrite Nat2Z.id by lia. eauto. + eauto. - intros. erewrite result_has_shape_result_shape_Z in * by eauto. erewrite result_has_shape_result_shape_Z in * by eauto. repeat decomp_index. - rewrite <- Z2Nat_div_distr by lia. erewrite <- eq_partial_interpret_reindexer_split; try apply Henv; try apply Hrdx; try lia; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; - eauto. - erewrite result_has_shape_result_shape_Z in * by eauto. erewrite result_has_shape_result_shape_Z in * by eauto. intros. repeat decomp_index. @@ -157,73 +148,65 @@ Proof. repeat decomp_goal_index. split. split. eapply Z.div_pos. lia. lia. - rewrite <- Z2Nat_div_distr by lia. - rewrite Z2Nat.id. - 2: { eapply div_nonneg. lia. lia. } + rewrite <- of_nat_div_distr. rewrite Z2Nat.id by lia. eapply floor_lt_ceil_mono_l; lia. decomp_goal_index. split. rewrite Z2Nat.id by lia. eapply Z.mod_pos_bound. lia. eauto. rewrite <- H4. f_equal. f_equal. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 1 by lia. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 k)) at 2 by lia. + rewrite <- (Z2Nat.id kz) at 1 by lia. + rewrite <- (Z2Nat.id kz) at 2 by lia. erewrite result_lookup_Z_option_split. reflexivity. - eauto. lia. apply H0. lia. rewrite Z2Nat.id. eauto. lia. + eauto. lia. apply H0. lia. eauto. - erewrite result_has_shape_result_shape_Z in * by eauto. erewrite result_has_shape_result_shape_Z in * by eauto. intros. repeat decomp_index. - eexists ((z*(eval_Zexpr_Z_total $0 k) + z0)%Z::x). + eexists ((z*kz + z0)%Z::x). rewrite Z.div_add_l by lia. rewrite Z.div_small by lia. rewrite Z.add_0_r. pose proof Z.add_mul_mod_distr_r. - specialize H5 with (b:=1%Z) (c:= eval_Zexpr_Z_total $0 k). + specialize H5 with (b:=1%Z) (c:= kz). rewrite Z.mul_1_l in *. rewrite H5. rewrite Z.mod_1_r. split. auto. eapply filter_In. split. repeat decomp_goal_index. split. - split. lia. rewrite Z2Nat.id. - 2: { lia. } + split. lia. eapply result_lookup_Z_option_split_true. eauto. - rewrite <- Z2Nat_div_distr in *. - 2: { lia. } 2: { lia. } - rewrite Z2Nat.id in H0. - 2: { eapply ceil_div_nonneg. lia. lia. } - lia. lia. lia. lia. lia. lia. lia. + rewrite <- of_nat_div_distr in H0. rewrite Z2Nat.id in H0 by lia. + lia. lia. all: eauto. + rewrite Nat2Z.id. eauto. rewrite <- H4. erewrite <- result_lookup_Z_option_split - with (k:=Z.to_nat (eval_Zexpr_Z_total $0 k)); eauto. + with (k:=Z.to_nat kz); eauto. 2: { lia. } 3: lia. 3: { lia. } all: try lia. - 2: { rewrite <- Z2Nat_div_distr in H0. - 2: { lia. } - 2: { lia. } + 2: { rewrite <- of_nat_div_distr in H0. rewrite Z2Nat.id in H0 by lia. rewrite Z2Nat.id in * by lia. eapply result_lookup_Z_option_split_true. eauto. - lia. lia. lia. eauto. eauto. } + lia. lia. lia. eauto. rewrite Nat2Z.id. eauto. } rewrite Z2Nat.id by lia. rewrite Z.div_add_l by lia. rewrite Z.div_small by lia. rewrite Z.add_0_r. pose proof Z.add_mul_mod_distr_r. - specialize H7 with (b:=1%Z) (c:= eval_Zexpr_Z_total $0 k). + specialize H7 with (b:=1%Z) (c:= kz). rewrite Z.mul_1_l in *. rewrite H7. rewrite Z.mod_1_r. reflexivity. lia. lia. lia. - eapply partial_injective_split. eauto. eauto. apply Henv. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. all: eauto. - eauto. - unfold injective. erewrite result_has_shape_result_shape_Z by eauto. propositional. repeat decomp_index. invert H5. - rewrite (Z.div_mod z (eval_Zexpr_Z_total $0 k)). - rewrite (Z.div_mod z0 (eval_Zexpr_Z_total $0 k)). + rewrite (Z.div_mod z kz). + rewrite (Z.div_mod z0 kz). rewrite H10. rewrite H11. reflexivity. lia. lia. - eapply no_dup_filter. eauto with reindexers. - eapply no_dup_filter. eauto with reindexers. @@ -231,8 +214,8 @@ Proof. Qed. Lemma nondestructivity_array_add_shift_top_dim_reindexer : - forall i lo hi l st h v x p r reindexer asm, - (eval_Zexpr_Z_total $0 lo < eval_Zexpr_Z_total $0 hi)%Z -> + forall i lo loz hi hiz l st h v x p r reindexer asm, + (loz < hiz)%Z -> ~ i \in dom v -> ~ contains_substring "?" i -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> @@ -253,12 +236,11 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - eq_zexpr lo (| eval_Zexpr_Z_total $0 lo |)%z -> - eq_zexpr hi (| eval_Zexpr_Z_total $0 hi |)%z -> + eval_Zexpr $0 lo loz -> + eval_Zexpr $0 hi hiz -> result_has_shape (V (r :: l)) (result_shape_nat (V (r :: l))) -> well_formed_allocation reindexer (V (r :: l)) st h p v -> - length l = - Z.to_nat (eval_Zexpr_Z_total $0 hi - (eval_Zexpr_Z_total $0 lo + 1)) -> + length l = Z.to_nat (hiz - (loz + 1)) -> nondestructivity st h p reindexer (V (r :: l)) v asm -> h $? p = Some x -> nondestructivity st @@ -267,11 +249,11 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> (tensor_to_array_delta (partial_interpret_reindexer (fun l5 : list (Zexpr * Zexpr) => - reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l5)) - (result_shape_Z r) (v $+ (i, eval_Zexpr_Z_total $0 lo))) r))) p + reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l5)) + (result_shape_Z r) (v $+ (i, loz))) r))) p (shift_top_dim_reindexer reindexer) (V l) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? ? Hlohi Hidom Hsubstring Henv + intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? Hlohi Hidom Hsubstring Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg Hlo Hhi Hsh Halloc Hlen Hassign Hlookup. unfold nondestructivity. split; intros. @@ -311,7 +293,7 @@ Proof. repeat decomp_index. erewrite eq_partial_interpret_reindexer_shift_top_dim_reindexer - in H0,H; try apply Hrdx; eauto. + in H0,H; try apply Hrdx; eauto. 2: { cases l. inversion 1. simpl in *. lia. inversion 1. } 2: { cases l. inversion 1. simpl in *. lia. inversion 1. } 2: { eapply forall_result_has_shape; eauto. invert Hsh. eauto. } @@ -319,7 +301,7 @@ Proof. erewrite result_has_shape_result_shape_Z in H0. 2: { invert Hsh. eauto. } erewrite eq_partial_interpret_reindexer_eval_0 in H0; - try apply Hrdx; eauto. + try apply Hrdx; eauto. 2: { unfold not. intros. apply Hsubstring. eapply shape_to_vars_contains_substring. eauto. } 2: { simpl. lia. } @@ -352,13 +334,13 @@ Proof. all: eauto. 2: { lia. } 2: { unfold not. intros. eapply shape_to_vars_contains_substring in H. - sets. } + sets. } rewrite dom_array_add. sets. Qed. Lemma nondestructivity_cons_0 : - forall reindexer i lo hi v st h p r l x asm, - (eval_Zexpr_Z_total $0 lo < eval_Zexpr_Z_total $0 hi)%Z -> + forall reindexer i lo loz hi hiz v st h p r l x asm, + (loz < hiz)%Z -> ~ i \in dom v -> ~ contains_substring "?" i -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> @@ -379,19 +361,18 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - eq_zexpr lo (| eval_Zexpr_Z_total $0 lo |)%z -> - eq_zexpr hi (| eval_Zexpr_Z_total $0 hi |)%z -> + eval_Zexpr $0 lo loz -> + eval_Zexpr $0 hi hiz -> result_has_shape (V (r :: l)) (result_shape_nat (V (r :: l))) -> h $? p = Some x -> - length l = - Z.to_nat (eval_Zexpr_Z_total $0 hi - (eval_Zexpr_Z_total $0 lo + 1)) -> + length l = Z.to_nat (hiz - (loz + 1)) -> nondestructivity st h p reindexer (V (r :: l)) v asm -> nondestructivity st h p (fun l3 : list (Zexpr * Zexpr) => reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l3)) r - (v $+ (i, eval_Zexpr_Z_total $0 lo)) asm. + (v $+ (i, loz)) asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? ? Hlohi Hidom Hsubstring + intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? Hlohi Hidom Hsubstring Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg Hlo Hhi Hsh Hheap Hlen Hassign. unfold nondestructivity. split; intros. @@ -461,21 +442,17 @@ Proof. Qed. Lemma nondestructivity_alloc_heap : - forall e1 esh1 st'0 h p v x l2 asm z0 zs nz z reindexer l1, - constant_nonneg_bounds e1 -> - size_of e1 (z::esh1) -> + forall e1 sz1 st'0 h p v x l2 asm nz z reindexer l1, + nonneg_bounds $0 e1 -> + size_of $0 e1 (z::sz1) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> nondestructivity st'0 h p reindexer l2 v asm -> - eval_Zexpr v z z0 -> - eval_Zexprlist v esh1 zs -> eval_Zexpr v (flat_sizeof e1) nz -> - result_has_shape (V l1) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (z :: esh1))) -> + result_has_shape (V l1) (z :: sz1) -> nondestructivity st'0 (alloc_array_in_heap [Z.to_nat nz] h x) x (fun l : list (Zexpr * Zexpr) => l) (V l1) v Assign. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? Hconst Hsize Henv Hassign Hz Hzs - Hflat Hsh. + intros ? ? ? ? ? ? ? ? ? ? ? ? ? Hbds Hsize Henv Hassign Hz Hsh. unfold nondestructivity in *. invs. split; intros. - unfold alloc_array_in_heap in *. rewrite lookup_add_eq in * by auto. @@ -491,54 +468,43 @@ Proof. invert H4. rewrite add_0_r. 2: { decomp_index. eauto. } 2: { apply Henv. } - pose proof (lookup_alloc_array (Z.to_nat nz) - (flatten (result_shape_Z (V l1)) x1)). + pose proof (lookup_alloc_array (Z.to_nat nz) (flatten (result_shape_Z (V l1)) x1)). invert H1. 2: auto. eapply lookup_None_dom in H4. exfalso. apply H4. rewrite dom_alloc_array. erewrite <- In_iff_in. - unfold flat_sizeof in *. erewrite size_of_sizeof in * by eauto. - simpl in Hflat. eapply eval_Zexpr_Z_eval_Zexpr in Hflat. - erewrite eval_Zexpr_Z_fold_left_ZTimes in Hflat; eauto. invert Hflat. - replace (fold_left Z.mul zs z0) with (fold_left Z.mul (z0::zs) 1%Z). - 2: { simpl. f_equal. lia. } - rewrite Z2Nat.id. erewrite result_has_shape_result_shape_Z by eauto. - pose proof Hconst. - eapply constant_nonneg_bounds_size_of_no_vars in H1. - 2: { eauto. } - 2: { eapply fold_left_mul_nonneg. 2: lia. - eapply constant_nonneg_bounds_size_of_nonneg. eauto. - eauto. econstructor; eauto. } - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v) in H1. - invert H1. eq_eval_Z. eq_eval_Zlist. repeat decomp_index. + unfold flat_sizeof in *. + pose proof size_of_sizeof as Hsz. specialize Hsz with (1 := Hsize) (2 := Hbds). + destruct Hsz as (lz&Hsz&?). subst. simpl in Hsz. invert Hsz. + rewrite <- H1 in *. + pose proof eval_Zexpr_Z_fold_left_ZTimes as H'. + specialize (H' _ _ _ ltac:(eassumption) _ _ ltac:(eassumption)). + apply eval_Zexpr_Z_eval_Zexpr in H'. + eapply eval_Zexpr_includes_valuation in H'. 2: apply empty_includes. + eapply eval_Zexpr_deterministic in H'. 2: apply Hz. subst. + erewrite result_has_shape_result_shape_Z by eauto. + repeat decomp_index. erewrite filter_until_0_id. - 2: { erewrite result_has_shape_result_shape_Z in H1 by eauto. + 2: { erewrite result_has_shape_result_shape_Z in H6 by eauto. decomp_index. - pose proof Hconst. - eapply constant_nonneg_bounds_size_of_nonneg in H5; eauto. - invert H5. - rewrite Z2Nat.id in * by lia. - rewrite Z2Natid_list in H1; eauto. - eapply mesh_grid_shape_pos in H1. rewrite map_cons. - eapply Forall_map. eapply Forall_impl. - 2: apply H1. simpl. lia. } - rewrite <- map_cons. - rewrite Z2Natid_list. - 2: { pose proof Hconst. - eapply constant_nonneg_bounds_size_of_nonneg in H5; eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v). - eapply constant_nonneg_bounds_size_of_no_vars. eauto. eauto. } + eapply mesh_grid_shape_pos in H6. + eapply Forall_impl. 2: apply Forall_map; eassumption. + simpl. lia. } + rewrite Z2Nat.id. + 2: { apply fold_left_mul_nonneg; try lia. + apply Forall_map. apply Forall_forall. intros. lia. } + replace (fold_left Z.mul (map Z.of_nat sz1) (Z.of_nat z)) with + (fold_left Z.mul (map Z.of_nat (z :: sz1)) 1%Z). + 2: { simpl. f_equal. lia. } eapply in_mesh_grid_flatten_in_range. - eapply constant_nonneg_bounds_size_of_nonneg. eauto. eauto. - eapply forall_no_vars_eval_Zexpr_Z_total with (v:=v). - eapply constant_nonneg_bounds_size_of_no_vars. eapply Hconst. eauto. - erewrite result_has_shape_result_shape_Z in H1 by eauto. - repeat decomp_index. rewrite mesh_grid_map_Nat2Z_id in *. - simpl map. decomp_goal_index. propositional. lia. + apply Forall_map. apply Forall_forall. lia. + erewrite result_has_shape_result_shape_Z in H6 by eauto. + repeat decomp_index. + simpl map. decomp_goal_index. propositional. - rewrite dom_alloc_array_in_heap in *. sets. inversion 1. Qed. Lemma nondestructivity_concat_r : - forall st h p v e1 e2 l1 l2 reindexer asm x rest1 rest2 dim1 dim2, + forall st h p v e1 e2 l1 l2 reindexer asm x rest1 rest2 dim1 dim2 dim2z, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V (l1 ++ l2))) v) @@ -559,28 +525,15 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> nondestructivity st h p reindexer (V (l1 ++ l2)) v asm -> h $? p = Some x -> -size_of e1 (dim1 :: rest1) -> -size_of e2 (dim2 :: rest2) -> -result_has_shape (V l2) - (Z.to_nat (eval_Zexpr_Z_total $0 dim2) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -result_has_shape (V l1) - (Z.to_nat (eval_Zexpr_Z_total $0 dim1) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -result_has_shape (V (l1 ++ l2)) - (Z.to_nat (eval_Zexpr_Z_total $0 dim1) + - Z.to_nat (eval_Zexpr_Z_total $0 dim2) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -(0 <= eval_Zexpr_Z_total $0 dim1)%Z -> -(0 <= eval_Zexpr_Z_total $0 dim2)%Z -> -eq_zexpr dim1 (| eval_Zexpr_Z_total $0 dim1 |)%z -> -eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> +nonneg_bounds $0 e1 -> +size_of $0 e1 (dim1 :: rest1) -> +nonneg_bounds $0 e2 -> +size_of $0 e2 (Z.to_nat dim2z :: rest2) -> +result_has_shape (V l2) (Z.to_nat dim2z :: rest1) -> +result_has_shape (V l1) (dim1 :: rest1) -> +result_has_shape (V (l1 ++ l2)) (dim1 + Z.to_nat dim2z :: rest1) -> +(0 <= dim2z)%Z -> +eval_Zexpr $0 dim2 dim2z -> nondestructivity st (h $+ (p, array_add x @@ -607,24 +560,25 @@ eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> end)%z) :: xs end) (V l2) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap - Hvarsarg Hassign Hheap Hsize1 Hsize2 Hsh2 Hsh1 Hsh Hdim1nonneg - Hdim2nonneg Heqdim1 Heqdim2. + intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap + Hvarsarg Hassign Hheap Hbds1 Hsize1 Hbds2 Hsize2 Hsh2 Hsh1 Hsh Hdim2nonneg Heqdim2. unfold nondestructivity in *. invs. split; intros. - rewrite lookup_add_eq in * by auto. invert H1. + pose proof size_of_sizeof as Hsz. + specialize (Hsz _ _ _ Hsize1 Hbds1). destruct Hsz as (lz&Hsz&?). subst. + simpl in Hsz. invert Hsz. rewrite <- H1 in *. erewrite lookup_array_add_weak_l. 2: { erewrite result_has_shape_result_shape_Z by eauto. - erewrite size_of_sizeof in * by eauto. simpl in H4. erewrite result_has_shape_result_shape_Z in H4 by eauto. unfold tensor_to_array_delta, tensor_to_array_delta_by_indices in *. rewrite partial_dom_fold_left_array_add in *. 2: { eauto. } 2: { erewrite result_has_shape_result_shape_Z by eauto. - eapply partial_injective_concat_r. eauto. - eauto. eauto. apply Henv. - all: eauto. } + eapply partial_injective_concat_r; eauto. + rewrite Nat2Z.id. eauto. + lia. } 2: { erewrite result_has_shape_result_shape_Z by eauto. eapply partial_injective_concat_l. eauto. eauto. eauto. apply Henv. @@ -635,25 +589,23 @@ Proof. rewrite dom_empty in *. rewrite cup_empty_r in *. erewrite result_has_shape_result_shape_Z in * by eauto. unfold not. intros. - eapply In_iff_in in H1,H4. - eapply in_extract_Some in H1,H4. - eapply in_map_iff in H1,H4. invs. - rewrite <- H1 in H4. + eapply In_iff_in in H2,H4. + eapply in_extract_Some in H2,H4. + eapply in_map_iff in H2,H4. invs. + rewrite <- H2 in H4. repeat decomp_index. - erewrite eq_partial_interpret_reindexer_padr in H1, H4. - erewrite eq_partial_interpret_reindexer_padl in H4. - rewrite (Nat.add_comm (Z.to_nat (eval_Zexpr_Z_total $0 dim2))) - in H1,H4. - (* pose proof H6 as Hinj; clear H6. - erewrite result_has_shape_result_shape_Z in Hinj by eauto. *) + erewrite eq_partial_interpret_reindexer_padr in H2, H4 by (eassumption || lia). + erewrite eq_partial_interpret_reindexer_padl in H4 by (eassumption || lia). + rewrite Nat2Z.id in H4. + rewrite (Nat.add_comm (Z.to_nat dim2z)) + in H2,H4. pose proof H4. eapply Hinj in H4. - invert H4. invert H11. lia. - rewrite H11 in H2. - rewrite H1 in H2. discriminate. + invert H4. invert H14. lia. + rewrite H14 in H5. + rewrite H2 in H5. discriminate. eapply filter_In. split; eauto. - repeat decomp_goal_index. split. lia. eauto. rewrite <- H7. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 dim1)) by lia. + repeat decomp_goal_index. split. lia. eauto. rewrite <- H10. erewrite <- result_lookup_Z_truncl. 2: lia. rewrite truncl_list_skipn. rewrite skipn_app. rewrite skipn_all2. @@ -661,7 +613,7 @@ Proof. erewrite result_has_shape_length by eauto. rewrite sub_diag. simpl. reflexivity. eapply filter_In. split. - repeat decomp_goal_index. split. lia. eauto. rewrite <- H9. + repeat decomp_goal_index. split. lia. eauto. rewrite <- H12. simpl. cases z0; try lia. rewrite nth_error_app1. 2: { erewrite result_has_shape_length by eauto. lia. } auto. @@ -672,7 +624,6 @@ Proof. all: try lia. all: eauto. } eapply H; eauto. - erewrite size_of_sizeof in * by eauto. simpl in H4. erewrite result_has_shape_result_shape_Z in * by eauto. unfold tensor_to_array_delta in *. unfold tensor_to_array_delta_by_indices in *. @@ -680,8 +631,8 @@ Proof. 2: { erewrite result_has_shape_result_shape_Z by eauto. eapply partial_injective_concat_r with (l1:=l1). erewrite result_has_shape_result_shape_Z by eauto. eauto. - eauto. eauto. apply Henv. - all: eauto. } + rewrite Nat2Z.id. eassumption. + eauto. apply Henv. all: eauto. lia. } 2: { invs. erewrite result_has_shape_result_shape_Z in * by eauto. eauto. } @@ -692,12 +643,11 @@ Proof. rewrite filter_idempotent in *. erewrite result_has_shape_result_shape_Z in * by eauto. repeat decomp_index. - erewrite eq_partial_interpret_reindexer_padl in H2; eauto; + erewrite eq_partial_interpret_reindexer_padl in H4; eauto; try apply Henv; try apply Hrdx; try lia. - eexists. rewrite H2. split. auto. eapply filter_In. + eexists. rewrite Nat2Z.id in H4. rewrite H4. split. auto. eapply filter_In. split. repeat decomp_goal_index. - split. lia. eauto. rewrite <- H5. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 dim1)) by lia. + split. lia. eauto. rewrite <- H8. erewrite <- result_lookup_Z_truncl. rewrite truncl_list_skipn. rewrite skipn_app. rewrite skipn_all2. @@ -710,7 +660,7 @@ Proof. Qed. Lemma nondestructivity_concat_r__ : - forall st h p v l1 l2 reindexer asm x rest1 dim1 dim2, + forall st h p v l1 l2 reindexer asm x rest1 dim1 dim1z dim2 dim2z, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V (l1 ++ l2))) v) @@ -731,20 +681,12 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> nondestructivity st h p reindexer (V (l1 ++ l2)) v asm -> h $? p = Some x -> -result_has_shape (V l2) - (Z.to_nat (eval_Zexpr_Z_total $0 dim2) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -result_has_shape (V l1) - (Z.to_nat (eval_Zexpr_Z_total $0 dim1) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -(0 <= eval_Zexpr_Z_total $0 dim1)%Z -> -(0 <= eval_Zexpr_Z_total $0 dim2)%Z -> -eq_zexpr dim1 (| eval_Zexpr_Z_total $0 dim1 |)%z -> -eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> +result_has_shape (V l2) (Z.to_nat dim2z :: rest1) -> +result_has_shape (V l1) (Z.to_nat dim1z :: rest1) -> +(0 <= dim1z)%Z -> +(0 <= dim2z)%Z -> +eval_Zexpr $0 dim1 dim1z -> +eval_Zexpr $0 dim2 dim2z -> nondestructivity st (h $+ (p, array_add x @@ -765,7 +707,7 @@ eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> (d + dim1)%z) :: xs end) (V l2) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap + intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg Hnondstr Hheap Hsh2 Hsh1 Hdim1nonneg Hdim2nonneg Heqdim1 Heqdim2. unfold nondestructivity in *. invs. @@ -773,7 +715,7 @@ Proof. - rewrite lookup_add_eq in * by auto. invert H1. erewrite lookup_array_add_weak_l. 2: { erewrite result_has_shape_result_shape_Z by eauto. - simpl in H4. + simpl in H4. erewrite result_has_shape_result_shape_Z in H4 by eauto. unfold tensor_to_array_delta, tensor_to_array_delta_by_indices in *. @@ -798,12 +740,9 @@ Proof. eapply in_map_iff in H1,H4. invs. rewrite <- H1 in H4. repeat decomp_index. - erewrite eq_partial_interpret_reindexer_padr in H1, H4. - erewrite eq_partial_interpret_reindexer_padl in H4. - rewrite (Nat.add_comm (Z.to_nat (eval_Zexpr_Z_total $0 dim2))) - in H1,H4. - (* pose proof H6 as Hinj; clear H6. - by eauto. *) + erewrite eq_partial_interpret_reindexer_padr in H1, H4 by (eassumption || lia). + erewrite eq_partial_interpret_reindexer_padl in H4 by (eassumption || lia). + rewrite (Nat.add_comm (Z.to_nat dim2z)) in H1,H4. erewrite result_has_shape_result_shape_Z in Hinj. 2: { eapply result_has_shape_concat. eauto. eauto. } pose proof H4. @@ -813,7 +752,7 @@ Proof. rewrite H1 in H2. discriminate. eapply filter_In. split; eauto. repeat decomp_goal_index. split. lia. eauto. rewrite <- H7. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 dim1)) by lia. + rewrite <- (Z2Nat.id dim1z) by lia. erewrite <- result_lookup_Z_truncl. 2: lia. rewrite truncl_list_skipn. rewrite skipn_app. rewrite skipn_all2. @@ -826,18 +765,13 @@ Proof. rewrite nth_error_app1. 2: { erewrite result_has_shape_length by eauto. lia. } auto. rewrite nth_error_app1. - 2: { erewrite result_has_shape_length by eauto. lia. } auto. - all: try apply Hrdx. - all: try apply Henv. - all: try lia. - all: eauto. } + 2: { erewrite result_has_shape_length by eauto. lia. } auto. } eapply H; eauto. - simpl in H4. erewrite result_has_shape_result_shape_Z in * by eauto. unfold tensor_to_array_delta in *. unfold tensor_to_array_delta_by_indices in *. rewrite partial_dom_fold_left_array_add in *. - 2: { eauto. } + 2: { eauto. } 2: { erewrite result_has_shape_result_shape_Z by eauto. eapply partial_injective_concat_r with (l1:=l1). eauto. eauto. eauto. apply Henv. all: eauto. } @@ -859,7 +793,7 @@ Proof. rewrite H2. split. auto. eapply filter_In. split. repeat decomp_goal_index. split. lia. eauto. rewrite <- H5. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 dim1)) by lia. + rewrite <- (Z2Nat.id dim1z) by lia. erewrite <- result_lookup_Z_truncl. rewrite truncl_list_skipn. rewrite skipn_app. rewrite skipn_all2. @@ -870,7 +804,7 @@ Proof. Qed. Lemma nondestructivity_concat_l : - forall st h p v l1 l2 reindexer asm x rest1 dim1 dim2, + forall st h p v l1 l2 reindexer asm x rest1 dim1 dim1z dim2 dim2z, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V (l1 ++ l2))) v) @@ -891,20 +825,12 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> nondestructivity st h p reindexer (V (l1 ++ l2)) v asm -> h $? p = Some x -> -result_has_shape (V l2) - (Z.to_nat (eval_Zexpr_Z_total $0 dim2) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -result_has_shape (V l1) - (Z.to_nat (eval_Zexpr_Z_total $0 dim1) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -(0 <= eval_Zexpr_Z_total $0 dim1)%Z -> -(0 <= eval_Zexpr_Z_total $0 dim2)%Z -> -eq_zexpr dim1 (| eval_Zexpr_Z_total $0 dim1 |)%z -> -eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> +result_has_shape (V l2) (Z.to_nat dim2z :: rest1) -> +result_has_shape (V l1) (Z.to_nat dim1z :: rest1) -> +(0 <= dim1z)%Z -> +(0 <= dim2z)%Z -> +eval_Zexpr $0 dim1 dim1z -> +eval_Zexpr $0 dim2 dim2z -> nondestructivity st h p (fun l0 : list (Zexpr * Zexpr) => reindexer @@ -913,7 +839,7 @@ eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> | (v0, d) :: xs => (v0, (d + dim2)%z) :: xs end) (V l1) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap + intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg Hassign Hheap Hsh2 Hsh1 Hdim1nonneg Hdim2nonneg Heqdim1 Heqdim2. unfold nondestructivity in *. invs. @@ -927,8 +853,7 @@ Proof. 2: { erewrite result_has_shape_result_shape_Z by eauto. eapply partial_injective_concat_l; try apply Hrdx; eauto. rewrite Z2Nat.id by lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eapply Heqdim2. } + assumption. } 2: { eauto. } rewrite @filter_idempotent in *. rewrite dom_empty in *. rewrite cup_empty_r in *. @@ -945,7 +870,7 @@ Proof. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_concat. eauto. eauto. } eexists x1. - split. auto. + split. auto. erewrite result_has_shape_result_shape_Z in * by eauto. repeat decomp_index. eapply filter_In. split. repeat decomp_goal_index. split. lia. eauto. @@ -958,34 +883,17 @@ Qed. Lemma nondestructivity_transpose : forall n0 m0 l0 st h p v l reindexer asm a, - (*eval_Zexprlist v (n0 :: m0 :: l0) - (eval_Zexpr_Z_total $0 n0 - :: eval_Zexpr_Z_total $0 m0 - :: map (eval_Zexpr_Z_total $0) l0) ->*) (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - partial_injective (partial_interpret_reindexer reindexer - (result_shape_Z - (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) v) + (result_shape_Z (transpose_result l (m0 :: n0 :: l0))) v) (filter (fun x : list Z => negb (is_None - (result_lookup_Z_option x - (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))))) + (result_lookup_Z_option x (transpose_result l (m0 :: n0 :: l0))))) (mesh_grid - (result_shape_Z - (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))))) -> + (result_shape_Z (transpose_result l (m0 :: n0 :: l0))))) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -999,17 +907,9 @@ Lemma nondestructivity_transpose : vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> nondestructivity st h p reindexer - (transpose_result l - (Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) v asm -> + (transpose_result l (m0 :: n0 :: l0)) v asm -> h $? p = Some a -> - result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> - vars_of_Zexpr n0 = [] -> - vars_of_Zexpr m0 = [] -> + result_has_shape (V l) (n0 :: m0 :: l0) -> nondestructivity st h p (fun l4 : list (Zexpr * Zexpr) => reindexer @@ -1020,7 +920,7 @@ Lemma nondestructivity_transpose : end) (V l) v asm. Proof. intros ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZZlist - Hvarsub Hmap Hvarsarg Hassign Hheap Hsh Hvarn0 Hvarm0. + Hvarsub Hmap Hvarsarg Hassign Hheap Hsh. unfold nondestructivity in *. invs. split; intros. - eapply H; eauto. unfold tensor_to_array_delta in *. @@ -1033,7 +933,6 @@ Proof. erewrite result_has_shape_result_shape_Z in H5. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. eauto. } repeat decomp_index. - rewrite mesh_grid_map_Nat2Z_id in *. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. + intros. @@ -1061,12 +960,12 @@ Proof. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. eauto. } repeat decomp_index. eexists (z0::z::x0). split. auto. eapply filter_In. propositional. - repeat decomp_goal_index. propositional. + repeat decomp_goal_index. propositional. repeat decomp_goal_index. propositional. rewrite <- H7. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. + eauto. - + eapply partial_injective_transpose; eauto. + + eapply partial_injective_transpose; eauto. + erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_transpose_result. simpl in Hsh. eauto. } unfold injective. @@ -1097,10 +996,7 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape (V l) (n :: m :: l0) -> h $? p = Some a -> nondestructivity st h p reindexer (V (flatten_result l)) v asm -> nondestructivity st h p @@ -1121,9 +1017,7 @@ Proof. with (shuffle:= fun l => match l with | x::y::xs => - (x*(Z.of_nat - (Z.to_nat - (eval_Zexpr_Z_total $0 m))) + y)%Z::xs + (x * Z.of_nat m + y)%Z::xs | _ => l end). eassumption. + intros. erewrite result_has_shape_result_shape_Z in H5 by eauto. @@ -1149,28 +1043,22 @@ Proof. + intros. erewrite result_has_shape_result_shape_Z in H5. 2: { eapply result_has_shape_flatten. eauto. } repeat decomp_index. - pose proof (Z_div_mod - z (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))). - assert (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) > 0)%Z by lia. + pose proof (Z_div_mod z (Z.of_nat m)). + assert (Z.of_nat m > 0)%Z by lia. propositional. - cases (Z.div_eucl z (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))). + cases (Z.div_eucl z (Z.of_nat m)). invert H2. eexists (z0::z1::x0). rewrite Z.mul_comm. split. auto. erewrite result_has_shape_result_shape_Z by eauto. eapply filter_In. propositional. - repeat decomp_goal_index. propositional. - assert (-1 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) < - z0 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))%Z - by lia. + repeat decomp_goal_index. propositional. + assert (-1 * Z.of_nat m < z0 * Z.of_nat m)%Z by lia. eapply Zorder.Zmult_lt_reg_r in H11. lia. lia. rewrite Nat2Z.inj_mul in H10. - rewrite - (Z.mul_comm (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 n)))) in H10. + rewrite (Z.mul_comm (Z.of_nat n)) in H10. eapply div_eucl_bound in H10. lia. - assert (-1 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) < - z0 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))%Z - by lia. + assert (-1 * Z.of_nat m < z0 * Z.of_nat m)%Z by lia. eapply Zorder.Zmult_lt_reg_r in H11. lia. lia. lia. @@ -1178,19 +1066,14 @@ Proof. rewrite <- H7. erewrite <- result_lookup_Z_option_flatten. rewrite Z.mul_comm. reflexivity. - assert (-1 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) < - z0 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))%Z - by lia. + assert (-1 * Z.of_nat m < z0 * Z.of_nat m)%Z by lia. eapply Zorder.Zmult_lt_reg_r in H11. - lia. lia. + lia. lia. rewrite Nat2Z.inj_mul in H10. - rewrite - (Z.mul_comm (Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 n)))) in H10. + rewrite (Z.mul_comm (Z.of_nat n)) in H10. eapply div_eucl_bound in H10. apply H10. - assert (-1 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)) < - z0 * Z.of_nat (Z.to_nat (eval_Zexpr_Z_total $0 m)))%Z - by lia. + assert (-1 * Z.of_nat m < z0 * Z.of_nat m)%Z by lia. eapply Zorder.Zmult_lt_reg_r in H11. lia. lia. eauto. eauto. @@ -1246,9 +1129,8 @@ Qed. Lemma nondestructivity_tensor_shape_0 : forall l x l0 p x0 reindexer h st asm v, - result_has_shape (V l) - (map Z.to_nat (x:: (map (eval_Zexpr_Z_total $0) l0))) -> - Exists (fun x : Z => x = 0%Z) (map (eval_Zexpr_Z_total $0) l0) -> + result_has_shape (V l) (x :: l0) -> + Exists (fun x => x = 0) l0 -> h $? p = Some x0 -> nondestructivity st h p reindexer (V l) v asm. Proof. @@ -1257,27 +1139,24 @@ Proof. - unfold tensor_to_array_delta in H5. erewrite result_has_shape_result_shape_Z in H5 by eauto. rewrite mesh_grid_filter_until in H5. - rewrite mesh_grid_map_Nat2Z_id in H5. erewrite exists_0_empty_mesh_grid in H5. - 2: { simpl. right. eauto. } + 2: { simpl. right. apply Exists_map. + eapply Exists_impl; [|eassumption]. simpl. lia. } unfold tensor_to_array_delta_by_indices in *. simpl in *. rewrite dom_empty in *. sets. - - eapply lookup_Some_dom in H1. sets. + - eapply lookup_Some_dom in H1. sets. Qed. Lemma nondestructivity_trunc_r : - forall st h p v reindexer m l0 k x asm x1, + forall st h p v reindexer m l0 k kz x asm x1, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V (rev - (truncl_list (Z.to_nat (eval_Zexpr_Z_total $0 k)) - (repeat - (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) ++ + (truncl_list (Z.to_nat kz) + (repeat (gen_pad l0) (Z.to_nat kz) ++ rev x))))) v) (filter (fun x0 : list Z => @@ -1286,21 +1165,15 @@ partial_injective (result_lookup_Z_option x0 (V (rev - (truncl_list (Z.to_nat (eval_Zexpr_Z_total $0 k)) - (repeat - (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) ++ + (truncl_list (Z.to_nat kz) + (repeat (gen_pad l0) (Z.to_nat kz) ++ rev x))))))) (mesh_grid (result_shape_Z (V (rev - (truncl_list (Z.to_nat (eval_Zexpr_Z_total $0 k)) - (repeat - (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) ++ + (truncl_list (Z.to_nat kz) + (repeat (gen_pad l0) (Z.to_nat kz) ++ rev x))))))) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> @@ -1313,17 +1186,10 @@ partial_injective (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - result_has_shape - (V - (x ++ - repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))) - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> - vars_of_Zexpr k = [] -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> - vars_of_Zexpr m = [] -> - (eval_Zexpr_Z_total $0 k < eval_Zexpr_Z_total $0 m)%Z -> + result_has_shape (V (x ++ repeat (gen_pad l0) (Z.to_nat kz))) (m :: l0) -> + eval_Zexpr $0 k kz -> + (0 <= kz)%Z -> + (kz < Z.of_nat m)%Z -> h $? p = Some x1 -> nondestructivity st h p reindexer (V x) v asm -> nondestructivity st h p @@ -1332,18 +1198,13 @@ partial_injective | [] => l1 | (v0, d) :: xs => (v0, (d - k)%z) :: xs end) - (V - (x ++ - repeat (gen_pad - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))) v asm. + (V (x ++ repeat (gen_pad l0) (Z.to_nat kz))) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist - Hvarsub Hmap Hvarsarg Hsh Hk Hknonneg Hm Hmknonneg Hheap Hassign. + intros ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist + Hvarsub Hmap Hvarsarg Hsh Hk Hknonneg Hmknonneg Hheap Hassign. unfold nondestructivity in *. invs. split; intros. - - eapply H; eauto. simpl in *. + - eapply H; eauto. simpl in *. unfold tensor_to_array_delta in *. erewrite eq_tensor_to_array_delta_by_indices_shuffle with (shuffle:=fun x => x) in H4. eassumption. @@ -1363,16 +1224,11 @@ Proof. rewrite repeat_length in *. repeat decomp_index. erewrite result_has_shape_result_shape_Z by eauto. - repeat rewrite <- map_cons. - rewrite eq_partial_interpret_reindexer_truncr; - try apply Henv; try apply Hrdx. + erewrite eq_partial_interpret_reindexer_truncr by (eassumption || lia). erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_app_r in Hsh. eauto. rewrite repeat_length. reflexivity. } reflexivity. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - all: eauto. - lia. lia. + intros. erewrite result_has_shape_result_shape_Z in H5. 2: { repeat rewrite map_cons in Hsh. eapply result_has_shape_app_r; eauto. } @@ -1417,15 +1273,12 @@ Proof. repeat decomp_index. repeat rewrite <- map_cons in *. erewrite eq_partial_interpret_reindexer_truncr in H7; eauto; try apply Henv; try lia. - 2: eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; auto. symmetry in H7. erewrite eq_partial_interpret_reindexer_truncr in H7; eauto; try apply Henv; try lia. - 2: eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; auto. pose proof H7. erewrite eq_partial_interpret_reindexer_truncr; eauto; try apply Henv; try lia. - 2: eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. eapply Hinj in H7. 2: { eapply filter_In. split; eauto. repeat decomp_goal_index. split; eauto. simpl in H9. @@ -1456,34 +1309,21 @@ Proof. Qed. Lemma nondestructivity_pad_r : - forall st h p v l k rest asm reindexer dim a, + forall st h p v l k kz rest asm reindexer dim dimz a, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z - (V - (l ++ - repeat - (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))))) v) + (V (l ++ repeat (gen_pad rest) (Z.to_nat kz)))) v) (filter (fun x : list Z => negb (is_None (result_lookup_Z_option x - (V - (l ++ - repeat - (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))))))) + (V (l ++ repeat (gen_pad rest) (Z.to_nat kz)))))) (mesh_grid (result_shape_Z - (V - (l ++ - repeat - (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))))))) -> + (V (l ++ repeat (gen_pad rest) (Z.to_nat kz)))))) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -1496,20 +1336,13 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> nondestructivity st h p reindexer - (V - (l ++ - repeat - (gen_pad - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) rest))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))) v asm -> - result_has_shape (V l) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (dim::rest))) -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + (V (l ++ repeat (gen_pad rest) (Z.to_nat kz))) v asm -> + result_has_shape (V l) (Z.to_nat dimz :: rest) -> + (0 <= kz)%Z -> h $? p = Some a -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> - eq_zexpr dim (| eval_Zexpr_Z_total $0 dim |)%z -> - (0 < eval_Zexpr_Z_total $0 dim)%Z -> + eval_Zexpr $0 k kz -> + eval_Zexpr $0 dim dimz -> + (0 < dimz)%Z -> nondestructivity st h p (fun l0 : list (Zexpr * Zexpr) => reindexer match l0 with @@ -1517,7 +1350,7 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> | (v0, d) :: xs => (v0, (d + k)%z) :: xs end) (V l) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist + intros ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg Hassign Hsh Hknonneg Hheap Hk Hdim Hdimpos. unfold nondestructivity in *. invs. split; intros. @@ -1535,9 +1368,7 @@ Proof. erewrite result_has_shape_result_shape_Z by eauto. repeat rewrite map_cons. erewrite eq_partial_interpret_reindexer_concat_l - with (l2:=repeat - (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))); + with (l2:=repeat (gen_pad rest) (Z.to_nat kz)); try apply Hrdx; try apply Henv. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_app. @@ -1597,7 +1428,7 @@ Proof. repeat rewrite map_cons. eapply partial_injective_concat_l; auto; try apply Henv. repeat rewrite map_cons in Hinj. eapply Hinj. - eapply result_has_shape_repeat_gen_pad. + eapply result_has_shape_repeat_gen_pad. rewrite Z2Nat.id by lia. auto. + eauto. + unfold injective. propositional. @@ -1607,31 +1438,21 @@ Proof. Qed. Lemma nondestructivity_pad_l : - forall st h p v reindexer asm l rest dim k a, + forall st h p v reindexer asm l rest dim dimz k kz a, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z - (V - (repeat - (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) ++ l))) v) + (V (repeat (gen_pad rest) (Z.to_nat kz) ++ l))) v) (filter (fun x : list Z => negb (is_None (result_lookup_Z_option x - (V - (repeat - (gen_pad - (map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) ++ l))))) + (V (repeat (gen_pad rest) (Z.to_nat kz) ++ l))))) (mesh_grid (result_shape_Z - (V - (repeat - (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) ++ l))))) -> + (V (repeat (gen_pad rest) (Z.to_nat kz) ++ l))))) -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -1643,19 +1464,15 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - result_has_shape (V l) - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) (dim :: rest))) -> - vars_of_Zexpr dim = [] -> - vars_of_Zexpr k = [] -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + result_has_shape (V l) (Z.to_nat dimz :: rest) -> + eval_Zexpr $0 k kz -> + eval_Zexpr $0 dim dimz -> + (0 <= kz)%Z -> h $? p = Some a -> - (0 < eval_Zexpr_Z_total $0 dim)%Z -> + (0 < dimz)%Z -> nondestructivity st h p reindexer - (V - (repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) rest))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) ++ l)) v asm -> + (V (repeat (gen_pad rest) (Z.to_nat kz) ++ l)) v asm -> nondestructivity st h p (fun l0 : list (Zexpr * Zexpr) => reindexer @@ -1664,7 +1481,7 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> | (v0, d) :: xs => ((v0 + k)%z, (d + k)%z) :: xs end) (V l) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist + intros ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg Hsh Hdim Hk Hknonneg Hheap Hdimpos Hassign. unfold nondestructivity in *. invs. split; intros. @@ -1675,8 +1492,7 @@ Proof. with (shuffle:=fun l1 : list Z => match l1 with | [] => l1 - | x1 :: xs => - (x1 + eval_Zexpr_Z_total $0 k)%Z :: xs + | x1 :: xs => (x1 + kz)%Z :: xs end). eassumption. - erewrite result_has_shape_result_shape_Z by eauto. intros. repeat decomp_index. pose proof result_lookup_Z_option_concat_l. @@ -1688,8 +1504,7 @@ Proof. 2: { eapply result_has_shape_concat. eapply result_has_shape_repeat. eapply result_has_shape_gen_pad. simpl in Hsh. eauto. } - auto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. + auto. lia. - erewrite result_has_shape_result_shape_Z by eauto. intros. repeat decomp_index. erewrite result_has_shape_result_shape_Z. @@ -1697,31 +1512,16 @@ Proof. eapply result_has_shape_repeat. eapply result_has_shape_gen_pad. simpl in Hsh. eauto. } rewrite <- Z2Nat.inj_add by lia. - repeat rewrite <- map_cons. - rewrite <- eval_Zexpr_Z_total_add_distr. - rewrite <- map_cons. pose proof filter_pad_l_mesh_grid. simpl gen_pad_list in H6. rewrite H6. clear H6. - 2: { repeat rewrite map_cons. - erewrite eval_Zexpr_Z_total_add_distr. - rewrite Z2Nat.inj_add by lia. + 2: { rewrite Z2Nat.inj_add by lia. eapply result_has_shape_concat. eapply result_has_shape_repeat. - eapply result_has_shape_gen_pad. simpl in Hsh. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eauto. - } + eapply result_has_shape_gen_pad. simpl in Hsh. eauto. } eapply in_map_iff. eexists (z::x0). split. reflexivity. eapply filter_In. split; eauto. repeat decomp_goal_index. split. - erewrite eval_Zexpr_Z_total_add_distr. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eauto. lia. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. + lia. eauto. lia. - intros. erewrite result_has_shape_result_shape_Z by eauto. erewrite result_has_shape_result_shape_Z in H5. 2: { eapply result_has_shape_concat. @@ -1729,39 +1529,24 @@ Proof. eapply result_has_shape_gen_pad. simpl in Hsh. eauto. } pose proof filter_pad_l_mesh_grid. simpl gen_pad_list in H6. erewrite <- Z2Nat.inj_add in H5 by lia. - erewrite <- eval_Zexpr_Z_total_add_distr in H5. - repeat rewrite <- map_cons in H5. rewrite H6 in H5. clear H6. - 2: { repeat rewrite map_cons. - erewrite eval_Zexpr_Z_total_add_distr. - rewrite Z2Nat.inj_add by lia. + 2: { rewrite Z2Nat.inj_add by lia. eapply result_has_shape_concat. eapply result_has_shape_repeat. - eapply result_has_shape_gen_pad. simpl in Hsh. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. - eauto. } + eapply result_has_shape_gen_pad. simpl in Hsh. eauto. } 2: lia. - 2: eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - 2: eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. eapply in_map_iff in H5. invs. repeat decomp_index . - rewrite eval_Zexpr_Z_total_add_distr in H5. - 2: eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. - 2: eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total; eauto. eexists (z::x1). split. reflexivity. eapply filter_In. split; eauto. repeat decomp_goal_index. split. lia. eauto. - erewrite result_has_shape_result_shape_Z by eauto. repeat rewrite map_cons. - assert (eval_Zexpr_Z_total $0 dim = 0 \/ - eval_Zexpr_Z_total $0 dim <> 0)%Z by lia. invert H5. + assert (dimz = 0 \/ dimz <> 0)%Z by lia. destruct H5 as [H6|H6]. { rewrite H6. simpl. - unfold partial_injective. propositional. invert H2. } + unfold partial_injective. propositional. destruct H5. } eapply partial_injective_padl; eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. + lia. - eauto. - unfold injective. erewrite result_has_shape_result_shape_Z by eauto. @@ -1771,7 +1556,7 @@ Proof. Qed. Lemma nondestructivity_concat_r_ : - forall st h p v e1 e2 l1 l2 reindexer asm x rest1 rest2 dim1 dim2, + forall st h p v l1 l2 reindexer asm x rest1 dim1 dim1z dim2 dim2z, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V (l1 ++ l2))) v) @@ -1792,28 +1577,13 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> nondestructivity st h p reindexer (V (l1 ++ l2)) v asm -> h $? p = Some x -> -size_of e1 (dim1 :: rest1) -> -size_of e2 (dim2 :: rest2) -> -result_has_shape (V l2) - (Z.to_nat (eval_Zexpr_Z_total $0 dim2) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -result_has_shape (V l1) - (Z.to_nat (eval_Zexpr_Z_total $0 dim1) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -result_has_shape (V (l1 ++ l2)) - (Z.to_nat (eval_Zexpr_Z_total $0 dim1) + - Z.to_nat (eval_Zexpr_Z_total $0 dim2) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -(0 <= eval_Zexpr_Z_total $0 dim1)%Z -> -(0 <= eval_Zexpr_Z_total $0 dim2)%Z -> -eq_zexpr dim1 (| eval_Zexpr_Z_total $0 dim1 |)%z -> -eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> +result_has_shape (V l2) (Z.to_nat dim2z :: rest1) -> +result_has_shape (V l1) (Z.to_nat dim1z :: rest1) -> +result_has_shape (V (l1 ++ l2)) (Z.to_nat dim1z + Z.to_nat dim2z :: rest1) -> +(0 <= dim1z)%Z -> +(0 <= dim2z)%Z -> +eval_Zexpr $0 dim1 dim1z -> +eval_Zexpr $0 dim2 dim2z -> nondestructivity st (h $+ (p, array_add x @@ -1823,7 +1593,7 @@ eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> reindexer match l6 with | [] => l6 - | (v0, d) :: xs => (v0, (d + |eval_Zexpr_Z_total $0 dim2|)%z) :: xs + | (v0, d) :: xs => (v0, (d + dim2)%z) :: xs end) (result_shape_Z (V l1)) v) (V l1)))) p (fun l6 : list (Zexpr * Zexpr) => reindexer @@ -1834,9 +1604,9 @@ eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> (d + dim1)%z) :: xs end) (V l2) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist + intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg Hassign Hheap - Hsize1 Hsize2 Hsh2 Hsh1 Hsh Hdim1nonneg Hdim2nonneg Heqdim1 Heqdim2. + Hsh2 Hsh1 Hsh Hdim1nonneg Hdim2nonneg Heqdim1 Heqdim2. unfold nondestructivity in *. invs. split; intros. - rewrite lookup_add_eq in * by auto. invert H1. @@ -1851,7 +1621,7 @@ Proof. eapply partial_injective_concat_r. all: eauto. } 2: { erewrite result_has_shape_result_shape_Z by eauto. eapply partial_injective_concat_l. - all: eauto. + all: eauto. rewrite Z2Nat.id by lia. eauto. } rewrite filter_idempotent in *. @@ -1863,10 +1633,9 @@ Proof. eapply in_map_iff in H1,H4. invs. rewrite <- H1 in H4. repeat decomp_index. - erewrite eq_partial_interpret_reindexer_padr in H1, H4. - erewrite eq_partial_interpret_reindexer_padl in H4. - rewrite (Nat.add_comm (Z.to_nat (eval_Zexpr_Z_total $0 dim2))) - in H1,H4. + erewrite eq_partial_interpret_reindexer_padr in H1, H4 by (eassumption || lia). + erewrite eq_partial_interpret_reindexer_padl in H4 by (eassumption || lia). + rewrite (Nat.add_comm (Z.to_nat dim2z)) in H1,H4. pose proof H4. eapply Hinj in H4. invert H4. invert H11. lia. @@ -1874,7 +1643,7 @@ Proof. rewrite H1 in H2. discriminate. eapply filter_In. split; eauto. repeat decomp_goal_index. split. lia. eauto. rewrite <- H7. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 dim1)) by lia. + rewrite <- (Z2Nat.id dim1z) by lia. erewrite <- result_lookup_Z_truncl. 2: lia. rewrite truncl_list_skipn. rewrite skipn_app. rewrite skipn_all2. @@ -1887,11 +1656,7 @@ Proof. rewrite nth_error_app1. 2: { erewrite result_has_shape_length by eauto. lia. } auto. rewrite nth_error_app1. - 2: { erewrite result_has_shape_length by eauto. lia. } auto. - all: try apply Hrdx. - all: try apply Henv. - all: try lia. - all: eauto. } + 2: { erewrite result_has_shape_length by eauto. lia. } auto. } eapply H; eauto. erewrite result_has_shape_result_shape_Z in * by eauto. unfold tensor_to_array_delta in *. @@ -1915,7 +1680,7 @@ Proof. eexists. rewrite H2. split. auto. eapply filter_In. split. repeat decomp_goal_index. split. lia. eauto. rewrite <- H5. - rewrite <- (Z2Nat.id (eval_Zexpr_Z_total $0 dim1)) by lia. + rewrite <- (Z2Nat.id dim1z) by lia. erewrite <- result_lookup_Z_truncl. rewrite truncl_list_skipn. rewrite skipn_app. rewrite skipn_all2. @@ -1928,7 +1693,7 @@ Proof. Qed. Lemma nondestructivity_concat_l_ : - forall st h p v e1 e2 l1 l2 reindexer asm x rest1 rest2 dim1 dim2, + forall st h p v l1 l2 reindexer asm x rest1 dim1 dim1z dim2 dim2z, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V (l1 ++ l2))) v) @@ -1949,41 +1714,24 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> nondestructivity st h p reindexer (V (l1 ++ l2)) v asm -> h $? p = Some x -> -size_of e1 (dim1 :: rest1) -> -size_of e2 (dim2 :: rest2) -> -result_has_shape (V l2) - (Z.to_nat (eval_Zexpr_Z_total $0 dim2) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -result_has_shape (V l1) - (Z.to_nat (eval_Zexpr_Z_total $0 dim1) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -result_has_shape (V (l1 ++ l2)) - (Z.to_nat (eval_Zexpr_Z_total $0 dim1) + - Z.to_nat (eval_Zexpr_Z_total $0 dim2) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> -(0 <= eval_Zexpr_Z_total $0 dim1)%Z -> -(0 <= eval_Zexpr_Z_total $0 dim2)%Z -> -eq_zexpr dim1 (| eval_Zexpr_Z_total $0 dim1 |)%z -> -eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> -vars_of_Zexpr dim2 = [] -> +result_has_shape (V l2) (Z.to_nat dim2z :: rest1) -> +result_has_shape (V l1) (Z.to_nat dim1z :: rest1) -> +result_has_shape (V (l1 ++ l2)) (Z.to_nat dim1z + Z.to_nat dim2z :: rest1) -> +(0 <= dim1z)%Z -> +(0 <= dim2z)%Z -> +eval_Zexpr $0 dim1 dim1z -> +eval_Zexpr $0 dim2 dim2z -> nondestructivity st h p (fun l0 : list (Zexpr * Zexpr) => reindexer match l0 with | [] => l0 - | (v0, d) :: xs => (v0, (d + | eval_Zexpr_Z_total $0 dim2| )%z) :: xs + | (v0, d) :: xs => (v0, (d + dim2)%z) :: xs end) (V l1) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist + intros ? ? ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg Hassign Hheap - Hsize1 Hsize2 Hsh2 Hsh1 Hsh Hdim1nonneg Hdim2nonneg Heqdim1 Heqdim2 - Hvardim2. + Hsh2 Hsh1 Hsh Hdim1nonneg Hdim2nonneg Heqdim1 Heqdim2. unfold nondestructivity in *. invs. split; intros. - eapply H; eauto. @@ -2008,7 +1756,7 @@ Proof. 2: { apply Henv. } all: eauto. erewrite result_has_shape_result_shape_Z by eauto. eexists x1. - split. auto. + split. auto. erewrite result_has_shape_result_shape_Z in * by eauto. repeat decomp_index. eapply filter_In. split. repeat decomp_goal_index. split. lia. eauto. @@ -2021,7 +1769,7 @@ Proof. Qed. Lemma nondestructivity_trunc_l : - forall st h p v reindexer x asm m l0 k x1, + forall st h p v reindexer x asm m l0 k kz x1, (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V x)) v) @@ -2040,15 +1788,10 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> nondestructivity st h p reindexer (V x) v asm -> - result_has_shape - (V - (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) ++ x)) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) -> - vars_of_Zexpr k = [] -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> - (eval_Zexpr_Z_total $0 k < eval_Zexpr_Z_total $0 m)%Z -> + result_has_shape (V (gen_pad_list (Z.to_nat kz :: l0) ++ x)) (m :: l0) -> + eval_Zexpr $0 k kz -> + (0 <= kz)%Z -> + (kz < Z.of_nat m)%Z -> h $? p = Some x1 -> nondestructivity st h p (fun l1 : list (Zexpr * Zexpr) => @@ -2057,14 +1800,9 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> | [] => l1 | (v0, d) :: xs => ((v0 - k)%z, (d - k)%z) :: xs end) - (V - (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) - ++ x)) v asm. + (V (gen_pad_list (Z.to_nat kz :: l0) ++ x)) v asm. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist + intros ? ? ? ? ? ? ? ? ? ? ? ? Henv Hinj HeqZlist Hvarsub Hmap Hvarsarg Hassign Hsh Hk Hknonneg Hkm Hheap. unfold nondestructivity in *. invs. split; intros. @@ -2074,7 +1812,7 @@ Proof. with (shuffle:=(fun l => match l with | [] => l | x::xs => - (x+eval_Zexpr_Z_total $0 k)%Z::xs + (x+kz)%Z::xs end)) in H4. eassumption. + intros. erewrite result_has_shape_result_shape_Z in H5. 2: { simpl in Hsh. eapply result_has_shape_app_l; eauto. } @@ -2088,10 +1826,10 @@ Proof. erewrite eq_partial_interpret_reindexer_truncl. erewrite result_has_shape_result_shape_Z. 2: { simpl in Hsh. eapply result_has_shape_app_l; eauto. } - rewrite repeat_length. reflexivity. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. + rewrite repeat_length. reflexivity. + assumption. apply Henv. all: eauto. - lia. lia. + lia. + intros. erewrite result_has_shape_result_shape_Z in H5. 2: { simpl in Hsh. eapply result_has_shape_app_l; eauto. } repeat decomp_index. rewrite repeat_length in *. @@ -2101,8 +1839,8 @@ Proof. rewrite <- H7. rewrite result_lookup_Z_option_concat_l. auto. lia. lia. + intros. erewrite result_has_shape_result_shape_Z in H5. - 2: eauto. repeat decomp_index. - eexists (z- eval_Zexpr_Z_total $0 k::x2)%Z. propositional. + 2: eauto. repeat decomp_index. + eexists (z- kz::x2)%Z. propositional. f_equal. lia. eapply filter_In. propositional. erewrite result_has_shape_result_shape_Z. 2: { simpl in Hsh. eapply result_has_shape_app_l; eauto. } @@ -2110,44 +1848,33 @@ Proof. split; eauto. * cases (result_lookup_Z_option (z :: x2) - (V - (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) - ++ x))). + (V (gen_pad_list (Z.to_nat kz :: l0) ++ x))). 2: discriminate. simpl in Heq. cases z; try lia. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 k))). + cases (Z.to_nat kz). -- simpl in *. lia. -- simpl in *. rewrite result_lookup_Z_option_gen_pad in Heq. discriminate. - -- assert ((Z.to_nat (Z.pos p0)) < - (Z.to_nat (eval_Zexpr_Z_total $0 k)) \/ - (Z.to_nat (eval_Zexpr_Z_total $0 k)) <= - (Z.to_nat (Z.pos p0))) by lia. + -- assert (Z.to_nat (Z.pos p0) < (Z.to_nat kz) \/ + (Z.to_nat kz) <= (Z.to_nat (Z.pos p0))) by lia. invert H2. rewrite nth_error_app1 in Heq. 2: { rewrite repeat_length. lia. } 2: { lia. } rewrite nth_error_repeat in Heq by lia. rewrite result_lookup_Z_option_gen_pad in Heq. discriminate. - * rewrite <- H7. replace z with - (z - eval_Zexpr_Z_total $0 k + eval_Zexpr_Z_total $0 k)%Z - at 2 by lia. + * rewrite <- H7. replace z with (z - kz + kz)%Z at 2 by lia. erewrite result_lookup_Z_option_concat_l. auto. 2: lia. simpl in H7. cases z; try lia. - cases ((Z.to_nat (eval_Zexpr_Z_total $0 k))). + cases (Z.to_nat kz). -- simpl in *. lia. -- simpl in *. rewrite result_lookup_Z_option_gen_pad in H7. discriminate. - -- assert ((Z.to_nat (Z.pos p0)) < - (Z.to_nat (eval_Zexpr_Z_total $0 k)) \/ - (Z.to_nat (eval_Zexpr_Z_total $0 k)) <= - (Z.to_nat (Z.pos p0))) by lia. + -- assert (Z.to_nat (Z.pos p0) < Z.to_nat kz \/ + Z.to_nat kz <= Z.to_nat (Z.pos p0)) by lia. invert H2. rewrite nth_error_app1 in H7. 2: { rewrite repeat_length. lia. } 2: { lia. } @@ -2162,26 +1889,17 @@ Proof. rewrite repeat_length in *. unfold partial_injective. intros. repeat decomp_index. repeat rewrite map_cons in *. - replace z with ((z - eval_Zexpr_Z_total $0 k) - + eval_Zexpr_Z_total $0 k)%Z in H8 by lia. - replace z0 with ((z0 - eval_Zexpr_Z_total $0 k) - + eval_Zexpr_Z_total $0 k)%Z in * by lia. + replace z with ((z - kz) + kz)%Z in H8 by lia. + replace z0 with ((z0 - kz) + kz)%Z in * by lia. erewrite eq_partial_interpret_reindexer_truncl in H8; eauto; try apply Henv. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. } - 2: { lia. } 2: { lia. } symmetry in H8. erewrite eq_partial_interpret_reindexer_truncl in H8; eauto; try apply Henv. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. } - 2: { lia. } 2: { lia. } symmetry in H8. - repeat rewrite map_cons. erewrite eq_partial_interpret_reindexer_truncl; eauto; try apply Henv. - 2: { eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. } - 2: { lia. } 2: { lia. } erewrite result_has_shape_result_shape_Z in Hinj. 2: { simpl in Hsh. eapply result_has_shape_app_l; eauto. } @@ -2190,15 +1908,13 @@ Proof. split. - clear Hinj. rewrite Z.sub_add in *. simpl in *. cases z0; try lia. - + cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). + + cases (Z.to_nat kz). * simpl in *. lia. * simpl in *. rewrite result_lookup_Z_option_gen_pad in *. simpl in *. discriminate. - + assert ((Z.to_nat (Z.pos p0)) < - (Z.to_nat (eval_Zexpr_Z_total $0 k)) \/ - (Z.to_nat (eval_Zexpr_Z_total $0 k)) <= - (Z.to_nat (Z.pos p0))) by lia. + + assert (Z.to_nat (Z.pos p0) < Z.to_nat kz \/ + Z.to_nat kz <= (Z.to_nat (Z.pos p0))) by lia. invert H9. rewrite nth_error_app1 in H11. 2: { rewrite repeat_length. lia. } 2: { lia. } @@ -2211,15 +1927,13 @@ Proof. reflexivity. simpl in *. rewrite Z.sub_add in *. cases z0; try lia. - + cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). + + cases (Z.to_nat kz). * simpl in *. lia. * simpl in *. rewrite result_lookup_Z_option_gen_pad in *. simpl in *. discriminate. - + assert ((Z.to_nat (Z.pos p0)) < - (Z.to_nat (eval_Zexpr_Z_total $0 k)) \/ - (Z.to_nat (eval_Zexpr_Z_total $0 k)) <= - (Z.to_nat (Z.pos p0))) by lia. + + assert (Z.to_nat (Z.pos p0) < Z.to_nat kz \/ + Z.to_nat kz <= Z.to_nat (Z.pos p0)) by lia. invert H9. rewrite nth_error_app1 in H11. 2: { rewrite repeat_length. lia. } 2: { lia. } @@ -2231,15 +1945,13 @@ Proof. split. - clear Hinj. rewrite Z.sub_add in *. simpl in *. cases z; try lia. - + cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). + + cases (Z.to_nat kz). * simpl in *. lia. * simpl in *. rewrite result_lookup_Z_option_gen_pad in *. simpl in *. discriminate. - + assert ((Z.to_nat (Z.pos p0)) < - (Z.to_nat (eval_Zexpr_Z_total $0 k)) \/ - (Z.to_nat (eval_Zexpr_Z_total $0 k)) <= - (Z.to_nat (Z.pos p0))) by lia. + + assert (Z.to_nat (Z.pos p0) < Z.to_nat kz \/ + Z.to_nat kz <= Z.to_nat (Z.pos p0)) by lia. invert H9. rewrite nth_error_app1 in H10. 2: { rewrite repeat_length. lia. } 2: { lia. } @@ -2248,22 +1960,18 @@ Proof. discriminate. - auto. - rewrite <- H10. - replace z with (z - eval_Zexpr_Z_total $0 k + - eval_Zexpr_Z_total $0 k)%Z - at 2 by lia. + replace z with (z - kz + kz)%Z at 2 by lia. erewrite result_lookup_Z_option_concat_l. reflexivity. simpl in *. rewrite Z.sub_add in *. cases z; try lia. - + cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). + + cases (Z.to_nat kz). * simpl in *. lia. * simpl in *. rewrite result_lookup_Z_option_gen_pad in *. simpl in *. discriminate. - + assert ((Z.to_nat (Z.pos p0)) < - (Z.to_nat (eval_Zexpr_Z_total $0 k)) \/ - (Z.to_nat (eval_Zexpr_Z_total $0 k)) <= - (Z.to_nat (Z.pos p0))) by lia. + + assert (Z.to_nat (Z.pos p0) < Z.to_nat kz \/ + Z.to_nat kz <= Z.to_nat (Z.pos p0)) by lia. invert H9. rewrite nth_error_app1 in H10. 2: { rewrite repeat_length. lia. } 2: { lia. } @@ -2283,19 +1991,14 @@ Proof. Qed. Lemma well_formed_reindexer_truncl : - forall reindexer m l0 k v x st h o asn arr, + forall reindexer m l0 k kz v x st h o asn arr, well_formed_reindexer reindexer v (V x) st h o asn -> - result_has_shape - (V (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) ++ x)) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) -> + result_has_shape (V (gen_pad_list (Z.to_nat kz :: l0) ++ x)) (m :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> - (0 <= eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + eval_Zexpr $0 k kz -> + (0 <= kz)%Z -> h $? o = Some arr -> - (eval_Zexpr_Z_total $0 k < eval_Zexpr_Z_total $0 m)%Z -> + (kz < Z.of_nat m)%Z -> well_formed_reindexer (fun l : list (Zexpr * Zexpr) => reindexer @@ -2303,17 +2006,12 @@ Lemma well_formed_reindexer_truncl : | [] => l | (v0, d) :: xs => ((v0 - k)%z, (d - k)%z) :: xs end) v - (V (gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) ++ x)) st h o asn. + (V (gen_pad_list (Z.to_nat kz :: l0) ++ x)) st h o asn. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? H Hsh Hvar Hk Hmnonneg Hknonneg Hheap Hkm. + intros ? ? ? ? ? ? ? ? ? ? ? ? H Hsh Hvar Hk Hknonneg Hheap Hkm. decomp_well_formed_reindexer. propositional. - - assert (0 < eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k \/ - eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k <= 0)%Z - by lia. + - assert (0 < Z.of_nat m - kz \/ Z.of_nat m - kz <= 0)%Z by lia. invert H. + erewrite result_has_shape_result_shape_Z; eauto. rewrite filter_pad_l_mesh_grid; eauto. @@ -2321,20 +2019,19 @@ Proof. eauto. eassumption. auto. eauto. - auto. auto. auto. auto. lia. lia. lia. + auto. auto. auto. auto. lia. lia. + erewrite result_has_shape_result_shape_Z; eauto. rewrite filter_pad_l_mesh_grid; eauto. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m) - - Z.to_nat (eval_Zexpr_Z_total $0 k)) with 0 by lia. + replace (m - Z.to_nat kz) with 0 by lia. simpl filter. unfold partial_injective. propositional. invert H1. - eapply HeqZlist. cases l1; cases l2. eauto. - invert H. simpl in *. lia. - invert H. simpl in *. lia. + invert H. simpl in H0. invert H0. + invert H. simpl in H0. invert H0. erewrite <- eq_Z_tuple_index_list_cons in H. propositional. - cases p. cases p0. + cases p. cases p0. erewrite <- eq_Z_tuple_index_list_cons. propositional. unfold eq_Z_tup. simpl. propositional. eapply eq_zexpr_sub. apply H0. apply eq_zexpr_id. auto. @@ -2343,55 +2040,35 @@ Proof. cases l. auto. cases p. simpl. unfold subst_var_in_Z_tup. simpl. f_equal. f_equal. rewrite (subst_var_in_Zexpr_id k). auto. - invert Hk. rewrite H1. sets. + erewrite eval_Zexpr_vars_empty by eassumption. auto. - rewrite Hvarsarg. cases l. auto. cases p. simpl. - invert Hk. rewrite H0. repeat rewrite constant_app_no_dups. + f_equal. f_equal. erewrite (eval_Zexpr_vars_empty k) by eassumption. + repeat rewrite constant_app_no_dups. sets. - eapply nondestructivity_trunc_l; eauto. - eapply Hk. Qed. Lemma well_formed_reindexer_padl : - forall reindexer m l0 k v x0 st h o asn a, + forall reindexer m l0 k kz v x0 st h o asn a, partial_injective (partial_interpret_reindexer reindexer - (result_shape_Z - (V (repeat - (gen_pad - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - ++ x0))) v) + (result_shape_Z (V (repeat (gen_pad l0) (Z.to_nat kz) ++ x0))) v) (filter (fun x => negb (is_None (result_lookup_Z_option x - (V (repeat - (gen_pad - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - ++ x0))))) + (V (repeat (gen_pad l0) (Z.to_nat kz) ++ x0))))) (mesh_grid - (result_shape_Z - (V (repeat - (gen_pad - (map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - ++ x0))))) -> - result_has_shape - (V x0) (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + (result_shape_Z (V (repeat (gen_pad l0) (Z.to_nat kz) ++ x0))))) -> + result_has_shape (V x0) (m :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> - eq_zexpr m (| eval_Zexpr_Z_total $0 m |)%z -> - (0 < eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + eval_Zexpr $0 k kz -> + (0 < m) -> + (0 <= kz)%Z -> (forall l1 l2 : list (Zexpr * Zexpr), eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list (reindexer l1) (reindexer l2)) -> @@ -2405,9 +2082,7 @@ Lemma well_formed_reindexer_padl : vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> h $? o = Some a -> nondestructivity st h o reindexer - (V - (repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)) ++ x0)) v asn -> + (V (repeat (gen_pad l0) (Z.to_nat kz) ++ x0)) v asn -> h $? o = Some a -> well_formed_reindexer (fun l : list (Zexpr * Zexpr) => @@ -2418,87 +2093,67 @@ Lemma well_formed_reindexer_padl : end) v (V x0) st h o asn. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? H Hsh Hvar Hk Hm Hmnonneg Hknonneg HeqZlist + intros ? ? ? ? ? ? ? ? ? ? ? ? H Hsh Hvar Hk Hmnonneg Hknonneg HeqZlist Hvarsub Hmap Hvarsarg Hnondstr Hheap. unfold well_formed_reindexer. propositional. - erewrite result_has_shape_result_shape_Z by eauto. - cases (Z.to_nat (eval_Zexpr_Z_total $0 m)). + cases m. simpl. unfold partial_injective. propositional. invert H1. - rewrite <- Heq in *. - eapply partial_injective_padl; eauto. + eapply partial_injective_padl; eauto. - eapply HeqZlist. pose proof H0. cases l1; cases l2. eauto. - invert H1; simpl in *; try lia. - invert H1; simpl in *; try lia. + invert H1. invert H3. + invert H1. invert H3. cases p. cases p0. erewrite <- eq_Z_tuple_index_list_cons_tup. erewrite <- eq_Z_tuple_index_list_cons_tup in H1. propositional. eapply eq_zexpr_add; eauto. - eapply eq_zexpr_add; eauto. + eapply eq_zexpr_add; eauto. - rewrite Hmap by auto. cases l. reflexivity. cases p. simpl. unfold subst_var_in_Z_tup. f_equal. f_equal. simpl. rewrite (subst_var_in_Zexpr_id k). auto. - invert Hk. rewrite H3. sets. + erewrite eval_Zexpr_vars_empty by eassumption. auto. - rewrite Hvarsarg. cases l. reflexivity. cases p. simpl. + erewrite (eval_Zexpr_vars_empty k) by eassumption. repeat rewrite constant_app_no_dups. - invert Hk. rewrite H2. sets. - - eapply nondestructivity_pad_l; eauto. - simpl map. eauto. - eapply Hm. eapply Hk. + sets. + - eapply nondestructivity_pad_l. + 7: { rewrite Nat2Z.id. eassumption. } + all: eauto. + lia. Qed. Lemma well_formed_reindexer_truncr : - forall reindexer x m l0 k v st h o a arr, + forall reindexer x m l0 k kz v st h o a arr, well_formed_reindexer reindexer v (V (rev - (truncl_list - (Z.to_nat (eval_Zexpr_Z_total $0 k)) - (rev - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0))))))) st h o a -> + (truncl_list (Z.to_nat kz) + (rev (x ++ gen_pad_list (Z.to_nat kz :: l0)))))) st h o a -> result_has_shape - (V - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) - (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + (V (x ++ gen_pad_list (Z.to_nat kz :: l0))) (m :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> - (0 <= eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k )%Z -> + eval_Zexpr $0 k kz -> + (0 <= kz)%Z -> h $? o = Some arr -> - vars_of_Zexpr m = [] -> - (eval_Zexpr_Z_total $0 k < eval_Zexpr_Z_total $0 m)%Z -> + (kz < Z.of_nat m)%Z -> well_formed_reindexer (fun l : list (Zexpr * Zexpr) => reindexer match l with | [] => l | (v0, d) :: xs => (v0, (d - k)%z) :: xs end) v - (V - (x ++ - gen_pad_list - (Z.to_nat (eval_Zexpr_Z_total $0 k) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) st h o a. + (V (x ++ gen_pad_list (Z.to_nat kz :: l0))) st h o a. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? Hrdx Hsh Hvar Hk Hmnonneg Hknonneg Hheap - Hm Hkm. + intros ? ? ? ? ? ? ? ? ? ? ? ? Hrdx Hsh Hvar Hk Hknonneg Hheap Hkm. decomp_well_formed_reindexer. propositional. - - assert (0 < eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k \/ - eval_Zexpr_Z_total $0 m - eval_Zexpr_Z_total $0 k <= 0)%Z - by lia. + - assert (0 < Z.of_nat m - kz \/ Z.of_nat m - kz <= 0)%Z by lia. invert H. 2: { eapply result_has_shape_app_r in Hsh. 2: simpl; rewrite repeat_length; eauto. @@ -2509,8 +2164,6 @@ Proof. rewrite filter_gen_pad_empty. unfold partial_injective. propositional. invert H2. } erewrite result_has_shape_result_shape_Z by eauto. - rewrite <-map_cons. - rewrite <-map_cons. rewrite filter_pad_r_mesh_grid. eapply partial_injective_truncr. rewrite rev_app_distr in Hinj. @@ -2524,69 +2177,56 @@ Proof. simpl gen_pad_list in Hinj. rewrite repeat_length in *. apply Hinj. eauto. auto. auto. auto. auto. auto. auto. auto. auto. - lia. simpl. - replace (Z.to_nat (eval_Zexpr_Z_total $0 m)) with - (Z.to_nat (eval_Zexpr_Z_total $0 k) + - ((Z.to_nat (eval_Zexpr_Z_total $0 m) - - (Z.to_nat (eval_Zexpr_Z_total $0 k))))) by lia. + replace m with (Z.to_nat kz + (m - (Z.to_nat kz))) by lia. eapply result_has_shape_concat. eapply result_has_shape_repeat_gen_pad. eapply result_has_shape_app_r; eauto. simpl. rewrite repeat_length. auto. - lia. - - cases l1; cases l2; pose proof H; invert H; simpl in *; try lia. + - cases l1; cases l2; try solve [destruct H as (H1&_); invert H1]. eapply HeqZlist. eapply eq_Z_tuple_index_list_id. cases p. cases p0. eapply HeqZlist. simpl. erewrite <- eq_Z_tuple_index_list_cons in *. propositional. - unfold eq_Z_tup in *. simpl in H. propositional. + unfold eq_Z_tup in *. simpl in *. propositional. simpl. eapply eq_zexpr_sub; auto. - rewrite Hmap by auto. cases l. reflexivity. cases p. simpl. unfold subst_var_in_Z_tup. simpl. f_equal. f_equal. rewrite (subst_var_in_Zexpr_id k). - reflexivity. invert Hk. rewrite H1. sets. + reflexivity. + erewrite eval_Zexpr_vars_empty by eassumption. auto. - rewrite Hvarsarg. cases l. reflexivity. cases p. simpl. rewrite constant_app_no_dups. - invert Hk. rewrite H0. sets. + erewrite (eval_Zexpr_vars_empty k) by eassumption. + sets. - eapply nondestructivity_trunc_r; eauto. rewrite rev_app_distr in Hinj. simpl in *. rewrite rev_repeat in Hinj. rewrite truncl_list_skipn in Hinj. - replace (repeat - (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))) - with (gen_pad_list ((Z.to_nat (eval_Zexpr_Z_total $0 k)):: - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) - in Hinj. + replace (repeat (gen_pad l0) (Z.to_nat kz)) + with (gen_pad_list (Z.to_nat kz :: l0)) + in Hinj. 2: { simpl. eauto. } rewrite <- truncl_list_skipn in Hinj. erewrite truncl_list_gen_pad_id in Hinj. rewrite rev_involutive in Hinj. - simpl in *. + simpl in *. rewrite truncl_list_skipn. - replace (repeat - (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))) - with (gen_pad_list ((Z.to_nat (eval_Zexpr_Z_total $0 k)):: - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))). + replace (repeat (gen_pad l0) (Z.to_nat kz)) + with (gen_pad_list (Z.to_nat kz :: l0)). 2: { simpl. eauto. } rewrite <- truncl_list_skipn. erewrite truncl_list_gen_pad_id. rewrite rev_involutive. eauto. - eapply Hk. rewrite rev_app_distr in Hnondstr. simpl in *. rewrite rev_repeat in Hnondstr. rewrite truncl_list_skipn in Hnondstr. - replace (repeat - (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k))) - with (gen_pad_list ((Z.to_nat (eval_Zexpr_Z_total $0 k)):: - (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)))) + replace (repeat (gen_pad l0) (Z.to_nat kz)) + with (gen_pad_list (Z.to_nat kz :: l0)) in Hnondstr. 2: { simpl. eauto. } rewrite <- truncl_list_skipn in Hnondstr. @@ -2608,7 +2248,7 @@ Proof. intros. decomp_well_formed_reindexer. propositional. - erewrite result_has_shape_result_shape_Z in Hinj by eauto. erewrite result_has_shape_result_shape_Z. - 2: { invert H1. eauto. } + 2: { invert H1. eauto. } unfold partial_injective in *. propositional. repeat decomp_index. @@ -2634,45 +2274,42 @@ Proof. simpl. rewrite Hvarsarg. simpl. sets. - rewrite Hvarsarg. simpl. symmetry. rewrite Hvarsarg. simpl. sets. - - -Admitted. + - +Admitted. Lemma well_formed_reindexer_shift_top_dim_reindexer : - forall x1 xs1 reindexer v st h o a arr i lo hi, - well_formed_reindexer reindexer - v (V (x1 :: xs1)) st h o a -> + forall x1 xs1 reindexer v st h o a arr i lo loz hi hiz, + well_formed_reindexer reindexer v (V (x1 :: xs1)) st h o a -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> result_has_shape (V (x1 :: xs1)) (result_shape_nat (V (x1 :: xs1))) -> h $? o = Some arr -> ~ i \in dom v -> ~ contains_substring "?" i -> - (eval_Zexpr_Z_total $0 lo < eval_Zexpr_Z_total $0 hi)%Z -> - eq_zexpr lo (| eval_Zexpr_Z_total $0 lo |)%z -> - eq_zexpr hi (| eval_Zexpr_Z_total $0 hi |)%z -> + (loz < hiz)%Z -> + eval_Zexpr $0 lo loz -> + eval_Zexpr $0 hi hiz -> well_formed_allocation reindexer (V (x1 :: xs1)) st h o v -> - Datatypes.length xs1 = - Z.to_nat (eval_Zexpr_Z_total $0 hi - (eval_Zexpr_Z_total $0 lo + 1)) -> - well_formed_reindexer (shift_top_dim_reindexer reindexer) + Datatypes.length xs1 = Z.to_nat (hiz - (loz + 1)) -> + well_formed_reindexer (shift_top_dim_reindexer reindexer) v (V xs1) st (h $+ (o, array_add arr (tensor_to_array_delta (partial_interpret_reindexer (fun l5 : list (Zexpr * Zexpr) => reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l5)) - (result_shape_Z x1) (v $+ (i, eval_Zexpr_Z_total $0 lo))) x1))) o a. -Proof. + (result_shape_Z x1) (v $+ (i, loz))) x1))) o a. +Proof. intros. decomp_well_formed_reindexer. - unfold well_formed_reindexer. + unfold well_formed_reindexer. propositional. - cases xs1. simpl. unfold partial_injective. propositional. invert H. eapply partial_injective_shift_top_dim_reindexer; eauto. inversion 1. - - cases l1; cases l2; simpl in *; pose proof H; - try invert H; simpl in *; try lia. + - cases l1; cases l2; simpl in *; try solve [destruct H as (H&_); invert H]. eapply HeqZlist. eauto. cases p. cases p0. - eapply HeqZlist. simpl in *. + eapply HeqZlist. simpl in *. erewrite <- eq_Z_tuple_index_list_cons in *. invs. propositional. unfold eq_Z_tup in *. simpl in *. invs. @@ -2726,7 +2363,7 @@ Proof. forall v reindexer, result_has_shape r1 (result_shape_nat r1) -> result_has_shape r2 (result_shape_nat r1) -> - result_has_shape r3 (result_shape_nat r1) -> + result_has_shape r3 (result_shape_nat r1) -> partial_injective (partial_interpret_reindexer reindexer (result_shape_Z r3) v) (filter (fun x : list Z => negb (is_None (result_lookup_Z_option x r3))) @@ -2756,7 +2393,7 @@ Proof. result_has_shape (V r2) (result_shape_nat (V r1)) -> result_has_shape (V r3) (result_shape_nat (V r1)) -> - + partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) v) (filter (fun x : list Z => negb (is_None (result_lookup_Z_option x (V r3)))) (mesh_grid (result_shape_Z (V r3)))) -> @@ -2771,9 +2408,9 @@ partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) (forall l : list (Zexpr * Zexpr), vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> - - + + (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> array_add (tensor_to_array_delta @@ -2794,7 +2431,7 @@ partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) + unfold result_shape_Z in *. simpl in *. invert a. simpl. unfold shape_to_index, shape_to_vars. simpl. - repeat rewrite array_add_empty_l. + repeat rewrite array_add_empty_l. unfold array_add. rewrite merge_add2. rewrite lookup_add_eq by auto. rewrite merge_empty2. @@ -2805,7 +2442,7 @@ partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) + unfold result_shape_Z in *. simpl in *. invert a. simpl. unfold shape_to_index, shape_to_vars. simpl. - repeat rewrite array_add_empty_l. + repeat rewrite array_add_empty_l. unfold array_add. rewrite merge_add1. rewrite lookup_empty. rewrite merge_empty2. @@ -2816,25 +2453,12 @@ partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) + unfold result_shape_Z in *. simpl in *. invert a. simpl. unfold shape_to_index, shape_to_vars. simpl. - repeat rewrite array_add_empty_l. + repeat rewrite array_add_empty_l. unfold array_add. reflexivity. + invert a. unfold result_shape_Z in *. simpl in *. reflexivity. - (* - - intros. unfold result_shape_Z. simpl. - unfold partial_result_to_array_delta. - simpl in *. unfold partial_result_to_array_delta_by_indices. - simpl. rewrite array_add_empty_l. - rewrite array_add_empty_r. - reflexivity. - - intros. unfold result_shape_Z. simpl. - unfold partial_result_to_array_delta. - simpl in *. unfold partial_result_to_array_delta_by_indices. - simpl. rewrite array_add_empty_l. - unfold shape_to_index,shape_to_vars. simpl. - rewrite array_add_empty_l. reflexivity. *) - intros. eapply H9; eauto. - intros. simpl. repeat erewrite tensor_to_array_delta_cons_generic_indexer. @@ -2847,11 +2471,11 @@ partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) f_equal. + rewrite array_add_comm. repeat rewrite tensor_to_array_delta_cons0; auto. - simpl length. + simpl length. assert (length xs2 = length xs1). { invert H12. lia. } assert (length r4 = length xs1). - { invert H13. lia. } + { invert H13. lia. } rewrite H20, H21. eapply H9; auto. * invert H11. auto. @@ -2889,10 +2513,9 @@ partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) eapply result_has_shape_self; eauto. inversion 1. * intros. unfold shift_top_dim_reindexer. destruct l1; destruct l2. - eapply H15; eauto. - inversion H20. simpl in *. lia. inversion H20. simpl in *. lia. + eapply H15; eauto. invert H20. invert H21. invert H20. invert H21. destruct p. destruct p0. - eapply eq_Z_tuple_index_list_cons_tup in H20. + eapply eq_Z_tuple_index_list_cons_tup in H20. eapply H15. erewrite <- eq_Z_tuple_index_list_cons_tup. split. eapply eq_zexpr_add. propositional. eauto. @@ -2914,12 +2537,12 @@ partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) eapply partial_injective_add_result_l; try apply Hinj. 4: econstructor; econstructor; eauto. eauto. eauto. eauto. eauto. - + eassumption. - + apply H14. + + eassumption. + + apply H14. + eassumption. + eapply partial_injective_add_result_r; try apply H14. 4: { econstructor; econstructor; eauto. } - eauto. eauto. eauto. + eauto. eauto. eauto. + eassumption. + eapply partial_injective_add_result_l; try apply H14. 4: { econstructor; econstructor; eauto. } @@ -2942,38 +2565,37 @@ partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) - eauto. Qed. -Lemma well_formed_reindexer_eval0 : - forall x1 xs1 reindexer v i lo hi st h o a arr, +Lemma well_formed_reindexer_eval0 : + forall x1 xs1 reindexer v i lo loz hi hiz st h o a arr, well_formed_reindexer reindexer v (V (x1 :: xs1)) st h o a -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> result_has_shape (V (x1 :: xs1)) (result_shape_nat (V (x1 :: xs1))) -> ~ i \in dom v -> ~ In i (shape_to_vars (result_shape_Z x1)) -> - (eval_Zexpr_Z_total $0 hi - eval_Zexpr_Z_total $0 lo)%Z = - Z.of_nat (Datatypes.length (x1 :: xs1)) -> - eq_zexpr lo (|eval_Zexpr_Z_total $0 lo|)%z -> - eq_zexpr hi (|eval_Zexpr_Z_total $0 hi|)%z -> + eval_Zexpr $0 lo loz -> + eval_Zexpr $0 hi hiz -> + (hiz - loz)%Z = Z.of_nat (Datatypes.length (x1 :: xs1)) -> h $? o = Some arr -> - (eval_Zexpr_Z_total $0 lo < eval_Zexpr_Z_total $0 hi)%Z -> + (loz < hiz)%Z -> ~ contains_substring "?" i -> well_formed_reindexer (fun l0 : list (Zexpr * Zexpr) => reindexer (((! i ! - lo)%z, (hi - lo)%z) :: l0)) - (v $+ (i, eval_Zexpr_Z_total $0 lo)) x1 st h o a. + (v $+ (i, loz)) x1 st h o a. Proof. intros. decomp_well_formed_reindexer. propositional. - eapply partial_injective_cons_reindexer; eauto. - - eapply HeqZlist. + - eapply HeqZlist. erewrite <- eq_Z_tuple_index_list_cons in *. propositional. unfold eq_Z_tup. simpl. propositional. eauto. eauto. - rewrite dom_add. rewrite Hvarsarg. simpl. rewrite cup_empty_r. repeat rewrite constant_app_no_dups. - invert H5. rewrite H10. invert H6. rewrite H11. - simpl. sets. + do 2 erewrite eval_Zexpr_vars_empty by eassumption. + sets. - rewrite Hmap. simpl. unfold subst_var_in_Z_tup at 1. simpl. rewrite Hvarsarg in H. simpl in H. @@ -3034,41 +2656,31 @@ Qed. (* Lemma well_formed_reindexer_id : forall v r st h o a, (forall var : var, contains_substring "?" var -> - var \in dom v -> False) -> - well_formed_reindexer (fun l : list (Zexpr * Zexpr) => l) v + var \in dom v -> False) -> + well_formed_reindexer (fun l : list (Zexpr * Zexpr) => l) v (S r) (st $+ (o, 0%R)) h o a. -well_formed_reindexer (fun l : list (Zexpr * Zexpr) => l) v +well_formed_reindexer (fun l : list (Zexpr * Zexpr) => l) v (V l1) st'0 (alloc_array_in_heap [Z.to_nat nz] h x) x Assign -Proof. +Proof. unfold well_formed_reindexer. propositional. - eapply partial_injective_id_reindexer. auto. - sets. - sets. - unfold nondestructivity. split; intros. + admit. - + + + Qed. *) Lemma well_formed_reindexer_transpose : forall l n0 m0 l0 v reindexer st h o a arr, - result_has_shape (V l) - (Z.to_nat - (eval_Zexpr_Z_total $0 n0) - :: Z.to_nat (eval_Zexpr_Z_total $0 m0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape (V l) (n0 :: m0 :: l0) -> well_formed_reindexer reindexer v - (transpose_result l - (Z.to_nat - (eval_Zexpr_Z_total $0 m0) - :: Z.to_nat (eval_Zexpr_Z_total $0 n0) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - st h o a -> + (transpose_result l (m0 :: n0 :: l0)) + st h o a -> (forall var : var, contains_substring "?" var -> var \in dom v -> False) -> h $? o = Some arr -> - vars_of_Zexpr n0 = [] -> - vars_of_Zexpr m0 = [] -> well_formed_reindexer (fun l1 : list (Zexpr * Zexpr) => reindexer @@ -3078,22 +2690,22 @@ Lemma well_formed_reindexer_transpose : | (v0, d) :: (vi, di) :: xs => (vi, di) :: (v0, d) :: xs end) v (V l) st h o a. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? Hsh Hrdx Henv Harr Hn0 Hm0. + intros ? ? ? ? ? ? ? ? ? ? ? Hsh Hrdx Henv Harr. decomp_well_formed_reindexer. propositional. - eapply partial_injective_transpose; eauto. - eapply HeqZlist. cases l1; cases l2. eapply eq_Z_tuple_index_list_id. - invert H. simpl in *. lia. - invert H. simpl in *. lia. + invert H. simpl in *. invert H0. + invert H. simpl in *. invert H0. cases p. cases p0. erewrite <- eq_Z_tuple_index_list_cons in H. invs. cases l1; cases l2. simpl. erewrite <- eq_Z_tuple_index_list_cons. propositional. - invert H1. simpl in *. lia. - invert H1. simpl in *. lia. + invert H1. invert H. + invert H1. invert H. cases p. cases p0. erewrite <- eq_Z_tuple_index_list_cons in H1. invs. erewrite <- eq_Z_tuple_index_list_cons. @@ -3111,27 +2723,18 @@ Proof. cases p. cases l1. auto. cases p. simpl. sets. - - eapply nondestructivity_transpose; eauto. + - eapply nondestructivity_transpose; eauto. Qed. Lemma well_formed_reindexer_concat_l : - forall reindexer l1 l2 v st h o a arr dim1 dim2 rest1, - well_formed_reindexer - reindexer v (V (l1 ++ l2)) st h o a -> - result_has_shape (V l2) - (Z.to_nat (eval_Zexpr_Z_total $0 dim2) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> - result_has_shape (V l1) - (Z.to_nat (eval_Zexpr_Z_total $0 dim1) - :: map Z.to_nat - (map - (eval_Zexpr_Z_total $0) rest1)) -> - (0 <= eval_Zexpr_Z_total $0 dim1)%Z -> - (0 <= eval_Zexpr_Z_total $0 dim2)%Z -> - eq_zexpr dim1 (| eval_Zexpr_Z_total $0 dim1 |)%z -> - eq_zexpr dim2 (| eval_Zexpr_Z_total $0 dim2 |)%z -> + forall reindexer l1 l2 v st h o a arr dim1 dim1z dim2 dim2z rest1, + well_formed_reindexer reindexer v (V (l1 ++ l2)) st h o a -> + result_has_shape (V l2) (Z.to_nat dim2z :: rest1) -> + result_has_shape (V l1) (Z.to_nat dim1z :: rest1) -> + (0 <= dim1z)%Z -> + (0 <= dim2z)%Z -> + eval_Zexpr $0 dim1 dim1z -> + eval_Zexpr $0 dim2 dim2z -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> h $? o = Some arr -> well_formed_reindexer @@ -3150,8 +2753,8 @@ Proof. rewrite Z2Nat.id by lia. eauto. - cases l0; cases l3. eapply HeqZlist. auto. - invert H. simpl in *. lia. - invert H. simpl in *. lia. + invert H. invert H8. + invert H. invert H8. cases p. cases p0. erewrite <- eq_Z_tuple_index_list_cons_tup in H. eapply HeqZlist. @@ -3165,33 +2768,29 @@ Proof. unfold subst_var_in_Z_tup. simpl. rewrite (subst_var_in_Zexpr_id dim2). reflexivity. - unfold eq_zexpr in *. simpl in *. invs. rewrite H9. sets. + erewrite eval_Zexpr_vars_empty by eassumption. auto. - cases l. rewrite Hvarsarg. sets. cases p. rewrite Hvarsarg. f_equal. simpl. - unfold eq_zexpr in *. simpl in *. invs. rewrite H8. - rewrite app_no_dups_empty_r. + erewrite (eval_Zexpr_vars_empty dim2) by eassumption. + rewrite app_no_dups_empty_r. sets. - - eapply nondestructivity_concat_l; eauto. + - eapply nondestructivity_concat_l; eauto. Qed. Lemma well_formed_reindexer_concat_r : - forall reindexer l1 l2 v n m l0 st h o a arr, + forall reindexer l1 l2 v n nz m mz l0 st h o a arr, well_formed_reindexer reindexer v (V (l1 ++ l2)) st h o a -> - result_has_shape (V l1) (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) -> - result_has_shape (V l2) (Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape (V l1) (Z.to_nat nz :: l0) -> + result_has_shape (V l2) (Z.to_nat mz :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - eq_zexpr n (| eval_Zexpr_Z_total $0 n |)%z -> - (0 <= eval_Zexpr_Z_total $0 n)%Z -> + eval_Zexpr $0 n nz -> + (0 <= nz)%Z -> h $? o = Some arr -> - (0 <= eval_Zexpr_Z_total $0 m)%Z -> - eq_zexpr m (| eval_Zexpr_Z_total $0 m |)%z -> + (0 <= mz)%Z -> + eval_Zexpr $0 m mz -> well_formed_reindexer (fun l3 : list (Zexpr * Zexpr) => reindexer @@ -3212,12 +2811,12 @@ Proof. intros. decomp_well_formed_reindexer. propositional. - - erewrite result_has_shape_result_shape_Z by eauto. + - erewrite result_has_shape_result_shape_Z by eauto. eapply partial_injective_concat_r; eauto. - cases l3; cases l4. eapply HeqZlist. auto. - invert H. simpl in *. lia. - invert H. simpl in *. lia. + invert H. invert H8. + invert H. invert H8. cases p. cases p0. erewrite <- eq_Z_tuple_index_list_cons_tup in H. eapply HeqZlist. @@ -3232,25 +2831,21 @@ Proof. unfold subst_var_in_Z_tup. simpl. rewrite (subst_var_in_Zexpr_id n). reflexivity. - invert H3. rewrite H9. sets. + erewrite eval_Zexpr_vars_empty by eassumption. auto. - cases l. rewrite Hvarsarg. sets. cases p. rewrite Hvarsarg. f_equal. simpl. - unfold eq_zexpr in *. simpl in *. invs. rewrite H9. - repeat rewrite app_no_dups_empty_r. + erewrite (eval_Zexpr_vars_empty n) by eassumption. + repeat rewrite app_no_dups_empty_r. sets. - eapply nondestructivity_concat_r__; eauto. Qed. Lemma well_formed_reindexer_flatten : forall v l n m l0 reindexer st h o a arr, - result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: Z.to_nat (eval_Zexpr_Z_total $0 m) - :: map Z.to_nat - (map (eval_Zexpr_Z_total $0) l0)) -> + result_has_shape (V l) (n :: m :: l0) -> well_formed_reindexer reindexer v (V (flatten_result l)) st h o a -> (forall var : var, contains_substring "?" var -> var \in dom v -> False)-> h $? o = Some arr -> @@ -3274,14 +2869,14 @@ Proof. - eapply HeqZlist. cases l1; cases l2. eapply eq_Z_tuple_index_list_id. - invert H. simpl in *. lia. - invert H. simpl in *. lia. + invert H. invert H0. + invert H. invert H0. erewrite <- eq_Z_tuple_index_list_cons in H. propositional. cases p. cases p0. - cases l1; cases l2. + cases l1; cases l2. erewrite <- eq_Z_tuple_index_list_cons. propositional. - invert H1. simpl in *. lia. - invert H1. simpl in *. lia. + invert H1. invert H. + invert H1. invert H. cases p. cases p0. erewrite <- eq_Z_tuple_index_list_cons. propositional. unfold eq_Z_tup in *. propositional. simpl in *. @@ -3301,22 +2896,16 @@ Proof. cases p. cases l1. auto. cases p. simpl. repeat rewrite constant_app_no_dups. sets. - eapply nondestructivity_flatten; eauto. -Qed. +Qed. Lemma well_formed_reindexer_padr : - forall l m l0 v reindexer k st h o a arr, - result_has_shape (V l) - (map Z.to_nat (map (eval_Zexpr_Z_total $0) (m :: l0))) -> + forall l m l0 v reindexer k kz st h o a arr, + result_has_shape (V l) (m :: l0) -> well_formed_reindexer - reindexer v - (V - (l ++ - repeat (gen_pad (map Z.to_nat (map (eval_Zexpr_Z_total $0) l0))) - (Z.to_nat (eval_Zexpr_Z_total $0 k)))) st h o a -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k|)%z -> - eq_zexpr m (| eval_Zexpr_Z_total $0 m |)%z -> - (0 < eval_Zexpr_Z_total $0 m)%Z -> - (0 <= eval_Zexpr_Z_total $0 k)%Z -> + reindexer v (V (l ++ repeat (gen_pad l0) (Z.to_nat kz))) st h o a -> + eval_Zexpr $0 k kz -> + (0 < m) -> + (0 <= kz)%Z -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> h $? o = Some arr -> well_formed_reindexer @@ -3330,8 +2919,6 @@ Proof. decomp_well_formed_reindexer. propositional. - erewrite result_has_shape_result_shape_Z by eauto. pose proof Hinj. - rewrite map_cons. - rewrite map_cons. eapply partial_injective_concat_l; auto; try apply Henv. apply Hinj. eapply result_has_shape_repeat_gen_pad. @@ -3339,8 +2926,8 @@ Proof. - eapply HeqZlist. cases l1; cases l2. apply eq_Z_tuple_index_list_id. - invert H. simpl in *. lia. - invert H. simpl in *. lia. + invert H. invert H0. + invert H. invert H0. cases p. cases p0. erewrite <- eq_Z_tuple_index_list_cons_tup in H. propositional. erewrite <- eq_Z_tuple_index_list_cons_tup. propositional. @@ -3350,13 +2937,16 @@ Proof. cases p. simpl. f_equal. f_equal. unfold subst_var_in_Z_tup. simpl. rewrite (subst_var_in_Zexpr_id k). auto. - invert Hk. rewrite H1. sets. + erewrite eval_Zexpr_vars_empty by eassumption. auto. - rewrite Hvarsarg. cases l1. auto. cases p. simpl. repeat rewrite constant_app_no_dups. - invert Hk. rewrite H0. sets. - - eapply nondestructivity_pad_r; eauto. -Qed. + erewrite (eval_Zexpr_vars_empty k) by eassumption. sets. + - eapply nondestructivity_pad_r. + 8: { rewrite Nat2Z.id. eassumption. } + all: eauto. + lia. +Qed. Lemma well_formed_reindexer_gen_pad : forall reindexer sh v s st h o a, well_formed_reindexer reindexer v s st h o a -> @@ -3391,19 +2981,15 @@ Proof. 2: { unfold shape_to_vars. unfold not. intros. apply H0. eapply shape_to_vars_contains_substring. apply H1. } reflexivity. -Qed. +Qed. Lemma well_formed_reindexer_split : - forall reindexer l0 k v l n st h o a arr, - well_formed_reindexer reindexer v - (V (split_result (Z.to_nat (eval_Zexpr_Z_total $0 k)) l)) st h o a -> -result_has_shape (V l) - (Z.to_nat (eval_Zexpr_Z_total $0 n) - :: map Z.to_nat (map (eval_Zexpr_Z_total $0) l0)) -> + forall reindexer l0 k kz v l n st h o a arr, + well_formed_reindexer reindexer v (V (split_result (Z.to_nat kz) l)) st h o a -> + result_has_shape (V l) (n :: l0) -> (forall var : var, contains_substring "?" var -> ~ var \in dom v) -> - eq_zexpr k (| eval_Zexpr_Z_total $0 k |)%z -> - (0 <= eval_Zexpr_Z_total $0 n)%Z -> - (0 < eval_Zexpr_Z_total $0 k)%Z -> + eval_Zexpr $0 k kz -> + (0 < kz)%Z -> h $? o = Some arr -> well_formed_reindexer (fun l2 : list (Zexpr * Zexpr) => @@ -3413,16 +2999,16 @@ result_has_shape (V l) | (v0, d) :: xs => ((v0 / k)%z, (d // k)%z) :: ((ZMod v0 k)%z, k) :: xs end) v (V l) st h o a. Proof. - intros ? ? ? ? ? ? ? ? ? ? ? H Hsh Hvar Hk Hnnonneg Hknonneg Hheap. + intros ? ? ? ? ? ? ? ? ? ? ? ? H Hsh Hvar Hk Hknonneg Hheap. decomp_well_formed_reindexer. propositional. - eapply partial_injective_split; eauto. - eapply HeqZlist. cases l1; cases l2. eauto. - invert H. simpl in *. lia. - invert H. simpl in *. lia. + invert H. invert H0. + invert H. invert H0. erewrite <- eq_Z_tuple_index_list_cons in H. propositional. - cases p. cases p0. + cases p. cases p0. erewrite <- eq_Z_tuple_index_list_cons. propositional. unfold eq_Z_tup. simpl. propositional. eapply eq_zexpr_div. apply H0. apply eq_zexpr_id. auto. @@ -3435,14 +3021,13 @@ Proof. cases l1. auto. cases p. simpl. unfold subst_var_in_Z_tup. simpl. f_equal. f_equal. rewrite (subst_var_in_Zexpr_id k). auto. - invert Hk. rewrite H1. sets. + erewrite eval_Zexpr_vars_empty by eassumption. auto. f_equal. rewrite (subst_var_in_Zexpr_id k). auto. - invert Hk. rewrite H1. sets. + erewrite eval_Zexpr_vars_empty by eassumption. auto. - rewrite Hvarsarg. cases l1. auto. cases p. simpl. - invert Hk. rewrite H0. repeat rewrite constant_app_no_dups. + erewrite (eval_Zexpr_vars_empty k) by eassumption. + repeat rewrite constant_app_no_dups. sets. - eapply nondestructivity_split; eauto. - eapply Hk. Qed. - diff --git a/src/verified_lowering/proof/Zexpr.v b/src/verified_lowering/proof/Zexpr.v index c0d287d..2d8c9df 100644 --- a/src/verified_lowering/proof/Zexpr.v +++ b/src/verified_lowering/proof/Zexpr.v @@ -6,7 +6,7 @@ From Stdlib Require Import ZArith.Int. From Stdlib Require Import ZArith.Znat. From Stdlib Require Import Lists.List. From Stdlib Require Import micromega.Lia. - + From Stdlib Require Import Logic.FunctionalExtensionality. Set Warnings "-deprecate-hint-without-locality,-deprecated". @@ -52,7 +52,7 @@ Fixpoint eval_Zexpr_Z (v : valuation) (e : Zexpr) : option Z := match eval_Zexpr_Z v x, eval_Zexpr_Z v y with | Some xz, Some yz => Some (xz-yz)%Z | _,_ => None - end + end | ZTimes x y => match eval_Zexpr_Z v x, eval_Zexpr_Z v y with | Some xz, Some yz => Some (xz*yz)%Z @@ -62,7 +62,7 @@ Fixpoint eval_Zexpr_Z (v : valuation) (e : Zexpr) : option Z := match eval_Zexpr_Z v x, eval_Zexpr_Z v y with | Some xz, Some yz => Some (xz/yz)%Z | _,_ => None - end + end | ZDivc x y => match eval_Zexpr_Z v x, eval_Zexpr_Z v y with | Some xz, Some yz => Some (xz//yz)%Z @@ -72,10 +72,10 @@ Fixpoint eval_Zexpr_Z (v : valuation) (e : Zexpr) : option Z := match eval_Zexpr_Z v x, eval_Zexpr_Z v y with | Some xz, Some yz => Some (xz mod yz)%Z | _,_ => None - end + end | ZLit z => Some z | ZVar var => v $? var - end. + end. Inductive eval_Zexpr (v : valuation) : Zexpr -> Z -> Prop := | EvalZPlus : forall x y xz yz, @@ -144,7 +144,7 @@ Proof. reflexivity. * simpl. rewrite IHl. reflexivity. Qed. - + Definition app_no_dups (l1 l2 : list var) : list var := app l1 (filter (fun v => negb (in_bool l1 v)) l2). @@ -182,52 +182,26 @@ Definition eq_zexpr ez1 ez2 := Fixpoint flatten_shape_index (sh : list Zexpr) (i : list Zexpr) := match sh with - | n::m::ns => - match i with - | x::xs => - let stride := fold_left ZTimes ns m in - ZPlus (ZTimes x stride) (flatten_shape_index (m::ns) xs) - | _ => ZLit 0%Z - end - | [n] => + | n :: sh' => match i with - | [z] => z + | x :: xs => + let stride := fold_left ZTimes sh' (ZLit 1) in + ZPlus (ZTimes x stride) (flatten_shape_index sh' xs) | _ => ZLit 0%Z end - | _ => ZLit 0%Z + | [] => ZLit 0%Z end. Arguments flatten_shape_index : simpl nomatch. -Inductive eval_Zexprlist : valuation -> list Zexpr -> list Z -> Prop := -| EvalZNil : forall v, eval_Zexprlist v [] [] -| EvalZCons : forall v x xs z zs, - eval_Zexpr v x z -> - eval_Zexprlist v xs zs -> - eval_Zexprlist v (x::xs) (z::zs). -#[export] Hint Constructors eval_Zexprlist. +Notation eval_Zexprlist v := (Forall2 (eval_Zexpr v)). -Lemma eval_Zexprlist_app : forall l1 v l1z, - eval_Zexprlist v l1 l1z -> - forall l2 l2z, - eval_Zexprlist v l2 l2z -> - eval_Zexprlist v (l1++l2) (l1z++l2z). -Proof. - induct 1; intros. - - repeat rewrite app_nil_l. auto. - - repeat rewrite <- app_comm_cons. - econstructor. auto. - auto. -Qed. - -Definition eq_Z_index_list (l1 l2 : list Zexpr) := - length l1 = length l2 /\ - Forall (fun t => eq_zexpr (fst t) (snd t)) - (combine l1 l2). +Definition eq_Z_index_list := + Forall2 eq_zexpr. +Hint Unfold eq_Z_index_list : core. Definition eq_Z_tuple_index_list (l1 l2 : list (Zexpr * Zexpr)) := - length l1 = length l2 /\ - eq_Z_index_list (map fst l1) (map fst l2) /\ + eq_Z_index_list (map fst l1) (map fst l2) /\ eq_Z_index_list (map snd l1) (map snd l2). Ltac invsZ := @@ -492,6 +466,13 @@ Proof. simpl. apply app_nil_r. Qed. +Lemma app_no_dups_empty_l : forall l, + [] ++/ l = l. +Proof. + unfold app_no_dups. + simpl. intros. apply filter_true. +Qed. + Lemma eq_zexpr_add_0_r : forall e, eq_zexpr e (e + | 0 |)%z. Proof. @@ -502,6 +483,26 @@ Proof. - simpl. rewrite app_no_dups_empty_r. reflexivity. Qed. +Lemma eq_zexpr_mul_1_r : forall e, + eq_zexpr e (e * | 1 |)%z. +Proof. + intros. + unfold eq_zexpr. propositional. + - replace z with (z * 1)%Z by lia. eauto. + - invert H. invert H4. replace (xz*1)%Z with xz by lia. auto. + - simpl. rewrite app_no_dups_empty_r. reflexivity. +Qed. + +Lemma eq_zexpr_mul_1_l : forall e, + eq_zexpr e (| 1 | * e)%z. +Proof. + intros. + unfold eq_zexpr. propositional. + - replace z with (1 * z)%Z by lia. eauto. + - invert H. invert H2. replace (1*yz)%Z with yz by lia. auto. + - simpl. rewrite app_no_dups_empty_l. reflexivity. +Qed. + Lemma eq_zexpr_transitivity : forall e1 e2 e3, eq_zexpr e1 e2 -> eq_zexpr e2 e3 -> @@ -547,30 +548,16 @@ Lemma eq_Z_index_list_id : forall l, Proof. induct l. - econstructor; econstructor. - - econstructor; invert IHl. - reflexivity. simpl. econstructor. eauto. eauto. + - econstructor; eauto. Qed. Lemma eq_Z_index_list_cons : forall x1 xs1 x2 xs2, (eq_Z_index_list xs1 xs2 /\ eq_zexpr x1 x2) <-> eq_Z_index_list (x1::xs1) (x2::xs2). Proof. - induct xs1; intros; cases xs2; propositional. - - econstructor. reflexivity. econstructor. simpl. - auto. econstructor. - - eapply eq_Z_index_list_id. - - invert H. invert H1. auto. - - invert H0. simpl in *. lia. - - invert H. simpl in *. lia. - - invert H. simpl in *. lia. - - invert H0. simpl in *. lia. - - invert H. simpl in *. lia. - - invert H. simpl in *. lia. - - invert H0; simpl in *. econstructor. simpl. lia. - simpl. econstructor. eauto. auto. - - invert H. simpl in *. econstructor. - simpl. lia. invert H1. simpl. auto. - - invert H. invert H1. eauto. + intros. split; intros. + - destruct H; constructor; auto. + - invert H; auto. Qed. Lemma eq_zexpr_fold_ZTimes : forall vars1 vars2 z2 z3, @@ -588,7 +575,7 @@ Proof. Qed. Lemma eq_zexpr_fold_accum {X} : forall (f : Zexpr -> X -> Zexpr) l z1 z2, - eq_zexpr z1 z2 -> + eq_zexpr z1 z2 -> (forall x1 x2 a, eq_zexpr x1 x2 -> eq_zexpr (f x1 a) (f x2 a)) -> eq_zexpr (fold_left f l z1) (fold_left f l z2). Proof. @@ -615,7 +602,7 @@ Fixpoint partially_eval_Zexpr (v : valuation) (e : Zexpr) : Zexpr := | Some val => ZLit val | _ => e end - end. + end. Fixpoint subst_var_in_Zexpr (v : var) (z : Z) (e : Zexpr) : Zexpr := match e with @@ -629,7 +616,7 @@ Fixpoint subst_var_in_Zexpr (v : var) (z : Z) (e : Zexpr) : Zexpr := | ZVar var => if var ==v v then ZLit z else e - end. + end. Definition subst_var_in_Z_tup var z t := (subst_var_in_Zexpr var z (fst t), subst_var_in_Zexpr var z (snd t)). @@ -696,8 +683,8 @@ Proof. * simpl in *. eapply String.eqb_eq in Heq0. subst. rewrite Heq. simpl. rewrite String.eqb_refl. simpl. rewrite filter_app. f_equal. - repeat rewrite filter_filter. f_equal. - eapply functional_extensionality. intros. + repeat rewrite filter_filter. + apply filter_ext. intros x. cases (s =? x). -- eapply String.eqb_eq in Heq0. subst. rewrite Heq. simpl. auto. -- simpl. rewrite in_bool_filter. @@ -739,9 +726,9 @@ Proof. simpl. cases (f x). simpl. rewrite andb_true_r. reflexivity. simpl. reflexivity. ++ rewrite filter_app. - f_equal. simpl. rewrite Heq2. + f_equal. simpl. rewrite Heq2. repeat rewrite filter_filter. - f_equal. + f_equal. eapply functional_extensionality. intros. rewrite in_bool_filter. cases (a =? x). @@ -821,7 +808,7 @@ Proof. ** eapply String.eqb_eq in Heq3. subst. rewrite Heq. simpl. reflexivity. ** simpl. reflexivity. -Qed. +Qed. Lemma vars_of_Zexpr_subst_var_in_Zexpr : forall e v z, vars_of_Zexpr (subst_var_in_Zexpr v z e) = @@ -857,14 +844,6 @@ Proof. - simpl. f_equal. eauto. Qed. *) -Lemma app_no_dups_empty_l : forall l, - [] ++/ l = l. -Proof. - intros. cases l. - - reflexivity. - - unfold app_no_dups. - simpl. rewrite filter_true_id. auto. -Qed. Lemma in_bool_app : forall l1 l2 x, in_bool (l1 ++ l2) x = in_bool l1 x || in_bool l2 x. @@ -964,50 +943,33 @@ Definition index_to_function_alt (index : list (Zexpr * Zexpr)) vars : end. Lemma eq_zexpr_flatten_shape_index : - forall vars1 vars2, + forall vars1 vars2 dims1 dims2, eq_Z_index_list vars1 vars2 -> - forall dims1 dims2, - eq_Z_index_list dims1 dims2 -> - eq_zexpr (flatten_shape_index vars1 dims1) - (flatten_shape_index vars2 dims2). -Proof. - induction vars1; intros; cases vars2; cases dims1; cases dims2; - simpl in *; eauto; try lia; try now (invert H; simpl in *; lia). - - unfold flatten_shape_index. - cases vars1; cases vars2; eauto. - - invert H0; simpl in *; lia. - - invert H0; simpl in *; lia. - - cases vars1; cases vars2. - + unfold flatten_shape_index. - eapply eq_Z_index_list_cons in H0. - invert H. - cases dims1; cases dims2; propositional; auto. - invert H. simpl in *. lia. - invert H. simpl in *. lia. - + invert H. simpl in *. lia. - + invert H. simpl in *. lia. - + simpl. eapply eq_zexpr_add. - eapply eq_zexpr_mul. auto. - eapply eq_Z_index_list_cons in H0. propositional. - eapply eq_zexpr_fold_ZTimes. invert H. simpl in *. lia. - eapply eq_Z_index_list_cons in H. propositional. - eapply eq_Z_index_list_cons in H1. propositional. - eapply eq_Z_index_list_cons in H. propositional. - eapply eq_Z_index_list_cons in H1. propositional. - eapply IHvars1. eapply eq_Z_index_list_cons in H. propositional. - eapply eq_Z_index_list_cons in H0. propositional. + eq_Z_index_list dims1 dims2 -> + eq_zexpr (flatten_shape_index vars1 dims1) + (flatten_shape_index vars2 dims2). +Proof. + intros vars1 vars2 dims1 dims2 H. + revert dims1 dims2 . induction H; intros dims1 dims2 Hd. + - destruct dims1, dims2; simpl; apply eq_zexpr_id; reflexivity. + - invert Hd. + + destruct l, l'; simpl; apply eq_zexpr_id; reflexivity. + + simpl. + eapply eq_zexpr_add; auto. + eapply eq_zexpr_mul; auto. + apply eq_zexpr_fold_ZTimes; auto. + eapply Forall2_length. eassumption. Qed. Lemma eq_zexpr_flatten_index : forall index1 index2, eq_Z_tuple_index_list index1 index2 -> eq_zexpr (flatten_index index1) (flatten_index index2). Proof. - unfold eq_Z_tuple_index_list; - induction index1; intros; cases index2; simpl in *; try lia; propositional. - - unfold flatten_index. simpl. - eapply eq_zexpr_id; eauto. - - unfold flatten_index. simpl. - eapply eq_zexpr_flatten_shape_index; auto. + induction index1; simpl; intros index2 (H1&H2). + - simpl in *. destruct index2; invert H1. + apply eq_zexpr_id. reflexivity. + - unfold flatten_index. + apply eq_zexpr_flatten_shape_index; auto. Qed. Ltac eq_match_discriminee := @@ -1016,43 +978,30 @@ Ltac eq_match_discriminee := assert (A = B) as HH; [ | rewrite HH; reflexivity ] end. -Lemma index_to_function_alt_cons : forall index1 index2 z z1 z0 z2, +Lemma index_to_function_alt_cons : forall index1 index2 z1 z2 z3 z4, eq_Z_tuple_index_list index1 index2 -> index_to_function_alt index1 = index_to_function_alt index2 -> - eq_zexpr z z1 -> - eq_zexpr z0 z2 -> - index_to_function_alt ((z, z0) :: index1) = - index_to_function_alt ((z1, z2) :: index2). + eq_zexpr z1 z2 -> + eq_zexpr z3 z4 -> + index_to_function_alt ((z1, z3) :: index1) = + index_to_function_alt ((z2, z4) :: index2). Proof. unfold index_to_function_alt. unfold eq_Z_tuple_index_list. intros. eapply functional_extensionality. intros. unfold index_to_function_rec_alt in *. - unfold flatten_index. simpl. eapply functional_extensionality. intros. + unfold flatten_index. cbn -[flatten_shape_index]. eapply functional_extensionality. intros. propositional. eq_match_discriminee. eapply eq_eval_Zexpr_Z. - eapply eq_zexpr_transitivity. eapply eq_zexpr_fold_accum. - eapply eq_zexpr_flatten_shape_index with - (vars2:=z2 :: map snd index2) (dims2:=z1 :: map fst index2). + apply eq_zexpr_flatten_shape_index. rewrite <- eq_Z_index_list_cons. - propositional. + propositional. rewrite <- eq_Z_index_list_cons. propositional. intros. eapply eq_zexpr_subst_var_in_Zexpr. auto. - assert ( - eq_zexpr - (flatten_shape_index (z0 :: map snd index1) (z :: map fst index1)) - (flatten_shape_index (z2 :: map snd index2) (z1 :: map fst index2)) - ). - { - eapply eq_zexpr_flatten_shape_index. - rewrite <- eq_Z_index_list_cons. propositional. - rewrite <- eq_Z_index_list_cons. propositional. - } - eapply eq_zexpr_id. reflexivity. Qed. Lemma eq_index_to_function_alt : @@ -1061,14 +1010,12 @@ Lemma eq_index_to_function_alt : index_to_function_alt index1 = index_to_function_alt index2. Proof. unfold eq_Z_tuple_index_list; induction index1. - - intros. cases index2; simpl in *; try lia. reflexivity. - - intros. cases index2; simpl in *; try lia. + - intros. destruct H. cases index2; simpl in *; try congruence. invert H. + - intros. cases index2; simpl in *; destruct H; try congruence. invert H. propositional. - cases a. cases p. simpl in *. - eapply eq_Z_index_list_cons in H. - eapply eq_Z_index_list_cons in H2. propositional. auto. + cases a. cases p. simpl in *. subst. invert H. invert H0. eapply index_to_function_alt_cons; auto. - unfold eq_Z_tuple_index_list. propositional. lia. + unfold eq_Z_tuple_index_list. propositional. Qed. Lemma eq_index_to_function_alt_app : @@ -1170,7 +1117,7 @@ Proof. cases (a0 =? a). eapply String.eqb_eq in Heq0. subst. propositional. reflexivity. Qed. - + Lemma eq_zexpr_partially_eval_subst_var_in_Zexpr : forall e a z v, v $? a = Some z -> @@ -1191,7 +1138,7 @@ Proof. cases (x ==v a); subst; try rewrite H; auto; cases (v $? x); simpl in *; rewrite Heq; auto. Qed. - + Lemma eq_zexpr_eval_Zexpr : forall z1 z2, eq_zexpr z1 z2 -> forall v z, @@ -1202,7 +1149,7 @@ Proof. Qed. Lemma eval_Zexpr_partially_eval_Zexpr_not_in_valuation : - forall e a l, + forall e a l, vars_of_Zexpr e = a::l -> forall v v0 z, eval_Zexpr v0 (partially_eval_Zexpr v e) z -> @@ -1237,7 +1184,7 @@ Lemma subst_var_in_Zexpr_partially_eval_Zexpr_comm : forall e a x v, Proof. induct e; intros; simpl in *; try rewrite IHe1, IHe2; auto. - cases (x ==v a). + cases (x ==v a). - subst. rewrite H. simpl in *. cases (a ==v a); firstorder. - simpl. cases (v $? x); simpl. @@ -1262,7 +1209,7 @@ Lemma eq_zexpr_partially_eval_Zexpr_helper : forall l z1 z2, eq_zexpr (partially_eval_Zexpr v z1) (partially_eval_Zexpr v z2). Proof. unfold eq_zexpr in *. - assert True as H by propositional. + assert True as H by propositional. induction l; propositional. - cases z1; simpl in *; invsZ; try symmetry in H0; try eapply app_no_dups_empty_args in H0; invert1 H0; @@ -1303,7 +1250,7 @@ Proof. eapply eval_Zexpr_subst_var_in_Zexpr. eapply eval_Zexpr_subst_var_in_Zexpr in H6. eapply H2. auto. - } + } eapply H7 in H6. clear H7. 2: auto. invert H6. eapply eq_zexpr_eval_Zexpr. 2: { eapply eq_zexpr_partially_eval_subst_var_in_Zexpr. @@ -1346,7 +1293,7 @@ Proof. rewrite <- subst_var_in_Zexpr_partially_eval_Zexpr_comm by auto. eapply eval_Zexpr_subst_var_in_Zexpr. rewrite add_id by auto. - auto. + auto. - rewrite <- H0 in *. cases (v $? a). + specialize (IHl (subst_var_in_Zexpr a z0 z1) @@ -1432,7 +1379,7 @@ Proof. eapply eq_zexpr_subst_var_in_Zexpr in H1. unfold eq_zexpr in H1. invert H1. - eapply H6. eauto. + eapply H6. eauto. assert (eq_zexpr z1 z2). unfold eq_zexpr. propositional. eapply eq_zexpr_subst_var_in_Zexpr in H1. @@ -1448,10 +1395,10 @@ Proof. Qed. Definition eq_Z_tup x y := - eq_zexpr (fst x) (fst y) /\ eq_zexpr (snd x) (snd y). + eq_zexpr (fst x) (fst y) /\ eq_zexpr (snd x) (snd y). Definition partially_eval_Z_tup v tp := - (partially_eval_Zexpr v (fst tp),partially_eval_Zexpr v (snd tp)). + (partially_eval_Zexpr v (fst tp), partially_eval_Zexpr v (snd tp)). Lemma eq_zexpr_partially_eval_Zexpr : forall z1 z2, eq_zexpr z1 z2 -> @@ -1469,8 +1416,8 @@ Lemma eq_Z_tup_partially_eval_tup : forall t1 t2, Proof. intros. cases t1. cases t2. invert H. unfold partially_eval_Z_tup. unfold eq_Z_tup. - simpl in *. - split; eapply eq_zexpr_partially_eval_Zexpr; auto. + simpl in *. subst. + split; auto; eapply eq_zexpr_partially_eval_Zexpr; auto. Qed. Lemma eq_zexpr_list_fst : forall v (l1 l2 : list (Zexpr * Zexpr)), @@ -1508,10 +1455,10 @@ Proof. induction l1; intros; cases l2; simpl in *; try lia. - constructor. - invert H0. invert H. - constructor. simpl in *. + constructor. simpl in *. eapply eq_zexpr_partially_eval_Zexpr. auto. eauto. -Qed. +Qed. Lemma partially_eval_Zexpr_empty_valuation : forall v z, eval_Zexpr_Z v z = eval_Zexpr_Z $0 (partially_eval_Zexpr v z). @@ -1571,7 +1518,7 @@ Proof. - invert H. econstructor. auto. eapply H0. auto. - invert H. econstructor. auto. eapply H0. auto. - simpl. rewrite H1. reflexivity. -Qed. +Qed. Lemma eq_zexpr_mul_l : forall a b c, eq_zexpr b c -> @@ -1581,7 +1528,7 @@ Proof. - invert H. econstructor. eapply H0. auto. auto. - invert H. econstructor. eapply H0. auto. auto. - simpl. rewrite H1. reflexivity. -Qed. +Qed. Lemma eq_zexpr_fold_left_ZTimes_accum : forall dims acc1 acc2, eq_zexpr acc1 acc2 -> @@ -1604,7 +1551,7 @@ Proof. - invert H. econstructor. eapply H0. auto. auto. - invert H. econstructor. eapply H0. auto. auto. - simpl. rewrite H1. reflexivity. -Qed. +Qed. Lemma eq_zexpr_mul_fold_left_times : forall dims i z, eq_zexpr (i * fold_left ZTimes dims z)%z @@ -1623,17 +1570,19 @@ Lemma eq_zexpr_flatten_shape_index_cons : forall vars i n dims, length dims = length vars -> eq_zexpr (flatten_shape_index (n::dims) (i::vars)) - (ZPlus (fold_left ZTimes dims i) - (flatten_shape_index dims vars)). + (ZPlus (fold_left ZTimes dims i) + (flatten_shape_index dims vars)). Proof. - intros; cases vars; cases dims; simpl in *; try lia. - - simpl in *. eapply eq_zexpr_add_0_r. - - invert H. - eapply eq_zexpr_add_l. - eapply eq_zexpr_mul_fold_left_times. -Qed. + intros. simpl. + apply eq_zexpr_add; auto. + eapply eq_zexpr_transitivity. + apply eq_zexpr_mul_fold_left_times. + apply eq_zexpr_fold_left_ZTimes_accum. + apply eq_zexpr_comm. + apply eq_zexpr_mul_1_r. +Qed. -Lemma eq_Z_tuple_index_list_empty : +Lemma eq_Z_tuple_index_list_empty : eq_Z_tuple_index_list [] []. Proof. unfold eq_Z_tuple_index_list. unfold eq_Z_index_list. @@ -1642,35 +1591,28 @@ Qed. Lemma eq_Z_tuple_index_list_cons_tup : forall l1 l2 x1 x2 y1 y2, (eq_zexpr x1 x2 /\ - eq_zexpr y1 y2 /\ - eq_Z_tuple_index_list l1 l2) <-> - (eq_Z_tuple_index_list ((x1,y1)::l1) ((x2,y2)::l2)). + eq_zexpr y1 y2 /\ + eq_Z_tuple_index_list l1 l2) <-> + (eq_Z_tuple_index_list ((x1,y1)::l1) ((x2,y2)::l2)). Proof. unfold eq_Z_tuple_index_list. unfold eq_Z_index_list. - propositional; simpl in *. - - lia. - - lia. - - econstructor. simpl. auto. auto. - - lia. - - econstructor. simpl. auto. auto. - - invert H3. auto. - - invert H4. auto. - - lia. - - lia. - - invert H3. auto. - - lia. - - invert H4. auto. + propositional; simpl in *; + do 2 try match goal with + | H: Forall2 _ (_ :: _) _ |- _ => invert H + end; + eauto. Qed. Lemma eq_Z_tuple_index_list_cons : forall l1 l2 x y, (eq_Z_tup x y /\ - eq_Z_tuple_index_list l1 l2) <-> + eq_Z_tuple_index_list l1 l2) <-> (eq_Z_tuple_index_list (x::l1) (y::l2)). Proof. intros. cases x. cases y. unfold eq_Z_tup. simpl. split; intros. + destruct H as ((?&?)&?). subst. erewrite <- eq_Z_tuple_index_list_cons_tup. propositional. - eapply eq_Z_tuple_index_list_cons_tup in H. propositional. + erewrite <- eq_Z_tuple_index_list_cons_tup in H. propositional. Qed. Lemma eq_Z_tuple_index_list_id : forall l, @@ -1690,8 +1632,8 @@ Lemma eq_Z_tuple_index_list_partially_eval_Z_tup : forall l1 l2 v, Proof. induct l1; intros; cases l2. - simpl. eapply eq_Z_tuple_index_list_id. - - invert H. simpl in *. lia. - - invert H. simpl in *. lia. + - invert H. invert H0. + - invert H. invert H0. - simpl. rewrite <- eq_Z_tuple_index_list_cons. rewrite <- eq_Z_tuple_index_list_cons in H. propositional. + unfold eq_Z_tup in *. propositional; simpl; @@ -1707,23 +1649,23 @@ Proof. - eapply eq_zexpr_transitivity. eapply eq_zexpr_add; eassumption. unfold eq_zexpr; propositional. invert H1. invert H4. invert H6. eauto. - invert H1. eauto. + invert H1. eauto. - eapply eq_zexpr_transitivity. eapply eq_zexpr_sub; eassumption. unfold eq_zexpr; propositional. invert H1. invert H4. invert H6. eauto. - invert H1. eauto. + invert H1. eauto. - eapply eq_zexpr_transitivity. eapply eq_zexpr_mul; eassumption. unfold eq_zexpr; propositional. invert H1. invert H4. invert H6. eauto. - invert H1. eauto. + invert H1. eauto. - eapply eq_zexpr_transitivity. eapply eq_zexpr_div; eassumption. unfold eq_zexpr; propositional. invert H1. invert H4. invert H6. eauto. - invert H1. eauto. + invert H1. eauto. - eapply eq_zexpr_transitivity. eapply eq_zexpr_divc; eassumption. unfold eq_zexpr; propositional. invert H1. invert H4. invert H6. eauto. - invert H1. eauto. + invert H1. eauto. - eapply eq_zexpr_transitivity. eapply eq_zexpr_mod; eassumption. unfold eq_zexpr; propositional. invert H1. invert H4. invert H6. eauto. @@ -1790,18 +1732,10 @@ Lemma eq_Z_index_list_transitivity : eq_Z_index_list l2 l3 -> eq_Z_index_list l1 l3. Proof. - induct l1; intros. - - invert H. cases l2; cases l3; invert H0; simpl in *; try lia. - eapply eq_Z_index_list_id. - - invert H. cases l2; cases l3; invert H0; simpl in *; try lia. - invert H3. invert H2. simpl in *. - econstructor. simpl. lia. - simpl. econstructor. simpl. eapply eq_zexpr_transitivity. eassumption. - eassumption. unfold eq_Z_index_list in IHl1. - invert H1. invert H. - specialize (IHl1 l2 l3). propositional. -Qed. - + cbv [eq_Z_index_list]. intros l1 l2 l3 H1. revert l3. + induction H1; invert 1; eauto using eq_zexpr_transitivity. +Qed. + Lemma eq_Z_tuple_index_list_transitivity : forall l1 l2 l3, eq_Z_tuple_index_list l1 l2 -> @@ -1809,13 +1743,12 @@ Lemma eq_Z_tuple_index_list_transitivity : eq_Z_tuple_index_list l1 l3. Proof. unfold eq_Z_tuple_index_list. propositional. - lia. eapply eq_Z_index_list_transitivity; eassumption. eapply eq_Z_index_list_transitivity; eassumption. Qed. Lemma eq_Z_index_list_sym : forall l1 l2, - eq_Z_index_list l1 l2 -> + eq_Z_index_list l1 l2 -> eq_Z_index_list l2 l1. Proof. induct l1; intros; cases l2; auto; @@ -1825,14 +1758,14 @@ Proof. rewrite <- eq_Z_index_list_cons. propositional. eauto. eapply eq_zexpr_comm. eassumption. -Qed. +Qed. Lemma eq_Z_tuple_index_list_sym : forall l1 l2, - eq_Z_tuple_index_list l1 l2 -> + eq_Z_tuple_index_list l1 l2 -> eq_Z_tuple_index_list l2 l1. Proof. unfold eq_Z_tuple_index_list. - propositional; try lia; eapply eq_Z_index_list_sym; auto. + propositional; eauto using Logic.eq_trans, eq_Z_index_list_sym. Qed. Lemma partially_eval_Zexpr_fold_left_ZTimes : forall l z v, @@ -1863,7 +1796,7 @@ Lemma map_subst_var_in_Z_tup_combine_not_in : forall vars sh a z, ~ In a vars -> map (subst_var_in_Z_tup a z) (combine (map ZVar vars) (map ZLit sh)) = - combine (map ZVar vars) (map ZLit sh) . + combine (map ZVar vars) (map ZLit sh). Proof. induct vars; intros. - reflexivity. @@ -1926,28 +1859,16 @@ Lemma eval_flatten_shape_index_cons : eval_Zexpr v (fold_left ZTimes (map snd xs) (snd x)) stride -> eval_Zexpr v (flatten_shape_index (n :: map snd l) (i :: map fst l)) val. Proof. - induct l; intros. - - discriminate. - - invert H1. - simpl in *. - cases xs. - + simpl in *. eauto. - + simpl in *. - invert H. - invert H4. - pose proof H6. - eapply IHl in H6. 4: reflexivity. - 5: eassumption. - 2: eassumption. - 2: eassumption. - 2: reflexivity. - invert H6. - eapply eval_Zexpr_deterministic in H; try eassumption. subst. - invert H8. - eapply eval_Zexpr_deterministic in H9; try eassumption. subst. - eapply eval_Zexpr_deterministic in H10; try eassumption. subst. - eauto. -Qed. + intros. simpl. subst. simpl. simpl in H. + constructor. + 2: assumption. + constructor; auto. + eapply eq_zexpr_eval_Zexpr. + 2: eassumption. + apply eq_zexpr_fold_left_ZTimes_accum. + apply eq_zexpr_mul_1_l. + all: fail. +Abort. Lemma eval_flatten_shape_index_app_end : forall l n i offset nz iz v, eval_Zexpr v (flatten_shape_index (map snd l) (map fst l)) offset -> @@ -1957,83 +1878,33 @@ Lemma eval_flatten_shape_index_app_end : forall l n i offset nz iz v, (offset*nz+iz). Proof. induct l; intros. - - simpl in *. invert H. rewrite Z.mul_0_l. rewrite Z.add_0_l. auto. - - simpl map in *. - cases l; try cases l; simpl map in *. - + simpl in *. - eauto. - + simpl in *. - invert H. invert H4. - replace ((xz0 * yz0 + yz) * nz + iz)%Z with - ((xz0 * (yz0 * nz)) + ((yz * nz) + iz))%Z by lia. - eauto. - + rewrite <- app_comm_cons. - replace ((snd p :: snd p0 :: map snd l) ++ [n])%list with - (map snd (p::p0::l++[(i,n)])). - 2: { simpl. rewrite map_app. reflexivity. } - - rewrite <- app_comm_cons. - replace ((fst p :: fst p0 :: map fst l) ++ [i])%list with - (map fst (p::p0::l++[(i,n)])). - 2: { simpl. rewrite map_app. reflexivity. } - - simpl in H. - invert H. - invert H4. - invert H6. - invert H4. - - eapply eval_flatten_shape_index_cons. - 3: reflexivity. - 4: { simpl. rewrite map_app. simpl. - eapply eval_Zexpr_fold_app_end. - econstructor. eassumption. - eassumption. } - simpl map. repeat rewrite map_app. simpl map. - eapply IHl. simpl. - econstructor. econstructor. eassumption. eassumption. - eassumption. eassumption. eassumption. - eassumption. lia. + - simpl in *. invert H. eassert ((_ + _)%Z = _) as ->. 2: eauto. lia. + - simpl in *. invert H. invert H4. eassert ((_ + _)%Z = _) as ->. + 2: { constructor; eauto. rewrite fold_left_app. simpl. eauto. } + lia. Qed. Lemma partially_eval_Zexpr_flatten_shape_index : forall l1 l2 v, (partially_eval_Zexpr v (flatten_shape_index l1 l2)) = flatten_shape_index - (map (partially_eval_Zexpr v) l1) - (map (partially_eval_Zexpr v) l2). + (map (partially_eval_Zexpr v) l1) + (map (partially_eval_Zexpr v) l2). Proof. - induct l1; intros; cases l2. - - simpl. auto. - - simpl. auto. - - simpl. unfold flatten_shape_index. - cases l1; auto. - - simpl. - cases l1; cases l2. - + simpl. auto. - + simpl. auto. - + simpl. unfold flatten_shape_index. cases l1; auto. simpl. - f_equal. f_equal. - eapply partially_eval_Zexpr_fold_left_ZTimes. - + simpl. - f_equal. f_equal. eapply partially_eval_Zexpr_fold_left_ZTimes. - rewrite IHl1. simpl. auto. + induct l1; intros; cases l2; try reflexivity; []. + simpl. rewrite IHl1. f_equal. f_equal. + apply partially_eval_Zexpr_fold_left_ZTimes. Qed. Fixpoint flatten (sh : list Z) (i : list Z) := match sh with - | n::m::ns => + | n :: sh' => match i with - | x::xs => - let stride := fold_left Z.mul ns m in - ((x * stride) + (flatten (m::ns) xs))%Z - | _ => 0%Z + | x :: xs => + let stride := fold_left Z.mul sh' 1%Z in + ((x * stride) + (flatten sh' xs))%Z + | [] => 0%Z end - | [n] => - match i with - | [z] => z - | _ => 0%Z - end - | _ => 0%Z + | [] => 0%Z end. Lemma eval_Zexpr_Z_flatten_index_ZLit_flatten : forall sh args v, @@ -2041,23 +1912,11 @@ Lemma eval_Zexpr_Z_flatten_index_ZLit_flatten : forall sh args v, Some (flatten sh args). Proof. induct sh; intros. - - simpl. cases args. - + simpl. reflexivity. - + simpl. reflexivity. - - simpl. cases sh. - + simpl. - cases args. - * simpl. reflexivity. - * simpl. unfold flatten_shape_index. - cases args. - simpl. reflexivity. - simpl. reflexivity. - + simpl. - cases args. - * simpl. reflexivity. - * simpl. - rewrite eval_Zexpr_Z_fold_left_ZTimes_ZLit. - rewrite IHsh. reflexivity. + - simpl. destruct args; reflexivity. + - simpl. destruct args; simpl; try reflexivity. + rewrite eval_Zexpr_Z_fold_left_ZTimes_ZLit. + rewrite IHsh. + reflexivity. Qed. Lemma subst_var_in_Zexpr_fold_left_Times : @@ -2074,21 +1933,16 @@ Proof. Qed. Lemma subst_var_in_Zexpr_flatten_index : - forall var k index, + forall var k index, subst_var_in_Zexpr var k (flatten_index index) = - flatten_index (map (fun t => (subst_var_in_Z_tup var k t)) index). + flatten_index (map (subst_var_in_Z_tup var k) index). Proof. unfold flatten_index. induction index. - reflexivity. - - simpl. repeat rewrite map_map in *. simpl in *. - cases index. - + simpl in *. eauto. - + simpl in *. - f_equal. f_equal. - rewrite subst_var_in_Zexpr_fold_left_Times. - rewrite map_map. reflexivity. - eauto. + - simpl. rewrite IHindex. f_equal. f_equal. + rewrite subst_var_in_Zexpr_fold_left_Times. + do 2 rewrite map_map. reflexivity. Qed. Lemma subst_var_in_Z_tup_partially_eval_Z_tup_comm : forall e a x v, @@ -2098,7 +1952,7 @@ Lemma subst_var_in_Z_tup_partially_eval_Z_tup_comm : forall e a x v, Proof. unfold subst_var_in_Z_tup. unfold partially_eval_Z_tup. intros. simpl. - repeat rewrite subst_var_in_Zexpr_partially_eval_Zexpr_comm. + repeat rewrite subst_var_in_Zexpr_partially_eval_Zexpr_comm. reflexivity. eapply None_dom_lookup. auto. eapply None_dom_lookup. auto. @@ -2136,7 +1990,7 @@ Lemma fold_left_subst_var_in_Z_tup_ZLit : fold_left (fun (a0 : Zexpr * Zexpr) (t0 : var * Z) => subst_var_in_Z_tup (fst t0) (snd t0) a0) (combine vars x) - ((| z |)%z, (| z0 |)%z) = ((| z |)%z, (| z0 |)%z). + ((| z |)%z, | z0 |%z) = ((| z |)%z, | z0 |%z). Proof. induct vars; intros. - reflexivity. @@ -2187,20 +2041,16 @@ Qed. Lemma flatten_index_partially_eval_Zexpr : forall (l : list (Zexpr * Zexpr)) v, partially_eval_Zexpr v (flatten_index l) = - flatten_index (map (fun tp => (partially_eval_Zexpr v (fst tp), - partially_eval_Zexpr v (snd tp))) l). + flatten_index (map (fun tp => (partially_eval_Zexpr v (fst tp), partially_eval_Zexpr v (snd tp))) l). Proof. unfold flatten_index. induct l; intros. - reflexivity. - - specialize (IHl v). - repeat rewrite map_map in *. simpl in *. - cases l. - + reflexivity. - + simpl. f_equal. f_equal. - rewrite partially_eval_Zexpr_fold_left_Times. - rewrite map_map. reflexivity. - eauto. + - specialize (IHl v). simpl. repeat rewrite map_map in *. simpl in *. + rewrite IHl. f_equal. f_equal. + rewrite partially_eval_Zexpr_fold_left_Times. + rewrite map_map. + reflexivity. Qed. Lemma flatten_index_partially_eval_Z_tup : @@ -2230,7 +2080,7 @@ Proof. rewrite subst_var_in_Zexpr_partially_eval_Zexpr_comm. rewrite IHvars. reflexivity. auto. eapply None_dom_lookup. auto. -Qed. +Qed. Lemma fold_left_subst_var_in_Zexpr_flatten_index : forall tups e, @@ -2276,9 +2126,9 @@ Proof. eapply IHl1. auto. - simpl in *. invert H0. rewrite String.eqb_refl in H. simpl in *. discriminate. - eapply IHl1. 2: eassumption. + eapply IHl1. 2: eassumption. eapply orb_false_iff in H. propositional. -Qed. +Qed. Lemma combine_eq_id : forall l, Forall (fun t => eq_zexpr (fst t) (snd t)) @@ -2292,8 +2142,8 @@ Lemma index_to_function_alt_vars_cons : ~ var \in dom v -> index_to_function_alt (map (partially_eval_Z_tup v) - (reindexer l)) (var::vars) (k :: x) = - index_to_function_alt + (reindexer l)) (var::vars) (k :: x) = + index_to_function_alt (map (partially_eval_Z_tup v) (map (fun e => (subst_var_in_Z_tup var k e)) (reindexer l))) vars x. @@ -2366,7 +2216,7 @@ Fixpoint vars_of_reindexer cont := match cont with | [] => constant nil | (i,n)::xs => constant (vars_of_Zexpr i) \cup constant (vars_of_Zexpr n) - \cup vars_of_reindexer xs + \cup vars_of_reindexer xs end. Lemma eq_Z_tuple_index_list_eq_vars_of_reindexer : forall l1 l2, @@ -2375,11 +2225,11 @@ Lemma eq_Z_tuple_index_list_eq_vars_of_reindexer : forall l1 l2, Proof. induct l1; intros; cases l2. - reflexivity. - - invert H. simpl in *. lia. - - invert H. simpl in *. lia. + - invert H. simpl in *. invert H0. + - invert H. invert H0. - rewrite <- eq_Z_tuple_index_list_cons in H. propositional. simpl. cases a. cases p. - f_equal. + f_equal. unfold eq_Z_tup in H0. invert H0. simpl in *. unfold eq_zexpr in H, H2. propositional. rewrite H3, H4. reflexivity. @@ -2390,14 +2240,14 @@ Lemma map_fold_left_subst_var_in_Z_tup_reindexer : (forall (var : var) (k : Z) (l : list (Zexpr * Zexpr)), (var \in vars_of_reindexer (reindexer []) -> False) -> map (subst_var_in_Z_tup var k) (reindexer l) = - reindexer (map (subst_var_in_Z_tup var k) l)) -> + reindexer (map (subst_var_in_Z_tup var k) l)) -> (Forall (fun var => ~ var \in vars_of_reindexer (reindexer [])) vars) -> map (fun y => fold_left (fun a t0 => subst_var_in_Z_tup (fst t0) (snd t0) a) (combine vars x) y) - (reindexer l) = + (reindexer l) = (reindexer (map (fun y => fold_left @@ -2413,7 +2263,7 @@ Proof. erewrite IHvars. reflexivity. eassumption. invert H0. auto. invert H0. auto. Qed. - + Lemma length_eval_Zexprlist : forall l1 l2 v, eval_Zexprlist v l1 l2 -> length l1 = length l2. @@ -2452,7 +2302,7 @@ Lemma eval_Zexpr_Z_fold_left_ZTimes : Proof. induct 1; intros. - simpl. eapply eval_Zexpr_Z_eval_Zexpr. auto. - - simpl. eapply IHeval_Zexprlist in H1. + - simpl. eapply IHForall2 in H1. rewrite fold_left_mul_assoc. rewrite eval_Zexpr_Z_fold_left_assoc. simpl. rewrite H1. @@ -2461,31 +2311,18 @@ Qed. Arguments flatten : simpl nomatch. Lemma eval_Zexpr_Z_flatten_index_flatten: - forall (sh args : list Zexpr) shz argsz (v : valuation), - eval_Zexprlist v sh shz -> + forall sh (args : list Zexpr) shz argsz (v : valuation), eval_Zexprlist v args argsz -> + eval_Zexprlist v sh shz -> eval_Zexpr_Z v (flatten_shape_index sh args) = Some (flatten shz argsz). Proof. - induct sh; intros; cases args; try invert H; try invert H0. - - reflexivity. - - reflexivity. - - simpl. unfold flatten_shape_index. - cases sh; cases zs; auto. - - cases zs0; cases zs; cases sh; cases args; - try invert H6; try invert H7. - + eapply eval_Zexpr_Z_eval_Zexpr. auto. - + simpl. - eapply eval_Zexpr_Z_eval_Zexpr in H3. rewrite H3. - erewrite eval_Zexpr_Z_fold_left_ZTimes; try eassumption. - erewrite IHsh; try eauto. - + reflexivity. - + simpl. erewrite IHsh. - 2: { econstructor. eauto. eauto. } - 2: { econstructor. eauto. eauto. } - eapply eval_Zexpr_Z_eval_Zexpr in H3. rewrite H3. - erewrite eval_Zexpr_Z_fold_left_ZTimes; try eassumption. - reflexivity. -Qed. + intros sh args shz argsz v H. revert sh shz. induction H; intros sh shz. + - invert 1; reflexivity. + - invert 1; try reflexivity. simpl. + apply eval_Zexpr_Z_eval_Zexpr in H. rewrite H. + erewrite IHForall2 by eassumption. + erewrite eval_Zexpr_Z_fold_left_ZTimes; eauto. +Qed. Lemma In_app_no_dups : forall l1 l2 i, ~ In i (l1 ++/ l2) -> @@ -2545,7 +2382,8 @@ Proof. - reflexivity. - propositional. simpl. rewrite subst_var_in_Z_tup_id. auto. - simpl. rewrite H. sets. simpl. rewrite H0. sets. + simpl. rewrite H. sets. + simpl. rewrite H0. sets. Qed. Lemma fold_left_mul_pos : forall l x, @@ -2600,10 +2438,10 @@ Qed. Lemma eq_Z_tup_fold_left_subst_var_in_Z_tup : forall l1 vars idx, Forall (fun var => ~ In var vars) (vars_of_Zexpr (fst l1)) -> Forall (fun var => ~ In var vars) (vars_of_Zexpr (snd l1)) -> - (fold_left - (fun a t0 => - subst_var_in_Z_tup (fst t0) (snd t0) a) - (combine vars idx) l1) = l1. + (fold_left + (fun a t0 => + subst_var_in_Z_tup (fst t0) (snd t0) a) + (combine vars idx) l1) = l1. Proof. induction vars; intros; simpl in *. - auto. @@ -2621,7 +2459,7 @@ Proof. unfold not. intros. eapply Forall_forall in H1. 2: apply H0. simpl in *. propositional. -Qed. +Qed. Lemma constant_filter_negb_in_bool : forall l1 l2, constant l1 \cup @@ -2703,6 +2541,29 @@ Proof. eapply lookup_Some_dom in H. sets. Qed. +Lemma eval_Zexpr_vars_empty e r : + eval_Zexpr $0 e r -> + vars_of_Zexpr e = []. +Proof. + intros H. apply eval_Zexpr_vars_in_valuation in H. + destruct (vars_of_Zexpr e) as [| v ?]; auto. + rewrite dom_empty in H. exfalso. specialize (H v). apply H. simpl. auto. +Qed. + +Lemma eval_empty_eq_zexpr x xz : + eval_Zexpr $0 x xz -> + eq_zexpr x (| xz |)%z. +Proof. + intros H. cbv [eq_zexpr]. + - split. + + intros v z. split; intros H'. + -- eapply eval_Zexpr_includes_valuation in H. 2: apply empty_includes. + eapply eval_Zexpr_deterministic in H'. 2: apply H. subst. constructor. + -- invert H'. eapply eval_Zexpr_includes_valuation. 1: eassumption. + apply empty_includes. + + simpl. eapply eval_Zexpr_vars_empty. eassumption. +Qed. + Lemma eval_Zexpr_forall_vars_of_Zexpr : forall e v ez, eval_Zexpr v e ez -> Forall (fun var => var \in dom v) (vars_of_Zexpr e). @@ -2719,14 +2580,13 @@ Lemma eval_Zexprlist_add : forall l v lz, ~ i \in dom v -> eval_Zexprlist (v $+ (i,x)) l lz. Proof. - induct 1; intros. - - econstructor. - - econstructor. - eapply eval_Zexpr_subst_var_in_Zexpr. - rewrite subst_var_in_Zexpr_id. auto. - eapply vars_not_in_vars_of_Zexpr. eassumption. auto. - eauto. -Qed. + intros. eapply Forall2_impl; [|eassumption]. + intros. + eapply eval_Zexpr_includes_valuation; eauto. + apply includes_add_new. + apply None_dom_lookup. + assumption. +Qed. Lemma eq_zexpr_literal_subst_var_in_Zexpr : forall x xz v k, eq_zexpr x (|xz|)%z -> @@ -2738,17 +2598,15 @@ Proof. rewrite subst_var_in_Zexpr_id. eapply H0 in H. eauto. rewrite H1. sets. rewrite vars_of_Zexpr_subst_var_in_Zexpr. rewrite H1. reflexivity. -Qed. +Qed. Lemma eval_Zexprlist_includes_valuation : forall v l lz v', eval_Zexprlist v l lz -> v $<= v' -> eval_Zexprlist v' l lz. Proof. - induct l; intros. - - invert H. eauto. - - invert H. econstructor. - eapply eval_Zexpr_includes_valuation; eauto. eauto. + intros. eapply Forall2_impl; [|eassumption]. + intros. eapply eval_Zexpr_includes_valuation; eauto. Qed. Definition eval_Zexpr_Z_total v e := @@ -2761,7 +2619,7 @@ Lemma vars_of_Zexpr_empty_eval_Zexpr_literal : forall e, vars_of_Zexpr e = [] -> exists x, - forall v, + forall v, eval_Zexpr v e x. Proof. induct e; simpl in *; intros; try eapply app_no_dups_empty_args in H; @@ -2795,7 +2653,7 @@ Proof. eapply vars_of_Zexpr_empty_eval_Zexpr_literal in H2. invs. pose proof H0. specialize (H0 $0). eapply eval_Zexpr_Z_eval_Zexpr in H0. rewrite H0. - eapply H1. eauto. + eapply H1. apply H. Qed. Lemma vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total : forall n v, @@ -2946,7 +2804,7 @@ Proof. pose proof (H v). pose proof (H $0). eq_eval_Z. eapply eval_Zexpr_Z_eval_Zexpr in H3. unfold eval_Zexpr_Z_total in *. rewrite H3 in *. invert H1. - cases (Z.to_nat x). simpl. lia. + cases (Z.to_nat x). simpl. lia. simpl. lia. - simpl in *. invert H. invert H5. specialize (IHesh1 (ZTimes z a)). @@ -3003,7 +2861,7 @@ Proof. Qed. Definition eval_Zexpr_Z_tup v tup := - (eval_Zexpr_Z v (fst tup),eval_Zexpr_Z v (snd tup)). + (eval_Zexpr_Z v (fst tup), eval_Zexpr_Z v (snd tup)). Definition eval_Zexpr_Z_tup_total v tup := match eval_Zexpr_Z_tup v tup with @@ -3055,9 +2913,9 @@ Lemma snd_fold_left_subst_var_in_Z_tup : (fold_left (fun (z3 : Zexpr * Zexpr) (tup : var * Z) => subst_var_in_Z_tup (fst tup) (snd tup) z3) l (z, z0)) = - fold_left - (fun (z3 : Zexpr) (tup : var * Z) => - subst_var_in_Zexpr (fst tup) (snd tup) z3) l z0. + fold_left + (fun (z3 : Zexpr) (tup : var * Z) => + subst_var_in_Zexpr (fst tup) (snd tup) z3) l z0. Proof. induct l; intros. auto. simpl. cases a. simpl. @@ -3085,7 +2943,7 @@ Qed. Lemma eq_zexpr_fold_left_subst_var_in_Zexpr : forall x x0 z1 z2 , eq_zexpr z1 z2 -> - eq_zexpr + eq_zexpr (fold_left (fun (z3 : Zexpr) (tup : var * Z) => subst_var_in_Zexpr (fst tup) (snd tup) z3) (combine x x0) z1) @@ -3163,7 +3021,7 @@ Lemma map_eval_Zexpr_Z_tup_total_map_partially_eval_Z_tup : forall l v, map (eval_Zexpr_Z_tup_total $0) (map (partially_eval_Z_tup v) l) = map (eval_Zexpr_Z_tup_total v) l. -Proof. +Proof. induct l; intros. - reflexivity. - simpl. f_equal. @@ -3179,35 +3037,35 @@ Lemma map_eval_Zexpr_Z_tup_total_map_fold_left_subst_var_in_Z_tup : (fun tup : Zexpr * Zexpr => (fold_left (fun (z5 : Zexpr * Zexpr) (tup0 : var * Z) => - subst_var_in_Z_tup (fst tup0) (snd tup0) z5) + subst_var_in_Z_tup (fst tup0) (snd tup0) z5) (combine x x0) tup)) index1) = map (eval_Zexpr_Z_tup_total $0) (map (fun tup : Zexpr * Zexpr => (fold_left (fun (z5 : Zexpr * Zexpr) (tup0 : var * Z) => - subst_var_in_Z_tup (fst tup0) (snd tup0) z5) - (combine x x0) tup)) index2). + subst_var_in_Z_tup (fst tup0) (snd tup0) z5) + (combine x x0) tup)) index2). Proof. intros. induct index1; cases index2. - reflexivity. - - invert H. simpl in *. lia. - - invert H. simpl in *. lia. + - invert H. invert H0. + - invert H. invert H0. - repeat rewrite map_cons. f_equal. - 2: { eapply IHindex1. + 2: { eapply IHindex1. eapply eq_Z_tuple_index_list_cons in H. propositional. } eapply eq_Z_tuple_index_list_cons in H. invs. unfold eval_Zexpr_Z_tup_total. eq_match_discriminee. cases a. cases p. simpl in *. - eapply (eq_zexpr_fold_left_subst_var_in_Z_tup x x0) in H0. + eapply (eq_zexpr_fold_left_subst_var_in_Z_tup x x0) in H0. unfold eval_Zexpr_Z_tup. simpl. unfold eq_Z_tup in H0. invs. repeat rewrite fst_fold_left_subst_var_in_Z_tup in *. repeat rewrite snd_fold_left_subst_var_in_Z_tup in *. - f_equal; eapply eq_eval_Zexpr_Z; eauto. + subst. f_equal; eapply eq_eval_Zexpr_Z; eauto. Qed. Lemma map_partially_eval_Z_tup_combine_ZLit : @@ -3392,54 +3250,54 @@ Proof. invert H. rewrite lookup_empty in *. discriminate. - rewrite H1. econstructor. Qed. - + Lemma eval_Zexprlist_map_match_snd_map_eval_Zexpr_Z_tup_total : forall v l, - eval_Zexprlist $0 (map (partially_eval_Zexpr v) (map snd l)) - (map (eval_Zexpr_Z_total v) (map snd l)) -> - eval_Zexprlist $0 (map (partially_eval_Zexpr v) (map fst l)) - (map (eval_Zexpr_Z_total v) (map fst l)) -> - (map - (fun o : option (Z * Z) => - match o with - | Some x => snd x - | None => 0%Z - end) (map (eval_Zexpr_Z_tup_total v) l)) = - (map (eval_Zexpr_Z_total v) (map snd l)). + eval_Zexprlist $0 (map (partially_eval_Zexpr v) (map snd l)) + (map (eval_Zexpr_Z_total v) (map snd l)) -> + eval_Zexprlist $0 (map (partially_eval_Zexpr v) (map fst l)) + (map (eval_Zexpr_Z_total v) (map fst l)) -> + (map + (fun o : option (Z * Z) => + match o with + | Some x => snd x + | None => 0%Z + end) (map (eval_Zexpr_Z_tup_total v) l)) = + (map (eval_Zexpr_Z_total v) (map snd l)). Proof. induct l; intros. - reflexivity. - - simpl in *. invert H. invert H0. + - simpl in *. invert H. invert H0. cases a. simpl in *. unfold eval_Zexpr_Z_tup_total. unfold eval_Zexpr_Z_tup. simpl. - erewrite -> eval_Zexpr_partially_eval_Zexpr in H5,H4. - eapply eval_Zexpr_Z_eval_Zexpr in H5,H4. - rewrite H5,H4. simpl. f_equal. + erewrite -> eval_Zexpr_partially_eval_Zexpr in H4,H3. + eapply eval_Zexpr_Z_eval_Zexpr in H4, H3. + rewrite H4, H3. simpl. f_equal. eapply IHl. eauto. eauto. Qed. Lemma eval_Zexprlist_map_match_fst_map_eval_Zexpr_Z_tup_total : forall v l, - eval_Zexprlist $0 (map (partially_eval_Zexpr v) (map snd l)) - (map (eval_Zexpr_Z_total v) (map snd l)) -> - eval_Zexprlist $0 (map (partially_eval_Zexpr v) (map fst l)) - (map (eval_Zexpr_Z_total v) (map fst l)) -> - (map - (fun o : option (Z * Z) => - match o with - | Some x => fst x - | None => 0%Z - end) (map (eval_Zexpr_Z_tup_total v) l)) = - (map (eval_Zexpr_Z_total v) (map fst l)). + eval_Zexprlist $0 (map (partially_eval_Zexpr v) (map snd l)) + (map (eval_Zexpr_Z_total v) (map snd l)) -> + eval_Zexprlist $0 (map (partially_eval_Zexpr v) (map fst l)) + (map (eval_Zexpr_Z_total v) (map fst l)) -> + (map + (fun o : option (Z * Z) => + match o with + | Some x => fst x + | None => 0%Z + end) (map (eval_Zexpr_Z_tup_total v) l)) = + (map (eval_Zexpr_Z_total v) (map fst l)). Proof. induct l; intros. - reflexivity. - - simpl in *. invert H. invert H0. + - simpl in *. invert H. invert H0. cases a. simpl in *. unfold eval_Zexpr_Z_tup_total. unfold eval_Zexpr_Z_tup. simpl. - erewrite -> eval_Zexpr_partially_eval_Zexpr in H5,H4. - eapply eval_Zexpr_Z_eval_Zexpr in H5,H4. - rewrite H5,H4. simpl. f_equal. + erewrite -> eval_Zexpr_partially_eval_Zexpr in H4, H3. + eapply eval_Zexpr_Z_eval_Zexpr in H4, H3. + rewrite H4, H3. simpl. f_equal. eapply IHl. eauto. eauto. Qed. @@ -3493,9 +3351,9 @@ Qed. Lemma vars_of_reindexer_subseteq_map_partially_eval_Z_tup : forall l v, vars_of_reindexer l \subseteq dom v -> Forall (fun x => vars_of_Zexpr x = []) - (map fst (map (partially_eval_Z_tup v) l)) /\ + (map fst (map (partially_eval_Z_tup v) l)) /\ Forall (fun x => vars_of_Zexpr x = []) - (map snd (map (partially_eval_Z_tup v) l)). + (map snd (map (partially_eval_Z_tup v) l)). Proof. induct l; propositional. - econstructor. @@ -3533,4 +3391,3 @@ Proof. - simpl. econstructor. lia. eauto. Qed. - diff --git a/src/verified_lowering/stringify/.Makefile.coq.d b/src/verified_lowering/stringify/.Makefile.coq.d deleted file mode 100644 index 48e7448..0000000 --- a/src/verified_lowering/stringify/.Makefile.coq.d +++ /dev/null @@ -1,3 +0,0 @@ -Stringify.vo Stringify.glob Stringify.v.beautified Stringify.required_vo: Stringify.v ../../verified_scheduling/atl/Div.vo ../../verified_scheduling/codegen/IdentParsing.vo ../../verified_scheduling/codegen/NatToString.vo ../../verified_scheduling/codegen/IntToString.vo ../proof/ATLDeep.vo ../proof/Sexpr.vo ../proof/Zexpr.vo ../proof/Bexpr.vo -Stringify.vio: Stringify.v ../../verified_scheduling/atl/Div.vio ../../verified_scheduling/codegen/IdentParsing.vio ../../verified_scheduling/codegen/NatToString.vio ../../verified_scheduling/codegen/IntToString.vio ../proof/ATLDeep.vio ../proof/Sexpr.vio ../proof/Zexpr.vio ../proof/Bexpr.vio -Stringify.vos Stringify.vok Stringify.required_vos: Stringify.v ../../verified_scheduling/atl/Div.vos ../../verified_scheduling/codegen/IdentParsing.vos ../../verified_scheduling/codegen/NatToString.vos ../../verified_scheduling/codegen/IntToString.vos ../proof/ATLDeep.vos ../proof/Sexpr.vos ../proof/Zexpr.vos ../proof/Bexpr.vos diff --git a/src/verified_lowering/stringify/.MakefileLib.coq.d b/src/verified_lowering/stringify/.MakefileLib.coq.d deleted file mode 100644 index 97a56bf..0000000 --- a/src/verified_lowering/stringify/.MakefileLib.coq.d +++ /dev/null @@ -1,3 +0,0 @@ -GenLib.vo GenLib.glob GenLib.v.beautified GenLib.required_vo: GenLib.v ../../verified_scheduling/atl/ATL.vo ../../verified_scheduling/atl/Tactics.vo ../../verified_scheduling/atl/Common.vo ../../verified_scheduling/atl/CommonTactics.vo ../../verified_scheduling/atl/Div.vo ../../verified_scheduling/atl/Reshape.vo ../../verified_scheduling/atl/Map.vo ../../verified_scheduling/codegen/IdentParsing.vo ../../verified_scheduling/codegen/NatToString.vo ../../verified_scheduling/codegen/IntToString.vo ../../verified_scheduling/codegen/CodeGen.vo ../../verified_scheduling/codegen/Normalize.vo ../../verified_scheduling/codegen/CheckSafe.vo ../../examples/GatherScatter.vo ../../examples/Convolution.vo ../../examples/Im2col.vo ../../examples/Blur.vo ../../examples/TensorAdd.vo ../../examples/Matmul.vo ../inferpad/Reify.vo ../proof/Zexpr.vo ../proof/ATLDeep.vo ../proof/Bexpr.vo ../proof/Sexpr.vo ./Stringify.vo -GenLib.vio: GenLib.v ../../verified_scheduling/atl/ATL.vio ../../verified_scheduling/atl/Tactics.vio ../../verified_scheduling/atl/Common.vio ../../verified_scheduling/atl/CommonTactics.vio ../../verified_scheduling/atl/Div.vio ../../verified_scheduling/atl/Reshape.vio ../../verified_scheduling/atl/Map.vio ../../verified_scheduling/codegen/IdentParsing.vio ../../verified_scheduling/codegen/NatToString.vio ../../verified_scheduling/codegen/IntToString.vio ../../verified_scheduling/codegen/CodeGen.vio ../../verified_scheduling/codegen/Normalize.vio ../../verified_scheduling/codegen/CheckSafe.vio ../../examples/GatherScatter.vio ../../examples/Convolution.vio ../../examples/Im2col.vio ../../examples/Blur.vio ../../examples/TensorAdd.vio ../../examples/Matmul.vio ../inferpad/Reify.vio ../proof/Zexpr.vio ../proof/ATLDeep.vio ../proof/Bexpr.vio ../proof/Sexpr.vio ./Stringify.vio -GenLib.vos GenLib.vok GenLib.required_vos: GenLib.v ../../verified_scheduling/atl/ATL.vos ../../verified_scheduling/atl/Tactics.vos ../../verified_scheduling/atl/Common.vos ../../verified_scheduling/atl/CommonTactics.vos ../../verified_scheduling/atl/Div.vos ../../verified_scheduling/atl/Reshape.vos ../../verified_scheduling/atl/Map.vos ../../verified_scheduling/codegen/IdentParsing.vos ../../verified_scheduling/codegen/NatToString.vos ../../verified_scheduling/codegen/IntToString.vos ../../verified_scheduling/codegen/CodeGen.vos ../../verified_scheduling/codegen/Normalize.vos ../../verified_scheduling/codegen/CheckSafe.vos ../../examples/GatherScatter.vos ../../examples/Convolution.vos ../../examples/Im2col.vos ../../examples/Blur.vos ../../examples/TensorAdd.vos ../../examples/Matmul.vos ../inferpad/Reify.vos ../proof/Zexpr.vos ../proof/ATLDeep.vos ../proof/Bexpr.vos ../proof/Sexpr.vos ./Stringify.vos diff --git a/src/verified_lowering/stringify/.MakefileTest.coq.d b/src/verified_lowering/stringify/.MakefileTest.coq.d deleted file mode 100644 index 41fb41b..0000000 --- a/src/verified_lowering/stringify/.MakefileTest.coq.d +++ /dev/null @@ -1,3 +0,0 @@ -GenTest.vo GenTest.glob GenTest.v.beautified GenTest.required_vo: GenTest.v ../../verified_scheduling/atl/ATL.vo ../../verified_scheduling/atl/Common.vo ../../verified_scheduling/atl/CommonTactics.vo ../../verified_scheduling/atl/Div.vo ../../examples/GatherScatter.vo ../../examples/Convolution.vo ../../examples/Im2col.vo ../../examples/Blur.vo ../../examples/TensorAdd.vo ../../examples/Matmul.vo ../../verified_scheduling/codegen/IdentParsing.vo ../../verified_scheduling/codegen/NatToString.vo ../../verified_scheduling/codegen/IntToString.vo ../../verified_scheduling/codegen/CodeGen.vo -GenTest.vio: GenTest.v ../../verified_scheduling/atl/ATL.vio ../../verified_scheduling/atl/Common.vio ../../verified_scheduling/atl/CommonTactics.vio ../../verified_scheduling/atl/Div.vio ../../examples/GatherScatter.vio ../../examples/Convolution.vio ../../examples/Im2col.vio ../../examples/Blur.vio ../../examples/TensorAdd.vio ../../examples/Matmul.vio ../../verified_scheduling/codegen/IdentParsing.vio ../../verified_scheduling/codegen/NatToString.vio ../../verified_scheduling/codegen/IntToString.vio ../../verified_scheduling/codegen/CodeGen.vio -GenTest.vos GenTest.vok GenTest.required_vos: GenTest.v ../../verified_scheduling/atl/ATL.vos ../../verified_scheduling/atl/Common.vos ../../verified_scheduling/atl/CommonTactics.vos ../../verified_scheduling/atl/Div.vos ../../examples/GatherScatter.vos ../../examples/Convolution.vos ../../examples/Im2col.vos ../../examples/Blur.vos ../../examples/TensorAdd.vos ../../examples/Matmul.vos ../../verified_scheduling/codegen/IdentParsing.vos ../../verified_scheduling/codegen/NatToString.vos ../../verified_scheduling/codegen/IntToString.vos ../../verified_scheduling/codegen/CodeGen.vos diff --git a/src/verified_lowering/stringify/GenLib.v b/src/verified_lowering/stringify/GenLib.v index 963abc6..5480bf3 100644 --- a/src/verified_lowering/stringify/GenLib.v +++ b/src/verified_lowering/stringify/GenLib.v @@ -63,13 +63,13 @@ Ltac Llibfunc name context := let progty := type of prog in let tystr := type_to_str progty in let funcname := name in - let progstr := stringify_stmt ast in + let progstr := stringify_stmt ast in let progstr := eval simpl in progstr in let header := constr:([funcname++".h"; "#include "; ""; - "void "++funcname++"("++args++","++scalar++"*output);"]) in - + "void "++funcname++"("++args++","++scalar++"*output);"]) in + let func := constr:((funcname++".c"):: "#include ":: ("#include @"++funcname++".h@"):: @@ -80,7 +80,7 @@ Ltac Llibfunc name context := let ret' := constr:(app ("!!!"::header) ("!!!"::func)) in let ret := eval simpl in ret' in - ret. + ret. Goal forall A B C (m1 m2 : list (list R)), (0 < A)%Z -> @@ -90,7 +90,7 @@ Goal forall A B C (m1 m2 : list (list R)), consistent m2 (Z.to_nat B,(Z.to_nat C,tt)) -> matmul A B C m1 m2 = matmul_tiled (Z.to_nat A) (Z.to_nat B) (Z.to_nat C) m1 m2 4%Z. Proof. - intros. + intros. let s := Llibfunc constr:("matmul") constr:(($0 $+ ("m1", [ZLit A;ZLit B]) @@ -142,7 +142,7 @@ Goal forall (A B C D : nat) (m1 m2 : (list (list (list (list R))))), add (Z.of_nat A) (Z.of_nat B) (Z.of_nat C) (Z.of_nat D) m1 m2 = add_split A B C D m1 m2. Proof. - intros. + intros. let s := Llibfunc constr:("tensoradd") constr:(($0 @@ -151,7 +151,7 @@ Proof. $+ ("m2", [ZLit (Z.of_nat A);ZLit (Z.of_nat B);ZLit (Z.of_nat C);ZLit (Z.of_nat A)]))) in idtac_list s. -Abort. +Abort. Goal forall (A B C D : nat) (m1 m2 : (list (list (list (list R))))), 0 < A -> @@ -159,11 +159,11 @@ Goal forall (A B C D : nat) (m1 m2 : (list (list (list (list R))))), 0 < C -> 0 < D -> consistent m1 (A,(B,(C,(D,tt)))) -> - consistent m2 (A,(B,(C,(D,tt)))) -> + consistent m2 (A,(B,(C,(D,tt)))) -> add_split A B C D m1 m2 = add (Z.of_nat A) (Z.of_nat B) (Z.of_nat C) (Z.of_nat D) m1 m2. Proof. - intros. + intros. let s := Llibfunc constr:("tensoradd_split") constr:(($0 @@ -172,12 +172,12 @@ Proof. $+ ("m2", [ZLit (Z.of_nat A);ZLit (Z.of_nat B);ZLit (Z.of_nat C);ZLit (Z.of_nat A)]))) in idtac_list s. -Abort. +Abort. Goal forall (c : (list R)) n m, conv4 c n m = conv1 c n m. Proof. - intros. + intros. let s := Llibfunc constr:("conv4") constr:(($0 $+ ("c",[ZLit n]))) in idtac_list s. @@ -186,7 +186,7 @@ Abort. Goal forall (c : (list R)) n m, conv4 c n m = conv1 c n m. Proof. - intros. + intros. let s := Llibfunc constr:("conv4") constr:(($0 $+ ("c",[ZLit n]))) in idtac_list s. @@ -203,13 +203,13 @@ Proof. constr:(($0 $+ ("c",[ZLit n]))) in idtac_list s. Abort. - + Goal forall n m (l : list (list R)), Common.transpose ( (GEN [ j < 1 ] GEN [ i < n ] l _[i;j]) - <++> + <++> (GEN [ 1 <= j < m ] (GEN [ i < 1 ] l _[i;j]) @@ -235,7 +235,7 @@ Goal forall n m (l : list (list R)), (GEN [ j < 1 ] GEN [ i < Z.of_nat n ] l _[i;j]) - <++> + <++> (GEN [ 1 <= j < Z.of_nat m ] GEN [ i < Z.of_nat n ] l _[i;j]) @@ -259,9 +259,9 @@ Goal forall n m (v : list (list R)), v _[i;j]) <++> (GEN [ 1 <= i < Z.of_nat n ] - v _[i;j]) + v _[i;j]) ) - <++> + <++> (GEN [ 1 <= j < Z.of_nat m ] GEN [ i < Z.of_nat n ] v _[i;j] @@ -305,7 +305,7 @@ Goal forall n m (l : (list R)), <++> (GEN [ 1 <= i < Z.of_nat m ] (GEN [ j < Z.of_nat n ] - l _[j * Z.of_nat m + i])) + l _[j * Z.of_nat m + i])) )) = @nil _. @@ -326,7 +326,7 @@ Abort. constr:($0 $+ ("v",[ZLit (Z.of_nat N); ZLit (Z.of_nat M)])) in idtac_list s. Abort. - + Goal forall N M (v : list (list R)), 0 < N -> 0 < M -> @@ -343,13 +343,13 @@ Abort. Goal forall (n m : nat) (l : list (list R)), 0 < n -> 0 < m -> - consistent l (n, (m, tt)) -> + consistent l (n, (m, tt)) -> ((Truncr (Z.of_nat 64 * Z.of_nat (n - 1 - 1) // (Z.of_nat 64) - Z.of_nat (n - 1 - 1)) (flatten ( - (GEN [ Z.of_nat (n - 1 - 1) / Z.of_nat 64 <= i < + (GEN [ Z.of_nat (n - 1 - 1) / Z.of_nat 64 <= i < Z.of_nat (n - 1 - 1) // (Z.of_nat 64) ] transpose (Truncr @@ -386,7 +386,7 @@ Goal forall n m (l : list (list R)), 0 < n -> 0 < m -> consistent l (n,(m,tt)) -> - fusion_no_boundary n m l + fusion_no_boundary n m l = @nil _. Proof. intros. @@ -394,7 +394,7 @@ Proof. constr:($0 $+ ("l",[ZLit (Z.of_nat n); ZLit (Z.of_nat m)])) in idtac_list s. Abort. -Goal forall W RR (x w : list R), +Goal forall W RR (x w : list R), consistent w (Z.to_nat RR, tt) -> consistent x (Z.to_nat RR, tt) -> (0 < W)%Z -> @@ -404,9 +404,9 @@ Proof. intros. let s := Llibfunc constr:("gather") constr:($0 $+ ("x",[ZLit RR]) $+ ("w",[ ZLit RR])) in idtac_list s. -Abort. +Abort. -Goal forall W RR (x w : list R), +Goal forall W RR (x w : list R), consistent w (Z.to_nat RR, tt) -> consistent x (Z.to_nat RR, tt) -> (0 < W)%Z -> @@ -421,7 +421,7 @@ Abort. Goal forall A B K W RR (w : list (list R)) (x : list R), (0 < K)%Z -> (0 < W)%Z -> - (0 < RR)%Z -> + (0 < RR)%Z -> consistent w (A,(B,tt))-> consistent x (Z.to_nat K,tt) -> im2colminilifted K W RR w x = im2colmini K W RR w x. @@ -431,13 +431,13 @@ Proof. constr:($0 $+ ("x",[ZLit K]) $+ ("w",[ ZLit (Z.of_nat A); ZLit (Z.of_nat B)])) - in idtac_list s. -Abort. + in idtac_list s. +Abort. Goal forall A B K W RR (w : list (list R)) (x : list R), (0 < K)%Z -> (0 < W)%Z -> - (0 < RR)%Z -> + (0 < RR)%Z -> consistent w (A,(B,tt))-> consistent x (Z.to_nat K,tt) -> im2colminilifted K W RR w x = im2colmini K W RR w x. @@ -447,8 +447,8 @@ Proof. constr:($0 $+ ("x",[ZLit K]) $+ ("w",[ ZLit (Z.of_nat A); ZLit (Z.of_nat B)])) - in idtac_list s. - + in idtac_list s. + Abort. Goal forall n m (v : list (list R)), @@ -474,7 +474,7 @@ Proof. let s := Llibfunc constr:("blurisolate") constr:($0 $+ ("v",[ZLit (Z.of_nat n); ZLit (Z.of_nat m)])) - in idtac_list s. + in idtac_list s. Abort. Goal forall N M (v : list (list R)), @@ -487,5 +487,5 @@ Proof. let s := Llibfunc constr:("blurtwopart") constr:($0 $+ ("v",[ZLit (Z.of_nat N); ZLit (Z.of_nat M)])) - in idtac_list s. + in idtac_list s. Abort. diff --git a/src/verified_lowering/stringify/Stringify.v b/src/verified_lowering/stringify/Stringify.v index bdba753..c784d8a 100644 --- a/src/verified_lowering/stringify/Stringify.v +++ b/src/verified_lowering/stringify/Stringify.v @@ -11,6 +11,7 @@ From Stdlib Require Import Logic.FunctionalExtensionality. From Stdlib Require Import Lists.List. From Stdlib Require Import micromega.Lia. From Stdlib Require Import Reals.Rpower. +From Stdlib Require Import QArith. Import ListNotations. @@ -54,11 +55,11 @@ Ltac stringify_nat n := | (?x - ?y)%nat => let xstr := stringify_nat x in let ystr := stringify_nat y in - constr:((xstr++" - "++ystr)%string) + constr:(xstr ++ " - (" ++ ystr ++ ")") | (?x * ?y)%nat => let xstr := stringify_nat x in let ystr := stringify_nat y in - constr:((xstr++" * "++ystr)%string) + constr:("("++xstr ++ ") * (" ++ ystr ++")") | (?x //n ?y)%nat => let xstr := stringify_nat x in let ystr := stringify_nat y in @@ -85,6 +86,10 @@ Ltac stringify_nat n := let xstr := stringify_int x in let ystr := stringify_int y in constr:("((" ++ xstr ++ ") / (" ++ ystr ++"))") + | (?x // ?y)%Z => + let xstr := stringify_int x in + let ystr := stringify_int y in + constr:("((" ++ xstr ++ ") + (" ++ ystr ++ ") - 1 ) / (" ++ ystr ++")") | Z.opp ?x => let xstr := match x with @@ -156,7 +161,7 @@ Fixpoint flatten_list_Zexpr_helper (l : list (Zexpr * Zexpr)) | [(i,d)] => (i,d) | (i,d)::l' => let (i',d') := flatten_list_Zexpr_helper l' in - (ZPlus (ZTimes i d') i', ZTimes d d') + ((i * d' + i')%z, (d * d')%z) | _ => (ZLit 0%Z, ZLit 0%Z) end. @@ -196,10 +201,10 @@ Ltac stringify_Sstmt s := let ystr := stringify_Sstmt y in constr:((xstr ++ " - (" ++ ystr ++ ")")%string) | SLit ?r => match r with - | 0%R => constr:("0") - | 1%R => constr:("1") - | 2%R => constr:("2") - | 3%R => constr:("3") + | 0%Q => constr:("0") + | 1%Q => constr:("1") + | 2%Q => constr:("2") + | 3%Q => constr:("3") end end. @@ -254,4 +259,3 @@ Ltac stringify_stmt s := let str2 := stringify_stmt s2 in constr:((str1++str2)%list) end. - diff --git a/src/verified_scheduling/atl/Tactics.v b/src/verified_scheduling/atl/Tactics.v index dca4f09..c75d008 100644 --- a/src/verified_scheduling/atl/Tactics.v +++ b/src/verified_scheduling/atl/Tactics.v @@ -204,4 +204,3 @@ Ltac posnats := | H : context [Pos.succ (Pos.of_succ_nat _)] |- _ => rewrite <- SuccNat2Pos.inj_succ in H end. -