Ltac isWcst w :=
match eval hnf in w with
| WO => constr:(true)
| WS ?b ?w' =>
match eval hnf in b with
| true => isWcst w'
| false => isWcst w'
| _ => constr:(false)
end
| natToWord _ ?n => is_nat_cst n
| _ => constr:(false)
end.
Ltac wcst w :=
let b := isWcst w in
match b with
| true => w
| _ => constr:(NotConstant)
end.
(* Here's how you can add a ring for a specific bit-width. There doesn't seem to be a polymorphic method, so this code really does need to be copied. *)
(* Definition wring8 := wring 8. Add Ring wring8 : wring8 (decidable (weqb_sound 8), constants [wcst]). *)
Ltac noptac x := idtac.
Ltac PackWring sz F :=
let RNG := (fun proj => proj
inv_morph_nothing inv_morph_nothing noptac noptac
(word sz) (@eq (word sz)) (wzero sz) (wone sz)
(@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz)
(BinNums.Z) (BinNums.N) (id_phi_N)
(pow_N (wone sz) (@wmult sz))
(ring_correct (@Eqsth (word sz))
(Eq_ext _ _ _)
(Rth_ARth (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz))
(gen_phiZ_morph (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz))
(pow_N_th _ _ (@Eqsth (word sz)))
(triv_div_th (@Eqsth (word sz))
(Eq_ext _ _ _)
(Rth_ARth (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz))
(gen_phiZ_morph (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz)))
)
tt) in
F RNG (@nil (word sz)) (@nil (word sz)).
Ltac ring_sz sz := PackWring sz Ring_gen.
Fact bitwp_wtl : forall sz (w w' : word (S sz)) op, bitwp op (wtl w) (wtl w') = wtl (bitwp op w w').

Lemma combine_bitwp : forall sz1 sz2 (wa wa' : word sz1) (wb wb' : word sz2) op,
combine (bitwp op wa wa') (bitwp op wb wb') = bitwp op (combine wa wb) (combine wa' wb').