Library nominal

Require Import base.
Require Export Peano_dec.

Definition VAR := nat.

Record perm :=
  { perm_f : VAR -> VAR
  ; perm_g : VAR -> VAR
  ; perm_gf : forall x, perm_g (perm_f x) = x
  ; perm_fg : forall x, perm_f (perm_g x) = x
  }.

Lemma perm_ext : forall p1 p2,
  (forall x, perm_f p1 x = perm_f p2 x) ->
  p1 = p2.

Program Definition perm_id : perm :=
  {| perm_f := fun x => x
   ; perm_g := fun x => x
   |}.

Definition perm_inv (p:perm) : perm :=
  {| perm_f := perm_g p
   ; perm_g := perm_f p
   ; perm_gf := perm_fg p
   ; perm_fg := perm_gf p
   |}.

Program Definition perm_compose (p1:perm) (p2:perm) : perm :=
  {| perm_f := fun x => perm_f p1 (perm_f p2 x)
   ; perm_g := fun x => perm_g p2 (perm_g p1 x)
   |}.

Lemma perm_inv_inv : forall p,
  perm_inv (perm_inv p) = p.

Lemma perm_inv_id1 : forall p,
  perm_compose p (perm_inv p) = perm_id.

Lemma perm_inv_id2 : forall p,
  perm_compose (perm_inv p) p = perm_id.

Lemma perm_f_inj : forall p x y,
  perm_f p x = perm_f p y -> x = y.

Lemma perm_g_inj : forall p x y,
  perm_g p x = perm_g p y -> x = y.

Program Definition perm_swap (x y:VAR) : perm :=
  {| perm_f := fun z => if eq_nat_dec x z then y
                   else if eq_nat_dec y z then x else z
   ; perm_g := fun z => if eq_nat_dec x z then y
                   else if eq_nat_dec y z then x else z
   |}.

Class Nominal (A:Type) (rel:relation A):=
  { papp : perm -> A -> A
  ; support : A -> VAR -> Prop
  ; nom_id : forall a , papp perm_id a = a
  ; nom_comp : forall a p1 p2,
        (papp p1 (papp p2 a)) = (papp (perm_compose p1 p2) a)
  ; support_axiom : forall p a,
       (forall v, support a v -> perm_f p v = v) ->
       rel (papp p a) a
  ; support_papp : forall p x v,
       support x v <-> support (papp p x) (perm_f p v)
  }.

Lemma support_axiom' A rel `{Nominal A rel} :
  forall p x,
      (forall v, support x v -> perm_f p v = v) ->
      rel x (papp p x).

Program Instance perm_nominal : Nominal perm eq :=
  {| papp := perm_compose
   ; support p v := True
   |}.

Program Instance var_nominal : Nominal VAR eq :=
  {| papp := perm_f
   ; support := eq
   |}.

Inductive option_rel A (R:relation A) : option A -> option A -> Prop :=
  | opt_rel_None : option_rel A R None None
  | opt_rel_Some : forall x y, R x y -> option_rel A R (Some x) (Some y).

Program Instance option_nominal A R {N:Nominal A R} : Nominal (option A) (option_rel A R) :=
  {| papp p := option_map (papp p)
   ; support a v := match a with | None => False | Some a' => support a' v end
  |}.

Lemma papp_eq A R `{Nominal A R}: forall p (x y:A),
  papp p x = y ->
  x = papp (perm_inv p) y.

Lemma papp_eq2 A R `{Nominal A R}: forall p (x y:A),
  papp (perm_inv p) x = y ->
  x = papp p y.

Inductive pairwise (A B: Type) (f: A -> B -> Prop): list A -> list B -> Prop :=
 | pairwise_nil: pairwise A B f nil nil
 | pairwise_cons: forall x xs y ys, f x y -> pairwise A B f xs ys ->
                          pairwise A B f (x::xs) (y::ys).
Implicit Arguments pairwise.

Program Instance list_nominal A R `{Nominal A R} : Nominal (list A) (pairwise R) :=
 {| papp p := map (papp p)
  ; support l v := exists x, In x l /\ support x v
  |}.

Lemma papp_In : forall a p x,
  In a (papp p x) <-> In (perm_g p a) x.

Lemma remove_In2 : forall x v l,
  In v (remove eq_nat_dec x l) <-> (x <> v /\ In v l).

Lemma papp_remove : forall l v p,
  papp p (remove eq_nat_dec v l) =
  remove eq_nat_dec (perm_f p v) (papp p l).