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 eq_rect_bitwp : forall a b Heq f w1 w2,
bitwp f w1 w2 = eq_rect a word (
bitwp f (eq_rect b word w1 a Heq) (eq_rect b word w2 a Heq)) b (eq_sym Heq).