(************************************************************************)
(*         *      The Rocq Prover / The Rocq Development Team           *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
Require Export Morphisms Setoid Bool.
Require Export Ncring.
Set Implicit Arguments.
Ltac reify_as_var_aux n lvar term :=
lazymatch lvar with
| @cons _ ?t0 ?tl =>
let conv :=
match goal with
| _ => let _ := match goal with _ => convert term t0 end in open_constr:(true)
| _ => open_constr:(false)
end
in
lazymatch conv with
| true => n
| false => reify_as_var_aux open_constr:(S n) tl term
end
| _ =>
let _ := open_constr:(eq_refl : lvar = @cons _ term _) in
n
end.
Ltac reify_as_var lvar term := reify_as_var_aux Datatypes.O lvar term.
Ltac close_varlist lvar :=
lazymatch lvar with
| @nil _ => idtac
| @cons _ _ ?tl => close_varlist tl
| _ => let _ := constr:(eq_refl : lvar = @nil _) in idtac
end.
(* extensibility: override to add ways to reify a term. Return [tt] for terms which aren't handled (tt doesn't have type PExpr so is unambiguous) *)
Ltac extra_reify term := open_constr:(tt).
Ltac reify_term R ring0 ring1 add mul sub opp lvar term :=
let reify_term x := reify_term R ring0 ring1 add mul sub opp lvar x in
match term with
(* int literals *)
| Z0 => open_constr:(PEc 0%Z)
| Zpos ?p => open_constr:(PEc (Zpos p))
| Zneg ?p => open_constr:(PEc (Zneg p))
(* ring constants *)
| _ =>
let _ := lazymatch goal with _ => convert ring0 term end in
open_constr:(PEc 0%Z)
| _ =>
let _ := lazymatch goal with _ => convert ring1 term end in
open_constr:(PEc 1%Z)
(* binary operators *)
| ?op ?t1 ?t2 =>
(* quick(?) check op is of the right type? TODO try without this check *)
let _ := open_constr:(t1 : R) in
let _ := open_constr:(t2 : R) in
match tt with
| _ =>
let _ := lazymatch goal with _ => convert add op end in
(* NB: don't reify before we recognize the operator in case we can't recognire it *)
let et1 := reify_term t1 in
let et2 := reify_term t2 in
open_constr:(PEadd et1 et2)
| _ =>
let _ := lazymatch goal with _ => convert mul op end in
let et1 := reify_term t1 in
let et2 := reify_term t2 in
open_constr:(PEmul et1 et2)
| _ =>
let _ := lazymatch goal with _ => convert sub op end in
let et1 := reify_term t1 in
let et2 := reify_term t2 in
open_constr:(PEsub et1 et2)
end
(* unary operator (opposite) *)
| ?op ?t =>
let _ := lazymatch goal with _ => convert opp op end in
let et := reify_term t in
open_constr:(PEopp et)
(* special cases (XXX can/should we be less syntactic?) *)
| @multiplication Z _ _ ?z ?t =>
let et := reify_term t in
open_constr:(PEmul (PEc z) et)
| pow_N ?t ?n =>
let et := reify_term t in
open_constr:(PEpow et n)
| @power _ _ power_ring ?t ?n =>
let et := reify_term t in
open_constr:(PEpow et (ZN n))
(* extensibility and variable case *)
| _ =>
let extra := extra_reify term in
lazymatch extra with
| tt =>
let n := reify_as_var lvar term in
open_constr:(PEX Z (Pos.of_succ_nat n))
| ?v => v
end
end.
Ltac list_reifyl_core Tring lvar lterm :=
lazymatch lterm with
| @nil _ => open_constr:(@nil (PExpr Z))
| @cons _ ?t ?tl =>
lazymatch Tring with
| Ring (T:=?R) (ring0:=?ring0) (ring1:=?ring1)
(add:=?add) (mul:=?mul) (sub:=?sub) (opp:=?opp) =>
let et := reify_term R ring0 ring1 add mul sub opp lvar t in
let etl := list_reifyl_core Tring lvar tl in
open_constr:(@cons (PExpr Z) et etl)
end
end.
Ltac list_reifyl lvar lterm :=
lazymatch lterm with
| @cons ?R _ _ =>
let R_ring := constr:(_ :> Ring (T:=R)) in
let Tring := type of R_ring in
let lexpr := list_reifyl_core Tring lvar lterm in
let _ := lazymatch goal with _ => close_varlist lvar end in
constr:((lvar,lexpr))
end.
Ltac list_reifyl0 lterm :=
lazymatch lterm with
| @cons ?R _ _ =>
let lvar := open_constr:(_ :> list R) in
list_reifyl lvar lterm
end.
Class ReifyL {R:Type} (lvar lterm : list R) := list_reifyl : (list R * list (PExpr Z)).
Arguments list_reifyl {R lvar lterm _}.
Global Hint Extern 0 (ReifyL ?lvar ?lterm) => let reif := list_reifyl lvar lterm in exact reif : typeclass_instances.
Unset Implicit Arguments.
Ltac lterm_goal g :=
match g with
| ?t1 == ?t2 => constr:(t1::t2::nil)
| ?t1 = ?t2 => constr:(t1::t2::nil)
| (_ ?t1 ?t2) => constr:(t1::t2::nil)
end.

(* Specifications: *)
Lemma Zeqb_ok: forall x y : Z, Zeq_bool x y = true -> x == y.
intros x y H. rewrite (Zeq_bool_eq x y H). reflexivity. Qed.