(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(****************************************************************************)
(*                 The Calculus of Inductive Constructions                  *)
(*                                                                          *)
(*                                Projet Coq                                *)
(*                                                                          *)
(*                     INRIA                        ENS-CNRS                *)
(*              Rocquencourt                        Lyon                    *)
(*                                                                          *)
(*                                Coq V5.10                                 *)
(*                              Nov 25th 1994                               *)
(*                                                                          *)
(****************************************************************************)
(*                                Redexes.v                                 *)
(*                                                                          *)
(*                                Gerard Huet                               *)
(*                                                                          *)
(* Developed in V5.8  January 1993                                          *)
(* Ported    to V5.10 January 1995                                          *)
(****************************************************************************)
(************************************)
(* Lambda terms with marked redexes *)
(************************************)
Inductive redexes : Set :=
| Var : nat -> redexes
| Fun : redexes -> redexes
| Ap : bool -> redexes -> redexes -> redexes.
(* A redex is marked as (Ap true (Fun M) N) *)
(* The Boolean algebra of sets of redexes *)
Inductive sub : redexes -> redexes -> Prop :=
| Sub_Var : forall n : nat, sub (Var n) (Var n)
| Sub_Fun : forall U V : redexes, sub U V -> sub (Fun U) (Fun V)
| Sub_Ap1 :
forall U1 V1 : redexes,
sub U1 V1 ->
forall U2 V2 : redexes,
sub U2 V2 -> forall b : bool, sub (Ap false U1 U2) (Ap b V1 V2)
| Sub_Ap2 :
forall U1 V1 : redexes,
sub U1 V1 ->
forall U2 V2 : redexes,
sub U2 V2 -> forall b : bool, sub (Ap true U1 U2) (Ap true V1 V2).
Definition bool_max (b b' : bool) :=
match b return bool with
| true => true
| false => b'
end.
Inductive union : redexes -> redexes -> redexes -> Prop :=
| Union_Var : forall n : nat, union (Var n) (Var n) (Var n)
| Union_Fun :
forall U V W : redexes, union U V W -> union (Fun U) (Fun V) (Fun W)
| Union_Ap :
forall U1 V1 W1 : redexes,
union U1 V1 W1 ->
forall U2 V2 W2 : redexes,
union U2 V2 W2 ->
forall b1 b2 : bool,
union (Ap b1 U1 U2) (Ap b2 V1 V2) (Ap (bool_max b1 b2) W1 W2).
(* Compatibility *)
(* (comp U V) iff (unmark U)=(unmark V) *)
Inductive comp : redexes -> redexes -> Prop :=
| Comp_Var : forall n : nat, comp (Var n) (Var n)
| Comp_Fun : forall U V : redexes, comp U V -> comp (Fun U) (Fun V)
| Comp_Ap :
forall U1 V1 : redexes,
comp U1 V1 ->
forall U2 V2 : redexes,
comp U2 V2 -> forall b1 b2 : bool, comp (Ap b1 U1 U2) (Ap b2 V1 V2).
Hint Resolve Comp_Var Comp_Fun Comp_Ap.
simple induction 1; intros; inversion_clear CVW; auto.
Qed.
(* A element of type redexes is said to be regular if its true marks label redexes *)
Fixpoint regular (U : redexes) : Prop :=
match U with
| Var n => True
| Fun V => regular V
| Ap true (Fun _ as V) W => regular V /\ regular W
| Ap true _ W => False
| Ap false V W => regular V /\ regular W
end.

Lemma union_preserve_regular :
forall U V W : redexes, union U V W -> regular U -> regular V -> regular W.