From 798981f70936c23c42790eebf8246fd9012b7855 Mon Sep 17 00:00:00 2001 From: Owen Conoly Date: Sun, 22 Mar 2026 23:01:11 -0400 Subject: [PATCH 1/5] change gitignore so that repo appears clean after running make --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) 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 From 2f81c158b5d7bba9648227af24f79b6e590fd248 Mon Sep 17 00:00:00 2001 From: Owen Conoly Date: Thu, 30 Oct 2025 14:18:34 -0400 Subject: [PATCH 2/5] various simplifications to deep ATL semantics: * change the type of size_of from ATLexpr -> list Zexpr -> Prop to ATLexpr -> valuation -> list nat -> Prop * remove unnecessary SizeOfSum hypotheses * get rid of "sh" parameter of eval_expr * have one Lbind case instead of two in eval_expr * remove unnecessary hypothesis of EvalSplit * no more Var in Sexprs; only use Get --- .../count_reshape/.Makefile.coq.d | 3 - src/verified_lowering/inferpad/InferPad.v | 223 +- src/verified_lowering/inferpad/Reify.v | 1 - src/verified_lowering/proof/ATLDeep.v | 1034 ++--- src/verified_lowering/proof/Constant.v | 18 + src/verified_lowering/proof/ContextsAgree.v | 296 +- src/verified_lowering/proof/Correct.v | 23 +- src/verified_lowering/proof/InferPad.v | 836 ---- src/verified_lowering/proof/Injective.v | 628 +-- .../proof/InterpretReindexer.v | 62 +- src/verified_lowering/proof/ListMisc.v | 43 +- src/verified_lowering/proof/LowerCorrect.v | 3762 ++++++----------- src/verified_lowering/proof/LowerExists.v | 2991 +++++-------- src/verified_lowering/proof/Meshgrid.v | 231 +- src/verified_lowering/proof/Pad.v | 3212 ++++++-------- src/verified_lowering/proof/Result.v | 8 +- .../proof/ResultToArrayDelta.v | 323 +- src/verified_lowering/proof/Sexpr.v | 70 +- src/verified_lowering/proof/VarGeneration.v | 2 +- .../proof/WellFormedAllocation.v | 581 +-- .../proof/WellFormedReindexer.v | 1212 ++---- src/verified_lowering/proof/Zexpr.v | 632 ++- .../stringify/.Makefile.coq.d | 3 - .../stringify/.MakefileLib.coq.d | 3 - src/verified_lowering/stringify/GenLib.v | 10 +- src/verified_lowering/stringify/Stringify.v | 16 +- src/verified_scheduling/atl/Tactics.v | 1 - 27 files changed, 5777 insertions(+), 10447 deletions(-) delete mode 100644 src/verified_lowering/count_reshape/.Makefile.coq.d delete mode 100644 src/verified_lowering/proof/InferPad.v delete mode 100644 src/verified_lowering/stringify/.Makefile.coq.d delete mode 100644 src/verified_lowering/stringify/.MakefileLib.coq.d 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..89e49b7 100644 --- a/src/verified_lowering/inferpad/InferPad.v +++ b/src/verified_lowering/inferpad/InferPad.v @@ -188,44 +188,55 @@ 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 + | _ => progress (cbv [Z.div div_ceil] (*fine to unfold these, since they had better only be applied to literals, anyway*); simpl) + | |- size_of _ _ _ => econstructor + | |- eval_Zexpr _ _ _ => econstructor; eauto + | |- _ = _ => reflexivity + | |- _ :: _ = _ :: _ => f_equal + | _ => lia + end. + +Ltac infer_size_of := + infer_size_of'. + 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 +244,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 +316,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 +326,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 +349,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 +361,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 +421,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 +433,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 +453,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 +465,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 +487,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 +549,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 +584,14 @@ end with infer_transpose left right offset1 offset2 := Goal forall v, Common.truncl 3 (GEN [ i < 10 ] (|[ 1 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 +712,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 +723,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 -> + 1 < n -> + 1 < 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). + assert (exists pad, has_pad $0 $0 ast pad). { eexists. infer_pad 0%Z 0%Z. } Abort. @@ -770,7 +776,7 @@ 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. @@ -782,7 +788,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,7 +804,7 @@ 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. @@ -814,7 +820,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. @@ -830,7 +836,6 @@ 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. - diff --git a/src/verified_lowering/inferpad/Reify.v b/src/verified_lowering/inferpad/Reify.v index 860ae98..d7d33e5 100644 --- a/src/verified_lowering/inferpad/Reify.v +++ b/src/verified_lowering/inferpad/Reify.v @@ -116,7 +116,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. diff --git a/src/verified_lowering/proof/ATLDeep.v b/src/verified_lowering/proof/ATLDeep.v index 6329a4b..a3c28d3 100644 --- a/src/verified_lowering/proof/ATLDeep.v +++ b/src/verified_lowering/proof/ATLDeep.v @@ -70,10 +70,10 @@ Fixpoint vars_of (e : ATLexpr) : set var := | Scalar _ => constant [] end. -Fixpoint sizeof (e : ATLexpr) := +Fixpoint sizeof (e : ATLexpr) : list Zexpr := 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 | Guard p body => @@ -87,56 +87,53 @@ Fixpoint sizeof (e : ATLexpr) := | n::rest => match sy with | m::rest' => - (ZPlus n m)::rest + (n + m)%z ::rest | _ => sx 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] + | a::b::rest => (a * b)%z :: rest + | [] => [] | s => s end | Split k e => match sizeof e with - | a::rest => (ZDivc a k)::k::rest - | [] => [ZLit 0] + | 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 | Truncr n e => match sizeof e with | m::rest => - (ZMinus m n)::rest - | [] => [ZLit 0] + (m - n)%z :: rest + | [] => [] end | Truncl n e => match sizeof e with - | m::rest => - (ZMinus m n)::rest - | [] => [ZLit 0] + | m :: rest => (m - n)%z :: rest + | [] => [] end | Padr n e => match sizeof e with - | m::rest => - (ZPlus m n)::rest - | [] => [ZLit 0] + | m :: rest => (m + n)%z :: rest + | [] => [] end | Padl n e => match sizeof e with - | m::rest => - (ZPlus m n)::rest - | [] => [ZLit 0] + | m :: rest => (m + n)%z :: rest + | [] => [] end | Scalar s => [] @@ -144,146 +141,171 @@ Fixpoint sizeof (e : ATLexpr) := Definition flat_sizeof e := match sizeof e with - | [] => ZLit 0 + | [] => | 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 : context) := 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)%z, (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)%z, (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)%z, + (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 +350,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 +377,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 +478,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 +496,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,8 +603,8 @@ 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. @@ -639,8 +632,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 -> @@ -716,22 +709,25 @@ 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. specialize (H0 []); simpl in *. @@ -739,58 +735,25 @@ Proof. 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 +770,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. + 2: { eapply IHn in H19. eassumption. eassumption. eassumption. + simpl. rewrite H2. 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. + 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_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. -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..bf68be2 100644 --- a/src/verified_lowering/proof/Constant.v +++ b/src/verified_lowering/proof/Constant.v @@ -429,3 +429,21 @@ 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. + +(*idk where to put this*) +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..860dee4 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,42 @@ 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. + +(*surely this is implied by some other eval_get lemmas, but i don't see how right now*) +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. + - (*definition of result_has_shape is mildly annoying *) + (*definition was like that because result induction principle was useless. + this is not a problem anymore, so would be nice to have a better definition of + result_has_shape*) + (*i suspect refactoring would be a huge amount of effort though*) + 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 +128,85 @@ 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. (* <- magic*) invs. clear H1. rewrite H3 in H2. + Fail invert1 H4. (*...*) + 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,20 +216,15 @@ 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. @@ -248,14 +232,12 @@ Proof. - 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. + - 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, @@ -267,11 +249,10 @@ Lemma contexts_agree_add_heap : forall ec st h sh a val p, Proof. unfold contexts_agree. propositional. - eapply H in H3. invs. clear H. - cases (x ==v p). subst. eapply lookup_Some_dom in H3. sets. + 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,11 +268,10 @@ 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. @@ -357,47 +337,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. + 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 +372,41 @@ 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 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. + 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. + - 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..33ded6e 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,11 +85,11 @@ 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. @@ -217,13 +196,20 @@ Definition index_to_partial_function | None => 0%Z end) evaled_list_index)) else None. +Print shape_to_vars. +Print shape_to_index. +Print partially_eval_Z_tup. +Print partially_eval_Zexpr. +Print index_to_partial_function. Definition partial_interpret_reindexer (reindexer : list (Zexpr * Zexpr) -> list (Zexpr * Zexpr)) (sh : list Z) (v : valuation) : list Z -> option Z := let vars := shape_to_vars sh in let result_index := shape_to_index sh vars in + (*[(?, d1), (??, d2), ...]*) let full_index := reindexer result_index in + (*why would v have these ?? strings in its domain??*) let evaled_index := map (partially_eval_Z_tup v) full_index in index_to_partial_function evaled_index vars. @@ -233,15 +219,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 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. @@ -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, @@ -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)) := @@ -1165,14 +1152,14 @@ 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. @@ -1312,4 +1299,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..6c4a7e9 100644 --- a/src/verified_lowering/proof/LowerCorrect.v +++ b/src/verified_lowering/proof/LowerCorrect.v @@ -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. + repeat decomp_index. 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,34 +429,28 @@ 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. auto. auto. auto. @@ -534,15 +458,15 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply well_formed_reindexer_eval0. eassumption. eapply Henv. eauto. eauto. - unfold not. intros. - eapply shape_to_vars_contains_substring in H6. + 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,34 +574,28 @@ 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. auto. auto. auto. @@ -699,13 +604,13 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply Henv. 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. @@ -861,13 +747,13 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply Henv. 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,28 @@ 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. @@ -1022,124 +890,93 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply Henv. 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. } + { cbv [eval_Zexpr_Z_total] in *. rewrite Hhi, Hlo in *. lia. } - eapply IHeval_expr1 with (asn:=Reduce) in H18; clear IHeval_expr1. + 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. - - 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'. lia. + + 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 +985,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 *. + 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 *. + simpl in *. rewrite Hlo, Hhi in *. invs'. + 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. } - - assert (vars_of_Zexpr lo ++/ [] = [] /\ - vars_of_Zexpr hi = [] /\ constant_nonneg_bounds body). - { rewrite H7. propositional. } + 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 +1078,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. @@ -1304,9 +1093,7 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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; @@ -1314,15 +1101,11 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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 +1117,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 +1134,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,15 +1165,15 @@ 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 @@ -1421,293 +1191,246 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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. - - 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. + - (* 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. } + + 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,138 +1439,69 @@ 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)). + 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. unfold tensor_to_array_delta at 1. - + erewrite array_add_tensor_to_array_delta_concat; auto. unfold tensor_to_array_delta. 2: { eapply cap_empty_exclusion. intros. @@ -1855,50 +1509,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. + rewrite <- H25. simpl. rewrite nth_error_app1. auto. @@ -1907,180 +1545,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 + eval_Zexpr_Z_total $0 dim1)%Z; try lia. - eauto. lia. - - invs. + cases (Z.pos p0 + Z.of_nat (length l1))%Z; try lia. + eauto. + + 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. + 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. } + 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 +1923,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 +1958,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 +1989,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 +2010,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 +2022,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. @@ -2519,7 +2038,7 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply filter_In. propositional. repeat decomp_goal_index. propositional. repeat decomp_goal_index. propositional. - rewrite <- H11. + rewrite <- H5. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. @@ -2533,7 +2052,7 @@ 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. @@ -2541,7 +2060,7 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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 +2068,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 +2100,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 +2121,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 +2133,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. @@ -2647,7 +2149,7 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eapply filter_In. propositional. repeat decomp_goal_index. propositional. repeat decomp_goal_index. propositional. - rewrite <- H10. + rewrite <- H4. erewrite result_lookup_Z_option_transpose. reflexivity. lia. lia. eauto. @@ -2661,7 +2163,7 @@ 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. @@ -2671,11 +2173,8 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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 +2183,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. @@ -2700,30 +2198,17 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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 +2220,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 +2239,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 + 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 +2291,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. @@ -2829,73 +2305,43 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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. } + - (* 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 +2353,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. + 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 +2424,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,62 +2469,56 @@ 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. + invert Halloc. invs'. eapply lookup_Some_dom in H15. sets. eauto. } } @@ -3101,79 +2526,69 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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. @@ -3184,24 +2599,17 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). unfold result_shape_Z, shape_to_index, shape_to_vars in Heq1. 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)). + 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. + 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 +2624,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 +2694,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,34 +2733,29 @@ 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. } @@ -3400,8 +2763,8 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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 +2774,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 +2794,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 +2806,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 (result_has_shape (V l) (m::sh0)) as Hsh. + { eauto using size_of_eval_expr_result_has_shape. } - 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. + 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 +2860,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. 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 +2922,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,94 +2969,82 @@ 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. } @@ -3744,63 +3052,44 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). (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,114 +3101,90 @@ 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. + 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. 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. + unfold lookup_total. rewrite H8. split. 2: auto. f_equal. f_equal. invs. subst. @@ -3930,40 +3195,37 @@ 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. @@ -3971,11 +3233,10 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). eauto. eassumption. apply Henv. - eapply vars_of_Zexpr_empty_eq_zexpr_eval_Zexpr_Z_total. eauto. - auto. auto. auto. auto. lia. lia. lia. + 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,86 +3244,36 @@ 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. simpl in IHeval_expr. @@ -4072,25 +3283,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 +3312,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 +3330,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)). + 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. @@ -4176,19 +3362,10 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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 +3377,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 +3388,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,16 +3402,15 @@ 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. @@ -4243,116 +3419,63 @@ eapply H6 with (st:=st) (st':=st') (asn:=asm). 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. simpl in IHeval_expr. @@ -4366,21 +3489,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 +3518,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)). + 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 +3566,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,87 +3593,55 @@ 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. + + 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. - - 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. + apply Hinj. + 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. @@ -4627,7 +3680,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,8 +3690,8 @@ 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 *. @@ -4651,7 +3703,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,7 +3714,7 @@ 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. eapply eval_Sexpr_eval_Sstmt in H. @@ -4677,7 +3728,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 +3740,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,8 +3784,8 @@ 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 *. @@ -4744,7 +3797,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 +3808,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 +3837,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 @@ -4874,8 +3927,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 +3949,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 +3968,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 +3983,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..bd5f1b6 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,15 +148,16 @@ 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 -> + (* reindexer is well-formed *) well_formed_reindexer reindexer v r st h p asn -> (* allocation is well-formed *) @@ -178,80 +165,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. 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 +232,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 +343,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 +508,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 +673,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,35 +835,32 @@ 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. } @@ -1289,10 +882,9 @@ Proof. 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,20 +892,20 @@ 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. } 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. @@ -1322,22 +914,17 @@ Proof. 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. } + 2: { apply H12; lia. } - assert (constant_nonneg_bounds (Sum i (lo + | 1 |)%z hi body)). - { econstructor. simpl. rewrite H7. sets. propositional. } - 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,22 +932,22 @@ 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. @@ -1370,25 +957,21 @@ Proof. 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 +979,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 +1001,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. @@ -1441,14 +1025,10 @@ Proof. 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 +1037,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 +1047,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. } - - 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. } - - 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 sz1; simpl in *. + + invs. invert Hpad. eq_size_of. pose proof H16 as Heval1. + + 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. } - 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. + 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. } - 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. } + 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 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. } - 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. + 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'. - 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; + 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. + + 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 +1446,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 +1546,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 +1557,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 +1581,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,32 +1594,25 @@ 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. @@ -2296,36 +1623,36 @@ sets. 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. + 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,14 +1670,12 @@ 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. lia. lia. 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. @@ -2365,170 +1690,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. @@ -2558,7 +1858,6 @@ sets. 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. @@ -2579,26 +1878,26 @@ sets. 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,67 +1905,67 @@ 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. @@ -2677,25 +1976,25 @@ sets. 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 +2003,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..59a95b9 100644 --- a/src/verified_lowering/proof/Meshgrid.v +++ b/src/verified_lowering/proof/Meshgrid.v @@ -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, @@ -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. @@ -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. @@ -905,19 +849,14 @@ Definition is_None {X} (x : option X) := end. Lemma filter_pad_r_empty : forall k l0 x, - (0 <= k)%Z -> + (0 <= k) -> 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,11 +864,9 @@ 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. @@ -947,12 +884,8 @@ 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) -> + (0 <= k) -> filter (fun x1 : list Z => negb @@ -960,21 +893,15 @@ 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. @@ -984,19 +911,16 @@ 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. - replace (Z.to_nat k + length x - Z.to_nat k) with (length x) by lia. + 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. @@ -1019,14 +943,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 +968,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 +978,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 +991,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 +1001,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 +1010,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 +1138,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 +1157,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)))). + cases ((repeat (gen_pad l0) k)). + auto. - + cases (Z.to_nat (eval_Zexpr_Z_total $0 k)). invert Heq. invert Heq. + + 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. @@ -1354,9 +1265,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)) = @@ -1434,15 +1345,15 @@ 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. erewrite <- result_lookup_Z_option_flatten in H; eauto; try lia. @@ -1455,7 +1366,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 +1378,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. diff --git a/src/verified_lowering/proof/Pad.v b/src/verified_lowering/proof/Pad.v index 0d6900e..52542cd 100644 --- a/src/verified_lowering/proof/Pad.v +++ b/src/verified_lowering/proof/Pad.v @@ -18,6 +18,7 @@ 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 := @@ -30,7 +31,7 @@ Inductive pad_type := 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. (* @@ -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) @@ -365,15 +365,13 @@ Proof. 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. @@ -770,25 +766,19 @@ 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. @@ -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)). + cases n0. + lia. - + cases (Z.to_nat (eval_Zexpr_Z_total $0 m0)). + + 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,105 +1218,70 @@ 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. @@ -1434,10 +1295,11 @@ 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'. @@ -1445,30 +1307,24 @@ Proof. 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,7 +1350,7 @@ 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. @@ -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,10 +1461,10 @@ 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. @@ -1638,10 +1490,10 @@ 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. eapply result_has_shape_forall in H1. @@ -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. @@ -1682,11 +1534,9 @@ Proof. 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,9 +1588,7 @@ 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 + 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. @@ -1749,10 +1596,10 @@ 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_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. 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). @@ -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. @@ -2044,18 +1890,18 @@ Proof. rewrite <- (rev_involutive (skipn _ (r0::l))). 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. @@ -2091,25 +1937,21 @@ Proof. } { (* 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,20 +1976,19 @@ 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 <- 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 <- firstn_rev. @@ -2155,7 +1996,7 @@ Proof. 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,79 +2050,74 @@ 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. + 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. @@ -2291,14 +2125,14 @@ Proof. 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,7 +2166,7 @@ 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 rev_involutive. repeat rewrite mul_sub_distr_l. @@ -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,7 +2212,7 @@ 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. + unfold not. intros. eapply mod_0_iff_ceil_eq_floor_0 in H7. lia. lia. lia. } split. auto. @@ -2386,10 +2220,10 @@ Proof. 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,7 +2231,7 @@ 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. @@ -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,39 +2284,39 @@ 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) - @@ -2501,36 +2335,36 @@ 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). @@ -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. + rewrite <- H14. erewrite <- result_has_shape_filter_until_0. eauto. - rewrite <- H20. + 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,13 +2619,13 @@ 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 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 @@ -2859,14 +2691,14 @@ Proof. rewrite skipn_app. rewrite firstn_app. rewrite length_skipn. rewrite length_rev. rewrite length_skipn. rewrite length_rev. - simpl length. rewrite Hlen. + 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. } @@ -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 (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. @@ -2989,10 +2818,10 @@ Proof. 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.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. } @@ -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. } @@ -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). @@ -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). @@ -3239,13 +3068,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. - erewrite <- H20. eapply relate_pads_filter_until_0. + erewrite <- H14. eapply relate_pads_filter_until_0. eauto. eauto. lia. } rewrite <- Heq2. @@ -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. @@ -3306,13 +3135,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. 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. + + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz. + intros. apply H18. lia. - 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. - - auto. - - 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 Hhiz. + intros. apply H20. 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. + eq_size_of. intros. apply H21. lia. 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. 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. + 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,85 +3319,47 @@ Proof. { simpl. split. auto. rewrite firstn_app. rewrite length_rev. cases (rr - length l). - - simpl. rewrite app_nil_r. - 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. + - 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 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. } @@ -3610,34 +3367,22 @@ 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. } + 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. eapply H21. lia. lia. eauto. eauto. eauto. eauto. eauto. - eapply constant_nonneg_bounds_size_of_eval_expr_result_has_shape; - eauto. econstructor. - + 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. } + 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 result_shape_gen_length in H5. - 2: { simpl. rewrite H. reflexivity. } - 2: { rewrite H0. reflexivity. } - rewrite firstn_all2 in H18. + 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. - - rewrite eval_Zexpr_Z_total_add_distr; eauto. - unfold eval_Zexpr_Z_total at 3. simpl. 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 *. - 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 *. 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,60 +3678,51 @@ 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. 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. + rewrite <- Hsize'. + apply result_has_shape_gen_pad. - repeat rewrite <- map_cons. - rewrite Hsh''. + 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. @@ -4149,61 +3730,28 @@ Proof. + eq_eval_B. discriminate. + simpl in *. eapply IHeval_expr; eauto. - - (* LET SCALAR *) + - (* LET *) invert Hsize. eq_size_of. invert Hpad. simpl in *. invs. eq_size_of. - eapply IHeval_expr1 in H12. - 2: { eauto. } - 2: { econstructor. } + 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 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 *) - 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. } - 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. @@ -4213,22 +3761,20 @@ Proof. pose proof Hsh as Hsh''. eapply result_has_shape_app_l in Hsh''. 2: { reflexivity. } - pose proof H1. pose proof H2. - - 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. + pose proof Hsize1 as Hsh1. pose proof Hsize2 as Hsh2. + + 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. @@ -4236,142 +3782,150 @@ Proof. 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. + 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. eauto. eauto. - + + rewrite skipn_app. rewrite firstn_app. rewrite length_skipn. rewrite length_rev. 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,48 +3934,40 @@ 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. @@ -4438,38 +3984,38 @@ Proof. 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. + (* rewrite filter_until_cons in * by lia. *) + 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. 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. + 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. @@ -4487,8 +4033,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 +4075,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. @@ -4561,8 +4106,7 @@ Proof. eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. econstructor; eauto. rewrite length_firstn. rewrite length_skipn. - rewrite length_rev. simpl. reflexivity. } - pose proof H10. eapply Forall_rev in H4. + rewrite length_rev. simpl. reflexivity. } erewrite (forall_get_col_relate_pads_gen_pad (rev (firstn r (skipn y (rev (r0 :: l)))))). 4: { eapply forall_result_has_shape. @@ -4571,7 +4115,7 @@ 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. @@ -4584,7 +4128,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 +4140,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 +4153,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 +4167,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 +4178,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 +4187,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 +4209,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 +4252,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 +4277,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 +4298,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 +4325,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 +4345,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,59 +4372,50 @@ 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. - - pose proof Hconst' as Hsh'. + eapply size_of_includes in Hsize'. 2: apply empty_includes. + eapply size_of_eval_expr_result_has_shape in Hsize'; eauto. + + 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. @@ -4942,38 +4432,38 @@ Proof. 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. 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 +4510,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 +4518,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 +4585,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 +4593,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 +4649,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 +4658,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 +4767,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. } + 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 *. - 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. 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 (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 H7. eapply IHeval_expr in H13; eauto. - simpl in H13. invs. + 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 +4889,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 +5005,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. 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 +5034,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..1345015 100644 --- a/src/verified_lowering/proof/Sexpr.v +++ b/src/verified_lowering/proof/Sexpr.v @@ -22,7 +22,6 @@ 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) @@ -42,11 +41,11 @@ Inductive Sstmt := 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 +54,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,47 +73,38 @@ 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 r). +About flatten_shape_index. Inductive eval_Sstmt : valuation -> stack -> heap -> Sstmt -> R -> Prop := | EvalSVar : forall v st h x r, @@ -151,4 +138,3 @@ Inductive eval_Sstmt : eval_Sstmt v st h (SSub s1 s2) r | EvalSLit: forall v st h r, eval_Sstmt v st h (SLit r) 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..7d14948 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 @@ -268,10 +250,10 @@ vars_of_reindexer (reindexer []) \subseteq dom v -> (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 + (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. @@ -357,8 +339,8 @@ Proof. 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,25 @@ 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. + 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 H6 as Hinj; clear H6. erewrite result_has_shape_result_shape_Z in Hinj by eauto. *) 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 +615,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 +626,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 +633,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 +645,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 +662,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 +683,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 +709,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. @@ -798,10 +742,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 H6 as Hinj; clear H6. by eauto. *) erewrite result_has_shape_result_shape_Z in Hinj. @@ -813,7 +756,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 +769,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 +797,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 +808,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 +829,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 +843,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 +857,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 *. @@ -958,34 +887,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 +911,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 +924,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 +937,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. @@ -1097,10 +1000,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 +1021,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 +1047,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. + 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 +1070,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. 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 +1133,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 +1143,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. 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 +1169,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 +1190,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,15 +1202,10 @@ 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 *. @@ -1363,16 +1228,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 +1277,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 +1313,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 +1340,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 +1354,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 +1372,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. @@ -1607,31 +1442,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 +1468,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 +1485,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 +1496,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 +1508,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 +1516,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 +1533,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 +1560,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 +1581,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 +1597,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 +1608,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. @@ -1863,10 +1637,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 +1647,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 +1660,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 +1684,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 +1697,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 +1718,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. @@ -2021,7 +1773,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 +1792,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 +1804,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 +1816,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 +1830,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 *. @@ -2102,7 +1844,7 @@ Proof. 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. + 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 +1852,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 +1893,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 +1912,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 +1931,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 +1949,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 +1964,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 +1995,15 @@ 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 <= Z.of_nat m)%Z -> + (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 +2011,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 Hmnonneg 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,18 +2024,17 @@ 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. erewrite <- eq_Z_tuple_index_list_cons. propositional. @@ -2343,55 +2045,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 +2087,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,19 +2098,18 @@ 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 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. @@ -2441,64 +2120,45 @@ Proof. 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 +2169,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 +2182,57 @@ 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 *. 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. @@ -2638,20 +2284,18 @@ Proof. 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)) -> + 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 @@ -2659,7 +2303,7 @@ Lemma well_formed_reindexer_shift_top_dim_reindexer : (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. + (result_shape_Z x1) (v $+ (i, loz))) x1))) o a. Proof. intros. decomp_well_formed_reindexer. unfold well_formed_reindexer. @@ -2668,8 +2312,7 @@ Proof. 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 *. @@ -2889,8 +2532,7 @@ 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 H15. @@ -2943,25 +2585,24 @@ partial_injective (partial_interpret_reindexer reindexer (result_shape_Z (V r3)) Qed. Lemma well_formed_reindexer_eval0 : - forall x1 xs1 reindexer v i lo hi st h o a arr, + 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. @@ -2972,8 +2613,8 @@ Proof. - 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. @@ -3052,23 +2693,13 @@ 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 +2709,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. @@ -3115,23 +2746,14 @@ Proof. 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 +2772,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 +2787,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. + erewrite (eval_Zexpr_vars_empty dim2) by eassumption. rewrite app_no_dups_empty_r. sets. - 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 @@ -3216,8 +2834,8 @@ Proof. 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,13 +2850,13 @@ 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. + erewrite (eval_Zexpr_vars_empty n) by eassumption. repeat rewrite app_no_dups_empty_r. sets. - eapply nondestructivity_concat_r__; eauto. @@ -3246,11 +2864,7 @@ 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 +2888,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. 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 *. @@ -3304,19 +2918,13 @@ Proof. 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 +2938,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 +2945,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,12 +2956,15 @@ 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. + 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, @@ -3394,16 +3003,12 @@ Proof. 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,14 +3018,14 @@ 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. erewrite <- eq_Z_tuple_index_list_cons. propositional. @@ -3435,14 +3040,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..9b847f4 100644 --- a/src/verified_lowering/proof/Zexpr.v +++ b/src/verified_lowering/proof/Zexpr.v @@ -182,54 +182,28 @@ Definition eq_zexpr ez1 ez2 := Fixpoint flatten_shape_index (sh : list Zexpr) (i : list Zexpr) := match sh with - | n::m::ns => + | n :: sh' => match i with - | x::xs => - let stride := fold_left ZTimes ns m in - ZPlus (ZTimes x stride) (flatten_shape_index (m::ns) xs) + | x :: xs => + let stride := fold_left ZTimes sh' (ZLit 1) in + ZPlus (ZTimes x stride) (flatten_shape_index sh' xs) | _ => ZLit 0%Z end - | [n] => - match i with - | [z] => z - | _ => 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. - -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. +Notation eval_Zexprlist v := (Forall2 (eval_Zexpr v)). -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 := repeat match goal with @@ -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, @@ -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. @@ -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. 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 : @@ -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)), @@ -1548,6 +1495,17 @@ Proof. apply app_no_dups_assoc. Qed. +Lemma eq_zexpr_mul_comm : forall x1 x2, + eq_zexpr (x1 * x2)%z (x2 * x1)%z. +Proof. + intros. cbv [eq_zexpr]. simpl. split. + - intros. split; invert 1. + + eassert (_ * _ = _)%Z as ->. 2: eauto. lia. + + eassert (_ * _ = _)%Z as ->. 2: eauto. lia. + - Abort. +(*not true... why does vars_of_Zexpr not return a set? + and isn't the condition about having the same variables redundant anyway?*) + Lemma eq_zexpr_mul_assoc : forall x1 x2 x3, eq_zexpr (x1 * x2 * x3)%z (x1 * (x2 * x3))%z. Proof. @@ -1623,14 +1581,16 @@ 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. + 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 : @@ -1640,37 +1600,36 @@ Proof. propositional; simpl; auto. Qed. +(*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 + end. + 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 *; invs'; 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 +1649,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; @@ -1790,16 +1749,8 @@ 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. + 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 : @@ -1809,7 +1760,6 @@ 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. @@ -1832,7 +1782,7 @@ Lemma eq_Z_tuple_index_list_sym : forall 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 +1813,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 +1876,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 +1895,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 => - match i with - | x::xs => - let stride := fold_left Z.mul ns m in - ((x * stride) + (flatten (m::ns) xs))%Z - | _ => 0%Z - end - | [n] => + | n :: sh' => match i with - | [z] => z - | _ => 0%Z + | x :: xs => + let stride := fold_left Z.mul sh' 1%Z in + ((x * stride) + (flatten sh' xs))%Z + | [] => 0%Z end - | _ => 0%Z + | [] => 0%Z end. Lemma eval_Zexpr_Z_flatten_index_ZLit_flatten : forall sh args v, @@ -2041,23 +1929,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 : @@ -2076,19 +1952,14 @@ Qed. Lemma subst_var_in_Zexpr_flatten_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, @@ -2136,7 +2007,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 +2058,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 : @@ -2362,11 +2229,11 @@ Proof. reflexivity. Qed. -Fixpoint vars_of_reindexer cont := +Fixpoint vars_of_reindexer (cont : list (Zexpr * Zexpr)) := 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,8 +2242,8 @@ 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. @@ -2452,7 +2319,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 +2328,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 +2399,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 +2455,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. @@ -2703,6 +2558,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,13 +2597,12 @@ 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. + 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, @@ -2745,10 +2622,8 @@ Lemma eval_Zexprlist_includes_valuation : forall v l lz v', 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 := @@ -2795,7 +2670,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, @@ -3003,7 +2878,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 +2930,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. @@ -3192,8 +3067,8 @@ 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. @@ -3207,7 +3082,7 @@ Proof. 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 : @@ -3395,51 +3270,51 @@ 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. 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 +3368,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 +3408,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/GenLib.v b/src/verified_lowering/stringify/GenLib.v index 963abc6..e2ca8c8 100644 --- a/src/verified_lowering/stringify/GenLib.v +++ b/src/verified_lowering/stringify/GenLib.v @@ -37,7 +37,7 @@ Ltac Llibfunc name context := | String _ ?s' => s' | EmptyString => EmptyString end in - let ast := R in + let ast := R in let _ := match goal with |- _ => intros end in let ast := constr:(lower ast (fun i : list (Zexpr * Zexpr) => i) "output" @@ -63,12 +63,12 @@ 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 ":: @@ -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]) diff --git a/src/verified_lowering/stringify/Stringify.v b/src/verified_lowering/stringify/Stringify.v index bdba753..9384ad0 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. @@ -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. - From 2cca39461f528ed30ad8db47141a86c91dbd6b78 Mon Sep 17 00:00:00 2001 From: Owen Conoly Date: Thu, 30 Oct 2025 14:22:57 -0400 Subject: [PATCH 3/5] stringification bug --- src/verified_lowering/stringify/.MakefileTest.coq.d | 3 --- src/verified_lowering/stringify/Stringify.v | 4 ++-- 2 files changed, 2 insertions(+), 5 deletions(-) delete mode 100644 src/verified_lowering/stringify/.MakefileTest.coq.d 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/Stringify.v b/src/verified_lowering/stringify/Stringify.v index 9384ad0..c784d8a 100644 --- a/src/verified_lowering/stringify/Stringify.v +++ b/src/verified_lowering/stringify/Stringify.v @@ -55,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 From febfb30cbb447a5a7406465ec1a9a49b59c33c80 Mon Sep 17 00:00:00 2001 From: Owen Conoly Date: Wed, 4 Feb 2026 01:20:13 -0500 Subject: [PATCH 4/5] replace R with Q in syntax trees --- src/verified_lowering/inferpad/Reify.v | 5 +++-- src/verified_lowering/proof/Sexpr.v | 11 ++++++----- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/verified_lowering/inferpad/Reify.v b/src/verified_lowering/inferpad/Reify.v index d7d33e5..b3d3f5f 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. @@ -95,8 +96,8 @@ Goal forall (i j : Z) (s : string) (v : list (list R)), True. 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 1%Q) | (?a * ?b)%R => let la := reify_R a in let lb := reify_R b in diff --git a/src/verified_lowering/proof/Sexpr.v b/src/verified_lowering/proof/Sexpr.v index 1345015..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. @@ -27,7 +28,7 @@ Inductive Sexpr := | Add (x y : Sexpr) | Div (x y : Sexpr) | Sub (x y : Sexpr) -| Lit (r : R). +| Lit (r : Q). Inductive Sstmt := | SVar (v : string) @@ -36,7 +37,7 @@ 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 @@ -103,8 +104,8 @@ Inductive eval_Sexpr : 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 v ec (Lit r) (SS r). -About flatten_shape_index. + eval_Sexpr v ec (Lit r) (SS (Q2R r)). + Inductive eval_Sstmt : valuation -> stack -> heap -> Sstmt -> R -> Prop := | EvalSVar : forall v st h x r, @@ -137,4 +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). From 2ed8fbc8a9fa3d3e1c9ef6d8af3673811e28eebb Mon Sep 17 00:00:00 2001 From: Owen Conoly Date: Tue, 4 Nov 2025 03:44:31 -0500 Subject: [PATCH 5/5] verified reification --- src/examples/Blur.v | 651 ++++---- src/examples/Matmul.v | 76 +- src/examples/TensorAdd.v | 23 +- src/verified_lowering/count_reshape/Count.v | 240 ++- src/verified_lowering/inferpad/ATLPhoas.v | 1447 +++++++++++++++++ src/verified_lowering/inferpad/ATLSpecs.v | 336 ++++ src/verified_lowering/inferpad/InferPad.v | 495 +++--- src/verified_lowering/inferpad/Makefile | 2 +- src/verified_lowering/inferpad/NatToString.v | 168 ++ src/verified_lowering/inferpad/PhoasToDeep.v | 795 +++++++++ src/verified_lowering/inferpad/Reify.v | 698 +++++--- .../inferpad/ReifyExamples.v | 579 ++++--- .../inferpad/TensorToResult.v | 1009 ++++++++++++ src/verified_lowering/proof/ATLDeep.v | 178 +- src/verified_lowering/proof/Constant.v | 9 +- src/verified_lowering/proof/ContextsAgree.v | 57 +- .../proof/InterpretReindexer.v | 33 +- src/verified_lowering/proof/ListMisc.v | 197 ++- src/verified_lowering/proof/LowerCorrect.v | 10 +- src/verified_lowering/proof/LowerExists.v | 11 +- src/verified_lowering/proof/Pad.v | 235 ++- src/verified_lowering/proof/Range.v | 133 +- src/verified_lowering/proof/Result.v | 380 +++-- .../proof/ResultToArrayDelta.v | 65 +- src/verified_lowering/proof/VarGeneration.v | 17 +- .../proof/WellFormedAllocation.v | 2 +- .../proof/WellFormedReindexer.v | 48 +- src/verified_lowering/proof/Zexpr.v | 168 +- src/verified_lowering/stringify/GenLib.v | 541 +++--- src/verified_lowering/stringify/GenTest.v | 267 ++- src/verified_lowering/stringify/Stringify.v | 228 +-- src/verified_scheduling/atl/ATL.v | 4 +- src/verified_scheduling/atl/Common.v | 215 +-- src/verified_scheduling/atl/GenPushout.v | 1 - src/verified_scheduling/atl/Map.v | 13 +- src/verified_scheduling/atl/PairElimination.v | 1 - src/verified_scheduling/codegen/CheckSafe.v | 15 +- 37 files changed, 6635 insertions(+), 2712 deletions(-) create mode 100644 src/verified_lowering/inferpad/ATLPhoas.v create mode 100644 src/verified_lowering/inferpad/ATLSpecs.v create mode 100644 src/verified_lowering/inferpad/NatToString.v create mode 100644 src/verified_lowering/inferpad/PhoasToDeep.v create mode 100644 src/verified_lowering/inferpad/TensorToResult.v diff --git a/src/examples/Blur.v b/src/examples/Blur.v index 5d4296a..1f205b4 100644 --- a/src/examples/Blur.v +++ b/src/examples/Blur.v @@ -18,31 +18,30 @@ Definition pipeline {X} `{TensorElem X} Hint Unfold pipeline : examples. Section Pipeline. - Variables (f : list R) (n : Z) (m k : nat). + Variables (f : list R) (n : Z) (m k : Z). Derive pipeline_sched SuchThat - (consistent f (m,tt) -> + (consistent f (Z.to_nat m,tt) -> (1 < n)%Z -> - 0 < k -> + (0 < k)%Z -> pipeline n f = pipeline_sched) As pipeline_correct. Proof. reschedule. inline let_binding. - + rw @get_gen_some. rw @get_gen_some. - - wrapid^ @flatten_trunc_tile_id around (GEN [ _ < _ ] _) with k. + + wrapid^ @flatten_trunc_tile_id around (GEN [ _ < _ ] _) with (Z.to_nat k). inline tile. + rewrite Z2Nat.id by lia. rw<- @gp_iverson. - rw @ll_get. - rw @ll_iverson_. rw @get_gen_some. - rw @lbind_helper for (fun x => |[ _ * Z.of_nat k + _ |[ _ * k + _ v _[ y-1; x] <+> - (|[ x + 1 blurx' _[ y+1; x] <+> blurx' _[ y+2; x]). Hint Unfold blurtwostage : examples. Section two_to_part. - Variables (X : Set) (H : TensorElem X) (N M : nat) + Variables (X : Set) (H : TensorElem X) (N M : Z) (v : list (list X)) (s : @shape X _). Derive blurtwostage_partition SuchThat (2 < M -> 0 < N -> - consistent v (N,(M,s)) -> - blurtwostage N M v = blurtwostage_partition) As twostagepart. + consistent v (Z.to_nat N,(Z.to_nat M,s)) -> + blurtwostage N M v = blurtwostage_partition)%Z As twostagepart. Proof. reschedule. - rw^ Nat2Z.inj_add. simpl. + rw^ @split_gen upto (N + 2)%Z at 1%Z. - rw^ @split_gen upto (Z.of_nat N + 2)%Z at 1%Z. - - rw^ @split_genr upto (Z.of_nat N + 2)%Z at (Z.of_nat N + 1)%Z. + rw^ @split_genr upto (N + 2)%Z at (N + 1)%Z. etransitivity. apply tlet_eq_bound. apply concat_eq_r. - rw^ split_gen upto (Z.of_nat M) at 1%Z. - rw^ @split_genr upto (Z.of_nat M) at (Z.of_nat M - 1)%Z. + rw^ split_gen upto M at 1%Z. + rw^ @split_genr upto M at (M - 1)%Z. reflexivity. simpl_guard. @@ -106,18 +103,18 @@ Hint Unfold blurtwostage_partition : examples. * redundant computations *) Definition blurimmediate_isolate {X} `{TensorElem X} - n m (l : list (list X)) := + (n m : Z) (l : list (list X)) := (GEN [ y < 1 ] - GEN [ x2 < Z.of_nat m ] + GEN [ x2 < m ] (|[ 0 <=? y - 1 ]| (|[ 0 <=? x2 - 1 ]| l _[ y - 1; x2 - 1]) <+> l _[ y - 1; x2] <+> - (|[ x2 + 1 + (|[ x2 + 1 ((|[ 0 <=? x2 - 1 ]| l _[ y; x2 - 1]) <+> l _[ y; x2] <+> - (|[ x2 + 1 + (|[ x2 + 1 ((|[ 0 <=? x2 - 1 ]| l _[ y + 1; x2 - 1]) <+> l _[ y + 1; x2] <+> - (|[ x2 + 1 + (|[ x2 + 1 transpose (transpose - (GEN [ 1 <= i < Z.of_nat (n - 1) ] + (GEN [ 1 <= i < n - 1 ] GEN [ x2 < 1 ] (|[ 0 <=? x2 - 1 ]| l _[ i - 1; x2 - 1]) <+> l _[ i - 1; x2] <+> l _[ i - 1; x2 + 1] <+> @@ -125,43 +122,43 @@ Definition blurimmediate_isolate {X} `{TensorElem X} ((|[ 0 <=? x2 - 1 ]| l _[ i + 1; x2 - 1]) <+> l _[ i + 1; x2] <+> l _[ i + 1; x2 + 1])) <++> transpose - (GEN [ 1 <= i < Z.of_nat (n - 1) ] - GEN [ 1 <= x2 < Z.of_nat (m - 1) ] + (GEN [ 1 <= i < n - 1 ] + GEN [ 1 <= x2 < m - 1 ] l _[ i - 1; x2 - 1] <+> l _[ i - 1; x2] <+> l _[ i - 1; x2 + 1] <+> (l _[ i; x2 - 1] <+> l _[ i; x2] <+> l _[ i; x2 + 1]) <+> (l _[ i + 1; x2 - 1] <+> l _[ i + 1; x2] <+> l _[ i + 1; x2 + 1])) <++> transpose - (GEN [ 1 <= i < Z.of_nat (n - 1) ] - GEN [ Z.of_nat m - 1 <= x2 < Z.of_nat m ] + (GEN [ 1 <= i < n - 1 ] + GEN [ m - 1 <= x2 < m ] l _[ i - 1; x2 - 1] <+> l _[ i - 1; x2] <+> - (|[ x2 + 1 + (|[ x2 + 1 (l _[ i; x2 - 1] <+> l _[ i; x2] <+> - (|[ x2 + 1 + (|[ x2 + 1 (l _[ i + 1; x2 - 1] <+> l _[ i + 1; x2]) <+> - (|[ x2 + 1 - (GEN [ Z.of_nat n - 1 <= y < Z.of_nat n ] - GEN [ x2 < Z.of_nat m ] + (|[ x2 + 1 + (GEN [ n - 1 <= y < n ] + GEN [ x2 < m ] (|[ 0 <=? x2 - 1 ]| l _[ y - 1; x2 - 1]) <+> l _[ y - 1; x2] <+> - (|[ x2 + 1 + (|[ x2 + 1 ((|[ 0 <=? x2 - 1 ]| l _[ y; x2 - 1]) <+> l _[ y; x2] <+> - (|[ x2 + 1 - (|[ y + 1 + (|[ x2 + 1 + (|[ y + 1 l _[ y + 1; x2] <+> - (|[ x2 + 1 v _[y-1;x2] <+> (|[x2+1 + ((|[0<=?x2-1]| v _[y-1;x2-1]) <+> v _[y-1;x2] <+> (|[x2+1 ((|[ 0 <=? x2 - 1 ]| v _[ y; x2 - 1]) <+> v _[ y; x2] <+> - (|[ x2 + 1 + (|[ x2 + 1 ((|[ 0 <=? x2 - 1 ]| v _[ y + 1; x2 - 1]) <+> v _[ y + 1; x2] <+> - (|[ x2 + 1 -(GEN [ 1 <= y < Z.of_nat (n - 1) ] +(GEN [ 1 <= y < n - 1 ] (GEN [ x2 < 1 ] ((|[ 0<=?x2-1 ]| v _[y-1;x2-1]) <+> v _[ y - 1; x2] @@ -171,7 +168,7 @@ Definition blurimmediate_partition {X} `{TensorElem X} ((|[ 0<=?x2-1 ]| v _[y+1;x2-1]) <+> v _[ y + 1; x2] <+> (v _[ y + 1; x2 + 1]))) <++> - (GEN [ 1 <= x2 < Z.of_nat (m-1) ] + (GEN [ 1 <= x2 < m-1 ] ((v _[ y - 1; x2 - 1]) <+> v _[ y - 1; x2] <+> (v _[ y - 1; x2 + 1])) @@ -182,31 +179,31 @@ Definition blurimmediate_partition {X} `{TensorElem X} <+> v _[ y + 1; x2] <+> (v _[ y + 1; x2 + 1]))) <++> - (GEN [ Z.of_nat m - 1 <= x2 < Z.of_nat m ] + (GEN [ m - 1 <= x2 < m ] ((v _[ y - 1; x2 - 1]) - <+> v _[ y - 1; x2] <+> (|[x2+1 v _[ y - 1; x2] <+> (|[x2+1 ((v _[ y; x2 - 1]) - <+> v _[ y; x2] <+> (|[x2+1 + <+> v _[ y; x2] <+> (|[x2+1 ((v _[ y + 1; x2 - 1]) - <+> v _[ y + 1; x2]) <+> (|[x2+1 v _[ y + 1; x2]) <+> (|[x2+1 -(GEN [ Z.of_nat n - 1 <= y < Z.of_nat n ] - GEN [ x2 < Z.of_nat m ] +(GEN [ n - 1 <= y < n ] + GEN [ x2 < m ] (|[ 0 <=? x2 - 1 ]| v _[ y - 1; x2 - 1]) <+> v _[ y - 1; x2] <+> - (|[ x2 + 1 + (|[ x2 + 1 ((|[ 0 <=? x2 - 1 ]| v _[ y; x2 - 1]) <+> v _[ y; x2] <+> - (|[ x2 + 1 -(|[y+1 v _[y+1;x2] <+> (|[x2+1 +(|[y+1 v _[y+1;x2] <+> (|[x2+1 v _[ i - 1; x2] <+> v _[ i - 1; x2 + 1] <+> (v _[ i; x2 - 1] <+> v _[ i; x2] <+> @@ -216,69 +213,69 @@ Definition fusion_no_boundary {X} `{TensorElem X} Hint Unfold fusion_no_boundary : examples. Definition tile_no_boundary {X} `{TensorElem X} - n_k m_k n m l := - flatten_trunc (n - 1 - 1) - ((GEN [ i < (Z.of_nat (n - 1) - 1) / Z.of_nat n_k ] + (n_k m_k n m : Z) l := + flatten_trunc (Z.to_nat (n - 1 - 1)) + ((GEN [ i < (n - 1 - 1) / n_k ] transpose - (flatten_trunc (m - 1 - 1) - ((GEN [ i0 < Z.of_nat (m - 1 - 1) / Z.of_nat m_k ] + (flatten_trunc (Z.to_nat (m - 1 - 1)) + ((GEN [ i0 < (m - 1 - 1) / m_k ] (tlet x2 - := GEN [ i1 < Z.of_nat (n_k + 2) ] - GEN [ i2 < Z.of_nat m_k ] - l _[ i * Z.of_nat n_k + i1; i0 * Z.of_nat m_k + i2] <+> - l _[ i * Z.of_nat n_k + i1; i0 * Z.of_nat m_k + i2 + 1] <+> - l _[ i * Z.of_nat n_k + i1; i0 * Z.of_nat m_k + i2 + 2] + := GEN [ i1 < n_k + 2 ] + GEN [ i2 < m_k ] + l _[ i * n_k + i1; i0 * m_k + i2] <+> + l _[ i * n_k + i1; i0 * m_k + i2 + 1] <+> + l _[ i * n_k + i1; i0 * m_k + i2 + 2] in transpose - (GEN [ i1 < Z.of_nat n_k ] - GEN [ i2 < Z.of_nat m_k ] + (GEN [ i1 < n_k ] + GEN [ i2 < m_k ] x2 _[ i1; i2] <+> x2 _[ i1 + 1; i2] <+> x2 _[ i1 + 2; i2]))) <++> - (GEN [ Z.of_nat (m - 1 - 1) / Z.of_nat m_k <= i0 < - Z.of_nat (m - 1 - 1) / Z.of_nat m_k + - (Z.of_nat (m - 1 - 1) mod Z.of_nat m_k) // (Z.of_nat m_k) ] - GEN [ i1 < Z.of_nat m_k ] - GEN [ n' < Z.of_nat n_k ] - (|[ i0 * Z.of_nat m_k + i1 - l _[ 1 + (i * Z.of_nat n_k + n') - 1; 1 + (i0 * Z.of_nat m_k + i1)] <+> - l _[ 1 + (i * Z.of_nat n_k + n') - 1; - 1 + (i0 * Z.of_nat m_k + i1) + 1] <+> - (l _[ 1 + (i * Z.of_nat n_k + n'); - 1 + (i0 * Z.of_nat m_k + i1) - 1] <+> - l _[ 1 + (i * Z.of_nat n_k + n'); 1 + (i0 * Z.of_nat m_k + i1)] <+> - l _[ 1 + (i * Z.of_nat n_k + n'); - 1 + (i0 * Z.of_nat m_k + i1) + 1]) <+> - (l _[ 1 + (i * Z.of_nat n_k + n') + 1; - 1 + (i0 * Z.of_nat m_k + i1) - 1] <+> - l _[ 1 + (i * Z.of_nat n_k + n') + 1; - 1 + (i0 * Z.of_nat m_k + i1)] <+> - l _[ 1 + (i * Z.of_nat n_k + n') + 1; - 1 + (i0 * Z.of_nat m_k + i1) + 1]))))))) <++> - (GEN [ (Z.of_nat (n - 1) - 1) / Z.of_nat n_k <= i < - (Z.of_nat (n - 1) - 1) / Z.of_nat n_k + - ((Z.of_nat (n - 1) - 1) mod Z.of_nat n_k) // (Z.of_nat n_k) ] + (GEN [ (m - 1 - 1) / m_k <= i0 < + (m - 1 - 1) / m_k + + ((m - 1 - 1) mod m_k) // m_k ] + GEN [ i1 < m_k ] + GEN [ n' < n_k ] + (|[ i0 * m_k + i1 + l _[ 1 + (i * n_k + n') - 1; 1 + (i0 * m_k + i1)] <+> + l _[ 1 + (i * n_k + n') - 1; + 1 + (i0 * m_k + i1) + 1] <+> + (l _[ 1 + (i * n_k + n'); + 1 + (i0 * m_k + i1) - 1] <+> + l _[ 1 + (i * n_k + n'); 1 + (i0 * m_k + i1)] <+> + l _[ 1 + (i * n_k + n'); + 1 + (i0 * m_k + i1) + 1]) <+> + (l _[ 1 + (i * n_k + n') + 1; + 1 + (i0 * m_k + i1) - 1] <+> + l _[ 1 + (i * n_k + n') + 1; + 1 + (i0 * m_k + i1)] <+> + l _[ 1 + (i * n_k + n') + 1; + 1 + (i0 * m_k + i1) + 1]))))))) <++> + (GEN [ ((n - 1) - 1) / n_k <= i < + ((n - 1) - 1) / n_k + + (((n - 1) - 1) mod n_k) // n_k ] transpose - (flatten_trunc (m - 1 - 1) - (GEN [ i0 < Z.of_nat (m - 1 - 1) / Z.of_nat m_k + - (Z.of_nat (m - 1 - 1) mod Z.of_nat m_k) // (Z.of_nat m_k) ] - GEN [ i1 < Z.of_nat m_k ] - GEN [ n' < Z.of_nat n_k ] - (|[ i0 * Z.of_nat m_k + i1 - l _[ 1 + (i * Z.of_nat n_k + n') - 1; 1 + (i0 * Z.of_nat m_k + i1)] <+> - l _[ 1 + (i * Z.of_nat n_k + n') - 1; - 1 + (i0 * Z.of_nat m_k + i1) + 1] <+> - (l _[ 1 + (i * Z.of_nat n_k + n'); 1 + (i0 * Z.of_nat m_k + i1) - 1] <+> - l _[ 1 + (i * Z.of_nat n_k + n'); 1 + (i0 * Z.of_nat m_k + i1)] <+> - l _[ 1 + (i * Z.of_nat n_k + n'); 1 + (i0 * Z.of_nat m_k + i1) + 1]) <+> - (l _[ 1 + (i * Z.of_nat n_k + n') + 1; - 1 + (i0 * Z.of_nat m_k + i1) - 1] <+> - l _[ 1 + (i * Z.of_nat n_k + n') + 1; 1 + (i0 * Z.of_nat m_k + i1)] <+> - l _[ 1 + (i * Z.of_nat n_k + n') + 1; - 1 + (i0 * Z.of_nat m_k + i1) + 1]))))))). + (flatten_trunc (Z.to_nat (m - 1 - 1)) + (GEN [ i0 < (m - 1 - 1) / m_k + + ((m - 1 - 1) mod m_k) // m_k ] + GEN [ i1 < m_k ] + GEN [ n' < n_k ] + (|[ i0 * m_k + i1 + l _[ 1 + (i * n_k + n') - 1; 1 + (i0 * m_k + i1)] <+> + l _[ 1 + (i * n_k + n') - 1; + 1 + (i0 * m_k + i1) + 1] <+> + (l _[ 1 + (i * n_k + n'); 1 + (i0 * m_k + i1) - 1] <+> + l _[ 1 + (i * n_k + n'); 1 + (i0 * m_k + i1)] <+> + l _[ 1 + (i * n_k + n'); 1 + (i0 * m_k + i1) + 1]) <+> + (l _[ 1 + (i * n_k + n') + 1; + 1 + (i0 * m_k + i1) - 1] <+> + l _[ 1 + (i * n_k + n') + 1; 1 + (i0 * m_k + i1)] <+> + l _[ 1 + (i * n_k + n') + 1; + 1 + (i0 * m_k + i1) + 1]))))))). Hint Unfold tile_no_boundary : examples. Lemma forall_tensor_consistent {X} `{TensorElem X} : forall l s n, @@ -294,7 +291,7 @@ Qed. Section total_tiled. Variables (X : Set) (H : TensorElem X) - (v : list (list X)) (s : @shape X _) (n m n_k m_k : nat). + (n_k m_k : Z) (n m : Z) (v : list (list X)) (s : @shape X _). Derive blur_tiles_guarded SuchThat (2 < n -> 2 < m -> @@ -302,49 +299,47 @@ Section total_tiled. 1 < m_k -> n_k < n - 2 -> m_k < m - 2 -> - (0 < Z.of_nat (m - 1 - 1) mod Z.of_nat m_k)%Z -> - (0 < (Z.of_nat (n - 1) - 1) mod Z.of_nat n_k)%Z -> - consistent v (n,(m,s)) -> - blurimmediate_partition n m v = blur_tiles_guarded) As total_tiled. + (0 < (m - 1 - 1) mod m_k)%Z -> + (0 < (n - 1 - 1) mod n_k)%Z -> + consistent v (Z.to_nat n,(Z.to_nat m,s)) -> + blurimmediate_partition n m v = blur_tiles_guarded)%Z As total_tiled. Proof. reschedule. wrapid^ @transpose_transpose_id around - (GEN [ 1 <= _ < (Z.of_nat (n-1)) ] _). + (GEN [ 1 <= _ < (n-1) ] _). rw @distrib_gen_concat. rw @distrib_gen_concat. wrapid @flatten_trunc_tile_id around - (GEN [ _ <= _ < Z.of_nat (n-1) ] GEN [ 1 <= _ < Z.of_nat (m-1)] _) - with n_k. - - rw^ Z2Nat.inj_sub. - rewrite Nat2Z.id. - replace (Z.to_nat 1) with 1 by reflexivity. + (GEN [ _ <= _ < n-1 ] GEN [ 1 <= _ < m-1] _) + with (Z.to_nat n_k). inline tile. rw @get_genr_some. rw @gp_genr_iverson. - wrapid @transpose_transpose_id around (GEN [ _ < Z.of_nat n_k ] _). + rewrite Z2Nat.id by lia. + wrapid @transpose_transpose_id around (GEN [ _ < n_k ] _). rw @unfold_inner_transpose. rw^ @consistent_length. + rw^ @consistent_length. rw^ Z2Nat.inj_sub. - rewrite Nat2Z.id. + rewrite Z2Nat.id by lia. replace (Z.to_nat 1) with 1 by reflexivity. rw @get_gen_some. rw @get_genr_some. - wrapid @flatten_trunc_tile_id around (GEN [ _ < Z.of_nat (m -1 -1)] _) - with m_k. + wrapid @flatten_trunc_tile_id around (GEN [ _ < m - 1 - 1] _) + with (Z.to_nat m_k). inline tile. rw @get_gen_some. - rw^ @gp_gen_iverson. - + rw^ @gp_gen_iverson. + repeat rw^ (Z.add_comm 1%Z). repeat rw^ Z.add_simpl_r. remember ((x1::xs1)::xs) as l. rw^ ceil_floor_mod. - rw^ (ceil_floor_mod (Z.of_nat (m-1-1))). + rw^ (ceil_floor_mod (m-1-1)). rw^ @split_gen_plus. rw^ @split_gen_plus. @@ -352,63 +347,68 @@ Section total_tiled. simpl_guard. simpl_guard. + rewrite Z2Nat.id by lia. rw @lbind_helper for (fun x => x - <+> ((_ _[_*Z.of_nat n_k + _ +1; _*Z.of_nat m_k + _]) <+> _ <+> _) + <+> ((_ _[_*n_k + _ +1; _*m_k + _]) <+> _ <+> _) <+> _). rw @ll_gen. rw @ll_gen. - - wrapid^ @transpose_transpose_id around (GEN [ _ < Z.of_nat m_k ] _). + + wrapid^ @transpose_transpose_id around (GEN [ _ < m_k ] _). rw^ @tlet_f_bound_body. rw unfold_transpose around (GEN [ _ < _ ] _). rw @get_gen_some. rw @get_gen_some. rw @transpose_get_get. - - wrapid^ @trunc_r_pad_r_id around (GEN [ _ < Z.of_nat n_k ] _) + + rewrite Z2Nat.id by lia. + wrapid^ @trunc_r_pad_r_id around (GEN [ _ < n_k ] _) with 2. rw^ @tlet_f_bound_body. inline pad_r. rw^ @get_gen_some. inline trunc_r. rw @get_gen_some. - rw @lbind_helper for (fun x => |[ _ |[ _ (|[ _ (|[ _ x <+> (_ <+> _ <+> _)). rw @ll_gen. rw @ll_gen. wrapid^ @transpose_transpose_id around - (GEN [ _ < Z.of_nat m_k ] GEN [ _ < _ ] _). + (GEN [ _ < m_k ] GEN [ _ < _ ] _). rw^ @tlet_f_bound_body. rw unfold_transpose around (GEN [ _ < _ ] _). rw @get_gen_some. rw @get_gen_some. rw @transpose_get_get. + do 2 rewrite Z2Nat.id by lia. wrapid^ @trunc_l_pad_l_id around - (GEN [ _ < Z.of_nat n_k] - GEN [ _ < Z.of_nat m_k ] _) with 1. + (GEN [ _ < n_k] + GEN [ _ < m_k ] _) with 1. rw^ @tlet_f_bound_body. inline pad_l. rw^ @get_gen_some. - inline trunc_l. + inline trunc_l. rw minus_plus. rw @get_gen_some. simpl. rw^ Z.add_sub_assoc. - rw^ Zplus_minus. rw^ Z.sub_add. - wrapid @trunc_r_pad_r_id around (GEN [ _ < Z.of_nat (n_k+1) ] - |[ 1 <=? _ ]| GEN [ _ < Z.of_nat m_k ] _) + do 2 rewrite Nat2Z.inj_add. + rw Z2Nat.id. + rw Z2Nat.id. + wrapid @trunc_r_pad_r_id around (GEN [ _ < n_k+1 ] + |[ 1 <=? _ ]| GEN [ _ < m_k ] _) with 1. rw^ @tlet_f_bound_body. inline pad_r. @@ -419,19 +419,22 @@ Section total_tiled. rw @ll_iverson_. rw @ll_gen. rw @let_let_flip. - rewrite <- Nat.add_assoc. simpl. - rw^ Z.sub_add. + rewrite Nat2Z.inj_add, Z2Nat.inj_add, Nat2Z.inj_add by lia. + do 4 progress rw Z2Nat.id. + change (Z.of_nat 1) with 1%Z. + change (Z.of_nat 2) with 2%Z. + rewrite <- Z.add_assoc. simpl. rw^ @let_let_same. rw @get_gen_some. rw @gp_iverson. rw @lbind_helper for (fun x => (|[ _ ]| _) - <+> (|[ _ (|[ _ x). rw @ll_gen. rw @ll_gen. wrapid^ @transpose_transpose_id around - (GEN [ _ < Z.of_nat m_k ] _). + (GEN [ _ < m_k ] _). rw^ @tlet_f_bound_body. rw unfold_transpose around (GEN [ _ < _ ] _). rw^ @get_gen_some. @@ -439,37 +442,33 @@ Section total_tiled. rw @transpose_get_get. repeat rw^<- (Zplus_assoc 1%Z 1%Z). - simpl. - rw^ @gen_trunc upto n_k at 2. + simpl. + rw^ @gen_trunc upto (Z.to_nat n_k) at 2. rw^ @tlet_f_bound_body. rw^ Z.add_sub_assoc. simpl. rw^ Z.sub_add. inline trunc_l. simpl. rw @get_gen_some. rw minus_plus. simpl. + rewrite Nat2Z.inj_add. + rewrite Z2Nat.id by lia. + change (Z.of_nat 2) with 2%Z. rw^ @let_let_same. - + simpl_guard. simpl_guard. - wrapid @transpose_transpose_id around (GEN [ _ < Z.of_nat m_k ] _). + wrapid @transpose_transpose_id around (GEN [ _ < m_k ] _). rw @unfold_inner_transpose. rw^ @consistent_length. + rw^ @consistent_length. + do 2 rw Z2Nat.id. rw @get_gen_some. rw @get_gen_some. erewrite flatten_trunc_flatten_truncr. 2: { consistent_shape; try reflexivity; try lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - - eapply znat_0lt. - rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos. @@ -477,7 +476,7 @@ Section total_tiled. lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos. - lia. + lia. lia. erewrite <- ceil_floor_mod by lia. eapply ceil_div_pos; lia. @@ -486,13 +485,7 @@ Section total_tiled. erewrite trunc_r_truncr. 2: { erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. @@ -503,20 +496,13 @@ Section total_tiled. 2: { eapply Z.div_pos; lia. } 2: { eapply Z.div_pos; lia. } erewrite <- ceil_floor_mod by lia. - replace (Z.of_nat (n - 1) - 1)%Z with (Z.of_nat (n-1-1)) by lia. - erewrite znat_id_distr. - rewrite Nat2Z.id. rewrite Nat2Z.id. + replace (Z.to_nat (n - 1) - 1) with (Z.to_nat (n-1-1)) by lia. + rewrite Z2Nat_div_distr by lia. rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound. lia. } erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. @@ -527,10 +513,9 @@ Section total_tiled. 2: { eapply Z.div_pos; lia. } 2: { eapply Z.div_pos; lia. } erewrite <- ceil_floor_mod by lia. - replace (Z.of_nat (n - 1) - 1)%Z with (Z.of_nat (n-1-1)) by lia. - erewrite znat_id_distr. - rewrite Nat2Z.id. rewrite Nat2Z.id. - + replace (Z.to_nat (n - 1) - 1) with (Z.to_nat (n-1-1)) by lia. + rewrite Z2Nat_div_distr by lia. + etransitivity. eapply concat_eq_l. eapply concat_eq_r. @@ -544,11 +529,6 @@ Section total_tiled. eapply gen_eq_bound; intros. erewrite flatten_trunc_flatten_truncr. 2: { consistent_shape; try reflexivity; try lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - - eapply znat_0lt. - rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. } @@ -556,23 +536,13 @@ Section total_tiled. erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. rewrite Z.add_simpl_l. - eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. eapply Z.div_str_pos; lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. erewrite ceil_floor_mod. eapply Z.lt_add_pos_r. eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. + simpl. eauto. lia. lia. lia. erewrite <- ceil_floor_mod by lia. eapply ceil_div_pos; lia. } rewrite Z2Nat.inj_sub. @@ -582,73 +552,52 @@ Section total_tiled. 2: { eapply ceil_div_nonneg; lia. } 2: { eapply floor_lt_ceil; lia. } eapply Z.div_pos; lia. } - + rewrite Nat.add_comm. rewrite Nat.add_sub. rewrite sub_sub_distr. 2: { rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. } 2: { eapply Nat.mul_le_mono_l. - rewrite znat_id_distr. rewrite Nat2Z.id. rewrite Nat2Z.id. lia. } - rewrite znat_id_distr. - rewrite Nat2Z.id. rewrite Nat2Z.id. + rewrite Z2Nat_div_distr by lia. lia. } + rewrite Z2Nat_div_distr by lia. rewrite Nat.sub_diag. rewrite Nat.add_0_l. - + erewrite trunc_r_truncr. 2: { erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. rewrite Z.add_simpl_l. - eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. eapply Z.div_str_pos; lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. erewrite ceil_floor_mod. - eapply Z.lt_add_pos_r. + eapply Z.lt_add_pos_r. eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. + simpl. eauto. lia. lia. lia. erewrite <- ceil_floor_mod by lia. eapply ceil_div_pos; lia. } - rewrite Z2Nat.inj_sub. + rewrite (Z2Nat.inj_sub (_ // _) (_ / _)). 2: { eapply Z.div_pos; lia. } rewrite Nat.add_sub_assoc. rewrite Nat.add_comm. rewrite Nat.add_sub. - rewrite znat_id_distr. rewrite Nat2Z.id. rewrite Nat2Z.id. + rewrite Z2Nat_div_distr by lia. rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. eapply Z2Nat.inj_le. 2: { eapply ceil_div_nonneg; lia. } - 2: { eapply floor_lt_ceil; lia. } + 2: { eapply floor_lt_ceil; lia. } eapply Z.div_pos; lia. } - + erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. rewrite Z.add_simpl_l. - eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. eapply Z.div_str_pos; lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. erewrite ceil_floor_mod. eapply Z.lt_add_pos_r. eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. + eauto. lia. lia. lia. erewrite <- ceil_floor_mod by lia. eapply ceil_div_pos; lia. } - + rewrite Z2Nat.inj_sub. 2: { eapply Z.div_pos; lia. } rewrite Nat.add_sub_assoc. @@ -657,8 +606,8 @@ Section total_tiled. 2: { eapply floor_lt_ceil; lia. } eapply Z.div_pos; lia. } rewrite Nat.add_comm. - rewrite Nat.add_sub. - + rewrite Nat.add_sub. + etransitivity. eapply concat_eq_l. eapply concat_eq_r. @@ -674,45 +623,33 @@ Section total_tiled. 2: { consistent_shape; try reflexivity; try lia. eapply Z.add_pos_pos. eapply Z.div_str_pos. lia. - eapply ceil_div_pos; lia. } - + eapply ceil_div_pos; lia. } + erewrite trunc_r_truncr. 2: { erewrite consistent_length. - 2: { consistent_shape; try lia; try reflexivity. + 2: { consistent_shape; try lia; try reflexivity. eapply split_floor_rest_nonneg; lia. } erewrite <- ceil_floor_mod. - erewrite znat_id_distr. - rewrite Nat2Z.id. rewrite Nat2Z.id. + rewrite Z2Nat_div_distr by lia. rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. lia. lia. } erewrite consistent_length. - 2: { consistent_shape; try lia; try reflexivity. + 2: { consistent_shape; try lia; try reflexivity. eapply split_floor_rest_nonneg; lia. } erewrite <- ceil_floor_mod by lia. - erewrite znat_id_distr. - rewrite Nat2Z.id. rewrite Nat2Z.id. + rewrite Z2Nat_div_distr by lia. reflexivity. cbv beta. - - + + erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. rewrite Z.add_simpl_l. - eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. eapply Z.div_str_pos; lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. rewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. erewrite ceil_floor_mod. eapply Z.lt_add_pos_r. eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. + simpl. eauto. lia. lia. lia. erewrite <- ceil_floor_mod by lia. eapply ceil_div_pos; lia. } @@ -724,7 +661,7 @@ Section total_tiled. 2: { eapply floor_lt_ceil; lia. } eapply Z.div_pos; lia. } rewrite Nat.add_comm. - rewrite Nat.add_sub. + rewrite Nat.add_sub. etransitivity. eapply concat_eq_l. @@ -740,39 +677,25 @@ Section total_tiled. erewrite trunc_r_truncr. 2: { erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. rewrite Z.add_simpl_l. - erewrite Z.div_small. - 2: { eapply Z.mod_bound_pos. lia. lia. } - simpl. eapply ceil_div_pos. - rewrite Z.mod_mod. lia. lia. lia. lia. lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos. lia. lia. } rewrite <- ceil_floor_mod by lia. - rewrite Z2Nat.inj_sub. + rewrite (Z2Nat.inj_sub (_ // _) (_ / _)). 2: { eapply Z.div_pos; lia. } rewrite Nat.add_sub_assoc. 2: { eapply Z2Nat.inj_le. - 2: { eapply ceil_div_nonneg; lia. } + 2: { eapply ceil_div_nonneg; lia. } 2: { eapply floor_lt_ceil; lia. } eapply Z.div_pos; lia. } rewrite Nat.add_sub_swap by lia. rewrite Nat.sub_diag. - simpl. rewrite znat_id_distr. rewrite Nat2Z.id. rewrite Nat2Z.id. + simpl. rewrite Z2Nat_div_distr by lia. rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. } erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. rewrite Z.add_simpl_l. - erewrite Z.div_small. - 2: { eapply Z.mod_bound_pos. lia. lia. } - simpl. eapply ceil_div_pos. - rewrite Z.mod_mod. lia. lia. lia. lia. lia. eapply Z.div_str_pos; lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos. lia. lia. } @@ -782,36 +705,27 @@ Section total_tiled. 2: { eapply Z.div_pos; lia. } rewrite Nat.add_sub_assoc. 2: { eapply Z2Nat.inj_le. - 2: { eapply ceil_div_nonneg; lia. } + 2: { eapply ceil_div_nonneg; lia. } 2: { eapply floor_lt_ceil; lia. } eapply Z.div_pos; lia. } rewrite Nat.add_sub_swap by lia. rewrite Nat.sub_diag. - simpl. rewrite znat_id_distr. rewrite Nat2Z.id. rewrite Nat2Z.id. - reflexivity. cbv beta. - + simpl. rewrite Z2Nat_div_distr by lia. + reflexivity. cbv beta. + erewrite trunc_r_truncr. 2: { erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. rewrite Z.add_simpl_l. - eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. eapply Z.div_str_pos; lia. - rewrite znat_id_distr. repeat rewrite Nat2Z.id. + rewrite Z2Nat_div_distr by lia. rewrite sub_sub_distr. 2: { rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. } 2: { lia. } rewrite Nat.sub_diag. simpl. lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. - erewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. - lia. lia. + eapply Z.div_str_pos; lia. + erewrite ceil_floor_mod by lia. + eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. erewrite Z2Nat.inj_sub. 2: { eapply Z.div_pos; lia. } rewrite Nat.add_sub_assoc. @@ -821,50 +735,38 @@ Section total_tiled. rewrite Nat.add_sub_swap. 2: { lia. } lia. - eapply Z.div_str_pos; lia. - erewrite ceil_floor_mod by lia. - eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. erewrite ceil_floor_mod by lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. simpl. lia. lia. lia. - rewrite znat_id_distr. rewrite Nat2Z.id. rewrite Nat2Z.id. + lia. lia. + rewrite Z2Nat_div_distr by lia. erewrite sub_sub_distr. 2: { rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. } 2: { lia. } - rewrite Nat.sub_diag. simpl. lia. + rewrite Nat.sub_diag. simpl. lia. eapply ceil_div_pos; lia. } - rewrite Z2Nat.inj_sub. + rewrite (Z2Nat.inj_sub (_ // _) (_ / _)). 2: { eapply Z.div_pos; lia. } rewrite Nat.add_sub_assoc. 2: { eapply Z2Nat.inj_le. eapply Z.div_pos; lia. eapply ceil_div_nonneg; lia. eapply floor_lt_ceil. lia. lia. } rewrite Nat.add_sub_swap by lia. - rewrite Nat.sub_diag. simpl. lia. + rewrite Nat.sub_diag. simpl. lia. } - + erewrite consistent_length. 2: { consistent_shape; try lia; try reflexivity. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. rewrite Z.add_simpl_l. - eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. - simpl. eauto. lia. lia. lia. lia. eapply Z.div_str_pos; lia. - rewrite znat_id_distr. repeat rewrite Nat2Z.id. + rewrite Z2Nat_div_distr by lia. rewrite sub_sub_distr. 2: { rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. } 2: { lia. } rewrite Nat.sub_diag. simpl. lia. - eapply znat_0lt; eapply Z.div_str_pos; lia. - eapply znat_0lt. - erewrite ceil_floor_mod. - erewrite Z.add_simpl_l. - eapply ceil_div_pos; lia. - lia. lia. + eapply Z.div_str_pos; lia. + erewrite ceil_floor_mod by lia. + eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. erewrite Z2Nat.inj_sub. 2: { eapply Z.div_pos; lia. } rewrite Nat.add_sub_assoc. @@ -874,18 +776,15 @@ Section total_tiled. rewrite Nat.add_sub_swap. 2: { lia. } lia. - eapply Z.div_str_pos; lia. - erewrite ceil_floor_mod by lia. - eapply Z.lt_add_pos_r. eapply ceil_div_pos; lia. erewrite ceil_floor_mod by lia. eapply Z.lt_add_pos_r. eapply ceil_div_pos. - rewrite Nat2Z.inj_sub. simpl. lia. lia. lia. - rewrite znat_id_distr. rewrite Nat2Z.id. rewrite Nat2Z.id. + lia. lia. + rewrite Z2Nat_div_distr by lia. erewrite sub_sub_distr. 2: { rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. } 2: { lia. } - rewrite Nat.sub_diag. simpl. lia. + rewrite Nat.sub_diag. simpl. lia. eapply ceil_div_pos; lia. } rewrite Z2Nat.inj_sub. @@ -894,24 +793,22 @@ Section total_tiled. 2: { erewrite ceil_floor_mod by lia. rewrite Z2Nat.inj_add. 2: { eapply Z.div_pos; lia. } - 2: { eapply ceil_div_nonneg. rewrite Nat2Z.inj_sub. simpl. - lia. lia. lia. } + 2: { eapply ceil_div_nonneg. lia. lia. } eapply Nat.le_add_r. } rewrite Nat.add_sub_swap by lia. rewrite Nat.sub_diag. rewrite Nat.add_0_l. rewrite sub_sub_distr by lia. rewrite Nat.sub_diag. rewrite Nat.add_0_l. - rewrite znat_id_distr. - rewrite Nat2Z.id. rewrite Nat2Z.id. + rewrite Z2Nat_div_distr by lia. erewrite truncr_Truncr. - rewrite (Nat2Z.inj_sub _ (n-1-1)). + rewrite (Nat2Z.inj_sub _ (Z.to_nat (n-1-1))). 2: { rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. } - erewrite Nat2Z.inj_mul. - erewrite <- of_nat_div_distr. + rewrite Nat2Z.inj_mul. + rewrite <- of_nat_div_distr. + repeat rewrite Z2Nat.id by lia. - etransitivity. eapply concat_eq_l. eapply concat_eq_r. @@ -924,13 +821,14 @@ Section total_tiled. eapply concat_eq_l. eapply gen_eq_bound; intros. erewrite truncr_Truncr. - rewrite (Nat2Z.inj_sub _ (m-1-1)). + rewrite (Nat2Z.inj_sub _ (Z.to_nat (m-1-1))). 2: { rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. } - erewrite Nat2Z.inj_mul. - erewrite <- of_nat_div_distr. + rewrite Nat2Z.inj_mul. + rewrite <- of_nat_div_distr. + repeat rewrite Z2Nat.id by lia. reflexivity. cbv beta. - + etransitivity. eapply concat_eq_l. eapply concat_eq_r. @@ -943,13 +841,14 @@ Section total_tiled. eapply concat_eq_r. eapply genr_eq_bound; intros. erewrite truncr_Truncr. - rewrite (Nat2Z.inj_sub _ (m-1-1)). + rewrite (Nat2Z.inj_sub _ (Z.to_nat (m-1-1))). 2: { rewrite Nat.mul_comm. eapply div_ceil_n_lower_bound; lia. } - erewrite Nat2Z.inj_mul. - erewrite <- of_nat_div_distr. + rewrite Nat2Z.inj_mul. + rewrite <- of_nat_div_distr. + repeat rewrite Z2Nat.id by lia. reflexivity. cbv beta. - + done. Qed. End total_tiled. @@ -957,10 +856,10 @@ Hint Unfold blur_tiles_guarded : examples. Section fuse_twostage. Variables (X : Set) (H : TensorElem X) - (v : list (list X)) (m n k : nat) (s : @shape X _). + (n m k : Z) (v : list (list X)) (s : @shape X _). Derive blurimmediate SuchThat - (0 < k -> 0 < m -> 0 < n -> consistent v (n,(m,s)) -> - blurtwostage n m v = blurimmediate) As twostage_immediate. + (0 < k -> 0 < m -> 0 < n -> consistent v (Z.to_nat n,(Z.to_nat m,s)) -> + blurtwostage n m v = blurimmediate)%Z As twostage_immediate. Proof. reschedule. @@ -1022,7 +921,7 @@ transpose (GEN [ i1 < Z.of_nat n_k ] GEN [ i2 < Z.of_nat m_k ] x2 _[ i1; i2] <+> x2 _[ i1 + 1; i2] <+> x2 _[ i1 + 2; i2]))) <++> - (GEN [ Z.of_nat (m - 1 - 1) / Z.of_nat m_k <= i0 < + (GEN [ Z.of_nat (m - 1 - 1) / Z.of_nat m_k <= i0 < Z.of_nat (m - 1 - 1) / Z.of_nat m_k + (Z.of_nat (m - 1 - 1) mod Z.of_nat m_k) // (Z.of_nat m_k) ] GEN [ i1 < Z.of_nat m_k ] @@ -1037,7 +936,7 @@ transpose (v _[ i * Z.of_nat n_k + i2 + 2; i0 * Z.of_nat m_k + i1] <+> v _[ i * Z.of_nat n_k + i2 + 2; i0 * Z.of_nat m_k + i1 + 1] <+> v _[ i * Z.of_nat n_k + i2 + 2; i0 * Z.of_nat m_k + i1 + 2])))))) <++> - (GEN [ (Z.of_nat (n - 1) - 1) / Z.of_nat n_k <= i < + (GEN [ (Z.of_nat (n - 1) - 1) / Z.of_nat n_k <= i < (Z.of_nat (n - 1) - 1) / Z.of_nat n_k + ((Z.of_nat (n - 1) - 1) mod Z.of_nat n_k) // (Z.of_nat n_k) ] transpose @@ -1078,52 +977,52 @@ Proof. reflexivity. Qed. *) Goal forall f n k, pipeline_sched f n k = flatten_trunc (Z.to_nat n) - (GEN [ i < n // (Z.of_nat k) ] + (GEN [ i < n // k ] (tlet x - := GEN [ i0 < Z.of_nat k ] - (|[ 0 <=? i * Z.of_nat k + i0 - 1 ]| f _[ i * Z.of_nat k + i0 - 1]) <+> - f _[ i * Z.of_nat k + i0] - in GEN [ n' < Z.of_nat k ] - (|[ i * Z.of_nat k + n' + f _[ i * k + i0] + in GEN [ n' < k ] + (|[ i * k + n' v _[ i - 1; i0] <+> - (|[ i0 + 1 + (|[ i0 + 1 ((|[ 0 <=? i0 - 1 ]| v _[ i; i0 - 1]) <+> v _[ i; i0] <+> - (|[ i0 + 1 - (|[ i + 1 + (|[ i + 1 v _[ i + 1; i0] <+> - (|[ i0 + 1 v _[ i - 1; i0] <+> v _[ i - 1; i0 + 1])) <++> - ((GEN [ 1 <= i < Z.of_nat N + 1 ] + ((GEN [ 1 <= i < N + 1 ] (GEN [ i0 < 1 ] (|[ 0 <=? i0 - 1 ]| v _[ i - 1; i0 - 1]) <+> v _[ i - 1; i0] <+> v _[ i - 1; i0 + 1]) <++> - ((GEN [ 1 <= i0 < Z.of_nat M - 1 ] + ((GEN [ 1 <= i0 < M - 1 ] v _[ i - 1; i0 - 1] <+> v _[ i - 1; i0] <+> v _[ i - 1; i0 + 1]) <++> - (GEN [ Z.of_nat M - 1 <= i0 < Z.of_nat M ] + (GEN [ M - 1 <= i0 < M ] v _[ i - 1; i0 - 1] <+> v _[ i - 1; i0] <+> - (|[ i0 + 1 - (GEN [ Z.of_nat N + 1 <= i < Z.of_nat N + 2 ] - GEN [ i0 < Z.of_nat M ] - (|[ i - 1 v _[ i - 1; i0] <+> + (|[ i0 + 1 + (GEN [ N + 1 <= i < N + 2 ] + GEN [ i0 < M ] + (|[ i - 1 v _[ i - 1; i0] <+> v _[ i - 1; i0 + 1]))) -in GEN [ y < Z.of_nat N ] -GEN [ x < Z.of_nat M ] +in GEN [ y < N ] +GEN [ x < M ] blurx' _[ y; x] <+> blurx' _[ y + 1; x] <+> blurx' _[ y + 2; x] -. +. Proof. reflexivity. Qed. diff --git a/src/examples/Matmul.v b/src/examples/Matmul.v index 9198e74..541ea5e 100644 --- a/src/examples/Matmul.v +++ b/src/examples/Matmul.v @@ -19,23 +19,23 @@ Definition matmul A B C (m1 m2 : (list (list R))) := SUM [ k < B ] (m1 _[i;k] * m2 _[k;j])%R. -Hint Unfold matmul : examples. +Hint Unfold matmul : examples. Section Tile. - Variables (A B C : nat) (m1 m2 : (list (list R))) (k : Z). + Variables (A B C : Z) (m1 m2 : (list (list R))) (k : Z). Derive matmul_tiled SuchThat - ((0 < k)%Z -> + (0 < k -> 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) As matmultiled. + consistent m1 (Z.to_nat A,(Z.to_nat B,tt)) -> + consistent m2 (Z.to_nat B,(Z.to_nat C,tt)) -> + matmul A B C m1 m2 = + matmul_tiled)%Z As matmultiled. Proof. reschedule. - wrapid^ @flatten_truncr_tile_id' around (GEN [ _ < (Z.of_nat A) ] _) + wrapid^ @flatten_truncr_tile_id' around (GEN [ _ < A ] _) with (Z.to_nat k). inline tile. @@ -47,47 +47,57 @@ Section Tile. rw @consistent_length. rw @consistent_length. rw @get_gen_some. - rw^ @gp_gen_iverson. + rw^ @gp_gen_iverson. rw @get_gen_some. - rewrite Z2Nat.id by lia. - - wrapid^ @flatten_truncr_tile_id' around (GEN [ _ < (Z.of_nat C) ] _) + + wrapid^ @flatten_truncr_tile_id' around (GEN [ _ < C ] _) with (Z.to_nat k). inline tile. rw @get_gen_some. - rw^ @gp_gen_iverson. + rw^ @gp_gen_iverson. rw @gp_double_iverson. + + rw truncr_Truncr. + Fail progress rw truncr_Truncr. rewrite truncr_Truncr. (*??*) + rewrite Nat2Z.inj_sub. + 2: { apply div_ceil_n_lower_bound. lia. } + rewrite Nat2Z.inj_sub. + 2: { apply div_ceil_n_lower_bound. lia. } + do 2 rewrite Nat2Z.inj_mul. + do 2 rewrite <- of_nat_div_distr. + do 3 rewrite Z2Nat.id by lia. + done. Defined. End Tile. -Hint Unfold matmul matmul_tiled : examples. +Hint Unfold matmul matmul_tiled : examples. Hint Resolve floor_lt_ceil Z.div_pos : crunch. Section Tile. - Variables (A B C : nat) (m1 m2 : (list (list R))) (k : Z). + Variables (A B C : Z) (m1 m2 : (list (list R))) (k : Z). Derive matmul_tiled_split SuchThat - ((0 < k)%Z -> + (0 < k -> 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_split) As matmultiledsplit. + consistent m1 (Z.to_nat A,(Z.to_nat B,tt)) -> + consistent m2 (Z.to_nat B,(Z.to_nat C,tt)) -> + matmul A B C m1 m2 = + matmul_tiled_split)%Z As matmultiledsplit. Proof. reschedule. - wrapid^ @flatten_truncr_tile_id' around (GEN [ _ < (Z.of_nat A) ] _) + wrapid^ @flatten_truncr_tile_id' around (GEN [ _ < A ] _) with (Z.to_nat k). inline tile. rw @get_gen_some. - rw^ @split_gen at (Z.of_nat A / k )%Z. + rw^ @split_gen at (A / k )%Z. simpl_guard. wrapid^ @transpose_transpose_id around (GEN [ _ < k ] _). @@ -96,23 +106,31 @@ Section Tile. rw @consistent_length. rw @consistent_length. rw @get_gen_some. - rw^ @gp_gen_iverson. + rw^ @gp_gen_iverson. rw @get_gen_some. - rewrite Z2Nat.id by lia. - wrapid^ @flatten_truncr_tile_id' around (GEN [ _ < (Z.of_nat C) ] _) + wrapid^ @flatten_truncr_tile_id' around (GEN [ _ < C ] _) with (Z.to_nat k). inline tile. rw @get_gen_some. - rw^ @gp_gen_iverson. + rw^ @gp_gen_iverson. - rw^ @split_gen upto (Z.of_nat C // k)%Z at (Z.of_nat C / k )%Z. + rw^ @split_gen upto (C // k)%Z at (C / k )%Z. simpl_guard. + rw truncr_Truncr. + Fail progress rw truncr_Truncr. rewrite truncr_Truncr. (*??*) + rewrite Nat2Z.inj_sub. + 2: { apply div_ceil_n_lower_bound. lia. } + rewrite Nat2Z.inj_sub. + 2: { apply div_ceil_n_lower_bound. lia. } + do 2 rewrite Nat2Z.inj_mul. + do 2 rewrite <- of_nat_div_distr. + do 3 rewrite Z2Nat.id by lia. + done. Defined. End Tile. -Hint Unfold matmul_tiled_split : examples. - +Hint Unfold matmul_tiled_split : examples. diff --git a/src/examples/TensorAdd.v b/src/examples/TensorAdd.v index 2afa53f..25202f9 100644 --- a/src/examples/TensorAdd.v +++ b/src/examples/TensorAdd.v @@ -20,7 +20,7 @@ Definition add A B C D (m1 m2 : (list (list (list (list R))))) := GEN [ l < D ] (m1 _[i;j;k;l] * m2 _[i;j;k;l])%R. -Hint Unfold add : examples. +Hint Unfold add : examples. Hint Resolve Z.div_lt_upper_bound mul_add_lt : crunch. Lemma mul_add_lt : forall i j k A C, @@ -35,23 +35,22 @@ Proof. rewrite Z.mod_small by lia. reflexivity. - inversion H2. subst. rewrite div_mod_eq by lia. reflexivity. -Qed. +Qed. Section Add. - Variables (A B C D : nat) (m1 m2 : (list (list (list (list R))))). + Variables (A B C D : Z) (m1 m2 : (list (list (list (list R))))). Derive add_split SuchThat (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) As matmultiled. + consistent m1 (Z.to_nat A,(Z.to_nat B,(Z.to_nat C,(Z.to_nat D,tt)))) -> + consistent m2 (Z.to_nat A,(Z.to_nat B,(Z.to_nat C,(Z.to_nat D,tt)))) -> + add A B C D m1 m2 = add_split)%Z As matmultiled. Proof. reschedule. - wrapid^ @tile_flatten_id around (GEN [ _ < (Z.of_nat A) ] _). + wrapid^ @tile_flatten_id around (GEN [ _ < A ] _). inline flatten. rw @consistent_length. @@ -92,8 +91,14 @@ Section Add. rw @sum_bound_indic_no_f_guard. repeat rw Z.div_div. + + rw tile_Tile. + Fail progress rw tile_Tile. rewrite tile_Tile. + Fail progress rw tile_Tile. rewrite tile_Tile. + do 3 rewrite Z2Nat.id by lia. + done. Defined. End Add. -Hint Unfold add add_split : examples. +Hint Unfold add add_split : examples. diff --git a/src/verified_lowering/count_reshape/Count.v b/src/verified_lowering/count_reshape/Count.v index 83727f3..c61ba83 100644 --- a/src/verified_lowering/count_reshape/Count.v +++ b/src/verified_lowering/count_reshape/Count.v @@ -10,18 +10,15 @@ From Stdlib Require Import Strings.String. From Stdlib Require Import Logic.FunctionalExtensionality. From Stdlib Require Import Lists.List. From Stdlib Require Import micromega.Lia. -From Stdlib Require Import Reals.Rpower. Import ListNotations. -Set Warnings "-omega-is-deprecated,-deprecated". - +From Inferpad Require Import Reify ReifyExamples ATLPhoas TensorToResult ATLSpecs. From ATL Require Import Div ATL. From Examples Require Import Blur TensorAdd Im2col Convolution GatherScatter Matmul. From Codegen Require Import IdentParsing NatToString IntToString Normalize. From Lower Require Import ATLDeep Sexpr Zexpr Bexpr. -From Inferpad Require Import Reify. Open Scope string_scope. Hint Extern 6 (_ < _)%Z => lia : crunch. @@ -133,8 +130,7 @@ Fixpoint count_split e : nat := | Scalar _ => 0 end. -Ltac print_counts name := - let e := Reify.R in +Ltac print_counts e name := let gen_count := constr:(count_gen e) in let gen_count := constr:(nat_to_string gen_count) in let concat_count := constr:(count_concat e) in @@ -150,8 +146,8 @@ Ltac print_counts name := let str := constr:((name++"," ++gen_count++"," ++concat_count++"," - ++truncate_count++"," - ++transpose_count++"," + ++truncate_count++"," + ++transpose_count++"," ++flatten_count++"," ++split_count)) in let str := eval unfold nat_to_string in str in @@ -159,166 +155,120 @@ Ltac print_counts name := idtac str. Goal True. -Proof. idtac "program,gen,concat,truncate,transpose,flatten,split". 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. +(*this is very wrong, but idk what the right answer is*) +Definition gather_full_args := + [Z_arg "W"; + Z_arg "C"; + Z_arg "B"; + Z_arg "K"; + Z_arg "RR"; + T_arg "x" [!"RR"!; !"RR"!; !"RR"!]%z; + T_arg "w" [!"RR"!; !"RR"!; !"RR"!]%z]. + +Definition gather_full_precond := + fun W C B K RR (_ _ : dim_n 3) => (0 < C /\ 0 < W /\ W <= C /\ 0 < K /\ 0 < RR /\ 0 < B)%Z. + +Derive gather_full_string in + (stringy_spec_of [tZ; tZ; tZ; tZ; tZ; tensor_n 3; tensor_n 3] 3 gather_full_args gather_full_string gather_full_precond (fun W C B K RR x w => gather_full W C B K x w RR)) + as gather_full_string_correct. Proof. - intros. autounfold with examples. - print_counts "gather". + cbv [gather_full_precond gather_full]. prove_stringy_spec. + (*TODO idk what is wrong or how to make these true*) + all: destruct (f : False). +Qed. + +Goal True. + print_counts gather_full_string "gather". 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. +(*this is no more correct than gather*) +Derive scatter_full_string in + (stringy_spec_of [tZ; tZ; tZ; tZ; tZ; tensor_n 3; tensor_n 3] 3 gather_full_args scatter_full_string gather_full_precond (fun W C B K RR x w => scatter_full B K W C x w)) + as scatter_full_string_correct. Proof. - intros. autounfold with examples. - print_counts "scatter". + cbv [gather_full_precond scatter_full]. prove_stringy_spec. + (*TODO idk what is wrong or how to make these true*) + all: destruct (f : False). +Qed. + +Goal True. + print_counts scatter_full_string "scatter". 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. - intros. autounfold with examples. - print_counts "im2col conv". -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. - intros. autounfold with examples. - print_counts "im2col mat". -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. +(*TODO: obviously wrong*) +Definition im2col_args := + [Z_arg "B"; + Z_arg "K"; + Z_arg "W"; + Z_arg "C"; + Z_arg "RR"; + T_arg "w" [ZLit 0; ZLit 0; ZLit 0]; + T_arg "x" [ZLit 0; ZLit 0; ZLit 0]]. + +Definition im2col_precond := + fun (B K W C RR : Z) (_ _ : dim_n 3) => (0 < W /\ 0 < K /\ 0 < B /\ 0 < C /\ 0 < RR)%Z. + +Derive im2col_string in + (stringy_spec_of [tZ; tZ; tZ; tZ; tZ; tensor_n 3; tensor_n 3] 3 im2col_args im2col_string im2col_precond im2col) + as im2col_string_correct. Proof. - intros. autounfold with examples. - print_counts "matmul". + cbv [im2col_precond im2col]. prove_stringy_spec. + (*TODO idk what is wrong or how to make these true*) + all: destruct (f : False). +Qed. + +Goal True. + print_counts im2col_string "im2col conv". 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. +Derive im2col_lifted_string in + (stringy_spec_of [tZ; tZ; tZ; tZ; tZ; tensor_n 3; tensor_n 3] 3 im2col_args im2col_lifted_string im2col_precond im2col_lifted) + as im2col_lifted_string_correct. Proof. - intros. autounfold with examples. - print_counts "tiled matmul". + cbv [im2col_precond im2col_lifted]. prove_stringy_spec. + (*TODO idk what is wrong or how to make these true*) + all: destruct (f : False). +Qed. + +Goal True. + print_counts im2col_lifted_string "im2col mat". 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. - intros. autounfold with examples. - print_counts "tiled+tails matmul". +Goal True. + print_counts matmul_string "matmul". Abort. -Goal forall N M (v : list (list R)), - 2 < N -> - 2 < M -> - consistent v (N,(M,tt)) -> - blurtwostage N M v = blurimmediate v M N. -Proof. - intros. autounfold with examples. - print_counts "two-stage blur". +Goal True. + print_counts matmul_tiled64_string "tiled matmul". Abort. -Goal forall N M (v : list (list R)), - 0 < N -> - 0 < M -> - consistent v (N,(M,tt)) -> - blurimmediate v M N = blurtwostage N M v. -Proof. - intros. autounfold with examples. - print_counts "fused blur". +Goal True. + print_counts matmul_tiled_split64_string "tiled+tails matmul". Abort. -Goal forall N M (v : list (list R)), - 0 < N -> - 0 < M -> - consistent v (N,(M,tt)) -> - blurimmediate_partition M N v = blurtwostage N M v. -Proof. - intros. autounfold with examples. - print_counts "fused+tails blur". +Goal True. + print_counts blurtwostage_string "two-stage blur". 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. - intros. autounfold with examples. - print_counts "tiled+tails+staged blur". +Goal True. + print_counts blurimmediate_string "fused blur". 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. - intros. autounfold with examples. - print_counts "tensor add". -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. - intros. autounfold with examples. - print_counts "split tensor add". -Abort. +Goal True. + print_counts blurimmediate_partition_string "fused+tails blur". +Abort. +Goal True. + print_counts blur_tiles_guarded4_string "tiled+tails+staged blur". +Abort. + +Goal True. + print_counts add_string "tensor add". +Abort. + +Goal True. + print_counts add_split_string "split tensor add". +Abort. diff --git a/src/verified_lowering/inferpad/ATLPhoas.v b/src/verified_lowering/inferpad/ATLPhoas.v new file mode 100644 index 0000000..bf490d2 --- /dev/null +++ b/src/verified_lowering/inferpad/ATLPhoas.v @@ -0,0 +1,1447 @@ +From Stdlib Require Import Arith.Arith. +From Stdlib Require Import Reals.Reals. +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 QArith. + +Import ListNotations. + +From ATL Require Import Common Map Sets FrapWithoutSets Div Tactics ATL. +From Lower Require Import Zexpr Bexpr Array Range Sexpr ListMisc + Constant ATLDeep Result. +From Inferpad Require Import NatToString TensorToResult. + +Notation S := Datatypes.S. + +Local Set Default Goal Selector "!". + +Open Scope list_scope. +Open Scope nat_scope. + +Inductive type := +| tZ +| tB +| tensor_n (n : nat). + +Definition interp_type t : Type := + match t with + | tZ => Z + | tB => bool + | tensor_n n => dim_n n + end. + +Variant Zbop := ZPlus | ZMinus | ZTimes | ZDivf | ZDivc | ZMod. + +Definition interp_Zbop o x y := + match o with + | ZPlus => (x + y) + | ZMinus => (x - y) + | ZTimes => (x * y) + | ZDivf => (x / y) + | ZDivc => (x // y) + | ZMod => (x mod y) + end%Z. + +Inductive pZexpr { var } := +| ZBop : Zbop -> pZexpr -> pZexpr -> pZexpr +| ZVar : var -> pZexpr +| ZZ0 : pZexpr +| ZZpos : positive -> pZexpr +| ZZneg : positive -> pZexpr +| ZZ_of_nat : nat -> pZexpr +| ZZopp : pZexpr -> pZexpr. +Arguments pZexpr : clear implicits. + +Variant tagged_Z := argvarZ (_ : Z) | itervarZ (_ : Z). +Definition untag_Z x := + match x with + | itervarZ x => x + | argvarZ x => x + end. +Coercion untag_Z : tagged_Z >-> Z. + +Variant tagged_string := argvarstr (_ : string) | itervarstr (_ : string). +Definition untag_string x := + match x with + | itervarstr x => x + | argvarstr x => x + end. +Coercion untag_string : tagged_string >-> string. + +Definition interp_type_tagged t : Type := + match t with + | tZ => tagged_Z + | tB => bool + | tensor_n n => dim_n n + end. + +Fixpoint interp_pZexpr (e : pZexpr tagged_Z) : Z := + match e with + | ZBop o x y => interp_Zbop o (interp_pZexpr x) (interp_pZexpr y) + | ZVar x => x + | ZZ0 => 0 + | ZZpos p => Zpos p + | ZZneg p => Zneg p + | ZZ_of_nat n => Z.of_nat n + | ZZopp x => - interp_pZexpr x + end. + +Fixpoint sizeof_pZexpr {var} (sizeof_var : var -> option Z) (e : pZexpr var) : option Z := + match e with + | ZBop o x y => + match sizeof_pZexpr sizeof_var x, sizeof_pZexpr sizeof_var y with + | Some x', Some y' => Some (interp_Zbop o x' y') + | _, _ => None + end + | ZVar x => sizeof_var x + | ZZ0 => Some 0%Z + | ZZpos p => Some (Zpos p) + | ZZneg p => Some (Zneg p) + | ZZ_of_nat n => Some (Z.of_nat n) + | ZZopp x => option_map (fun x => -x)%Z (sizeof_pZexpr sizeof_var x) + end. + +Variant Bbop := BLt | BLe | BEq. + +Definition interp_Bbop o x y := + match o with + | BLt => (x (x <=? y) + | BEq => (x =? y) + end%Z. + +Inductive pBexpr { var } := +| BAnd : pBexpr -> pBexpr -> pBexpr +| BBop : Bbop -> pZexpr var -> pZexpr var -> pBexpr. +Arguments pBexpr : clear implicits. + +Fixpoint interp_pBexpr (e : pBexpr tagged_Z) : bool := + match e with + | BBop o x y => interp_Bbop o (interp_pZexpr x) (interp_pZexpr y) + | BAnd x y => interp_pBexpr x && interp_pBexpr y + end. + +Variant Sbop := Mul | Add | Div | Sub. + +Definition interp_Sbop o x y := + match o with + | Mul => x * y + | Add => x + y + | Div => x / y + | Sub => x - y + end%R. + +Inductive pATLexpr { var : type -> Type } : nat -> Type := +| Gen {n} : pZexpr (var tZ) -> pZexpr (var tZ) -> (var tZ -> pATLexpr n) -> pATLexpr (S n) +| Sum {n} : pZexpr (var tZ) -> pZexpr (var tZ) -> (var tZ -> pATLexpr n) -> pATLexpr n +| Guard {n} : pBexpr (var tZ) -> pATLexpr n -> pATLexpr n +| Lbind {n m} : pATLexpr n -> (var (tensor_n n) -> pATLexpr m) -> pATLexpr m +| Concat {n} : pATLexpr (S n) -> pATLexpr (S n) -> pATLexpr (S n) +| Flatten {n} : pATLexpr (S (S n)) -> pATLexpr (S n) +| Split {n} : pZexpr (var tZ) -> pATLexpr (S n) -> pATLexpr (S (S n)) +| Transpose {n} : pATLexpr (S (S n)) -> pATLexpr (S (S n)) +| Truncr {n} : pZexpr (var tZ) -> pATLexpr (S n) -> pATLexpr (S n) +| Truncl {n} : pZexpr (var tZ) -> pATLexpr (S n) -> pATLexpr (S n) +| Padr {n} : pZexpr (var tZ) -> pATLexpr (S n) -> pATLexpr (S n) +| Padl {n} : pZexpr (var tZ) -> pATLexpr (S n) -> pATLexpr (S n) +| Var {n} : var (tensor_n n) -> pATLexpr n +| Get {n} : pATLexpr n -> list (pZexpr (var tZ)) -> pATLexpr O +| SBop : Sbop -> pATLexpr O -> pATLexpr O -> pATLexpr O +| SIZR : pZexpr (var tZ) -> pATLexpr O +. +Arguments pATLexpr : clear implicits. + +Fixpoint fun_type (var : type -> Type) (ts : list type) (T : Type) : Type := + match ts with + | [] => T + | t :: ts' => var t -> fun_type var ts' T + end. + +Fixpoint get_R {n} (v : dim_n n) (idxs : list Z) := + match n, idxs return dim_n n -> R with + | S n', idx :: idxs' => + fun v => get_R (get v idx) idxs' + | O, _ => fun v => v + | _, _ => fun v => 0%R (*garbage*) + end v. + +Fixpoint interp_pATLexpr {n} (e : pATLexpr interp_type_tagged n) : interp_type (tensor_n n) := + match e with + | Gen lo hi body => + genr (interp_pZexpr lo) (interp_pZexpr hi) (fun x => interp_pATLexpr (body (itervarZ x))) + | Sum lo hi body => + sumr (interp_pZexpr lo) (interp_pZexpr hi) (fun x => interp_pATLexpr (body (itervarZ x))) + | Guard b e1 => iverson (interp_pBexpr b) (interp_pATLexpr e1) + | Lbind x f => let_binding (interp_pATLexpr x) (fun x0 => interp_pATLexpr (f x0)) + | Concat x y => concat (interp_pATLexpr x) (interp_pATLexpr y) + | Flatten x => Common.flatten (interp_pATLexpr x) + | Split k x => Tile (interp_pATLexpr x) (interp_pZexpr k) + | Transpose x => transpose (interp_pATLexpr x) + | Truncr k x => Common.Truncr (interp_pZexpr k) (interp_pATLexpr x) + | Truncl k x => Common.Truncl (interp_pZexpr k) (interp_pATLexpr x) + | Padl k x => Common.Padl (interp_pZexpr k) (interp_pATLexpr x) + | Padr k x => Common.Padr (interp_pZexpr k) (interp_pATLexpr x) + | Var x => x + | Get x idxs => get_R (interp_pATLexpr x) (map interp_pZexpr idxs) + | SBop o x y => interp_Sbop o (interp_pATLexpr x) (interp_pATLexpr y) + | SIZR x => IZR (interp_pZexpr x) + end. + +Definition fvar_pATLexpr (var : type -> Type) (ts : list type) (n : nat) := + fun_type var ts (pATLexpr var n). + +Definition fvar_type var (ts : list type) n := + fun_type var ts (var (tensor_n n)). + +Fixpoint interp_fvar_pATLexpr ts n (e : fvar_pATLexpr interp_type_tagged ts n) : fvar_type interp_type ts n := + match ts return fvar_pATLexpr _ ts n -> fvar_type _ ts n with + | [] => fun e => interp_pATLexpr e + | tZ :: ts' => fun e => fun x => interp_fvar_pATLexpr ts' n (e (argvarZ x)) + | _ :: ts' => fun e => fun x => interp_fvar_pATLexpr ts' n (e x) + end e. + +Section well_formed. + Context (var1 var2 : type -> Type). + Record ctx_elt2 := + { ctx_elt_t : type; ctx_elt_p1 : var1 ctx_elt_t; ctx_elt_p2 : var2 ctx_elt_t }. + + Inductive wf_Zexpr (ctx : list ctx_elt2) : pZexpr (var1 tZ) -> pZexpr (var2 tZ) -> Prop := + | wf_ZBop o x1 x2 y1 y2 : + wf_Zexpr _ x1 x2 -> + wf_Zexpr _ y1 y2 -> + wf_Zexpr _ (ZBop o x1 y1) (ZBop o x2 y2) + | wf_ZVar v1 v2 : + List.In {| ctx_elt_p1 := v1; ctx_elt_p2 := v2 |} ctx -> + wf_Zexpr _ (ZVar v1) (ZVar v2) + | wf_ZZ0 : + wf_Zexpr _ ZZ0 ZZ0 + | wf_ZZpos p : + wf_Zexpr _ (ZZpos p) (ZZpos p) + | wf_ZZneg p : + wf_Zexpr _ (ZZneg p) (ZZneg p) + | wf_ZZ_of_nat n : + wf_Zexpr _ (ZZ_of_nat n) (ZZ_of_nat n) + | wf_ZZopp x1 x2 : + wf_Zexpr _ x1 x2 -> + wf_Zexpr _ (ZZopp x1) (ZZopp x2). + + Inductive wf_Bexpr (ctx : list ctx_elt2) : pBexpr (var1 tZ) -> pBexpr (var2 tZ) -> Prop := + | wf_BAnd x1 x2 y1 y2 : + wf_Bexpr _ x1 x2 -> + wf_Bexpr _ y1 y2 -> + wf_Bexpr _ (BAnd x1 y1) (BAnd x2 y2) + | wf_BBop o x1 x2 y1 y2 : + wf_Zexpr ctx x1 x2 -> + wf_Zexpr ctx y1 y2 -> + wf_Bexpr _ (BBop o x1 y1) (BBop o x2 y2) + . + + Inductive wf_ATLexpr : list ctx_elt2 -> forall n, pATLexpr var1 n -> pATLexpr var2 n -> Prop := + | wf_Gen ctx n lo1 lo2 hi1 hi2 body1 body2 : + wf_Zexpr ctx lo1 lo2 -> + wf_Zexpr ctx hi1 hi2 -> + (forall x1 x2, wf_ATLexpr ({| ctx_elt_p1 := x1; ctx_elt_p2 := x2 |} :: ctx) n (body1 x1) (body2 x2)) -> + wf_ATLexpr ctx _ (Gen lo1 hi1 body1) (Gen lo2 hi2 body2) + | wf_Sum ctx n lo1 lo2 hi1 hi2 body1 body2 : + wf_Zexpr ctx lo1 lo2 -> + wf_Zexpr ctx hi1 hi2 -> + (forall x1 x2, wf_ATLexpr ({| ctx_elt_p1 := x1; ctx_elt_p2 := x2 |} :: ctx) n (body1 x1) (body2 x2)) -> + wf_ATLexpr ctx _ (Sum lo1 hi1 body1) (Sum lo2 hi2 body2) + | wf_Guard ctx n b1 x1 b2 x2 : + wf_Bexpr ctx b1 b2 -> + wf_ATLexpr ctx n x1 x2 -> + wf_ATLexpr ctx _ (Guard b1 x1) (Guard b2 x2) + | wf_Lbind ctx n m x1 x2 f1 f2 : + wf_ATLexpr ctx n x1 x2 -> + (forall x1' x2', wf_ATLexpr ({| ctx_elt_p1 := x1'; ctx_elt_p2 := x2' |} :: ctx) m (f1 x1') (f2 x2')) -> + wf_ATLexpr ctx _ (Lbind x1 f1) (Lbind x2 f2) + | wf_Concat ctx n x1 x2 y1 y2 : + wf_ATLexpr ctx (S n) x1 x2 -> + wf_ATLexpr ctx (S n) y1 y2 -> + wf_ATLexpr ctx _ (Concat x1 y1) (Concat x2 y2) + | wf_Flatten ctx n x1 x2 : + wf_ATLexpr ctx (S (S n)) x1 x2 -> + wf_ATLexpr ctx _ (Flatten x1) (Flatten x2) + | wf_Split ctx n k1 k2 x1 x2 : + wf_Zexpr ctx k1 k2 -> + wf_ATLexpr ctx (S n) x1 x2 -> + wf_ATLexpr ctx _ (Split k1 x1) (Split k2 x2) + | wf_Transpose ctx n x1 x2 : + wf_ATLexpr ctx (S (S n)) x1 x2 -> + wf_ATLexpr ctx _ (Transpose x1) (Transpose x2) + | wf_Truncr ctx n k1 k2 x1 x2 : + wf_Zexpr ctx k1 k2 -> + wf_ATLexpr ctx (S n) x1 x2 -> + wf_ATLexpr ctx _ (Truncr k1 x1) (Truncr k2 x2) + | wf_Truncl ctx n k1 k2 x1 x2 : + wf_Zexpr ctx k1 k2 -> + wf_ATLexpr ctx (S n) x1 x2 -> + wf_ATLexpr ctx _ (Truncl k1 x1) (Truncl k2 x2) + | wf_Padl ctx n k1 k2 x1 x2 : + wf_Zexpr ctx k1 k2 -> + wf_ATLexpr ctx (S n) x1 x2 -> + wf_ATLexpr ctx _ (Padl k1 x1) (Padl k2 x2) + | wf_Padr ctx n k1 k2 x1 x2 : + wf_Zexpr ctx k1 k2 -> + wf_ATLexpr ctx (S n) x1 x2 -> + wf_ATLexpr ctx _ (Padr k1 x1) (Padr k2 x2) + | wf_Var ctx n v1 v2 : + List.In {| ctx_elt_p1 := v1; ctx_elt_p2 := v2 |} ctx -> + wf_ATLexpr ctx n (Var v1) (Var v2) + | wf_Get ctx n x1 x2 idxs1 idxs2 : + wf_ATLexpr ctx n x1 x2 -> + Forall2 (wf_Zexpr ctx) idxs1 idxs2 -> + wf_ATLexpr ctx _ (Get x1 idxs1) (Get x2 idxs2) + | wf_SBop ctx o x1 x2 y1 y2 : + wf_ATLexpr ctx _ x1 x2 -> + wf_ATLexpr ctx _ y1 y2 -> + wf_ATLexpr ctx _ (SBop o x1 y1) (SBop o x2 y2) + | wf_SIZR ctx x1 x2 : + wf_Zexpr ctx x1 x2 -> + wf_ATLexpr ctx _ (SIZR x1) (SIZR x2) + . + + Inductive wf_fvar_ATLexpr : list ctx_elt2 -> forall ts n, fvar_pATLexpr var1 ts n -> fvar_pATLexpr var2 ts n -> Prop := + | wf_no_fvar ctx n e1 e2 : + wf_ATLexpr ctx n e1 e2 -> + wf_fvar_ATLexpr ctx [] n e1 e2 + | wf_with_fvar ctx t ts n e1 e2 : + (forall x1 x2, wf_fvar_ATLexpr ({| ctx_elt_p1 := x1; ctx_elt_p2 := x2 |} :: ctx) ts n (e1 x1) (e2 x2)) -> + wf_fvar_ATLexpr ctx (t :: ts) n e1 e2. +End well_formed. + +Definition fvar_pATLExpr ts n := forall var, fvar_pATLexpr var ts n. + +Definition Wf_fvar_ATLExpr {ts n} (e : fvar_pATLExpr ts n) := + forall var1 var2, wf_fvar_ATLexpr var1 var2 [] _ _ (e var1) (e var2). + +Fixpoint sound_sizeof {var n} (dummy : forall t, var t) (sizeof_var : var tZ -> option Z) (e : pATLexpr var n) : option (list nat) := + match e with + | Gen lo hi body => + match sound_sizeof dummy sizeof_var (body (dummy _)), sizeof_pZexpr sizeof_var lo, sizeof_pZexpr sizeof_var hi with + | Some sz, Some lo', Some hi' => + let n := Z.to_nat (hi' - lo') in + (*for reasons described below (truncl case), + we check that the tensor has nonzero length*) + if (0 None + end + | Sum lo hi body => + sound_sizeof dummy sizeof_var (body (dummy _)) + | Guard p body => + sound_sizeof dummy sizeof_var body + | Lbind e1 e2 => + match sound_sizeof dummy sizeof_var e1 with + | Some _ => sound_sizeof dummy sizeof_var (e2 (dummy _)) + | None => None + end + | Concat x y => + match sound_sizeof dummy sizeof_var x, sound_sizeof dummy sizeof_var y with + | Some (nx :: restx), Some (ny :: resty) => + if list_eqb Nat.eqb restx resty then + Some (nx + ny :: restx) + else + None + | _, _ => None + end + | Flatten e => + match sound_sizeof dummy sizeof_var e with + | Some (a :: b :: rest) => Some (a * b :: rest) + | _ => None + end + | Split k e => + match sound_sizeof dummy sizeof_var e with + | Some (a :: rest) => + match sizeof_pZexpr sizeof_var k with + | Some k => + if (0 None + end + | _ => None + end + | Transpose e => + match sound_sizeof dummy sizeof_var e with + | Some (a :: b :: rest) => Some (b :: a :: rest) + | _ => None + end + | Truncr n e | Truncl n e => + match sound_sizeof dummy sizeof_var e with + | Some (m :: rest) => + (*note: ATLDeep.size_of only requires n <=? m. + here, we also check n + if (Z.to_nat n None + end + | _ => None + end + | Padr n e => + match sound_sizeof dummy sizeof_var e with + | Some (m :: rest) => + match sizeof_pZexpr sizeof_var n with + | Some n => + Some (m + Z.to_nat n :: rest) + | None => None + end + | _ => None + end + | Padl n e => + match sound_sizeof dummy sizeof_var e with + | Some (m :: rest) => + match sizeof_pZexpr sizeof_var n with + | Some n => + Some (Z.to_nat n + m :: rest) + | None => None + end + | _ => None + end + | @Var _ n _ => + match n with + | O => Some [] + | _ => None + end + | @Get _ n v idxs => + if (length idxs =? n)%nat then + match v with + | Var _ => Some [] + | _ => None + end + else None + | SBop _ x y => + match sound_sizeof dummy sizeof_var x, sound_sizeof dummy sizeof_var y with + | Some _, Some _ => Some [] + | _, _ => None + end + | SIZR _ => Some [] + end. + +Definition sizeof {var n} dummy sizeof_var (e : pATLexpr var n) := + match sound_sizeof dummy sizeof_var e with + | Some x => x + | None => [] + end. + +Definition interp_type_result t : Type := + match t with + | tZ => tagged_Z + | tB => bool + | tensor_n _ => result + end. + +Definition dummy_result (t : type) : interp_type_result t := + match t with + | tZ => itervarZ 0%Z + | tB => false + | tensor_n _ => V [] + end. + +Fixpoint eval_get' x idxs := + match x, idxs with + | V xs, i :: idxs' => + eval_get' (nth_default (Result.S SX) xs (Z.to_nat i)) idxs' + | Result.S s, [] => s + | _, _ => SX + end. + +Definition sizeof_Z x := + match x with + | argvarZ y => Some y + | itervarZ y => None + end. + +Fixpoint result_of_pATLexpr {n} (e : pATLexpr interp_type_result n) : Result.result := + match e in pATLexpr _ n with + | @Gen _ n lo hi body => + V (map (fun x => result_of_pATLexpr (body (itervarZ x))) (zrange (interp_pZexpr lo) (interp_pZexpr hi))) + | Sum lo hi body => + sum_with_sz (sizeof dummy_result sizeof_Z e) + (interp_pZexpr lo) (interp_pZexpr hi) (fun x => result_of_pATLexpr (body (itervarZ x))) + | Guard b e1 => if (interp_pBexpr b) then (result_of_pATLexpr e1) else gen_pad (sizeof dummy_result sizeof_Z e1) + | Lbind x f => let_binding (result_of_pATLexpr x) (fun x0 => result_of_pATLexpr (f x0)) + | Concat x y => + match result_of_pATLexpr x, result_of_pATLexpr y with + | V xs, V ys => V (xs ++ ys) + | _, _ => V [] + end + | Flatten x => + match result_of_pATLexpr x with + | V l => V (flatten_result l) + | _ => V [] + end + | Split k x => + match result_of_pATLexpr x with + | V xs => V (split_result (Z.to_nat (interp_pZexpr k)) xs) + | _ => V [] + end + | Transpose x => + match result_of_pATLexpr x, sizeof dummy_result sizeof_Z x with + | V xs, n :: m :: sh => transpose_result xs (m :: n :: sh) + | _, _ => V [] + end + | Truncr k x => + match result_of_pATLexpr x with + | V xs => V (rev (skipn (Z.to_nat (interp_pZexpr k)) (rev xs))) + | _ => V [] + end + | Truncl k x => + match result_of_pATLexpr x with + | V xs => V (skipn (Z.to_nat (interp_pZexpr k)) xs) + | _ => V [] + end + | Padl k x => + match result_of_pATLexpr x, sizeof dummy_result sizeof_Z x with + | V xs, _ :: sh => V (gen_pad_list (Z.to_nat (interp_pZexpr k) :: sh) ++ xs) + | _, _ => V [] + end + | Padr k x => + match result_of_pATLexpr x, sizeof dummy_result sizeof_Z x with + | V xs, _ :: sh => V (xs ++ gen_pad_list (Z.to_nat (interp_pZexpr k) :: sh)) + | _, _ => V [] + end + | Var x => + (*why is it not just x here :( *) + match x with + | Result.V _ => Result.S (SS 0) + | Result.S (SS _) => x + | Result.S SX => Result.S (SS 0) + end + | Get x idxs => + match x with + | Var y => + let r := eval_get' y (map interp_pZexpr idxs) in + Result.S + (* why is this not just r *) + match r with + | Result.SS _ => r + | Result.SX => Result.SS 0%R + end + | _ => Result.S SX + end + | SBop o x y => + match result_of_pATLexpr x, result_of_pATLexpr y with + | Result.S x0, Result.S y0 => Result.S (bin_scalar_result (interp_Sbop o) x0 y0) + | _, _ => Result.S SX (*garbage, but this being zero-dimensional makes sound_sizeof simpler*) + end + | SIZR x => Result.S (Result.SS (IZR (interp_pZexpr x))) + end. + +(*"unnatify" as in https://github.com/mit-plv/reification-by-parametricity/blob/d1bc17cf99a66e0268f655e28cdb375e712cd831/MiscIntro.v#L316 *) +(*we probably don't even need the speed here, and furthermore i'm probably doing enough + nonsense in other places that the efficiency of proving + well-formedness doesn't even matter... + but why not*) + +Record ctx_elt var := { ctx_elt_t0 : type; ctx_elt0 : var ctx_elt_t0 }. + +Fixpoint unnatify_Z {var} (ctx : list (ctx_elt var)) (e : pZexpr nat) : pZexpr (var tZ) := + match e with + | ZBop o x y => ZBop o (unnatify_Z ctx x) (unnatify_Z ctx y) + | ZVar v => match nth_error (rev ctx) v with + | Some {| ctx_elt_t0 := t; ctx_elt0 := x |} => + match t return var t -> _ with + | tZ => fun x => ZVar x + | _ => fun _ => ZZ0 + end x + | None => ZZ0 + end + | ZZ0 => ZZ0 + | ZZpos p => ZZpos p + | ZZneg p => ZZneg p + | ZZ_of_nat n => ZZ_of_nat n + | ZZopp x => ZZopp (unnatify_Z ctx x) + end. + +Fixpoint unnatify_B {var} (ctx : list (ctx_elt var)) (e : pBexpr nat) : pBexpr (var tZ) := + match e with + | BAnd x y => BAnd (unnatify_B ctx x) (unnatify_B ctx y) + | BBop o x y => BBop o (unnatify_Z ctx x) (unnatify_Z ctx y) + end. + +Fixpoint dummy {var n} : pATLexpr var n := + match n with + | S n' => Gen ZZ0 ZZ0 (fun _ => dummy) + | O => SIZR ZZ0 + end. + +Fixpoint unnatify {var n} (ctx : list (ctx_elt var)) (e : pATLexpr (fun _ => nat) n) : pATLexpr var n := + match e with + | Gen lo hi body => + Gen (unnatify_Z ctx lo) (unnatify_Z ctx hi) + (fun x => unnatify ({| ctx_elt0 := x |} :: ctx) (body (length ctx))) + | Sum lo hi body => + Sum (unnatify_Z ctx lo) (unnatify_Z ctx hi) + (fun x => unnatify ({| ctx_elt0 := x |} :: ctx) (body (length ctx))) + | Guard b e1 => + Guard (unnatify_B ctx b) (unnatify ctx e1) + | Lbind x f => + Lbind (unnatify ctx x) + (fun x => unnatify ({|ctx_elt0 := x |} :: ctx) (f (length ctx))) + | Concat x y => Concat (unnatify ctx x) (unnatify ctx y) + | Flatten x => Flatten (unnatify ctx x) + | Split k x => Split (unnatify_Z ctx k) (unnatify ctx x) + | Transpose x => Transpose (unnatify ctx x) + | Truncr k x => Truncr (unnatify_Z ctx k) (unnatify ctx x) + | Truncl k x => Truncl (unnatify_Z ctx k) (unnatify ctx x) + | Padl k x => Padl (unnatify_Z ctx k) (unnatify ctx x) + | Padr k x => Padr (unnatify_Z ctx k) (unnatify ctx x) + (*i do not understand why we need to write @Var _ n here*) + | @Var _ n v => + match nth_error (rev ctx) v with + | Some {| ctx_elt_t0 := t; ctx_elt0 := x |} => + match t return var t -> pATLexpr var n with + | tZ|tB => fun _ => @dummy var n + | tensor_n m => fun x => + match Nat.eq_dec n m with + | left pf => + match pf in (_ = q) return var (tensor_n q) -> _ with + | Logic.eq_refl => fun x => @Var var n x + end x + | right _ => @dummy var n + end + end x + | None => @dummy var n + end + | Get x idxs => Get (unnatify ctx x) (map (unnatify_Z ctx) idxs) + | SBop o x y => SBop o (unnatify ctx x) (unnatify ctx y) + | SIZR x => SIZR (unnatify_Z ctx x) + end. + +Fixpoint fvar_unnatify {var n ts} (ctx : list (ctx_elt var)) (e : fvar_pATLexpr (fun _ => nat) ts n) : fvar_pATLexpr var ts n := + match ts return fvar_pATLexpr (fun _ => nat) ts n -> fvar_pATLexpr var ts n with + | [] => fun e => unnatify ctx e + | t :: ts' => fun e => fun x => fvar_unnatify ({|ctx_elt0 := x|} :: ctx) (e (length ctx)) + end e. + +Definition ctx1 {var1 var2} (x : ctx_elt2 var1 var2) := + {| ctx_elt0 := x.(ctx_elt_p1 _ _) |}. +Definition ctx2 {var1 var2} (x : ctx_elt2 var1 var2) := + {| ctx_elt0 := x.(ctx_elt_p2 _ _) |}. + +Hint Constructors wf_Zexpr : core. +Lemma wf_unnatify_Z var1 var2 ctx e : + wf_Zexpr var1 var2 ctx (unnatify_Z (map ctx1 ctx) e) (unnatify_Z (map ctx2 ctx) e). +Proof. + induction e; simpl; intros; repeat constructor; eauto. + - do 2 rewrite <- map_rev. do 2 rewrite nth_error_map. + destruct (nth_error _ _) as [[t ? ?] |] eqn:E; auto. + simpl. destruct t; eauto. + apply nth_error_In in E. apply in_rev in E. + eauto. +Qed. +Hint Resolve wf_unnatify_Z : core. + +Hint Constructors wf_Bexpr : core. +Lemma wf_unnatify_B var1 var2 ctx e : + wf_Bexpr var1 var2 ctx (unnatify_B (map ctx1 ctx) e) (unnatify_B (map ctx2 ctx) e). +Proof. + induction e; simpl; eauto. +Qed. +Hint Resolve wf_unnatify_B : core. + +Hint Constructors wf_ATLexpr : core. +Lemma wf_dummy var1 var2 ctx n : wf_ATLexpr var1 var2 ctx n dummy dummy. +Proof. revert ctx. induction n; simpl; eauto. Qed. +Hint Resolve wf_dummy : core. + +Lemma wf_unnatify n var1 var2 ctx e : + wf_ATLexpr var1 var2 ctx n (unnatify (map ctx1 ctx) e) (unnatify (map ctx2 ctx) e). +Proof. + revert ctx. induction e; simpl; intros; repeat constructor; eauto; intros; + repeat rewrite length_map; eauto. + - do 2 rewrite <- map_rev. do 2 rewrite nth_error_map. + destruct (nth_error _ _) as [[t ? ?] |] eqn:E; simpl; auto. + destruct t; auto. destruct (Nat.eq_dec _ _); auto. + subst. apply nth_error_In in E. apply in_rev in E. auto. + - induction l; simpl; eauto. +Qed. +Hint Resolve wf_unnatify : core. + +Hint Constructors wf_fvar_ATLexpr : core. +Lemma wf_fvar_unnatify ts n var1 var2 ctx e : + wf_fvar_ATLexpr var1 var2 ctx ts n (fvar_unnatify (map ctx1 ctx) e) (fvar_unnatify (map ctx2 ctx) e). +Proof. + revert ctx. induction ts; intros; simpl; repeat rewrite length_map; eauto. +Qed. + +Lemma WfByUnnatify ts n (E : fvar_pATLExpr ts n) : + E = (fun var => fvar_unnatify nil (E (fun _ => nat))) -> + Wf_fvar_ATLExpr E. +Proof. + intros H. rewrite H. cbv [Wf_fvar_ATLExpr]. intros. apply wf_fvar_unnatify. +Qed. + + +Definition dummy_shal t : interp_type_tagged t := + match t with + | tZ => itervarZ 0%Z + | tB => false + | tensor_n O => 0%R + | tensor_n (S _) => [] + end. + +Ltac size_of_constr := + match goal with + | |- size_of _ _ ?x => is_evar x; econstructor + | |- size_of _ _ ?x => eassert (x = _) as ->; cycle 1; [econstructor|] + end. + +Definition sizes_consistent {var1 var2} (sizeof1 : _ -> option Z) sizeof2 (x : ctx_elt2 var1 var2) := + match x with + | {| ctx_elt_t := tZ; ctx_elt_p1 := x1; ctx_elt_p2 := x2|} => sizeof1 x1 = sizeof2 x2 + | _ => True + end. + +Lemma sound_sizeof_wf_Z var1 var2 sizeof1 sizeof2 ctx e1 e2 : + wf_Zexpr var1 var2 ctx e1 e2 -> + Forall (sizes_consistent sizeof1 sizeof2) ctx -> + sizeof_pZexpr sizeof1 e1 = sizeof_pZexpr sizeof2 e2. +Proof. + intros H1 H2. induction H1; simpl; eauto. + - destruct o; simpl; rewrite IHwf_Zexpr1, IHwf_Zexpr2; reflexivity. + - rewrite Forall_forall in H2. apply H2 in H. simpl in *. assumption. + - rewrite IHwf_Zexpr by assumption. reflexivity. +Qed. + +Hint Unfold sizes_consistent : core. +Lemma sound_sizeof_wf n var1 var2 sizeof1 sizeof2 dummy1 dummy2 e1 e2 ctx : + wf_ATLexpr var1 var2 ctx n e1 e2 -> + (sizeof1 (dummy1 tZ) = sizeof2 (dummy2 tZ)) -> + Forall (sizes_consistent sizeof1 sizeof2) ctx -> + sound_sizeof dummy1 sizeof1 e1 = sound_sizeof dummy2 sizeof2 e2. +Proof. + intros H1 H2. revert H1. + induction 1; simpl; intros; auto; + repeat erewrite sound_sizeof_wf_Z by eauto; + repeat match goal with + | H: _ |- _ => erewrite H by eauto + end; + try reflexivity. + - erewrite (sound_sizeof_wf_Z _ _ _ _ _ hi1) by eauto. reflexivity. + - erewrite Forall2_length by eassumption. destruct (_ =? _)%nat; [|reflexivity]. + destruct H1; reflexivity. +Qed. + +Ltac prove_sound_sizeof := + eassumption || + (erewrite sound_sizeof_wf; [|solve[eauto] | |]; [eassumption|solve[eauto]..]) || + (erewrite <- sound_sizeof_wf; [|solve[eauto] | |]; [eassumption|solve[eauto]..]) || + (erewrite sound_sizeof_wf by eauto; erewrite <- sound_sizeof_wf; [|solve[eauto] | |]; [eassumption|solve[eauto]..]) || + (erewrite <- sound_sizeof_wf by eauto; erewrite sound_sizeof_wf; [|solve[eauto] | |]; [eassumption|solve[eauto]..]). + +Lemma sizeof_pZexpr_interp_pZexpr e e' : + sizeof_pZexpr sizeof_Z e = Some e' -> + interp_pZexpr e = e'. +Proof. + revert e'. induction e; simpl; intros; + cbv [option_map] in *; + repeat (destruct_one_match_hyp; simpl in *; try congruence; []); invs'; + simpl in *; eauto; + repeat match goal with + | H: _ |- _ => specialize (H _ eq_refl) + end; + simpl in *; + subst; + eauto. + destruct v; simpl in *; auto; congruence. +Qed. + +Lemma sound_sizeof_gives_dim var dummy sizeof_var n (e : pATLexpr var n) sz : + sound_sizeof dummy sizeof_var e = Some sz -> + length sz = n. +Proof. + revert sz. + induction e; simpl; intros; + repeat (destruct_one_match_hyp; simpl in *; try congruence; []); invs'; + repeat (destruct_one_match_hyp; simpl in *; try congruence; []); invs'; + simpl in *; eauto; + repeat match goal with + | H: _ |- _ => specialize (H _ eq_refl) + end; + simpl in *; + try lia; + congruence. +Qed. + +Lemma sound_sizeof_nz {var n} dummy sizeof_var (e : pATLexpr var n) sh : + sound_sizeof dummy sizeof_var e = Some sh -> + ~In 0 sh. +Proof. + revert sh. + induction e; simpl; intros; + repeat (destruct_one_match_hyp; simpl in *; try congruence; []); invs'; + repeat (destruct_one_match_hyp; simpl in *; try congruence; []); invs'; + simpl in *; eauto; + repeat match goal with + | H: (_ =? _)%nat = false |- _ => + apply Nat.eqb_neq in H + | H: (_ + apply Nat.ltb_lt in H + | H: _ |- _ => specialize (H _ _ ltac:(eassumption)) + | H: _ |- _ => specialize (H _ eq_refl) + end; + simpl in *; + try solve [intros [?|?]; [lia|auto] ]. + - intros [?| [?|?] ]; try lia. + + pose proof ndiv_pos as H'. specialize (H' n0 (Z.to_nat z) ltac:(lia) ltac:(lia)). + lia. + + auto. + - intros [?| [?|?] ]; [lia|lia|auto]. +Qed. + +Hint Constructors result_has_shape' : core. +Hint Resolve result_has_shape'_sum_with_shape : core. +Hint Resolve result_has_shape_gen_pad result_has_shape_flatten result_has_shape_split_result result_has_shape_transpose_result result_has_shape_rev result_has_shape_repeat result_has_shape_truncl_list result_has_shape_app result_has_shape_concat : core. +Hint Extern 7 (result_has_shape _ _) => apply result_has_shape'_iff : core. +Hint Extern 7 (result_has_shape' _ _) => apply result_has_shape'_iff : core. + +Lemma sound_sizeof_result_has_shape n var1 ctx e0 dummy1 sizeof_var sz (e : pATLexpr _ n) : + wf_ATLexpr var1 interp_type_result ctx n e0 e -> + sizeof_var (dummy1 tZ) = None -> + Forall (sizes_consistent sizeof_var sizeof_Z) ctx -> + sound_sizeof dummy1 sizeof_var e0 = Some sz -> + result_has_shape' sz (result_of_pATLexpr e). +Proof. + intros H Hc. revert sz. induction H; simpl; intros; + repeat (destruct_one_match_hyp; simpl in *; try congruence; []); invs'; + repeat (destruct_one_match_hyp; simpl in *; try congruence; []); invs'; + simpl in *; eauto; + repeat match goal with + | H: (_ + apply Nat.ltb_lt in H + | H: (_ <=? _)%nat = true |- _ => + apply Nat.leb_le in H + | H: list_eqb Nat.eqb _ _ = true |- _ => + apply list_eqb_spec in H; [|apply Nat.eqb_eq]; subst + end; + repeat match goal with + | H: _ |- _ => specialize (H _ ltac:(eassumption) eq_refl) + end; + cbv [sizeof]; simpl; + repeat match goal with + | H: result_has_shape' _ _ |- _ => invert1 H + end; + repeat (erewrite <- sound_sizeof_wf by eauto; + match goal with + | H: sound_sizeof _ _ _ = Some _ |- _ => rewrite H + end); + repeat (erewrite sound_sizeof_wf_Z in * by eassumption); + repeat (erewrite sizeof_pZexpr_interp_pZexpr by eauto); + eauto; auto 10. + - constructor. + + rewrite zrange_seq. + do 2 rewrite length_map. rewrite length_seq. + reflexivity. + + apply Forall_map. apply Forall_forall. intros x _. eapply H2. + -- eauto. + -- prove_sound_sizeof. + - destruct (interp_pBexpr _); auto. + - destruct v2 as [ [ | ] | ]; constructor. + - destruct x2; constructor. + - destruct (result_of_pATLexpr _); auto. destruct (result_of_pATLexpr _); auto. +Qed. + +Ltac nts_inj := + repeat match goal with + | H: nat_to_string _ = nat_to_string _ |- _ => apply nat_to_string_injective in H + end. + +Ltac invs'' := invs'; nts_inj; subst. + +(*checks: + - indexes are in bounds + - we don't divide by zero + what these constraints have in common is that (unlike the no-zeroary-sums constraint) it's ok to violate them underneath false guards. + *) +Fixpoint idxs_in_bounds {n} (e : pATLexpr interp_type_result n) := + match e with + | Gen lo hi body | Sum lo hi body => + forall i, + (interp_pZexpr lo <= i < interp_pZexpr hi)%Z -> + idxs_in_bounds (body (itervarZ i)) + | Guard p body => + interp_pBexpr p = true -> + idxs_in_bounds body + | Lbind e1 e2 => + idxs_in_bounds e1 /\ idxs_in_bounds (e2 (result_of_pATLexpr e1)) + | Concat x y => + idxs_in_bounds x /\ idxs_in_bounds y + | Flatten e | Split _ e | Transpose e | Truncr _ e | Truncl _ e | Padr _ e + | Padl _ e => + idxs_in_bounds e + | Var x => result_has_shape' [] x + | Get v idxs => + match v with + | Var x => + exists sh, + result_has_shape' sh x /\ + Forall2 (fun i len => (0 <= i < Z.of_nat len)%Z) (map interp_pZexpr idxs) sh + | _ => False + end + | SBop o x y => + match o with + | Div => + match result_of_pATLexpr y with + | Result.V _ => False + | Result.S s => match s with + | SS s => s + | SX => 0%R + end <> 0%R + end + | _ => True + end + /\ idxs_in_bounds x /\ idxs_in_bounds y + | SIZR _ => True + end. + +Definition interp_type_result' t := + match t with + | tZ => tagged_Z + | tB => bool + | tensor_n _ => list nat + end. + +Definition dummy_result' t : interp_type_result' t := + match t with + | tZ => itervarZ 0%Z + | tB => false + | tensor_n _ => [] + end. + +Fixpoint idxs_in_bounds' {n} (e : pATLexpr interp_type_result' n) := + match e with + | Gen lo hi body | Sum lo hi body => + forall i, + (interp_pZexpr lo <= i < interp_pZexpr hi)%Z -> + idxs_in_bounds' (body (itervarZ i)) + | Guard p body => + interp_pBexpr p = true -> + idxs_in_bounds' body + | Lbind e1 e2 => + match sound_sizeof dummy_result' sizeof_Z e1 with + | Some sz => idxs_in_bounds' e1 /\ idxs_in_bounds' (e2 sz) + | None => False + end + | Concat x y => + idxs_in_bounds' x /\ idxs_in_bounds' y + | Flatten e | Split _ e | Transpose e | Truncr _ e | Truncl _ e | Padr _ e + | Padl _ e => + idxs_in_bounds' e + | Var sh => sh = [] + | Get v idxs => + match v with + | Var sh => + Forall2 (fun i len => (0 <= i < Z.of_nat len)%Z) (map interp_pZexpr idxs) sh + | _ => False + end + | SBop o x y => + match o with + | Div => False + (*TODO: this needs to be a sound check that y is nonzero. + The current check is obviously sound but could be replaced with something smarter*) + | _ => True + end + /\ idxs_in_bounds' x /\ idxs_in_bounds' y + | SIZR _ => True + end. + +(*TODO my names for things are getting worse and worse*) +Definition corresp' (x : ctx_elt2 interp_type_result' interp_type_result) := + match x with + | {| ctx_elt_t := tZ; ctx_elt_p1 := x1; ctx_elt_p2 := x2|} => x1 = x2 + | {| ctx_elt_t := tB; ctx_elt_p1 := x1; ctx_elt_p2 := x2|} => x1 = x2 + | {| ctx_elt_t := tensor_n _; ctx_elt_p1 := x1; ctx_elt_p2 := x2|} => + result_has_shape' x1 x2 + end. + +(*stupidly non-general*) +Lemma Zexprs_corresp'_same ctx e1 e2 : + Forall corresp' ctx -> + wf_Zexpr _ _ ctx e1 e2 -> + interp_pZexpr e1 = interp_pZexpr e2. +Proof. + intros Hctx. + induction 1; simpl; f_equal; auto. + { rewrite Forall_forall in Hctx. apply Hctx in H. simpl in H. auto. } +Qed. + +Lemma Bexprs_corresp'_same ctx e1 e2 : + Forall corresp' ctx -> + wf_Bexpr _ _ ctx e1 e2 -> + interp_pBexpr e1 = interp_pBexpr e2. +Proof. + induction 2; simpl; f_equal; eauto using Zexprs_corresp'_same. +Qed. + +Lemma corresp'_sizes_consistent x : + corresp' x -> + sizes_consistent sizeof_Z sizeof_Z x. +Proof. destruct x. destruct ctx_elt_t1; simpl; intros; subst; auto. Qed. + +Hint Unfold corresp' : core. +Lemma idxs_in_bounds'_idxs_in_bounds ctx n e e' : + wf_ATLexpr interp_type_result' interp_type_result ctx n e' e -> + Forall corresp' ctx -> + idxs_in_bounds' e' -> + idxs_in_bounds e. +Proof. + intros H Hcorresp' He'. induction H; simpl in He'; simpl; + repeat (erewrite Zexprs_corresp'_same in * by eassumption); + repeat (erewrite Bexprs_corresp'_same in * by eassumption); + eauto. + - intros. eapply H2; eauto. eapply He'. + erewrite Zexprs_corresp'_same with (e1 := hi1) by eassumption. eauto. + - intros. eapply H2; eauto. eapply He'. + erewrite Zexprs_corresp'_same with (e1 := hi1) by eassumption. eauto. + - destruct_one_match_hyp; try contradiction. invs'. split; auto. + intros. eapply H1; eauto. constructor; auto. simpl. + eapply sound_sizeof_result_has_shape. 1: eassumption. 3: eassumption. + 1: reflexivity. eauto using Forall_impl, corresp'_sizes_consistent. + - invs'. eauto. + - subst. rewrite Forall_forall in Hcorresp'. + specialize (Hcorresp' _ ltac:(eassumption)). apply Hcorresp'. + - destruct_one_match_hyp; try contradiction. simpl in *. + remember (Var i) eqn:Ei. destruct H; try congruence. subst. invert Ei. + pose proof Hcorresp' as H'. + rewrite Forall_forall in H'. + specialize (H' _ ltac:(eassumption)). simpl in H'. eexists. + split; [eassumption|]. + assert (map interp_pZexpr idxs1 = map interp_pZexpr idxs2) as <-. + { clear -H0 Hcorresp'. induction H0; simpl; f_equal; eauto. + eauto using Zexprs_corresp'_same. } + assumption. + - invs'. destruct_one_match_hyp; try contradiction; auto. +Qed. + +(*because shallow ATL does not have reasonable semantics for zero-ary sums.*) +Fixpoint sum_bounds_good {n} (e : pATLexpr interp_type_tagged n) := + match e with + | Gen lo hi body => + forall i, + (interp_pZexpr lo <= i < interp_pZexpr hi)%Z -> + sum_bounds_good (body (itervarZ i)) + | Sum lo hi body => + (interp_pZexpr lo < interp_pZexpr hi)%Z /\ + forall i, + (interp_pZexpr lo <= i < interp_pZexpr hi)%Z -> + sum_bounds_good (body (itervarZ i)) + | Guard p body => + sum_bounds_good body + | Lbind e1 e2 => + sum_bounds_good e1 /\ (forall x, sum_bounds_good (e2 x)) + | Concat x y => + sum_bounds_good x /\ sum_bounds_good y + | Flatten e | Split _ e | Transpose e | Truncr _ e | Truncl _ e | Padr _ e + | Padl _ e => + sum_bounds_good e + | Get e _ => + sum_bounds_good e + | SBop _ x y => + sum_bounds_good x /\ sum_bounds_good y + | Var _ | SIZR _ => + True + end. + +Definition res_tensor_corresp (x : ctx_elt2 interp_type_tagged interp_type_result) := + match x with + | {| ctx_elt_t := tZ; ctx_elt_p1 := x1; ctx_elt_p2 := x2|} => x1 = x2 + | {| ctx_elt_t := tB; ctx_elt_p1 := x1; ctx_elt_p2 := x2|} => x1 = x2 + | {| ctx_elt_t := tensor_n _; ctx_elt_p1 := x1; ctx_elt_p2 := x2|} => + x1 = tensor_of_result x2 + end. + +(*stupidly non-general*) +Lemma Zexprs_corresp_same ctx e1 e2 : + Forall res_tensor_corresp ctx -> + wf_Zexpr interp_type_tagged interp_type_result ctx e1 e2 -> + interp_pZexpr e1 = interp_pZexpr e2. +Proof. + intros Hctx. + induction 1; simpl; f_equal; auto. + { rewrite Forall_forall in Hctx. apply Hctx in H. simpl in H. auto. } +Qed. + +Lemma Bexprs_corresp_same ctx e1 e2 : + Forall res_tensor_corresp ctx -> + wf_Bexpr interp_type_tagged interp_type_result ctx e1 e2 -> + interp_pBexpr e1 = interp_pBexpr e2. +Proof. + induction 2; simpl; f_equal; eauto using Zexprs_corresp_same. +Qed. + +Lemma get_R_nil idxs n : + get_R (null : dim_n n) idxs = 0%R. +Proof. + revert idxs. + induction n; intros idxs; destruct idxs; eauto. +Qed. + +Lemma eval_get'_get_R r idxs n sh : + n = length idxs -> + result_has_shape' sh r -> + Forall2 (fun (i : Z) (len : nat) => (0 <= i < Z.of_nat len)%Z) idxs sh -> + R_of_scalar (eval_get' r idxs) = get_R (tensor_of_result (n := n) r) idxs. +Proof. + intro. subst. revert r sh. + induction idxs; intros r sh Hsh Hidxs; simpl. + - destruct r; reflexivity. + - destruct r. + + simpl. rewrite get_empty_null. rewrite get_R_nil. reflexivity. + + invert Hidxs. invert Hsh. rewrite get_is_nth_error by (rewrite length_map; lia). + cbv [nth_default]. rewrite nth_error_map. destruct (nth_error _ _) eqn:E. + -- simpl. eapply IHidxs; eauto. apply nth_error_In in E. + rewrite Forall_forall in *. eauto. + -- apply nth_error_None in E. lia. +Qed. + +Lemma invert_wf_var var1 var2 ctx n i1 x2 : + wf_ATLexpr var1 var2 ctx n (Var i1) x2 -> + exists i1' i2, Var i1 = Var i1' /\ x2 = Var i2 /\ In {| ctx_elt_p1 := i1'; ctx_elt_p2 := i2 |} ctx. +Proof. + intros H. remember (Var i1). destruct H; try congruence. eauto. +Qed. + +Lemma res_tensor_corresp_sizes_consistent x : + res_tensor_corresp x -> + sizes_consistent sizeof_Z sizeof_Z x. +Proof. destruct x; simpl. destruct ctx_elt_t1; intros; subst; auto. Qed. + +Lemma Forall_res_tensor_corresp_sizes_consistent xs : + Forall res_tensor_corresp xs -> + Forall (sizes_consistent sizeof_Z sizeof_Z) xs. +Proof. eauto using Forall_impl, res_tensor_corresp_sizes_consistent. Qed. +Hint Resolve Forall_res_tensor_corresp_sizes_consistent : core. + +Lemma blah : + sizeof_Z (dummy_shal tZ) = sizeof_Z (dummy_result tZ). +Proof. reflexivity. Qed. +Hint Immediate blah : core. + +Lemma blah' : + sizeof_Z (dummy_result tZ) = sizeof_Z (dummy_shal tZ). +Proof. reflexivity. Qed. +Hint Immediate blah' : core. + +Hint Resolve consistent_iverson consistent_concat consistent_transpose consistent_truncr consistent_truncl consistent_flatten consistent_pad_l consistent_pad_r : consistent. +Lemma sound_sizeof_tensor_has_size n e_shal sz ctx e_res : + wf_ATLexpr interp_type_tagged interp_type_result ctx n e_shal e_res -> + Forall (sizes_consistent sizeof_Z sizeof_Z) ctx -> + sum_bounds_good e_shal -> + sound_sizeof dummy_shal sizeof_Z e_shal = Some sz -> + consistent (interp_pATLexpr e_shal) (tuple_of_list sz). +Proof. + intros H Hctx Hbds. revert sz. induction H; intros sz Hsz; simpl in Hsz; repeat (destruct_one_match_hyp; try congruence; []); simpl in Hbds; invs'; + repeat match goal with + | H: (_ + apply Nat.ltb_lt in H + | H: (_ =? _)%nat = true |- _ => + apply Nat.eqb_eq in H; subst + | H: (_ =? _)%nat = false |- _ => + apply Nat.eqb_neq in H + | H: (_ <=? _)%nat = true |- _ => + apply Nat.leb_le in H + | H: list_eqb Nat.eqb _ _ = true |- _ => + apply list_eqb_spec in H; [|apply Nat.eqb_eq]; subst + end; + repeat match goal with + | IH: _ -> _ -> forall _, _ -> _ |- _ => + specialize (IH ltac:(eauto) ltac:(eauto) _ eq_refl); + simpl in IH + end; + cbn -[consistent]; + repeat (erewrite sizeof_pZexpr_interp_pZexpr in * by eassumption); + eauto with consistent. + - apply consistent_genr. + + lia. + + intros. eapply H2; eauto. prove_sound_sizeof. + - invs'. apply consistent_sumr; auto. intros. eapply H2; eauto. prove_sound_sizeof. + - eapply H1; eauto. prove_sound_sizeof. + - rewrite Nat.mul_comm. eauto with consistent. + - simpl. epose proof consistent_tile as H'. epose_dep H'. + rewrite of_nat_div_distr in H'. rewrite Nat2Z.id in H'. + eapply H'; eauto. + - apply consistent_truncr; eauto with consistent. lia. + - apply consistent_truncl; eauto with consistent. lia. + - apply consistent_pad_l; eauto with consistent. + - apply consistent_pad_r; eauto with consistent. + Unshelve. all: exact (dummy_result _). +Qed. + +Lemma result_of_pATLexpr_correct ctx n e_shal e_res sh : + wf_ATLexpr interp_type_tagged interp_type_result ctx n e_shal e_res -> + Forall res_tensor_corresp ctx -> + sound_sizeof dummy_shal sizeof_Z e_shal = Some sh -> + idxs_in_bounds e_res -> + sum_bounds_good e_shal -> + tensor_of_result (result_of_pATLexpr e_res) = interp_pATLexpr e_shal. +Proof. + intros H. revert sh. induction H; intros sz Hctx Hsz Hidxs Hbds; simpl in *; + repeat match goal with + | H: context[match ?x with _ => _ end] |- _ => + let E := fresh "E" in destruct x eqn:E; try congruence; [] + end; + invs'; + repeat match goal with + | IH : _ |- _ => specialize (IH _ ltac:(eauto) eq_refl ltac:(eauto) ltac:(eauto)) + end; + repeat match goal with + | H: context[match ?x with _ => _ end] |- _ => + let E := fresh "E" in destruct x eqn:E; try congruence; [] + end; + invs'; + repeat match goal with + | H: list_eqb Nat.eqb _ _ = true |- _ => + apply list_eqb_spec in H; [|apply Nat.eqb_eq]; subst + end. + - f_equal. rewrite genr_is_map. rewrite map_map. + erewrite <- (Zexprs_corresp_same _ _ lo2) in * by eassumption. + erewrite <- (Zexprs_corresp_same _ _ hi2) in * by eassumption. + apply map_ext_in. intros i Hi. rewrite In_zrange in Hi. eapply H2. + + constructor; auto. simpl. reflexivity. + + prove_sound_sizeof. + + auto. + + auto. + - cbv [sizeof]. simpl. + erewrite <- (Zexprs_corresp_same _ _ lo2) in * by eassumption. + erewrite <- (Zexprs_corresp_same _ _ hi2) in * by eassumption. + replace (sound_sizeof _ _ _) with (Some sz) by (symmetry; prove_sound_sizeof). + erewrite sumr_is_fold_right_map_zero; cycle 1. + + intros i Hi. apply consistent_of_tensor_has_size'. + -- erewrite <- H2; cycle 1. + ++ constructor; eauto. simpl. reflexivity. + ++ prove_sound_sizeof. + ++ auto. + ++ auto. + ++ apply tensor_of_result_size. + --- apply sound_sizeof_gives_dim in Hsz. eauto. + --- eapply sound_sizeof_result_has_shape; eauto. prove_sound_sizeof. + -- apply sound_sizeof_nz in Hsz. assumption. + + assumption. + + cbv [sum_with_sz]. + rewrite fold_right_map with (f := tensor_of_result) (g2 := @bin (dim_n n) _) (P := fun x => result_has_shape' sz x); [f_equal|..]. + -- erewrite <- H2; cycle 1. + ++ constructor; eauto. simpl. reflexivity. + ++ prove_sound_sizeof. + ++ apply Hidxs. lia. + ++ apply H4. lia. + ++ erewrite scalar_mul_0_tensor_of_result. + --- reflexivity. + --- apply sound_sizeof_gives_dim in Hsz. auto. + --- eapply sound_sizeof_result_has_shape; eauto. prove_sound_sizeof. + -- rewrite map_map. + apply map_ext_in. intros i Hi. apply In_zrange in Hi. eapply H2. + ++ constructor; eauto. simpl. reflexivity. + ++ prove_sound_sizeof. + ++ auto. + ++ auto. + -- apply result_has_shape'_iff. apply result_has_shape_gen_pad. + -- apply Forall_map. apply Forall_forall. intros i _. + eapply sound_sizeof_result_has_shape; eauto. prove_sound_sizeof. + -- intros x y Hx Hy. + pose proof (add_result_add_result' _ _ _ Hx Hy) as Hxy. + rewrite result_has_shape'_iff in *. + eapply result_has_shape_add_result; eauto. + -- intros. eapply tensor_of_result_add_result'; eauto. + apply sound_sizeof_gives_dim in Hsz. auto. + - erewrite <- Bexprs_corresp_same in * by eauto. destruct (interp_pBexpr b1); simpl. + + cbv [iverson]. rewrite mul_1_id. eauto. + + cbv [iverson]. clear IHwf_ATLexpr Hidxs. + cbv [sizeof]. erewrite <- sound_sizeof_wf by eauto. + Fail rewrite Hsz. + change (fun x => interp_type_tagged x) with interp_type_tagged. rewrite Hsz. + erewrite scalar_mul_0_is_0. + -- reflexivity. + -- apply sound_sizeof_gives_dim in Hsz. auto. + -- apply tensor_has_size'_of_consistent. + ++ apply sound_sizeof_gives_dim in Hsz. auto. + ++ eapply sound_sizeof_tensor_has_size; eauto. + - cbv [let_binding]. eapply H1. + + constructor; [|assumption]. simpl. eauto. + + prove_sound_sizeof. + + auto. + + auto. + - pose proof sound_sizeof_result_has_shape as Hx. + epose_dep Hx. specialize (Hx H ltac:(eauto) ltac:(eauto) ltac:(eauto)). + pose proof sound_sizeof_result_has_shape as Hy. + epose_dep Hy. specialize (Hy H0 ltac:(eauto) ltac:(eauto) ltac:(eauto)). + pose proof E as E'. pose proof E1 as E1'. + apply sound_sizeof_nz in E, E1. simpl in E, E1. + invert Hx. invert Hy. subst. + do 2 (destruct_one_match_hyp; try congruence; []). + do 2 match goal with + | H: Result.V _ = Result.V _ |- _ => invert H + end. + rewrite <- IHwf_ATLexpr1, <- IHwf_ATLexpr2. clear IHwf_ATLexpr1 IHwf_ATLexpr2. + erewrite concat_is_app'. + + rewrite map_app. reflexivity. + + cbn [tensor_has_size']. rewrite length_map. split; [reflexivity|]. + rewrite Forall_Forall'. apply Forall_map. eapply Forall_impl; [|eassumption]. + intros r Hr. apply tensor_of_result_size. 2: eassumption. + apply sound_sizeof_gives_dim in E'. simpl in E'. lia. + + cbn [tensor_has_size']. rewrite length_map. split; [reflexivity|]. + rewrite Forall_Forall'. apply Forall_map. eapply Forall_impl; [|eassumption]. + intros r Hr. apply tensor_of_result_size. 2: eassumption. + apply sound_sizeof_gives_dim in E'. simpl in E'. lia. + + auto. + + auto. + + auto. + - pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto. + destruct (result_of_pATLexpr x2); [invert0 E' |]. + rewrite <- IHwf_ATLexpr. clear IHwf_ATLexpr. + erewrite flatten_is_concat; cycle 1. + { apply consistent_of_tensor_has_size' with (sh := (n0 :: n1 :: l1)) (n := S (S _)). + (*wow why so slow*) + - cbn [tensor_has_size']. rewrite length_map. invert E'. split; [reflexivity|]. + apply Forall_Forall'. apply Forall_map. eapply Forall_impl; [|eassumption]. + intros r Hr. invert Hr. rewrite length_map. split; [reflexivity|]. + apply Forall_Forall'. apply Forall_map. eapply Forall_impl; [|eassumption]. + intros r Hr. apply tensor_of_result_size. + + apply sound_sizeof_gives_dim in E. simpl in E. lia. + + assumption. + - apply sound_sizeof_nz in E. assumption. } + apply result_has_shape'_2d in E'. invs'. + rewrite flatten_result_map_V, map_id. + rewrite map_map. + rewrite concat_map. reflexivity. + - pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto. + destruct (result_of_pATLexpr x2); [invert0 E' |]. + rewrite <- IHwf_ATLexpr. + cbv [split_result]. rewrite map_map. + apply result_has_shape'_iff in E'. + erewrite result_has_shape_result_shape_nat by eassumption. + pose proof E as E''. apply sound_sizeof_nz in E''. + rewrite filter_until_not_in by assumption. simpl. + cbv [Tile]. + erewrite tile_is_split; cycle 1. + + eassumption. + + apply result_has_shape'_iff in E'. + eapply tensor_of_result_size in E'; eauto. simpl in E'. + apply sound_sizeof_gives_dim in E. simpl in E. invert E. + apply E'. + + rewrite length_map. cbv [nat_range]. + erewrite <- Zexprs_corresp_same by eassumption. + apply map_ext. intros i. + rewrite <- firstn_map. rewrite <- skipn_map. rewrite map_app. + rewrite map_repeat. reflexivity. + - pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto. + destruct (result_of_pATLexpr x2); [invert0 E' |]. + pose proof E as E''. apply sound_sizeof_nz in E''. + rewrite <- IHwf_ATLexpr. cbv [sizeof]. + eassert (sound_sizeof _ _ _ = Some _) as -> by prove_sound_sizeof. + simpl. + erewrite result_has_shape_row_length. + 2: { invert E'. simpl in E''. destruct v; try congruence. + exfalso. simpl in E''. auto. } + 2: { apply result_has_shape'_iff. eassumption. } + erewrite pad_list_result_shape_id. + 2: { apply result_has_shape'_iff. eassumption. } + 2: { enough (0 <> n0) by lia. simpl in E''. auto. } + pose proof E' as E'''. + apply result_has_shape'_2d in E'''. invs'. + rewrite map_map. + invert E'. rewrite Forall_map in H4. + rewrite transpose_result_list_is_transpose_list; cycle 1. + { eapply Forall_impl; [|eassumption]. + simpl. invert 1. reflexivity. } + rewrite map_map. + rewrite transpose_is_transpose_list; cycle 1. + { apply Forall_map. eapply Forall_impl; [|eassumption]. + simpl. invert 1. rewrite length_map. destruct x. + - exfalso. simpl in E''. auto. + - simpl. rewrite length_map. invert H4. invert H2. assumption. } + replace (list_row_length _) with n1. + + cbv [transpose_list]. rewrite map_map. apply map_ext_in. + intros i Hi. cbv [get_list_col]. rewrite map_map. rewrite map_map. + apply map_ext_in. intros u Hu. cbv [nth_default]. rewrite nth_error_map. + destruct (nth_error _ _) eqn:Ei; [reflexivity|]. simpl. + rewrite Forall_forall in H4. apply H4 in Hu. invert Hu. + apply in_seq in Hi. apply nth_error_None in Ei. lia. + + destruct x. + -- exfalso. simpl in E''. auto. + -- simpl. rewrite length_map. invert H4. invert H2. reflexivity. + - pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto. + destruct (result_of_pATLexpr x2); [invert0 E' |]. + pose proof E as E''. apply sound_sizeof_nz in E''. + rewrite <- IHwf_ATLexpr. + cbv [Common.Truncr]. + rewrite truncr_is_rev_skipn_rev. + rewrite map_rev. rewrite <- skipn_map. rewrite map_rev. + erewrite <- Zexprs_corresp_same by eassumption. + reflexivity. + - pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto. + destruct (result_of_pATLexpr x2); [invert0 E' |]. + pose proof E as E''. apply sound_sizeof_nz in E''. + rewrite <- IHwf_ATLexpr. + cbv [Common.Truncl]. + rewrite truncl_is_skipn. + rewrite <- skipn_map. + erewrite <- Zexprs_corresp_same by eassumption. + reflexivity. + - pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto. + destruct (result_of_pATLexpr x2); [invert0 E' |]. + pose proof E as E''. apply sound_sizeof_nz in E''. + rewrite <- IHwf_ATLexpr. cbv [sizeof]. + eassert (sound_sizeof _ _ _ = Some _) as -> by prove_sound_sizeof. + simpl. cbv [Common.Padl]. erewrite pad_l_is_app_pad; eauto. + + rewrite map_app, map_repeat. erewrite <- Zexprs_corresp_same by eassumption. + reflexivity. + + invert E'. cbn [tensor_has_size']. rewrite length_map. split; [reflexivity|]. + apply Forall_Forall'. apply Forall_map. eapply Forall_impl; [|eassumption]. + intros. apply tensor_of_result_size; auto. apply sound_sizeof_gives_dim in E. + simpl in E. lia. + - pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto. + destruct (result_of_pATLexpr x2); [invert0 E' |]. + pose proof E as E''. apply sound_sizeof_nz in E''. + rewrite <- IHwf_ATLexpr. cbv [sizeof]. + eassert (sound_sizeof _ _ _ = Some _) as -> by prove_sound_sizeof. + simpl. cbv [Common.Padr]. erewrite pad_r_is_app_pad; eauto. + + rewrite map_app, map_repeat. erewrite <- Zexprs_corresp_same by eassumption. + reflexivity. + + invert E'. cbn [tensor_has_size']. rewrite length_map. split; [reflexivity|]. + apply Forall_Forall'. apply Forall_map. eapply Forall_impl; [|eassumption]. + intros. apply tensor_of_result_size; auto. apply sound_sizeof_gives_dim in E. + simpl in E. lia. + - invert Hidxs. rewrite Forall_forall in Hctx. specialize (Hctx _ ltac:(eassumption)). + simpl in Hctx. subst. destruct s; reflexivity. + - apply invert_wf_var in H. invs'. rewrite H1 in *. clear i H1. + assert (map interp_pZexpr idxs1 = map interp_pZexpr idxs2) as ->. + { clear -H0 Hctx. induction H0; simpl; f_equal; eauto. + eauto using Zexprs_corresp_same. } + simpl. + rewrite Forall_forall in Hctx. specialize (Hctx _ ltac:(eassumption)). + simpl in Hctx. subst. + erewrite <- eval_get'_get_R; cycle 1. + + rewrite length_map. apply Nat.eqb_eq in E. apply Forall2_length in H0. lia. + + eassumption. + + assumption. + + destruct (eval_get' _ _); reflexivity. + - pose proof E as E'. pose proof E0 as E0'. + eapply sound_sizeof_gives_dim in E', E0'; eauto. + destruct l, l0; try discriminate. clear E' E0'. + eapply sound_sizeof_result_has_shape in E, E0; eauto. + rewrite <- IHwf_ATLexpr1, <- IHwf_ATLexpr2. + destruct (result_of_pATLexpr x2); [|invert0 E]. + destruct (result_of_pATLexpr y2); [|invert0 E0]. + destruct o, z, z0; reflexivity. + - erewrite <- Zexprs_corresp_same by eassumption. reflexivity. + Unshelve. + all: exact dummy_result || exact 0%Z || exact (dummy_result _). +Qed. diff --git a/src/verified_lowering/inferpad/ATLSpecs.v b/src/verified_lowering/inferpad/ATLSpecs.v new file mode 100644 index 0000000..a51c65e --- /dev/null +++ b/src/verified_lowering/inferpad/ATLSpecs.v @@ -0,0 +1,336 @@ +From Stdlib Require Import Arith.Arith. +From Stdlib Require Import Reals.Reals. +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 QArith. + +Import ListNotations. + +From ATL Require Import Common Map Sets FrapWithoutSets Div Tactics ATL. +From Lower Require Import Zexpr Bexpr Array Range Sexpr ListMisc + Constant ATLDeep Result. +From Inferpad Require Import NatToString TensorToResult ATLPhoas PhoasToDeep. + +Notation S := Datatypes.S. + +Local Set Default Goal Selector "!". + +Open Scope list_scope. +Open Scope nat_scope. + +Fixpoint stringvar_fvar_ATLexpr {ts n} names (e : fvar_pATLexpr (fun _ => tagged_string) ts n) : option ATLexpr := + match ts, names return fvar_pATLexpr _ ts _ -> _ with + | [], [] => fun e => + match stringvar_ATLexpr O e with + | Some (_, e_string) => Some e_string + | None => None + end + | t :: ts', name :: names' => fun e => + stringvar_fvar_ATLexpr names' (e (argvarstr name)) + | _, _ => fun _ => None + end e. + +Inductive size_spec := +| size_nil (P : Prop) +| with_Z_var (sz : Z -> size_spec) +| with_T_var (sh : list nat) (sz : size_spec) +. + +Fixpoint fvar_idxs_in_bounds {ts n} (sizes : size_spec) (e : fvar_pATLexpr interp_type_result ts n) : Prop := + match ts, sizes return fvar_pATLexpr _ ts _ -> _ with + | [], size_nil P => fun e => P -> idxs_in_bounds e + | tensor_n n :: ts', with_T_var sh sz => fun e => + forall r, + result_has_shape' sh r -> + fvar_idxs_in_bounds sz (e r) + | tZ :: ts', with_Z_var sz => fun e => forall r, + fvar_idxs_in_bounds (sz r) (e (argvarZ r)) + | _, _ => fun _ => False + end e. + +Fixpoint fvar_idxs_in_bounds' {ts n} (sizes : size_spec) (e : fvar_pATLexpr interp_type_result' ts n) : Prop := + match ts, sizes return fvar_pATLexpr _ ts _ -> _ with + | [], size_nil P => fun e => P -> idxs_in_bounds' e + | tensor_n n :: ts', with_T_var sh sz => fun e => + fvar_idxs_in_bounds' sz (e sh) + | tZ :: ts', with_Z_var sz => fun e => forall r, + fvar_idxs_in_bounds' (sz r) (e (argvarZ r)) + | _, _ => fun _ => False + end e. + +Lemma fvar_idxs_in_bounds'_fvar_idxs_in_bounds ctx ts sizes n e e' : + wf_fvar_ATLexpr _ _ ctx ts n e' e -> + Forall corresp' ctx -> + fvar_idxs_in_bounds' sizes e' -> + fvar_idxs_in_bounds sizes e. +Proof. + intros H Hctx. revert sizes. induction H; intros sizes Hsizes; simpl in *. + - destruct sizes; try contradiction. + intros. + eapply idxs_in_bounds'_idxs_in_bounds; eauto. + - destruct t; try contradiction. + + destruct sizes; try contradiction. eauto. + + destruct sizes; try contradiction. invs'. eauto. +Qed. + +Fixpoint fvar_sound_sizeof {ts n} (sizes : size_spec) (e : fvar_pATLexpr interp_type_result ts n) : Prop := + match ts, sizes return fvar_pATLexpr _ ts _ -> _ with + | [], size_nil P => fun e => + P -> + match sound_sizeof dummy_result sizeof_Z e with + | Some _ => True + | None => False + end + | tensor_n n :: ts', with_T_var sh sz => + fun e => forall r, fvar_sound_sizeof sz (e r) + | tZ :: ts', with_Z_var sz => + fun e => forall r, fvar_sound_sizeof (sz r) (e (argvarZ r)) + | _, _ => fun _ => False + end e. + +Fixpoint fvar_sum_bounds_good {ts n} (sizes : size_spec) (e : fvar_pATLexpr interp_type_tagged ts n) : Prop := + match ts, sizes return fvar_pATLexpr _ ts _ -> _ with + | [], size_nil P => fun e => P -> sum_bounds_good e + | tensor_n _ :: ts', with_T_var _ sz => fun e => forall r, fvar_sum_bounds_good sz (e r) + | tZ :: ts', with_Z_var sz => + fun e => forall r, fvar_sum_bounds_good (sz r) (e (argvarZ r)) + | _, _ => fun _ => False + end e. + +Fixpoint res_spec_of' ts n names size (fd : ATLexpr) (fs : fvar_pATLexpr interp_type_result ts n) (v : fmap string Z) (ec : fmap string Result.result) := + match ts, size, names return ATLexpr -> fun_type interp_type_result ts _ -> _ with + | [], size_nil P, [] => fun fd fs => + P -> + eval_expr v ec fd (result_of_pATLexpr fs) + | tZ :: ts', with_Z_var size', name :: names' => fun fd fs => + forall (x : Z), + res_spec_of' ts' n names' (size' x) fd (fs (argvarZ x)) (v $+ (name, x)) ec + | tensor_n m :: ts', with_T_var sh size', name :: names' => fun fd fs => + forall (x : Result.result), + result_has_shape' sh x -> + res_spec_of' ts' n names' size' fd (fs x) v (ec $+ (name, x)) + | _, _, _ => fun _ _ => False + end fd fs. + +Definition res_spec_of ts n names size fd fs := res_spec_of' ts n names size fd fs $0 $0. + +Fixpoint spec_of' ts n names size (fd : ATLexpr) (fs : fun_type interp_type ts (dim_n n)) (v : fmap string Z) (ec : fmap string Result.result) := + match ts, size, names return ATLexpr -> fun_type interp_type ts _ -> _ with + | [], size_nil P, [] => fun fd fs => + P -> + exists r, + eval_expr v ec fd r /\ + tensor_of_result r = fs + | tZ :: ts', with_Z_var size', name :: names' => fun fd fs => + forall (x : Z), + spec_of' ts' n names' (size' x) fd (fs x) (v $+ (name, x)) ec + | tensor_n m :: ts', with_T_var sh size', name :: names' => fun fd fs => + forall (x : Result.result), + result_has_shape' sh x -> + spec_of' ts' n names' size' fd (fs (tensor_of_result x)) v (ec $+ (name, x)) + | _, _, _ => fun _ _ => False + end fd fs. + +Inductive arg_spec := +| Z_arg (name : string) +| T_arg (name : string) (size : list Zexpr). + +Fixpoint eval_Zexprlist_Z v (xs : list Zexpr) : option (list Z) := + match xs with + | nil => Some nil + | x :: xs' => + match eval_Zexpr_Z v x with + | Some val => option_map (cons val) (eval_Zexprlist_Z v xs') + | None => None + end + end. + +Definition spec_of ts n name size fd fs := spec_of' ts n name size fd fs $0 $0. + +Definition starts_with_var x := + exists y, x = ("var_" ++ y)%string. + +Lemma nat_to_string_starts_with_var x : + starts_with_var (nat_to_string x). +Proof. cbv [starts_with_var nat_to_string]. eexists. reflexivity. Qed. + +From Stdlib Require Import Permutation. +Lemma res_spec_of'_correct ts n names size fd e_nat e_res ctx_res : + wf_fvar_ATLexpr _ interp_type_result ctx_res ts n e_nat e_res -> + NoDup (names ++ map untagged_fst_ctx_elt ctx_res) -> + Forall (fun x => ~starts_with_var x) (names ++ map untagged_fst_ctx_elt ctx_res) -> + Forall tags_consistent ctx_res -> + fvar_sound_sizeof size e_res -> + fvar_idxs_in_bounds size e_res -> + stringvar_fvar_ATLexpr names e_nat = Some fd -> + res_spec_of' ts n names size fd e_res (valuation_of ctx_res) (ec_of ctx_res). +Proof. + intros Hwf. revert size names. + induction Hwf; simpl; intros size names Hnd Hname Htag Hsize Hbds Hstring; + destruct names as [|name names]; try congruence. + - destruct (stringvar_ATLexpr _ _) as [(?&e_string)|] eqn:E; try congruence. + invert Hstring. destruct size; try contradiction. + destruct (sound_sizeof _ _ _) eqn:?; [|contradiction]. + intros. simpl app in *. + eapply stringvar_ATLexpr_correct; eauto. + + intros name'' Hname''. rewrite Forall_forall in Hname. apply Hname in Hname''. + exfalso. apply Hname''. apply nat_to_string_starts_with_var. + + prove_sound_sizeof. + - destruct t; destruct size; try contradiction. + + intros x. simpl in H0. + epose proof (H0 (argvarstr _) (argvarZ _)) as H0. eapply H0. + -- eapply Permutation_NoDup. 2: eassumption. simpl. + apply Permutation_cons_app. apply Permutation_refl. + -- simpl in Hname. invert Hname. apply Forall_app in H4. invs'. + apply Forall_app; auto. + -- auto. + -- auto. + -- auto. + -- assumption. + + intros x Hx. simpl in H0. + epose proof (H0 (argvarstr _) _) as H0. eapply H0. + -- eapply Permutation_NoDup. 2: eassumption. simpl. + apply Permutation_cons_app. apply Permutation_refl. + -- simpl in Hname. invert Hname. apply Forall_app in H4. invs'. + apply Forall_app; auto. + -- auto. + -- auto. + -- auto. + -- assumption. +Qed. + +Fixpoint compat ts n size (e_shal : fvar_pATLexpr interp_type_tagged ts n) (e_res : fvar_pATLexpr interp_type_result ts n) := + match ts, size return fvar_pATLexpr _ ts _ -> fvar_pATLexpr _ ts _ -> _ with + | [], size_nil P => fun e_shal e_res => + P -> + tensor_of_result (result_of_pATLexpr e_res) = interp_pATLexpr e_shal + | tZ :: ts', with_Z_var size => fun e_shal e_res => + forall x, + compat ts' _ (size x) (e_shal (argvarZ x)) (e_res (argvarZ x)) + | tensor_n _ :: ts', with_T_var sh size => fun e_shal e_res => + forall x, + result_has_shape' sh x -> + compat ts' _ size (e_shal (tensor_of_result x)) (e_res x) + | _, _ => fun _ _ => False + end e_shal e_res. + +Hint Unfold res_tensor_corresp : core. +Lemma result_of_fvar_pATLexpr_correct' ctx ts n e_shal e_res size : + wf_fvar_ATLexpr interp_type_tagged interp_type_result ctx ts n e_shal e_res -> + fvar_sound_sizeof size e_res -> + Forall res_tensor_corresp ctx -> + fvar_idxs_in_bounds size e_res -> + fvar_sum_bounds_good size e_shal -> + compat ts n size e_shal e_res. +Proof. + intros Hwf. revert size. + induction Hwf; simpl; intros size Hsz Hcorresp Hidxs Hbds. + - destruct size; try contradiction. + destruct (sound_sizeof _ _ _) eqn:?; [|contradiction]. + intros. eapply result_of_pATLexpr_correct; eauto. + prove_sound_sizeof. + - destruct t; destruct size; try contradiction. + + intros. eapply H0; auto. + + intros. invs'. eapply H0; auto. +Qed. + +Lemma result_of_fvar_pATLexpr_correct ts n e size : + Wf_fvar_ATLExpr e -> + fvar_sound_sizeof size (e _) -> + fvar_idxs_in_bounds size (e _) -> + fvar_sum_bounds_good size (e _) -> + compat ts n size (e _) (e _). +Proof. + intros. eapply result_of_fvar_pATLexpr_correct'; eauto. +Qed. + +Lemma res_spec_of_correct ts n names size fd e : + Wf_fvar_ATLExpr e -> + NoDup names -> + Forall (fun x => ~starts_with_var x) names -> + fvar_sound_sizeof size (e _) -> + fvar_idxs_in_bounds size (e _) -> + stringvar_fvar_ATLexpr names (e _) = Some fd -> + res_spec_of ts n names size fd (e _). +Proof. + intros. cbv [res_spec_of]. + assert ($0 = valuation_of []) as -> by reflexivity. + assert ($0 = ec_of []) as -> by reflexivity. + eapply res_spec_of'_correct; eauto. + - simpl. rewrite app_nil_r. assumption. + - simpl. rewrite app_nil_r. assumption. +Qed. + +Lemma res_spec_of_compat_spec_of' ts n names size fd e_res e_shal v ec : + res_spec_of' ts n names size fd e_res v ec -> + compat ts n size e_shal e_res -> + spec_of' ts n names size fd (interp_fvar_pATLexpr ts n e_shal) v ec. +Proof. + revert size names e_res e_shal v ec. + induction ts as [|t ts]; intros size names e_res e_shal v ec Hres Hcompat. + - simpl in *. destruct size; destruct names; try contradiction. eauto. + - simpl in *. destruct t; destruct size; destruct names; try contradiction; eauto. +Qed. + +Lemma res_spec_of_compat_spec_of ts n name size fd e_res e_shal : + res_spec_of ts n name size fd e_res -> + compat ts n size e_shal e_res -> + spec_of ts n name size fd (interp_fvar_pATLexpr ts n e_shal). +Proof. + intros. eapply res_spec_of_compat_spec_of'; eassumption. +Qed. + +Lemma spec_of_correct' ts n e size names fd : + Wf_fvar_ATLExpr e -> + NoDup names -> + Forall (fun x : var => ~ starts_with_var x) names -> + fvar_sound_sizeof size (e _) -> + fvar_idxs_in_bounds size (e _) -> + fvar_sum_bounds_good size (e _) -> + stringvar_fvar_ATLexpr names (e _) = Some fd -> + spec_of ts n names size fd (interp_fvar_pATLexpr ts n (e _)). +Proof. + intros. eapply res_spec_of_compat_spec_of. + - eapply res_spec_of_correct; eauto. + - eapply result_of_fvar_pATLexpr_correct; eauto. +Qed. + +Fixpoint size_spec_of ts v P args := + match ts, args return fun_type interp_type ts _ -> _ with + | tZ :: ts', Z_arg x :: args' => fun P => + with_Z_var (fun x0 => size_spec_of ts' (v $+ (x, x0)) (P x0) args') + | tensor_n _ :: ts', T_arg x sh :: args' => fun P => + match eval_Zexprlist_Z v sh with + | Some sz => with_T_var (map Z.to_nat sz) (size_spec_of ts' v (P (dummy_shal (tensor_n _))) args') + | None => size_nil False + end + | [], [] => fun P => size_nil P + | _, _ => fun _ => size_nil False + end P. + +Definition name_of arg := + match arg with + | Z_arg x => x + | T_arg x _ => x + end. + +Lemma spec_of_correct ts n e0 (e : fvar_pATLExpr _ _) size names fd : + e0 = interp_fvar_pATLexpr ts n (e _) -> + Wf_fvar_ATLExpr e -> + NoDup names -> + Forall (fun x : var => ~ starts_with_var x) names -> + fvar_sound_sizeof size (e _) -> + fvar_idxs_in_bounds' size (e _) -> + fvar_sum_bounds_good size (e _) -> + stringvar_fvar_ATLexpr names (e _) = Some fd -> + spec_of ts n names size fd e0. +Proof. + intros. subst. eapply spec_of_correct'; try eassumption. + eapply fvar_idxs_in_bounds'_fvar_idxs_in_bounds; eauto. +Qed. + +Definition stringy_spec_of ts n args fd P fs := + spec_of ts n (map name_of args) (size_spec_of ts $0 P args) fd fs. diff --git a/src/verified_lowering/inferpad/InferPad.v b/src/verified_lowering/inferpad/InferPad.v index 89e49b7..b8e0b66 100644 --- a/src/verified_lowering/inferpad/InferPad.v +++ b/src/verified_lowering/inferpad/InferPad.v @@ -16,8 +16,8 @@ Import ListNotations. From ATL Require Import ATL Map Sets FrapWithoutSets Div Tactics Common CommonTactics. From Examples Require Import TensorAdd Matmul GatherScatter Im2col Convolution Blur. +From Inferpad Require Import Reify ReifyExamples ATLPhoas ATLSpecs. From Lower Require Import Zexpr Bexpr Array Range Sexpr Result ListMisc Meshgrid VarGeneration Constant ATLDeep Pad. -From Inferpad Require Import Reify. Open Scope string_scope. @@ -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 @@ -220,7 +220,7 @@ Ltac infer_pad left right := | |- has_pad _ _ (Scalar _) _ => eapply HasPadScalarNotPad | |- has_pad _ _ (Split _ _) _ => - infer_split left right + infer_split left right | |- has_pad _ _ (Truncr ?k _) _ => infer_truncr left right 0%nat | |- has_pad _ _ (Truncl ?k _) _ => @@ -366,7 +366,7 @@ end with infer_truncr left right offset := | |- 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 + (* if it's an evar let's instantiate it as left *) match goal with _ => is_evar kk end in constr:(Z.to_nat left) @@ -521,7 +521,7 @@ end with infer_truncr left right offset := arith | arith ] ] | assert (offset < outer_dim - x_ - y_) as Hcheck by (arith; lia); clear Hcheck; - solve [ infer_flatten left right constr:(offset+1) ] + solve [ infer_flatten left right constr:(offset+1) ] ] end with infer_transpose left right offset1 offset2 := match goal with @@ -552,7 +552,7 @@ end with infer_truncr left right offset := let lll':= constr:(inner_dim - ll' - rr' - offset1) in let rrr' := offset1 in let l' := constr:(outer_dim - offset2) in - let r' := 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') @@ -581,261 +581,262 @@ end with infer_truncr left right offset := arith ] end. -Goal forall v, Common.truncl 3 (GEN [ i < 10 ] (|[ 1 Common.Truncl 3 (GEN [ i < 10 ] (|[ 1 []). Proof. let ast := R in assert (exists pad, has_pad $0 $0 ast pad). { eexists. Fail infer_pad 0%Z 0%Z. Abort. -Goal forall n m (v : list (list R)), - 2 < n -> - 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 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 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 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 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. +(*writing let ast := R works here, because no normalization is needed*) +Goal (fun v : list R => Common.Truncl 3 (GEN [ i < 10 ] (v _[i]))) = (fun _ => []). Proof. - intros. unfold scatter_full. let ast := R in assert (exists pad, has_pad $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 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 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 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 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 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 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 ast pad). - { eexists. infer_pad 0%Z 0%Z. } -Abort. - -Goal forall n m (l : list (list R)), - 1 < n -> - 1 < 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 ast pad). - { eexists. infer_pad 0%Z 0%Z. } + { eexists. Fail 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 _. +(*writing let ast := R fails here, because normalization is needed*) +Goal (fun n m (v : list (list R)) => blurimmediate_partition n m v) = (fun _ _ _ => nil). Proof. - let ast := R in - 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), - 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 ast pad). - { eexists. infer_pad 0%Z 0%Z. } + Fail let ast := R in idtac. + let ast := eval compute in blurimmediate_partition_string in + assert (forall N M, + (2 < N)%Z -> + (2 < M)%Z -> + exists pad, has_pad ($0 $+ ("M", M) $+ ("N", N)) $0 ast pad). + { (*i think something like this should be true. + it is not true. + (and, therefore, infer_pad fails to prove it.) *) + eexists. + Fail 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 ast pad). +Definition weird_blur_args N M := + [T_arg "v" [ZLit (Z.of_nat N); ZLit (Z.of_nat M)]]. + +Derive weird_blurimmediate_partition_string in + (forall A B, + 2 < A -> + 2 < B -> + stringy_spec_of [tensor_n 2] 2 (weird_blur_args A B) (weird_blurimmediate_partition_string A B) (fun _ => True) (blurimmediate_partition (Z.of_nat A) (Z.of_nat B))) + as weird_blurimmediate_partition_string_correct. +Proof. cbv [blurimmediate_partition]. intros. prove_stringy_spec. Qed. + +(*we can prove things like this, but i think they are not good for much*) +Goal True. + let ast := eval lazy -[Z.of_nat] in weird_blurimmediate_partition_string in + assert (forall A B, + 2 < A -> + 2 < B -> + exists pad, has_pad $0 $0 (ast A B) 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 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 ast pad). - eexists. { infer_pad 0%Z 0%Z. } -Abort. +(* Goal (fun m1 m2 : list (list (list (list R))) => add_split 8 8 8 8 m1 m2) = *) +(* (fun m1 m2 => add 8 8 8 8 m1 m2). *) +(* Proof. *) +(* cbv [add_split]. *) +(* Reify_lhs foo. *) +(* (* autounfold. *) *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal (fun B C K W RR (w x : list (list (list R))) => im2col B K W C RR w x) = *) +(* (fun B C K W RR w x => im2col_lifted B K W C RR w x). *) +(* Proof. *) +(* cbv [im2col]. *) +(* Reify_lhs foo. *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal (fun B C K W RR (w x : list (list (list R))) => im2col_lifted B K W C RR w x) = *) +(* (fun B C K W RR w x => im2col B K W C RR w x). *) +(* Proof. *) +(* cbv [im2col_lifted]. *) +(* Reify_lhs foo. *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal (fun W C B K (x w : list (list (list R))) RR => scatter_full B K W C x w) = *) +(* (fun W C B K x w RR => gather_full W C B K x w RR). *) +(* Proof. *) +(* cbv [scatter_full]. *) +(* Reify_lhs foo. *) +(* (* intros. unfold scatter_full. *) *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal (fun W C B K (x w : list (list (list R))) RR => gather_full W C B K x w RR) = *) +(* (fun W C B K x w RR => scatter_full B K W C x w). *) +(* Proof. *) +(* cbv [gather_full]. *) +(* Reify_lhs foo. *) +(* (* intros. unfold gather_full. *) *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal (fun m1 m2 : list (list R) => matmul_tiled_split 64 64 64 m1 m2 4) = *) +(* (fun m1 m2 => matmul 64 64 64 m1 m2). *) +(* Proof. *) +(* cbv [matmul_tiled_split]. *) +(* Reify_lhs foo. *) +(* (* autounfold with examples. *) *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal (fun l : list (list R) => blur_tiles_guarded l 64 64 4 4) = (fun _ => nil). *) +(* Proof. *) +(* cbv [blur_tiles_guarded]. *) +(* Reify_lhs foo. *) +(* Print foo. *) +(* (* autounfold. unfold blur_tiles_guarded. *) *) +(* (* let ast := R in *) *) +(* (* 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, *) +(* (fun v : list (list R) => blurimmediate_isolate n m v) = (fun _ => nil). *) +(* Proof. *) +(* intros. *) +(* cbv [blurimmediate_isolate]. *) +(* Reify_lhs foo. *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_concat 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal forall N M, *) +(* (fun v : list (list R) => blurtwostage_partition N M v) = (fun _ => nil). *) +(* Proof. *) +(* intros. *) +(* cbv [blurtwostage_partition]. *) +(* Reify_lhs foo. *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal (fun v : list R => Common.truncl 3 (GEN [ i < 10 ] (|[ 2 []). *) +(* Proof. *) +(* Reify_lhs foo. *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal forall N M, *) +(* (fun v : list (list R) => blurimmediate v M N) = (fun v => blurtwostage N M v). *) +(* Proof. *) +(* intros. *) +(* cbv [blurimmediate]. *) +(* Reify_lhs foo. *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal forall N M, *) +(* (fun v : list (list R) => blurtwostage N M v) = (fun v => blurimmediate v M N). *) +(* Proof. *) +(* intros. *) +(* cbv [blurtwostage]. *) +(* Reify_lhs foo. *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal forall n m, *) +(* (fun l : list (list R) => fusion_no_boundary n m l) *) +(* = (fun _ => nil). *) +(* Proof. *) +(* intros. *) +(* cbv [fusion_no_boundary]. *) +(* Reify_lhs foo. *) +(* (* let ast := R in *) *) +(* (* assert (exists pad, has_pad $0 $0 ast pad). *) *) +(* (* { eexists. infer_pad 0%Z 0%Z. } *) *) +(* Abort. *) + +(* Goal (fun W x w => GatherScatter.gather W x w) = (fun _ _ _ => nil). *) +(* Proof. *) +(* cbv [gather]. *) +(* Reify_lhs foo. *) +(* (* let ast := R in *) *) +(* (* 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), *) +(* 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 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 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 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 ast pad). *) +(* eexists. { infer_pad 0%Z 0%Z. } *) +(* Abort. *) diff --git a/src/verified_lowering/inferpad/Makefile b/src/verified_lowering/inferpad/Makefile index 47f06bb..8f885e8 100644 --- a/src/verified_lowering/inferpad/Makefile +++ b/src/verified_lowering/inferpad/Makefile @@ -1,4 +1,4 @@ -MODULES := Reify ReifyExamples InferPad +MODULES := Reify ReifyExamples InferPad ATLPhoas TensorToResult NatToString PhoasToDeep ATLSpecs VS := $(MODULES:%=%.v) .PHONY: coq clean diff --git a/src/verified_lowering/inferpad/NatToString.v b/src/verified_lowering/inferpad/NatToString.v new file mode 100644 index 0000000..157ace0 --- /dev/null +++ b/src/verified_lowering/inferpad/NatToString.v @@ -0,0 +1,168 @@ +From Stdlib Require Import Strings.String Strings.Ascii. +From Stdlib Require Import micromega.Lia. +From Stdlib Require Import Lists.List. +From Stdlib Require Import Arith.Arith. +From ATL Require Import FrapWithoutSets. +From Lower Require VarGeneration. + +Import ListNotations. + +Open Scope string_scope. +Open Scope list_scope. + +Definition alphabet_string := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890". + +Definition alphabet := nodup ascii_dec (List.remove ascii_dec "?"%char (list_ascii_of_string alphabet_string)). + +(*TODO is this in stdlib / elsewehre? *) +Fixpoint to_radix r fuel n := + match fuel, n with + | S fuel', S n' => n mod r :: to_radix r fuel' (n / r) + | O, _ => nil + | _, O => nil + end. + +Fixpoint from_radix r n := + match n with + | n0 :: n' => n0 + r * from_radix r n' + | [] => O + end. + +Lemma from_radix_to_radix r fuel n : + n <= fuel -> + 1 < r -> + from_radix r (to_radix r fuel n) = n. +Proof. + intros Hn Hr. revert n Hn. induction fuel; intros n Hn. + - simpl. lia. + - simpl. destruct n; [reflexivity|]. + remember (S n) as n' eqn:E. clear n E. simpl. + rewrite IHfuel. + + rewrite (Nat.div_mod_eq n' r) at 3. lia. + + rewrite (Nat.div_mod_eq n' r) in Hn. + remember (n' / r) as k eqn:Ek. clear Ek. assert (k + k <= r * k). + { destruct r; try lia. destruct r; lia. } + lia. +Qed. + +Lemma to_radix_injective r n m : + 1 < r -> + to_radix r n n = to_radix r m m -> + n = m. +Proof. + intros ? H. + rewrite <- (from_radix_to_radix r n n) by lia. + rewrite <- (from_radix_to_radix r m m) by lia. + rewrite H. + reflexivity. +Qed. + +Lemma to_radix_small r fuel n : + 1 <= r -> + Forall (fun digit => digit < r) (to_radix r fuel n). +Proof. + intros Hr. revert n. induction fuel; simpl; intros; destruct n; constructor; auto. + apply Nat.mod_upper_bound. lia. +Qed. + +Definition encode {T} (default : T) (alphabet : list T) (n : list nat) := + map (fun digit => nth_default default alphabet digit) n. + +Lemma encode_injective {T} n m default (alphabet : list T) : + NoDup alphabet -> + Forall (fun digit => digit < length alphabet) n -> + Forall (fun digit => digit < length alphabet) m -> + encode default alphabet n = encode default alphabet m -> + n = m. +Proof. + intros Ha Hn. revert m. induction n; simpl; intros m Hm Hnm. + - destruct m; [|discriminate Hnm]. reflexivity. + - destruct m; [discriminate Hnm|]. simpl in Hnm. + cbv [nth_default] in Hnm. invert Hnm. invert Hn. invert Hm. + f_equal; eauto; []. clear IHn. + rewrite NoDup_nth_error in Ha. apply Ha; auto. + destruct (nth_error _ _) eqn:E; [|apply nth_error_None in E; lia]. + clear E. + destruct (nth_error _ _) eqn:E; [|apply nth_error_None in E; lia]. + clear E. subst. reflexivity. +Qed. + +Lemma encode_In {T} n default (alphabet : list T) : + Forall (fun digit => digit < length alphabet) n -> + Forall (fun digit => In digit alphabet) (encode default alphabet n). +Proof. + intros H. induction H; simpl; constructor; auto. + cbv [nth_default]. destruct (nth_error _ _) eqn:E. + - apply nth_error_In in E. apply E. + - apply nth_error_None in E. lia. +Qed. + +(* Compute (to_radix 2 5 5). *) +(* = [1; 0; 1] *) +(* : list nat *) + +Definition nat_to_string n := + ("var_" ++ string_of_list_ascii (encode (ascii_of_nat O) alphabet (to_radix (length alphabet) n n)))%string. + +Lemma alphabet_long : 2 <= length alphabet. +Proof. vm_compute. lia. Qed. + +Lemma string_of_list_ascii_injective n m : + string_of_list_ascii n = string_of_list_ascii m -> + n = m. +Proof. + intros H. + rewrite <- (list_ascii_of_string_of_list_ascii n). + rewrite <- (list_ascii_of_string_of_list_ascii m). + rewrite H. + reflexivity. +Qed. + +Lemma nat_to_string_injective x y : + nat_to_string x = nat_to_string y -> + x = y. +Proof. + cbv [nat_to_string]. intros H. apply VarGeneration.string_app_l in H. + pose proof alphabet_long. + eapply to_radix_injective; cycle 1. + - eapply encode_injective; cycle -1. + + apply string_of_list_ascii_injective. eassumption. + + cbv [alphabet]. apply NoDup_nodup. + + apply to_radix_small. lia. + + apply to_radix_small. lia. + - lia. +Qed. + +Lemma contains_substring_In c s : + contains_substring (String c EmptyString) s -> + In c (list_ascii_of_string s). +Proof. + intros H. cbv [contains_substring] in H. destruct H as [n H]. + revert n H. induction s; intros n H; simpl in H. + - destruct n; discriminate H. + - rewrite VarGeneration.substring0 in H. destruct n; simpl in *. + + invert H. auto. + + eauto. +Qed. + +Lemma nat_to_string_In x : + Forall (fun digit => In digit (list_ascii_of_string "var_") \/ In digit alphabet) (list_ascii_of_string (nat_to_string x)). +Proof. + cbv [nat_to_string]. lazy [list_ascii_of_string append]. + do 4 (constructor; [left; simpl; auto|]). + rewrite list_ascii_of_string_of_list_ascii. + eapply Forall_impl. + 2: { apply encode_In. apply to_radix_small. pose proof alphabet_long. lia. } + cbv beta. auto. +Qed. + +Opaque alphabet_string. (*Qed is slow otherwise, not sure why*) +Lemma no_question_marks n : + ~ contains_substring "?" (nat_to_string n). +Proof. + intros H. apply contains_substring_In in H. + eapply Forall_forall in H; [|apply nat_to_string_In]. cbv beta in H. + cbv [alphabet] in H. destruct H as [H|H]. + - simpl in H. repeat (destruct H as [H|H]; [congruence|]). contradiction. + - apply nodup_In in H. apply in_remove in H. destruct H as (_&H). congruence. +Qed. diff --git a/src/verified_lowering/inferpad/PhoasToDeep.v b/src/verified_lowering/inferpad/PhoasToDeep.v new file mode 100644 index 0000000..e39d451 --- /dev/null +++ b/src/verified_lowering/inferpad/PhoasToDeep.v @@ -0,0 +1,795 @@ +From Stdlib Require Import Arith.Arith. +From Stdlib Require Import Reals.Reals. +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 QArith. + +Import ListNotations. + +From ATL Require Import Common Map Sets FrapWithoutSets Div Tactics ATL. +From Lower Require Import Zexpr Bexpr Array Range Sexpr ListMisc + Constant ATLDeep Result. +From Inferpad Require Import NatToString TensorToResult ATLPhoas. + +Notation S := Datatypes.S. + +Local Set Default Goal Selector "!". + +Open Scope list_scope. +Open Scope nat_scope. + +Definition stringvar_Zbop o := + match o with + | ZPlus => Zexpr.ZPlus + | ZMinus => Zexpr.ZMinus + | ZTimes => Zexpr.ZTimes + | ZDivf => Zexpr.ZDivf + | ZDivc => Zexpr.ZDivc + | ZMod => Zexpr.ZMod + end. + +Fixpoint stringvar_ZLit (e : pZexpr tagged_string) : option Z := + match e with + | ZBop o x y => match stringvar_ZLit x, stringvar_ZLit y with + | Some x', Some y' => Some (interp_Zbop o x' y') + | _, _ => None + end + | ZVar _ => None + | ZZ0 => Some 0%Z + | ZZpos p => Some (Zpos p) + | ZZneg p => Some (Zneg p) + | ZZ_of_nat n => Some (Z.of_nat n) + | ZZopp x => option_map Z.opp (stringvar_ZLit x) + end. + +Fixpoint stringvar_Z (e : pZexpr tagged_string) : Zexpr := + match e with + | ZBop o x y => (stringvar_Zbop o) (stringvar_Z x) (stringvar_Z y) + | ZVar x => Zexpr.ZVar x + | ZZ0 => ZLit 0 + | ZZpos p => ZLit (Zpos p) + | ZZneg p => ZLit (Zneg p) + | ZZ_of_nat n => ZLit (Z.of_nat n) + | ZZopp x => Zexpr.ZMinus (ZLit 0) (stringvar_Z x) + end. + +Definition stringvar_Bbop o := + match o with + | BLt => Bexpr.Lt + | BLe => Bexpr.Le + | BEq => Bexpr.Eq + end. + +Fixpoint stringvar_B (e : pBexpr tagged_string) : Bexpr := + match e with + | BAnd x y => Bexpr.And (stringvar_B x) (stringvar_B y) + | BBop o x y => (stringvar_Bbop o) (stringvar_Z x) (stringvar_Z y) + end. + +Definition stringvar_Sbop o := + match o with + | Mul => Sexpr.Mul + | Add => Sexpr.Add + | Div => Sexpr.Div + | Sub => Sexpr.Sub + end. + +Fixpoint stringvar_S {n} (e : pATLexpr (fun _ => tagged_string) n) : option Sexpr := + match e with + | SBop o x y => + match stringvar_S x, stringvar_S y with + | Some x', Some y' => Some (stringvar_Sbop o x' y') + | _, _ => None + end + | SIZR x => option_map Sexpr.Lit (option_map inject_Z (stringvar_ZLit x)) + | Get x idxs => + match x with + | Var y => Some (Sexpr.Get y (map stringvar_Z idxs)) + | _ => None + end + | Var x => Some (Sexpr.Get x []) + | _ => None + end. + +(*yes, I'm using the same name generation for Z and tensor, even though they + don't need to be distinct*) +Fixpoint stringvar_ATLexpr {n} (name : nat) (e : pATLexpr (fun _ => tagged_string) n) : option (nat * ATLexpr) := + match e with + | Gen lo hi body => + match stringvar_ATLexpr (S name) (body (itervarstr (nat_to_string name))) with + | Some (name', body') => + Some (name', + ATLDeep.Gen (nat_to_string name) (stringvar_Z lo) (stringvar_Z hi) body') + | None => None + end + | Sum lo hi body => + match stringvar_ATLexpr (S name) (body (itervarstr (nat_to_string name))) with + | Some (name', body') => + Some (name', + ATLDeep.Sum (nat_to_string name) (stringvar_Z lo) (stringvar_Z hi) body') + | None => None + end + | Guard b e1 => + match stringvar_ATLexpr name e1 with + | Some (name', body') => + Some (name', ATLDeep.Guard (stringvar_B b) body') + | None => None + end + | Lbind x f => + match stringvar_ATLexpr (S name) x with + | Some (name', x') => + match stringvar_ATLexpr name' (f (itervarstr (nat_to_string name))) with + | Some (name'', fx') => + Some (name'', ATLDeep.Lbind (nat_to_string name) x' fx') + | None => None + end + | None => None + end + | Concat e1 e2 => + match stringvar_ATLexpr name e1 with + | Some (name', e1') => + match stringvar_ATLexpr name' e2 with + | Some (name'', e2') => + Some (name'', ATLDeep.Concat e1' e2') + | None => None + end + | None => None + end + | Flatten e1 => + match stringvar_ATLexpr name e1 with + | Some (name', e1') => + Some (name', ATLDeep.Flatten e1') + | None => None + end + | Split k e1 => + match stringvar_ATLexpr name e1 with + | Some (name', e1') => + Some (name', ATLDeep.Split (stringvar_Z k) e1') + | None => None + end + | Transpose e1 => + match stringvar_ATLexpr name e1 with + | Some (name', e1') => + Some (name', ATLDeep.Transpose e1') + | None => None + end + | Truncr k e1 => + match stringvar_ATLexpr name e1 with + | Some (name', e1') => + Some (name', ATLDeep.Truncr (stringvar_Z k) e1') + | None => None + end + | Truncl k e1 => + match stringvar_ATLexpr name e1 with + | Some (name', e1') => + Some (name', ATLDeep.Truncl (stringvar_Z k) e1') + | None => None + end + | Padl k e1 => + match stringvar_ATLexpr name e1 with + | Some (name', e1') => + Some (name', ATLDeep.Padl (stringvar_Z k) e1') + | None => None + end + | Padr k e1 => + match stringvar_ATLexpr name e1 with + | Some (name', e1') => + Some (name', ATLDeep.Padr (stringvar_Z k) e1') + | None => None + end + | Get _ _ | SBop _ _ _ | SIZR _ => + match stringvar_S e with + | Some s => Some (name, ATLDeep.Scalar s) + | None => None + end + | Var x => None + end. + +Fixpoint valuation_of (ctx : list (ctx_elt2 (fun _ => tagged_string) interp_type_result)) : valuation := + match ctx with + | {| ctx_elt_t := tZ; ctx_elt_p1 := x; ctx_elt_p2 := y |} :: ctx' => + valuation_of ctx' $+ (x, y) + | _ :: ctx' => valuation_of ctx' + | nil => $0 + end. + +Fixpoint ec_of (ctx : list (ctx_elt2 (fun _ => tagged_string) interp_type_result)) : expr_context := + match ctx with + | {| ctx_elt_t := tensor_n n; ctx_elt_p1 := x; ctx_elt_p2 := y |} :: ctx' => + ec_of ctx' $+ (x, y) + | _ :: ctx' => ec_of ctx' + | nil => $0 + end. + +Definition fst_ctx_elt {T var2} (elt : ctx_elt2 (fun _ => T) var2) := + elt.(ctx_elt_p1 _ _). + +Definition untagged_fst_ctx_elt {var2} (x : ctx_elt2 _ var2) := untag_string (fst_ctx_elt x). + +(* as usual, i miss coqutil. map.of_list.. *) +Lemma valuation_of_correct ctx x y : + NoDup (map untagged_fst_ctx_elt ctx) -> + List.In {| ctx_elt_t := tZ; ctx_elt_p1 := x; ctx_elt_p2 := y |} ctx -> + valuation_of ctx $? x = Some (untag_Z y). +Proof. + induction ctx. + - simpl. intros. contradiction. + - simpl. intros H1 H2. destruct H2 as [H2|H2]; subst. + + rewrite lookup_add_eq; reflexivity. + + invert H1. specialize (IHctx ltac:(eassumption) ltac:(eassumption)). + destruct a. destruct ctx_elt_t; auto. + rewrite lookup_add_ne; auto. + intro H'. + match goal with |H: ~_ |- _ => apply H end. apply in_map_iff. eexists. + split; [|eassumption]. simpl in *. assumption. +Qed. + +Lemma ec_of_correct ctx n x y : + NoDup (map untagged_fst_ctx_elt ctx) -> + List.In {| ctx_elt_t := tensor_n n; ctx_elt_p1 := x; ctx_elt_p2 := y |} ctx -> + ec_of ctx $? x = Some y. +Proof. + induction ctx. + - simpl. intros. contradiction. + - simpl. intros H1 H2. destruct H2 as [H2|H2]; subst. + + rewrite lookup_add_eq; reflexivity. + + invert H1. specialize (IHctx ltac:(eassumption) ltac:(eassumption)). + destruct a. destruct ctx_elt_t; auto. rewrite lookup_add_ne; auto. + intro H'. match goal with |H: ~_ |- _ => apply H end. apply in_map_iff. eexists. + split; [|eassumption]. assumption. +Qed. + +Lemma dom_valuation_of ctx : + dom (valuation_of ctx) \subseteq constant (map untagged_fst_ctx_elt ctx). +Proof. + induction ctx; simpl. + - rewrite dom_empty. sets. + - destruct a. simpl. destruct ctx_elt_t; try solve[sets]. + rewrite dom_add. sets. +Qed. + +Lemma dom_ec_of ctx : + dom (ec_of ctx) \subseteq constant (map untagged_fst_ctx_elt ctx). +Proof. + induction ctx; simpl. + - rewrite dom_empty. sets. + - destruct a. simpl. destruct ctx_elt_t; try solve[sets]. + rewrite dom_add. sets. +Qed. + +Lemma stringvar_Z_correct ctx e_nat e_shal : + NoDup (map untagged_fst_ctx_elt ctx) -> + wf_Zexpr (fun _ => tagged_string) interp_type_result ctx e_nat e_shal -> + eval_Zexpr (valuation_of ctx) (stringvar_Z e_nat) (interp_pZexpr e_shal). +Proof. + induction 2; simpl; eauto. + - destruct o; simpl; eauto. + - constructor. apply valuation_of_correct; auto. + - eenough (- _ = _)%Z as ->; [eauto|]. lia. +Qed. + +Lemma stringvar_B_correct ctx e_nat e_shal : + NoDup (map untagged_fst_ctx_elt ctx) -> + wf_Bexpr (fun _ => tagged_string) interp_type_result ctx e_nat e_shal -> + eval_Bexpr (valuation_of ctx) (stringvar_B e_nat) (interp_pBexpr e_shal). +Proof. + induction 2; simpl. + - constructor; eauto. + - destruct o; simpl; constructor; eauto using stringvar_Z_correct. +Qed. + +Lemma sizeof_pZexpr_eval_Zexpr e e' (sizeof_var : tagged_string -> _) v : + sizeof_pZexpr sizeof_var e = Some e' -> + (forall x y, sizeof_var x = Some y -> v $? (untag_string x) = Some y) -> + eval_Zexpr v (stringvar_Z e) e'. +Proof. + revert e'. induction e; simpl; intros; eauto; + try congruence; cbv [option_map] in *; + repeat match goal with + | H: context[match sizeof_pZexpr _ ?e with _ => _ end] |- _ => + let E := fresh "E" in + destruct (sizeof_pZexpr _ e) eqn:E; simpl in *; [|congruence] + end; + invs'; + simpl in *; + eauto. + - destruct z; simpl; eauto. + - eassert (-_ = _)%Z as ->. 2: eauto. lia. +Qed. + +Lemma sound_sizeof_size_of var2 (dummy2 : forall t, var2 t) n e_nat ctx sz e2 e_string name name' sizeof1 sizeof2 v : + wf_ATLexpr (fun _ => tagged_string) var2 ctx n e_nat e2 -> + (forall x, sizeof1 (itervarstr x) = sizeof2 (dummy2 tZ)) -> + sound_sizeof (fun _ => itervarstr (nat_to_string 0)) sizeof1 e_nat = Some sz -> + Forall (sizes_consistent sizeof1 sizeof2) ctx -> + (forall x y, sizeof1 x = Some y -> v $? (untag_string x) = Some y) -> + stringvar_ATLexpr (n := n) name e_nat = Some (name', e_string) -> + size_of v e_string sz. +Proof. + intros H Hdummy Hsz Hctx Hv. revert Hsz. revert name sz name' e_string. + set (f := fun _ => itervarstr (nat_to_string 0)). + assert (dumb_hyp : sizeof1 (f tZ) = sizeof2 (dummy2 tZ)) by (subst f; simpl; auto). + induction H; intros name sz name' e_string Hsz Hs; + repeat match goal with + | H: context [match stringvar_ATLexpr ?name ?e with _ => _ end] |- _ => + let E := fresh "E" in + destruct (stringvar_ATLexpr name e) as [(?&?)|] eqn:E; [|congruence] + end; + invs'; + simpl in *; + repeat (destruct_one_match_hyp; try congruence; []); + invs'; + try solve [constructor; eauto]; + repeat match goal with + | H: (_ + apply Nat.ltb_lt in H + | H: (_ <=? _)%nat = true |- _ => + apply Nat.leb_le in H + | H: list_eqb Nat.eqb _ _ = true |- _ => + apply list_eqb_spec in H; [|apply Nat.eqb_eq]; subst + end; + try solve [size_of_constr; eauto; repeat (lia || f_equal)]. + - constructor. + + eapply sizeof_pZexpr_eval_Zexpr; eassumption. + + eapply sizeof_pZexpr_eval_Zexpr; eassumption. + + eapply H2. 3: eassumption. 1: eauto. prove_sound_sizeof. + - constructor. + eapply H2. 3: eassumption. 1: eauto. prove_sound_sizeof. + - constructor; eauto. + eapply H1. 3: eassumption. 1: eauto. prove_sound_sizeof. + - constructor; eauto. eapply sizeof_pZexpr_eval_Zexpr; eassumption. + - constructor; eauto. eapply sizeof_pZexpr_eval_Zexpr; eassumption. + - constructor; eauto. eapply sizeof_pZexpr_eval_Zexpr; eassumption. + - constructor; eauto. eapply sizeof_pZexpr_eval_Zexpr; eassumption. + - constructor; eauto. eapply sizeof_pZexpr_eval_Zexpr; eassumption. + - congruence. + Unshelve. + all: auto. +Qed. + +Hint Extern 5 (_ <= _)%nat => lia : core. +Hint Extern 5 (_ <= _ < _)%nat => lia : core. +Hint Extern 5 (_ < _)%nat => lia : core. + +Lemma name_gets_bigger n (e : pATLexpr _ n) name name' e_string : + stringvar_ATLexpr name e = Some (name', e_string) -> + name <= name'. +Proof. + revert name name' e_string. + induction e; + simpl; + intros name name' e_string He; + repeat (destruct_one_match_hyp; simpl in *; try congruence; []); + invs'; + repeat match goal with + | H1: _, H2: stringvar_ATLexpr _ _ = _ |- _ => apply H1 in H2 + end; + lia || congruence. +Qed. + +Lemma vars_of_stringvar_ATLexpr n name (e : pATLexpr _ n) name' e_string : + stringvar_ATLexpr name e = Some (name', e_string) -> + (forall str, + vars_of e_string str -> + exists n, + str = nat_to_string n /\ + name <= n < name'). +Proof. + revert name name' e_string. induction e; + simpl; intros name name' e_string He str Hvars; + repeat (destruct_one_match_hyp; simpl in *; try congruence; []); invs'; + simpl in *; + try lazymatch goal with + | H1: stringvar_ATLexpr _ _ = _ , H2: stringvar_ATLexpr _ _ = _ |- _ => + pose proof H1 as H1'; pose proof H2 as H2'; + apply name_gets_bigger in H1', H2' + | H1: stringvar_ATLexpr _ _ = _ |- _ => + pose proof H1 as H1'; apply name_gets_bigger in H1' + end; + repeat (destruct Hvars as [Hvars|Hvars]); + subst; + try contradiction || congruence || solve[eauto]; + try match goal with + | H1: _, H2: stringvar_ATLexpr _ _ = _ |- _ => + eapply H1 in H2; solve[invs'; eauto] + end. +Qed. + +Lemma eval_get_eval_get' ctx r sh idxs1 idxs2 : + NoDup (map untagged_fst_ctx_elt ctx) -> + result_has_shape' sh r -> + length sh = length idxs2 -> + Forall2 (wf_Zexpr (fun _ => tagged_string) interp_type_result ctx) idxs1 idxs2 -> + Forall2 (fun i len => (0 <= i < Z.of_nat len)%Z) (map interp_pZexpr idxs2) sh -> + eval_get (valuation_of ctx) r (map stringvar_Z idxs1) (eval_get' r (map interp_pZexpr idxs2)). +Proof. + intros H0 H1 H2 H3 H4. revert sh r H1 H2 H4. induction H3; intros sh r H1 H2 H4; simpl. + - destruct sh; try discriminate. invert H1. constructor. + - destruct sh; try discriminate. invert H1. simpl in H4. invert H4. + econstructor. + + eapply stringvar_Z_correct; eauto. + + lia. + + apply nth_error_nth'. lia. + + rewrite <- nth_default_eq. eapply IHForall2; eauto. + pose proof nth_In as H'. + eapply Forall_forall; [eassumption|]. rewrite nth_default_eq. + apply nth_In. lia. +Qed. + +Lemma stringvar_ZLit_correct ctx e1 e2 z : + wf_Zexpr (fun _ => tagged_string) interp_type_result ctx e1 e2 -> + stringvar_ZLit e1 = Some z -> + interp_pZexpr e2 = z. +Proof. + intros H. revert z. induction H; intros z Hz; simpl in *; + cbv [option_map] in *; + repeat (destruct_one_match_hyp; try congruence ; []); + invs'; + repeat match goal with + | H: forall _, _ -> _ |- _ => specialize (H _ eq_refl) + end; + subst; + auto; + congruence. +Qed. + +Lemma stringvar_S_correct ctx n e_nat e_shal e_string : + NoDup (map untagged_fst_ctx_elt ctx) -> + wf_ATLexpr (fun _ => tagged_string) interp_type_result ctx n e_nat e_shal -> + stringvar_S e_nat = Some e_string -> + idxs_in_bounds e_shal -> + match (result_of_pATLexpr e_shal) with + | Result.S s => + result_of_pATLexpr e_shal = Result.S s /\ + eval_Sexpr (valuation_of ctx) (ec_of ctx) e_string s + | Result.V _ => False + end. +Proof. + intros H0 H. revert e_string. induction H; intros e_string H' Hbds; + simpl in *; try congruence; + invs'; + repeat match goal with + | H: context[match ?x with _ => _ end] |- _ => destruct x; try congruence; [] + end; + invs'. + - invert Hbds. destruct s. + + split; [reflexivity|]. eassert (SS _ = _) as ->; cycle 1. + { econstructor. + - eapply ec_of_correct; eauto. + - constructor. } + reflexivity. + + split; [reflexivity|]. eassert (SS _ = _) as ->; cycle 1. + { econstructor. + - eapply ec_of_correct; eauto. + - constructor. } + reflexivity. + - remember (Var _) eqn:E'. destruct H; try congruence. invert E'. + split; [reflexivity|]. invs'. + eassert (eval_get' _ _ = _) as ->; cycle 1. + { econstructor. + - eapply ec_of_correct; eauto. + - eapply eval_get_eval_get'. 1: eauto. 3: eauto. 3: eauto. + { simpl in *. invs'. assumption. } + apply Forall2_length in H4. rewrite length_map in H4. auto. } + simpl. + reflexivity. + - specialize (IHwf_ATLexpr1 ltac:(eassumption) _ eq_refl ltac:(assumption)). + specialize (IHwf_ATLexpr2 ltac:(eassumption) _ eq_refl ltac:(assumption)). + repeat match goal with + | H: context[match ?x with _ => _ end] |- _ => destruct x; try contradiction; [] + end. + invs'. + repeat match goal with + | H: Result.S _ = Result.S _ |- _ => invert H + end. + split; [reflexivity|]. + destruct o; constructor; auto. + - split; [reflexivity|]. + cbv [option_map] in *. + repeat (destruct_one_match_hyp; try congruence || contradiction; []; invs'). + erewrite stringvar_ZLit_correct by eassumption. + replace (IZR z) with (Q2R (inject_Z z)). 1: constructor. + cbv [Q2R]. simpl. rewrite Rinv_1. ring. +Qed. + +Definition tags_consistent (x : ctx_elt2 (fun _ => tagged_string) interp_type_result) := + match x with + | {| ctx_elt_t := tZ; ctx_elt_p1 := x1; ctx_elt_p2 := x2 |} => + match x1, x2 with + | itervarstr _, itervarZ _ => True + | argvarstr _, argvarZ _ => True + | _, _ => False + end + | _ => True + end. +Hint Unfold tags_consistent : core. + +Lemma sizes_consistent_valuation_of ctx v : + NoDup (map untagged_fst_ctx_elt ctx) -> + Forall tags_consistent ctx -> + valuation_of ctx $<= v -> + Forall (sizes_consistent (fun x => match x with + | itervarstr _ => None + | argvarstr x0 => v $? x0 + end) sizeof_Z) ctx. +Proof. + intros H Htag Hinc. apply Forall_forall. intros x Hx. + destruct x. destruct ctx_elt_t; simpl; auto. + rewrite Forall_forall in Htag. specialize (Htag _ Hx). simpl in Htag. + destruct ctx_elt_p1; destruct ctx_elt_p2; try contradiction. + - simpl. eapply includes_lookup; [|eassumption]. + eapply valuation_of_correct in Hx; eauto. + - reflexivity. +Qed. +Hint Resolve sizes_consistent_valuation_of : core. + +Lemma not_In_valuation_of_None x ctx : + ~ In x (map untagged_fst_ctx_elt ctx) -> + valuation_of ctx $? x = None. +Proof. + intros. induction ctx. + - simpl. apply lookup_empty. + - simpl in *. destruct a. destruct ctx_elt_t; simpl in *; eauto. + rewrite lookup_add_ne. 1: eauto. + intros H'. subst. eauto. +Qed. + +Opaque stringvar_S. Opaque nat_to_string. +Hint Resolve dummy_result : core. +Lemma stringvar_ATLexpr_correct ctx sz n e_nat e_shal name name' e_string : + wf_ATLexpr (fun _ => tagged_string) interp_type_result ctx n e_nat e_shal -> + NoDup (map untagged_fst_ctx_elt ctx) -> + Forall tags_consistent ctx -> + (forall name'', In (nat_to_string name'') (map untagged_fst_ctx_elt ctx) -> name'' < name) -> + stringvar_ATLexpr name e_nat = Some (name', e_string) -> + sound_sizeof (fun _ => itervarstr (nat_to_string 0)) (fun x => match x with + | itervarstr _ => None + | argvarstr x0 => valuation_of ctx $? x0 + end) e_nat = Some sz -> + idxs_in_bounds e_shal -> + eval_expr (valuation_of ctx) (ec_of ctx) e_string (result_of_pATLexpr e_shal). +Proof. + intros H. revert name name' e_string sz. + induction H; intros name name' e_string sz Hctx1 Htags Hctx2 H' Hsz Hbds; + repeat match goal with + | H: context [match stringvar_ATLexpr ?name ?e with _ => _ end] |- _ => + let E := fresh "E" in + destruct (stringvar_ATLexpr name e) as [(?&?)|] eqn:E; [|congruence] + end; + invs'; + simpl in *; + repeat (destruct_one_match_hyp; try (congruence || contradiction); []); + invs'; + repeat match goal with + | H: (_ + apply Nat.ltb_lt in H + | H: (_ =? _)%nat = true |- _ => + apply Nat.eqb_eq in H; subst + | H: (_ <=? _)%nat = true |- _ => + apply Nat.leb_le in H + end. + - simpl. eapply mk_eval_gen. + + apply eval_Zexpr_Z_eval_Zexpr. apply stringvar_Z_correct; eauto. + + apply eval_Zexpr_Z_eval_Zexpr. apply stringvar_Z_correct; eauto. + + rewrite length_map. rewrite length_zrange. reflexivity. + + intros i' Hi'. rewrite nth_error_map. rewrite nth_error_zrange_is_Some by lia. + simpl. replace (_ + _)%Z with i' by lia. split. + { intros H''. apply dom_valuation_of in H''. + apply Hctx2 in H''. lia. } + split. + { apply no_question_marks. } + epose proof (H2 (itervarstr _) (itervarZ _)) as H2. + eapply H2; try eassumption; eauto. + { constructor; auto. intros H'. apply Hctx2 in H'. + cbv [untagged_fst_ctx_elt] in H'. simpl in H'. lia. } + { cbv [untagged_fst_ctx_elt]. simpl. intros name'' [Hn|Hn]. + - apply nat_to_string_injective in Hn. subst. lia. + - apply Hctx2 in Hn. lia. } + erewrite sound_sizeof_wf. 2: eauto. + 3: { simpl. constructor; eauto. + eapply sizes_consistent_valuation_of; eauto. + eapply includes_add_new. apply not_In_valuation_of_None. intros H'. + apply Hctx2 in H'. lia. } + { erewrite <- sound_sizeof_wf. 2: eauto. 1: eassumption. 1: apply blah. auto. } + apply blah. + - eapply mk_eval_sum. + + eapply sound_sizeof_size_of. 6: eassumption. all: eauto. + 3: { constructor; eauto. simpl. auto. } + all: simpl; eauto. + -- prove_sound_sizeof. + -- intros x ? ?. destruct x; try congruence. assumption. + + apply eval_Zexpr_Z_eval_Zexpr. apply stringvar_Z_correct; eauto. + + apply eval_Zexpr_Z_eval_Zexpr. apply stringvar_Z_correct; eauto. + + cbv [sizeof]. simpl. + erewrite <- sound_sizeof_wf with (dummy1 := fun _ => itervarstr (nat_to_string 0)). 1: rewrite Hsz. + all: eauto. + apply add_list_result_sum_with_sz. + intros. eapply sound_sizeof_result_has_shape; eauto; simpl; auto. + + rewrite length_map. rewrite length_zrange. reflexivity. + + intros i' Hi'. rewrite nth_error_map. rewrite nth_error_zrange_is_Some by lia. + simpl. replace (_ + _)%Z with i' by lia. split. + { intros H''. apply dom_valuation_of in H''. apply Hctx2 in H''. lia. } + split. + { apply no_question_marks. } + epose proof (H2 (itervarstr _) (itervarZ _)) as H2. + eapply H2; try eassumption; eauto. + { constructor; auto. intros H'. apply Hctx2 in H'. + cbv [untagged_fst_ctx_elt] in H'. simpl in H'. lia. } + { cbv [untagged_fst_ctx_elt]. simpl. intros name'' [Hn|Hn]. + - apply nat_to_string_injective in Hn. subst. lia. + - apply Hctx2 in Hn. lia. } + erewrite sound_sizeof_wf. 2: eauto. + 3: { simpl. constructor; eauto. + eapply sizes_consistent_valuation_of; eauto. + eapply includes_add_new. apply not_In_valuation_of_None. intros H'. + apply Hctx2 in H'. lia. } + { erewrite <- sound_sizeof_wf. 2: eauto. 1: eassumption. 1: apply blah. auto. } + apply blah. + - destruct (interp_pBexpr _) eqn:Eb. + + apply EvalGuardTrue; eauto. + rewrite <- Eb. apply stringvar_B_correct; auto. + + apply EvalGuardFalse; eauto. + -- rewrite <- Eb. apply stringvar_B_correct; auto. + -- cbv [sizeof]. simpl. + erewrite <- sound_sizeof_wf with (dummy1 := fun _ => itervarstr (nat_to_string 0)). 1: rewrite Hsz. + all: eauto. + eapply sound_sizeof_size_of; eauto; simpl; auto. + intros x ? ?. destruct x; congruence || auto. + - pose proof E0 as E0'. pose proof E2 as E2'. + apply name_gets_bigger in E0', E2'. + pose proof (vars_of_stringvar_ATLexpr _ _ _ _ _ E0) as E0''. + pose proof (vars_of_stringvar_ATLexpr _ _ _ _ _ E2) as E2''. + eapply EvalLbind. + + eapply sound_sizeof_size_of. 6: eassumption. all: eauto; simpl; auto. + intros x ? ?. destruct x; congruence || auto. + + apply None_dom_lookup. intros H'. apply dom_ec_of in H'. + apply Hctx2 in H'. lia. + + split; intros H'. + -- apply E0'' in H'. invs''. lia. + -- apply E2'' in H'. invs''. lia. + + apply sets_equal. split; try contradiction. intros [H1' H2']. + apply E0'' in H1'. apply E2'' in H2'. invs''. lia. + + eapply IHwf_ATLexpr. 4: eassumption. all: eauto. + intros ? H'. apply Hctx2 in H'. lia. + + epose proof (H1 (itervarstr _) _) as H1. + eapply H1. 4: eassumption. + -- constructor; auto. intros H'. apply Hctx2 in H'. cbv [untagged_fst_ctx_elt] in H'. simpl in H'. lia. + -- auto. + -- cbv [untagged_fst_ctx_elt]. simpl. intros ? [Hn|Hn]. + ++ apply nat_to_string_injective in Hn. subst. lia. + ++ apply Hctx2 in Hn. lia. + -- prove_sound_sizeof. + -- auto. + - pose proof E4 as E4'. pose proof E6 as E6'. + apply name_gets_bigger in E4', E6'. + eapply sound_sizeof_result_has_shape in E1; eauto; []. + eapply sound_sizeof_result_has_shape in E; eauto; []. + invert E. invert E1. + constructor; + match goal with + | H: V _ = _ |- _ => rewrite H + end. + + eauto. + + eapply IHwf_ATLexpr2. 4: eassumption. all: eauto. intros ? H''. + apply Hctx2 in H''. lia. + - pose proof E2 as E2'. + apply name_gets_bigger in E2'. + eapply sound_sizeof_result_has_shape in E; eauto; []. + invert E. + constructor; + try match goal with + | H: V _ = _ |- _ => rewrite H + end. + + eauto. + + eapply Forall_impl; [|eassumption]. invert 1; eauto. + - pose proof E3 as E3'. + apply name_gets_bigger in E3'. + eapply sound_sizeof_result_has_shape in E; eauto; []. + invert E. + constructor; + try match goal with + | H: V _ = _ |- _ => rewrite H + end. + + eauto. + + apply eval_Zexpr_Z_eval_Zexpr. apply stringvar_Z_correct; assumption. + - pose proof E2 as E2'. + apply name_gets_bigger in E2'. + pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto; []. + invert E'. + cbv [sizeof]. + erewrite <- sound_sizeof_wf with (dummy1 := fun _ => itervarstr (nat_to_string 0)). 1: rewrite E. + all: eauto. + constructor; + try match goal with + | H: V _ = _ |- _ => rewrite H + end. + + eauto. + + eapply sound_sizeof_size_of; eauto; simpl; auto. + intros x ? ?. destruct x; congruence || auto. + - pose proof E3 as E3'. + apply name_gets_bigger in E3'. + eapply sound_sizeof_result_has_shape in E; eauto; []. + invert E. + constructor; + try match goal with + | H: V _ = _ |- _ => rewrite H + end. + + apply eval_Zexpr_Z_eval_Zexpr. apply stringvar_Z_correct; assumption. + + eauto. + - pose proof E3 as E3'. + apply name_gets_bigger in E3'. + eapply sound_sizeof_result_has_shape in E; eauto; []. + invert E. + constructor; + try match goal with + | H: V _ = _ |- _ => rewrite H + end. + + apply eval_Zexpr_Z_eval_Zexpr. apply stringvar_Z_correct; assumption. + + eauto. + - pose proof E2 as E2'. + apply name_gets_bigger in E2'. + pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto; []. + invert E'. + cbv [sizeof]. + erewrite <- sound_sizeof_wf with (dummy1 := fun _ => itervarstr (nat_to_string 0)). 1: rewrite E. + all: eauto. + econstructor; + try match goal with + | H: V _ = _ |- _ => rewrite H + end. + + apply eval_Zexpr_Z_eval_Zexpr. apply stringvar_Z_correct; assumption. + + eapply sound_sizeof_size_of; eauto; simpl; auto. + intros x ? ?. destruct x; congruence || auto. + + eauto. + - pose proof E2 as E2'. + apply name_gets_bigger in E2'. + pose proof E as E'. + eapply sound_sizeof_result_has_shape in E'; eauto; []. + invert E'. + cbv [sizeof]. + erewrite <- sound_sizeof_wf with (dummy1 := fun _ => itervarstr (nat_to_string 0)). 1: rewrite E. + all: eauto. + econstructor; + try match goal with + | H: V _ = _ |- _ => rewrite H + end. + + apply eval_Zexpr_Z_eval_Zexpr. apply stringvar_Z_correct; assumption. + + eapply sound_sizeof_size_of; eauto; simpl; auto. + intros x ? ?. destruct x; congruence || auto. + + eauto. + - congruence. + - pose proof stringvar_S_correct as H'. + epose proof (H' _ _ _ _ _) as H'. + specialize (H' ltac:(eassumption)). + specialize H' with (2 := E2). + specialize (H' ltac:(constructor; eauto) ltac:(simpl; eauto)). + simpl in H'. + invs'. constructor. assumption. + - repeat match goal with + | H: context[match ?x with _ => _ end] |- _ => + let E := fresh "E" in destruct x eqn:E; [|congruence]; [] + end. + invs'. + pose proof stringvar_S_correct as H'. + epose proof (H' _ _ _ _ _) as H'. + specialize (H' ltac:(eassumption)). + specialize H' with (2 := E1). + specialize (H' ltac:(constructor; eauto) ltac:(simpl; eauto)). + match goal with + | H: context[match ?x with _ => _ end] |- _ => + let E := fresh "E" in destruct x eqn:E; try congruence || contradiction; [] + end. + invs'. + simpl in E2. + rewrite E2. + constructor. assumption. + - constructor. eapply stringvar_S_correct in E; eauto. + simpl in E. invs'. assumption. + Unshelve. + all: try exact 0%Z || exact dummy_result || exact (fun _ => 0%nat) || exact (Result.S Result.SX). +Qed. diff --git a/src/verified_lowering/inferpad/Reify.v b/src/verified_lowering/inferpad/Reify.v index b3d3f5f..0f08394 100644 --- a/src/verified_lowering/inferpad/Reify.v +++ b/src/verified_lowering/inferpad/Reify.v @@ -1,266 +1,494 @@ 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 Reals.Reals. 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 Logic.FunctionalExtensionality. +From Stdlib Require Import Strings.String. 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. -Set Warnings "-omega-is-deprecated,-deprecated". - -From Codegen Require Import IdentParsing NatToString IntToString Normalize CodeGen. -From Lower Require Import ATLDeep Sexpr Zexpr Bexpr. -From ATL Require Import ATL Common CommonTactics Div. +From Codegen Require Import Normalize. +From Lower Require Import ATLDeep Sexpr Zexpr Bexpr ListMisc. +From ATL Require Import ATL Common CommonTactics Div Map. +From Inferpad Require Import ATLSpecs ATLPhoas TensorToResult NatToString. Open Scope string_scope. -Set Default Proof Mode "Classic". - -Definition is_lit (z :Z) := True. - -Ltac mark_lit := - repeat - match goal with - | z : Z |- _ => - assert (is_lit z) by (unfold is_lit; auto); - generalize dependent z - end; intros. - -Ltac reify_Z z := - match z with - | (?x * ?y)%Z => - let lx := reify_Z x in - let ly := reify_Z y in - constr:(ZTimes lx ly) - | (?x + ?y)%Z => - let lx := reify_Z x in - let ly := reify_Z y in - constr:(ZPlus lx ly) - | (?x - ?y)%Z => - let lx := reify_Z x in - let ly := reify_Z y in - constr:(ZMinus lx ly) - | (?x / ?y)%Z => - let lx := reify_Z x in - let ly := reify_Z y in - constr:(ZDivf lx ly) - | (?x // ?y)%Z => - let lx := reify_Z x in - let ly := reify_Z y in - constr:(ZDivc lx ly) - | (?x mod ?y)%Z => - let lx := reify_Z x in - let ly := reify_Z y in - constr:(ZMod lx ly) - | Z.of_nat ?x => - constr:(ZLit z) - | _ => let _ := match goal with _ => is_var z end in - match goal with - | H : is_lit z |- _ => constr:(ZLit z) - | _ => constr:(ZVar ltac:(to_str z)) - end - | _ => constr:(ZLit z) +Definition pExpr_type var (t : type) : Type := + match t with + | tZ => pZexpr (var tZ) + | tB => pBexpr (var tZ) + | tensor_n n => pATLexpr var n end. -(* -Goal forall i j, (i + j = 0)%Z. - intros. mark_lit. - let s := reify_Z (i / 0 + j // i * 1 - (i mod 1))%Z in - idtac s. - *) - -Ltac reify_get g := - lazymatch g with - | get ?v ?i => - let tup := reify_get v in - 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)) +Definition pair_to_reify (f : (type -> Type) -> Type) : Type := + f interp_type * (forall var, f (pExpr_type var)). + +Definition gen_n n := @genr (dim_n n) _. +Definition sum_n n := @sumr (dim_n n) _. +Definition iverson_n n := @iverson (dim_n n) _. +Definition flatten_n n := @Common.flatten (dim_n n) _. +Definition truncr_n n := @Common.Truncr (dim_n n) _. +Definition truncl_n n := @Common.Truncl (dim_n n) _. +Definition transpose_n n := @transpose (dim_n n) _. +Definition concat_n n := @concat (dim_n n) _. +Definition tile_n n := @Tile (dim_n n) _. +(*i guess we only reify bin_n O*) +Definition bin_n n := @bin (dim_n n) _. +Definition let_nm n m := @let_binding (dim_n n) (dim_n m). + +(*surely het-list notations are already available somewhere?*) +(*surely this notation is stupid enough that it's not being used for naything else*) +Local Notation "[> <]" := tt (format "[> <]"). +Local Notation "[> x <]" := (x, tt). +Local Notation "[> x ; y ; .. ; z <]" := ((x, (y, .. (z, tt) ..))). + +Definition pairs_to_reify := + [> + (Z0, fun var => ZZ0) + : pair_to_reify (fun var => var tZ); + (Zpos, fun var => ZZpos) + : pair_to_reify (fun var => positive -> var tZ); + (Zneg, fun var => ZZneg) + : pair_to_reify (fun var => positive -> var tZ); + (Z.opp, fun var => ZZopp) + : pair_to_reify (fun var => var tZ -> var tZ); + (IZR, fun var => SIZR) + : pair_to_reify (fun var => var tZ -> var (tensor_n O)); + (gen_n, fun var => (fun n lo hi body => @Gen var n lo hi (fun x => body (@ZVar (var tZ) x)))) + : pair_to_reify (fun var => forall n, var tZ -> var tZ -> (var tZ -> var (tensor_n n)) -> var (tensor_n (S n))); + (sum_n, fun var => (fun n lo hi body => @Sum var n lo hi (fun x => body (@ZVar (var tZ) x)))) + : pair_to_reify (fun var => forall n, var tZ -> var tZ -> (var tZ -> var (tensor_n n)) -> var (tensor_n n)); + (let_nm, fun var => (fun n m x f => @Lbind var n m x (fun x0 => f (@Var var n x0)))) + : pair_to_reify (fun var => forall n m, var (tensor_n n) -> (var (tensor_n n) -> var (tensor_n m)) -> var (tensor_n m)); + (@get_R, fun var => @Get var) + : pair_to_reify (fun var => forall n, var (tensor_n n) -> list (var tZ) -> var (tensor_n O)); + (iverson_n, fun var => @Guard var) + : pair_to_reify (fun var => forall n, var tB -> var (tensor_n n) -> var (tensor_n n)); + (flatten_n, fun var => @Flatten var) + : pair_to_reify (fun var => forall n, var (tensor_n (S (S n))) -> var (tensor_n (S n))); + (truncr_n, fun var => @Truncr var) + : pair_to_reify (fun var => forall n, var tZ -> var (tensor_n (S n)) -> var (tensor_n (S n))); + (truncl_n, fun var => @Truncl var) + : pair_to_reify (fun var => forall n, var tZ -> var (tensor_n (S n)) -> var (tensor_n (S n))); + (transpose_n, fun var => @Transpose var) + : pair_to_reify (fun var => forall n, var (tensor_n (S (S n))) -> var (tensor_n (S (S n)))); + (concat_n, fun var => @Concat var) + : pair_to_reify (fun var => forall n, var (tensor_n (S n)) -> var (tensor_n (S n)) -> var (tensor_n (S n))); + (tile_n, fun var => (fun n x k => @Split var n k x)) + : pair_to_reify (fun var => forall n, var (tensor_n (S n)) -> var tZ -> var (tensor_n (S (S n)))); + (Z.of_nat, fun var => ZZ_of_nat) + : pair_to_reify (fun var => nat -> var tZ); + (Z.add, fun var => ZBop ZPlus) + : pair_to_reify (fun var => var tZ -> var tZ -> var tZ); + (Z.sub, fun var => ZBop ZMinus) + : pair_to_reify (fun var => var tZ -> var tZ -> var tZ); + (Z.mul, fun var => ZBop ZTimes) + : pair_to_reify (fun var => var tZ -> var tZ -> var tZ); + (Z.div, fun var => ZBop ZDivf) + : pair_to_reify (fun var => var tZ -> var tZ -> var tZ); + (div_ceil, fun var => ZBop ZDivc) + : pair_to_reify (fun var => var tZ -> var tZ -> var tZ); + (Z.modulo, fun var => ZBop ZMod) + : pair_to_reify (fun var => var tZ -> var tZ -> var tZ); + (Z.ltb, fun var => BBop BLt) + : pair_to_reify (fun var => var tZ -> var tZ -> var tB); + (Z.leb, fun var => BBop BLe) + : pair_to_reify (fun var => var tZ -> var tZ -> var tB); + (Z.eqb, fun var => BBop BEq) + : pair_to_reify (fun var => var tZ -> var tZ -> var tB); + (andb, fun var => BAnd) + : pair_to_reify (fun var => var tB -> var tB -> var tB); + (Rmult, fun var => @SBop var Mul) + : pair_to_reify (fun var => var (tensor_n O) -> var (tensor_n O) -> var (tensor_n O)); + (Rplus, fun var => SBop Add) + : pair_to_reify (fun var => var (tensor_n O) -> var (tensor_n O) -> var (tensor_n O)) + <]. +Class TupleMap_fst T := { tuplemap_fst_Type : Type; tuplemap_fst : T -> tuplemap_fst_Type }. +Instance TupleMap_fst_nil : TupleMap_fst unit := { tuplemap_fst := fun x => x }. +Instance TupleMap_fst_cons (A B C : Type) (f : TupleMap_fst C) : TupleMap_fst ((A * B) * C) := { tuplemap_fst := fun '((a, b), c) => (a, tuplemap_fst c) }. + +Class TupleMap_snd T := { tuplemap_snd_Type : Type; tuplemap_snd : T -> tuplemap_snd_Type }. +Instance TupleMap_snd_nil : TupleMap_snd unit := { tuplemap_snd := fun x => x }. +Instance TupleMap_snd_cons (A B C : Type) (f : TupleMap_snd C) : TupleMap_snd ((A * B) * C) := { tuplemap_snd := fun '((a, b), c) => (b, tuplemap_snd c) }. + +Class TupleMap_app U T := { tuplemap_app_Type : U -> Type; tuplemap_app : forall U, T -> tuplemap_app_Type U }. +Instance TupleMap_app_nil U : TupleMap_app U unit := { tuplemap_app := fun _ x => x }. +Instance TupleMap_app_cons U B C {X: TupleMap_app U C} : TupleMap_app U ((forall U, B U) * C) := { tuplemap_app := fun u '(a, c) => (a u, tuplemap_app u c) }. + +Definition shallows := + ltac:(let y := eval cbn -[interp_type] in (tuplemap_fst pairs_to_reify) in exact y). +Definition deeps := + ltac:(let y := eval simpl in (tuplemap_snd pairs_to_reify) in exact y). + +Definition app_deeps (var : type -> Type) := + ltac:(let y := eval simpl in (tuplemap_app var deeps) in exact y). + +Class Tuple_apps T U := { tuple_apps_type : Type ; tuple_apps : tuple_apps_type -> T -> U }. +Instance Tuple_apps_nil U : Tuple_apps unit U := { tuple_apps := fun f _ => f }. +Instance Tuple_apps_cons T U B {X : Tuple_apps T U} : Tuple_apps (B * T) U := { tuple_apps := fun f '(b, c) => tuple_apps (f b) c }. + +Definition apply_to_all' {U : Type} (var : type -> Type) f : U := + tuple_apps f (app_deeps var). + +Definition apply_to_all {U : Type} (var : type -> Type) f : U := + ltac:(let y := eval cbv [apply_to_all' app_deeps tuple_apps] in (@apply_to_all' U var f) in + let y := eval simpl in y in + exact y). + +(*this relies on interp_type not being unfolded in type of l*) +Ltac print_shallows' l t := + lazymatch l with + | tt => idtac + | (?a, ?l) => + lazymatch t with + | (?A * ?t)%type => + idtac ",(" a ":" A ")"; print_shallows' l t + end 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%Q) - | 0%R => constr:(Lit 1%Q) - | (?a * ?b)%R => - let la := reify_R a in - let lb := reify_R b in - constr:(Mul la lb) - | (?a + ?b)%R => - let la := reify_R a in - let lb := reify_R b in - constr:(Add la lb) - | (?a - ?b)%R => - let la := reify_R a in - let lb := reify_R b in - constr:(Sub la lb) - | (?a / ?b)%R => - let la := reify_R a in - let lb := reify_R b in - constr:(Div la lb) - | _ => - let tup := reify_get s in - constr:(match tup with - | (var,idx) => Get var idx - end) + +Ltac print_shallows := + match type of shallows with + | ?t => let l := eval cbv [shallows] in shallows in + print_shallows' l t end. +Goal True. (*print_shallows.*) Abort. + +Ltac pattern_shallows x := + pattern interp_type + (*copy-paste result of "print_shallows" on following lines*) + (*TODO is there a less dumb way to do this? Ltac metaprogramming?*) + +,( 0%Z : (interp_type tZ) ) +,( Z.pos : (positive -> interp_type tZ) ) +,( Z.neg : (positive -> interp_type tZ) ) +,( Z.opp : (interp_type tZ -> interp_type tZ) ) +,( IZR : (interp_type tZ -> interp_type (tensor_n 0)) ) +,( gen_n : +(forall n : nat, + interp_type tZ -> + interp_type tZ -> + (interp_type tZ -> interp_type (tensor_n n)) -> interp_type (tensor_n (S n))) +) +,( sum_n : +(forall n : nat, + interp_type tZ -> + interp_type tZ -> + (interp_type tZ -> interp_type (tensor_n n)) -> interp_type (tensor_n n)) +) +,( let_nm : +(forall n m : nat, + interp_type (tensor_n n) -> + (interp_type (tensor_n n) -> interp_type (tensor_n m)) -> interp_type (tensor_n m)) +) +,( @get_R : +(forall n : nat, + interp_type (tensor_n n) -> list (interp_type tZ) -> interp_type (tensor_n 0)) +) +,( iverson_n : +(forall n : nat, interp_type tB -> interp_type (tensor_n n) -> interp_type (tensor_n n)) +) +,( flatten_n : +(forall n : nat, interp_type (tensor_n (S (S n))) -> interp_type (tensor_n (S n))) ) +,( truncr_n : +(forall n : nat, + interp_type tZ -> interp_type (tensor_n (S n)) -> interp_type (tensor_n (S n))) +) +,( truncl_n : +(forall n : nat, + interp_type tZ -> interp_type (tensor_n (S n)) -> interp_type (tensor_n (S n))) +) +,( transpose_n : +(forall n : nat, interp_type (tensor_n (S (S n))) -> interp_type (tensor_n (S (S n)))) +) +,( concat_n : +(forall n : nat, + interp_type (tensor_n (S n)) -> + interp_type (tensor_n (S n)) -> interp_type (tensor_n (S n))) +) +,( tile_n : +(forall n : nat, + interp_type (tensor_n (S n)) -> interp_type tZ -> interp_type (tensor_n (S (S n)))) +) +,( Z.of_nat : (nat -> interp_type tZ) ) +,( Z.add : (interp_type tZ -> interp_type tZ -> interp_type tZ) ) +,( Z.sub : (interp_type tZ -> interp_type tZ -> interp_type tZ) ) +,( Z.mul : (interp_type tZ -> interp_type tZ -> interp_type tZ) ) +,( Z.div : (interp_type tZ -> interp_type tZ -> interp_type tZ) ) +,( div_ceil : (interp_type tZ -> interp_type tZ -> interp_type tZ) ) +,( Z.modulo : (interp_type tZ -> interp_type tZ -> interp_type tZ) ) +,( Z.ltb : (interp_type tZ -> interp_type tZ -> interp_type tB) ) +,( Z.leb : (interp_type tZ -> interp_type tZ -> interp_type tB) ) +,( Z.eqb : (interp_type tZ -> interp_type tZ -> interp_type tB) ) +,( andb : (interp_type tB -> interp_type tB -> interp_type tB) ) +,( Rmult : +(interp_type (tensor_n 0) -> interp_type (tensor_n 0) -> interp_type (tensor_n 0)) ) +,( Rplus : +(interp_type (tensor_n 0) -> interp_type (tensor_n 0) -> interp_type (tensor_n 0)) ) -Ltac reify_bool b := - lazymatch b with - | ?a && ?b => - let ab := reify_bool a in - let bb := reify_bool b in - constr:(And ab bb) - | (?a - let ab := reify_Z a in - let bb := reify_Z b in - constr:(Lt ab bb) - | (?a <=? ?b)%Z => - let ab := reify_Z a in - let bb := reify_Z b in - constr:(Le ab bb) - | (?a =? ?b)%Z => - let ab := reify_Z a in - let bb := reify_Z b in - constr:(Eq ab bb) + in x. + +Ltac get_fun x := + lazymatch x with + | ?f _ => get_fun f + | _ => x end. -(* -Goal forall (i j : Z), True. + +Ltac make_types_reifiable_in x := + lazy [dim_n] in x; + (*Line above prevents line below from caulsing following error. + Error: Replacement would lead to an ill-typed term: In pattern-matching on term + "n" the branch for constructor "O" has type "Type" which should be + "Set".*) + change R with (interp_type (tensor_n O)) in x; + repeat change (list (interp_type (tensor_n ?n))) with (interp_type (tensor_n (S n))) in x; + change RTensorElem with (dim_n_TensorElem O) in x; + repeat change (@TensorTensorElem _ (dim_n_TensorElem ?n)) with + (dim_n_TensorElem (S n)) in x; + repeat change (@get _ _ ?v ?i) with (@get_R (S O) v [i]) in x; + repeat change (@get_R ?n (@get _ _ ?v ?idx) ?idxs) with (@get_R (S n) v (idx :: idxs)) in x; + change Z with (interp_type tZ) in x; + cbv [gen sum] in x; + + repeat change (@genr (interp_type (tensor_n ?n)) _) with (gen_n n) in x; + repeat change (@sumr (interp_type (tensor_n ?n)) _) with (sum_n n) in x; + repeat change (@iverson (interp_type (tensor_n ?n)) _) with (iverson_n n) in x; + repeat change (@Common.flatten (interp_type (tensor_n ?n)) _) with (flatten_n n) in x; + repeat change (@Common.Truncr (interp_type (tensor_n ?n)) _) with (truncr_n n) in x; + repeat change (@Common.Truncl (interp_type (tensor_n ?n)) _) with (truncl_n n) in x; + repeat change (@transpose (interp_type (tensor_n ?n)) _) with (transpose_n n) in x; + repeat change (@concat (interp_type (tensor_n ?n)) _) with (concat_n n) in x; + repeat change (@Tile (interp_type (tensor_n ?n)) _) with (tile_n n) in x; + repeat change (@let_binding (interp_type (tensor_n ?n)) (interp_type (tensor_n ?m))) with (let_nm n m) in x; + change (@bin (interp_type (tensor_n O)) _) with Rplus in x. + +Ltac Reify0 x name := + let y := fresh "y" in + let z := fresh "z" in + pose (y := x); + pattern_shallows y; + let rx := + lazymatch goal with + | y := ?y' |- _ => get_fun y' + end in + pose (z := rx); + let w := constr:(fun var => apply_to_all var (z (pExpr_type var))) in + let w := (eval cbv [apply_to_all z] in w) in + pose (name := w); + subst y; subst z; simpl. + +Ltac Reify x name := + let h := fresh "h" in + pose (h := x); + lazy [Z.to_nat PosDef.Pos.to_nat PosDef.Pos.iter_op Nat.add PosDef.Pos.of_succ_nat PosDef.Pos.succ] in h; + make_types_reifiable_in h; + let h0 := (eval cbv [h] in h) in + subst h; + Reify0 h0 name. + +Definition Var' {t var} (x : var t) : pExpr_type var t := + match t return var t -> pExpr_type var t with + | tZ => ATLPhoas.ZVar + | tB => fun _ => BBop BEq ZZ0 ZZ0 + | tensor_n n => Var + end x. + +Fixpoint varify var ts T (f : fun_type (pExpr_type var) ts T) : fun_type var ts T := + match ts return fun_type (pExpr_type var) ts T -> fun_type var ts T with + | [] => fun f => f + | t :: ts' => fun f => fun x => varify var ts' T (f (Var' x)) + end f. + +Ltac prove_spec_of0 := + match goal with + | |- spec_of ?ts ?n ?name ?size ?string_expr ?shallow_expr => + let e' := fresh "e'" in + Reify shallow_expr e'; + refine (spec_of_correct _ _ _ (fun var => varify var ts _ (e' var)) _ _ _ _ _ _ _ _ _ _ _); + [ lazy[interp_fvar_pATLexpr varify interp_pATLexpr interp_Sbop get_R map interp_pZexpr Var' e']; reflexivity | .. ]; + cycle -1; [ repeat match goal with + | x := _ : _ |- context[?x] => subst x + end; simpl; reflexivity | .. ] + end. + +Ltac checks_are_true := + repeat match goal with + | |- context[(_ =? _)%nat] => + replace (_ =? _)%nat with true by (symmetry; apply Nat.eqb_eq; lia) + | |- context[(_ + replace (_ progress intros + | H: andb _ _ = true |- _ => apply andb_prop in H; destruct H + | H: (_ apply Z.ltb_lt in H + | H: (_ <=? _)%Z = true |- _ => apply Z.leb_le in H + | |- Forall2 _ _ _ => constructor + | H: _ /\ _ |- _ => destruct H + | |- _ /\ _ => split + | |- _ => lia + | |- _ = _ => reflexivity + end. + +Lemma forallb_not_prefix_correct l : + forallb (fun x => negb (prefix "var_" x)) l = true -> + Forall (fun x => ~starts_with_var x) l. Proof. - intros. - let s := reify_bool constr:((i - let pr := reify_bool p in - let body := reify e in - constr:(Guard pr body) - | GEN [ 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:(Gen i (|0|)%z rn rbody) - | GEN [ ?mm <= 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 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 + intros H. apply Forall_forall. intros. + eapply forallb_forall in H; eauto. + cbv [starts_with_var]. + intros H'. invs'. simpl in H. destruct x0; simpl in H; congruence. +Qed. - let _ := match goal with _ => - let tempH := fresh "tempH" in - (assert (exists temp, temp = e1) as tempH - by eauto; destruct tempH) - 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 +Ltac prove_sideconditions := + match goal with + | |- Wf_fvar_ATLExpr _ => + simpl; apply WfByUnnatify; simpl; reflexivity + | |- NoDup _ => + apply nodupb_string_correct; reflexivity + | |- Forall (fun x => ~starts_with_var x) _ => + apply forallb_not_prefix_correct; reflexivity + | |- fvar_sound_sizeof _ _ => + repeat progress (intros; cbv [list_eqb]; cbn -[Nat.eqb Nat.ltb]; checks_are_true); try (exact I) + | |- fvar_idxs_in_bounds' _ _ => + repeat progress (intros; cbv [list_eqb]; cbn -[Nat.eqb Nat.ltb]; checks_are_true; do_arith) + | |- fvar_sum_bounds_good _ _ => + simpl; intros; do_arith + | |- _ => idtac + end. - 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 - constr:(Transpose re) - | tile ?e ?k => - let re := reify e in - let rk := reify_Z (Z.of_nat k) in - constr:(Split rk re) - | Common.flatten ?e => - let re := reify e in - constr:(Flatten re) - | truncr ?k ?e => - let rk := reify_Z constr:(Z.of_nat k) in - let re := reify e in - constr:(ATLDeep.Truncr rk re) - | truncl ?k ?e => - let rk := reify_Z constr:(Z.of_nat k) in - let re := reify e in - constr:(Truncl rk re) - | Truncr ?k ?e => - let rk := reify_Z constr:(k) in - let re := reify e in - constr:(ATLDeep.Truncr rk re) - | truncl ?k ?e => - let rk := reify_Z constr:(Z.of_nat k) in - let re := reify e in - constr:(Truncl rk re) - | pad_r ?k ?e => - let rk := reify_Z constr:(Z.of_nat k) in - let re := reify e in - constr:(Padr rk re) - | pad_l ?k ?e => - let rk := reify_Z constr:(Z.of_nat k) in - let re := reify e in - constr:(Padl rk re) - | ?a <++> ?b => - let ra := reify a in - let rb := reify b in - constr:(Concat ra rb) - | _ => let s := reify_R prog in - constr:(Scalar s) +Fixpoint size_correct ts sz := + match ts, sz with + | [], size_nil _ => True + | tZ :: ts', with_Z_var sz' => forall x, size_correct ts' (sz' x) + | tensor_n n :: ts', with_T_var sh sz' => n = length sh /\ size_correct ts' sz' + | _, _ => False end. -Ltac R := - let _ := match goal with _ => intros; - try autounfold with examples; - mark_lit +Fixpoint same_function ts n sz (f1 f2 : fun_type interp_type ts (dim_n n)) := + match ts, sz return fun_type _ ts _ -> fun_type _ ts _ -> _ with + | [], size_nil P => fun f1 f2 => + P -> + f1 = f2 + | tZ :: ts', with_Z_var sz' => fun f1 f2 => + forall x, same_function ts' n (sz' x) (f1 x) (f2 x) + | tensor_n _ :: ts', with_T_var sh sz' => fun f1 f2 => + forall x, + tensor_has_size' sh x -> + same_function ts' n sz' (f1 x) (f2 x) + | _, _ => fun _ _ => False + end f1 f2. + +Lemma spec_of'_ext ts n names sz e_string f1 f2 v ec : + size_correct ts sz -> + spec_of' ts n names sz e_string f1 v ec -> + same_function ts n sz f1 f2 -> + spec_of' ts n names sz e_string f2 v ec. +Proof. + revert names sz v ec. + induction ts as [|t ?]; simpl; intros names sz v ec H1 H2 H3; + try destruct t; destruct sz, names; try contradiction. + - cbv [spec_of spec_of'] in *. intros. rewrite <- H3 by assumption. auto. + - intros. eapply IHts; eauto. + - invs'. intros. eapply IHts; eauto. + apply H3. apply tensor_of_result_size; auto. +Qed. + +Lemma spec_of_ext ts n name sz e_string f1 f2 : + size_correct ts sz -> + same_function ts n sz f1 f2 -> + spec_of ts n name sz e_string f1 -> + spec_of ts n name sz e_string f2. +Proof. intros. eapply spec_of'_ext; eassumption. Qed. + +Ltac normalize_spec_of := + lazy[dim_n]; + eapply spec_of_ext; [solve[simpl; auto] | cbn [same_function]; intros; symmetry; normalize; reflexivity |]. + +Ltac prove_spec_of := normalize_spec_of; prove_spec_of0; prove_sideconditions. + +Lemma with_Z_var_eq f g : + f = g -> + with_Z_var f = with_Z_var g. +Proof. intros. subst. reflexivity. Qed. + +Lemma with_T_var_eq s f g : + f = g -> + with_T_var s f = with_T_var s g. +Proof. intros. subst. reflexivity. Qed. + +Ltac normalize_size_spec := + cbv [size_spec_of]; + simpl; + repeat match goal with + | |- _ => + progress (cbv [option_map]; simpl; first [rewrite lookup_add_ne by congruence | rewrite lookup_add_eq by reflexivity]) + | |- with_Z_var _ = _ => + apply with_Z_var_eq; apply functional_extensionality; intro + | |- with_T_var _ _ = _ => + simpl; apply with_T_var_eq + | _ => simpl; reflexivity + end. + +Ltac prove_stringy_spec := + cbv [stringy_spec_of]; + simpl map; + match goal with + | |- spec_of _ _ _ ?size _ _ => + eassert (size = _) as -> by normalize_size_spec + end; + prove_spec_of. + +Ltac infer_ts' t := + match t with + | pExpr_type _ ?t0 -> ?t' => + let ts0 := infer_ts' t' in + constr:(@cons ATLPhoas.type t0 ts0) + | _ => constr:(@nil ATLPhoas.type) + end. + +Ltac infer_ts x := + let x' := constr:(x (fun _ => (unit : Type))) in + match type of x' with + | ?T => infer_ts' T + end. + +Ltac Reify_lhs := + let name := fresh "name" in + let _ := lazymatch goal with + | |- ?x = _ => Reify x name end in - let _ := match goal with _ => - normalize end in + let ret := eval cbv[name] in name in + let ts := infer_ts ret in + let ret := constr:((fun var => varify var ts _ (ret var))) in + let ret := (eval simpl in ret) in + let ret := constr:(@stringvar_fvar_ATLexpr ts _ (map (fun x => "arg" ++ x) (map nat_to_string (seq O (length ts)))) (ret _)) in + let ret := (eval compute in ret) in + let ret := match ret with + | Some ?ret => ret + end in + ret. - let prog := match goal with |- ?prog = _ => prog end in - - let ast := reify prog in - let ast := eval simpl in ast in +Ltac R := + let _ := match goal with _ => autounfold with examples end in + (*The idea is that the 'R' tactic should allow for convenient non-verified + reification. However, the 'R' tactic only works when the target expression + is already normalized. + The problem is that the 'normalize' in the following line does not work; + the goal does not have the right shape (easy problem to fix), + and it does not have the appropriate hypotheses (hard problem to fix) *) + (* let _ := match goal with _ => normalize end in *) + let ast := Reify_lhs in ast. + (* + Goal forall r p, tlet x := (|[ p ]| tlet x := r*r in (tlet x1 := r+x in x1 + 1))%R in (x+1)%R = 0%R. Proof. @@ -280,7 +508,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/inferpad/ReifyExamples.v b/src/verified_lowering/inferpad/ReifyExamples.v index 1463222..0beec73 100644 --- a/src/verified_lowering/inferpad/ReifyExamples.v +++ b/src/verified_lowering/inferpad/ReifyExamples.v @@ -1,288 +1,349 @@ -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 Logic.FunctionalExtensionality. From Stdlib Require Import micromega.Lia. From Stdlib Require Import micromega.Zify. From Stdlib Require Import Lists.List. +From Stdlib Require Import QArith. Import ListNotations. -From ATL Require Import ATL Tactics Common CommonTactics Div Reshape. +From ATL Require Import ATL Tactics Common CommonTactics Div Reshape Map. From Codegen Require Import IdentParsing NatToString IntToString CodeGen Normalize CheckSafe. From Examples Require Import GatherScatter Convolution Im2col Blur TensorAdd Matmul. -From Inferpad Require Import Reify. -From Lower Require Import Zexpr ATLDeep Bexpr Sexpr. +From Inferpad Require Import Reify ATLPhoas TensorToResult ATLSpecs. +From Lower Require Import Zexpr ATLDeep Bexpr Sexpr ATLDeep. Open Scope string_scope. +Open Scope nat_scope. -Set Default Proof Mode "Classic". - -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. - let ast := R in idtac. -Abort. - -Goal forall A B C k (m1 m2 : list (list R)), - (0 < k)%Z -> - (0 < A)%Z -> - (0 < B)%Z -> - (0 < C)%Z -> - consistent m1 (Z.to_nat A,(Z.to_nat B,tt)) -> - 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. - let ast := R in idtac. -Abort. +Definition add_args := + [Z_arg "A"; + Z_arg "B"; + Z_arg "C"; + Z_arg "D"; + T_arg "m1" [ZVar "A"; ZVar "C"; ZVar "B"; ZVar "D"]; + T_arg "m2" [ZVar "A"; ZVar "C"; ZVar "B"; ZVar "D"]]. -Goal forall (m1 m2 : list (list R)), - consistent m1 (64,(64,tt)) -> - consistent m2 (64,(64,tt)) -> - matmul_tiled 64 64 64 m1 m2 4%Z = matmul 64 64 64 m1 m2. -Proof. - let ast := R in idtac. -Abort. +Definition add_precond := + fun A B C D (_ _ : dim_n 4) => (0 < A /\ 0 < B /\ 0 < C /\ 0 < D)%Z. -Goal forall (m1 m2 : list (list R)), - consistent m1 (50,(70,tt)) -> - consistent m2 (70,(30,tt)) -> - matmul_tiled_split 50 70 30 m1 m2 4%Z = matmul 50 70 30 m1 m2. -Proof. - let ast := R in idtac. -Abort. - -Goal forall (c : (list R)) (n m : Z), - (0 < n)%Z -> - (-m+1 < n)%Z -> - consistent c (Z.to_nat n,tt) -> - conv4 c n m = conv1 c n m. -Proof. - let ast := R in idtac. -Abort. - -Goal forall (c : (list R)) (n m : Z), - (0 < n)%Z -> - (-m+1 < n)%Z -> - consistent c (Z.to_nat n,tt) -> - conv1 c n m = conv4 c n m. +Derive add_string in + (stringy_spec_of [tZ; tZ; tZ; tZ; tensor_n 4; tensor_n 4] 4 add_args add_string add_precond add) + as add_string_correct. +Proof. cbv [add_precond add]. prove_stringy_spec. Qed. + +Axiom f : False. +Derive add_split_string in + (stringy_spec_of [tZ; tZ; tZ; tZ; tensor_n 4; tensor_n 4] 4 add_args add_split_string add_precond add_split) + as add_spilt_string_correct. Proof. - let ast := R in idtac. -Abort. - -Goal forall n m (l : list (list R)), - consistent l (n,(m,tt)) -> - transpose ( - (GEN [ j < 1 ] - GEN [ i < Z.of_nat n ] - l _[i;j]) - <++> - (GEN [ 1 <= j < Z.of_nat m ] - (GEN [ i < 1 ] - l _[i;j]) - <++> - (GEN [ 1 <= i < Z.of_nat n - 1] - l _[i;j]) - <++> - (GEN [ Z.of_nat n - 1 <= i < Z.of_nat n ] - l _[i;j]) - ) - ) - = @nil _. + cbv [add_precond add_split]. prove_stringy_spec. + all: destruct (f : False). (*arithmetic, seems true*) +Qed. + +Definition matmul_args := + [Z_arg "A"; + Z_arg "B"; + Z_arg "C"; + T_arg "m1" [ZVar "A"; ZVar "B"]; + T_arg "m2" [ZVar "B"; ZVar "C"]]. + +Definition matmul_precond := + fun A B C (_ _ : dim_n 2) => (0 < A /\ 0 < B /\ 0 < C)%Z. + +Derive matmul_string in + (stringy_spec_of [tZ; tZ; tZ; tensor_n 2; tensor_n 2] 2 matmul_args matmul_string matmul_precond matmul) + as matmul_string_correct. +Proof. cbv [matmul matmul_precond]. prove_stringy_spec. Qed. + +Definition matmul_args1 := + [T_arg "m1" [ZLit 64; ZLit 64]; + T_arg "m2" [ZLit 64; ZLit 64]]. + +Derive matmul_tiled64_string in + (stringy_spec_of [tensor_n 2; tensor_n 2] 2 matmul_args1 matmul_tiled64_string (fun _ _ => True) (fun m1 m2 => matmul_tiled 64 64 64 m1 m2 4)) + as matmul_tiled64_string_correct. +Proof. cbv [matmul_tiled]. prove_stringy_spec. Qed. + +Derive matmul_tiled_split64_string in + (stringy_spec_of [tensor_n 2; tensor_n 2] 2 matmul_args1 matmul_tiled_split64_string (fun _ _ => True) (fun m1 m2 => matmul_tiled_split 64 64 64 m1 m2 4)) + as matmul_tiled_split64_string_correct. +Proof. cbv [matmul_tiled_split]. prove_stringy_spec. Qed. + +Derive string_matmul_tiled_split in + (stringy_spec_of [tensor_n 2; tensor_n 2] 2 matmul_args1 string_matmul_tiled_split (fun _ _ => True) (fun m1 m2 => matmul_tiled_split 64 64 64 m1 m2 4)) + as string_matmul_tiled_split_correct. +Proof. cbv [matmul_tiled_split]. prove_stringy_spec. Qed. + +Definition conv_args := + [Z_arg "n"; + Z_arg "m"; + T_arg "c" [ZVar "n"]]. + +Definition conv_precond := + fun n m (_ : dim_n 1) => (0 < n /\ -m + 1 < n /\ 0 < m)%Z. + +Derive conv4_string in + (stringy_spec_of [tZ; tZ; tensor_n 1] 1 conv_args conv4_string conv_precond (fun n m c => conv4 c n m)) + as conv4_string_correct. +Proof. cbv [conv4 conv_precond]. prove_stringy_spec. Qed. + +Derive conv1_string in + (stringy_spec_of [tZ; tZ; tensor_n 1] 1 conv_args conv1_string conv_precond (fun n m c => conv1 c n m)) + as conv1_string_correct. +Proof. cbv [conv1 conv_precond]. prove_stringy_spec. Qed. + +Definition concat_test_args := + [Z_arg "n"; + Z_arg "m"; + T_arg "l" [ZVar "n"; ZVar "m"]]. + +Definition concat_test1_precond := + fun n m (_ : dim_n 2) => (2 < n /\ 1 < m)%Z. + +Derive concat_test1_string in + (let shallow_prog := + fun n m l => + transpose ( + (GEN [ j < 1 ] + GEN [ i < n ] + l _[i;j]) + <++> + (GEN [ 1 <= j < m ] + (GEN [ i < 1 ] + l _[i;j]) + <++> + (GEN [ 1 <= i < n - 1] + l _[i;j]) + <++> + (GEN [ n - 1 <= i < n ] + l _[i;j]) + )) in + stringy_spec_of [tZ; tZ; tensor_n 2] 2 concat_test_args concat_test1_string concat_test1_precond shallow_prog) + as concat_test1_string_correct. Proof. - let ast := R in idtac. -Abort. - -Goal forall n m (l : list (list R)), - consistent l (n,(m,tt)) -> - transpose ( - (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]) - ) - = @nil _. + intro shallow_prog. subst shallow_prog. + cbv [concat_test1_precond]. prove_stringy_spec. +Qed. + +Definition concat_test0_precond := + fun n m (_ : dim_n 2) => (0 < n /\ 1 < m)%Z. + +Derive concat_test0_string in + (let shallow_prog := + fun n m l => + transpose ( + (GEN [ j < 1 ] + GEN [ i < n ] + l _[i;j]) + <++> + (GEN [ 1 <= j < m ] + GEN [ i < n ] + l _[i;j])) in + stringy_spec_of [tZ; tZ; tensor_n 2] 2 concat_test_args concat_test0_string concat_test0_precond shallow_prog) + as concat_test0_string_correct. Proof. - let ast := R in idtac. -Abort. - -Goal forall n m (v : list (list R)), - 0 < n -> - 0 < m -> - consistent v (n,(m,tt)) -> - transpose ( - (GEN [ j < 1 ] - (GEN [ i < 1 ] + intro shallow_prog. subst shallow_prog. + cbv [concat_test0_precond]. prove_stringy_spec. +Qed. + +Definition concat_test2_precond := + fun n m (_ : dim_n 2) => (1 < n /\ 1 < m)%Z. + +Derive concat_test2_string in + (let shallow_prog := + fun n m v => + transpose ( + (GEN [ j < 1 ] + (GEN [ i < 1 ] v _[i;j]) - <++> - (GEN [ 1 <= i < Z.of_nat n ] - v _[i;j]) - ) - <++> - (GEN [ 1 <= j < Z.of_nat m ] - GEN [ i < Z.of_nat n ] - v _[i;j] - ) - ) - = @nil _. -Proof. - let ast := R in idtac. -Abort. - -Goal forall n m (l : list (list R)), - consistent l (n,(m,tt)) -> - transpose ( - GEN [ j < Z.of_nat m ] - (GEN [ i < 1 ] - l _[i;j]) - <++> - (GEN [ 1 <= i < Z.of_nat n ] - l _[i;j])) - = @nil _. -Proof. - let ast := R in idtac. -Abort. - -Goal forall n m (l : (list R)), - consistent l (n*m,tt) -> - Common.flatten ( - Common.transpose - ( - (GEN [ i < 1 ] - (GEN [ j < Z.of_nat n ] - l _[j * Z.of_nat m + i])) <++> - (GEN [ 1 <= i < Z.of_nat m ] - (GEN [ j < Z.of_nat n ] - l _[j * Z.of_nat m + i])) - )) - - = @nil _. -Proof. - let ast := R in idtac. -Abort. - -Goal forall N M (v : list (list R)), - 0 < N -> - 0 < M -> - consistent v (N,(M,tt)) -> - blurimmediate v M N = blurtwostage N M v. -Proof. - let ast := R in idtac. -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 idtac. -Abort. - -Goal forall n m (l : list (list R)), - 0 < n -> - 0 < m -> - consistent l (n,(m,tt)) -> - blur_tiles_guarded l n m 4 4 - = @nil _. + (GEN [ 1 <= i < n ] + v _[i;j])) + <++> + (GEN [ 1 <= j < m ] + GEN [ i < n ] + v _[i;j])) in + stringy_spec_of [tZ; tZ; tensor_n 2] 2 concat_test_args concat_test2_string concat_test2_precond shallow_prog) + as concat_test2_string_string_correct. Proof. - intros. autounfold with examples. - - let ast := R in idtac. -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 idtac. -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 -> - gather W x w = @nil _. + intro shallow_prog. subst shallow_prog. + cbv [concat_test2_precond]. prove_stringy_spec. +Qed. + +Definition concat_test3_precond := + fun n m (_ : dim_n 2) => (1 < n /\ 0 < m)%Z. + +Derive concat_test3_string in + (let shallow_prog := + fun n m l => + transpose ( + GEN [ j < m ] + (GEN [ i < 1 ] + l _[i;j]) + <++> + (GEN [ 1 <= i < n ] + l _[i;j])) in + stringy_spec_of [tZ; tZ; tensor_n 2] 2 concat_test_args concat_test3_string concat_test3_precond shallow_prog) + as concat_test3_string_correct. Proof. - let ast := R in idtac. -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 -> - scatter W x w = @nil _. + intro shallow_prog. subst shallow_prog. + cbv [concat_test3_precond]. prove_stringy_spec. +Qed. + +Definition concat_test4_precond := + fun n m (_ : dim_n 1) => (0 < n /\ 1 < m)%Z. + +Definition concat_test4_args := + [Z_arg "n"; + Z_arg "m"; + T_arg "l" [! "m" ! * ! "n" !]%z]. + +Derive concat_test4_string in + (let shallow_prog := + fun n m l => + Common.flatten ( + Common.transpose + ( + (GEN [ i < 1 ] + (GEN [ j < n ] + l _[j * m + i])) + <++> + (GEN [ 1 <= i < m ] + (GEN [ j < n ] + l _[j * m + i])))) in + stringy_spec_of [tZ; tZ; tensor_n 1] 1 concat_test4_args concat_test4_string concat_test4_precond shallow_prog) + as concat_test4_string_correct. Proof. - let ast := R in idtac. -Abort. - -Goal forall A B K W RR (w : list (list R)) (x : list R), - (0 < K)%Z -> - (0 < W)%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. + intro shallow_prog. subst shallow_prog. + cbv [concat_test4_precond]. prove_stringy_spec. + { rewrite Z2Nat.id by lia. (*probably true*) destruct (f : False). } + { rewrite Z2Nat.id by lia. (*probably true*) destruct (f : False). } +Qed. + +Definition blur_args := + [Z_arg "N"; + Z_arg "M"; + T_arg "v" [ZVar "N"; ZVar "M"]]. + +Definition blur_precond := + fun N M (_ : dim_n 2) => (0 < M /\ 0 < N)%Z. + +Derive blurimmediate_string in + (stringy_spec_of [tZ; tZ; tensor_n 2] 2 blur_args blurimmediate_string blur_precond blurimmediate) + as blurimmediate_string_correct. +Proof. cbv [blurimmediate blur_precond]. prove_stringy_spec. Qed. + +Derive blurtwostage_string in + (stringy_spec_of [tZ; tZ; tensor_n 2] 2 blur_args blurtwostage_string blur_precond blurtwostage) + as blurtwostage_string_correct. +Proof. cbv [blurtwostage blur_precond]. prove_stringy_spec. Qed. + +Definition blur_precond' := + fun N M (_ : dim_n 2) => (2 < N /\ 2 < M)%Z. + +Derive blur_tiles_guarded4_string in + (stringy_spec_of [tZ; tZ; tensor_n 2] 2 blur_args blur_tiles_guarded4_string blur_precond' (blur_tiles_guarded 4 4)) + as blur_tiles_guarded4_string_correct. Proof. - let ast := R in idtac. -Abort. - -Goal forall A B K W RR (w : list (list R)) (x : list R), - (0 < K)%Z -> - (0 < W)%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. + cbv [blur_tiles_guarded blur_precond']. prove_stringy_spec. + all: destruct (f : False). +Qed. + +Definition args5 := + [T_arg "l" [ZLit 100; ZLit 100]]. + +Derive string_prog in + (stringy_spec_of [tensor_n 2] 2 args5 string_prog (fun _ => True) (fun l => tlet y := l in y)) + as string_prog_correct. +Proof. Fail first [prove_stringy_spec | fail]. (*TODO is this supposed to work?*) Abort. + +Definition fusion_args := + [Z_arg "n"; + Z_arg "m"; + T_arg "v" [ZVar "n"; ZVar "m"]]. + +Definition fusion_precond := + fun n m (_ : dim_n 2) => (2 < n /\ 2 < m)%Z. + +Derive fusion_no_boundary_string in + (stringy_spec_of [tZ; tZ; tensor_n 2] 2 fusion_args fusion_no_boundary_string fusion_precond fusion_no_boundary) + as fusion_no_boundary_string_correct. +Proof. cbv [fusion_no_boundary fusion_precond]. prove_stringy_spec. Qed. + +Definition gather_args := + [Z_arg "W"; + Z_arg "RR"; + T_arg "x" [ZVar "RR"]; + T_arg "w" [ZVar "RR"]]. + +Definition gather_precond := + fun W R0 (_ _ : dim_n 1) => (Z.of_nat (Z.to_nat R0) < W)%Z. + +Derive gather_string in + (stringy_spec_of [tZ; tZ; tensor_n 1; tensor_n 1] 1 gather_args gather_string gather_precond (fun W R0 => gather W)) + as gather_string_correct. Proof. - let ast := R in idtac. -Abort. - -Goal forall n m (v : list (list R)), - 2 < n -> - 2 < m -> - consistent v (n,(m,tt)) -> - blurimmediate_partition n m v = @nil _. + cbv [gather gather_precond]. prove_stringy_spec. +(*idk what these parameters are supposed to represent, *) +(* so idk how to fix this*) + all: destruct f. +Qed. + +Definition scatter_args := gather_args. +Definition scatter_precond := gather_precond. + +Derive scatter_string in + (stringy_spec_of [tZ; tZ; tensor_n 1; tensor_n 1] 1 scatter_args scatter_string scatter_precond (fun W R0 => scatter W)) + as scatter_string_correct. Proof. - let ast := R in idtac. -Abort. - -Goal forall n m (v : list (list R)), - 2 < n -> - 2 < m -> - consistent v (n,(m,tt)) -> - blurimmediate_isolate n m v = @nil _. + cbv [scatter scatter_precond gather_precond]. prove_stringy_spec. + (*similar to gather, i do not understand why this fails*) + all: destruct f. +Qed. + +Definition im2col_args := + [Z_arg "A"; + Z_arg "B"; + Z_arg "K"; + Z_arg "W"; + Z_arg "RR"; + T_arg "w" [ZVar "A"; ZVar "B"]; + T_arg "x" [ZVar "K"]]. + +Definition im2col_precond := + fun (A B : Z) K W RR (_ : dim_n 2) (_ : dim_n 1) => (0 < K /\ 0 < W /\ 0 < RR)%Z. + +Derive im2colminilifted_string in + (stringy_spec_of [tZ; tZ; tZ; tZ; tZ; tensor_n 2; tensor_n 1] 2 im2col_args im2colminilifted_string im2col_precond (fun A B => im2colminilifted)) + as im2colminilifted_string_correct. Proof. - let ast := R in idtac. -Abort. - -Goal forall N M (v : list (list R)), - 2 < N -> - 2 < M -> - consistent v (N,(M,tt)) -> - blurtwostage_partition N M v = @nil _. + cbv [im2colminilifted im2col_precond]. prove_stringy_spec. + (*again i do not understand the spec of this function (what is going on with A and B??), so not sure how to make these true*) + all: destruct f. +Qed. + +Derive im2colmini_string in + (stringy_spec_of [tZ; tZ; tZ; tZ; tZ; tensor_n 2; tensor_n 1] 2 im2col_args im2colmini_string im2col_precond (fun A B => im2colmini)) + as im2colmini_string_correct. Proof. - let ast := R in idtac. -Abort. + cbv [im2colmini im2col_precond]. prove_stringy_spec. + (*again, not sure why this is false*) + all: destruct f. +Qed. + +Derive blurimmediate_partition_string in + (stringy_spec_of [tZ; tZ; tensor_n 2] 2 blur_args blurimmediate_partition_string blur_precond' blurimmediate_partition) + as blurimmediate_partition_string_correct. +Proof. cbv [blurimmediate_partition blur_precond']. prove_stringy_spec. Qed. + +Derive blurimmediate_isolate_string in + (stringy_spec_of [tZ; tZ; tensor_n 2] 2 blur_args blurimmediate_isolate_string blur_precond' blurimmediate_isolate) + as blurimmediate_isolate_string_correct. +Proof. cbv [blurimmediate_isolate blur_precond']. prove_stringy_spec. Qed. + +Derive blurtwostage_partition_string in + (stringy_spec_of [tZ; tZ; tensor_n 2] 2 blur_args blurtwostage_partition_string blur_precond' blurtwostage_partition) + as blurtwostage_partition_string_correct. +Proof. cbv [blurtwostage_partition blur_precond']. prove_stringy_spec. Qed. diff --git a/src/verified_lowering/inferpad/TensorToResult.v b/src/verified_lowering/inferpad/TensorToResult.v new file mode 100644 index 0000000..b1f07b0 --- /dev/null +++ b/src/verified_lowering/inferpad/TensorToResult.v @@ -0,0 +1,1009 @@ +From Stdlib Require Import Arith.Arith. +From Stdlib Require Import Reals.Reals. +From Stdlib Require Import ZArith.Int. +From Stdlib Require Import ZArith.Znat. +From Stdlib Require Import Strings.String. +From Stdlib Require Import Logic.FunctionalExtensionality. +From Stdlib Require Import Lists.List. +From Stdlib Require Import micromega.Lia. +From Stdlib Require Import QArith. +From Stdlib Require Import String. + +Import ListNotations. + +From ATL Require Import Common Map Sets FrapWithoutSets Div Tactics ATL. +From Lower Require Import Zexpr Bexpr Array Range Sexpr ListMisc + VarGeneration Constant ATLDeep Result. +Notation S := Datatypes.S. + +Ltac specialize' H := + let hyp := fresh "hyp" in + eassert _ as hyp; + [clear H|specialize (H hyp); clear hyp]. + +Ltac epose_dep H := + repeat lazymatch type of H with + | ?A -> ?B => fail + | forall _, _ => epose proof (H _) as H + end. + +Local Set Default Goal Selector "!". + +Open Scope list_scope. +Open Scope nat_scope. + +Fixpoint dim_n n := + match n with + | O => R + | S n' => list (dim_n n') + end. + +Definition R_of_scalar s := + match s with + | Result.SS x => x + | Result.SX => 0%R + end. + +Fixpoint tensor_of_result {n} (r : result) : dim_n n := + match n, r return dim_n n with + | S n', Result.V rs => + map tensor_of_result rs + | O, Result.S s => + R_of_scalar s + | O, _ => 0%R (*garbage*) + | S _, _ => [] (*garbage*) + end. + +Fixpoint dim_n_TensorElem n : TensorElem (dim_n n) := + match n return TensorElem (dim_n n) with + | S n => TensorTensorElem + | O => RTensorElem + end. +Existing Instance dim_n_TensorElem. + +Fixpoint tuple_of_list {n} (sh : list nat) : (@shape (dim_n n) _) := + match n, sh return (@shape (dim_n n) _) with + | S n', len :: sh' => (len, tuple_of_list sh') + | O, [] => tt + | S _, _ => (O, tuple_of_list sh) (*garbage*) + | O, _ => tt (*garbage*) + end. + +Fixpoint Forall' {X} (P : X -> Prop) l := + match l with + | a :: l' => P a /\ Forall' P l' + | [] => True + end. + +Lemma Forall_Forall' {X} (P : X -> _) l : + Forall' P l <-> + Forall P l. +Proof. + split. + - induction l; simpl in *; intros; invs'; eauto. + - induction 1; simpl; eauto. +Qed. + +Fixpoint tensor_has_size' sh {n} (x : dim_n n) {struct n} := + match n return dim_n n -> _ with + | S n' => fun x => + match sh with + | [] => False + | len :: sh' => + length x = len /\ Forall' (tensor_has_size' sh') x + end + | O => fun _ => sh = [] + end x. + +Lemma tensor_of_result_size n sh r : + n = length sh -> + result_has_shape' sh r -> + tensor_has_size' (n := n) sh (tensor_of_result r). +Proof. + intros ?. subst. revert sh. induction r; intros sh Hsh. + - invert Hsh. simpl. reflexivity. + - invert Hsh. simpl. rewrite length_map. split; [reflexivity|]. + rewrite Forall_Forall'. apply Forall_map. rewrite Forall_forall in *. eauto. +Qed. + +Lemma tensor_has_size_mul {n} sz x (v : dim_n n) : + tensor_has_size' sz v -> + tensor_has_size' sz (scalar_mul x v). +Proof. + revert sz. induction n; intros sz. + - simpl. auto. + - simpl. destruct sz; try contradiction. intros H; invs'; subst; simpl; auto. + rewrite length_map. split; [reflexivity|]. + rewrite Forall_Forall' in *. apply Forall_map. eapply Forall_impl; eauto. +Qed. + +Lemma consistent_of_tensor_has_size' n sh (x : dim_n n) : + tensor_has_size' sh x -> + ~In 0 sh -> + consistent x (tuple_of_list sh). +Proof. + revert x sh. induction n; simpl; auto. + intros x sh. destruct sh; [contradiction|]. intros [H1 H2] H3. subst. destruct x. + { exfalso. simpl in *. auto. } + invert H2. simpl in *. constructor. + - auto. + - rewrite Forall_Forall' in *. eapply Forall_impl; [|eassumption]. auto. + - reflexivity. +Qed. + +Lemma tensor_has_size'_dim n sh (x : dim_n n) : + tensor_has_size' sh x -> + ~In 0 sh -> + n = length sh. +Proof. + revert x sh. induction n; simpl. + - intros. subst. reflexivity. + - intros x sh H1 H2. destruct sh; [contradiction|]. + destruct H1 as [H1 H3]. + simpl. f_equal. simpl in *. subst. destruct x. + { exfalso. simpl in *. auto. } + invert H3. eauto. +Qed. + +Lemma map_seq a b : + seq a b = map (plus a) (seq 0 b). +Proof. + revert a. induction b; simpl; auto. + intros. f_equal; [lia|]. + rewrite IHb. symmetry. rewrite IHb. + rewrite map_map. apply map_ext. lia. +Qed. + +Lemma map_nth_seq {X} (x : X) (l : list X) : + l = map (nth_default x l) (seq O (length l)). +Proof. + induction l; [reflexivity|]. + simpl. f_equal. rewrite map_seq, map_map. erewrite map_ext; [eassumption|]. + simpl. reflexivity. +Qed. + +Lemma get_out_of_bounds {X} `{TensorElem X} (x : list X) i : + ~ (0 <= i < Z.of_nat (length x))%Z -> + get x i = null \/ (exists x0, In x0 x /\ get x i = scalar_mul 0 x0). +Proof. + intros H'. cbv [get]. destruct x; [auto|]. right. + destruct i; simpl in *; try lia. 2: eauto. + destruct (nth_error _ _) eqn:E. 2: eauto. apply nth_error_Some in E. + simpl in *. lia. +Qed. + +Lemma get_out_of_bounds_id {X} `{TensorElem X} (x : list X) i n sh y : + consistent x (n, sh) -> + consistent y sh -> + ~ (0 <= i < Z.of_nat (length x))%Z -> + y <+> scalar_mul 0 (get x i) = y. +Proof. + intros Hx Hy H'. apply get_out_of_bounds in H'. destruct H' as [H'|H']. + - intros. rewrite H'. rewrite mul_0_null. apply H. + - intros. destruct H' as (?&H'p1&H'p2). rewrite H'p2. + rewrite bin_comm. eapply bin_mul_0_id; eauto. + apply tensor_consistent_forall_consistent in Hx. + rewrite Forall_forall in Hx. apply consistent_mul. auto. +Qed. + +Lemma sum_helper_is_fold_right_map {X} `{TensorElem X} n x (f : _ -> X) : + sum_helper n x f = fold_right bin null (map f (map (fun y => (x + Z.of_nat y)%Z) (seq 0 n))). +Proof. + revert x f. induction n; intros x f; simpl. + - reflexivity. + - replace (x + 0)%Z with x by lia. f_equal. rewrite IHn. f_equal. + rewrite <- seq_shift. do 3 rewrite map_map. + apply map_ext. intros. f_equal. lia. +Qed. + +Lemma sumr_is_fold_right_map {X} `{TensorElem X} min max (f : _ -> X) : + sumr min max f = fold_right bin null (map f (zrange min max)). +Proof. + cbv [sumr]. rewrite sum_helper_is_fold_right_map. + rewrite zrange_seq. reflexivity. +Qed. + +Lemma zrange_is_cons min max : + (min < max)%Z -> + zrange min max = min :: zrange (min + 1) max. +Proof. + intros H. do 2 rewrite zrange_seq. + replace (Z.to_nat (max - min)) with (S (Z.to_nat (max - (min + 1)))) by lia. + simpl. f_equal. + - lia. + - rewrite map_seq. rewrite map_map. apply map_ext. intros. lia. +Qed. + +Lemma fold_right_bin_fold_left {X} `{TensorElem X} x ys : + fold_right bin x ys = fold_left bin ys x. +Proof. + symmetry. apply fold_symmetric. + - apply H. + - apply H. +Qed. + +Lemma sumr_is_fold_right_map_zero {X} `{TensorElem X} sh min max (f : _ -> X) : + (forall i, (min <= i < max)%Z -> consistent (f i) sh) -> + (min < max)%Z -> + sumr min max f = fold_right bin (scalar_mul 0 (f min)) (map f (zrange min max)). +Proof. + intros H1 H2. rewrite sumr_is_fold_right_map. + do 2 rewrite fold_right_bin_fold_left. + rewrite zrange_is_cons by lia. + simpl. f_equal. + rewrite bin_null_id_l. + erewrite bin_mul_0_id; eauto. + - apply H1. lia. + - apply H1. lia. +Qed. + +Lemma gen_helper_is_map {X} `{TensorElem X} n x f : + gen_helper n x f = map f (map (fun y => x + Z.of_nat y)%Z (seq O n)). +Proof. + revert f x. + induction n; intros f x; simpl; try reflexivity. f_equal. + - f_equal. lia. + - rewrite IHn. do 2 rewrite map_map. rewrite <- seq_shift. rewrite map_map. + apply map_ext. intros. f_equal. lia. +Qed. + +Lemma genr_is_map {X} `{TensorElem X} min max f : + genr min max f = map f (zrange min max). +Proof. + cbv [genr]. rewrite gen_helper_is_map. rewrite zrange_seq. reflexivity. +Qed. + +Lemma nth_error_is_get {X} `{TensorElem X} (v : list X) i : + (0 <= i < Z.of_nat (length v))%Z -> + nth_error v (Z.to_nat i) = Some (get v i). +Proof. + intros H'. cbv [get]. destruct v; simpl in *; [lia|]. + destruct i; simpl in *; try lia. + - reflexivity. + - destruct (nth_error _ _) eqn:E; [reflexivity|]. + apply nth_error_None in E. simpl in *. lia. +Qed. + +Lemma concat_is_app {X} `{TensorElem X} n m sh (x y : list X) : + consistent x (n, sh) -> + consistent y (m, sh) -> + x <++> y = x ++ y. +Proof. + intros Hx Hy. cbv [concat]. cbv [gen]. rewrite genr_is_map. rewrite zrange_seq. + rewrite map_map. replace (Z.to_nat _) with (length x + length y) by lia. + rewrite seq_app. rewrite map_app. f_equal. + - remember (map _ _). rewrite (map_nth_seq null x). subst. + apply map_ext_in. intros i Hi. apply in_seq in Hi. + eassert (_ < _)%Z as H'. 2: apply Z.ltb_lt in H'; rewrite H'. 1: lia. + clear H'. + eassert (_ < _)%Z as H'. 2: apply Z.leb_gt in H'; rewrite H'. 1: lia. + clear H'. + simpl. cbv [iverson]. rewrite mul_1_id. + erewrite get_out_of_bounds_id; eauto; cycle 1. + + apply tensor_consistent_forall_consistent in Hx. rewrite Forall_forall in Hx. + pose proof nth_error_is_get as H''. + specialize (H'' x (Z.of_nat i) ltac:(lia)). apply nth_error_In in H''. + apply Hx. assumption. + + lia. + + cbv [nth_default]. replace i with (Z.to_nat (Z.of_nat i)) by lia. + erewrite nth_error_is_get by lia. f_equal. lia. + - remember (map _ _). rewrite (map_nth_seq null y). subst. + rewrite (map_seq (_ + _)), map_map. + apply map_ext_in. intros i Hi. apply in_seq in Hi. + eassert (_ <= _)%Z as H'. 2: apply Z.leb_le in H'; rewrite H'. 1: lia. + clear H'. + eassert (_ <= _)%Z as H'. 2: apply Z.ltb_ge in H'; rewrite H'. 1: lia. + clear H'. + simpl. cbv [iverson]. rewrite mul_1_id. + rewrite bin_comm. erewrite get_out_of_bounds_id; eauto; cycle 1. + + apply tensor_consistent_forall_consistent in Hy. rewrite Forall_forall in Hy. + pose proof nth_error_is_get as H''. + specialize (H'' y (Z.of_nat i) ltac:(lia)). apply nth_error_In in H''. + apply Hy. eassert ((_ - _)%Z = _) as ->; [|eassumption]. lia. + + lia. + + cbv [nth_default]. replace i with (Z.to_nat (Z.of_nat i)) by lia. + erewrite nth_error_is_get by lia. f_equal. lia. +Qed. + +Lemma split_seq a b c : + c < b -> + seq a b = seq a c ++ seq (a + c) (b - c). +Proof. + revert a c. induction b; intros a c H; simpl. + - lia. + - destruct c. + + simpl. replace (a + 0) with a by lia. reflexivity. + + simpl. f_equal. erewrite IHb. + -- f_equal. f_equal. lia. + -- lia. +Qed. + +Lemma split_zrange min mid max : + (min <= mid < max)%Z -> + zrange min max = zrange min mid ++ zrange mid max. +Proof. + intros H. do 3 rewrite zrange_seq. + rewrite (split_seq 0 (Z.to_nat (max - min)) (Z.to_nat (mid - min))) by lia. + rewrite map_app. f_equal. + rewrite (map_seq (0 + _)). rewrite map_map. + replace (_ - _)%nat with (Z.to_nat (max - mid)) by lia. + apply map_ext. intros. lia. +Qed. + +Lemma fold_right_id {A B} (x : B) (ys : list A) f : + Forall (fun y => f y x = x) ys -> + fold_right f x ys = x. +Proof. + induction 1; simpl. + - reflexivity. + - rewrite IHForall. assumption. +Qed. + +Lemma nth_error_concat {A} (l : list (list A)) n i : + Forall (fun x => length x = n) l -> + nth_error (List.concat l) i = + match nth_error l (i / n) with + | Some l' => nth_error l' (i mod n) + | None => None + end. +Proof. + destruct n. + { intros. + destruct (nth_error _ _) eqn:E1. + - apply nth_error_In in E1. apply in_concat in E1. + destruct E1 as (l'&H1&H2). rewrite Forall_forall in H. + apply H in H1. destruct l'; try discriminate. contradiction. + - destruct (nth_error _ (_ / _)) eqn:E2; [|reflexivity]. + apply nth_error_In in E2. rewrite Forall_forall in H. + apply H in E2. destruct l0; try discriminate. rewrite nth_error_nil. + reflexivity. } + intros H. revert i. induction H; intros i. + - simpl. do 2 rewrite nth_error_nil. reflexivity. + - cbn [nth_error List.concat]. rewrite <- H in *. + assert (i < length x \/ length x <= i) as [Hn|Hn] by lia. + + rewrite nth_error_app1 by lia. rewrite Nat.div_small by lia. + rewrite Nat.mod_small by lia. reflexivity. + + rewrite nth_error_app2 by lia. rewrite IHForall. + remember (_ - _). + replace i with ((i - length x) + 1 * length x) by lia. + rewrite Nat.div_add by lia. + rewrite Nat.Div0.mod_add by lia. + rewrite Nat.add_1_r. + simpl. subst. reflexivity. +Qed. + +Lemma flatten_is_concat {X} `{TensorElem X} sh (x : list (list X)) : + consistent x sh -> + Common.flatten x = List.concat x. +Proof. + destruct sh as [n [m sh] ]. + intros Hx. cbv [Common.flatten]. cbv [gen]. rewrite genr_is_map. + rewrite (map_nth_seq null (List.concat _)). rewrite zrange_seq. + invert Hx. invert H2. + cbn [length]. rewrite get_0_cons. cbn [length]. + remember ((x :: xs0) :: xs) as l eqn:El. + replace (Z.to_nat _) with (S (length xs) * S (length xs0)) by lia. + assert (length (List.concat l) = S (length xs) * S (length xs0)) as Hlen. + { erewrite length_concat. + 2: { subst. constructor; auto. eapply Forall_impl; [|eassumption]. + simpl. intros a Ha. invert Ha. assumption. } + subst. simpl. lia. } + rewrite Hlen. + rewrite map_map. apply map_ext_in. + intros i Hi. apply in_seq in Hi. cbv [nth_default]. + destruct (nth_error _ _) eqn:E. + 2: { apply nth_error_None in E. lia. } + cbv [sum]. erewrite sumr_is_fold_right_map_zero; try lia. + 2: { intros. apply consistent_sumr. 1: lia. + intros. apply consistent_iverson. + eapply consistent_get. eapply consistent_get. subst. constructor; eauto. + constructor; eauto. } + rewrite split_zrange with (mid := (Z.of_nat i / Z.of_nat (length (x :: xs0)))%Z). + 2: { split. + - apply Zdiv.Z_div_nonneg_nonneg; lia. + - cbn [length]. apply Zdiv.Zdiv_lt_upper_bound; lia. } + rewrite map_app. rewrite fold_right_bin_fold_left. rewrite fold_left_app. + do 2 rewrite <- fold_right_bin_fold_left. + rewrite fold_right_id with (x := scalar_mul 0 _); cycle 1. + { apply Forall_map. rewrite zrange_seq. apply Forall_map. + apply Forall_forall. intros j Hj. apply in_seq in Hj. + erewrite sumr_is_fold_right_map_zero; try lia. + 2: { intros. apply consistent_iverson. eapply consistent_get. eapply consistent_get. + subst. constructor; eauto. constructor; eauto. } + rewrite fold_right_id; cycle 1. + { apply Forall_map. rewrite zrange_seq. apply Forall_map. + apply Forall_forall. intros k Hk. apply in_seq in Hk. + replace (_ =? _)%Z with false; cycle 1. + { symmetry. apply Z.eqb_neq. cbn [length] in *. Fail lia. + match goal with + | |- ?a <> ?b => enough (b < a)%Z by lia + end. + repeat rewrite Nat.add_0_l in *. repeat rewrite Z.add_0_l in *. + remember ((length xs)) as l1. + remember (length xs0) as l2. + assert (Z.of_nat j < Z.of_nat i / Z.of_nat (S l2))%Z as Hj' by lia. + apply floor_div_mono_upper in Hj'; lia. } + unfold iverson at 1. eapply bin_mul_0_id. + - eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - apply consistent_mul. apply consistent_iverson. + eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - reflexivity. } + eapply bin_mul_0_id. + - apply consistent_iverson. eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - apply consistent_mul. apply consistent_sumr. 1: lia. + intros. apply consistent_iverson. + eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - reflexivity. } + rewrite zrange_is_cons; cycle 1. + { assert (i < S (length xs0) * S (length xs)) as Hi' by lia. + apply Nat.Div0.div_lt_upper_bound in Hi'. cbn [length]. + rewrite <- Nat2Z.inj_div. lia. } + cbn [map fold_right]. rewrite fold_right_id; cycle 1. + { apply Forall_map. rewrite zrange_seq. apply Forall_map. + apply Forall_forall. intros j Hj. apply in_seq in Hj. + erewrite sumr_is_fold_right_map_zero; try lia. + 2: { intros. apply consistent_iverson. eapply consistent_get. eapply consistent_get. + subst. constructor; eauto. constructor; eauto. } + rewrite fold_right_id; cycle 1. + { apply Forall_map. rewrite zrange_seq. apply Forall_map. + apply Forall_forall. intros k Hk. apply in_seq in Hk. + replace (_ =? _)%Z with false; cycle 1. + { symmetry. apply Z.eqb_neq. cbn [length] in *. Fail lia. + match goal with + | |- ?a <> ?b => enough (a < b)%Z by lia + end. + repeat rewrite Nat.add_0_l in *. repeat rewrite Z.add_0_l in *. + remember ((length xs)) as l1. + remember (length xs0) as l2. + do 2 rewrite Z.mul_add_distr_r. + rewrite Z.mul_1_l. rewrite <- Nat2Z.inj_div. + enough (i < i / S l2 * S l2 + S l2) by lia. clear. + remember (_ + _). + rewrite (Nat.div_mod_eq i (S l2)). + subst. + enough (i mod S l2 < S l2) by lia. + apply Nat.mod_upper_bound. lia. } + unfold iverson at 1. eapply bin_mul_0_id. + - eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - apply consistent_mul. apply consistent_iverson. + eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - reflexivity. } + eapply bin_mul_0_id. + - apply consistent_iverson. eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - apply consistent_mul. apply consistent_sumr. 1: lia. + intros. apply consistent_iverson. + eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - reflexivity. } + erewrite sumr_is_fold_right_map_zero; try lia. + 2: { intros. apply consistent_iverson. eapply consistent_get. eapply consistent_get. + subst. constructor; eauto. constructor; eauto. } + rewrite split_zrange with (mid := (Z.of_nat i mod Z.of_nat (length (x :: xs0)))%Z). + 2: { split. + - apply mod_nonneg. simpl. lia. + - apply Z.mod_pos_bound. lia. } + rewrite map_app. rewrite fold_right_bin_fold_left. rewrite fold_left_app. + do 2 rewrite <- fold_right_bin_fold_left. + rewrite fold_right_id with (x := scalar_mul 0 _); cycle 1. + { apply Forall_map. rewrite zrange_seq. apply Forall_map. + apply Forall_forall. intros k Hk. apply in_seq in Hk. + replace (_ =? _)%Z with false; cycle 1. + { symmetry. apply Z.eqb_neq. cbn [length] in *. Fail lia. + match goal with + | |- ?a <> ?b => enough (b < a)%Z by lia + end. + repeat rewrite Nat.add_0_l in *. repeat rewrite Z.add_0_l in *. + remember ((length xs)) as l1. + remember (length xs0) as l2. + remember (_ + _)%Z. + rewrite <- (div_mod_eq (Z.of_nat i) (Z.of_nat (S l2))) by lia. + subst. lia. } + unfold iverson at 1. eapply bin_mul_0_id. + - eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - apply consistent_mul. apply consistent_iverson. + eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - reflexivity. } + rewrite zrange_is_cons; cycle 1. + { cbn [length]. apply mod_upper_bound. lia. } + cbn [map fold_right]. rewrite fold_right_id; cycle 1. + { apply Forall_map. rewrite zrange_seq. apply Forall_map. + apply Forall_forall. intros j Hj. apply in_seq in Hj. + replace (_ =? _)%Z with false; cycle 1. + { symmetry. apply Z.eqb_neq. cbn [length] in *. Fail lia. + match goal with + | |- ?a <> ?b => enough (a < b)%Z by lia + end. + repeat rewrite Nat.add_0_l in *. repeat rewrite Z.add_0_l in *. + remember ((length xs)) as l1. + remember (length xs0) as l2. + match goal with + | |- (_ < ?b)%Z => remember b + end. + rewrite <- (div_mod_eq (Z.of_nat i) (Z.of_nat (S l2))) by lia. + lia. } + unfold iverson at 1. eapply bin_mul_0_id. + - eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - apply consistent_mul. apply consistent_iverson. + eapply consistent_get. eapply consistent_get. subst. + constructor; eauto. constructor; eauto. + - reflexivity. } + replace (_ =? _)%Z with true; cycle 1. + { symmetry. apply Z.eqb_eq. cbn [length] in *. + remember ((length xs)) as l1. + remember (length xs0) as l2. + match goal with + | |- (_ = ?b)%Z => remember b + end. + rewrite <- (div_mod_eq (Z.of_nat i) (Z.of_nat (S l2))) by lia. + lia. } + unfold iverson at 1. + rewrite bin_comm. rewrite bin_assoc. erewrite bin_mul_0_id; cycle 1. + { apply consistent_sumr. 1: lia. intros. + apply consistent_iverson. eapply consistent_get. eapply consistent_get. + subst. constructor; eauto. constructor; auto. } + { apply consistent_mul. eapply consistent_get. eapply consistent_get. + subst. constructor; eauto. constructor; auto. } + { reflexivity. } + rewrite bin_comm. erewrite bin_mul_0_id; cycle 1. + { apply consistent_iverson. eapply consistent_get. eapply consistent_get. + subst. constructor; eauto. constructor; auto. } + { apply consistent_mul. eapply consistent_get. eapply consistent_get. + subst. constructor; eauto. constructor; auto. } + { reflexivity. } + erewrite nth_error_concat in E; cycle 1. + { subst. constructor; auto. eapply Forall_impl; [|eassumption]. + simpl. intros ? H'. invert H'. assumption. } + rewrite <- (Nat2Z.id (_ / _)) in E. + rewrite nth_error_is_get in E. + 2: { split; [lia|]. + cbn [length]. + enough (i / S (length xs0) < length l) by lia. subst. + assert (i < S (length xs0) * S (length xs)) as Hi' by lia. + apply Nat.Div0.div_lt_upper_bound in Hi'. cbn [length]. + lia. } + rewrite <- (Nat2Z.id (_ mod _)) in E. + rewrite nth_error_is_get in E. + 2: { split; [lia|]. + cbn [length] in *. + apply nth_error_Some in E. lia. } + rewrite mul_1_id. + rewrite <- Nat2Z.inj_div. rewrite <- Nat2Z.inj_mod. + invert E. reflexivity. +Qed. + +Lemma fold_right_pres {A B : Type} (f : B -> A -> A) l Q a : + Q a -> + (forall a b, Q a -> In b l -> Q (f b a)) -> + Q (fold_right f a l). +Proof. revert a. induction l; simpl; auto. Qed. + +Lemma fold_right_rel_fold_right {A B : Type} (f : B -> A -> A) R l a P Q : + P a -> + Q a -> + (forall a b, Q a -> In b l -> Q (f b a)) -> + Forall (fun b => forall a, Q a -> R b a (f b a)) l -> + fold_right_rel R P l (fold_right f a l). +Proof. + intros Ha HQ1 HQ2 Hl. revert a HQ1 HQ2 Ha. + induction Hl; simpl; intros; econstructor; eauto. + apply H. apply fold_right_pres; auto. +Qed. + +Definition sum_with_sz sz min max f := + fold_right add_result' (gen_pad sz) (map f (zrange min max)). + +Lemma add_list_result_sum_with_sz sz min max f : + (forall x, result_has_shape' sz (f x)) -> + add_list_result sz (map f (zrange min max)) (sum_with_sz sz min max f). +Proof. + intros. apply fold_right_rel_fold_right with (Q := result_has_shape' sz); auto. + - apply result_has_shape'_iff. apply result_has_shape_gen_pad. + - intros ? ? ? H'. apply in_map_iff in H'. destruct H' as (?&?&?). subst. + apply result_has_shape'_iff. eapply result_has_shape_add_result. + + eapply add_result_add_result'; eauto. + + apply result_has_shape'_iff. auto. + + apply result_has_shape'_iff. auto. + - apply Forall_map. apply Forall_forall. + intros. eapply add_result_add_result'; eauto. +Qed. + +Lemma result_has_shape_add_list sz l r : + Forall (result_has_shape' sz) l -> + add_list_result sz l r -> + result_has_shape' sz r. +Proof. + intros H. revert r. induction H; intros r; invert 1. + - apply result_has_shape'_iff. apply result_has_shape_gen_pad. + - rewrite result_has_shape'_iff in *. eapply result_has_shape_add_result; eauto. + apply result_has_shape'_iff. apply IHForall. assumption. +Qed. + +Lemma result_has_shape'_sum_with_shape sz min max f : + (forall x, result_has_shape' sz (f x)) -> + result_has_shape' sz (sum_with_sz sz min max f). +Proof. + intros H. eapply result_has_shape_add_list; cycle 1. + - apply add_list_result_sum_with_sz. assumption. + - apply Forall_map. apply Forall_forall. auto. +Qed. + +Lemma concat_is_app' n m d sh (x y : dim_n (S d)) : + tensor_has_size' (n :: sh) x -> + tensor_has_size' (m :: sh) y -> + ~In 0 sh -> + n <> 0 -> + m <> 0 -> + x <++> y = x ++ y. +Proof. + intros Hx Hy Hsh Hn Hm. + pose proof Hx as Hx'. + apply tensor_has_size'_dim in Hx'; try solve [intros [?|?]; auto]; []. + simpl in Hx'. invert Hx'. + eapply concat_is_app. + - apply consistent_of_tensor_has_size' in Hx. + + apply Hx. + + intros [?|?]; auto. + - apply consistent_of_tensor_has_size' in Hy. + + apply Hy. + + intros [?|?]; auto. +Qed. + +Lemma tensor_has_size'_of_consistent n sh (x : dim_n n) : + n = length sh -> + consistent x (tuple_of_list sh) -> + tensor_has_size' sh x. +Proof. + intro. subst. + revert x. induction sh; simpl; auto. + intros x H. invert H. split; [reflexivity|]. + rewrite Forall_Forall' in *. constructor; auto. + eapply Forall_impl; [|eassumption]. + simpl. intros a Ha. eauto. +Qed. + +Lemma scalar_mul_0_is_0 n sz v : + n = length sz -> + tensor_has_size' (n := n) sz v -> + scalar_mul 0 v = tensor_of_result (gen_pad sz). +Proof. + intro. subst. + induction sz; intros H; simpl. + - ring. + - simpl in v. simpl in H. cbn [tensor_has_size'] in H. + destruct H as [? H]. subst. + rewrite <- map_constant_repeat. rewrite map_map. apply map_ext_in. + rewrite Forall_Forall' in *. rewrite Forall_forall in *. eauto. +Qed. + +Lemma scalar_mul_0_tensor_of_result n sz r : + n = length sz -> + result_has_shape' sz r -> + scalar_mul 0 (tensor_of_result (n := n) r) = tensor_of_result (gen_pad sz). +Proof. + intros ?. subst. revert sz. induction r; intros sz Hr. + - invert Hr. simpl. ring. + - invert Hr. simpl. rewrite map_map. rewrite <- map_constant_repeat. + rewrite map_map. apply map_ext_in. rewrite Forall_forall in *. eauto. +Qed. + +Lemma fold_right_map' {A B} (f : A -> B) g1 g2 x ys P : + P x -> + Forall P ys -> + (forall x y, P x -> P y -> P (g1 x y)) -> + (forall x y, P x -> P y -> f (g1 x y) = g2 (f x) (f y)) -> + P (fold_right g1 x ys) /\ + f (fold_right g1 x ys) = fold_right g2 (f x) (map f ys). +Proof. + intros Hx Hys H1 H2. + induction Hys; simpl; auto. + destruct IHHys as [IH1 IH2]. split; auto. + rewrite H2 by auto. rewrite IH2. reflexivity. +Qed. + +Lemma fold_right_map {A B} (f : A -> B) g1 g2 x ys P : + P x -> + Forall P ys -> + (forall x y, P x -> P y -> P (g1 x y)) -> + (forall x y, P x -> P y -> f (g1 x y) = g2 (f x) (f y)) -> + f (fold_right g1 x ys) = fold_right g2 (f x) (map f ys). +Proof. + intros Hx Hys H1 H2. epose proof fold_right_map' as H'. epose_dep H'. + specialize (H' Hx). repeat (specialize (H' ltac:(eassumption))). + destruct H'. assumption. +Qed. + +Lemma tensor_add_is_map2_bin n (xs ys : dim_n (S n)) : + length xs = length ys -> + tensor_add xs ys = map2 bin xs ys. +Proof. + revert ys. induction xs; intros ys Hlen; destruct ys as [|y ys]; try discriminate. + - reflexivity. + - simpl in Hlen. rewrite tensor_add_step by lia. + simpl. f_equal. apply IHxs. lia. +Qed. + +Lemma tensor_of_result_add_result' sz n x y : + n = length sz -> + result_has_shape' sz x -> + result_has_shape' sz y -> + tensor_of_result (add_result' x y) = tensor_of_result (n := n) x <+> tensor_of_result y. +Proof. + intro. subst. + revert x y. induction sz; intros x y Hx Hy. + - invert Hx. invert Hy. simpl. destruct s, s0; simpl; ring. + - invert Hx. invert Hy. simpl. + rewrite tensor_add_is_map2_bin by (do 2 rewrite length_map; lia). + rewrite map_map2. rewrite map2_map. do 2 rewrite map2_is_map_combine. + apply map_ext_in. intros [x y] Hx. pose proof Hx as Hy. + apply in_combine_l in Hx. apply in_combine_r in Hy. rewrite Forall_forall in *. + eauto. +Qed. + +Lemma result_has_shape'_2d m n sh v : + result_has_shape' (m :: n :: sh) (V v) -> + exists v', v = map Result.V v'. +Proof. + intros H. exists (map (fun w => + match w with + | Result.V u => u + | Result.S _ => [] + end) v). + rewrite map_map. rewrite <- map_id at 1. apply map_ext_in. + intros r Hr. invert H. rewrite Forall_forall in *. + apply H4 in Hr. invert Hr. reflexivity. +Qed. + +Lemma tile_is_split k m n sh (v : dim_n (S n)) : + ~In 0 (m :: sh) -> + tensor_has_size' (m :: sh) v -> + tile v k = map (fun i => + firstn k (skipn (k * i) + (v ++ repeat (tensor_of_result (gen_pad sh)) + ((k - Datatypes.length v mod k) mod k)))) + (seq O (Datatypes.length v //n k)). +Proof. + cbn [tensor_has_size']. intros Hm [? H]. + subst. rewrite Forall_Forall' in H. + cbv [tile]. cbv [gen]. rewrite genr_is_map. rewrite zrange_seq. + replace (Z.to_nat _) with (length v //n k). + 2: { rewrite Z.sub_0_r. rewrite znat_id_distr. f_equal; lia. } + rewrite map_map. apply map_ext_in. intros i Hi. apply in_seq in Hi. + rewrite genr_is_map. + erewrite (map_nth_seq _ (firstn _ _)). + assert (k = 0 \/ k <> 0) as [Hk|Hk] by lia. + { subst. simpl. reflexivity. } + rewrite <- split_result_length_helper by lia. + rewrite zrange_seq. rewrite map_map. + replace (Z.to_nat _) with k by lia. + apply map_ext_in. + intros j Hj. apply in_seq in Hj. + cbv [nth_default]. + rewrite nth_error_firstn_elim by lia. rewrite nth_error_skipn. + destruct (_ [] | O => 0%R end) ltac:(lia) ltac:(lia)). + rewrite length_firstn, length_skipn, length_app, repeat_length in H'. + lia. } + destruct v. + { simpl in Hm. exfalso. auto. } + rewrite get_znlt_null by assumption. + cbv [iverson]. rewrite mul_0_idemp. erewrite scalar_mul_0_is_0. + + reflexivity. + + invert H. apply tensor_has_size'_dim in H2; auto. simpl in Hm. auto. + + invert H. assumption. + Unshelve. + exact (match n with | S _ => [] | O => 0%R end). +Qed. + +Lemma get_is_nth_error {X} `{TensorElem X} (v : list X) i : + (0 <= i < Z.of_nat (length v))%Z -> + get v i = nth_default null v (Z.to_nat i). +Proof. + intros H'. cbv [nth_default]. rewrite nth_error_is_get by assumption. + reflexivity. +Qed. + +Lemma truncr_is_rev_skipn_rev k n (l : dim_n (S n)) : + truncr k l = rev (skipn k (rev l)). +Proof. + cbv [truncr]. cbv [gen]. rewrite genr_is_map. + rewrite skipn_rev. rewrite rev_involutive. + erewrite (map_nth_seq _ (firstn _ _)). + rewrite zrange_seq. rewrite length_firstn. + replace (Z.to_nat _) with (length l - k) by lia. + replace (min _ _) with (length l - k) by lia. + rewrite map_map. apply map_ext_in. + intros i Hi. apply in_seq in Hi. cbv [nth_default]. + rewrite get_is_nth_error by lia. + replace (Z.to_nat _) with i by lia. + rewrite nth_error_firstn_elim by lia. + reflexivity. +Qed. + +Lemma truncl_is_skipn k n (l : dim_n (S n)) : + truncl k l = skipn k l. +Proof. + cbv [truncl]. cbv [gen]. rewrite genr_is_map. + erewrite (map_nth_seq _ (skipn _ _)). + rewrite zrange_seq. rewrite length_skipn. + replace (Z.to_nat _) with (length l - k) by lia. + rewrite map_map. apply map_ext_in. + intros i Hi. apply in_seq in Hi. cbv [nth_default]. + rewrite get_is_nth_error by lia. + rewrite nth_error_skipn. + replace (Z.to_nat _) with (k + i) by lia. + reflexivity. +Qed. + +Lemma pad_l_is_app_pad m n sh k (v : dim_n (S m)) : + ~In 0 (n :: sh) -> + tensor_has_size' (n :: sh) v -> + pad_l k v = repeat (tensor_of_result (gen_pad sh)) k ++ v. +Proof. + intros Hnz Hsz. cbv [pad_l]. cbv [gen]. rewrite genr_is_map. + pose proof Hnz as Hnz'. eapply tensor_has_size'_dim in Hnz; eauto. + simpl in Hnz. invert Hnz. + rewrite zrange_seq. rewrite map_map. + replace (Z.to_nat _) with (k + length v) by lia. + rewrite seq_app. rewrite map_app. f_equal. + - erewrite map_ext_in. + + rewrite map_const. rewrite length_seq. reflexivity. + + simpl. intros i Hi. apply in_seq in Hi. destruct (_ <=? _)%Z eqn:E. + -- apply Z.leb_le in E. lia. + -- cbv [iverson]. cbn [tensor_has_size'] in Hsz. destruct Hsz as [? Hsz]. subst. + destruct v; [simpl in Hnz'; exfalso; auto|]. rewrite get_neg_null by lia. + cbv [iverson]. rewrite mul_0_idemp. erewrite scalar_mul_0_is_0. + ++ reflexivity. + ++ auto. + ++ rewrite Forall_Forall' in Hsz. invert Hsz. assumption. + - remember (map _ _). rewrite (map_nth_seq null v). subst. + rewrite map_seq. rewrite map_map. apply map_ext_in. + intros i Hi. apply in_seq in Hi. destruct (_ <=? _)%Z eqn:E; cycle 1. + { apply Z.leb_nle in E. lia. } + cbv [iverson]. rewrite mul_1_id. + rewrite get_is_nth_error by lia. f_equal. lia. +Qed. + +Lemma pad_r_is_app_pad m n sh k (v : dim_n (S m)) : + ~In 0 (n :: sh) -> + tensor_has_size' (n :: sh) v -> + pad_r k v = v ++ repeat (tensor_of_result (gen_pad sh)) k. +Proof. + intros Hnz Hsz. cbv [pad_r]. cbv [gen]. rewrite genr_is_map. + pose proof Hnz as Hnz'. eapply tensor_has_size'_dim in Hnz; eauto. + simpl in Hnz. invert Hnz. + rewrite zrange_seq. rewrite map_map. + replace (Z.to_nat _) with (length v + k) by lia. + rewrite seq_app. rewrite map_app. f_equal. + - remember (map _ _). rewrite (map_nth_seq null v). subst. + rewrite map_seq at 2. rewrite map_map. apply map_ext_in. + intros i Hi. apply in_seq in Hi. destruct (_ nth_default d r n) l. + +Definition transpose_list {X} (d : X) (l : list (list X)) n := + map (fun i => get_list_col d l i) (seq O n). + +Lemma transpose_result_list_is_map_blah_seq' l n : + n <= row_length l -> + transpose_result_list l n = + map (fun i => V (get_col l i)) (seq (row_length l - n) n). +Proof. + induction n; auto. + intros H. + simpl. f_equal. rewrite IHn by lia. + f_equal. f_equal. lia. +Qed. + +Lemma transpose_result_list_is_map_blah_seq l : + transpose_result_list l (row_length l) = + map (fun i => V (get_col l i)) (seq O (row_length l)). +Proof. + rewrite transpose_result_list_is_map_blah_seq' by lia. + f_equal. f_equal. lia. +Qed. + +Definition list_row_length {A} (v : list (list A)) := + match v with + | [] => 0 + | a :: _ => length a + end. + +Lemma row_length_is_list_row_length v : + row_length (map V v) = list_row_length v. +Proof. destruct v; reflexivity. Qed. + +Lemma get_col_is_get_list_col v i : + Forall (fun u => i < length u) v -> + get_col (map V v) i = get_list_col (V []) v i. +Proof. + induction 1. + - reflexivity. + - simpl. cbv [nth_default]. destruct (nth_error _ _) eqn:E. + + f_equal. assumption. + + apply nth_error_None in E. lia. +Qed. + +Lemma transpose_result_list_is_transpose_list v n : + Forall (fun u => length u = n) v -> + transpose_result_list (map V v) n = map V (transpose_list (V []) v n). +Proof. + intros H. destruct v. + { simpl. cbv [transpose_list]. rewrite transpose_empty_result_list. + rewrite map_map. erewrite map_ext. + - rewrite map_constant_repeat. rewrite length_seq. reflexivity. + - simpl. reflexivity. } + invert H. + rewrite transpose_result_list_is_map_blah_seq. + cbv [transpose_list]. + rewrite map_map. cbn [map row_length]. apply map_ext_in. + intros i Hi. apply in_seq in Hi. f_equal. rewrite <- map_cons. + apply get_col_is_get_list_col. + constructor. 1: lia. eapply Forall_impl; [|eassumption]. simpl. lia. +Qed. + +Lemma transpose_is_transpose_list {X} `{TensorElem X} (v : list (list X)) : + Forall (fun u => length u = list_row_length v) v -> + transpose v = transpose_list null v (list_row_length v). +Proof. + cbv [transpose]. cbv [gen]. rewrite genr_is_map. cbv [transpose_list]. + intros Hlen. destruct v. + { reflexivity. } + cbn [list_row_length length]. cbn [get]. rewrite get_0_cons. + rewrite zrange_seq. replace (Z.to_nat _) with (length l) by lia. + rewrite map_map. apply map_ext_in. intros i Hi. apply in_seq in Hi. + rewrite genr_is_map. cbv [get_list_col]. + remember (map _ _). erewrite (map_nth_seq null (l :: v)). subst. + rewrite map_map. rewrite zrange_seq. replace (Z.to_nat _) with (S (length v)) by lia. + cbn [length]. rewrite map_map. apply map_ext_in. + intros j Hj. apply in_seq in Hj. rewrite get_is_nth_error. + 2: { simpl. split; [lia|]. rewrite get_is_nth_error by (simpl; lia). + cbv [nth_default]. destruct (nth_error _ _) eqn:E. + - apply nth_error_In in E. rewrite Forall_forall in Hlen. apply Hlen in E. + simpl in E. lia. + - apply nth_error_None in E. simpl in E. lia. } + rewrite get_is_nth_error by (simpl; lia). + f_equal; try lia. f_equal. lia. +Qed. + +Lemma nth_error_zrange_is_Some min max n : + n < Z.to_nat (max - min) -> + nth_error (zrange min max) n = Some (min + Z.of_nat n)%Z. +Proof. + intros H. rewrite zrange_seq. rewrite nth_error_map. + rewrite nth_error_seq. destruct (_ (m - n)%z :: rest | [] => [] - end + end | Padr n e => match sizeof e with | m :: rest => (m + n)%z :: rest | [] => [] - end + end | Padl n e => match sizeof e with | m :: rest => (m + n)%z :: rest | [] => [] - end + end | Scalar s => [] - end. + end. Definition flat_sizeof e := match sizeof e with @@ -179,11 +177,11 @@ Fixpoint lower let xlen := match sizeof x with | n::_ => n | _ => | 0 |%z - end in + end in let ylen := match sizeof y with | n::_ => n | _ => | 0 |%z - end in + end in Seq (lower x (fun l => f (match l with | (v,d)::xs => @@ -209,7 +207,7 @@ Fixpoint lower | (v,d)::(vi,di)::xs => ((v * di + vi)%z, (d * di)%z)::xs | _ => l - end)) p asn sh + end)) p asn sh | Truncr n e => lower e (fun l => f (match l with | (v,d)::xs => @@ -280,7 +278,7 @@ Inductive size_of v : ATLexpr -> list nat -> Prop := | 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) + size_of _ (Padl k e) (Z.to_nat kz + m :: sh) | SizeOfScalar : forall s, size_of _ (Scalar s) []. Local Hint Constructors eval_Zexpr eval_Bexpr eval_Sexpr size_of. @@ -448,11 +446,11 @@ Inductive eval_expr : eval_Zexpr_Z v k = Some kz -> 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)))) + (V (List.rev (skipn (Z.to_nat kz) (List.rev l)))) | EvalTruncl : forall e v ec k kz l, eval_Zexpr_Z v k = Some kz -> eval_expr v ec e (V l) -> - eval_expr v ec (Truncl k e) (V (truncl_list (Z.to_nat kz) l)) + eval_expr v ec (Truncl k e) (V (skipn (Z.to_nat kz) l)) | EvalPadr : forall e v ec l s n k kz, eval_Zexpr_Z v k = Some kz -> size_of v e (n::s) -> @@ -593,6 +591,14 @@ Proof. - f_equal; lia. Qed. +(*not quite equivalent to the coqutil thing, but same idea*) +Ltac destruct_one_match_hyp := + match goal with + | H: context [match ?e with _ => _ end] |- _ => + let E := fresh "E" in + destruct e eqn:E + end. + Theorem dom_alloc_array_in_heap : forall h x l, l <> [] -> dom (alloc_array_in_heap l h x) = constant [x] \cup dom h. @@ -610,7 +616,7 @@ Lemma length_eval_expr_gen : forall c v e l i lo hi, 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. @@ -670,7 +676,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. @@ -729,7 +735,7 @@ Proof. 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 *. @@ -799,10 +805,148 @@ Proof. eapply result_has_shape_add_result. eassumption. 2: { eapply IHn in H19. eassumption. eassumption. eassumption. simpl. rewrite H2. reflexivity. - eauto. lia. } + 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. +Qed. + +Lemma invert_eval_gen v ctx i lo hi body r : + eval_expr v ctx (Gen i lo hi body) r -> + exists loz hiz rl, + r = V rl /\ + length rl = Z.to_nat (hiz - loz) /\ + eval_Zexpr_Z v lo = Some loz /\ + eval_Zexpr_Z v hi = Some hiz /\ + (forall i', (loz <= i' < hiz)%Z -> + (~ i \in dom v) /\ + (~ contains_substring "?" i) /\ + match nth_error rl (Z.to_nat (i' - loz)) with + | None => False + | Some r => eval_expr (v $+ (i, i')) ctx body r + end). +Proof. + intros H. remember (Gen _ _ _ _) as e eqn:E. revert lo E. + induction H; intros lo_ H'; invert H'. + - exists loz, hiz, nil. simpl. intuition lia. + - clear IHeval_expr1. + specialize (IHeval_expr2 _ eq_refl). + destruct IHeval_expr2 as (loz_&hiz_&l_&Hl_&Hlen&Hloz&Hhiz&IH2). + rewrite H0 in Hhiz. invert Hhiz. invert Hl_. + simpl in Hloz. rewrite H in Hloz. invert Hloz. + eexists _, _, _. intuition eauto. + { simpl. lia. } + assert (Hor : (i' = loz \/ loz + 1 <= i')%Z) by lia. + destruct Hor as [Hle|Heq]. + + subst. replace (Z.to_nat _) with O by lia. simpl. assumption. + + specialize (IH2 i' ltac:(lia)). destruct (Z.to_nat (i' - loz)) eqn:E. 1: lia. + simpl. destruct IH2 as (_&_&IH2). replace (Z.to_nat _) with n in IH2 by lia. + apply IH2. +Qed. + +Lemma mk_eval_gen v ctx i lo hi body loz hiz rl : + eval_Zexpr_Z v lo = Some loz -> + eval_Zexpr_Z v hi = Some hiz -> + length rl = Z.to_nat (hiz - loz) -> + (forall i', (loz <= i' < hiz)%Z -> + (~ i \in dom v) /\ + (~ contains_substring "?" i) /\ + match nth_error rl (Z.to_nat (i' - loz)) with + | None => False + | Some r => eval_expr (v $+ (i, i')) ctx body r + end) -> + eval_expr v ctx (ATLDeep.Gen i lo hi body) (Result.V rl). +Proof. + intros Hlo Hhi Hlen Hbody. revert lo loz Hlen Hlo Hbody. + induction rl; intros lo loz Hlen Hlo Hbody. + - eapply EvalGenBase; eauto. simpl in Hlen. lia. + - simpl in Hlen. + pose proof (Hbody loz ltac:(lia)) as Hbody0. invs'. + replace (loz - loz)%Z with 0%Z in * by lia. simpl in *. invs'. + econstructor; eauto; try lia. eapply IHrl; eauto. + 2: { simpl. rewrite Hlo. reflexivity. } + { lia. } + intros i' Hi'. specialize (Hbody i' ltac:(lia)). invs'. intuition. + replace (Z.to_nat (i' - loz)) with (Datatypes.S (Z.to_nat (i' - (loz + 1)))) in * by lia. + simpl in H7. apply H7. +Qed. + +Inductive fold_right_rel {A B : Type} (R : B -> A -> A -> Prop) : (A -> Prop) -> list B -> A -> Prop := +| frr_nil P0 a : P0 a -> fold_right_rel R P0 [] a +| frr_cons P0 b l0 a a' : + fold_right_rel R P0 l0 a' -> + R b a' a -> + fold_right_rel R P0 (b :: l0) a +. +Hint Constructors fold_right_rel : core. + +Definition add_list_result sh := + fold_right_rel add_result (eq (gen_pad sh)). + +Lemma invert_eval_sum v ctx i lo hi body r : + eval_expr v ctx (Sum i lo hi body) r -> + exists loz hiz summands sz, + size_of v body sz /\ + length summands = Z.to_nat (hiz - loz) /\ + eval_Zexpr_Z v lo = Some loz /\ + eval_Zexpr_Z v hi = Some hiz /\ + add_list_result sz summands r /\ + (forall i', (loz <= i' < hiz)%Z -> + (~ i \in dom v) /\ + (~ contains_substring "?" i) /\ + match nth_error summands (Z.to_nat (i' - loz)) with + | None => False + | Some r => eval_expr (v $+ (i, i')) ctx body r + end). +Proof. + intros H. remember (Sum _ _ _ _) as e eqn:E. revert lo E. + induction H; intros lo_ H'; invert H'. + 2: { exists loz, hiz, nil, sz. simpl. intuition auto; try lia. + constructor. eauto. } + clear IHeval_expr1. specialize (IHeval_expr2 _ eq_refl). + destruct IHeval_expr2 as (loz'&hiz'&summands'&sz'&Hsz'&Hlen&Hloz'&Hhiz'&Hsummands'&IH). + simpl in Hloz'. rewrite H0 in Hhiz'. invert Hhiz'. rewrite H in Hloz'. invert Hloz'. + exists loz, hiz', (r :: summands'), sz'. intuition. + + simpl. lia. + + econstructor. 1: eassumption. assumption. + + clear Hsummands'. + assert (Hor : (i' = loz \/ loz + 1 <= i')%Z) by lia. + destruct Hor as [Hle|Heq]. + -- subst. replace (Z.to_nat _) with O by lia. simpl. assumption. + -- + specialize (IH i' ltac:(lia)). destruct IH as (_&_&IH). + replace (Z.to_nat (i' - loz)) with (Datatypes.S (Z.to_nat (i' - (loz + 1)))) by lia. + simpl. assumption. +Qed. + +Lemma mk_eval_sum sz v ctx i lo hi body r loz hiz summands : + size_of v body sz -> + eval_Zexpr_Z v lo = Some loz -> + eval_Zexpr_Z v hi = Some hiz -> + add_list_result sz summands r -> + length summands = Z.to_nat (hiz - loz) -> + (forall i', (loz <= i' < hiz)%Z -> + (~ i \in dom v) /\ + (~ contains_substring "?" i) /\ + match nth_error summands (Z.to_nat (i' - loz)) with + | None => False + | Some r => eval_expr (v $+ (i, i')) ctx body r + end) -> + eval_expr v ctx (Sum i lo hi body) r. +Proof. + intros Hsz Hlo Hhi Hsum Hlen Hbody. revert lo loz r Hlen Hlo Hsum Hbody. + induction summands; intros lo loz r Hlen Hlo Hsum Hbody. + - invert Hsum. eapply EvalSumBase; eauto. simpl in Hlen. lia. + - simpl in Hlen. invert Hsum. + pose proof (Hbody loz ltac:(lia)) as Hbody0. destruct Hbody0 as (?&?&?). + replace (loz - loz)%Z with 0%Z in * by lia. simpl in *. + econstructor; eauto; try lia. eapply IHsummands; eauto. + 2: { simpl. rewrite Hlo. reflexivity. } + { lia. } + intros i' Hi'. specialize (Hbody i' ltac:(lia)). + destruct Hbody as (?&?&?). intuition. + replace (Z.to_nat (i' - loz)) with (Datatypes.S (Z.to_nat (i' - (loz + 1)))) in * by lia. + simpl in H6. apply H6. +Qed. diff --git a/src/verified_lowering/proof/Constant.v b/src/verified_lowering/proof/Constant.v index bf68be2..e752e61 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 -> @@ -434,14 +434,13 @@ Lemma constant_not_empty {X} : forall (l : list X), constant l = constant [] -> False. Proof. - intros. + intros l H H0. erewrite <- sets_equal in H0. cases l. propositional. specialize (H0 x). propositional. simpl in H1. sets. Qed. -(*idk where to put this*) Ltac cups_empty := repeat match goal with | H: constant _ = constant [] |- _ => eapply constant_not_empty in H; [contradiction | solve[inversion 1]] diff --git a/src/verified_lowering/proof/ContextsAgree.v b/src/verified_lowering/proof/ContextsAgree.v index 860dee4..9ba04df 100644 --- a/src/verified_lowering/proof/ContextsAgree.v +++ b/src/verified_lowering/proof/ContextsAgree.v @@ -96,25 +96,17 @@ Proof. - invert H0. simpl. auto. Qed. -(*surely this is implied by some other eval_get lemmas, but i don't see how right now*) 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. - - (*definition of result_has_shape is mildly annoying *) - (*definition was like that because result induction principle was useless. - this is not a problem anymore, so would be nice to have a better definition of - result_has_shape*) - (*i suspect refactoring would be a huge amount of effort though*) - 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. + intros H. revert sz. + induction H; simpl; intros sz Hsz; apply result_has_shape'_iff in Hsz. + - invert Hsz; simpl. + f_equal. apply IHeval_get. apply nth_error_In in H1. simpl in H1. + rewrite Forall_forall in H6. specialize (H6 _ ltac:(eassumption)). + apply result_has_shape'_iff. auto. - invert Hsz. reflexivity. Qed. @@ -135,8 +127,7 @@ Proof. - 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. (* <- magic*) invs. clear H1. rewrite H3 in H2. - Fail invert1 H4. (*...*) + 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). @@ -145,7 +136,7 @@ Proof. invert H2. rewrite map_fst_combine in H9 by assumption. rewrite map_snd_combine in H9 by assumption. - + (* REVISIT *) assert (Some (array_add @@ -156,7 +147,7 @@ Proof. (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. @@ -176,7 +167,7 @@ Proof. 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 H5; eauto. erewrite result_has_shape_result_shape_Z in H5; eauto. @@ -228,10 +219,10 @@ Proof. 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. + 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. @@ -248,7 +239,7 @@ 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. + - 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. eexists. split. @@ -277,7 +268,7 @@ Proof. 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, @@ -290,8 +281,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. @@ -305,7 +296,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. @@ -342,7 +333,7 @@ Lemma contexts_agree_add_alloc_heap : ec $? x = None -> 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 -> + 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 @@ -354,7 +345,7 @@ Proof. unfold contexts_agree. propositional. - cases (x ==v x0). + subst. rewrite lookup_add_eq in * by auto. - invs. + invs. eexists. eexists. split. reflexivity. split. eauto. @@ -382,14 +373,6 @@ Proof. eapply H. eauto. 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. - Lemma contexts_agree_result_has_shape : forall ec st h sh, contexts_agree ec st h sh -> @@ -409,4 +392,4 @@ Proof. eapply eval_Zexprlist_deterministic in H2; [|eapply H1]. apply map_Z_of_nat_inj in H2. subst. assumption. -Qed. +Qed. diff --git a/src/verified_lowering/proof/InterpretReindexer.v b/src/verified_lowering/proof/InterpretReindexer.v index 33ded6e..d56ef51 100644 --- a/src/verified_lowering/proof/InterpretReindexer.v +++ b/src/verified_lowering/proof/InterpretReindexer.v @@ -41,7 +41,7 @@ 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. simpl in H. + 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). @@ -73,7 +73,7 @@ Proof. eapply not_In_empty_map2_cons in H; propositional. unfold interpret_reindexer. unfold shape_to_vars. - simpl length. unfold nat_range. simpl nat_range_rec. + simpl length. unfold nat_range. simpl seq. rewrite map_cons. rewrite shape_to_index_cons. rewrite index_to_function_alt_vars_cons; eauto with reindexers. @@ -94,7 +94,7 @@ Proof. 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) -> @@ -159,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) = @@ -196,20 +196,13 @@ Definition index_to_partial_function | None => 0%Z end) evaled_list_index)) else None. -Print shape_to_vars. -Print shape_to_index. -Print partially_eval_Z_tup. -Print partially_eval_Zexpr. -Print index_to_partial_function. Definition partial_interpret_reindexer (reindexer : list (Zexpr * Zexpr) -> list (Zexpr * Zexpr)) (sh : list Z) (v : valuation) : list Z -> option Z := let vars := shape_to_vars sh in let result_index := shape_to_index sh vars in - (*[(?, d1), (??, d2), ...]*) let full_index := reindexer result_index in - (*why would v have these ?? strings in its domain??*) let evaled_index := map (partially_eval_Z_tup v) full_index in index_to_partial_function evaled_index vars. @@ -247,8 +240,8 @@ Lemma index_to_partial_function_vars_cons : ~ var \in dom v -> 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. @@ -308,7 +301,7 @@ Proof. - repeat decomp_index. unfold partial_interpret_reindexer. unfold shape_to_vars. - simpl length. unfold nat_range. simpl nat_range_rec. + simpl length. unfold nat_range. simpl seq. rewrite map_cons. rewrite shape_to_index_cons. rewrite index_to_partial_function_vars_cons; eauto with reindexers. @@ -327,7 +320,7 @@ Proof. 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. @@ -346,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. @@ -355,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, @@ -377,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. @@ -388,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, @@ -397,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. diff --git a/src/verified_lowering/proof/ListMisc.v b/src/verified_lowering/proof/ListMisc.v index d789b25..ccab546 100644 --- a/src/verified_lowering/proof/ListMisc.v +++ b/src/verified_lowering/proof/ListMisc.v @@ -23,6 +23,15 @@ Fixpoint filter_until l k := | _ => [] end. +Lemma filter_until_not_in l k : + ~In k l -> + filter_until l k = l. +Proof. + induction l as [|a l]; intros Hk; [reflexivity|]. + simpl. simpl in Hk. assert (a <> k) as H by auto. + apply Nat.eqb_neq in H. rewrite H. f_equal. apply IHl. auto. +Qed. + Lemma Forall_repeat {X} : forall n a (P : X -> Prop), P a -> Forall P (repeat a n). @@ -42,6 +51,13 @@ Fixpoint map2 {X Y Z}(f : X -> Y -> Z) (l1 : list X) (l2 : list Y) : list Z := | _,_ => [] end. +Lemma map2_is_map_combine {X Y Z} (f : X -> Y -> Z) (l1 : list X) (l2 : list Y) : + map2 f l1 l2 = map (fun '(x, y) => f x y) (combine l1 l2). +Proof. + revert l2. induction l1; simpl; auto. + destruct l2; auto. simpl. f_equal. auto. +Qed. + Lemma fold_left_cons {X} : forall (f : X -> X -> X) x xs a, (forall a b, f a b = f b a) -> (forall a b c, f a (f b c) = f (f a b) c) -> @@ -181,7 +197,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 +242,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) <-> @@ -252,6 +268,14 @@ Proof. simpl. f_equal. eauto. Qed. +Lemma map2_map {X1 X2 X1' X2' Y} l1 l2 (f1 : X1 -> X1') (f2 : X2 -> X2') (g : _ -> _ -> Y) : + map2 g (map f1 l1) (map f2 l2) = map2 (fun x1 x2 => g (f1 x1) (f2 x2)) l1 l2. +Proof. + revert l2. + induction l1; intros; cases l2; try reflexivity. + simpl. f_equal. eauto. +Qed. + Lemma map2_map_l1 {X Y Z K} : forall (l1 : list X) (l2 : list Y) (f : Z -> Y -> K) (g : X -> Z), map2 (fun a b => f (g a) b) l1 l2 = map2 f (map g l1) l2. @@ -362,7 +386,7 @@ Lemma forall_filter {X} : forall f l, Proof. induct l; intros. - econstructor. - - simpl. + - simpl. cases (f a). + econstructor. auto. auto. + auto. @@ -501,7 +525,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) -> @@ -710,7 +734,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. @@ -734,7 +758,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 <-> @@ -774,20 +798,19 @@ Proof. - reflexivity. - invert H. simpl. rewrite Z2Nat.id by lia. f_equal. eauto. -Qed. - -Fixpoint truncl_list {X} n (l : list X) := - match n with - | Datatypes.S n' => match l with - | x::xs => truncl_list n' xs - | _ => l - end - | _ => l - end. +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. Lemma truncl_list_empty {X} : forall k, - truncl_list k (@nil X) = []. -Proof. induct k; propositional. Qed. + skipn k (@nil X) = []. +Proof. apply skipn_nil. Qed. Lemma filter_idempotent {X} : forall (l : list X) f, filter f (filter f l) = filter f l. @@ -822,22 +845,10 @@ Qed. Lemma nth_error_truncl {X} : forall (l : list X) k z, - nth_error (truncl_list k l) z = + nth_error (skipn k l) z = nth_error l (z + k). Proof. - induct l; intros. - - rewrite truncl_list_empty. - repeat rewrite nth_error_empty. auto. - - simpl. cases (z + k). - + simpl. assert (z = 0) by lia. subst. simpl. - assert (k = 0) by lia. subst. simpl. reflexivity. - + simpl. cases z. - * simpl. rewrite add_0_l in Heq. subst. simpl. - specialize (IHl n 0). simpl in *. auto. - * simpl in *. invert Heq. - cases k. simpl. f_equal. lia. - simpl. specialize (IHl k (Datatypes.S z)). simpl in *. - rewrite add_succ_r. simpl. auto. + intros. rewrite nth_error_skipn. f_equal. lia. Qed. Lemma rev_arg_empty {X} : forall (l : list X), @@ -851,34 +862,24 @@ Qed. Lemma truncl_list_app {X} : forall k (l1 l2 : list X), k <= length l1 -> - truncl_list k (l1 ++ l2)%list = (truncl_list k l1 ++ l2)%list. + skipn k (l1 ++ l2)%list = (skipn k l1 ++ l2)%list. Proof. - induct k; intros. - - reflexivity. - - simpl. - cases l1. simpl in *. lia. simpl in *. eapply IHk. lia. + intros. rewrite skipn_app. + replace (_ - _) with 0 by lia. reflexivity. Qed. Lemma truncl_list_length_empty {X} : forall k (l : list X), length l <= k <-> - truncl_list k l = []. + skipn k l = []. Proof. - induct k; intros; split; intros; cases l; simpl in *. - - reflexivity. - - lia. - - lia. - - discriminate. - - reflexivity. - - eapply IHk. lia. - - lia. - - eapply IHk in H. lia. + intros. apply skipn_all_iff. Qed. Lemma nth_error_truncr {X} : forall (l : list X) k z, z < length l - k -> nth_error (rev - (truncl_list + (skipn k (rev l))) z = nth_error l z. Proof. @@ -888,7 +889,7 @@ Proof. repeat rewrite nth_error_empty. auto. - simpl. cases z. + simpl. - cases (rev (truncl_list k (rev l ++ [a]))). + cases (rev (skipn k (rev l ++ [a]))). * erewrite rev_arg_empty in Heq. eapply truncl_list_length_empty in Heq. rewrite length_app in *. rewrite length_rev in *. simpl in Heq. @@ -901,7 +902,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). @@ -922,19 +923,14 @@ Qed. Lemma truncl_list_app_l {X} : forall k (l1 l2 : list X), k <= length l1 -> - truncl_list k (l1 ++ l2)%list = (truncl_list k l1 ++ l2)%list. + skipn k (l1 ++ l2)%list = (skipn k l1 ++ l2)%list. Proof. - induct k; intros. - - reflexivity. - - simpl. - cases l1. simpl in *. lia. - simpl in *. - rewrite IHk by lia. - reflexivity. -Qed. + intros. rewrite skipn_app. + replace (_ - _) with 0 by lia. reflexivity. +Qed. Lemma truncl_list_repeat {X} : forall k (x : X) n, - truncl_list k (repeat x n) = repeat x (n-k). + skipn k (repeat x n) = repeat x (n-k). Proof. induct k; intros. - simpl. f_equal. lia. @@ -1055,15 +1051,6 @@ Proof. econstructor. lia. eapply IHl. invert H. auto. Qed. -Lemma truncl_list_skipn {X} : forall n (l : list X), - truncl_list n l = skipn n l. -Proof. - induct n; intros. - - reflexivity. - - cases l. reflexivity. - simpl in *. eauto. -Qed. - Lemma forall_firstn_skipn {X} : forall y (l : list X) k P, Forall P (firstn y l) -> Forall P (firstn (y - k) (skipn k l)). @@ -1089,7 +1076,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. @@ -1100,7 +1087,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))) = @@ -1121,11 +1108,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) -> @@ -1163,7 +1150,7 @@ Proof. 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 -> @@ -1186,7 +1173,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. @@ -1209,7 +1196,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). @@ -1308,3 +1295,61 @@ Proof. - subst. simpl. intros. rewrite fold_left_mul_assoc_nat. lia. - rewrite filter_until_0_cons by lia. simpl. auto. Qed. + +(*stolen from https://github.com/mit-plv/coqutil/blob/master/src/coqutil/Datatypes/List.v.*) +Definition list_eqb {A} (aeqb : A -> A -> bool) (x y : list A) : bool := + ((length x =? length y)%nat && forallb (fun xy => aeqb (fst xy) (snd xy)) (combine x y)). + +Lemma list_eqb_spec A (aeqb : A -> _) : + (forall x y, aeqb x y = true <-> x = y) -> + (forall l1 l2, list_eqb aeqb l1 l2 = true <-> l1 = l2). +Proof. + intros H l1. induction l1; intros l2; destruct l2; simpl. + - split; reflexivity. + - cbv [list_eqb]. simpl. split; congruence. + - cbv [list_eqb]. simpl. split; congruence. + - cbv [list_eqb]. simpl. split; intros H'. + + apply andb_prop in H'. destruct H' as [H'1 H'2]. apply andb_prop in H'2. + destruct H'2 as [H'2 H'3]. apply H in H'2. subst. f_equal. apply IHl1. + cbv [list_eqb]. rewrite H'1, H'3. reflexivity. + + invert H'. assert (H': l2 = l2) by reflexivity. apply IHl1 in H'. + eassert (H'': _ = _) by reflexivity. apply H in H''. rewrite H''. simpl. apply H'. +Qed. + +Fixpoint nodupb {T : Type} (eqb : T -> T -> bool) l := + match l with + | x :: l' => if existsb (eqb x) l' then false else nodupb eqb l' + | [] => true + end. + +Lemma existsb_false_implies : forall {A : Type} (f : A -> bool) (l : list A), + existsb f l = false -> forall x, In x l -> f x = false. +Proof. + intros A f l H_exists x H_in. + destruct (f x) eqn:H_eval. + - assert (H_true : existsb f l = true). + { apply existsb_exists. exists x. auto. } + congruence. + - reflexivity. +Qed. + +Lemma nodupb_correct T (eqb : T -> _) l : + (forall x, eqb x x = true) -> + nodupb eqb l = true -> + NoDup l. +Proof. + intros Heqb H. induction l; simpl in *. + - constructor. + - destruct (existsb _ _) eqn:E; try congruence. constructor; auto. + intro. + eapply existsb_false_implies in E; eauto. + rewrite Heqb in E. congruence. +Qed. + +Lemma nodupb_string_correct l : + nodupb String.eqb l = true -> + NoDup l. +Proof. + intros. eapply nodupb_correct; [|eassumption]. + intros. apply String.eqb_refl. +Qed. diff --git a/src/verified_lowering/proof/LowerCorrect.v b/src/verified_lowering/proof/LowerCorrect.v index 6c4a7e9..661a403 100644 --- a/src/verified_lowering/proof/LowerCorrect.v +++ b/src/verified_lowering/proof/LowerCorrect.v @@ -2581,12 +2581,12 @@ Proof. (shape_to_index (result_shape_Z (V (rev - (truncl_list + (skipn (Z.to_nat kz) (rev l))))) (shape_to_vars (result_shape_Z - (V (rev (truncl_list + (V (rev (skipn (Z.to_nat kz) (rev l)))))))). @@ -2594,7 +2594,6 @@ Proof. 2: { eapply result_has_shape_rev. eapply result_has_shape_truncl_list. eapply result_has_shape_rev. - erewrite <- result_has_shape_filter_until_0. simpl in *. eauto. } unfold result_shape_Z, shape_to_index, shape_to_vars in Heq1. simpl in *. @@ -2621,7 +2620,6 @@ Proof. 2: { eapply result_has_shape_rev. eapply result_has_shape_truncl_list. eapply result_has_shape_rev. - erewrite <- result_has_shape_filter_until_0. simpl in *. eauto. } erewrite Exists_map. eapply Exists_impl; [|apply exists_filter_until_0]. @@ -2689,7 +2687,6 @@ Proof. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_rev. eapply result_has_shape_truncl_list. - erewrite <- result_has_shape_filter_until_0. eapply result_has_shape_rev. repeat rewrite map_cons in Hsh. eauto. } @@ -2729,7 +2726,6 @@ Proof. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_rev. eapply result_has_shape_truncl_list. - erewrite <- result_has_shape_filter_until_0. eapply result_has_shape_rev. repeat rewrite map_cons in Hsh. eassumption. } @@ -3076,7 +3072,6 @@ Proof. 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 (m - Z.to_nat kz). @@ -3099,7 +3094,6 @@ Proof. simpl. reflexivity. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_truncl_list. - erewrite <- result_has_shape_filter_until_0. simpl in *. eauto. } erewrite Exists_map. eapply Exists_impl; [|apply exists_filter_until_0]. diff --git a/src/verified_lowering/proof/LowerExists.v b/src/verified_lowering/proof/LowerExists.v index bd5f1b6..cdc5d20 100644 --- a/src/verified_lowering/proof/LowerExists.v +++ b/src/verified_lowering/proof/LowerExists.v @@ -1543,13 +1543,11 @@ Proof. rewrite rev_app_distr. rewrite truncl_list_app. 2: { rewrite length_rev. simpl. rewrite repeat_length. lia. } - rewrite truncl_list_skipn. rewrite skipn_all2. 2: { rewrite length_rev. simpl. rewrite repeat_length. lia. } replace m with (length l). 2: { erewrite result_has_shape_length by eauto. reflexivity. } - rewrite <- skipn_rev. simpl. - rewrite <- truncl_list_skipn. eauto. + rewrite <- skipn_rev. simpl. eauto. eapply forall_result_has_shape. eapply Forall_app. split. eapply forall_firstn. eapply result_has_shape_forall. eauto. @@ -1578,14 +1576,13 @@ Proof. rewrite rev_app_distr. rewrite truncl_list_app. 2: { rewrite length_rev. simpl. rewrite repeat_length. lia. } - rewrite truncl_list_skipn. rewrite skipn_all2. 2: { rewrite length_rev. simpl. rewrite repeat_length. lia. } replace m with (length l). 2: { erewrite result_has_shape_length by eauto. reflexivity. } simpl. rewrite <- skipn_rev. simpl. - rewrite <- truncl_list_skipn. eauto. apply Hrdx. + eauto. apply Hrdx. eapply forall_result_has_shape. eapply Forall_app. split. eapply forall_firstn. eapply result_has_shape_forall. eauto. @@ -1662,7 +1659,7 @@ Proof. eapply Hnondstr; eauto. } eapply well_formed_reindexer_truncl. - rewrite <- truncl_list_skipn. eauto. simpl. + eauto. simpl. eapply forall_result_has_shape. eapply Forall_app. split. simpl. eapply Forall_repeat. eapply result_has_shape_gen_pad. @@ -1683,7 +1680,7 @@ Proof. rewrite min_l by lia. eapply well_formed_allocation_truncl. - erewrite <- truncl_list_skipn. eauto. apply Hrdx. + eauto. apply Hrdx. simpl. eapply forall_result_has_shape. eapply Forall_app. split. simpl. eapply Forall_repeat. eapply result_has_shape_gen_pad. diff --git a/src/verified_lowering/proof/Pad.v b/src/verified_lowering/proof/Pad.v index 52542cd..1cd2750 100644 --- a/src/verified_lowering/proof/Pad.v +++ b/src/verified_lowering/proof/Pad.v @@ -25,7 +25,7 @@ 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 := @@ -1228,6 +1228,7 @@ Proof. rewrite <- gen_pad_filter_until_0. apply relate_pads_filter_until_0. apply result_has_shape_gen_pad. + rewrite Nat.add_0_r. apply relate_pads_gen_pad_id. + cbv [eval_Zexpr_Z_total] in *. apply eval_Zexpr_Z_eval_Zexpr in H3. rewrite H3 in *. @@ -1285,9 +1286,9 @@ Proof. 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. @@ -1301,7 +1302,7 @@ Proof. 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''. @@ -1311,19 +1312,19 @@ Proof. simpl in *; discriminate. cases n. simpl in Hsh''. - cases (n0 * m0). lia. + cases (n0 * m0). lia. simpl in Hsh''. invert Hsh''. cases (n0 * m0). lia. simpl in Hsh''. invert Hsh''. clear Hsh'. rewrite <- Heq in *. clear Heq. clear n. - + eapply IHeval_expr in Hsize. 3: { eauto. } 3: { eauto. } 2: { eauto. } - + simpl in Hsize. invs. rewrite <- gen_pad_cons in *. @@ -1354,7 +1355,7 @@ Proof. { 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. @@ -1467,7 +1468,7 @@ Proof. 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. } @@ -1495,7 +1496,7 @@ Proof. 2: { eapply forall_firstn. eapply forall_skipn. 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. } @@ -1505,7 +1506,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. } @@ -1528,7 +1529,7 @@ 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. @@ -1589,7 +1590,7 @@ Proof. eapply relate_pads_filter_until_0; eauto. * rewrite <- Heq. replace (n0 - y - (n0 - y - Datatypes.S r)) with - (Datatypes.S r) by lia. + (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. @@ -1720,7 +1721,7 @@ Proof. rewrite HHH in HHHH. 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 kz - 1)) by lia. unfold nat_range. simpl. @@ -1795,7 +1796,7 @@ Proof. remember (Z.to_nat kz) as kk. cbn [length] in *. remember (Datatypes.S (length l)) as mm. - rewrite map_rev. + rewrite map_rev. cases (mm mod kk). 2: { (* k does not divide m *) rewrite <- Heq. @@ -1810,7 +1811,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. } @@ -1864,7 +1865,7 @@ Proof. - replace (kk * (mm / kk)) with (length (r0::l) - (length (r0::l) - (kk * (mm / kk)))). 2: { rewrite sub_sub_distr. - lia. simpl length. rewrite <- Heqmm. + 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 <- Heqmm. @@ -1888,7 +1889,7 @@ 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 <- Heqmm. rewrite (min_l (mm-c)) by lia. @@ -1933,9 +1934,9 @@ 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 min_l. 2: { eapply mod_0_iff_ceil_eq_floor_0 in Heq. rewrite Heq. @@ -1983,14 +1984,14 @@ Proof. rewrite (mul_comm (mm/kk) kk). rewrite <- H17. 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 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. } @@ -2038,7 +2039,7 @@ Proof. exfalso. 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 H3. } @@ -2050,7 +2051,7 @@ 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 kz)) in H0. + 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. @@ -2104,21 +2105,21 @@ Proof. rewrite @skipn_repeat in *. rewrite @firstn_repeat in *. cbn [length] in *. rewrite min_r in * by lia. cases l0. rewrite min_0_l. rewrite sub_0_l. - rewrite min_0_r. constructor. + rewrite min_0_r. constructor. eapply Forall_repeat. invert H13. cases n1. invert H3. lia. invert H3. eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. rewrite <- H19. eapply result_has_shape_gen_pad. - rewrite <- H19. eauto. } + rewrite <- H19. eauto. } eauto. } - + (* last part of split *) 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. + 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 *) @@ -2127,7 +2128,7 @@ Proof. (c + (kk - mm mod kk) mod kk) kk). lia. } subst n0. - + cases (mm mod kk). - (* kk divides mm *) rewrite sub_0_r in *. rewrite mod_same in * by lia. @@ -2137,8 +2138,8 @@ Proof. simpl repeat. rewrite app_nil_r. rewrite <- map_rev. rewrite skipn_map. rewrite firstn_map. unfold nat_range. - replace (skipn (c / kk) (rev (nat_range_rec (mm / kk) 0))) with - (rev (nat_range_rec (mm / kk - c / kk) 0)). + replace (skipn (c / kk) (rev (seq 0 (mm / kk)))) with + (rev (seq 0 (mm / kk - c / kk))). 2: { rewrite skipn_rev. rewrite length_nat_range_rec. rewrite firstn_nat_range_rec. rewrite min_l. reflexivity. lia. } @@ -2168,7 +2169,7 @@ Proof. repeat rewrite length_rev. rewrite length_skipn. 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 @@ -2213,10 +2214,10 @@ Proof. 2: { eapply mod_le. lia. } rewrite sub_diag. econstructor. lia. unfold not. intros. eapply mod_0_iff_ceil_eq_floor_0 in H7. lia. 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. @@ -2236,7 +2237,7 @@ Proof. 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). @@ -2319,7 +2320,7 @@ Proof. 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). @@ -2365,7 +2366,7 @@ Proof. 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 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. @@ -2481,7 +2482,7 @@ Proof. eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. rewrite <- H14. - erewrite <- result_has_shape_filter_until_0. eauto. + erewrite <- result_has_shape_filter_until_0. eauto. rewrite <- H14. eapply relate_pads_filter_until_0. eauto. eauto. eauto. auto. @@ -2626,7 +2627,7 @@ Proof. eapply div_small_iff in Heq2. 2: { lia. } rewrite mod_small in H16 by lia. lia. - + rewrite min_l by 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. } @@ -2664,10 +2665,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. @@ -2687,10 +2688,10 @@ 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. + rewrite length_rev. simpl length. rewrite <- Heqmm. rewrite rev_app_distr. rewrite skipn_app. rewrite length_rev. rewrite length_firstn. @@ -2702,7 +2703,7 @@ Proof. 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) <= @@ -2751,7 +2752,7 @@ Proof. rewrite length_rev. rewrite length_firstn. 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. @@ -2817,7 +2818,7 @@ 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.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 H7. @@ -2881,7 +2882,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. @@ -2989,7 +2990,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. @@ -3031,7 +3032,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)). @@ -3063,7 +3064,7 @@ 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. @@ -3075,7 +3076,7 @@ Proof. rewrite <- H14. erewrite <- result_has_shape_filter_until_0. eauto. erewrite <- H14. eapply relate_pads_filter_until_0. - eauto. eauto. lia. + eauto. eauto. lia. } rewrite <- Heq2. rewrite add_sub_swap. @@ -3103,7 +3104,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 <- Heqmm. 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. @@ -3112,13 +3113,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. @@ -3128,7 +3129,7 @@ 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. @@ -3189,7 +3190,7 @@ Proof. invert Hpad. simpl in Hbds. invs. - eq_eval_Z. + eq_eval_Z. eq_size_of. @@ -3208,7 +3209,7 @@ Proof. 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. @@ -3223,7 +3224,7 @@ Proof. 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. intros. apply H18. lia. @@ -3232,7 +3233,7 @@ Proof. cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. eq_size_of. intros. apply H21. lia. lia. - + cbv [eval_Zexpr_Z_total]. simpl. rewrite Hloz, Hhiz. lia. } cases l. @@ -3254,7 +3255,7 @@ Proof. eauto. eauto. eauto. eauto. eauto. eapply size_of_eval_expr_result_has_shape; eauto. } - + eapply IHeval_expr2 in Hsh'; clear IHeval_expr2. 2,3: eassumption. 2: { apply eval_Zexpr_Z_eval_Zexpr in Hloz, Hhiz. @@ -3262,8 +3263,8 @@ Proof. 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 *. propositional. @@ -3283,7 +3284,7 @@ Proof. eapply relate_pads_gen_pad. eapply IHeval_expr1. eapply H21. lia. lia. eauto. - eauto. eauto. + eauto. eauto. eauto. eauto. eapply size_of_eval_expr_result_has_shape; eauto. @@ -3359,10 +3360,10 @@ Proof. simpl. split. econstructor. eapply IHeval_expr1. invs. eauto. - eapply H18. 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 @@ -3408,7 +3409,7 @@ Proof. 2: { apply eval_Zexpr_Z_eval_Zexpr in Hhiz, Hloz. econstructor; eauto. } simpl in Hsh'. invs. eauto. eapply Forall_app. split. eauto. - + cases (rr - length l). 2: lia. simpl. eauto. * (* 0 < c *) @@ -3447,7 +3448,7 @@ Proof. eapply relate_pads_gen_pad. eapply IHeval_expr1. eauto. eapply H21. lia. lia. eauto. eauto. - eauto. eauto. eauto. + eauto. eauto. eauto. eapply size_of_eval_expr_result_has_shape; eauto. constructor. rewrite firstn_nil. split; eauto. @@ -3462,7 +3463,7 @@ Proof. 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 H8. invs. @@ -3485,7 +3486,7 @@ Proof. eapply size_of_eval_expr_result_has_shape; eauto. constructor. simpl length in *. - + simpl in H5. assert (length l = Z.to_nat (hiz - loz - 1) -1) by lia. rewrite skipn_all2. @@ -3583,7 +3584,7 @@ Proof. 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 *. lia. } eapply IHeval_expr2 in Hsh'; eauto. @@ -3592,7 +3593,7 @@ Proof. 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. @@ -3681,7 +3682,7 @@ Proof. 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 *) simpl in *. @@ -3706,13 +3707,13 @@ Proof. simpl in H1. eapply result_has_shape_length in H1. rewrite repeat_length in H1. subst. - + eapply relate_pads_filter_until_0. eapply result_has_shape_filter_until_0. rewrite gen_pad_filter_until_0. rewrite <- Hsize'. apply result_has_shape_gen_pad. - + rewrite Hsize'. eapply relate_pads_filter_until_0. eapply result_has_shape_gen_pad. @@ -3725,15 +3726,15 @@ Proof. 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 *) invert Hsize. eq_size_of. invert Hpad. simpl in *. invs. - eq_size_of. + eq_size_of. 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. } @@ -3742,7 +3743,7 @@ Proof. eapply IHeval_expr2; eauto. { intros. cases (x0 ==v x); subst. - + rewrite lookup_add_eq in * by auto. invs. + + rewrite lookup_add_eq in * by auto. invs. erewrite result_has_shape_result_shape_nat. 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. @@ -3754,7 +3755,7 @@ Proof. 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. } @@ -3762,7 +3763,7 @@ Proof. eapply result_has_shape_app_l in Hsh''. 2: { reflexivity. } pose proof Hsize1 as Hsh1. pose proof Hsize2 as Hsh2. - + 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. @@ -3776,14 +3777,14 @@ Proof. pose proof Hsh1 as Hlen1. pose proof Hsh2 as Hlen2. eapply result_has_shape_length in Hlen1,Hlen2. 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. } { cbn -[Nat.sub] in *. - invs'. + invs'. eapply IHeval_expr2 in Hsh2; eauto. cbn -[Nat.sub] in *. invs. replace x with 0 in * by lia. @@ -3807,7 +3808,7 @@ Proof. 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 Hsh2'''. - eapply result_has_shape_forall in Hsh2'''. + eapply result_has_shape_forall in Hsh2'''. eapply relate_pads_filter_until_0. eapply Forall_rev in Hsh2'''. eapply forall_skipn in Hsh2'''. eapply forall_firstn in Hsh2'''. @@ -3823,7 +3824,7 @@ Proof. 2: { eassumption. } eauto. eauto. } - { simpl in *. rewrite app_nil_r in *. + { 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. @@ -3839,7 +3840,7 @@ Proof. 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 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. @@ -3904,8 +3905,8 @@ Proof. eapply Forall_forall in H. 2: eassumption. eauto. eauto. - - + + rewrite skipn_app. rewrite firstn_app. rewrite length_skipn. rewrite length_rev. replace (r2 - (Datatypes.length (r0 :: l2) - b)) with 0 by lia. @@ -3974,7 +3975,7 @@ Proof. 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. } @@ -3982,7 +3983,7 @@ Proof. 2: { eauto. } 2: { inversion 1. } 2: { eauto. } - + rewrite <- gen_pad_cons in *. cases m. { simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } @@ -3995,28 +3996,28 @@ Proof. 2: { invert Hsize'. lia. } 2: { invert Hsize'. lia. } 2: { invert Hsize'. lia. } - + erewrite firstn_transpose_result_list; eauto. 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 Hsize'. lia. } 2: { invert Hsize'. lia. } erewrite Forall_map. - invert Hsize'. + invert Hsize'. simpl in H9. cases rsh. invert H9. cases n. invert H9. invert H9. - + split. { eapply Forall_forall. intros ? H5. eapply In_nat_range in H5. - rewrite add_0_r. + rewrite add_0_r. erewrite <- (firstn_skipn x (r0::l)). erewrite get_col_app. 2: { eapply forall_result_has_shape. @@ -4106,7 +4107,7 @@ Proof. eapply forall_firstn. eapply forall_skipn. eapply Forall_rev. econstructor; eauto. rewrite length_firstn. rewrite length_skipn. - rewrite length_rev. simpl. reflexivity. } + rewrite length_rev. simpl. reflexivity. } erewrite (forall_get_col_relate_pads_gen_pad (rev (firstn r (skipn y (rev (r0 :: l)))))). 4: { eapply forall_result_has_shape. @@ -4118,7 +4119,7 @@ Proof. 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)). @@ -4393,7 +4394,7 @@ Proof. unfold transpose_result in Hsh. invert Hsh. eapply size_of_includes in Hsize'. 2: apply empty_includes. eapply size_of_eval_expr_result_has_shape in Hsize'; eauto. - + pose proof Hsize' as Hsh'. eapply result_has_shape_transpose_result in Hsh'. pose proof Hsh' as Hsh'''. pose proof Hsh as Hsh''. @@ -4421,7 +4422,7 @@ Proof. 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. } @@ -4429,7 +4430,7 @@ Proof. 2: { eauto. } 2: { inversion 1. } 2: { eauto. } - + rewrite <- gen_pad_cons in *. split. auto. split. auto. cases m. @@ -4443,23 +4444,23 @@ Proof. 2: { invert Hsize'. lia. } 2: { invert Hsize'. lia. } 2: { invert Hsize'. lia. } - + erewrite firstn_transpose_result_list; eauto. 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 Hsize'. lia. } 2: { invert Hsize'. lia. } erewrite Forall_map. - invert Hsize'. + invert Hsize'. simpl in H7. cases rsh. invert H7. cases n. invert H7. invert H7. - + split. { eapply Forall_forall. intros ? H6. @@ -4609,8 +4610,6 @@ Proof. eapply result_has_shape_rev in Hsh'. rewrite rev_involutive in 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 kz) in Hsh''. eapply result_has_shape_result_shape_nat in Hsh',Hsh''. @@ -4638,7 +4637,7 @@ Proof. eapply H in Hm. rewrite Hm. simpl. repeat rewrite skipn_nil. repeat rewrite firstn_nil. eauto. } simpl in *. invert Hsh''. - + rewrite rev_involutive. pose proof Hsize' as Hsize''. eapply IHeval_expr in Hsize'. @@ -4647,7 +4646,6 @@ Proof. 2: eauto. 2: eauto. simpl in *. invs. - rewrite truncl_list_skipn. rewrite gen_pad_filter_until_0. rewrite H4. rewrite <- gen_pad_filter_until_0. @@ -4707,7 +4705,7 @@ Proof. 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. @@ -4715,8 +4713,6 @@ Proof. pose proof Hsh as Hsh'. eapply result_has_shape_rev in 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 kz) in Hsh''. eapply result_has_shape_rev in Hsh''. @@ -4751,7 +4747,6 @@ Proof. 2: eauto. 2: eauto. simpl in Hsize''. invs. - rewrite truncl_list_skipn in *. rewrite gen_pad_filter_until_0. rewrite H4. @@ -4809,7 +4804,7 @@ Proof. 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. @@ -4838,7 +4833,7 @@ Proof. 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 Hsize as Hsize'. @@ -4874,7 +4869,7 @@ Proof. 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. @@ -4930,7 +4925,7 @@ Proof. 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]. @@ -4951,7 +4946,7 @@ Proof. eapply relate_pads_filter_until_0. eapply result_has_shape_gen_pad. eapply relate_pads_gen_pad_id. } - + invs'. rename H6 into Hsize. rename H4 into Hk. pose proof Hk as Hk'. @@ -4959,9 +4954,9 @@ Proof. 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 Hsize as Hsize'. eapply size_of_includes in Hsize'. 2: apply empty_includes. eapply size_of_eval_expr_result_has_shape in Hsize'; eauto. @@ -5018,7 +5013,7 @@ Proof. rewrite <- gen_pad_filter_until_0. auto. eauto. - split. + split. eapply Forall_app. split. eauto. eapply forall_firstn. cases (Z.to_nat kz). econstructor. diff --git a/src/verified_lowering/proof/Range.v b/src/verified_lowering/proof/Range.v index 7f08742..85d2e89 100644 --- a/src/verified_lowering/proof/Range.v +++ b/src/verified_lowering/proof/Range.v @@ -24,13 +24,7 @@ Fixpoint zrange' lo range := Definition zrange lo hi := zrange' lo (Z.to_nat (hi-lo)%Z). -Fixpoint nat_range_rec k x := - match k with - | 0 => [] - | Datatypes.S n => x::(nat_range_rec n (x+1)) - end. - -Definition nat_range k := nat_range_rec k 0. +Definition nat_range k := seq 0 k. Lemma map_zrange'_shift_1 {X} : forall k lo (f : Z -> X), map f (zrange' (lo+1)%Z k) = @@ -118,22 +112,18 @@ Proof. Qed. Lemma succ_nat_range_rec_app_end : forall n k, - nat_range_rec (Datatypes.S n) k = ((nat_range_rec n k) ++ [n+k])%list. + seq k (Datatypes.S n) = ((seq k n) ++ [n+k])%list. Proof. - induct n; intros. - - reflexivity. - - simpl in *. f_equal. - rewrite IHn. f_equal. f_equal. lia. + intros. rewrite seq_S. f_equal. f_equal. lia. Qed. Lemma map_nat_range_rec_extensionality {X} : forall n k (f g : nat -> X), - (forall x, k <= x < n + k-> f x = g x) -> - map f (nat_range_rec n k) = map g (nat_range_rec n k). + (forall x, k <= x < n + k -> f x = g x) -> + map f (seq k n) = map g (seq k n). Proof. - induct n; intros. - - reflexivity. - - simpl. f_equal. eapply H. lia. - eapply IHn. intros. eapply H. lia. + intros ? ? ? ? H. apply map_ext_in. + intros i Hi. apply in_seq in Hi. + apply H. lia. Qed. Lemma map_nat_range_extensionality {X} : forall n (f g : nat -> X), @@ -153,11 +143,9 @@ Proof. Qed. Lemma length_nat_range_rec : forall n k, - length (nat_range_rec n k) = n. + length (seq k n) = n. Proof. - induct n; intros. - - reflexivity. - - simpl. rewrite IHn. lia. + intros. apply length_seq. Qed. Lemma no_dup_map2_cons_concat : forall a l, @@ -202,26 +190,20 @@ Proof. Qed. Lemma range_nat_range_rec : forall k n x, - In x (nat_range_rec k n) -> + In x (seq n k) -> n <= x < n + k. Proof. - induct k; intros. - - simpl in *. propositional. - - simpl in *. propositional. - + lia. - + subst. lia. - + eapply IHk in H0. lia. - + eapply IHk in H0. lia. + apply in_seq. Qed. Lemma zrange'_nat_range_rec : forall n k, (0 <= k)%Z -> - zrange' k n = map Z.of_nat (nat_range_rec n (Z.to_nat k)). + zrange' k n = map Z.of_nat (seq (Z.to_nat k) n). Proof. induct n; intros. - reflexivity. - simpl. f_equal. lia. - replace (Z.to_nat k + 1) with (Z.to_nat (k+1))%Z by lia. + replace (S (Z.to_nat k)) with (Z.to_nat (k+1))%Z by lia. eapply IHn. lia. Qed. @@ -237,7 +219,7 @@ Qed. Lemma eq_zrange'_nat_range_rec : forall x y, x = y -> - zrange' 0 x = map Z.of_nat (nat_range_rec y 0). + zrange' 0 x = map Z.of_nat (seq 0 y). Proof. induct x; propositional; subst. - reflexivity. @@ -274,11 +256,11 @@ Proof. + left. eapply IHn. lia. Qed. -Lemma In_zrange : forall x n, - In x (zrange 0 n) <-> - (0 <= x < n)%Z. +Lemma In_zrange : forall x min max, + In x (zrange min max) <-> + (min <= x < max)%Z. Proof. - unfold zrange. intros. rewrite Z.sub_0_r in *. + unfold zrange. intros. split; intros. eapply In_zrange' in H. lia. eapply In_zrange'. lia. @@ -286,23 +268,12 @@ Qed. Lemma In_nat_range_rec : forall n k x, - In x (nat_range_rec n k) <-> + In x (seq k n) <-> k <= x < n + k. Proof. - induct n; intros; split; intros. - - invert H. - - lia. - - rewrite succ_nat_range_rec_app_end in *. - eapply in_app_or in H. - simpl in *. invert H. - + eapply IHn in H0. lia. - + invert H0. 2: contradiction. - lia. - - rewrite succ_nat_range_rec_app_end in *. - eapply in_or_app. simpl. - assert (n + k = x \/ n + k <> x) by lia. invert H0. - + propositional. - + left. eapply IHn. lia. + split; intros H. + - apply in_seq in H. lia. + - apply in_seq. lia. Qed. Lemma In_nat_range : @@ -317,7 +288,7 @@ Proof. Qed. Lemma map_nat_range_rec_shift {X} : forall n k (f : nat -> X), - map f (nat_range_rec n k) = + map f (seq k n) = map (fun x => f (x+k)) (nat_range n). Proof. induct n; intros. @@ -327,7 +298,7 @@ Proof. Qed. Lemma skipn_rev_nat_range_rec : forall n k c, - skipn c (rev (nat_range_rec n k)) = rev (nat_range_rec (n-c) k). + skipn c (rev (seq k n)) = rev (seq k (n-c)). Proof. induct n; intros. - simpl. rewrite skipn_nil. reflexivity. @@ -339,8 +310,8 @@ Proof. Qed. Lemma firstn_nat_range_rec : forall n k c, - firstn c (nat_range_rec n k) = - nat_range_rec (min c n) k. + firstn c (seq k n) = + seq k (min c n). Proof. induct n; intros. - simpl. rewrite firstn_nil. rewrite min_0_r. reflexivity. @@ -351,8 +322,7 @@ Proof. Qed. Lemma skipn_nat_range_rec : forall n k c, - skipn c (nat_range_rec n k) = - nat_range_rec (n-c) (k+c). + skipn c (seq k n) = seq (k+c) (n-c). Proof. induct n; intros. - simpl. rewrite skipn_nil. reflexivity. @@ -362,8 +332,7 @@ Proof. Qed. Lemma skipn_nat_range : forall n c, - skipn c (nat_range n) = - nat_range_rec (n-c) c. + skipn c (nat_range n) = seq c (n-c). Proof. unfold nat_range. intros. rewrite skipn_nat_range_rec. reflexivity. Qed. @@ -386,8 +355,8 @@ Proof. Qed. Lemma firstn_rev_nat_range_rec : forall n k c, - firstn k (rev (nat_range_rec n c)) = - rev (nat_range_rec (min k n) (c+(n-k))). + firstn k (rev (seq c n)) = + rev (seq (c+(n-k)) (min k n)). Proof. induct n; intros. - simpl. rewrite min_0_r. rewrite firstn_nil. reflexivity. @@ -407,7 +376,7 @@ Qed. Lemma nth_error_nat_range_rec : forall n k x, x < n -> - nth_error (nat_range_rec n k) x = Some (k+x). + nth_error (seq k n) x = Some (k+x). Proof. induct n; intros. - lia. @@ -415,3 +384,41 @@ Proof. simpl. rewrite IHn by lia. f_equal. lia. Qed. +Lemma length_zrange min max : + length (zrange min max) = Z.to_nat (max - min). +Proof. + cbv [zrange]. rewrite length_zrange'. reflexivity. +Qed. + +Lemma zrange'_seq x n start : + zrange' x n = map (fun y => x + Z.of_nat y - Z.of_nat start)%Z (seq start n). +Proof. + revert x start. induction n; simpl; auto. intros. f_equal; [lia|]. erewrite IHn. + apply map_ext. lia. +Qed. + +Lemma zrange_seq min max : + zrange min max = map (fun y => min + Z.of_nat y)%Z (seq O (Z.to_nat (max - min))). +Proof. + cbv [zrange]. erewrite zrange'_seq. apply map_ext. lia. +Qed. + +Lemma nth_error_seq_Some n1 n2 n3 n4 : + nth_error (seq n1 n2) n3 = Some n4 -> + n4 = n1 + n3. +Proof. + revert n1 n3 n4. induction n2; intros n1 n3 n4 H; simpl in *. + - destruct n3; discriminate H. + - destruct n3; simpl in H. + + invert H. lia. + + apply IHn2 in H. lia. +Qed. + +Lemma nth_error_zrange_Some min max n x : + nth_error (zrange min max) n = Some x -> + x = (min + Z.of_nat n)%Z. +Proof. + rewrite zrange_seq, nth_error_map. intros H. + destruct (nth_error _ _) eqn:E; simpl in H; try discriminate H. + apply nth_error_seq_Some in E. subst. invert H. lia. +Qed. diff --git a/src/verified_lowering/proof/Result.v b/src/verified_lowering/proof/Result.v index c54088f..761703d 100644 --- a/src/verified_lowering/proof/Result.v +++ b/src/verified_lowering/proof/Result.v @@ -79,6 +79,30 @@ Inductive result_has_shape : result -> list nat -> Prop := Forall (fun r => result_has_shape r xs_shape) xs -> result_has_shape (V (x::xs)) (Datatypes.S l::xs_shape). +Inductive result_has_shape' : list nat -> result -> Prop := +| ScalarShape' s : result_has_shape' [] (Result.S s) +| VectorShape' xs n sh : + n = length xs -> + Forall (result_has_shape' sh) xs -> + result_has_shape' (n :: sh) (V xs). + +Lemma result_has_shape'_iff r sh : + result_has_shape' sh r <-> result_has_shape r sh. +Proof. + revert sh. induction r. + - intros sh. split; intros H; invert H; constructor. + - intros sh. split; intros H'; invert H'. + + destruct v. + -- constructor. + -- invert H3. invert H. simpl. constructor; auto. 1: apply H3; assumption. + eapply Forall_impl. 2: apply Forall_and; [apply H4|apply H5]. simpl. + intros ? (?&H'). edestruct H'. eauto. + + constructor; auto. + + constructor; auto. invert H. constructor. 1: apply H4; assumption. + eapply Forall_impl. 2: apply Forall_and; [apply H3|apply H5]. simpl. + intros ? (?&H'). edestruct H'. eauto. +Qed. + Fixpoint result_shape_nat r := match r with | S _ => [] @@ -113,6 +137,44 @@ with add_list : list result -> list result -> list result -> Prop := Scheme add_result_mut := Induction for add_result Sort Prop with add_list_mut := Induction for add_list Sort Prop. +Definition add_scalar_result' (x y : scalar_result) := + match x, y with + | SX, SX => SX + | SX, SS sy => SS sy + | SS sx, SX => SS sx + | SS sx, SS sy => SS (sx + sy) + end. + +Lemma add_scalar_result_iff_add_scalar_result' a b c : + add_scalar_result' a b = c <-> add_scalar_result a b c. +Proof. + split. + - intros. subst. destruct a, b; constructor. + - intros H. invert H; reflexivity. +Qed. + +Fixpoint add_result' x y := + match x, y with + | V xs, V ys => V (map2 add_result' xs ys) + | Result.S x0, Result.S y0 => Result.S (add_scalar_result' x0 y0) + | _, _ => V [] + end. + +Lemma add_result_add_result' sz x y : + result_has_shape' sz x -> + result_has_shape' sz y -> + add_result x y (add_result' x y). +Proof. + revert x y. induction sz; simpl; invert 1; invert 1; simpl. + - constructor. destruct s, s0; constructor. + - constructor. + (*i really wish add_list was forall3 something; i don't want to do induction here*) + revert xs0 H2 H5. induction H4; intros xs0 H2 H5. + + destruct xs0; [|discriminate H2]. constructor. + + destruct xs0; [discriminate H2|]. simpl in H2, H5. invert H5. invert H2. + simpl. constructor; auto. +Qed. + Fixpoint gen_pad sh := match sh with | x::xs => V (List.repeat (gen_pad xs) x) @@ -139,7 +201,7 @@ Definition row_length (l : list result) := match l with | V v::xss => length v | _ => 0 - end. + end. Fixpoint transpose_result_list (l : list result) (n : nat) := match n with @@ -234,7 +296,7 @@ Lemma result_has_shape_result_shape_Z : forall r l, result_shape_Z r = map Z.of_nat (filter_until l 0). Proof. intros. - unfold result_shape_Z. + unfold result_shape_Z. eapply result_has_shape_result_shape_nat in H. rewrite H. reflexivity. Qed. @@ -475,7 +537,7 @@ Lemma length_get_col : forall l n k m xs, length (get_col l n) = length l. Proof. induct l; intros. - - reflexivity. + - reflexivity. - simpl. invert H. cases a. invert H6. cases (nth_error v n). + simpl. f_equal. cases l. reflexivity. @@ -497,7 +559,7 @@ Proof. eapply result_has_shape_gen_pad. specialize (IHk l). invert IHk. eauto. econstructor. eauto. eauto. -Qed. +Qed. Lemma forall_result_has_shape : forall sh l k, (Forall (fun r => result_has_shape r sh) l) -> @@ -541,7 +603,7 @@ Lemma result_has_shape_transpose_result_list : forall k v l n m xs, Proof. induct k; intros. - simpl. econstructor. - - simpl. invert H0. cases v. invert H6. + - simpl. invert H0. cases v. invert H6. cases (nth_error v (length v - Datatypes.S k)). + econstructor. rewrite length_transpose_result_list. reflexivity. pose proof Heq. @@ -580,6 +642,97 @@ Proof. reflexivity. Qed. +Lemma split_result_length_helper T k x0 l0 (x : T) : + 0 < k -> + x0 < Datatypes.length l0 //n k -> + k = + length + (firstn k + (skipn (k * x0) + (l0 ++ + repeat x ((k - Datatypes.length l0 mod k) mod k)))). +Proof. + rewrite skipn_app. rewrite firstn_app. + rewrite length_skipn. rewrite skipn_repeat. + rewrite firstn_repeat. cbn [length]. + rewrite length_app. rewrite length_firstn. + rewrite length_skipn. rewrite repeat_length. + simpl length. + remember (length l0) as q. clear Heqq. + + intros H H2. + cases (q mod k). + - rewrite sub_0_r. rewrite Div0.mod_same by lia. rewrite sub_0_l. + rewrite min_0_l. rewrite add_0_r. + pose proof Heq. eapply Div0.div_exact in Heq. + rewrite Heq. rewrite <- mul_sub_distr_l. + pose proof H0. + rewrite mod_0_iff_ceil_eq_floor_0 in H0 by lia. + rewrite H0 in H2. pose proof H1. + cases (q / k - x0). lia. + rewrite min_l. reflexivity. + rewrite mul_comm. simpl. eapply le_add_r. + - cases (q //n k - q / k). + + eapply mod_0_iff_ceil_sub_floor_0 in Heq0. lia. lia. + + pose proof (ceil_sub_floor_le_1 q k). + assert (n0 = 0) by lia. subst. + assert (x0 = q / k \/ + x0 < q / k) by lia. + invert H1. + * rewrite <- Div0.mod_eq by lia. + rewrite min_r. + 2: { pose proof (Nat.mod_upper_bound q k). + lia. } + replace (k * (q / k) - q) with 0. + 2: { pose proof (Div0.mul_div_le q k). lia. } + rewrite sub_0_r. rewrite Heq. + rewrite min_l. + 2: { eapply Div0.mod_le. } + rewrite <- Heq. + + unfold modulo. unfold modulo in Heq. cases k. lia. + pose proof (divmod_spec q k 0 k). + cases (divmod q k 0 k). + assert (k<=k) by lia. propositional. + rewrite mul_0_r in *. rewrite add_0_r in *. + rewrite sub_diag in *. rewrite add_0_r in *. + simpl. simpl in Heq. rewrite Heq. simpl. + f_equal. + pose proof (divmod_spec (k - n) k 0 k). + cases (divmod (k - n) k 0 k). propositional. simpl. + rewrite sub_diag in *. rewrite mul_0_r in *. + repeat rewrite add_0_r in *. + assert (k - (k-n3) = n ->k = n + (k - n3)). lia. + apply H6. + rewrite sub_sub_distr by lia. + rewrite sub_diag. simpl. clear H6. + assert (Datatypes.S k * n2 + (k - n3) <= k) by lia. + pose proof H6. eapply le_add_le_sub_r in H8. + assert (k - (k-n3) <= k) by lia. + assert (Datatypes.S k * n2 <= k) by lia. + cases n2. + 2: { remember (Datatypes.S k). rewrite mul_comm in H10. + simpl in H10. subst. lia. } + rewrite mul_0_r in H4. simpl in H4. lia. + * erewrite (Nat.div_mod_eq q k). + rewrite add_sub_swap. + 2: { eapply mul_le_mono_l. lia. } + rewrite <- mul_sub_distr_l. + rewrite min_l. + 2: { cases (q / k - x0). + lia. rewrite mul_comm. simpl. + rewrite <- add_assoc. eapply le_add_r. } + repeat rewrite sub_add_distr. + rewrite <- mul_sub_distr_l. + cases (x0 - q / k). + 2: lia. rewrite mul_0_r. rewrite sub_0_l. rewrite sub_0_r. + replace k with (k*1) at 5 by lia. + rewrite <- mul_sub_distr_l. + replace (1 - (q / k - x0)) with 0 by lia. + rewrite mul_0_r. rewrite sub_0_l. + rewrite min_0_r. lia. +Qed. + Lemma result_has_shape_split_result : forall l k n sh, 0 < k -> result_has_shape (V l) (n :: sh) -> @@ -590,11 +743,6 @@ Proof. rewrite div_small by lia. simpl. econstructor. - unfold split_result. remember sub. simpl. invert H0. rewrite app_comm_cons. - erewrite map_nat_range_extensionality. - 2: { intros. rewrite skipn_app. rewrite firstn_app. - rewrite length_skipn. rewrite skipn_repeat. - rewrite firstn_repeat. simpl length. - reflexivity. } eapply forall_result_has_shape. 2: { rewrite length_map. unfold nat_range. rewrite length_nat_range_rec. reflexivity. } @@ -603,83 +751,14 @@ Proof. eapply in_map_iff in H0. invs. eapply In_nat_range in H2. eapply forall_result_has_shape. - 2: { rewrite length_app. rewrite length_firstn. - rewrite length_skipn. rewrite repeat_length. - simpl length. - cases (Datatypes.S (Datatypes.length l) mod k). - - rewrite sub_0_r. rewrite Div0.mod_same by lia. rewrite sub_0_l. - rewrite min_0_l. rewrite add_0_r. - pose proof Heq. eapply Div0.div_exact in Heq. - rewrite Heq. rewrite <- mul_sub_distr_l. - pose proof H0. - rewrite mod_0_iff_ceil_eq_floor_0 in H0 by lia. - rewrite H0 in H2. pose proof H1. - cases (Datatypes.S (Datatypes.length l) / k - x0). lia. - rewrite min_l. reflexivity. - rewrite mul_comm. simpl. eapply le_add_r. - - cases (Datatypes.S (length l) //n k - Datatypes.S (length l) / k). - + eapply mod_0_iff_ceil_sub_floor_0 in Heq0. lia. lia. - + pose proof (ceil_sub_floor_le_1 (Datatypes.S (length l)) k). - assert (n0 = 0) by lia. subst. - assert (x0 = Datatypes.S (Datatypes.length l) / k \/ - x0 < Datatypes.S (Datatypes.length l) / k) by lia. - invert H1. - * rewrite <- Div0.mod_eq by lia. - rewrite min_r. - 2: { pose proof (Nat.mod_upper_bound - (Datatypes.S (Datatypes.length l)) k). - lia. } - replace (k * (Datatypes.S (length l) / k) - - Datatypes.S (length l)) with 0. - 2: { pose proof (Div0.mul_div_le - (Datatypes.S (length l)) k). lia. } - rewrite sub_0_r. rewrite Heq. - rewrite min_l. - 2: { eapply Div0.mod_le. } - rewrite <- Heq. - - unfold modulo. unfold modulo in Heq. cases k. lia. - pose proof (divmod_spec(Datatypes.S (Datatypes.length l)) k 0 k). - cases (divmod (Datatypes.S (Datatypes.length l)) k 0 k). - assert (k<=k) by lia. propositional. - rewrite mul_0_r in *. rewrite add_0_r in *. - rewrite sub_diag in *. rewrite add_0_r in *. - simpl. simpl in Heq. rewrite Heq. simpl. - f_equal. - pose proof (divmod_spec (k - n) k 0 k). - cases (divmod (k - n) k 0 k). propositional. simpl. - rewrite sub_diag in *. rewrite mul_0_r in *. - repeat rewrite add_0_r in *. - assert (k - (k-n3) = n ->k = n + (k - n3)). lia. - apply H8. - rewrite sub_sub_distr by lia. - rewrite sub_diag. simpl. clear H8. - assert (Datatypes.S k * n2 + (k - n3) <= k) by lia. - pose proof H8. eapply le_add_le_sub_r in H10. - assert (k - (k-n3) <= k) by lia. - assert (Datatypes.S k * n2 <= k) by lia. - cases n2. - 2: { remember (Datatypes.S k). rewrite mul_comm in H12. - simpl in H12. subst. lia. } - rewrite mul_0_r in H4. simpl in H4. lia. - * erewrite (Nat.div_mod_eq (Datatypes.S (length l)) k). - rewrite add_sub_swap. - 2: { eapply mul_le_mono_l. lia. } - rewrite <- mul_sub_distr_l. - rewrite min_l. - 2: { cases (Datatypes.S (Datatypes.length l) / k - x0). - lia. rewrite mul_comm. simpl. - rewrite <- add_assoc. eapply le_add_r. } - repeat rewrite sub_add_distr. - rewrite <- mul_sub_distr_l. - cases (x0 - Datatypes.S (Datatypes.length l) / k). - 2: lia. rewrite mul_0_r. rewrite sub_0_l. rewrite sub_0_r. - replace k with (k*1) at 5 by lia. - rewrite <- mul_sub_distr_l. - replace (1 - (Datatypes.S (length l) / k - x0)) with 0 by lia. - rewrite mul_0_r. rewrite sub_0_l. - rewrite min_0_r. lia. - } + 2: { remember (a :: l) as l0. + replace (Datatypes.S _) with (length l0) in * by (subst; reflexivity). + clear Heql0. clear -H H2. + apply split_result_length_helper; auto. } + rewrite skipn_app. rewrite firstn_app. + rewrite length_skipn. rewrite skipn_repeat. + rewrite firstn_repeat. cbn [length]. + rewrite Forall_app. split. eapply forall_firstn. eapply forall_skipn. econstructor; eauto. eapply Forall_repeat. @@ -774,7 +853,7 @@ Lemma forall_result_has_shape_get_col : forall l k n m xs, Proof. induct l. - invert 1. simpl. econstructor. - - intros. invert H. cases a. invert H5. + - intros. invert H. cases a. invert H5. cases k. + simpl. cases v. * auto. @@ -793,7 +872,7 @@ Proof. invert H6. eassumption. invert H6. auto. * auto. -Qed. +Qed. Lemma result_has_shape_row_length : forall l n m xs, l <> [] -> @@ -823,7 +902,7 @@ Proof. erewrite result_has_shape_row_length in H2; try eassumption. 2: intros; discriminate. simpl transpose_result_list. - invert H1. cases r. invert H8. + invert H1. cases r. invert H8. assert (0 < m). lia. assert (Z.to_nat z < m). lia. propositional. replace (m - (m - Z.to_nat z)) with (Z.to_nat z) in * by lia. erewrite result_has_shape_length by eassumption. @@ -839,7 +918,7 @@ Proof. 2: { eapply nth_error_None in Heq0. simpl in *. lia. } eapply nth_error_In in Heq0. eapply Forall_forall in Heq0. 2: { econstructor. 2: apply H9. apply H8. } - simpl in Heq0. cases r0. invert Heq0. + simpl in Heq0. cases r0. invert Heq0. cases z0; cases z; reflexivity. lia. lia. + eapply nth_error_None in Heq. rewrite length_transpose_result_list in Heq. lia. @@ -851,9 +930,9 @@ Lemma result_has_shape_flatten : forall l n m xs, Proof. induct l; intros. - invert H. simpl. econstructor. - - invert H. simpl. cases a. invert H5. - - cases v. + - invert H. simpl. cases a. invert H5. + + cases v. invert H5. simpl. rewrite mul_0_r. eapply flatten_result_empty in H6. rewrite H6. econstructor. @@ -865,12 +944,12 @@ Proof. eapply IHl in H. eapply result_has_shape_app. eapply result_has_shape_forall. eauto. - eapply result_has_shape_forall. eauto. + eapply result_has_shape_forall. eauto. erewrite (result_has_shape_length (r::v)) by eassumption. erewrite (result_has_shape_length (flatten_result _)) by eassumption. lia. eapply result_has_shape_length in H5. simpl in *. subst. lia. -Qed. +Qed. Lemma result_has_shape_no_cons : forall l sh k, l <> [] -> @@ -882,8 +961,8 @@ Proof. - propositional. - clear H. simpl in *. subst. econstructor. auto. invert H1. auto. invert H1. auto. -Qed. - +Qed. + Lemma empty_result_shape_Z_flatten : forall l, Forall (fun r : result => result_has_shape r [0]) l -> result_shape_Z (V (flatten_result l)) = [0%Z]. @@ -946,8 +1025,8 @@ Proof. simpl. econstructor. simpl in *. lia. invert H10. auto. invert H10. auto. - intros. invert H. eauto. -Qed. - +Qed. + Lemma result_has_shape_add_result_result : forall r1 r2 r3, add_result r1 r2 r3 -> forall sh, @@ -973,7 +1052,7 @@ Proof. eapply H0 in H2. invs. simpl in *. invert H3. invert H4. split; econstructor; simpl; eauto. - intros. invert H. split; econstructor. -Qed. +Qed. Lemma length_add_list : forall l1 l2 l3, add_list l1 l2 l3 -> @@ -983,7 +1062,7 @@ Proof. - invs. simpl. lia. - eauto. Qed. - + Lemma result_has_shape_concat : forall l1 l2 x1 x2 xs, result_has_shape (V l1) (x1::xs) -> result_has_shape (V l2) (x2::xs) -> @@ -1001,8 +1080,8 @@ Qed. Lemma result_has_shape_truncl_list : forall l k x xs, - result_has_shape (V l) (filter_until (x::xs) 0) -> - result_has_shape (V (truncl_list k l)) (x -k::xs). + result_has_shape (V l) (x::xs) -> + result_has_shape (V (skipn k l)) (x -k::xs). Proof. induct l; intros; cases x. - rewrite truncl_list_empty. econstructor. @@ -1010,11 +1089,11 @@ Proof. - invert H. - cases k. + simpl. simpl in *. invert H. econstructor. auto. - eapply result_has_shape_filter_until_0. auto. + auto. eapply Forall_impl. 2: eassumption. simpl. intros. - eapply result_has_shape_filter_until_0. auto. - + simpl truncl_list. simpl Nat.sub. + auto. + + simpl skipn. simpl Nat.sub. eapply IHl. cases l. * simpl in *. invert H. simpl. econstructor. @@ -1050,7 +1129,7 @@ Proof. Datatypes.S (Datatypes.length l1)) with (length l2) by lia. eapply Forall_app in H7. invs. eapply forall_result_has_shape; eauto. -Qed. +Qed. Lemma result_has_shape_app_r : forall l1 l2 m sh k, length l2 = k -> @@ -1106,7 +1185,7 @@ Proof. Qed. Lemma truncl_list_gen_pad_id : forall k x l, - truncl_list k (gen_pad_list (k :: l) ++ x) = x. + skipn k (gen_pad_list (k :: l) ++ x) = x. Proof. induct k; intros. - reflexivity. @@ -1142,18 +1221,18 @@ Proof. invert H1. rewrite result_lookup_Z_option_gen_pad in H0. discriminate. Qed. - + Lemma result_lookup_Z_truncl : forall z x1 k l, (0 <= z)%Z -> - result_lookup_Z_option (z :: x1) (V (truncl_list k l)) = + result_lookup_Z_option (z :: x1) (V (skipn k l)) = result_lookup_Z_option ((z + Z.of_nat k)%Z :: x1) (V l). Proof. intros. simpl. rewrite nth_error_truncl. cases z; try lia. - simpl. rewrite Nat2Z.id. cases (Z.of_nat k); try lia. auto. auto. - - cases ((Z.pos p + Z.of_nat k)%Z); try lia. + - cases ((Z.pos p + Z.of_nat k)%Z); try lia. eq_match_discriminee. f_equal. lia. Qed. @@ -1161,8 +1240,8 @@ Qed. Lemma result_lookup_Z_truncr : forall z x0 k l, Z.to_nat z < Datatypes.length l - k -> - result_lookup_Z_option (z :: x0) (V (rev (truncl_list k (rev l)))) = - result_lookup_Z_option (z :: x0) (V l). + result_lookup_Z_option (z :: x0) (V (rev (skipn k (rev l)))) = + result_lookup_Z_option (z :: x0) (V l). Proof. intros. simpl. rewrite nth_error_truncr. reflexivity. @@ -1239,10 +1318,10 @@ Proof. cases z. discriminate. auto. - simpl in *. cases a; try discriminate; auto. - cases r; try discriminate; auto. + cases r; try discriminate; auto. cases (nth_error v (Z.to_nat 0)); eauto. cases r; auto. - cases (nth_error v (Z.to_nat (Z.pos p))); eauto. + cases (nth_error v (Z.to_nat (Z.pos p))); eauto. Qed. Lemma gen_pad_cons : forall x xs, @@ -1257,7 +1336,7 @@ Proof. - simpl. rewrite IHn. reflexivity. -Qed. +Qed. Lemma result_has_shape_repeat : forall n r sh, result_has_shape r sh -> @@ -1298,7 +1377,7 @@ Proof. eexists (r1::x). eexists x0. simpl. propositional. econstructor; eauto. -Qed. +Qed. Lemma add_list_repeat_gen_pad : forall sh n l r1 r2, add_list r1 r2 l -> @@ -1366,7 +1445,7 @@ Lemma add_list_rev : forall l1 l2 l3, Proof. induct 1; intros; simpl; try econstructor. eapply add_list_app. eauto. econstructor. eauto. econstructor. -Qed. +Qed. Lemma add_list_skipn : forall l1 l2 l3, add_list l1 l2 l3 -> @@ -1393,7 +1472,7 @@ Proof. 2: { eapply nth_error_None in Heq. eapply result_has_shape_length in H7. lia. } simpl. f_equal. - eapply IHl1. 2: eauto. + eapply IHl1. 2: eauto. eapply forall_result_has_shape. eauto. reflexivity. lia. Qed. @@ -1489,7 +1568,7 @@ Lemma pad_list_result_to_shape_transpose_result_list_app : result_has_shape (V l2) (a :: m :: xs) -> x = n + a -> (pad_list_result_to_shape - (transpose_result_list (l1 ++ l2) (row_length (l1 ++ l2))) + (transpose_result_list (l1 ++ l2) (row_length (l1 ++ l2))) (m :: x :: xs)) = (map2 (fun r1 r2 : result => @@ -1522,7 +1601,7 @@ Proof. erewrite map_match_transpose_result_list_id; try eassumption; auto. - simpl. invert H0. - rewrite app_nil_r. simpl. rewrite add_0_r. + rewrite app_nil_r. simpl. rewrite add_0_r. rewrite map2_repeat2. 2: { invert H. simpl. cases x; try now invert H4. @@ -1532,7 +1611,7 @@ Proof. - simpl. rewrite length_transpose_result_list. eapply result_has_shape_length in H4. simpl in *. lia. } - + replace (fun x : result => match x with | V l0 => V (l0 ++ []) | _ => V [] @@ -1559,7 +1638,7 @@ Proof. erewrite result_has_shape_row_length. 2: { invert H. invert H0. inversion 1. } 2: eauto. - + erewrite pad_list_result_shape_id; try lia; eauto. erewrite pad_list_result_shape_id; try lia; eauto. @@ -1734,7 +1813,7 @@ Proof. cases v. invert H7. lia. cases k. simpl. rewrite min_0_r. reflexivity. rewrite <- succ_min_distr. - unfold nat_range. simpl nat_range_rec. rewrite map_cons. + unfold nat_range. simpl seq. rewrite map_cons. simpl firstn. pose proof H7. eapply result_has_shape_length in H. cases m. lia. invert H. f_equal. erewrite IHm0. @@ -1745,11 +1824,11 @@ Proof. rewrite map_nat_range_rec_shift. f_equal. eapply functional_extensionality. intros. f_equal. f_equal. - rewrite add_sub_assoc. + rewrite add_sub_assoc. rewrite add_sub_assoc. lia. lia. lia. -Qed. +Qed. Lemma skipn_transpose_result_list : forall m0 l k n m sh, result_has_shape (V l) (n::m::sh) -> @@ -1758,7 +1837,7 @@ Lemma skipn_transpose_result_list : forall m0 l k n m sh, m0 <= m -> skipn k (transpose_result_list l m0) = map (fun x => V (get_col l x)) - (nat_range_rec (m0-k) (m-m0+k)). + (seq (m-m0+k) (m0-k)). Proof. induct m0; intros. - simpl. rewrite skipn_nil. reflexivity. @@ -1769,7 +1848,7 @@ Proof. pose proof H7. eapply result_has_shape_length in H. invert H. cases k. + simpl skipn. rewrite add_0_r. rewrite sub_0_r. - simpl nat_range_rec. rewrite map_cons. f_equal. + simpl seq. rewrite map_cons. f_equal. specialize IHm0 with (k:=0). simpl in *|-. erewrite IHm0. rewrite add_0_r in *. rewrite sub_0_r in *. @@ -1819,7 +1898,7 @@ Proof. rewrite succ_nat_range_rec_app_end. rewrite add_0_r. rewrite map_app. simpl map at 2. rewrite sub_0_r. f_equal. - replace (nat_range_rec m0 0) with (nat_range m0) by auto. + replace (seq 0 m0) with (nat_range m0) by auto. replace m0 with (min m0 k) at 2 by lia. erewrite <- IHm0. 2: econstructor; eauto. @@ -1892,7 +1971,7 @@ Proof. assert (rev (rev v) = rev (rev (repeat (gen_pad sh) (Datatypes.length v)))). { rewrite H4; auto. } - repeat rewrite rev_involutive in H. + repeat rewrite rev_involutive in H. cases (nth_error v i). eapply nth_error_In in Heq0. rewrite H in *. @@ -1919,7 +1998,7 @@ Proof. 2: { lia. } eapply IHl. eauto. 2: { eapply forall_result_has_shape; eauto. } - lia. + lia. Qed. Lemma get_col_rev : forall l i sh n m, @@ -1935,13 +2014,13 @@ Proof. - reflexivity. - simpl get_col at 1. invert H. cases a. invert H6. cases v. - + invert H6. simpl. rewrite nth_error_empty. reflexivity. + + invert H6. simpl. rewrite nth_error_empty. reflexivity. + assert (i < m-1 \/ m-1 <= i) as Hcase by lia. inversion Hcase as [ Hcase1 | Hcase2 ]; clear Hcase. * cases (nth_error (r :: v) (m -1 - i)). 2: { eapply nth_error_None in Heq. erewrite result_has_shape_length in Heq by eauto. - assert (i = 0) by lia. + assert (i = 0) by lia. assert (m = 0) by lia. subst. invert H6. } erewrite IHl. @@ -2029,7 +2108,7 @@ Proof. f_equal. simpl. rewrite Heq. reflexivity. + eapply nth_error_None in Heq. eapply result_has_shape_length in H6. lia. -Qed. +Qed. Lemma skipn_get_col : forall l n x a b sh, result_has_shape (V l) (a::b::sh) -> @@ -2089,7 +2168,7 @@ Proof. induct 1; intros; simpl; try rewrite firstn_nil; try econstructor. cases n. simpl. econstructor. simpl. econstructor. eauto. eauto. -Qed. +Qed. Lemma result_has_shape_map_rev : forall l sh, result_has_shape (V l) sh -> @@ -2269,7 +2348,7 @@ Proof. replace (l2 - (m - b)) with 0 by lia. simpl. rewrite app_nil_r. invert H. eauto. Qed. - + Lemma forall_firstn_skipn_flatten_result : forall l P l0 a l1 n m xs, Forall @@ -2343,7 +2422,7 @@ Lemma flatten_result_split_nat_range_rec_gen : forall n k l a sh c, repeat (gen_pad sh) (min (Datatypes.length l mod k - (k * (x-c) - Datatypes.length l)) (k - (Datatypes.length l - k * (x-c)))))) - (nat_range_rec n c)) = + (seq c n)) = firstn (n * k) l. Proof. induct n; intros. @@ -2355,7 +2434,7 @@ Proof. replace (k - Datatypes.S (Datatypes.length l)) with 0 by lia. rewrite min_0_r. simpl repeat at 1. rewrite app_nil_r. f_equal. - erewrite <- IHn with (sh:=sh) (c:=c+1). + erewrite <- IHn with (sh:=sh) (c:=Datatypes.S c). rewrite length_skipn. simpl length. 2: lia. 2: { simpl in *. rewrite length_skipn. simpl length in *. lia. } @@ -2363,7 +2442,7 @@ Proof. invert H1. econstructor. eauto. eauto. reflexivity. } f_equal. eapply map_nat_range_rec_extensionality. intros. f_equal. rewrite skipn_skipn. - replace (k * (x - (c + 1)) + k) with (k * (Datatypes.S (x - (c + 1)))) + replace (k * (x - (Datatypes.S c)) + k) with (k * (Datatypes.S (x - (c + 1)))) by lia. f_equal. f_equal. f_equal. rewrite sub_add_distr. f_equal. lia. @@ -2381,13 +2460,11 @@ Proof. rewrite Div0.add_mod by lia. symmetry. rewrite Div0.add_mod by lia. rewrite Nat.mul_comm. rewrite Div0.mod_mul. rewrite Nat.mul_comm. rewrite Div0.mod_mul. reflexivity. } - rewrite sub_add_distr. f_equal. f_equal. f_equal. - repeat rewrite mul_sub_distr_l. rewrite mul_1_r. - lia. + repeat rewrite mul_sub_distr_l. lia. symmetry. rewrite <- sub_add_distr. - replace (k + k * (x - c - 1)) with (k * (x - c - 1 + 1)) by lia. + replace (k + k * (x - Datatypes.S c)) with (k * (x - c - 1 + 1)) by lia. f_equal. f_equal. f_equal. lia. Qed. @@ -2440,9 +2517,9 @@ Proof. rewrite H1. 2: lia. pose proof Heq. eapply mod_0_iff_ceil_eq_floor_0 in H2. 2: lia. rewrite firstn_all2. reflexivity. - rewrite H2. eapply Div0.div_exact in Heq. lia. + rewrite H2. eapply Div0.div_exact in Heq. lia. pose proof Heq. eapply mod_0_iff_ceil_eq_floor_0 in H2. 2: lia. - rewrite H2. eapply Div0.div_exact in Heq. lia. + rewrite H2. eapply Div0.div_exact in Heq. lia. simpl. econstructor; eauto. - rewrite <- Heq. cases (Datatypes.length (r :: l) //n k). @@ -2518,7 +2595,7 @@ Proof. simpl. econstructor; eauto. eapply Forall_map. eapply Forall_forall. propositional. econstructor; eauto. -Qed. +Qed. Lemma skipn_split_result : forall l n k a sh, 0 < k -> @@ -2573,11 +2650,11 @@ Qed. Lemma flatten_result_nat_range_rec : forall a n l k, flatten_result (map (fun x => V (firstn k (skipn (k * x) l))) - (nat_range_rec a n)) = firstn (a*k) (skipn (n*k) l). + (seq n a)) = firstn (a*k) (skipn (n*k) l). Proof. induct a; intros. - simpl. reflexivity. - - simpl. rewrite Nat.add_comm. rewrite firstn_add. + - simpl. rewrite firstn_add. f_equal. rewrite mul_comm. reflexivity. rewrite IHa. simpl. rewrite skipn_skipn. reflexivity. Qed. @@ -2588,7 +2665,7 @@ Lemma nth_error_split_result : forall l k x, match nth_error (split_result k l) (x / k) with - | Some (V v) => nth_error v (x mod k) + | Some (V v) => nth_error v (x mod k) | _ => None end = nth_error l x . Proof. @@ -2617,9 +2694,8 @@ Proof. 2: { rewrite length_skipn. simpl length in *. eapply Nat.add_lt_mono_l with (p:=k * (x / k)). rewrite <- div_mod by lia. - rewrite Nat.add_comm. + rewrite Nat.add_comm. rewrite Nat.sub_add. lia. pose proof (Div0.mul_div_le x k). lia. } rewrite nth_error_skipn_mod by lia. reflexivity. Qed. - diff --git a/src/verified_lowering/proof/ResultToArrayDelta.v b/src/verified_lowering/proof/ResultToArrayDelta.v index dc316ab..d207eb1 100644 --- a/src/verified_lowering/proof/ResultToArrayDelta.v +++ b/src/verified_lowering/proof/ResultToArrayDelta.v @@ -125,10 +125,10 @@ Proof. * rewrite dom_add. sets. + rewrite IHdomain; eauto. invert H. auto. - eapply partial_injective_cons; eauto. + eapply partial_injective_cons; eauto. + rewrite IHdomain; eauto. invert H. eauto. - eapply partial_injective_cons; eauto. + eapply partial_injective_cons; eauto. + rewrite IHdomain; eauto. invert H. eauto. eapply partial_injective_cons; eauto. @@ -216,7 +216,7 @@ Proof. simpl. propositional. simpl. propositional. eapply partial_injective_cons; eauto. - - pose proof H. pose proof H0. + - pose proof H. pose proof H0. cases (f a); cases (result_lookup_Z_option a r). + rewrite array_add_empty_l. rewrite partial_fold_left_array_add_accum_assoc; @@ -224,7 +224,7 @@ Proof. assert (forall l l' : list Z, {l = l'} + {l <> l'}). apply list_eq_dec. apply Z.eq_dec. specialize (H5 index a). invert H5; subst. - * rewrite Heq in *. invert H2. + * rewrite Heq in *. invert H2. rewrite lookup_add_eq by auto. auto. * rewrite lookup_add_ne. eapply IHdomain; eauto. invert H0. @@ -279,7 +279,7 @@ Lemma tensor_to_array_delta_cons_generic_indexer : | _ => f index end) (V r0)). Proof. - intros. + intros. cases l. invert H. unfold tensor_to_array_delta. eapply fmap_ext. intros. @@ -427,7 +427,7 @@ Proof. rewrite <- H5. reflexivity. * eapply H2. - erewrite <- in_extract_Some in H3. + erewrite <- in_extract_Some in H3. eapply in_map_iff in H3. invs. repeat decomp_index. erewrite result_has_shape_result_shape_Z in H4. @@ -468,9 +468,9 @@ Lemma eq_tensor_to_array_delta_by_indices_shuffle : (forall x, In x dom1 -> exists y, shuffle y = x /\ In y dom2) -> partial_injective reindexer2 dom2 -> partial_injective reindexer1 dom1 -> - injective dom2 shuffle -> + injective dom2 shuffle -> no_dup dom2 -> - no_dup dom1 -> + no_dup dom1 -> tensor_to_array_delta_by_indices reindexer1 r1 dom1 = tensor_to_array_delta_by_indices reindexer2 r2 dom2. Proof. @@ -583,12 +583,12 @@ Lemma tensor_to_array_delta_cons : vars_of_reindexer (reindexer l) = vars_of_reindexer (reindexer []) \cup vars_of_reindexer l) -> ~ i \in dom v -> - (forall var, contains_substring "?" var -> ~ var \in dom v) -> + (forall var, contains_substring "?" var -> ~ var \in dom v) -> ~ In i (shape_to_vars (result_shape_Z r)) -> array_add (tensor_to_array_delta (partial_interpret_reindexer - (shift_top_dim_reindexer reindexer) (result_shape_Z (V r0)) v) + (shift_top_dim_reindexer reindexer) (result_shape_Z (V r0)) v) (V r0)) (tensor_to_array_delta (partial_interpret_reindexer @@ -621,7 +621,7 @@ Proof. reflexivity. - intros. repeat decomp_index. erewrite eq_partial_interpret_reindexer_eval_0 with (r0:=[]); eauto. - simpl in *. lia. + simpl in *. lia. - intros. repeat decomp_index. eapply filter_In. propositional. repeat decomp_goal_index. @@ -641,14 +641,14 @@ Proof. try eapply H3; eauto. simpl in *. lia. - erewrite result_has_shape_result_shape_Z in Hinj. - 2: { eauto. } + 2: { eauto. } eauto. - unfold injective. propositional. invert H9. auto. - eapply no_dup_filter. eapply no_dup_mesh_grid. - eapply no_dup_filter. - eapply no_dup_mesh_grid. } + eapply no_dup_mesh_grid. } rewrite array_add_comm. symmetry. erewrite tensor_to_array_delta_cons_generic_indexer; eauto. symmetry. @@ -701,7 +701,7 @@ Lemma tensor_to_array_delta_add_valuation : ~ i \in dom v -> ~ contains_substring "?" i -> result_has_shape r sh -> - partial_injective + partial_injective (partial_interpret_reindexer reindexer (result_shape_Z r) (v $+ (i, loz0))) (filter @@ -712,10 +712,10 @@ Lemma tensor_to_array_delta_add_valuation : map (subst_var_in_Z_tup var k) (reindexer l) = reindexer (map (subst_var_in_Z_tup var k) l)) -> vars_of_reindexer (reindexer []) \subseteq dom v -> - (tensor_to_array_delta + (tensor_to_array_delta (partial_interpret_reindexer reindexer (result_shape_Z r) (v $+ (i, loz0))) r) = - (tensor_to_array_delta + (tensor_to_array_delta (partial_interpret_reindexer reindexer (result_shape_Z r) v) r). Proof. unfold tensor_to_array_delta. intros. @@ -819,7 +819,7 @@ Proof. unfold partial_interpret_reindexer. unfold shift_top_dim_reindexer. unfold shape_to_vars. simpl. cases (xs1). simpl in *. lia. - simpl. + simpl. rewrite shape_to_index_cons. repeat rewrite index_to_partial_function_vars_cons; eauto with reindexers. rewrite Hmap; eauto with reindexers. @@ -886,7 +886,7 @@ Lemma tensor_to_array_delta_cons0 : forall reindexer x1 xs1 v, Proof. intros ? ? ? ?. intros Hinj HeqZlist Hvarsub Hmap Hvarsarg. intros. - + unfold tensor_to_array_delta. eapply eq_tensor_to_array_delta_by_indices. intros. unfold partial_interpret_reindexer. @@ -928,7 +928,7 @@ Proof. eapply length_mesh_grid_indices. decomp_index. auto. eapply not_In_var_map. lia. eapply partial_injective_cons_0. apply Hinj. - eapply partial_injective_eval_cons0; try eapply Hinj; eauto. + eapply partial_injective_eval_cons0; try eapply Hinj; eauto. eapply no_dup_filter. eapply no_dup_mesh_grid. Qed. @@ -963,8 +963,8 @@ Proof. rewrite partially_eval_Z_tup_empty_id. rewrite map_id. rewrite map_partially_eval_Z_tup_shape_to_index; auto. eapply eq_Z_tuple_index_list_id. -Qed. - +Qed. + Lemma array_add_tensor_to_array_delta_concat : forall r1 r2 f g x1 x2 xs, constant (extract_Some (map f (filter @@ -1002,7 +1002,7 @@ Proof. erewrite result_has_shape_result_shape_nat in * by eassumption. erewrite result_has_shape_result_shape_nat in * by eassumption. unfold tensor_to_array_delta. - symmetry. unfold tensor_to_array_delta_by_indices. + symmetry. unfold tensor_to_array_delta_by_indices. erewrite result_has_shape_result_shape_Z. 2: { eapply result_has_shape_concat; eassumption. } erewrite result_has_shape_length by eassumption. @@ -1111,7 +1111,7 @@ Proof. repeat decomp_index. lia. } 3: { eapply filter_In. propositional. - repeat decomp_index. + repeat decomp_index. erewrite result_has_shape_result_shape_Z in H5 by eauto. repeat decomp_index. eapply in_or_app. left. @@ -1308,12 +1308,12 @@ Lemma tensor_to_array_delta_partial_interpret_reindexer_flatten : tensor_to_array_delta (partial_interpret_reindexer (fun l0 => l0) - (result_shape_Z (V rs)) $0) + (result_shape_Z (V rs)) $0) (V rs) = tensor_to_array_delta (fun args => Some (flatten - (result_shape_Z (V rs)) args)) + (result_shape_Z (V rs)) args)) (V rs). Proof. intros. @@ -1343,7 +1343,7 @@ Lemma result_lookup_Z_tensor_to_array_delta : In x2 (mesh_grid (result_shape_Z (V rs))) -> injective (mesh_grid (result_shape_Z (V rs))) f -> tensor_to_array_delta - (fun args : list Z => Some (f args)) + (fun args : list Z => Some (f args)) (V rs) $? f x2 = result_lookup_Z_option x2 (V rs). Proof. @@ -1357,8 +1357,8 @@ Proof. unfold partial_injective. propositional. invert H5. unfold injective in *. - repeat decomp_index. - specialize (H1 args1 args2). + repeat decomp_index. + specialize (H1 args1 args2). propositional. eapply no_dup_filter. eapply no_dup_mesh_grid. @@ -1379,8 +1379,8 @@ Proof. unfold partial_injective. propositional. invert H5. unfold injective in *. - repeat decomp_index. - specialize (H1 args1 args2). + repeat decomp_index. + specialize (H1 args1 args2). propositional. Qed. @@ -1441,7 +1441,7 @@ Proof. 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 IHe. eapply H. eapply length_eval_expr_gen in H20; eauto. 2: { simpl. rewrite Hlo,Hhi. reflexivity. } lia. @@ -1482,12 +1482,10 @@ Proof. 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. 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. eapply IHe; eauto. - invs. eq_eval_Z. invert H. eq_size_of. invert H. @@ -1498,7 +1496,6 @@ Proof. - 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. eapply IHe; eauto. diff --git a/src/verified_lowering/proof/VarGeneration.v b/src/verified_lowering/proof/VarGeneration.v index 83d7474..f5dd08f 100644 --- a/src/verified_lowering/proof/VarGeneration.v +++ b/src/verified_lowering/proof/VarGeneration.v @@ -87,7 +87,7 @@ Lemma not_In_var_generation : forall n k k', (k <= k') -> ~ In (String.concat "" (repeat "?" k)) (map (fun k0 => String.concat "" (repeat "?" (k0 + 1))) - (nat_range_rec n k')). + (seq k' n)). Proof. induct n; intros. - simpl. propositional. @@ -102,7 +102,7 @@ Qed. Lemma no_dup_var_generation : forall n k, no_dup (map (fun k => String.concat "" (repeat "?" (k + 1))) - (nat_range_rec n k)). + (seq k n)). Proof. induct n; intros. - simpl. econstructor. @@ -132,7 +132,7 @@ Lemma not_In_var_map : forall len n, 1 <= n -> ~ In "?" (map (fun k : nat => String.concat "" (repeat "?" (k + 1))) - (nat_range_rec len n)). + (seq n len)). Proof. intros. replace "?" with (String.concat "" (repeat "?" (0+1))) by reflexivity. @@ -143,7 +143,7 @@ Lemma not_In_var_map2 : forall len n, 2 <= n -> ~ In "??" (map (fun k : nat => String.concat "" (repeat "?" (k + 1))) - (nat_range_rec len n)). + (seq n len)). Proof. intros. replace "??" with (String.concat "" (repeat "?" (1+1))) by reflexivity. @@ -202,7 +202,7 @@ Lemma forall_map_not_in_index {X} : vars_of_reindexer index \subseteq dom v -> Forall (fun var : var => ~ var \in vars_of_reindexer index) (map (fun k : nat => String.concat "" (repeat "?" (k + 1))) - (nat_range_rec (Datatypes.length sh) k)). + (seq k (Datatypes.length sh))). Proof. propositional. eapply Forall_map. @@ -228,7 +228,7 @@ Lemma forall_map_not_in_dom {X} : (forall var : var, contains_substring "?" var -> var \in dom v -> False) -> Forall (fun var : var => ~ var \in dom v) (map (fun k : nat => String.concat "" (repeat "?" (k + 1))) - (nat_range_rec (Datatypes.length sh) k)). + (seq k (Datatypes.length sh))). Proof. propositional. eapply Forall_map. eapply Forall_forall. intros. @@ -287,11 +287,11 @@ Lemma map_partially_eval_Z_tup_combine : forall sh v k, (combine (map ZVar (map (fun k => String.concat "" (repeat "?" (k + 1))) - (nat_range_rec (length sh) k))) (map ZLit sh)) = + (seq k (length sh)))) (map ZLit sh)) = combine (map ZVar (map (fun k => String.concat "" (repeat "?" (k + 1))) - (nat_range_rec (length sh) k))) (map ZLit sh). + (seq k (length sh)))) (map ZLit sh). Proof. induct sh; intros; auto. simpl. rewrite IHsh; auto. @@ -334,4 +334,3 @@ Proof. unfold result_shape_Z. simpl. intros. cases l; unfold shape_to_vars, shape_to_index; simpl; inversion 1. Qed. - diff --git a/src/verified_lowering/proof/WellFormedAllocation.v b/src/verified_lowering/proof/WellFormedAllocation.v index 9a9c142..76df0e5 100644 --- a/src/verified_lowering/proof/WellFormedAllocation.v +++ b/src/verified_lowering/proof/WellFormedAllocation.v @@ -271,7 +271,7 @@ Lemma well_formed_allocation_truncr : reindexer (V (rev - (truncl_list + (skipn (Z.to_nat kz) (rev (x ++ gen_pad_list (Z.to_nat kz :: l0)))))) st h p v -> diff --git a/src/verified_lowering/proof/WellFormedReindexer.v b/src/verified_lowering/proof/WellFormedReindexer.v index 7d14948..4a2ace6 100644 --- a/src/verified_lowering/proof/WellFormedReindexer.v +++ b/src/verified_lowering/proof/WellFormedReindexer.v @@ -608,9 +608,8 @@ Proof. rewrite H2 in H5. discriminate. eapply filter_In. split; eauto. 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. + erewrite <- result_lookup_Z_truncl by lia. + rewrite skipn_app. rewrite skipn_all2. 2: { erewrite result_has_shape_length by eauto. lia. } erewrite result_has_shape_length by eauto. rewrite sub_diag. simpl. reflexivity. @@ -650,13 +649,12 @@ Proof. eexists. rewrite Nat2Z.id in H4. rewrite H4. split. auto. eapply filter_In. split. repeat decomp_goal_index. split. lia. eauto. rewrite <- H8. - erewrite <- result_lookup_Z_truncl. - rewrite truncl_list_skipn. rewrite skipn_app. - rewrite skipn_all2. + erewrite <- result_lookup_Z_truncl by lia. + rewrite skipn_app. rewrite skipn_all2. 2: { erewrite result_has_shape_length by eauto. lia. } erewrite result_has_shape_length by eauto. rewrite sub_diag. simpl. reflexivity. - lia. invs. + invs. erewrite result_has_shape_result_shape_Z in * by eauto. eauto. - rewrite dom_add in *. sets. Qed. @@ -757,9 +755,8 @@ Proof. eapply filter_In. split; eauto. repeat decomp_goal_index. split. lia. eauto. rewrite <- H7. rewrite <- (Z2Nat.id dim1z) by lia. - erewrite <- result_lookup_Z_truncl. 2: lia. - rewrite truncl_list_skipn. rewrite skipn_app. - rewrite skipn_all2. + erewrite <- result_lookup_Z_truncl by lia. + rewrite skipn_app. rewrite skipn_all2. 2: { erewrite result_has_shape_length by eauto. lia. } erewrite result_has_shape_length by eauto. rewrite sub_diag. simpl. reflexivity. @@ -798,12 +795,11 @@ Proof. split. repeat decomp_goal_index. split. lia. eauto. rewrite <- H5. rewrite <- (Z2Nat.id dim1z) by lia. - erewrite <- result_lookup_Z_truncl. - rewrite truncl_list_skipn. rewrite skipn_app. - rewrite skipn_all2. + erewrite <- result_lookup_Z_truncl by lia. + rewrite skipn_app. rewrite skipn_all2. 2: { erewrite result_has_shape_length by eauto. lia. } erewrite result_has_shape_length by eauto. rewrite sub_diag. - simpl. reflexivity. lia. + simpl. reflexivity. - rewrite dom_add in *. sets. Qed. @@ -1159,7 +1155,7 @@ partial_injective (result_shape_Z (V (rev - (truncl_list (Z.to_nat kz) + (skipn (Z.to_nat kz) (repeat (gen_pad l0) (Z.to_nat kz) ++ rev x))))) v) (filter @@ -1169,14 +1165,14 @@ partial_injective (result_lookup_Z_option x0 (V (rev - (truncl_list (Z.to_nat kz) + (skipn (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 kz) + (skipn (Z.to_nat kz) (repeat (gen_pad l0) (Z.to_nat kz) ++ rev x))))))) -> (forall l1 l2 : list (Zexpr * Zexpr), @@ -1259,13 +1255,13 @@ Proof. + pose proof Hinj. rewrite @truncl_list_app in *. 2: { rewrite repeat_length; lia. } - rewrite @truncl_list_skipn in *. rewrite @skipn_all2 in H5. + rewrite @skipn_all2 in H5. 2: { rewrite repeat_length. lia. } simpl in *. rewrite @rev_involutive in *. eauto. rewrite repeat_length. lia. + rewrite @truncl_list_app in *. 2: { rewrite repeat_length; lia. } - rewrite @truncl_list_skipn in *. rewrite @skipn_all2 in Hinj. + rewrite @skipn_all2 in Hinj. 2: { rewrite repeat_length. lia. } simpl in *. rewrite @rev_involutive in *. erewrite result_has_shape_result_shape_Z in Hinj. @@ -1649,8 +1645,7 @@ Proof. repeat decomp_goal_index. split. lia. eauto. rewrite <- H7. rewrite <- (Z2Nat.id dim1z) by lia. erewrite <- result_lookup_Z_truncl. 2: lia. - rewrite truncl_list_skipn. rewrite skipn_app. - rewrite skipn_all2. + rewrite skipn_app. rewrite skipn_all2. 2: { erewrite result_has_shape_length by eauto. lia. } erewrite result_has_shape_length by eauto. rewrite sub_diag. simpl. reflexivity. @@ -1686,8 +1681,7 @@ Proof. split. lia. eauto. rewrite <- H5. rewrite <- (Z2Nat.id dim1z) by lia. erewrite <- result_lookup_Z_truncl. - rewrite truncl_list_skipn. rewrite skipn_app. - rewrite skipn_all2. + rewrite skipn_app. rewrite skipn_all2. 2: { erewrite result_has_shape_length by eauto. lia. } erewrite result_has_shape_length by eauto. rewrite sub_diag. simpl. reflexivity. @@ -2138,7 +2132,7 @@ Lemma well_formed_reindexer_truncr : reindexer v (V (rev - (truncl_list (Z.to_nat kz) + (skipn (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 kz :: l0))) (m :: l0) -> @@ -2211,31 +2205,25 @@ Proof. - 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 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 *. - rewrite truncl_list_skipn. 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. rewrite rev_app_distr in Hnondstr. simpl in *. rewrite rev_repeat in Hnondstr. - rewrite truncl_list_skipn in Hnondstr. 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. erewrite truncl_list_gen_pad_id in Hnondstr. rewrite rev_involutive in Hnondstr. eauto. diff --git a/src/verified_lowering/proof/Zexpr.v b/src/verified_lowering/proof/Zexpr.v index 9b847f4..275d239 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). @@ -203,7 +203,7 @@ Hint Unfold eq_Z_index_list : core. Definition eq_Z_tuple_index_list (l1 l2 : list (Zexpr * Zexpr)) := eq_Z_index_list (map fst l1) (map fst l2) /\ eq_Z_index_list (map snd l1) (map snd l2). - + Ltac invsZ := repeat match goal with @@ -575,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. @@ -602,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 @@ -616,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)). @@ -726,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). @@ -808,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) = @@ -997,7 +997,7 @@ Proof. eapply eq_zexpr_fold_accum. apply eq_zexpr_flatten_shape_index. rewrite <- eq_Z_index_list_cons. - propositional. + propositional. rewrite <- eq_Z_index_list_cons. propositional. intros. @@ -1117,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 -> @@ -1138,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, @@ -1149,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 -> @@ -1184,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. @@ -1209,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; @@ -1250,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. @@ -1293,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) @@ -1379,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. @@ -1455,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). @@ -1529,7 +1529,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 -> @@ -1539,7 +1539,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 -> @@ -1562,7 +1562,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 @@ -1581,7 +1581,7 @@ 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) + (ZPlus (fold_left ZTimes dims i) (flatten_shape_index dims vars)). Proof. intros. simpl. @@ -1591,9 +1591,9 @@ Proof. apply eq_zexpr_fold_left_ZTimes_accum. apply eq_zexpr_comm. apply eq_zexpr_mul_1_r. -Qed. +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. @@ -1666,23 +1666,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. @@ -1752,7 +1752,7 @@ Proof. 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 -> @@ -1765,7 +1765,7 @@ Proof. 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; @@ -1775,10 +1775,10 @@ 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. @@ -1909,7 +1909,7 @@ Lemma partially_eval_Zexpr_flatten_shape_index : forall l1 l2 v, Proof. induct l1; intros; cases l2; try reflexivity; []. simpl. rewrite IHl1. f_equal. f_equal. - apply partially_eval_Zexpr_fold_left_ZTimes. + apply partially_eval_Zexpr_fold_left_ZTimes. Qed. Fixpoint flatten (sh : list Z) (i : list Z) := @@ -1950,7 +1950,7 @@ 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 (subst_var_in_Z_tup var k) index). Proof. @@ -1969,7 +1969,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. @@ -2097,7 +2097,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, @@ -2143,9 +2143,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)) @@ -2159,8 +2159,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. @@ -2246,7 +2246,7 @@ Proof. - 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. @@ -2257,14 +2257,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 @@ -2280,7 +2280,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. @@ -2458,7 +2458,7 @@ Lemma eq_Z_tup_fold_left_subst_var_in_Z_tup : forall l1 vars idx, (fold_left (fun a t0 => subst_var_in_Z_tup (fst t0) (snd t0) a) - (combine vars idx) l1) = l1. + (combine vars idx) l1) = l1. Proof. induction vars; intros; simpl in *. - auto. @@ -2476,7 +2476,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 @@ -2571,7 +2571,7 @@ Lemma eval_empty_eq_zexpr x xz : eval_Zexpr $0 x xz -> eq_zexpr x (| xz |)%z. Proof. - intros H. cbv [eq_zexpr]. + intros H. cbv [eq_zexpr]. - split. + intros v z. split; intros H'. -- eapply eval_Zexpr_includes_valuation in H. 2: apply empty_includes. @@ -2579,7 +2579,7 @@ Proof. -- invert H'. eapply eval_Zexpr_includes_valuation. 1: eassumption. apply empty_includes. + simpl. eapply eval_Zexpr_vars_empty. eassumption. -Qed. +Qed. Lemma eval_Zexpr_forall_vars_of_Zexpr : forall e v ez, eval_Zexpr v e ez -> @@ -2603,7 +2603,7 @@ Proof. apply includes_add_new. apply None_dom_lookup. assumption. -Qed. +Qed. Lemma eq_zexpr_literal_subst_var_in_Zexpr : forall x xz v k, eq_zexpr x (|xz|)%z -> @@ -2615,7 +2615,7 @@ 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 -> @@ -2636,7 +2636,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; @@ -2821,7 +2821,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)). @@ -2960,7 +2960,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) @@ -3038,7 +3038,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. @@ -3054,15 +3054,15 @@ 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. @@ -3071,13 +3071,13 @@ Proof. - 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 *. @@ -3232,7 +3232,7 @@ Proof. - simpl. rewrite IHl. reflexivity. Qed. -Lemma join_empty_r {X} : forall (v : fmap var X), +Lemma join_empty_r {X Y} : forall (v : fmap X Y), v $++ $0 = v. Proof. intros. eapply fmap_ext. intros. @@ -3243,6 +3243,36 @@ Proof. eapply lookup_None_dom. sets. Qed. +Lemma join_empty_l {X Y} (v : fmap X Y) : + $0 $++ v = v. +Proof. + rewrite join_comm. 1: apply join_empty_r. rewrite dom_empty. sets. +Qed. + +Lemma join_add_l {X Y} m1 k v (m2 : fmap X Y) : + ~ k \in dom m1 -> + m1 $+ (k, v) $++ m2 = m1 $++ (m2 $+ (k, v)). +Proof. + intros Hk. + apply fmap_ext. intros k0. + assert (k0 \in dom m1 \/ ~k0 \in dom m1) as [H|H] by sets. + - rewrite lookup_join1; cycle 1. + { rewrite dom_add. sets. } + rewrite lookup_join1; cycle 1. + { sets. } + rewrite lookup_add_ne by sets. + reflexivity. + - assert (k = k0 \/ k <> k0) as [H'|H'] by sets. + + subst. rewrite lookup_join1 by (rewrite dom_add; sets). + rewrite lookup_join2 by sets. + do 2 rewrite lookup_add_eq by reflexivity. + reflexivity. + + rewrite lookup_join2 by (rewrite dom_add; sets). + rewrite lookup_join2 by sets. + rewrite lookup_add_ne by sets. + reflexivity. +Qed. + Lemma eval_Zexpr_partially_eval_Zexpr : forall e v x, eval_Zexpr $0 (partially_eval_Zexpr v e) x <-> eval_Zexpr v e x. @@ -3267,7 +3297,7 @@ 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)) @@ -3309,7 +3339,7 @@ Lemma eval_Zexprlist_map_match_fst_map_eval_Zexpr_Z_tup_total : 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 H4, H3. diff --git a/src/verified_lowering/stringify/GenLib.v b/src/verified_lowering/stringify/GenLib.v index e2ca8c8..b4c82f2 100644 --- a/src/verified_lowering/stringify/GenLib.v +++ b/src/verified_lowering/stringify/GenLib.v @@ -7,9 +7,7 @@ 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 Logic.FunctionalExtensionality. From Stdlib Require Import micromega.Lia. -From Stdlib Require Import micromega.Zify. From Stdlib Require Import Lists.List. Import ListNotations. @@ -21,6 +19,7 @@ From ATL Require Import ATL Tactics Common CommonTactics Div Reshape Map. From Codegen Require Import IdentParsing NatToString IntToString CodeGen Normalize CheckSafe. From Examples Require Import GatherScatter Convolution Im2col Blur TensorAdd Matmul. From Inferpad Require Import Reify. +From Inferpad Require Import ReifyExamples ATLPhoas ATLSpecs. From Lower Require Import Zexpr ATLDeep Bexpr Sexpr. From Stringify Require Import Stringify. @@ -30,326 +29,211 @@ Set Default Proof Mode "Classic". Definition SENTINEL := "!!!". -Ltac Llibfunc name context := - let args'' := args_for_decl in - let args' := eval simpl in args'' in - let args := match args' with - | String _ ?s' => s' - | EmptyString => EmptyString - end in - let ast := R in - let _ := match goal with |- _ => intros end in - let ast := constr:(lower ast - (fun i : list (Zexpr * Zexpr) => i) "output" - Assign context) in - let _ := match goal with |- _ => assert (Hast : ast = ast) by eauto end in - let Hast := match goal with - H : ?ast = ?ast |- _ => H - end in - let _ := match goal with - |- _ => - repeat (simpl in Hast; - first [ rewrite lookup_add_eq in Hast by auto | - rewrite lookup_add_ne in Hast by - (unfold not; intros Hneq; inversion Hneq) - ] ); - simpl combine in Hast end in +Definition arg_to_str (x : arg_spec) := + match x with + | Z_arg x => "int " ++ x + | T_arg x [] => "float " ++ x + | T_arg x (_ :: _) => "float* " ++ x + end. + +Fixpoint comma_separated_list elts := + match elts with + | [] => "" + | [elt] => elt + | elt :: elts => elt ++ ", " ++ comma_separated_list elts + end%string. + +Definition args_for_decl names := + comma_separated_list (map arg_to_str names). + +Fixpoint shape_context_of (names : list arg_spec) := + match names with + | [] => $0 + | Z_arg _ :: names' => shape_context_of names' + | T_arg x sh :: names' => shape_context_of names' $+ (x, sh) + end. + +Ltac lower' e names := + let ast := constr:(lower e (fun i => i) "output" Assign (shape_context_of names)) in + let _ := match goal with |- _ => assert (Hast : ast = ast) by eauto end in + let Hast := match goal with + H : ?ast = ?ast |- _ => H + end in + let _ := match goal with + |- _ => + repeat (compute in Hast; + first [ rewrite lookup_add_eq in Hast by auto | + rewrite lookup_add_ne in Hast by + (unfold not; intros Hneq; inversion Hneq) + ] ); + simpl combine in Hast end in let ast := match goal with H : ?ast = ?ast |- _ => ast end in - let ast := eval unfold flat_sizeof in ast in - let ast := eval simpl in ast in - let prog := match goal with |- ?prog = _ => prog end in - 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 := eval simpl in progstr in - let header := constr:([funcname++".h"; - "#include "; - ""; - "void "++funcname++"("++args++","++scalar++"*output);"]) in - - let func := constr:((funcname++".c"):: - "#include ":: - ("#include @"++funcname++".h@"):: - "":: - ("void "++funcname++"("++args++","++scalar++"*output)"++"{"):: - (progstr++ - ["}"])%list) in - - let ret' := constr:(app ("!!!"::header) ("!!!"::func)) in - let ret := eval simpl in ret' in - ret. - -Goal forall A B C (m1 m2 : list (list R)), - (0 < A)%Z -> - (0 < B)%Z -> - (0 < C)%Z -> - consistent m1 (Z.to_nat A,(Z.to_nat B,tt)) -> - 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. + let _ := match goal with _ => clear Hast end in + ast. + +Definition Llibfunc' funcname names prog := + let args := args_for_decl names in + let progstr := stringify_stmt prog in + let header := [funcname++".h"; + "#include "; + ""; + "void "++funcname++"("++args++", "++scalar++"* output);"]%string in + let func := ([funcname ++ ".c"; + "#include "; + "#include @" ++ funcname ++ ".h@"; + ""; + "void " ++ funcname ++ "(" ++ args ++ ", " ++ scalar ++ "* output){"]%string ++ + progstr ++ + ["}"])%list in + let ret := (("!!!"::header) ++ ("!!!"::func))%list in + ret. + +Ltac Llibfunc funcname names e := + let prog := lower' e names in + let ret := constr:(Llibfunc' funcname names prog) in + let ret := eval compute in ret in + ret. + +Goal True. + Check matmul_string_correct. let s := Llibfunc constr:("matmul") - constr:(($0 $+ ("m1", [ZLit A;ZLit B]) - $+ ("m2", [ZLit A;ZLit B]))) + matmul_args + matmul_string in idtac_list s. Abort. -Goal forall A B C (m1 m2 : list (list R)), - (0 < A)%Z -> - (0 < B)%Z -> - (0 < C)%Z -> - consistent m1 (Z.to_nat A,(Z.to_nat B,tt)) -> - consistent m2 (Z.to_nat B,(Z.to_nat C,tt)) -> - matmul_tiled (Z.to_nat A) (Z.to_nat B) (Z.to_nat C) m1 m2 4%Z = - matmul A B C m1 m2. +Derive string_matmul_tiled in + (stringy_spec_of [tZ; tZ; tZ; tensor_n 2; tensor_n 2] 2 matmul_args string_matmul_tiled matmul_precond (fun A B C m1 m2 => matmul_tiled A B C m1 m2 4%Z)) + as string_matmul_correct. Proof. - intros. - let s := Llibfunc - constr:("matmul_tiled") - constr:(($0 $+ ("m1", [ZLit A;ZLit B]) - $+ ("m2", [ZLit A;ZLit B]))) - in idtac_list s. + cbv [matmul_tiled matmul_precond]. prove_stringy_spec. + { destruct (f : False). (*seems true*) } +Qed. + +Goal True. + let s := Llibfunc + constr:("matmul_tiled") + matmul_args + string_matmul_tiled + in idtac_list s. Abort. -Goal forall A B C (m1 m2 : list (list R)), - (0 < A)%Z -> - (0 < B)%Z -> - (0 < C)%Z -> - consistent m1 (Z.to_nat A,(Z.to_nat B,tt)) -> - consistent m2 (Z.to_nat B,(Z.to_nat C,tt)) -> - matmul_tiled_split (Z.to_nat A) (Z.to_nat B) (Z.to_nat C) m1 m2 4%Z = - matmul A B C m1 m2. +Derive string_matmul_tiled_split in + (stringy_spec_of [tZ; tZ; tZ; tensor_n 2; tensor_n 2] 2 matmul_args string_matmul_tiled_split matmul_precond (fun A B C m1 m2 => matmul_tiled_split A B C m1 m2 4%Z)) + as string_matmul_tiled_correct. Proof. - intros. + cbv [matmul_tiled_split matmul_precond]. prove_stringy_spec. + { destruct (f : False). (*seems true*) } +Qed. + +Goal True. let s := Llibfunc constr:("matmul_tiled_split") - constr:(($0 $+ ("m1", [ZLit A;ZLit B]) - $+ ("m2", [ZLit B;ZLit C]))) + matmul_args + string_matmul_tiled_split in idtac_list s. 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. - intros. +Goal True. let s := Llibfunc constr:("tensoradd") - constr:(($0 - $+ ("m1", - [ZLit (Z.of_nat A);ZLit (Z.of_nat B);ZLit (Z.of_nat C);ZLit (Z.of_nat A)]) - $+ ("m2", - [ZLit (Z.of_nat A);ZLit (Z.of_nat B);ZLit (Z.of_nat C);ZLit (Z.of_nat A)]))) + add_args + add_string in idtac_list s. -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_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. +Abort. + +Derive string_add_split in + (stringy_spec_of [tZ; tZ; tZ; tZ; tensor_n 4; tensor_n 4] 4 add_args string_add_split add_precond add_split) + as string_add_split_correct. Proof. - intros. + cbv [add_precond add_split]. prove_stringy_spec. + all: (destruct (f : False)). (*arithmetic, seems true*) +Qed. + +Goal True. let s := Llibfunc constr:("tensoradd_split") - constr:(($0 - $+ ("m1", - [ZLit (Z.of_nat A);ZLit (Z.of_nat B);ZLit (Z.of_nat C);ZLit (Z.of_nat A)]) - $+ ("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. - -Goal forall (c : (list R)) n m, - conv4 c n m = conv1 c n m. -Proof. - intros. - let s := Llibfunc constr:("conv4") - constr:(($0 $+ ("c",[ZLit n]))) + add_args + string_add_split in idtac_list s. Abort. -Goal forall (c : (list R)) n m, - conv4 c n m = conv1 c n m. -Proof. - intros. +Goal True. let s := Llibfunc constr:("conv4") - constr:(($0 $+ ("c",[ZLit n]))) + conv_args + conv4_string in idtac_list s. Abort. -Goal forall (c : (list R)) (n m : Z), - (0 < n)%Z -> - (-m+1 < n)%Z -> - consistent c (Z.to_nat n,tt) -> - conv1 c n m = conv4 c n m. -Proof. - intros. +Goal True. let s := Llibfunc constr:("conv1") - constr:(($0 $+ ("c",[ZLit n]))) + conv_args + conv1_string 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]) - <++> - (GEN [ 1 <= i < n - 1] - l _[i;j]) - <++> - (GEN [ n - 1 <= i < n ] - l _[i;j]) - ) - ) - = @nil _. -Proof. - intros. + +Goal True. let s := Llibfunc constr:("concattest1") - constr:($0 $+ ("l",[ZLit n; ZLit m])) + concat_test_args + concat_test1_string in idtac_list s. Abort. -Goal forall n m (l : list (list R)), - consistent l (n,(m,tt)) -> - Common.transpose ( - (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]) - ) - = @nil _. -Proof. - intros. +Goal True. let s := Llibfunc constr:("concattest0") - constr:($0 $+ ("l",[ZLit (Z.of_nat n); - ZLit (Z.of_nat m)])) + concat_test_args + concat_test0_string in idtac_list s. Abort. -Goal forall n m (v : list (list R)), - 0 < n -> - 0 < m -> - consistent v (n,(m,tt)) -> - Common.transpose ( - (GEN [ j < 1 ] - (GEN [ i < 1 ] - v _[i;j]) - <++> - (GEN [ 1 <= i < Z.of_nat n ] - v _[i;j]) - ) - <++> - (GEN [ 1 <= j < Z.of_nat m ] - GEN [ i < Z.of_nat n ] - v _[i;j] - ) - ) - = @nil _. -Proof. - intros. +Goal True. let s := Llibfunc constr:("concattest2") - constr:($0 $+ ("v",[ZLit (Z.of_nat n); - ZLit (Z.of_nat m)])) + concat_test_args + concat_test2_string in idtac_list s. Abort. -Goal forall n m (l : list (list R)), - consistent l (n,(m,tt)) -> - Common.transpose ( - GEN [ j < Z.of_nat m ] - (GEN [ i < 1 ] - l _[i;j]) - <++> - (GEN [ 1 <= i < Z.of_nat n ] - l _[i;j])) - = @nil _. -Proof. - intros. +Goal True. let s := Llibfunc constr:("concattest3") - constr:($0 $+ ("l",[ZLit (Z.of_nat n); - ZLit (Z.of_nat m)])) + concat_test_args + concat_test3_string in idtac_list s. Abort. -Goal forall n m (l : (list R)), - consistent l (n*m,tt) -> - Common.flatten ( - Common.transpose - ( - (GEN [ i < 1 ] - (GEN [ j < Z.of_nat n ] - l _[j * Z.of_nat m + i])) - <++> - (GEN [ 1 <= i < Z.of_nat m ] - (GEN [ j < Z.of_nat n ] - l _[j * Z.of_nat m + i])) - )) - - = @nil _. -Proof. - intros. +Goal True. let s := Llibfunc constr:("concattest4") - constr:($0 $+ ("l",[ZLit (Z.of_nat n); ZLit (Z.of_nat m)])) in idtac_list s. + concat_test4_args + concat_test4_string + in idtac_list s. Abort. - Goal forall N M (v : list (list R)), - 0 < N -> - 0 < M -> - consistent v (N,(M,tt)) -> - blurimmediate v M N = blurtwostage N M v. - Proof. - intros. - let s := Llibfunc constr:("blurim") - constr:($0 $+ ("v",[ZLit (Z.of_nat N); - ZLit (Z.of_nat M)])) in idtac_list s. +Goal True. + let s := Llibfunc constr:("blurim") + blur_args + blurimmediate_string + in idtac_list s. 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. - intros. + +Goal True. let s := Llibfunc constr:("blurtwo") - constr:($0 $+ ("v",[ZLit (Z.of_nat N); - ZLit (Z.of_nat M)])) in - idtac_list s. + blur_args + blurtwostage_string + in idtac_list s. 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 @@ -370,122 +254,73 @@ Proof. let s := Llibfunc constr:("blurtiles") in idtac_list s. *) -Goal forall n m (l : list (list R)), - 0 < n -> - 0 < m -> - consistent l (n,(m,tt)) -> - blur_tiles_guarded l n m 64 64 - = @nil _. +Derive blur_tiles_guarded64_string in + (stringy_spec_of [tZ; tZ; tensor_n 2] 2 blur_args blur_tiles_guarded64_string blur_precond' (blur_tiles_guarded 64 64)) + as blur_tiles_guarded64_string_correct. Proof. - autounfold with examples. intros. + cbv [blur_tiles_guarded blur_precond']. prove_stringy_spec. + all: destruct (f : False). +Qed. + +Goal True. let s := Llibfunc constr:("blurtiles") - constr:($0 $+ ("l",[ZLit (Z.of_nat n); ZLit (Z.of_nat m)])) in idtac_list s. + blur_args + blur_tiles_guarded64_string + in idtac_list s. 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. - intros. +Goal True. let s := Llibfunc constr:("fusion_nb") - constr:($0 $+ ("l",[ZLit (Z.of_nat n); ZLit (Z.of_nat m)])) in idtac_list s. + fusion_args + fusion_no_boundary_string + in idtac_list s. Abort. -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 -> - (Z.of_nat (length x) < W)%Z -> - gather W x w = @nil _. -Proof. - intros. +Goal True. let s := Llibfunc constr:("gather") - constr:($0 $+ ("x",[ZLit RR]) $+ ("w",[ ZLit RR])) in idtac_list s. -Abort. - -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 -> - (Z.of_nat (length x) < W)%Z -> - scatter W x w = @nil _. -Proof. - intros. + gather_args + gather_string + in idtac_list s. +Abort. + +Goal True. let s := Llibfunc constr:("scatter") - constr:($0 $+ ("x",[ZLit RR]) $+ ("w",[ ZLit RR])) in idtac_list s. + scatter_args + scatter_string + 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 -> - consistent w (A,(B,tt))-> - consistent x (Z.to_nat K,tt) -> - im2colminilifted K W RR w x = im2colmini K W RR w x. -Proof. - intros. +Goal True. let s := Llibfunc constr:("im2collifted") - constr:($0 $+ ("x",[ZLit K]) $+ - ("w",[ ZLit (Z.of_nat A); - ZLit (Z.of_nat B)])) - 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 -> - consistent w (A,(B,tt))-> - consistent x (Z.to_nat K,tt) -> - im2colminilifted K W RR w x = im2colmini K W RR w x. -Proof. - intros. + im2col_args + im2colminilifted_string + in idtac_list s. +Abort. + +Goal True. let s := Llibfunc constr:("im2col") - constr:($0 $+ ("x",[ZLit K]) $+ - ("w",[ ZLit (Z.of_nat A); - ZLit (Z.of_nat B)])) - in idtac_list s. - + im2col_args + im2colmini_string + in idtac_list s. Abort. -Goal forall n m (v : list (list R)), - 2 < n -> - 2 < m -> - consistent v (n,(m,tt)) -> - blurimmediate_partition n m v = @nil _. -Proof. - intros. +Goal True. let s := Llibfunc constr:("blurpart") - constr:($0 $+ ("v",[ZLit (Z.of_nat n); - ZLit (Z.of_nat m)])) + blur_args + blurimmediate_partition_string in idtac_list s. 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. - intros. +Goal True. let s := Llibfunc constr:("blurisolate") - constr:($0 $+ ("v",[ZLit (Z.of_nat n); - ZLit (Z.of_nat m)])) - in idtac_list s. + blur_args + blurimmediate_isolate_string + in idtac_list s. 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. - intros. +Goal True. let s := Llibfunc constr:("blurtwopart") - constr:($0 $+ ("v",[ZLit (Z.of_nat N); - ZLit (Z.of_nat M)])) - in idtac_list s. + blur_args + blurtwostage_partition_string + in idtac_list s. Abort. diff --git a/src/verified_lowering/stringify/GenTest.v b/src/verified_lowering/stringify/GenTest.v index 16a16b3..0ba902c 100644 --- a/src/verified_lowering/stringify/GenTest.v +++ b/src/verified_lowering/stringify/GenTest.v @@ -32,14 +32,14 @@ Ltac Ltime name default_dim reps := let callocs_frees_args := allocs_for_call in let callocs := fst2 callocs_frees_args in let frees := snd2 callocs_frees_args in - + let arg_vals := args_for_call default_dim in let allocs := fst3 arg_vals in let call_vals' := snd3 arg_vals in let call_vals := match call_vals' with | String _ ?s' => s' | EmptyString => EmptyString - end in + end in let _ := match goal with _ => intros end in let prog := match goal with |- ?prog = _ => prog end in @@ -48,21 +48,21 @@ Ltac Ltime name default_dim reps := let funcname := name in let size := alloc_size prog in - + let _ := match goal with _ => assert Z by exact 0%Z end in let i := match goal with H : Z |- _ => constr:(ltac:(to_str H)) end in - + let main := constr:( (app ((funcname++"_time.c"):: - HEADERS) + HEADERS) (app (("#include @"++funcname++".h@"):: "":: "int main() {":: "srandom(time(NULL));":: allocs) - + (app callocs (app @@ -71,7 +71,7 @@ Ltac Ltime name default_dim reps := ("for (int "++i++" = 0; "++i++" < "++reps++"; "++i++"++) {"):: "clock_t start = clock();":: (funcname++"("++call_vals++",output);"):: - "clock_t end = clock();":: + "clock_t end = clock();":: "double t = ((double) (end - start)/CLOCKS_PER_SEC);":: "accum += t;":: "}":: @@ -79,7 +79,7 @@ Ltac Ltime name default_dim reps := ("float avg = accum / "++reps++";"):: ("printf(@"++funcname++"\t"++default_dim++"\t"++"%lfs~@,avg);"):: frees) - + ["return 0;"; "}"]))))) in let ret' := constr:("!!!"::main) in @@ -91,18 +91,18 @@ Ltac Leq lname rname default_dim := let callocs_frees_args := allocs_for_call in let callocs := fst2 callocs_frees_args in let frees := snd2 callocs_frees_args in - + let arg_vals := args_for_call default_dim in let allocs := fst3 arg_vals in let call_vals' := snd3 arg_vals in let call_vals := match call_vals' with | String _ ?s' => s' | EmptyString => EmptyString - end in + end in let _ := match goal with _ => intros end in let lprog := match goal with |- ?prog = _ => prog end in - let rprog := match goal with |- _ = ?prog => prog end in + let rprog := match goal with |- _ = ?prog => prog end in let progty := type of lprog in let tystr := type_to_str progty in @@ -123,7 +123,7 @@ Ltac Leq lname rname default_dim := constr:(["for (int "++x++" = 0; "++x++" < "++nums++"; "++x++"++) {"; "assert(loutput["++x++"] == routput["++x++"]);"; "}"]) in - + let main := constr:( (app ((lname++"_"++rname++"_eq.c"):: HEADERS) @@ -158,14 +158,14 @@ Ltac Lid lname default_dim := let callocs_frees_args := allocs_for_call in let callocs := fst2 callocs_frees_args in let frees := snd2 callocs_frees_args in - + let arg_vals := args_for_call default_dim in let allocs := fst3 arg_vals in let call_vals' := snd3 arg_vals in let call_vals := match call_vals' with | String _ ?s' => s' | EmptyString => EmptyString - end in + end in let _ := match goal with _ => intros end in let lprog := match goal with |- ?prog = _ => prog end in @@ -189,7 +189,7 @@ Ltac Lid lname default_dim := constr:(["for (int "++x++" = 0; "++x++" < "++nums++"; "++x++"++) {"; "assert(loutput["++x++"] == v["++x++"]);"; "}"]) in - + let main := constr:( (app ((lname++"_"++"id_eq.c"):: HEADERS) @@ -199,15 +199,15 @@ Ltac Lid lname default_dim := "int main() {":: "srandom(time(NULL));":: allocs) - + (app callocs - + (app ((tystr++" loutput = ("++scalar++"*) calloc(1,"++size++");"):: (lname++"("++call_vals++",loutput);"):: comp) - + (app frees - + ["free(loutput);"; "return 0;"; "}"])))))) in @@ -216,77 +216,76 @@ Ltac Lid lname default_dim := let ret := eval simpl in ret' in ret. -Goal forall A B C (m1 m2 : list (list R)), +Goal forall (m2 m1 : list (list R)) C B A, (0 < A)%Z -> (0 < B)%Z -> (0 < C)%Z -> consistent m1 (Z.to_nat A,(Z.to_nat B,tt)) -> consistent m2 (Z.to_nat B,(Z.to_nat C,tt)) -> - matmul_tiled_split (Z.to_nat A) (Z.to_nat B) (Z.to_nat C) m1 m2 4 = + matmul_tiled_split A B C m1 m2 4 = matmul A B C m1 m2. Proof. let s := Leq constr:("matmul_tiled_split") constr:("matmul") constr:("50") in idtac_list s. Abort. -Goal forall A B C (m1 m2 : list (list R)), +Goal forall (m2 m1 : list (list R)) C B A, (0 < A)%Z -> (0 < B)%Z -> (0 < C)%Z -> consistent m1 (Z.to_nat A,(Z.to_nat B,tt)) -> 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. + matmul A B C m1 m2 = matmul_tiled A B C m1 m2 4%Z. Proof. let s := Leq constr:("matmul") constr:("matmul_tiled") constr:("50") in idtac_list s. 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 = + +Goal forall (m2 m1 : (list (list (list (list R))))) D C B A, + (0 < A)%Z -> + (0 < B)%Z -> + (0 < C)%Z -> + (0 < D)%Z -> + consistent m1 (Z.to_nat A,(Z.to_nat B,(Z.to_nat C,(Z.to_nat D,tt)))) -> + consistent m2 (Z.to_nat A,(Z.to_nat B,(Z.to_nat C,(Z.to_nat D,tt)))) -> + add A B C D m1 m2 = add_split A B C D m1 m2. Proof. let s := Leq constr:("tensoradd") constr:("tensoradd_split") constr:("50") in idtac_list s. Abort. - -Goal forall N M (v : list (list R)), - 0 < N -> - 0 < M -> - consistent v (N,(M,tt)) -> - blurimmediate v M N = blurtwostage N M v. + +Goal forall (v : list (list R)) M N, + (0 < N)%Z -> + (0 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> + blurimmediate N M v = blurtwostage N M v. Proof. let s := Leq constr:("blurim") constr:("blurtwo") constr:("50") in idtac_list s. Abort. -Goal forall N M (v : list (list R)), - 2 < N -> - 2 < M -> - consistent v (N,(M,tt)) -> - blurimmediate_partition N M v = blurimmediate v M N. +Goal forall (v : list (list R)) M N, + (2 < N)%Z -> + (2 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> + blurimmediate_partition N M v = blurimmediate N M v. Proof. let s := Leq constr:("blurpart") constr:("blurim") constr:("50") in idtac_list s. Abort. -Goal forall N M (v : list (list R)), - 2 < N -> - 2 < M -> - consistent v (N,(M,tt)) -> +Goal forall (v : list (list R)) M N, + (2 < N)%Z -> + (2 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> blurimmediate_partition N M v = blurimmediate_isolate N M v. Proof. let s := Leq constr:("blurpart") constr:("blurisolate") constr:("50") in idtac_list s. Abort. - -Goal forall N M (v : list (list R)), - 2 < N -> - 2 < M -> - consistent v (N,(M,tt)) -> +Goal forall (v : list (list R)) M N, + (2 < N)%Z -> + (2 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> blurtwostage_partition N M v = blurtwostage N M v. Proof. let s := Leq constr:("blurtwopart") constr:("blurtwo") constr:("50") in idtac_list s. @@ -319,26 +318,26 @@ Proof. let s := Ltime constr:("tile_nb") constr:("2000") constr:("50") in idtac_list s. Abort. *) -Goal forall N M (v : list (list R)), - 0 < N -> - 0 < M -> - consistent v (N,(M,tt)) -> - blurimmediate v M N = blur_tiles_guarded v N M 64 64. +Goal forall (v : list (list R)) M N, + (0 < N)%Z -> + (0 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> + blurimmediate N M v = blur_tiles_guarded 64 64 N M v. Proof. let s := Leq constr:("blurim") constr:("blurtiles") constr:("2000") in idtac_list s. Abort. -Goal forall W R0 (x w : list R), +Goal forall (w x : list R) R0 W, consistent w (Z.to_nat R0, tt) -> consistent x (Z.to_nat R0, tt) -> (0 < W)%Z -> (Z.of_nat (length x) < W)%Z -> gather W x w = scatter W x w. -Proof. +Proof. let s := Leq constr:("gather") constr:("scatter") constr:("10") in idtac_list s. Abort. -Goal forall (c : (list R)) (n m : Z), +Goal forall (c : (list R)) (m n: Z), (0 < n)%Z -> (-m+1 < n)%Z -> consistent c (Z.to_nat n,tt) -> @@ -347,26 +346,26 @@ Proof. let s := Leq constr:("conv4") constr:("conv1") constr:("100") in idtac_list s. Abort. -Goal forall A B K W RR (w : list (list R)) (x : list R), +Goal forall (x : list R) (w : list (list R)) RR W K B A, (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. Proof. let s := Leq constr:("im2collifted") constr:("im2col") constr:("50") in idtac_list s. -Abort. +Abort. -Goal forall n m (v : list (list R)), - consistent v (n,(m,tt)) -> +Goal forall (v : list (list R)) m n, + consistent v (Z.to_nat n,(Z.to_nat m,tt)) -> transpose ( (GEN [ j < 1 ] - GEN [ i < Z.of_nat n ] + GEN [ i < n ] v _[i;j]) - <++> - (GEN [ 1 <= j < Z.of_nat m ] - GEN [ i < Z.of_nat n ] + <++> + (GEN [ 1 <= j < m ] + GEN [ i < n ] v _[i;j]) ) = @nil _. @@ -375,20 +374,20 @@ Proof. Abort. -Goal forall n m (v : list (list R)), - 0 < n -> - 0 < m -> - consistent v (n,(m,tt)) -> +Goal forall (v : list (list R)) m n, + (0 < n)%Z -> + (0 < m)%Z -> + consistent v (Z.to_nat n,(Z.to_nat m,tt)) -> transpose ( (GEN [ j < 1 ] - GEN [ i < Z.of_nat n ] + GEN [ i < n ] v _[i;j]) - <++> - (GEN [ 1 <= j < Z.of_nat m ] + <++> + (GEN [ 1 <= j < m ] (GEN [ i < 1 ] v _[i;j]) <++> - (GEN [ 1 <= i < Z.of_nat n ] + (GEN [ 1 <= i < n ] v _[i;j]) ) ) @@ -397,21 +396,21 @@ Proof. let s := Lid constr:("concattest1") constr:("10") in idtac_list s. Abort. -Goal forall n m (v : list (list R)), - 0 < n -> - 0 < m -> - consistent v (n,(m,tt)) -> +Goal forall (v : list (list R)) m n, + (0 < n)%Z -> + (0 < m)%Z -> + consistent v (Z.to_nat n,(Z.to_nat m,tt)) -> transpose ( (GEN [ j < 1 ] (GEN [ i < 1 ] v _[i;j]) <++> - (GEN [ 1 <= i < Z.of_nat n ] - v _[i;j]) + (GEN [ 1 <= i < n ] + v _[i;j]) ) - <++> - (GEN [ 1 <= j < Z.of_nat m ] - GEN [ i < Z.of_nat n ] + <++> + (GEN [ 1 <= j < m ] + GEN [ i < n ] v _[i;j] ) ) @@ -420,26 +419,26 @@ Proof. let s := Lid constr:("concattest2") constr:("10") in idtac_list s. Abort. -Goal forall n m (v : list (list R)), - consistent v (n,(m,tt)) -> +Goal forall (v : list (list R)) m n, + consistent v (Z.to_nat n,(Z.to_nat m,tt)) -> transpose ( - GEN [ j < Z.of_nat m ] + GEN [ j < m ] (GEN [ i < 1 ] v _[i;j]) <++> - (GEN [ 1 <= i < Z.of_nat n ] + (GEN [ 1 <= i < n ] v _[i;j])) = @nil _. Proof. let s := Lid constr:("concattest3") constr:("10") in idtac_list s. Abort. -Goal forall n m (v : (list R)), - consistent v (n*m,tt) -> +Goal forall (v : (list R)) m n, + consistent v (Z.to_nat n * Z.to_nat m,tt) -> flatten ( - (GEN [ j < Z.of_nat n ] - (GEN [ i < Z.of_nat m ] - v _[j * Z.of_nat m + i])) + (GEN [ j < n ] + (GEN [ i < m ] + v _[j * m + i])) ) = @nil _. @@ -448,53 +447,52 @@ Proof. Abort. (* - *) -Goal forall N M (v : list (list R)), - 0 < N -> - 0 < M -> - consistent v (N,(M,tt)) -> - blurimmediate v M N = blurtwostage N M v. +Goal forall (v : list (list R)) M N, + (0 < N)%Z -> + (0 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> + blurimmediate N M v = blurtwostage N M v. Proof. let s := Ltime constr:("blurim") constr:("1000") constr:("3") in idtac_list s. Abort. -Goal forall N M (v : list (list R)), - 2 < N -> - 2 < M -> - consistent v (N,(M,tt)) -> +Goal forall (v : list (list R)) M N, + (2 < N)%Z -> + (2 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> blurimmediate_partition N M v = blurimmediate_partition N M v. Proof. let s := Ltime constr:("blurpart") constr:("1000") constr:("3") in idtac_list s. Abort. -Goal forall N M (v : list (list R)), - 2 < N -> - 2 < M -> - consistent v (N,(M,tt)) -> +Goal forall (v : list (list R)) M N, + (2 < N)%Z -> + (2 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> blurtwostage_partition N M v = blurimmediate_partition N M v. Proof. let s := Ltime constr:("blurtwopart") constr:("1000") constr:("3") in idtac_list s. 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. +Goal forall (v : list (list R)) M N, + (0 < N)%Z -> + (0 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> + blurtwostage N M v = blurimmediate N M v. Proof. - let s := Ltime constr:("blurtwo") constr:("1000") constr:("3") in idtac_list s. + let s := Ltime constr:("blurtwo") constr:("1000") constr:("3") in idtac_list s. Abort. - -Goal forall N M (v : list (list R)), - 0 < N -> - 0 < M -> - consistent v (N,(M,tt)) -> - blur_tiles_guarded v N M 64 64 = blurimmediate v M N. +Goal forall (v : list (list R)) M N, + (0 < N)%Z -> + (0 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,tt)) -> + blur_tiles_guarded 64 64 N M v = blurimmediate N M v. Proof. - let s := Ltime constr:("blurtiles") constr:("2000") constr:("10") in idtac_list s. + let s := Ltime constr:("blurtiles") constr:("2000") constr:("10") in idtac_list s. Abort. -Goal forall W R0 (x w : list R), +Goal forall (w x : list R) R0 W, consistent w (Z.to_nat R0, tt) -> consistent x (Z.to_nat R0, tt) -> (0 < W)%Z -> @@ -502,19 +500,19 @@ Goal forall W R0 (x w : list R), gather W x w = scatter W x w. Proof. let s := Ltime constr:("gather") constr:("10") constr:("10") in idtac_list s. -Abort. +Abort. -Goal forall W R0 (x w : list R), +Goal forall (w x : list R) R0 W, consistent w (Z.to_nat R0, tt) -> consistent x (Z.to_nat R0, tt) -> (0 < W)%Z -> (Z.of_nat (length x) < W)%Z -> scatter W x w = gather W x w. -Proof. +Proof. let s := Ltime constr:("scatter") constr:("10") constr:("10") in idtac_list s. -Abort. +Abort. -Goal forall (c : (list R)) (n m : Z), +Goal forall (c : (list R)) (m n : Z), (0 < n)%Z -> (-m+1 < n)%Z -> consistent c (Z.to_nat n,tt) -> @@ -523,7 +521,7 @@ Proof. let s := Ltime constr:("conv4") constr:("100") constr:("10") in idtac_list s. Abort. -Goal forall (c : (list R)) (n m : Z), +Goal forall (c : (list R)) (m n : Z), (0 < n)%Z -> (-m+1 < n)%Z -> consistent c (Z.to_nat n,tt) -> @@ -532,25 +530,24 @@ Proof. let s := Ltime constr:("conv1") constr:("100") constr:("10") in idtac_list s. Abort. -Goal forall A B K W RR (w : list (list R)) (x : list R), +Goal forall (x : list R) (w : list (list R)) RR W K B A, (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. Proof. let s := Ltime constr:("im2collifted") constr:("50") constr:("10") in idtac_list s. -Abort. +Abort. -Goal forall A B K W RR (w : list (list R)) (x : list R), +Goal forall (x : list R) (w : list (list R)) RR W K B A, (0 < K)%Z -> (0 < W)%Z -> - (0 < RR)%Z -> + (0 < RR)%Z -> consistent w (A,(B,tt))-> consistent x (Z.to_nat K,tt) -> im2colmini K W RR w x = im2colminilifted K W RR w x. Proof. let s := Ltime constr:("im2col") constr:("50") constr:("10") in idtac_list s. -Abort. - +Abort. diff --git a/src/verified_lowering/stringify/Stringify.v b/src/verified_lowering/stringify/Stringify.v index c784d8a..4a79ece 100644 --- a/src/verified_lowering/stringify/Stringify.v +++ b/src/verified_lowering/stringify/Stringify.v @@ -40,119 +40,40 @@ Ltac to_str := ltac2:(n |- let n := Option.get (Ltac1.to_constr n) in let str := match Constr.Unsafe.kind n with - | Constr.Unsafe.Var v => IdentParsing.coq_string_of_ident v + | Constr.Unsafe.Var v => IdentParsing.coq_string_of_ident v | _ => constr:("") end in exact $str). -Ltac stringify_nat n := - match n with - | (?x + ?y)%nat => - let xstr := stringify_nat x in - let ystr := stringify_nat y in - constr:((xstr++" + "++ystr)%string) - | (?x - ?y)%nat => - let xstr := stringify_nat x in - let ystr := stringify_nat y in - constr:(xstr ++ " - (" ++ ystr ++ ")") - | (?x * ?y)%nat => - let xstr := stringify_nat x in - let ystr := stringify_nat y in - constr:("("++xstr ++ ") * (" ++ ystr ++")") - | (?x //n ?y)%nat => - let xstr := stringify_nat x in - let ystr := stringify_nat y in - constr:("((" ++ xstr ++ ") + (" ++ ystr ++ ") - 1 ) / (" ++ ystr ++")") - | Z.to_nat ?z => stringify_int z - | _ => let _ := match goal with _ => is_var n end in - constr:(ltac:(to_str n)) - | _ => constr:(nat_to_string n) - end with stringify_int z := - match z with - | (?x + ?y)%Z => - 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 ++")") - | (?x - ?y)%Z => - 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 ++"))") - | (?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 - | _ => let _ := match goal with _ => is_var x end in - constr:(ltac:(to_str x)) - | _ => - constr:(int_to_string x) - end in - constr:(("- "++xstr)%string) - | Z.of_nat ?n => stringify_nat n - | _ => let _ := match goal with _ => is_var z end in - constr:(ltac:(to_str z)) - | _ => constr:(int_to_string z) - end. - -Ltac stringify_Zexpr z := +Fixpoint stringify_Zexpr z := match z with - | ZPlus ?x ?y => - let xstr := stringify_Zexpr x in - let ystr := stringify_Zexpr y in - constr:(xstr ++ " + " ++ ystr) - | ZMinus ?x ?y => - let xstr := stringify_Zexpr x in - let ystr := stringify_Zexpr y in - constr:(xstr ++ " - (" ++ ystr ++ ")") - | ZTimes ?x ?y => - let xstr := stringify_Zexpr x in - let ystr := stringify_Zexpr y in - constr:("("++xstr ++ ") * (" ++ ystr ++")") - | ZDivc ?x ?y => - let xstr := stringify_Zexpr x in - let ystr := stringify_Zexpr y in - constr:("((" ++ xstr ++ ") + (" ++ ystr ++ ") - 1 ) / (" ++ ystr ++")") - | ZDivf ?x ?y => - let xstr := stringify_Zexpr x in - let ystr := stringify_Zexpr y in - constr:("((" ++ xstr ++ ") / (" ++ ystr ++"))") - | (ZMod ?x ?y)%Z => - let xstr := stringify_Zexpr x in - let ystr := stringify_Zexpr y in - constr:("((" ++ xstr ++ ") % (" ++ ystr ++"))") - | ZVar ?s => s - | ZLit ?z => stringify_int z + | ZPlus x y => + stringify_Zexpr x ++ " + " ++ stringify_Zexpr y + | ZMinus x y => + stringify_Zexpr x ++ " - (" ++ stringify_Zexpr y ++ ")" + | ZTimes x y => + "(" ++ stringify_Zexpr x ++ ") * (" ++ stringify_Zexpr y ++ ")" + | ZDivc x y => + "((" ++ stringify_Zexpr x ++ ") + (" ++ stringify_Zexpr y ++ ") - 1 ) / (" ++ stringify_Zexpr y ++ ")" + | ZDivf x y => + "((" ++ stringify_Zexpr x ++ ") / (" ++ stringify_Zexpr y ++ "))" + | ZMod x y => + "((" ++ stringify_Zexpr x ++ ") % (" ++ stringify_Zexpr y ++ "))" + | ZVar s => s + | ZLit z => int_to_string z end. -Ltac stringify_Bexpr p := +Fixpoint stringify_Bexpr p := match p with - | And ?a ?b => - let astr := stringify_Bexpr a in - let bstr := stringify_Bexpr b in - constr:(astr ++ " && " ++ bstr) - | Le ?a ?b %Z => - let xstr := stringify_Zexpr a in - let ystr := stringify_Zexpr b in - constr:(xstr ++ " <= " ++ ystr) - | Eq ?x ?y => - let xstr := stringify_Zexpr x in - let ystr := stringify_Zexpr y in - constr:(xstr ++ " == " ++ ystr) - | Lt ?x ?y => - let xstr := stringify_Zexpr x in - let ystr := stringify_Zexpr y in - constr:(xstr ++ " < " ++ ystr) + | And a b => + stringify_Bexpr a ++ " && " ++ stringify_Bexpr b + | Le a b => + stringify_Zexpr a ++ " <= " ++ stringify_Zexpr b + | Eq x y => + stringify_Zexpr x ++ " == " ++ stringify_Zexpr y + | Lt x y => + stringify_Zexpr x ++ " < " ++ stringify_Zexpr y end. Fixpoint flatten_list_Zexpr_helper (l : list (Zexpr * Zexpr)) @@ -173,39 +94,34 @@ Fixpoint swap_tups {X Y} (l : list (X * Y)) : list (Y * X) := | _ => [] end. -Ltac stringify_Sstmt s := +Definition Q_to_string x := + int_to_string (Qnum x) ++ "/ (" ++ int_to_string (Zpos (Qden x)) ++ ")". + +Fixpoint stringify_Sstmt s := match s with - | SVar ?v => v - | SGet ?v ?idx => - let idx := constr:(swap_tups idx) in - let idx := eval simpl in idx in - let flat_idx_ := constr:((flatten_list_Zexpr idx)) in - let flat_idx_ := eval unfold flatten_list_Zexpr in flat_idx_ in - let flat_idx := eval simpl in flat_idx_ in + | SVar v => v + | SGet v idx => + let idx := swap_tups idx in + let flat_idx := flatten_list_Zexpr idx in let idxstr := stringify_Zexpr flat_idx in - constr:((v++"["++idxstr++"]")%string) - | SMul ?x ?y => + v ++ "[" ++ idxstr ++ "]" + | SMul x y => let xstr := stringify_Sstmt x in let ystr := stringify_Sstmt y in - constr:((xstr ++ " * (" ++ ystr ++ ")")%string) - | SAdd ?x ?y => + xstr ++ " * (" ++ ystr ++ ")" + | SAdd x y => let xstr := stringify_Sstmt x in let ystr := stringify_Sstmt y in - constr:((xstr ++ " + (" ++ ystr ++ ")")%string) - | SDiv ?x ?y => + xstr ++ " + (" ++ ystr ++ ")" + | SDiv x y => let xstr := stringify_Sstmt x in let ystr := stringify_Sstmt y in - constr:((xstr ++ " / (" ++ ystr ++ ")")%string) - | SSub ?x ?y => + xstr ++ " / (" ++ ystr ++ ")" + | SSub x y => let xstr := stringify_Sstmt x in let ystr := stringify_Sstmt y in - constr:((xstr ++ " - (" ++ ystr ++ ")")%string) - | SLit ?r => match r with - | 0%Q => constr:("0") - | 1%Q => constr:("1") - | 2%Q => constr:("2") - | 3%Q => constr:("3") - end + xstr ++ " - (" ++ ystr ++ ")" + | SLit r => Q_to_string r end. Definition stringify_storetype s := @@ -214,48 +130,44 @@ Definition stringify_storetype s := | Reduce => " += " end. -Ltac stringify_stmt s := +Fixpoint stringify_stmt s := match s with - | Store ?redeq ?v ?idx ?sc => + | Store redeq v idx sc => match idx with - | @nil (Zexpr * Zexpr) => - let redstr := constr:((stringify_storetype redeq)) in + | [] => + let redstr := stringify_storetype redeq in let str := stringify_Sstmt sc in - constr:([v ++ redstr ++ str ++ ";"]) + [v ++ redstr ++ str ++ ";"] | _ => - let redstr := constr:((stringify_storetype redeq)) in - let flat_idx_ := constr:((flatten_list_Zexpr idx)) in - let flat_idx_ := eval unfold flatten_list_Zexpr in flat_idx_ in - let flat_idx := eval simpl in flat_idx_ in + let redstr := stringify_storetype redeq in + let flat_idx := flatten_list_Zexpr idx in let idxstr := stringify_Zexpr flat_idx in let str := stringify_Sstmt sc in - constr:([v ++ "[" ++ idxstr ++ "]" ++ redstr ++ str ++ ";"]) + [v ++ "[" ++ idxstr ++ "]" ++ redstr ++ str ++ ";"] end - | If ?b ?s1 => + | If b s1 => let bstr := stringify_Bexpr b in let sstr := stringify_stmt s1 in - constr:( ( [("if ("++bstr++") {")%string] - ++ sstr - ++ ["}"])%list ) - | AllocV ?v ?size => + ( [("if ("++bstr++") {")%string] + ++ sstr + ++ ["}"])%list + | AllocV v size => let sizestr := stringify_Zexpr size in - constr:( ([("float *" ++ v ++ " = calloc("++ sizestr ++", sizeof(float));")%string])%list ) - | AllocS ?v => - constr:( ([("{ float " ++ v ++ " = 0;")%string])%list ) - | DeallocS ?v => - constr:( (["}"])%list ) - | Free ?v => - constr:( ([("free("++v++");")%string])%list ) - | For ?i ?lo ?hi ?body => + ["float *" ++ v ++ " = calloc("++ sizestr ++", sizeof(float));"] + | AllocS v => + ["{ float " ++ v ++ " = 0;"] + | DeallocS v => + ["}"] + | Free v => + ["free("++v++");"] + | For i lo hi body => let lostr := stringify_Zexpr lo in let histr := stringify_Zexpr hi in let bodystr := stringify_stmt body in - constr:(([("for (int "++i++" = "++lostr++"; "++i++" < "++histr++"; " - ++i++"++) {")%string] - ++ bodystr - ++ ["}"])%list) - | Seq ?s1 ?s2 => - let str1 := stringify_stmt s1 in - let str2 := stringify_stmt s2 in - constr:((str1++str2)%list) + ([("for (int "++i++" = "++lostr++"; "++i++" < "++histr++"; " + ++i++"++) {")%string] + ++ bodystr + ++ ["}"])%list + | Seq s1 s2 => + (stringify_stmt s1 ++ stringify_stmt s2)%list end. diff --git a/src/verified_scheduling/atl/ATL.v b/src/verified_scheduling/atl/ATL.v index 4ca3c6c..3e558de 100644 --- a/src/verified_scheduling/atl/ATL.v +++ b/src/verified_scheduling/atl/ATL.v @@ -13,7 +13,7 @@ Import ListNotations. Set Warnings "-deprecate-hint-without-locality,-deprecated". -Class TensorElem (A : Set) := +Class TensorElem (A : Type) := { null : A; bin : A -> A -> A; shape : Set; @@ -434,7 +434,7 @@ Proof. - lia. Qed. -Lemma get_znlt_null : forall i (X : Set) (H: TensorElem X) (v : list X) x, +Lemma get_znlt_null : forall i (X : Type) (H: TensorElem X) (v : list X) x, ~ (i < Z.of_nat (length (x::v)))%Z-> (x::v) _[ i ] = (|[ false ]| x). Proof. diff --git a/src/verified_scheduling/atl/Common.v b/src/verified_scheduling/atl/Common.v index f26e7a4..431f7d8 100644 --- a/src/verified_scheduling/atl/Common.v +++ b/src/verified_scheduling/atl/Common.v @@ -23,7 +23,7 @@ From ATL Require Import ATL Tactics Div. Generalizable All Variables. Instance pointwise_eq_ext {A B : Type} `(sb : subrelation B RB Logic.eq) - : subrelation (pointwise_relation A RB) Logic.eq. + : subrelation (pointwise_relation A RB) Logic.eq. Proof. intros f g Hfg. apply functional_extensionality. intro x; apply sb, (Hfg x). Qed. @@ -34,15 +34,6 @@ Definition to_val {X} `{TensorElem X} (opt : option X) : X := | Some v => v end. -Lemma nth_map {X} `{TensorElem X} : forall i f v, - i < length v -> - @nth_error X (List.map f v) i = Some (f (to_val (nth_error v i))). -Proof. - induction i; intros f v H0; destruct v; simpl in *; - try contra_crush; auto. - apply IHi. lia. -Qed. - (* Hole Establishing and Context Diving *) Lemma concat_eq_l {X} `{TensorElem X} : @@ -97,12 +88,12 @@ Proof. Qed. Lemma tlet_id_split {X Y} `{TensorElem X} `{TensorElem Y} : forall (f : X -> X) (g : X -> X) s (x : X) (body : X -> Y), - consistent x s -> + consistent x s -> (forall x', consistent x' s -> f (g x') = x') -> let_binding x body = let_binding (g x) (fun x' => body (f x')). Proof. intros. - unfold let_binding. + unfold let_binding. rewrite H2; auto. Qed. @@ -113,7 +104,7 @@ Lemma tlet_eq_body {X Y} : Proof. intros. unfold let_binding. auto. Qed. - + Lemma bin_eq_l {X} `{TensorElem X} : forall a b c, a = b -> a <+> c = b <+> c. Proof. @@ -179,7 +170,7 @@ Proof. replace (Z.of_nat i + m + 1)%Z with ((Z.of_nat (S i)) + m)%Z by (rewrite Nat2Z.inj_succ; lia). apply H0; lia. -Qed. +Qed. Theorem sumr_eq_bound {X} `{TensorElem X} : forall n m f g, (forall i, m <= i -> i < n -> @@ -191,10 +182,10 @@ Proof. destruct (0<=?n-m)%Z eqn:nm; unbool. apply sum_helper_eq_bound. intros. apply H0. lia. - zify. + zify. lia. destruct (n-m)%Z. lia. zify. lia. reflexivity. -Qed. +Qed. Theorem gen_helper_eq_bound {X} `{TensorElem X} : forall n m f g, (forall i, 0 <= i -> i < n -> @@ -210,7 +201,7 @@ Proof. replace (Z.of_nat i + m + 1)%Z with ((Z.of_nat (S i)) + m)%Z by (rewrite Nat2Z.inj_succ; lia). apply H0; lia. -Qed. +Qed. Hint Resolve sum_helper_eq_bound : crunch. @@ -237,13 +228,13 @@ Theorem genr_eq_bound {X} `{TensorElem X} : forall N (f g : Z -> X) K, GEN [ K <= i < N ] f i = GEN [ K <= i < N ] g i. Proof. destruct N; intros; try reflexivity. - unfold gen, genr. + unfold gen, genr. apply gen_helper_eq_bound; intros. apply H0. lia. zify. lia. - unfold gen, genr. + unfold gen, genr. apply gen_helper_eq_bound; intros. apply H0. lia. zify. lia. - unfold gen, genr. + unfold gen, genr. apply gen_helper_eq_bound; intros. apply H0. lia. zify. lia. Qed. @@ -263,7 +254,7 @@ Hint Resolve gen_eq_bound : crunch. Lemma iverson_eq {X} `{TensorElem X} : forall p1 p2 e, p1 = p2 -> (|[ p1 ]| e) = (|[ p2 ]| e). -Proof. +Proof. intros. subst. reflexivity. Qed. @@ -382,14 +373,14 @@ Proof. induction (Z.to_nat (n-k)%Z); simpl; auto with crunch. Qed. -Lemma get_neg_null : forall i (X: Set) (H: TensorElem X) x v, +Lemma get_neg_null : forall i (X: Type) (H: TensorElem X) x v, (i < 0)%Z -> (x::v) _[ i ] = |[ false ]| x. Proof. intros; destruct i; contra_crush. Qed. -Lemma get_neg_null_shape : forall i (X: Set) (H: TensorElem X) +Lemma get_neg_null_shape : forall i (X: Type) (H: TensorElem X) (v : list X) s e n, (i < 0)%Z -> consistent v (n,s) -> @@ -402,31 +393,7 @@ Proof. eapply mul_0_absorb; eauto. Qed. -Lemma get_znlt_null : forall i (X : Set) (H: TensorElem X) (v : list X) x, - ~ (i < Z.of_nat (length (x::v)))%Z-> - (x::v) _[ i ] = (|[ false ]| x). -Proof. - intros. generalize dependent i. - induction v; destruct i; intros; try reflexivity; unfold get; simpl. - - simpl in H0. lia. - - posnat. - simpl in *. - destruct pn; reflexivity. - - simpl in H0. zify. lia. - - posnat. simpl. - simpl length in *. - destruct pn. - simpl. zify. lia. - simpl. - specialize (IHv (Z.of_nat (S pn))). - assert (~ (Z.of_nat (S pn) < Z.of_nat (S (length v)))%Z). zify. lia. - apply IHv in H1. - unfold get in H1. simpl in H1. - rewrite SuccNat2Pos.id_succ in H1. simpl in H1. - assumption. -Qed. - -Lemma get_znlt_null_shape : forall i (X : Set) (H: TensorElem X) +Lemma get_znlt_null_shape : forall i (X : Type) (H: TensorElem X) (v : list X) s e n, ~ (i < Z.of_nat (length v))%Z-> consistent v (n,s) -> @@ -487,10 +454,10 @@ Lemma nth_gen_helper_some {X} `{TensorElem X} : forall n i m (e0 : Z -> X), i < n -> nth_error (gen_helper n m e0) i = Some (e0 (m + Z.of_nat i)%Z). -Proof. +Proof. induction n; intros i m e0 H0. - inversion H0. - - simpl. + - simpl. destruct i; try reflexivity. simpl. rewrite Z.add_0_r. reflexivity. simpl. rewrite IHn by lia. @@ -602,7 +569,7 @@ Qed. (* Lemma get_gen_some_ {X} `{TensorElem X} : forall (e0 : Z -> X) i n k, - (i < k)%Z -> + (i < k)%Z -> k = n -> (0 <= i)%Z -> (GEN [ x < n ] e0 x) _[ i ] = e0 i. @@ -613,7 +580,7 @@ Proof. Qed. *) Lemma get_gen_of_nat_some : - forall I (X : Set) (H : TensorElem X) (body : Z -> X) N, + forall I (X : Type) (H : TensorElem X) (body : Z -> X) N, (I < Z.of_nat N)%Z -> (0 <= I)%Z -> (GEN [ x < Z.of_nat N ] body x) _[ I ] = body I. @@ -784,6 +751,13 @@ Proof. auto with crunch. Qed. +Lemma nth_error_genr_Some {X} `{TensorElem X} i lo hi (f : _ -> X) : + i < Z.to_nat (hi - lo) -> + nth_error (genr lo hi f) i = Some (f (lo + Z.of_nat i)%Z). +Proof. + cbv [genr]. intros. rewrite nth_gen_helper_some; auto. +Qed. + Lemma get_genr_indic_not {X} `{TensorElem X} : forall (I N m o : Z) (body : Z -> X), (m < N)%Z -> @@ -802,14 +776,14 @@ Proof. assert (Z.to_nat I < Z.to_nat (N-m)%Z) by auto with crunch. apply (nth_gen_helper_indic_not (Z.to_nat I) (Z.to_nat (N-m)%Z) m o body) in H4. - rewrite H4. + rewrite H4. destruct (Z.to_nat (N-m)) eqn:e. zify. lia. simpl. f_equal. f_equal. zify. lia. zify. lia. - contra_crush. Qed. - + Lemma get_genr_indic : forall I N m body, (m < N)%Z -> (I < N - m)%Z -> @@ -988,7 +962,7 @@ Proof. apply consistent_sum_helper. intros. apply H1; zify; lia. Qed. - + Lemma consistent_sum {X} `{TensorElem X} : forall s n f, (0 < n)%Z -> @@ -1074,11 +1048,11 @@ Lemma consistent_gen' {X} `{TensorElem X} : forall n m f s, Proof. unfold gen, genr. intros. rewrite Z.sub_0_r. rewrite H2. - apply consistent_gen_helper. zify. lia. + apply consistent_gen_helper. zify. lia. intros. apply H1; zify; lia. Qed. -Theorem consistent_let {X Y : Set} `{TensorElem Y} : +Theorem consistent_let {X Y : Type} `{TensorElem Y} : forall (f : X -> Y) (e : X) s, consistent (f e) s -> consistent (let_binding e f) s. @@ -1145,7 +1119,7 @@ Proof. simpl in IHn. rewrite <- IHn. rewrite mul_bin_distr. reflexivity. -Qed. +Qed. Lemma mul_0_sum_helper {X} `{TensorElem X} : forall n (f : Z -> X), scalar_mul 0 (sum_helper n 0 f) = @@ -1212,7 +1186,7 @@ Lemma sum_helper_bound_indic {X} `{TensorElem X} : forall n (m a : Z) (f : Z -> bool) (g : Z -> X) (t : shape), (forall x : Z, m <= x -> x < m + Z.of_nat (S n) -> consistent (g x) t)%Z -> consistent (g a) t -> - sum_helper (S n) m (fun k => |[ (k =? a) && f k ]| g k) + sum_helper (S n) m (fun k => |[ (k =? a) && f k ]| g k) = (|[ (a consistent (f x) s)%Z -> sum_helper (S n) m (fun i => f i _[I]) = (sum_helper (S n) m f) _[I]. @@ -1555,10 +1529,10 @@ Proof. 2: { eapply H0. lia. lia. } repeat erewrite gen_length in *. repeat rewrite Nat2Z.id in *. 2: { eapply H0. lia. lia. } - rewrite max_assoc. rewrite max_id. + rewrite max_assoc. rewrite max_id. erewrite IHm. eauto. intros. eapply H0. lia. lia. -Qed. +Qed. Theorem sum_helper_cons_split {X} `{TensorElem X} : forall m n f (g : Z -> list X) s k, @@ -1575,7 +1549,7 @@ Proof. specialize (IHm n (inc f) (inc g) s k). simpl in IHm. rewrite IHm. rewrite tensor_add_step. reflexivity. - unfold tensor_add. erewrite gen_length. rewrite Nat2Z.id. + unfold tensor_add. erewrite gen_length. rewrite Nat2Z.id. 2: { intros. eapply H0. lia. lia. } assert (n <= n)%Z by lia. assert (n <= n+1)%Z by lia. @@ -1592,7 +1566,7 @@ Theorem sum_helper_gen_helper_swap {X} `{TensorElem X} : 0 < b -> (forall (x y : Z), (n <= x)%Z -> (x < n + Z.of_nat b)%Z -> (m <= y)%Z -> (y < m + Z.of_nat a)%Z -> - consistent (f y x) s) -> + consistent (f y x) s) -> gen_helper a m (fun x => sum_helper b n (fun y => (f x y))) = sum_helper b n (fun y => gen_helper a m (fun x => (f x y))). Proof. @@ -1623,9 +1597,9 @@ Proof. f_equal. pose proof get_bin_distr. specialize (H2 ([ f m (n+1+1)%Z])). - specialize H3 with (I:=0%Z). simpl in H3. + specialize H3 with (I:=0%Z). simpl in H3. erewrite H3. - erewrite <- get_sum_helper. reflexivity. + erewrite <- get_sum_helper. reflexivity. intros. econstructor. eapply H1; lia. econstructor. simpl. reflexivity. simpl. econstructor. eapply H1; lia. econstructor. reflexivity. @@ -1842,7 +1816,7 @@ Proof. zify. lia. simpl in *. zify. lia. auto. + simpl in H1. lia. -Qed. +Qed. Hint Extern 5 => match goal with |- context[ length (_ _[_]) ] => apply get_forall @@ -1891,11 +1865,11 @@ Proof. - reflexivity. Qed. -Fixpoint map2 {X Y Z : Set} (f : X -> Y -> Z) (l1 : list X) (l2 : list Y) := +Fixpoint map2 {X Y Z : Type} (f : X -> Y -> Z) (l1 : list X) (l2 : list Y) := match l1,l2 with | x::xs, y::ys => f x y :: (map2 f xs ys) | _,_ => [] - end. + end. Lemma gen_helper_mul_distr : forall n f g, gen_helper n 0%Z (fun x => (f x * g x)%R) = @@ -1914,8 +1888,8 @@ Lemma gen_mul_distr : forall n f g, Proof. intros. apply gen_helper_mul_distr. Qed. Lemma tensor_consistent_forall_consistent {X} `{TensorElem X} : - forall s (l : list X), - consistent l (length l,s) -> Forall (fun x => consistent x s) l. + forall s n (l : list X), + consistent l (n,s) -> Forall (fun x => consistent x s) l. Proof. intros. inversion H0. subst. @@ -1928,7 +1902,7 @@ Lemma Forall_split {X} `{TensorElem X} : forall (l : list X) P Q, Forall P l /\ Forall Q l. Proof. split; induction l; intros; try split; try constructor. - - inversion H0. tauto. + - inversion H0. tauto. - inversion H0. eapply Forall_impl with (P:= (fun x : X => P x /\ Q x)). intros. tauto. auto. @@ -2230,7 +2204,7 @@ Proof. Qed. Lemma flatten_trunc_eq {X} `{TensorElem X} : forall u v m n, - u = v -> + u = v -> n = m -> flatten_trunc n u = flatten_trunc m v. Proof. @@ -2276,7 +2250,7 @@ Proof. inversion H5. rewrite <- H18 in *. clear H18. subst. eapply consistent_get. eapply consistent_get. eauto. - + simpl in *. inversion H14. inversion H5. rewrite <- H9. subst. simpl. f_equal. rewrite mul_comm. simpl. @@ -2405,9 +2379,9 @@ Theorem consistent_truncr {X} `{TensorElem X} : Proof. intros. unfold truncr. apply consistent_gen. - erewrite consistent_length; eauto. + erewrite consistent_length; eauto. intros. eapply consistent_get. - eauto. erewrite consistent_length; eauto. + eauto. erewrite consistent_length; eauto. Qed. Theorem consistent_truncl {X} `{TensorElem X} : @@ -2418,33 +2392,31 @@ Theorem consistent_truncl {X} `{TensorElem X} : Proof. intros. unfold truncl. apply consistent_gen. - erewrite consistent_length; eauto. + erewrite consistent_length; eauto. intros. eapply consistent_get. - eauto. erewrite consistent_length; eauto. + eauto. erewrite consistent_length; eauto. Qed. Theorem consistent_pad_l {X} `{TensorElem X} : forall (v : list X) n k s, - 0 < k -> consistent v (n,s) -> consistent (pad_l k v) (k+n,s). Proof. intros. unfold pad_l. - apply consistent_gen. lia. + apply consistent_gen. inversion H0. simpl. lia. intros. apply consistent_iverson. eapply consistent_get. - eauto. inversion H1. rewrite H7. lia. + eauto. inversion H0. subst. lia. Qed. Theorem consistent_pad_r {X} `{TensorElem X} : forall (v : list X) n k s, - 0 < k -> consistent v (n,s) -> - consistent (pad_r k v) (k+n,s). + consistent (pad_r k v) (n+k,s). Proof. intros. unfold pad_r. - apply consistent_gen. lia. + apply consistent_gen. inversion H0. subst. simpl. lia. intros. apply consistent_iverson. eapply consistent_get. - eauto. inversion H1. rewrite H7. lia. + eauto. inversion H0. subst. lia. Qed. Lemma guard_comp_to_eq : forall k l i i1, @@ -2472,7 +2444,7 @@ Proof. rewrite Z.mul_comm. rewrite Z.add_sub_swap. rewrite <- Z.mul_sub_distr_r. - + replace (0 <=? (i / zk - i1) * zk + r)%Z with (0 <=? (i / zk - i1))%Z. 2: @@ -2500,7 +2472,7 @@ Proof. ((i / zk - i1) <=?0)%Z. 2: { - pose proof (Z.mod_pos_bound i zk). peel_hyp. + pose proof (Z.mod_pos_bound i zk). peel_hyp. assert (r < zk)%Z. lia. @@ -2543,18 +2515,15 @@ Proof. Qed. Theorem consistent_concat {X} `{TensorElem X} : forall (l1 l2 : list X) n m s k, - 0 < n -> - 0 < m -> - k = n + m -> consistent l1 (n,s) -> consistent l2 (m,s) -> + k = n + m -> consistent (l1 <++> l2) (k,s). Proof. intros. unfold concat. - inversion H3. inversion H4. - rewrite H10, H16. - apply consistent_gen. lia. + inversion H0. inversion H1. subst. + apply consistent_gen. simpl. lia. intros. eapply consistent_bin. eapply consistent_iverson. eapply consistent_get. subst. eauto. @@ -2682,7 +2651,7 @@ Proof. rewrite true_iverson. unfold iverson. apply bin_mul_0_self_id. -Qed. +Qed. Theorem gp_iverson {X} `{TensorElem X} : forall I p (e : list X), @@ -2696,7 +2665,7 @@ Proof. + destruct e. simpl in ie. lia. simpl. auto. - + simpl in *. rewrite nth_map by (zify; lia). + + simpl in *. rewrite nth_error_map by (zify; lia). destruct e. simpl in *. lia. simpl. unfold to_val. @@ -2705,7 +2674,7 @@ Proof. destruct (nth_error (x::e) (Pos.to_nat p0)). auto. contradiction. + contradiction. - destruct e. - + simpl. unfold get. simpl. + + simpl. unfold get. simpl. destruct p. * repeat rewrite true_iverson. reflexivity. @@ -2766,13 +2735,63 @@ Definition Truncr {X} `{TensorElem X} k l := Lemma Truncr_eq {X} `{TensorElem X} : forall k l1 l2, l1 = l2 -> Truncr k l1 = Truncr k l2. -Proof. intros. subst. eauto. Qed. +Proof. intros. subst. eauto. Qed. Lemma truncr_Truncr {X} `{TensorElem X} : forall l n, truncr n l = Truncr (Z.of_nat n) l. Proof. intros. unfold Truncr. rewrite Nat2Z.id. eauto. Qed. -Lemma minus_plus : forall n m : nat, n + m - n = m. Proof. lia. Qed. +Definition Truncl {X} `{TensorElem X} k l := + truncl (Z.to_nat k) l. + +Lemma Truncl_eq {X} `{TensorElem X} : forall k l1 l2, + l1 = l2 -> + Truncl k l1 = Truncl k l2. +Proof. intros. subst. eauto. Qed. +Lemma truncl_Truncl {X} `{TensorElem X} : + forall l n, + truncl n l = Truncl (Z.of_nat n) l. +Proof. intros. unfold Truncl. rewrite Nat2Z.id. eauto. Qed. + +Definition Tile {X} `{TensorElem X} l k := + tile l (Z.to_nat k). + +Lemma Tile_eq {X} `{TensorElem X} : forall k l1 l2, + l1 = l2 -> + Tile l1 k = Tile l2 k. +Proof. intros. subst. eauto. Qed. +Lemma tile_Tile {X} `{TensorElem X} : + forall l n, + tile l n = Tile l (Z.of_nat n). +Proof. intros. unfold Tile. rewrite Nat2Z.id. eauto. Qed. + +Definition Padl {X} `{TensorElem X} k l := + pad_l (Z.to_nat k) l. + +Lemma Padl_eq {X} `{TensorElem X} : forall k l1 l2, + l1 = l2 -> + Padl l1 k = Padl l2 k. +Proof. intros. subst. eauto. Qed. + +Lemma pad_l_Padl {X} `{TensorElem X} : + forall n l, + pad_l n l = Padl (Z.of_nat n) l. +Proof. intros. unfold Padl. rewrite Nat2Z.id. eauto. Qed. + +Definition Padr {X} `{TensorElem X} k l := + pad_r (Z.to_nat k) l. + +Lemma Padr_eq {X} `{TensorElem X} : forall k l1 l2, + l1 = l2 -> + Padr l1 k = Padr l2 k. +Proof. intros. subst. eauto. Qed. + +Lemma pad_r_Padr {X} `{TensorElem X} : + forall n l, + pad_r n l = Padr (Z.of_nat n) l. +Proof. intros. unfold Padr. rewrite Nat2Z.id. eauto. Qed. + +Lemma minus_plus : forall n m : nat, n + m - n = m. Proof. lia. Qed. diff --git a/src/verified_scheduling/atl/GenPushout.v b/src/verified_scheduling/atl/GenPushout.v index aa505df..9dfe2d1 100644 --- a/src/verified_scheduling/atl/GenPushout.v +++ b/src/verified_scheduling/atl/GenPushout.v @@ -3,7 +3,6 @@ From Stdlib Require Import Arith.PeanoNat. Import Nat. From Stdlib Require Import micromega.Lia. From Stdlib Require Import micromega.Zify. From Stdlib Require Import Lists.List. -From Stdlib Require Import Vectors.Vector. From Stdlib Require Import Reals.Reals. Import RIneq. Import Rdefinitions. From Stdlib Require Import Logic.FunctionalExtensionality. Import ListNotations. diff --git a/src/verified_scheduling/atl/Map.v b/src/verified_scheduling/atl/Map.v index 115fe5a..0bcab3e 100644 --- a/src/verified_scheduling/atl/Map.v +++ b/src/verified_scheduling/atl/Map.v @@ -33,7 +33,7 @@ Module Type S. Axiom lookup_transform : forall A B (m : fmap A B) (f : A -> A) a b, a = f b -> lookup (transform m f) b = lookup m a. - + Axiom lookup_empty : forall A B k, empty A B $? k = None. Axiom includes_lookup : forall A B (m m' : fmap A B) k v, @@ -129,7 +129,7 @@ Module Type S. Axiom dom_remove : forall A B (m : fmap A B) k, dom (m $- k) = dom m \setminus constant (k::nil). - + Axiom lookup_restrict_true : forall A B (P : A -> Prop) (m : fmap A B) k, P k -> lookup (restrict P m) k = lookup m k. @@ -176,7 +176,7 @@ Module Type S. Axiom includes_intro : forall K V (m1 m2 : fmap K V), (forall k v, m1 $? k = Some v -> m2 $? k = Some v) -> m1 $<= m2. - + Axiom lookup_Some_dom : forall K V (m : fmap K V) k v, m $? k = Some v -> k \in dom m. @@ -318,7 +318,7 @@ Module M : S. forall k v, m1 k = Some v -> m2 k = Some v. Definition transform A B (m : fmap A B) (f : A -> A) := fun k => m (f k). - + Definition dom A B (m : fmap A B) : set A := fun x => m x <> None. Theorem fmap_ext : forall A B (m1 m2 : fmap A B), @@ -334,7 +334,7 @@ Module M : S. Proof. intros. unfold transform. subst. unfold lookup. reflexivity. Qed. - + Theorem lookup_empty : forall A B (k : A), lookup (empty B) k = None. Proof. auto. @@ -588,7 +588,7 @@ Module M : S. Proof. auto. Qed. - + Lemma lookup_Some_dom : forall K V (m : fmap K V) k v, lookup m k = Some v -> k \in dom m. @@ -765,5 +765,4 @@ Module M : S. Qed. End splitting. End M. - Export M. diff --git a/src/verified_scheduling/atl/PairElimination.v b/src/verified_scheduling/atl/PairElimination.v index 1efb091..2b16d7b 100644 --- a/src/verified_scheduling/atl/PairElimination.v +++ b/src/verified_scheduling/atl/PairElimination.v @@ -4,7 +4,6 @@ From Stdlib Require Import ZArith.BinInt. From Stdlib Require Import micromega.Lia. From Stdlib Require Import micromega.Zify. From Stdlib Require Import Lists.List. -From Stdlib Require Import Vectors.Vector. From Stdlib Require Import Logic.FunctionalExtensionality. Import ListNotations. diff --git a/src/verified_scheduling/codegen/CheckSafe.v b/src/verified_scheduling/codegen/CheckSafe.v index ac1bf10..a00557c 100644 --- a/src/verified_scheduling/codegen/CheckSafe.v +++ b/src/verified_scheduling/codegen/CheckSafe.v @@ -10,12 +10,10 @@ From Stdlib Require Import ZArith.Zdiv. From Stdlib Require Import ZArith.Int. From Stdlib Require Import ZArith.Znat. -Set Warnings "-omega-is-deprecated,-deprecated". - Import ListNotations. From ATL Require Import ATL Tactics Div Common CommonTactics. -From Examples Require Import Blur. +From Examples Require Import Blur. Generalizable All Variables. (* @@ -86,7 +84,7 @@ Ltac safe := match cvsh with | consistent _ (?n,_) => n end in - assert (i < Z.of_nat n)%Z by eauto with crunch; + assert (i < Z.of_nat n)%Z by eauto with crunch; apply get_eq_index; safe | |- _ = _ => @@ -97,11 +95,12 @@ Ltac safe := Ltac check_safe := etransitivity; [ safe; try reflexivity | eauto ]; lazy beta. Goal forall X (H : TensorElem X) N M (v : list (list R)) s, - 0 < N -> - 0 < M -> - consistent v (N,(M,s)) -> - blur_tiles_guarded v N M 4 4 = @nil _. + (0 < N)%Z -> + (0 < M)%Z -> + consistent v (Z.to_nat N,(Z.to_nat M,s)) -> + blur_tiles_guarded 4 4 N M v = @nil _. Proof. intros. autounfold with examples. + (*TODO what is this doing? did i break it?*) check_safe. Abort.