(* * Machines on [N] (binary natural numbers) *)

From Undecidability.TM Require Import ProgrammingTools.
From Undecidability Require Import BinNumbers.EncodeBinNumbers.
From Undecidability Require Import Code.CaseSum. (* [CaseOption] *)

From Undecidability Require Import ArithPrelim.
From Coq Require Import BinNat.

Local Open Scope N_scope.

(* ** Write a number *)

Definition WriteNumber (n : N) : pTM sigN^+ unit 1 := WriteValue n.

Definition WriteNumber_Rel (n : N) : pRel sigN^+ unit 1:=
  fun tin '(_, tout) =>
    isVoid tin[@Fin0] ->
    tout[@Fin0] ≃ n.

Definition WriteNumber_steps (n : N) : nat := 2 * Encode_N_size n + 3.

Lemma WriteNumber_Sem (n : N) : WriteNumber n ⊨c(WriteNumber_steps n) WriteNumber_Rel n.
Proof.
  eapply RealiseIn_monotone.
  { unfold WriteNumber. TM_Correct. }
  { setoid_rewrite Encode_N_hasSize. cbn. ring_simplify. reflexivity. }
  {
    intros tin ([], tout) H. hnf in H. intros Hright. modpon H. auto.
  }
Qed.

(* ** Constructor *)

Definition Constr_N0 : pTM sigN^+ unit 1 := WriteNumber 0.

Definition Constr_N0_Rel : pRel sigN^+ unit 1:=
  fun tin '(_, tout) =>
    isVoid tin[@Fin0] ->
    tout[@Fin0] ≃ 0.

Definition Constr_N0_steps : nat := Eval cbn in WriteNumber_steps 0.

Lemma Constr_N0_Sem : Constr_N0 ⊨c(Constr_N0_steps) Constr_N0_Rel.
Proof.
  eapply RealiseIn_monotone.
  { unfold Constr_N0. apply WriteNumber_Sem. }
  { reflexivity. }
  { intros tin ([], tout) H. hnf in *. eauto. }
Qed.

Definition Constr_Npos : pTM sigN^+ unit 1 := Constr_Some _.

Definition Constr_Npos_Rel : pRel sigN^+ unit 1 :=
  fun tin '(_, tout) =>
    forall (x : positive),
      tin[@Fin0] ≃ x ->
      tout[@Fin0] ≃ Npos x.

Definition Constr_Npos_Sem : Constr_Npos ⊨c(Constr_Some_steps) Constr_Npos_Rel.
Proof.
  eapply RealiseIn_monotone.
  { unfold Constr_Npos. TM_Correct. }
  { reflexivity. }
  { intros tin ([], tout) H. cbn in *. intros x Hx. modpon H. auto. }
Qed.

(* ** Deconstructor *)

(* Don't reset tape when [x=0], in contrast to [CaseOption] *)
Definition CaseN : pTM sigN^+ bool 1 := If (CaseOption _) (Return Nop true) (Return (WriteNumber 0) false).

Definition CaseN_Rel : pRel sigN^+ bool 1 :=
  fun tin '(yout, tout) =>
    forall (x : N),
      tin[@Fin0] ≃ x ->
      match yout, x with
      | true, Npos p => tout[@Fin0] ≃ p
      | false, N0 => tout[@Fin0] ≃ 0
      | _, _ => False
      end.

Definition CaseN_steps : nat := 13.

Lemma CaseN_Sem : CaseN ⊨c(CaseN_steps) CaseN_Rel.
Proof.
  eapply RealiseIn_monotone.
  { unfold CaseN. TM_Correct.
    - apply WriteNumber_Sem. }
  { reflexivity. }
  {
    intros tin (yout, tout) H. intros x Hx. destruct H as [H|H]; TMSimp.
    - modpon H. destruct x as [ | p]; cbn in *; auto.
    - modpon H. destruct x as [ | p]; cbn in *; auto.
  }
Qed.

(* ** Increment *)

From Undecidability Require Import PosIncrementTM.

Definition Increment_N : pTM sigN^+ unit 1 := If (CaseOption _) (Increment ⇑ _;; Constr_Some _) (WriteNumber 1).

Definition Increment_N_Rel : pRel sigN^+ unit 1 :=
  fun tin '(_, tout) =>
    forall (n : BinNums.N),
      tin[@Fin0] ≃ n ->
      tout[@Fin0] ≃ N.succ n.

Lemma Increment_N_Realise : Increment_N ⊨ Increment_N_Rel.
Proof.
  eapply Realise_monotone.
  { unfold Increment_N. TM_Correct.
    - apply Increment_Realise.
    - eapply RealiseIn_Realise. apply WriteNumber_Sem. }
  {
    intros tin ([], tout) H. intros n Hn. destruct H as [H|H]; TMSimp.
    - modpon H. destruct n; cbn in *; auto.
      modpon H0;[].
      modpon H1;[]. eauto.
    - modpon H. destruct n; cbn in *; auto.
  }
Qed.

(* ** Addition *)

From Undecidability Require Import PosAddTM.

Definition Add'_N : pTM sigN^+ unit 2 :=
  If (CaseOption _ @[|Fin0|])
     (If (CaseOption _ @[|Fin1|])
         (Add' ⇑ _;; Constr_Some _@[|Fin0|];; Constr_Some _@[|Fin1|])
         (Constr_Some _@[|Fin0|];; CopyValue _))
     (Constr_None _@[|Fin0|]).

Definition Add'_N_Rel : pRel sigN^+ unit 2 :=
  fun tin '(_, tout) =>
    forall (x y : N),
      tin[@Fin0] ≃ x ->
      tin[@Fin1] ≃ y ->
      x <= y ->
      tout[@Fin0] ≃ x /\
      tout[@Fin1] ≃ x + y.

Lemma Add'_N_Realise : Add'_N ⊨ Add'_N_Rel.
Proof.
  eapply Realise_monotone.
  { unfold Add'_N. TM_Correct.
    - apply Add'_Realise.
    }
  {
    intros tin ([], tout) H. intros x y Hx Hy Hle. destruct H as [H|H]; TMSimp.
    - modpon H. destruct x as [ | x]; cbn in *; auto.
      destruct H0; TMSimp.
      + modpon H0. destruct y as [ | y]; cbn in *; auto.
        specialize (H1 x y).
        modpon H1;[].
        simpl_tape in *; simpl_surject.
        modpon H3. modpon H4.
        split; eauto.
      + modpon H0. destruct y as [ | y]; cbn in *; auto.
        modpon H1.
        specialize (H3 (N.pos x)). modpon H3.
        split; auto.
    - modpon H. destruct x as [ | x]; cbn in *; auto. modpon H0. auto.
  }
Qed.

Definition Add_N : pTM sigN^+ unit 3 :=
  If (CaseOption _ @[|Fin0|])
     (If (CaseOption _ @[|Fin1|])
         (Add ⇑ _;; Constr_Some _@[|Fin0|];; Constr_Some _@[|Fin1|];; Constr_Some _@[|Fin2|])
         (Constr_Some _@[|Fin0|];; Constr_None _@[|Fin1|];; CopyValue _ @[|Fin0; Fin2|]))
     (Constr_None _@[|Fin0|];; CopyValue _@[|Fin1; Fin2|]).

Definition Add_N_Rel : pRel sigN^+ unit 3 :=
  fun tin '(_, tout) =>
    forall (x y : N),
      tin[@Fin0] ≃ x ->
      tin[@Fin1] ≃ y ->
      isVoid tin[@Fin2] ->
      tout[@Fin0] ≃ x /\
      tout[@Fin1] ≃ y /\
      tout[@Fin2] ≃ x+y.

Lemma Add_N_Realise : Add_N ⊨ Add_N_Rel.
Proof.
  eapply Realise_monotone.
  { unfold Add_N. TM_Correct.
    - apply Add_Realise. }
  {
    intros tin ([], tout) H. intros x y Hx Hy Hright. destruct H as [H|H]; TMSimp.
    - modpon H. destruct x as [ | x]; cbn in *; auto.
      destruct H0; TMSimp.
      +
        rename H0 into HCaseOption, H1 into HAdd, H3 into HSome0, H4 into HSome1, H6 into HSome2.
        modpon HCaseOption. destruct y as [ | y]; cbn in *; auto.
        specialize (HAdd x y). modpon HAdd; simpl_tape in *; simpl_surject; TMSimp; auto.
        modpon HSome0. modpon HSome1. modpon HSome2.
        repeat split; eauto.
      + modpon H0. destruct y as [ | y]; cbn in *; auto.
        modpon H1.
        modpon H3. modpon H5.
        TMSimp.
        repeat split; auto.
    - modpon H. destruct x as [ | x]; cbn in *; auto. modpon H0. modpon H2. auto.
  }
Qed.

(* ** Multiplication *)

From Undecidability Require Import PosMultTM.

(* Print N.mul. *)

Definition Mult_N : pTM sigN^+ unit 3 :=
  If (CaseN @[|Fin0|])
     (If (CaseN @[|Fin1|])
         (Mult ⇑ _;; Constr_Npos @[|Fin0|];; Constr_Npos @[|Fin1|];; Constr_Npos @[|Fin2|])
         (Constr_Npos @[|Fin0|];; Constr_N0 @[|Fin2|]))
     (Constr_N0 @[|Fin2|]).

Definition Mult_N_Rel : pRel sigN^+ unit 3 :=
  fun tin '(yout, tout) =>
    forall (x y : N),
      tin[@Fin0] ≃ x ->
      tin[@Fin1] ≃ y ->
      isVoid tin[@Fin2] ->
      tout[@Fin0] ≃ x /\
      tout[@Fin1] ≃ y /\
      tout[@Fin2] ≃ x*y.

Lemma Mult_N_Realise : Mult_N ⊨ Mult_N_Rel.
Proof.
  eapply Realise_monotone.
  { unfold Mult_N. TM_Correct.
    - eapply RealiseIn_Realise. apply CaseN_Sem.
    - eapply RealiseIn_Realise. apply CaseN_Sem.
    - apply Mult_Realise.
    - eapply RealiseIn_Realise. apply Constr_Npos_Sem.
    - eapply RealiseIn_Realise. apply Constr_Npos_Sem.
    - eapply RealiseIn_Realise. apply Constr_Npos_Sem.
    - eapply RealiseIn_Realise. apply Constr_Npos_Sem.
    - eapply RealiseIn_Realise. apply Constr_N0_Sem.
    - eapply RealiseIn_Realise. apply Constr_N0_Sem. }
  {
    intros tin ([], tout) H. intros x y Hx Hy Hright. destruct H as [H|H]; TMSimp.
    - modpon H. destruct x as [ | x]; cbn in *; auto. destruct H0 as [?|?]; TMSimp.
      + modpon H0. destruct y as [ | y]; cbn in *; auto. simpl_tape in *; simpl_surject. TMSimp.
        modpon H1. modpon H3. modpon H4. repeat split; eauto.
      + modpon H0. destruct y as [ | y]; cbn in *; auto.
    - modpon H. destruct x as [ | x]; cbn in *; auto.
  }
Qed.

(* ** Tactic Support *)

Ltac smpl_TM_NTM :=
  match goal with
  (* WriteNumber *)
  | [ |- WriteNumber _ ⊨ _ ] => eapply RealiseIn_Realise; apply WriteNumber_Sem
  | [ |- WriteNumber _ ⊨c(_) _ ] => apply WriteNumber_Sem
  | [ |- projT1 (WriteNumber _) ↓ _ ] => eapply RealiseIn_TerminatesIn; apply WriteNumber_Sem
  (* Constr_N0 *)
  | [ |- Constr_N0 ⊨ _ ] => eapply RealiseIn_Realise; apply Constr_N0_Sem
  | [ |- Constr_N0 ⊨c(_) _ ] => apply Constr_N0_Sem
  | [ |- projT1 (Constr_N0) ↓ _ ] => eapply RealiseIn_TerminatesIn; apply Constr_N0_Sem
  (* Constr_Npos *)
  | [ |- Constr_Npos ⊨ _ ] => eapply RealiseIn_Realise; apply Constr_Npos_Sem
  | [ |- Constr_Npos ⊨c(_) _ ] => apply Constr_Npos_Sem
  | [ |- projT1 (Constr_Npos) ↓ _ ] => eapply RealiseIn_TerminatesIn; apply Constr_Npos_Sem
  (* CaseN *)
  | [ |- CaseN ⊨ _ ] => eapply RealiseIn_Realise; apply CaseN_Sem
  | [ |- CaseN ⊨c(_) _ ] => apply CaseN_Sem
  | [ |- projT1 (CaseN) ↓ _ ] => eapply RealiseIn_TerminatesIn; apply CaseN_Sem
  (* Increment_N *)
  | [ |- Increment_N ⊨ _ ] => apply Increment_N_Realise
  (* Add'_N *)
  | [ |- Add'_N ⊨ _ ] => apply Add'_N_Realise
  (* Add_N *)
  | [ |- Add_N ⊨ _ ] => apply Add_N_Realise
  (* Mult_N *)
  | [ |- Mult_N ⊨ _ ] => apply Mult_N_Realise
  end.

Smpl Add smpl_TM_NTM : TM_Correct.


Require Export Iron.Language.SystemF2Data.Base.
Require Export Iron.Language.SystemF2Data.Kind.
Require Export Iron.Language.SystemF2Data.Type.Exp.TyCon.

(* Type Expressions. *)
Inductive ty  : Type :=
 | TCon      : tycon -> ty
 | TVar      : nat   -> ty
 | TForall   : ty    -> ty
 | TApp      : ty    -> ty -> ty.
Hint Constructors ty.

(* Builtin in types. *)
Definition tUnit
 := TCon tcUnit.

Definition tFun (t1: ty) (t2: ty)
 := TApp (TApp (TCon TyConFun) t1) t2.
Hint Unfold tFun.

Definition tNat
 := TCon TyConNat.

Definition tBool
 := TCon TyConBool.


(*

Require Export Relations ind_potype.

Set Implicit Arguments.
Unset Strict Implicit.

Section pcfo_syntax.

(*Inductive base_type := Bool | Nat.*)

Inductive TY :=
 | Bool : TY
 | Nat : TY
 | arrow: TY -> TY -> TY.

Definition ipo := ind_po_obj TY.

Inductive PCF_consts : TY -> Type :=
 | Nats : nat -> PCF_consts Nat
 | tt : PCF_consts Bool
 | ff : PCF_consts Bool
 | succ : PCF_consts (arrow Nat Nat)
 | zero : PCF_consts (arrow Nat Bool)
 | condN: PCF_consts (arrow Bool (arrow Nat (arrow Nat Nat)))
 | condB: PCF_consts (arrow Bool (arrow Bool (arrow Bool Bool))).

Inductive PCF (V: ind_po_obj TY) : TY -> Type:=
 | Bottom: forall t, PCF V t
 | Const : forall t, PCF_consts t -> PCF V t
 | PCFVar : forall t, V t -> PCF V t
 | PApp : forall t s, PCF V (arrow s t) -> PCF V s -> PCF V t
 | PLam : forall t s, PCF (opt_TP t V) s -> PCF V (arrow t s)
 | PRec : forall t, PCF V (arrow t t) -> PCF V t.

Definition PCF_varmap (V W: ind_po_obj TY):Type :=
        ind_po_mor V W.

Fixpoint PCF_rename_ (V W:ind_po_obj TY) (f:PCF_varmap V W)
         (t:TY)(v:PCF V t): PCF W t :=
    match v with
    | Bottom t => Bottom W t
    | Const t c => Const W c
    | PCFVar t v => PCFVar (f t v)
    | PApp t s u v => PApp (PCF_rename_ f u) (PCF_rename_ f v)
    | PLam t s u => PLam (PCF_rename_ (opt_TP_map _ (*u:=t*) f) u)
    | PRec t u => PRec (PCF_rename_ f u)
    end.

Lemma PCF_rename_eq (V:ind_po_obj TY)(t:TY)(v: PCF V t)
  (W: ind_po_obj TY) (f g: PCF_varmap V W)(H: forall t x, f t x = g t x):
           PCF_rename_ f v = PCF_rename_ g v.
Proof. intros V t v; induction v; simpl; auto.

       intros; rewrite H; auto.

       intros. rewrite (IHv1 W f g); auto.
               rewrite (IHv2 W f g); auto.

       intros.
       rewrite (IHv (opt_TP t W) (opt_TP_map _ f) (opt_TP_map _ g)); auto.
       intros; apply opt_TP_map_extens; auto.

       intros; rewrite (IHv W f g H); auto.
Qed.

Lemma PCF_rename_id (V:ind_po_obj TY)(t:TY)(v: PCF V t)
  (f: PCF_varmap V V)(H: forall t x, f t x = x):
           PCF_rename_ f v = v.
Proof. intros V t v; induction v; simpl; auto.
       intros f H; rewrite H; auto.
       intros f H; rewrite IHv1; try rewrite IHv2; auto.
       intros f H; rewrite IHv; intros; try apply opt_TP_map_id; auto.
       intros f H; rewrite IHv; auto.
Qed.

Lemma PCF_rename_comp (V: ind_po_obj TY) (t: TY) (v: PCF V t)
      (W X: ind_po_obj TY) (f: PCF_varmap V W) (g: PCF_varmap W X):
      PCF_rename_ (ind_po_comp f g) v =
           PCF_rename_ g (PCF_rename_ f v).
Proof. intros V t v; induction v; simpl; auto.
       intros W X f g; rewrite IHv1; rewrite IHv2; auto.
       intros W X f g. apply f_equal.
       rewrite <- (IHv _ (opt_TP t X)).
       apply PCF_rename_eq.
       intros to x.
       set (H3:=opt_TP_map_comp).
       simpl in *. apply H3.
       intros W X f g; rewrite IHv; auto.
Qed.

(* injection of terms into terms with one variable more, of type u *)
Definition PCF_inj_(u:TY)(V:ind_po_obj TY)(t:TY)(v:PCF V t):
           PCF (opt_TP u V) t :=
    PCF_rename_ (@Some_TP_PO TY u V) v.

Definition PCF_shift_ :=
fun (u : TY) (V W : ind_po_obj TY) (f : forall t : TY, V t -> PCF W t)
  (t : TY) (v : opt_TP u V t) =>
match v in (opt_TPd _ _ y) return (PCF (opt_TP u W) y) with
| Some_TP t0 p => PCF_inj_ u (f t0 p)
| None_TP => PCFVar (V:=opt_TP u W) (t:=u) (None_TP u W)
end.

Lemma PCF_shift_eq (u:TY) (V:ind_po_obj TY)(t:TY)(v:opt_TP u V t)
          (W:ind_po_obj TY)(f g: forall t, V t -> PCF W t)
          (H: forall t x, f t x = g t x):
          PCF_shift_ f v = PCF_shift_ g v.
Proof. intros u V t v; induction v; simpl; intros; try rewrite H; auto.
Qed.

Lemma PCF_shift_var (u:TY)(V:ind_po_obj TY)(t:TY)(v: opt_TP u V t):
       PCF_shift_ (fun t x => PCFVar x) v = PCFVar v.
Proof. induction v; intros; simpl; auto. Qed.

Lemma PCF_var_lift_shift_eq (u:TY) (V:ind_po_obj TY)
     (t: TY) (v: opt_TP u V t)
               (W:ind_po_obj TY) (f: ind_po_mor V W):
    PCFVar (opt_TP_map u f t v) =
    PCF_shift_ (fun t x0 => PCFVar (f t x0)) v.
Proof. induction v; simpl; intros; auto. Qed.

Lemma PCF_shift_lift (u:TY) (V: ind_po_obj TY) (t:TY)(v:opt_TP u V t)
           (W:ind_po_obj TY)(f: ind_po_mor V W) (X: ind_po_obj TY)
                    (g: forall t, W t -> PCF X t):
   PCF_shift_ g (opt_TP_map u f t v) =
   PCF_shift_ (fun t x0 => g t (f t x0)) v.
Proof. induction v; simpl; intros; auto. Qed.

Fixpoint PCF_subst_ (V W: ind_po_obj TY) (t:TY) (v: PCF V t)
       (f: forall t, V t -> PCF W t) : PCF W t :=
    match v with
    | Bottom t => Bottom W t
    | Const t c => Const W c
    | PCFVar t v => f t v
    | PApp t s u v => PApp (PCF_subst_ u f) (PCF_subst_ v f)
    | PLam t s u => PLam (PCF_subst_ u (PCF_shift_ (*u:=t*) f))
    | PRec t u => PRec (PCF_subst_ u f)
    end.

Definition PCF_substar (u:TY)(V:ind_po_obj TY) (t:TY)(v:PCF (opt_TP u V) t)
      (M:PCF V u): PCF V t := PCF_subst_ (V:=opt_TP u V) v
  (fun t x => match x with
            | None_TP => M
            | Some_TP _ v => PCFVar v
            end) .

Lemma PCF_subst_eq (V: ind_po_obj TY)(t:TY)(v:PCF V t) (W:ind_po_obj TY)
       (f g: forall t, V t -> PCF W t)
       (H: forall t x, f t x = g t x) :
       PCF_subst_ v f = PCF_subst_ v g.
Proof. induction v; intros; simpl;  auto.

       try rewrite (IHv1 W f g);
       try rewrite (IHv2 W f g);
       try rewrite (IHv W f g); auto.

       rewrite (IHv _ (PCF_shift_ f) (PCF_shift_ g)); auto.
       intros; apply PCF_shift_eq; auto.

       rewrite (IHv W f g); auto.
Qed.

Lemma PCF_subst_var (V:ind_po_obj TY)(t:TY)(v:PCF V t):
       PCF_subst_ v (fun t x0 => PCFVar x0) = v.
Proof. induction v; intros; simpl; auto.
       rewrite IHv1. rewrite IHv2; auto.
       rewrite <- IHv at 2.
       apply f_equal. apply PCF_subst_eq.
       intros; apply PCF_shift_var.
       rewrite IHv; auto.
Qed.

Lemma PCF_subst_eq_rename (V:ind_po_obj TY)(t:TY)(v:PCF V t)
      (W:ind_po_obj TY) (f:ind_po_mor V W):
        PCF_rename_ f v = PCF_subst_ v (fun t x0 => PCFVar (f t x0)).
Proof. induction v; intros; simpl; auto.
       rewrite IHv1; rewrite IHv2; auto.
       rewrite IHv. apply f_equal. apply PCF_subst_eq.
       intros; apply PCF_var_lift_shift_eq.
       rewrite IHv; auto.
Qed.

Lemma PCF_rename_term_inj (u:TY)(V:ind_po_obj TY)(t:TY)(v:PCF V t)
    (W:ind_po_obj TY) (g: ind_po_mor V W):
       PCF_rename_ (opt_TP_map u g) (PCF_inj_ u v) =
                  PCF_inj_ u (PCF_rename_ g v).
Proof. induction v; simpl; intros; auto.
       rewrite IHv1; rewrite IHv2; auto.
       unfold PCF_inj_. simpl.
       apply f_equal.
       rewrite <- PCF_rename_comp.
       rewrite <- PCF_rename_comp.
       apply PCF_rename_eq.
       induction x; simpl; auto.
       rewrite IHv. unfold PCF_inj_. simpl. auto.
Qed.

Lemma PCF_rename_subst (V:ind_po_obj TY) (t:TY)(v: PCF V t)
     (W:ind_po_obj TY)(f:forall t, V t -> PCF W t)(X:ind_po_obj TY)
     (g:PCF_varmap W X):
   PCF_rename_ g (PCF_subst_ v f) =
           PCF_subst_ v (fun t x => PCF_rename_ g (f t x)).
Proof. induction v; intros; simpl; auto.
       rewrite IHv1; rewrite IHv2; auto.

       rewrite IHv. apply f_equal. apply PCF_subst_eq.
       induction x; simpl; auto.
       apply PCF_rename_term_inj.

       rewrite IHv. auto.
Qed.

Lemma PCF_subst_rename (V:ind_po_obj TY) (t:TY)(v: PCF V t)
     (W:ind_po_obj TY) (f:PCF_varmap V W)(X:ind_po_obj TY)
     (g:forall t, W t -> PCF X t):
   PCF_subst_ (PCF_rename_ f v) g =
           PCF_subst_ v (fun t x =>  g t (f t x)).
Proof. induction v; simpl; intros; auto.
       rewrite IHv1; rewrite IHv2; auto.

       rewrite IHv. apply f_equal.
       apply PCF_subst_eq. intros.
       apply PCF_shift_lift.

       rewrite IHv. auto.
Qed.

Lemma PCF_rename_substar (V:ind_po_obj TY)(s t:TY) (v:PCF (opt_TP s V) t)
   (W:ind_po_obj TY) (f:PCF_varmap V W) N:
       PCF_rename_ (W:=W) f (PCF_substar v N) =
        PCF_substar (PCF_rename_ (opt_TP_map _ f) v) (PCF_rename_ f N).
Proof. intros. unfold PCF_substar.
       rewrite PCF_rename_subst.
       rewrite PCF_subst_rename. simpl.
       apply PCF_subst_eq.
       intros t0 x; destruct x;  simpl; auto.
Qed.

Lemma PCF_subst_term_inj (u:TY)(V:ind_po_obj TY)(t:TY)(v:PCF V t)
      (W:ind_po_obj TY)
      (g:forall t, V t -> PCF W t):
    PCF_subst_ (PCF_inj_ u v) (PCF_shift_ g) = PCF_inj_ u (PCF_subst_ v g).
Proof. induction v; simpl; intros; auto.
       rewrite IHv1; rewrite IHv2; auto.

       unfold PCF_inj_. simpl. apply f_equal.
       rewrite PCF_rename_subst.
       rewrite PCF_subst_rename.
       apply PCF_subst_eq.
       induction x; simpl; auto.
       rewrite PCF_rename_term_inj. auto.

       rewrite IHv; auto.
Qed.

Lemma PCF_subst_shift_shift (u:TY) (V:ind_po_obj TY) (t:TY)(v:opt_TP u V t)
 (W:ind_po_obj TY)
 (f: forall t, V t -> PCF W t) (X:ind_po_obj TY)
 (g:forall t, W t -> PCF X t):
  PCF_subst_ (PCF_shift_ f v) (PCF_shift_ g) =
          PCF_shift_ (fun t x0 => PCF_subst_ (f t x0) g) v.
Proof. induction v; simpl; intros; try apply PCF_subst_term_inj; auto.
Qed.

Lemma PCF_subst_subst (V:ind_po_obj TY)(t:TY)(v:PCF V t)
         (W X:ind_po_obj TY)
         (f:forall t, V t -> PCF W t)(g:forall t, W t -> PCF X t):
  PCF_subst_ (PCF_subst_ v f) g =
     PCF_subst_ v (fun t x0 => PCF_subst_ (f t x0) g).
Proof. induction v; simpl; intros; auto.
       rewrite IHv1; rewrite IHv2; auto.

       rewrite IHv. apply f_equal.
       apply PCF_subst_eq.
       intros; simpl.
       apply PCF_subst_shift_shift.

       rewrite IHv; auto.
Qed.

Inductive PCFrelpropag (rel: forall V t, relation (PCF V t))
      (V:ind_po_obj TY) : forall t, relation (PCF V t) :=
| PCFrelorig : forall t v v', rel V t   v v' -> PCFrelpropag rel v v'
| PCFrelPApp1: forall (*V:ind_po_obj TY*)(s t:TY)(M M':PCF V (arrow s t)) N,
      PCFrelpropag (V:=V) rel M M' ->
      PCFrelpropag rel (PApp M N) (PApp M' N)
| PCFrelPApp2: forall (*V:ind_po_obj TY*)(s t:TY)(M:PCF V (arrow s t)) N N',
      PCFrelpropag rel N N' ->
      PCFrelpropag rel (PApp M N) (PApp M N')
| PCFrelPLam: forall (s t:TY)(M M':PCF (opt_TP s V) t),
      PCFrelpropag rel (V:=opt_TP s V) M M' ->
      PCFrelpropag rel (PLam M) (PLam M')
| PCFrelPRec : forall (s:TY) (M M':PCF V (arrow s s)),
      PCFrelpropag rel M M' ->
      PCFrelpropag rel (PRec M) (PRec M').
(* | PCFrelvv : forall t (x y:V t), PreOrderRel x y
       -> PCFrelpropag rel (PCFVar x) (PCFVar y). *)

Inductive PCF_beta (V:ind_po_obj TY): forall t, relation (PCF V t) :=
| PCFbeta_beta: forall (s t:TY) (M:PCF (opt_TP s V) t) N,
          PCF_beta (PApp (PLam M) N) (PCF_substar M N)
|PCFbeta_var: forall (t:TY) (x y:V t),
          x << y -> PCF_beta (PCFVar x) (PCFVar y).

Lemma PCF_rename_propag :
    forall (rel: forall V t, relation (PCF V t)),
   (forall (V W:ind_po_obj TY) (f:PCF_varmap V W) t,
      Proper (rel V t ==> rel _ _) (@PCF_rename_ _ _ f t))
    ->
    forall (V W: ind_po_obj TY)(f: PCF_varmap V W) t,
    Proper (@PCFrelpropag rel V t ==> @PCFrelpropag rel W t)
           (@PCF_rename_ _ _ f t).
Proof. unfold Proper in *; repeat red in *.
       intros rel H V W f t x y H0.
       generalize dependent W.
       dependent induction H0.
       red in H.

       constructor 1. apply H. auto.

       simpl. constructor 2. auto.
       simpl. constructor 3. auto.
       simpl. constructor 4. auto.
       simpl. constructor 5. auto.
       (*intros W f. simpl. constructor 6.
       set (ft := f t). apply ft. auto.*)
Qed.

Lemma PCF_rename_rt_clos:
 forall (rel:forall V t, relation (PCF V t)),
(forall (V W:ind_po_obj TY)(f:PCF_varmap V W) t,
  Proper (rel V t ==> rel W t)
            (@PCF_rename_ _ _ f t)) ->
 forall V W f t,
 Proper (clos_refl_trans_1n _ (rel V t) ==> clos_refl_trans_1n _ (rel W t))
                 (@PCF_rename_ _ _ f t).
Proof. unfold Proper; repeat red.
       intros rel H V W f t x y H0.
(*       generalize dependent W. *)
       dependent induction H0; simpl.
       intros. constructor 1.
       intros. constructor 2 with (PCF_rename_  f y).
        apply H. auto.
        apply IHclos_refl_trans_1n; auto.
Qed.

Lemma PCF_rename_beta:
forall (V1 W1 : ind_po_obj TY) (f0 : PCF_varmap V1 W1) (t1 : TY),
Proper (@PCF_beta V1 t1 ==> @PCF_beta W1 t1) (@PCF_rename_ _ _  f0 t1).
Proof. intros V W f t.
       unfold Proper; repeat red.
       intros x y H.
       induction H. simpl.
       rewrite PCF_rename_substar.
       constructor.
       simpl.
       constructor 2.
       destruct (f t) as [ft fp]. simpl.
       apply fp. auto.
Qed.

Definition PCFbeta := PCFrelpropag PCF_beta.
(*
Lemma PCFbeta_Bottom
*)
Definition PCFbetaS : forall V t, relation (PCF V t):=
   fun V t => clos_refl_trans_1n _ (@PCFbeta V t).

Instance BETA_struct (V:ipo) t : PO_obj_struct (PCF V t) := {
 Rel := @PCFbetaS V t
}.

Program Definition PCFBETA (V: ipo) : ipo :=
        fun t => Build_PO_obj (BETA_struct V t).

(*  Next Obligation.
    Proof. unfold PCFbetaS; apply Clos_RT_1n. Qed. *)

Program Definition PCF_rename (V W: ind_po_obj TY)(f:ind_po_mor V W) :
          ind_po_mor (PCFBETA V) (PCFBETA W) := fun t =>
    Build_PreOrder_mor (a:= PCFBETA V t)
                       (b:= PCFBETA W t)
              (PO_fun := PCF_rename_ f (t:=t)) _ .

  Next Obligation.
    Proof. unfold Proper; repeat red. unfold PCFbeta.
           intros x y H.
           apply PCF_rename_rt_clos.
           intros V0 W0 F0 t0.
           apply PCF_rename_propag.
           intros V1 W1 f0 t1. unfold Proper. repeat red.
           intros.
           apply PCF_rename_beta. auto.
           auto.
    Qed.

Program Definition  PCF_inj (u:TY)(V:ind_po_obj TY) :
      ind_po_mor (PCFBETA V) (PCFBETA (opt_TP u V)) := fun t =>
        Build_PreOrder_mor  (PO_fun := @PCF_inj_ u V t) _.

  Next Obligation.
    Proof. unfold Proper; repeat red.
           unfold PCF_inj_. intros.

           apply PCF_rename_rt_clos.

           intros V0 W0 F0 t0.
           apply PCF_rename_propag.
           intros V1 W1 f0 t1. unfold Proper. repeat red.
           intros.
           apply PCF_rename_beta. auto.
           auto.
    Qed.

Lemma PCF_shift_propag (u:TY):
    forall (rel: forall V t, relation (PCFBETA V t)),
   (forall (u:TY)(V W:ind_po_obj TY) (f:PCF_varmap V (PCFBETA W)) t,
      Proper (@Rel _  ==> rel _ _) (@PCF_shift_ u _ _ f t))
    ->
    forall (V W: ind_po_obj TY)(f: PCF_varmap V (PCFBETA W)) t,
    Proper (@Rel _  ==> @PCFrelpropag rel _ _ )
           (@PCF_shift_ u _ _ f t).
Proof. unfold Proper in *; repeat red in *.
       intros u rel H V W f t x y H0. red in H.
       generalize dependent W.
       induction H0.

       constructor 1. apply H. constructor. auto.

       intros W f.  constructor 1. apply H.
       constructor 2. auto.
Qed.

Lemma PCF_shift_rt_clos (u:TY):
    forall (rel: forall V t, relation (PCFBETA V t)),
   (forall (u:TY)(V W:ind_po_obj TY) (f:PCF_varmap V (PCFBETA W)) t,
      Proper (@Rel _  ==> rel _ _) (@PCF_shift_ u _ _ f t))
    ->
    forall (V W: ind_po_obj TY)(f: PCF_varmap V (PCFBETA W)) t,
    Proper (@Rel _  ==> @clos_refl_trans_1n _ (rel _ _) )
           (@PCF_shift_ u _ _ f t).
Proof. unfold Proper; repeat red in *.
       intros u rel H V W f t x y H0. red in H.
(*       generalize dependent W. *)
       induction H0.
       (*constructor 2 with (PCFVar (V:=opt_TP u W) (t:=u) (None_TP u W)).
       Focus 2.
          constructor.*)
 constructor 1.

 constructor 2 with (PCF_shift_ f (Some_TP u y)).
 apply H. constructor.  auto.
 constructor.
(* constructor 2 with (PCF_shift_  f (Some_TP u y)).
 apply H.
 constructor. auto.
 constructor.*)
Qed.

(* this is not true *)
(*
Lemma PCF_shift_beta (u:TY):
forall (V1 W1 : ind_po_obj TY) (f0 : PCF_varmap V1 (PCFBETA W1)) (t1 : TY),
Proper (@PreOrderRel _ ==> @PCF_beta _ _ ) (@PCF_shift_ u _ _  f0 t1).
Proof. intros u V W f t.
       unfold Proper; repeat red.
       intros x y H.
       induction H. dependent induction x.  simpl.
       unfold PCF_shift_.
       destruct x. destruct y.
       dependent induction H; simpl.
       rewrite PCF_rename_substar.
       constructor.
Qed.
*)
Program Definition PCF_shift (u:TY) (V W: ind_po_obj TY)
      (f:ind_po_mor V (PCFBETA W)) :
          ind_po_mor (opt_TP u V) (PCFBETA (opt_TP u W)) := fun t =>
    Build_PreOrder_mor (*(a:= PCFBETA V t)
                       (b:= PCFBETA W t) *)
              (PO_fun := @PCF_shift_ u _ _ f t) _ .

  Next Obligation.
    Proof. unfold Proper; repeat red.
           intros x y H. induction H.
           constructor 1.

           simpl.
           unfold PCF_inj_.
           apply PCF_rename_rt_clos.
           intros V0 W0 F0 t0.
           apply PCF_rename_propag.
           intros V1 W1 f0 t1. unfold Proper. repeat red.
           intros.
           apply PCF_rename_beta. auto.

           unfold PCFBETA in f. simpl in f.
           unfold PCFbetaS in f.

           destruct (f t) as [rt fp]. simpl.
           unfold Proper in fp. simpl in fp. red in fp.
           apply fp; auto.
Qed.

Lemma PCF_subst_propag :
    forall (rel: forall V t, relation (PCF V t)),
   (forall (V W:ind_po_obj TY) (f:PCF_varmap V (PCFBETA W)) t,
      Proper (rel V t ==> rel _ _) (fun v => PCF_subst_  v f ))
    ->
    forall (V W: ind_po_obj TY)(f: PCF_varmap V (PCFBETA W)) t,
    Proper (@PCFrelpropag rel V t ==> @PCFrelpropag rel W t)
           (fun v => PCF_subst_ v f ).
Proof. unfold Proper in *; repeat red in *.
       intros rel H V W f t x y H0.
       generalize dependent W.
       dependent induction H0.
       red in H.

       constructor 1. apply H. auto.

       simpl. constructor 2. auto.

       simpl. intros; constructor 3. apply IHPCFrelpropag. auto.

       simpl. intros. constructor 4.
         apply (IHPCFrelpropag _ (PCF_shift _ f)). auto.

       simpl; intros; constructor 5; auto.
         (*red in H.
       intros. constructor 1. apply H.
       set (ft := f t). apply ft.*)
Qed.

Lemma PCF_subst_rt_clos :
    forall (rel: forall V t, relation (PCF V t)),
   (forall (V W:ind_po_obj TY) (f:PCF_varmap V (PCFBETA W)) t,
      Proper (rel V t ==> rel _ _) (fun v => PCF_subst_  v f ))
    ->
    forall (V W: ind_po_obj TY)(f: PCF_varmap V (PCFBETA W)) t,
    Proper (clos_refl_trans_1n _ (rel V t) ==>
                       clos_refl_trans_1n _ (rel _ _))
           (fun v => PCF_subst_ v f ).
Proof. unfold Proper in *; repeat red in *.
       intros rel H V W f t x y H0.
       generalize dependent W.
       dependent induction H0.
       red in H.

       constructor 1.

       intros. constructor 2 with (PCF_subst_ y f).
        apply H. auto.
        apply IHclos_refl_trans_1n.
Qed.

Lemma PCF_subst_substar (V W:ind_po_obj TY)
      (s t:TY) (M:PCF (opt_TP s V) t) N  f:
(PCF_subst_ (V:=V) (W:=W) (PCF_substar M N) (*fun t0 => f t0*) f) =
  PCF_substar (PCF_subst_ M (PCF_shift_ (*fun t0 => f t0*) f)) (PCF_subst_ N f).
Proof. intros V W s t M N f.
       unfold PCF_substar. simpl.
       repeat rewrite PCF_subst_subst.
       apply PCF_subst_eq.
       intros t0 x.
       destruct x. unfold PCF_shift_. (*simpl.*) unfold PCF_inj_.
         rewrite PCF_subst_rename. simpl.
         rewrite  PCF_subst_var. auto.
         simpl.
         apply PCF_subst_eq; auto.
Qed.

Lemma betaS_App1 (V:ind_po_obj TY) (s t: TY) (M M':PCF V (arrow s t))
      N (rel: forall V t, relation (PCF V t)):
   clos_refl_trans_1n _ (@PCFrelpropag rel V _) M M' ->
   clos_refl_trans_1n _ (@PCFrelpropag rel V t) (PApp M N) (PApp M' N).
Proof. intros. generalize N.
       induction H. constructor.
         intros. constructor 2 with (PApp y N0); auto.
                 constructor 2. auto.
Qed.

Lemma betaS_App2 (V:ind_po_obj TY) (s t: TY) (M:PCF V (arrow s t))
      N N' (rel: forall V t, relation (PCF V t)):
   clos_refl_trans_1n _ (@PCFrelpropag rel V _) N N' ->
   clos_refl_trans_1n _ (@PCFrelpropag rel V t) (PApp M N) (PApp M N').
Proof. intros. generalize M.
       induction H. constructor.
         intros. constructor 2 with (PApp M0 y); auto.
                 constructor 3. auto.
Qed.

Lemma betaS_Lam (V:ind_po_obj TY) (s t: TY) (M M': PCF (opt_TP s V) t )
         (rel: forall V t, relation (PCF V t)):
      clos_refl_trans_1n _ (@PCFrelpropag rel _ _ ) M M' ->
      clos_refl_trans_1n _ (@PCFrelpropag rel V _ ) (PLam M) (PLam M').
Proof. intros.
       induction H. constructor.
           constructor 2 with (PLam y); auto.
           constructor 4. auto.
Qed.

Lemma betaS_Rec (V:ind_po_obj TY) (t: TY) (M M': PCF V (arrow t t))
         (rel: forall V t, relation (PCF V t)):
      clos_refl_trans_1n _ (@PCFrelpropag rel _ _ ) M M' ->
      clos_refl_trans_1n _ (@PCFrelpropag rel V _ ) (PRec M) (PRec M').
Proof. intros.
       induction H. constructor.
           constructor 2 with (PRec y); auto.
           constructor 5. auto.
Qed.

Lemma propag_clos_propag_clos (rel: forall V t, relation (PCF V t))
(V:ind_po_obj TY)(t:TY)(x y: PCF V t)
(H: clos_refl_trans_1n _ (@PCFrelpropag
       (fun V0 t0 =>
           fun x0 y0 => clos_refl_trans_1n _
                (@PCFrelpropag rel V0 t0) x0 y0) V t) x y):

clos_refl_trans_1n _ (@PCFrelpropag rel V t) x y.
Proof.
        intros rel  V t x y H.
        induction H.
          constructor.

          clear H0.
          generalize dependent z.
          induction H.

            transitivity v'; auto.

            intros. (*inversion IHclos_refl_trans_1n.*)
            transitivity (PApp M' N); auto.
            apply betaS_App1. apply IHPCFrelpropag. constructor.

            intros.
            transitivity (PApp M N'); auto.
            apply betaS_App2. apply IHPCFrelpropag. constructor.

            intros.
            transitivity (PLam M'); auto.
            apply betaS_Lam. apply IHPCFrelpropag. constructor.

            intros.
            transitivity (PRec M'); auto.
            apply betaS_Rec. apply IHPCFrelpropag. constructor.
Qed.

Lemma PCF_clos (V:ind_po_obj TY)
      (rel: forall V t, relation (PCF V t)) (t:TY) x y:
          rel V t x y -> clos_refl_trans_1n _ (rel V t) x y.
Proof. intros. constructor 2 with y; try constructor; auto. Qed.

Program Definition PCF_subst (V W: ind_po_obj TY)
      (f:PCF_varmap V (PCFBETA W)): ind_po_mor (PCFBETA V) (PCFBETA W) :=
     fun t => Build_PreOrder_mor
        (PO_fun := fun x => PCF_subst_  x f) _ .

  Next Obligation.
    Proof. unfold Proper; repeat red.
           intros x y H.
           generalize dependent W.

           induction H. constructor.

           intros.
                 (*constructor 2 with (PCF_subst_ y f); auto.
                 apply PCF_subst_propag; auto.
                 unfold Proper; repeat red; simpl; intros.
                 induction H1. (* PCF_beta x y *)
                      rewrite PCF_subst_substar; simpl; constructor.
                      simpl. (* not solvable *)*)
                 transitivity (PCF_subst_ y f); auto.
(*                 generalize dependent H0.
                 generalize dependent IHclos_refl_trans_1n.*)
                 apply propag_clos_propag_clos.
                   generalize dependent W.
                   generalize dependent z.
                 induction H. intros. simpl.
                   Focus 2. intros. simpl.
                   clear H0 IHclos_refl_trans_1n z.
                   apply betaS_App1.
                   apply IHPCFrelpropag with M'; constructor.

                   Focus 2. intros. simpl.
                   clear H0 IHclos_refl_trans_1n z.
                   apply betaS_App2.
                   apply IHPCFrelpropag with N'; constructor.

                   Focus 2. intros. simpl.
                   clear H0 IHclos_refl_trans_1n z.
                   apply betaS_Lam.
                   apply (IHPCFrelpropag M' (rt1n_refl _ _ _ )
                       (fun W f => rt1n_refl _ _ _ ) _ (PCF_shift s f)).
                   (*apply (IHPCFrelpropag M' (f:= PCF_shift s f));
                     constructor.*)

                   Focus 2. intros. simpl.
                   clear H0 IHclos_refl_trans_1n z.
                   apply betaS_Rec.
                   apply IHPCFrelpropag with M'; constructor.

                 induction H.
                       apply PCF_clos. constructor 1.
                       simpl.
                       rewrite PCF_subst_substar.
                       apply PCF_clos. constructor 1. constructor 1.

                       simpl.
                       set (ft := f t).
                       destruct ft as [ftt fp]. simpl.
                       unfold Proper in fp; repeat red in fp.
                       apply PCF_clos. constructor 1.
                       apply fp.  auto.
Qed.

Program Definition PCFVAR (V:ind_po_obj TY) : ind_po_mor V (PCFBETA V) :=
       fun t => Build_PreOrder_mor (PO_fun := fun a => PCFVar a) _.

  Next Obligation.
    Proof. unfold Proper; repeat red.
           intros x y H.
           constructor 2 with (PCFVar y); try constructor.
           constructor. auto.
    Qed.

End pcfo_syntax.

Section bla.

Require Export monad_haskell.

(*Variable V:ind_po_obj TY.*)

Program Instance syntax_monad_h: Monad_struct (IND_PO_struct TY)
        (*fun V => PCFBETA V*) PCFBETA.

Next Obligation.
   apply PCFVAR. Defined.

Next Obligation.
  apply (PCF_subst X). Defined.

(*:= {
(*  weta V t v:= PCFVAR v*)
(*  kleisli V W f := fun t x => PCF_subst x f *)
}.*)

  Next Obligation.
    Proof. unfold Proper; red. unfold eq_ind_po, syntax_monad_h_obligation_2.
           intros. unfold eq_PreOrder. simpl. intros; apply PCF_subst_eq. auto.
    Qed.

  Next Obligation.
    Proof. unfold eq_ind_po, eq_PreOrder,ind_po_comp.
           simpl. auto.
    Qed.

  Next Obligation.
    Proof. unfold eq_ind_po,ind_po_id,syntax_monad_h_obligation_2,
             syntax_monad_h_obligation_1,eq_PreOrder,PreOrder_id.
           intros; simpl. apply PCF_subst_var.
    Qed.

  Next Obligation.
    Proof. unfold eq_ind_po,ind_po_id,syntax_monad_h_obligation_2,
             syntax_monad_h_obligation_1,eq_PreOrder,PreOrder_id.
           intros; simpl. rewrite PCF_subst_subst. auto.
    Qed.

End bla.
*)


Require Import rt.util.all.
Require Import rt.model.schedule.global.basic.schedule.
Require Import rt.analysis.apa.workload_bound.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop.

Module InterferenceBoundGeneric.

  Section Definitions.

    Import Schedule WorkloadBound.

    Context {sporadic_task: eqType}.
    Variable task_cost: sporadic_task -> time.
    Variable task_period: sporadic_task -> time.
    Variable task_deadline: sporadic_task -> time.

    Variable num_cpus: nat.

    (* Let tsk be the task to be analyzed. *)
    Variable tsk: sporadic_task.

    Let task_with_response_time := (sporadic_task * time)%type.

    (* Assume a known response-time bound for each interfering task ... *)
    Variable R_prev: seq task_with_response_time.

    (* ... and an interval length delta. *)
    Variable delta: time.

    Section PerTask.

      Variable tsk_R: task_with_response_time.
      Let tsk_other := fst tsk_R.
      Let R_other := snd tsk_R.

      (* Based on the workload bound, Bertogna and Cirinei define the
         following interference bound for a task. *)
      Definition interference_bound_generic :=
        minn (W task_cost task_period tsk_other R_other delta) (delta - (task_cost tsk) + 1).

    End PerTask.

  End Definitions.

End InterferenceBoundGeneric.


Require Import Coq.Lists.List.

Require Import Syntax.
Require Import Sequence.
Require Import Subst.
Require Import Equivalence.

Definition promote_hyp {object} (h : @hyp object) : hyp :=
  match h with
  | hyp_tpl => hyp_tp
  | hyp_tml a => hyp_tm a
  | _ => h
  end.

Definition promote {object} (G : @context object) : context :=
  map promote_hyp G.

Inductive hpositive {object} (P N : list (term object)) : nat -> term object -> Prop :=
| hpositive_goal :
    forall i a,
      In a P
      -> hpositive P N i (subst (sh i) a)

| hpositive_var :
    forall i,
      hpositive P N i (var i)

| hpositive_const :
    forall i a,
      hpositive P N i (subst (under i sh1) a)

| hpositive_prod :
    forall i a b,
      hpositive P N i a
      -> hpositive P N i b
      -> hpositive P N i (prod a b)

| hpositive_pi :
    forall i a b,
      hnegative P N i a
      -> hpositive P N (S i) b
      -> hpositive P N i (pi a b)

| hpositive_sigma :
    forall i a b,
      hpositive P N i a
      -> hpositive P N (S i) b
      -> hpositive P N i (sigma a b)

| hpositive_mu :
    forall i a,
      hpositive P N (S i) a
      -> hpositive P N i (mu a)

| hpositive_bite :
    forall i m a b,
      hpositive P N i a
      -> hpositive P N i b
      -> hpositive P N i (bite (subst (under i sh1) m) a b)

| hpositive_equiv :
    forall i a b,
      equiv a b
      -> hpositive P N i b
      -> hpositive P N i a

with hnegative {object} (P N : list (term object)) : nat -> term object -> Prop :=
| hnegative_goal :
    forall i a,
      In a N
      -> hnegative P N i (subst (sh i) a)

| hnegative_const :
    forall i a,
      hnegative P N i (subst (under i sh1) a)

| hnegative_prod :
    forall i a b,
      hnegative P N i a
      -> hnegative P N i b
      -> hnegative P N i (prod a b)

| hnegative_pi :
    forall i a b,
      hpositive P N i a
      -> hnegative P N (S i) b
      -> hnegative P N i (pi a b)

| hnegative_sigma :
    forall i a b,
      hnegative P N i a
      -> hnegative P N (S i) b
      -> hnegative P N i (sigma a b)

| hnegative_mu :
    forall i a,
      hnegative P N (S i) a
      -> hnegative P N i (mu a)

| hnegative_bite :
    forall i m a b,
      hnegative P N i a
      -> hnegative P N i b
      -> hnegative P N i (bite (subst (under i sh1) m) a b)

| hnegative_equiv :
    forall i a b,
      equiv a b
      -> hnegative P N i b
      -> hnegative P N i a
.

Scheme hpositive_mut_ind := Minimality for hpositive Sort Prop
with   hnegative_mut_ind := Minimality for hnegative Sort Prop.
Combined Scheme hpositive_hnegative_ind from hpositive_mut_ind, hnegative_mut_ind.