(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 2 of the License, or  *)
(*  (at your option) any later version.  This file is also distributed *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Tactics to generate Boolean-valued equalities *)
(** The [decide equality] tactic can generate a term of type [forall (x y: A), {x=y} + {x<>y}] if [A] is an inductive type. This term is a decidable equality function.  Similarly, this module defines a [boolean_equality] tactic that generates a term of type [A -> A -> bool].  This term is a Boolean-valued equality function over the inductive type [A].  Two internal tactics generate proofs that show the correctness of this equality function [f], namely proofs of the following two properties: - [forall (x: A), f x x = true] - [forall (x y: A), f x y = true -> x = y]  Finally, the [decide_equality_from f] tactic wraps [f] (the Boolean equality generated by [boolean_equality]) and those proofs together, producing a decidable equality of type [forall (x y: A), {x=y} + {x<>y}].  The advantage of the present tactics over the standard [decide equality] tactic is that the former produce smaller transparent definitions than the latter.  For a type [A] that has N constructors, [decide equality] produces a single term of size O(N^3), which must be kept transparent so that it computes and extracts as expected.  Given such a big transparent definition, the virtual machine compiler of Coq produces very big chunks of VM code, causing memory overflows on 32-bit platforms.  In contrast, the term produced by [boolean_equality] has size O(N^2) only (so to speak).  The proofs that this term is a correct boolean equality are still O(N^3), but those proofs are opaque and do not need to be compiled to VM code.  Only the boolean equality itself is defined transparently and compiled.  The present tactics also have some restrictions: - Constructors must have at most 4 arguments. - Decidable equalities must be provided (as hypotheses in the context) for all the types [T] of constructor arguments other than type [A]. - They probably do not work for mutually-defined inductive types. *)
Module BE.
Definition bool_eq {A: Type} (x y: A) : Type := bool.
Ltac bool_eq_base x y :=
change (bool_eq x y);
match goal with
| [ H: forall (x y: ?A), bool |- @bool_eq ?A x y ] => exact (H x y)
| [ H: forall (x y: ?A), {x=y} + {x<>y}  |- @bool_eq ?A x y ] => exact (proj_sumbool (H x y))
| _ => idtac
end.
Ltac bool_eq_case :=
match goal with
| |- bool_eq (?C ?x1 ?x2 ?x3 ?x4) (?C ?y1 ?y2 ?y3 ?y4) =>
refine (_ && _ && _ && _); [bool_eq_base x1 y1|bool_eq_base x2 y2|bool_eq_base x3 y3|bool_eq_base x4 y4]
| |- bool_eq (?C ?x1 ?x2 ?x3) (?C ?y1 ?y2 ?y3) =>
refine (_ && _ && _); [bool_eq_base x1 y1|bool_eq_base x2 y2|bool_eq_base x3 y3]
| |- bool_eq (?C ?x1 ?x2) (?C ?y1 ?y2) =>
refine (_ && _); [bool_eq_base x1 y1|bool_eq_base x2 y2]
| |- bool_eq (?C ?x1) (?C ?y1) => bool_eq_base x1 y1
| |- bool_eq ?C ?C => exact true
| |- bool_eq _ _ => exact false
end.
Ltac bool_eq :=
match goal with
| [ |- ?A -> ?A -> bool ] =>
let f := fresh "rec" in let x := fresh "x" in let y := fresh "y" in
fix f 1; intros x y; change (bool_eq x y); destruct x, y; bool_eq_case
| [ |- _ -> _ ] =>
let eq := fresh "eq" in intro eq; bool_eq
end.

(* Specifications: *)
Lemma proj_sumbool_is_true:
forall (A: Type) (f: forall (x y: A), {x=y} + {x<>y}) (x: A),
proj_sumbool (f x x) = true.