(* Generates correctness proofs for comparison functions generated by derive.eq.

   license: GNU Lesser General Public License Version 2.1 or later           
   ------------------------------------------------------------------------- *)

From elpi.apps.derive Extra Dependency "eqcorrect.elpi" as eqcorrect.
From elpi.apps.derive Extra Dependency "derive_hook.elpi" as derive_hook.
  
From elpi Require Import elpi.
From elpi.apps Require Import derive.
From elpi.apps Require Import  derive.eq derive.induction derive.eqK derive.param1.

From Coq Require Import ssreflect Uint63.

Lemma uint63_eq_correct i : is_uint63 i -> eq_axiom_at PrimInt63.int PrimInt63.eqb i.
Proof.
move=> _ j; case: (Uint63.eqb_spec i j); case: PrimInt63.eqb => [-> // _|_ abs];
  [ by constructor | by constructor=> /abs ].
Qed.
Register uint63_eq_correct as elpi.derive.uint63_eq_correct.

Elpi Db derive.eqcorrect.db lp:{{
  type eqcorrect-db gref -> term -> prop.

eqcorrect-db X {{ lib:elpi.derive.uint63_eq_correct }} :- {{ lib:elpi.uint63 }} = global X, !.
eqcorrect-db X _ :- {{ lib:elpi.float64 }} = global X, !, stop "float64 comparison is not syntactic".

:name "eqcorrect-db:fail"
eqcorrect-db T _ :-
  M is "derive.eqcorrect: can't find the correctness proof for the comparison function on " ^ {coq.gref->string T},
  stop M.

}}.

(* standalone *)
Elpi Command derive.eqcorrect.
Elpi Accumulate Db derive.param1.db. (* TODO: understand which other db needs this *)
Elpi Accumulate Db derive.induction.db.
Elpi Accumulate Db derive.param1.functor.db.
Elpi Accumulate Db derive.eq.db.
Elpi Accumulate Db derive.eqK.db.
Elpi Accumulate Db derive.eqcorrect.db.
Elpi Accumulate File eqcorrect.
Elpi Accumulate lp:{{
  main [str I, str Name] :- !, coq.locate I (indt GR), derive.eqcorrect.main GR Name _.
  main [str I] :- !, coq.locate I (indt GR), coq.gref->id (indt GR) ID, Name is ID ^ "_eq_correct", derive.eqcorrect.main GR Name _.
  main _ :- usage.

  usage :- coq.error "Usage: derive.eqcorrect <inductive type name> [<suffix>]".
}}.
Elpi Typecheck.

(* hook into derive *)
Elpi Accumulate derive File derive_hook.
Elpi Accumulate derive File eqcorrect.
Elpi Accumulate derive Db derive.eqcorrect.db.
Elpi Accumulate derive lp:{{
  
dep1 "eqcorrect" "induction".
dep1 "eqcorrect" "eq".
dep1 "eqcorrect" "eqK".

derivation (indt T) Prefix (derive "eqcorrect" (derive.eqcorrect.main T N) (eqcorrect-db (indt T) _)) :- N is Prefix ^ "eq_correct".

}}.
