Module Import ShiftNotations.
Notation "l ^<< r" := (@wlshift' _ l%word r) : word_scope.
Notation "l ^>> r" := (@wrshift' _ l%word r) : word_scope.
End ShiftNotations.
(** * Setting an individual bit *)
Definition wbit sz sz' (n : word sz') := natToWord sz (pow2 (wordToNat n)).
(*! Facts *)
Hint Rewrite div2_double div2_S_double: div2.
Local Hint Resolve mod2_S_double mod2_double.
induction w as [|b]; rewrite wordToNat_wordToNat'; intuition; f_equal; unfold natToWord, wordToNat'; fold natToWord; fold wordToNat';
destruct b; f_equal; autorewrite with div2; intuition.
Qed.
induction sz; simpl; intuition.
Qed.
Hint Rewrite roundTrip_0 : wordToNat.
induction sz as [|sz IHsz]; simpl; intro w; intuition; repeat rewrite untimes2.
exists w; intuition.
case_eq (mod2 w); intro Hmw.
specialize (IHsz (div2 w)); firstorder.
rewrite wordToNat_wordToNat' in *.
let x' := match goal with H : _ + ?x * _ = _ |- _ => x end in
rename x' into x. (* force non-auto-generated name *)
exists x; intuition.
rewrite mult_assoc.
rewrite (mult_comm x 2).
rewrite mult_comm. simpl mult at 1.
rewrite (plus_Sn_m (2 * wordToNat' (natToWord sz (div2 w)))).
rewrite <- mult_assoc.
rewrite <- mult_plus_distr_l.
rewrite H; clear H.
symmetry; apply div2_odd; auto.
specialize (IHsz (div2 w)); firstorder.
let x' := match goal with H : _ + ?x * _ = _ |- _ => x end in
rename x' into x. (* force non-auto-generated name *)
exists x; intuition.
rewrite mult_assoc.
rewrite (mult_comm x 2).
rewrite <- mult_assoc.
rewrite mult_comm.
rewrite <- mult_plus_distr_l.
match goal with H : _ |- _ => rewrite H; clear H end.
symmetry; apply div2_even; auto.
Qed.
intros b1 b2 sz w1 w2 ? H0; intuition.
apply (f_equal (@whd _)) in H0; tauto.
apply (f_equal (@wtl _)) in H0; tauto.
Qed.
Ltac shatterer := simpl; intuition;
match goal with
| [ w : _ |- _ ] => rewrite (shatter_word w); simpl
end; f_equal; auto.
induction sz1; shatterer.
Qed.
induction sz1; shatterer.
Qed.
induction sz1; shatterer.
Qed.
Hint Rewrite combine_split.
Hint Rewrite split1_combine.
Hint Rewrite split2_combine.
induction w1 as [|?? w1 IHw1]; simpl; intros n2 n3 w2 w3 Heq; intuition.
rewrite (UIP_dec eq_nat_dec Heq (refl_equal _)); reflexivity.
rewrite (IHw1 _ _ _ _ (plus_assoc _ _ _)); clear IHw1.
repeat match goal with
| [ |- context[match ?pf with refl_equal => _ end] ] => generalize pf
end.
generalize dependent (combine w1 (combine w2 w3)).
rewrite plus_assoc; intros w Heq0 e.
rewrite (UIP_dec eq_nat_dec e (refl_equal _)).
rewrite (UIP_dec eq_nat_dec Heq0 (refl_equal _)).
reflexivity.
Qed.
induction n1 as [|n1 IHn1]; simpl; intros n2 n3 Heq w; intuition.
rewrite (UIP_dec eq_nat_dec Heq (refl_equal _)); reflexivity.
rewrite (IHn1 _ _ (plus_assoc _ _ _)).
f_equal.
apply wtl_match.
Qed.
induction n1 as [|n1 IHn1]; simpl; intros n2 n3 Heq w.
rewrite (UIP_dec eq_nat_dec Heq (refl_equal _)).
apply combine_split.
rewrite (shatter_word w) in *.
simpl.
eapply trans_eq; [ | apply IHn1 with (Heq := plus_assoc _ _ _) ]; clear IHn1.
repeat f_equal.
repeat match goal with
| [ |- context[match ?pf with refl_equal => _ end] ] => generalize pf
end.
simpl.
generalize dependent w.
rewrite plus_assoc.
intros.
rewrite (UIP_dec eq_nat_dec e (refl_equal _)).
rewrite (UIP_dec eq_nat_dec Heq0 (refl_equal _)).
reflexivity.
Qed.

Theorem eq_rect_combine : forall n1 n2 n2' (w1 : word n1) (w2 : word n2') Heq,
eq_rect (n1 + n2') (fun n => word n)
(combine w1 w2) (n1 + n2) Heq =
combine w1 (eq_rect n2' (fun n => word n) w2 n2 (plus_reg_l _ _ _ Heq)).