Library Implementation

Require Import Common.
Require Export CC.
Require Export Kleene.

Local Open Scope nat_scope.

Choreography language

We start by defining the types for the concrete language we use for proving Turing completeness.
Inductive Expr : Type :=
 | this : Expr
 | zero : Expr
 | succ_this : Expr
.

Inductive BExpr : Type := compare.

Module CC_Expressions <: DecType.

Definition t := Expr.

Lemma eq_dec : forall (e e' : Expr), { e = e' } + { e <> e' }.

End CC_Expressions.

Module Bool_Expressions <: DecType.

Definition t := BExpr.

Lemma eq_dec : forall (e e' : BExpr), { e = e' } + { e <> e' }.

End Bool_Expressions.

The two variables in each process.

Definition xx := true.
Definition yy := false.

Module CC_Eval <: (Eval CC_Expressions Bool Nat Nat).

Definition eval (e:Expr) (f:bool -> nat) : nat :=
match e with
 | zero => 0
 | this => f xx
 | succ_this => S (f xx)
end.

Lemma eval_wd : forall f f', (forall x, f x = f' x) ->
  forall e, eval e f = eval e f'.

End CC_Eval.

Module CC_BEval <: (Eval Bool_Expressions Bool Nat Bool).

Definition eval (b:BExpr) (f:bool -> nat) : bool :=
  (f xx =? f yy).

Lemma eval_wd : forall f f', (forall x, f x = f' x) ->
  forall b, eval b f = eval b f'.

End CC_BEval.

Module Export CC_Nat :=
  CCBase Nat Bool Nat CC_Expressions Bool_Expressions Nat CC_Eval CC_BEval.

Local Open Scope CC_scope.

Restricted conditional.

Definition Send p e q : Eta := p#e --> q$xx.
Definition IfEq p q C1 C2 : Choreography :=
  q#this --> p$yy;; If p ?? compare Then C1 Else C2.


Example sanity_check : forall P s,
  (Build_Program P (3#this --> 2$yy;; Sel 0 1 left;; If 2 ?? compare Then (4#succ_this --> 3$xx;; End) Else (3#zero --> 2$xx;; End)),s)
  --[ L_Sel 0 1 left ]-->
  (Build_Program P (3#this --> 2$yy;; If 2 ?? compare Then (4#succ_this --> 3$xx;; End) Else (3#zero --> 2$xx;; End)), s).

Example CC_ToStar_sanity_check : forall p e q s1 C P, exists s2 v,
  (Build_Program P (Send p e q;; Send p zero q;; C), s1)
  --[ (List.cons (L_Com p v q) (List.cons (L_Com p 0 q) List.nil)) ]-->*
  (Build_Program P C, s2) /\ (CSt.eq_state_ext s2 (CSt.update s1 q xx 0)).

Extensions of CC

We require some additional operators on CC for our encoding.

Section CC_plus.

Fixpoint Implementation_Choreography (m n:nat) (C:Choreography) :=
  match C with
  | End => False
  | Call X => m <= X <= n
  | RT_Call X _ C' => m <= X <= n /\ Implementation_Choreography m n C'
  | Eta;; C' => Implementation_Choreography m n C'
  | If p ?? b Then C1 Else C2 => Implementation_Choreography m n C1 /\ Implementation_Choreography m n C2
end.

Definition Implementation_Program (P:Program) (m n:nat) :=
    Main P = Call m /\
    (forall k, m<=k<n -> Implementation_Choreography m n (Procs P k)) /\
    (forall k, (k<m \/ n<=k) -> Procs P m = End).

Functions Pi and Gamma


Fixpoint Pi {m} (f:PRFunction m) : nat :=
  match f with
  | Zero => 0
  | Successor => 0
  | Projection _ => 0
  | @Composition k m g fs => Pi g + vsum (map Pi fs) + m
  | Recursion f g => Pi f + Pi g + 3
  | Minimization f => Pi f + 3
  end.

Fixpoint Gamma {m} (f:PRFunction m) : nat :=
  match f with
  | Zero => 1
  | Successor => 1
  | Projection _ => 1
  | @Composition _ _ g fs => Gamma g + vsum (map Gamma fs)
  | Recursion f g => Gamma f + Gamma g + 3
  | Minimization f => Gamma f + 2
  end.

Lemma Gamma_neq_zero : forall m (f:PRFunction m), 0 < Gamma f.


Useful macros for writing choreographies.
Definition Pack0 (ps:list Pid) (C:Choreography) :=
  Build_Program (fun (X:RecVar) => (ps,End)) C.

Definition Pack1 X CX : RecVar -> Choreography :=
  (fun (R:RecVar) => if RecVar_dec R X then CX else End).

End CC_plus.

Definitions

We have the usual problems with defining implementation: we need information about the size of the vector of processes that we only get with an interactive definition. *sigh* Even worse, because of composition we need to do induction on the depth of the function...
Section Definitions.

Fixpoint all_pids (n:Pid) :=
  match n with
  | O => List.cons 0 List.nil
  | S k => List.cons (S k) (all_pids k)
  end.

Lemma all_pids_not_nil : forall n, all_pids n <> List.nil.

Fixpoint seq_labels (n:nat) {k} {m} (fs:t (PRFunction m) k) : t Pid k :=
  match fs with
  | [] => []
  | (_ :: fs') => (n :: seq_labels (S n) fs')
  end.

Lemma seq_labels_lt : forall x {m k} (fs:t (PRFunction m) k) n,
  In x (seq_labels n fs) -> n <= x < n + k.

Fixpoint skip_labels (n:nat) {k} {m} (fs:t (PRFunction m) k) : t Pid k :=
  match fs with
  | [] => []
  | (f :: fs') => (n :: skip_labels (n + Pi f) fs')
  end.

This function takes care of the first part of the definition of composition. Relationship to the arguments in the paper:
  • fs is the vector of functions
  • ps are the (fixed) argument processes
  • target is the output process for the first function to implement
  • init is the label l_i
  • k is the first free procedure definition
Fixpoint seq_compose {m} {k} (fs:t (PRFunction m) k) d (Hd:forall i, depth fs[@i] < d) (ps:t Pid m) (target init:nat) (X:RecVar)
  (Implement : forall m' (f:PRFunction m') (Hd:depth f < d) (ps':t Pid m') (q' i':nat) (k':RecVar), RecVar -> Choreography) {struct fs} : RecVar -> Choreography.

Relationship to the arguments in the paper:
  • f is the function (f)
  • pids is the list of all processes used in the choreography
  • ps are the input processes p
  • q is the output process q
  • init is the label l
  • k is the first free recursion variable
Fixpoint Encoding_rec {m} (f:PRFunction m) d (Hd:depth f<d)
  (ps:t Pid m) (q:Pid) (init:nat) (X:RecVar) {struct d}: RecVar -> Choreography.

The definition in the paper uses auxiliary process names distinct from the ps and q, numbered from 0. We model this by using auxiliary processes higher than the ps and q.
Definition Encoding {m} (f:PRFunction m) (ps:t Pid m) (q:Pid) : Program :=
  Build_Program
    (fun X => (all_pids ((max q (vmax ps)) + Pi f),
               Encoding_rec f _ (lt_n_Sn (depth f)) ps q (S (max q (vmax ps))) 0 X))
    (Call 0).

By default, we take process 0 for q and 1..m for the ps.
Definition Encoding' {m} (f:PRFunction m) : Program :=
  Encoding f (vec_1_to_n m) 0.


End Definitions.

Section Soundness.

Again - since the definitions are interactive, we prove that they behave as expected.
Lemma Zero_Procs : forall d Hd ps q n X,
  Encoding_rec Zero d Hd ps q n X X = Send (hd ps) zero q;; Call (S X).

Lemma Successor_Procs : forall d Hd ps q n X,
  Encoding_rec Successor d Hd ps q n X X = Send (hd ps) succ_this q;; Call (S X).

Lemma Projection_Procs : forall k m (Hp:k<m) d Hd ps q n X,
  Encoding_rec (Projection Hp) d Hd ps q n X X = Send ps[@Fin.of_nat_lt Hp] this q;; Call (S X).

Lemma seq_compose_Procs_hd : forall m k f (fs:t (PRFunction m) k) d Hd ps q i X Implement Y,
  X <= Y < X + Gamma f ->
  seq_compose (f::fs) d Hd ps q i X Implement Y =
    Implement m f (Hd Fin.F1) ps q i X Y.

Lemma seq_compose_Procs_tl : forall m k f (fs:t (PRFunction m) k) d Hd ps q i X Implement Y,
  X + Gamma f <= Y < X + (vsum (map Gamma (f::fs))) ->
  seq_compose (f::fs) d Hd ps q i X Implement Y =
    seq_compose fs d (fun i => Hd (Fin.FS i)) ps (S q) (i + Pi f) (X + Gamma f) Implement Y.

Lemma Composition_Procs_fs : forall k m (fs:t (PRFunction k) m) g d (Hd:depth (Composition g fs) < S d) ps q n X Y,
  X <= Y < X + (vsum (map Gamma fs)) ->
  let Hd' := (lt_S_n (Nat.max (depth g) (vmax (map depth fs))) d Hd) in
  let Hf := (vmax_lt_map _ _ (max_lt_r _ _ _ Hd')) in
  Encoding_rec (Composition g fs) _ Hd ps q n X Y =
    seq_compose fs _ Hf ps n (n+m) X (fun m f => Encoding_rec f d) Y.

Lemma Composition_Procs_g : forall k m (fs:t (PRFunction k) m) g d (Hd:depth (Composition g fs) < S d) ps q n X Y,
  X + (vsum (map Gamma fs)) <= Y < X + Gamma (Composition g fs) ->
  let Hd' := (lt_S_n (Nat.max (depth g) (vmax (map depth fs))) d Hd) in
  let Hg := (max_lt_l _ _ _ Hd') in
  Encoding_rec (Composition g fs) _ Hd ps q n X Y =
    Encoding_rec g _ Hg (seq_labels n fs) q (n + m) (X + (vsum (map Gamma fs))) Y.

Lemma Recursion_Procs_g : forall k (g:PRFunction k) h d (Hd:depth (Recursion g h) < S d) ps q n X Y,
  X <= Y < X + Gamma g ->
  let Hd' := (lt_S_n (Nat.max (depth g) (depth h)) d Hd) in
  let Hg := (max_lt_l _ _ _ Hd') in
  Encoding_rec (Recursion g h) _ Hd ps q n X Y =
    Encoding_rec _ _ Hg (tl ps) n (n+3) X Y.

Lemma Recursion_Procs_0 : forall k (g:PRFunction k) h d (Hd:depth (Recursion g h) < S d) ps q n X,
  Encoding_rec (Recursion g h) _ Hd ps q n X (X + Gamma g) =
    Send (n + 2) zero (S n);; Call (X + Gamma g + 1).

Lemma Recursion_Procs_1 : forall k (g:PRFunction k) h d (Hd:depth (Recursion g h) < S d) ps q n X,
  Encoding_rec (Recursion g h) _ Hd ps q n X (X + Gamma g + 1) =
    IfEq (S n) (hd ps) (Send n this q;; Call (X + Gamma g + Gamma h + 3)) (Call (X + Gamma g + 2)).

Lemma Recursion_Procs_h : forall k (g:PRFunction k) h d (Hd:depth (Recursion g h) < S d) ps q n X Y,
  X + Gamma g + 2 <= Y < X + Gamma g + Gamma h + 2 ->
  let Hd' := (lt_S_n (Nat.max (depth g) (depth h)) d Hd) in
  let Hh := (max_lt_r _ _ _ Hd') in
  Encoding_rec (Recursion g h) _ Hd ps q n X Y =
    Encoding_rec _ _ Hh (S n :: n :: tl ps) (n+2) (n+3 + Pi g) (X + Gamma g + 2) Y.

Lemma Recursion_Procs_2 : forall k (g:PRFunction k) h d (Hd:depth (Recursion g h) < S d) ps q n X,
  Encoding_rec (Recursion g h) _ Hd ps q n X (X + Gamma g + Gamma h + 2) =
    Send (n+2) this n;; Send (S n) this (n+2);; Send (n+2) succ_this (S n);; Call (X + Gamma g + 1).

Lemma Minimization_Procs_0 : forall k (h:PRFunction (S k)) d (Hd:depth (Minimization h) < S d) ps q n X,
  Encoding_rec (Minimization h) _ Hd ps q n X X =
    Send (n+2) zero (n+1);; Call (X + 1).

Lemma Minimization_Procs_h : forall k (h:PRFunction (S k)) d (Hd:depth (Minimization h) < S d) ps q n X Y,
  (X + 1) <= Y < X + Gamma h + 1 ->
  let Hh := (lt_S_n (depth h) d Hd) in
  Encoding_rec (Minimization h) _ Hd ps q n X Y =
    Encoding_rec h _ Hh (shiftin (n+1) ps) n (n+3) (X + 1) Y.

Lemma Minimization_Procs_1 : forall k (h:PRFunction (S k)) d (Hd:depth (Minimization h) < S d) ps q n X,
  Encoding_rec (Minimization h) _ Hd ps q n X (X + Gamma h + 1) =
    Send (n+1) zero (n+2);; IfEq (n+2) n
            (Send (n+1) this q;; Call (X + Gamma h + 2))
            (Send (n+1) this (n+2);; Send (n+2) succ_this (n+1);; Call (X + 1)).

Lemma Encoding_rec_ge : forall {n} (f:PRFunction n) d Hd ps q i X Y,
  Y >= X + Gamma f -> Encoding_rec f d Hd ps q i X Y = End.

We prove some auxiliary results about how these functions reduce.

Section LargeStepSemantics.

Lemma Zero_reduce : forall Defs (ps: t Pid 1) q X s,
  exists t, (Build_Program Defs (Send (hd ps) zero q;; Call X),s) --[t]--> (Build_Program Defs (Call X), update s q xx 0).

Lemma Successor_reduce : forall Defs (ps: t Pid 1) q X s,
  exists t, (Build_Program Defs (Send (hd ps) succ_this q;; Call X),s) --[t]--> (Build_Program Defs (Call X), update s q xx (S (s (hd ps) xx))).

Lemma Projection_reduce : forall k m (Hp:k<m) Defs ps q X s,
  exists t, (Build_Program Defs (Send ps[@Fin.of_nat_lt Hp] this q;; Call X),s) --[t]--> (Build_Program Defs (Call X), update s q xx (s ps[@Fin.of_nat_lt Hp] xx)).

Lemma Recursion_reduce_0 : forall Defs X n s,
  exists t, (Build_Program Defs (Send (n + 2) zero (S n);; Call X),s) --[t]--> (Build_Program Defs (Call X),update s (S n) xx 0).

Lemma Recursion_reduce_1_true : forall m Defs X Y n (ps:t Pid (S m)) q s,
  s (S n) xx = s (hd ps) xx ->
  exists t s', (Build_Program Defs (IfEq (S n) (hd ps) (Send n this q;; Call X) (Call Y)),s) --[t]-->* (Build_Program Defs (Call X), s')
    /\ s' q xx = s n xx /\ forall p, p <> q -> s' p xx = s p xx.

Lemma Recursion_reduce_1_false : forall m Defs X Y n (ps:t Pid (S m)) q s,
  s (S n) xx <> s (hd ps) xx ->
  exists t, (Build_Program Defs (IfEq (S n) (hd ps) (Send n this q;; Call X) (Call Y)),s) --[t]-->* (Build_Program Defs (Call Y), update s (S n) yy (s (hd ps) xx)).

Lemma Recursion_reduce_2 : forall Defs X n s,
  exists t s', (Build_Program Defs (Send (n+2) this n;; Send (S n) this (n+2);; Send (n+2) succ_this (S n);; Call X),s) --[t]-->* (Build_Program Defs (Call X),s')
    /\ (forall p, p < n -> s' p xx = s p xx) /\ s' n xx = s (n+2) xx /\ s' (S n) xx = S (s (S n) xx) /\ s' (n+2) xx = s (S n) xx.

Lemma Minimization_reduce_0 : forall Defs X n s,
  exists t, (Build_Program Defs (Send (n + 2) zero (n + 1);; Call X),s) --[t]--> (Build_Program Defs (Call X),update s (n + 1) xx 0).

Lemma Minimization_reduce_1_true : forall Defs X Y n s q,
  q < n -> s n xx = 0 -> exists t s', (Build_Program Defs (Send (n+1) zero (n+2);; IfEq (n+2) n
     (Send (n+1) this q;; Call X)
     (Send (n+1) this (n+2);; Send (n+2) succ_this (n+1);; Call Y)),s) --[t]-->* (Build_Program Defs (Call X),s')
  /\ (forall p, p < n -> p <> q -> s' p xx = s p xx) /\ s' q xx = s (n+1) xx /\ s' n xx = s n xx /\ s' (n+1) xx = s (n+1) xx /\ s' (n+2) xx = 0.

Lemma Minimization_reduce_1_false : forall Defs X Y n s q,
  q < n -> s n xx <> 0 -> exists t s', (Build_Program Defs (Send (n+1) zero (n+2);; IfEq (n+2) n
     (Send (n+1) this q;; Call X)
     (Send (n+1) this (n+2);; Send (n+2) succ_this (n+1);; Call Y)),s) --[t]-->* (Build_Program Defs (Call Y),s')
  /\ (forall p, p < n -> s' p xx = s p xx) /\ s' n xx = s n xx /\ s' (n+1) xx = S (s (n+1) xx) /\ s' (n+2) xx = s (n+1) xx.

End LargeStepSemantics.


Definition implements (P:Program) {n} (f:PRFunction n) (ps:t Pid n) (q:Pid) :=
  forall (xs:t nat n) (s:State), (forall Hi, s (ps[@Hi]) xx = xs[@Hi]) ->
  (forall y, converges f xs y <-> exists s' ts P', (P,s) --[ts]-->* (P',s') /\ s' q xx = y /\ Main P' = End) /\
  (diverges f xs <-> forall s' ts P', (P,s) --[ts]-->* (P',s') -> Main P' <> End).

For convenience.
Lemma implements_None : forall P {n} f ps q, implements P f ps q ->
  forall (xs:t nat n) (s:State), (forall Hi, s (ps[@Hi]) xx = xs[@Hi]) ->
  diverges f xs -> forall s' ts P', (P,s) --[ts]-->* (P',s') -> Main P' <> End.

Lemma implements_Some : forall P {n} f ps q, implements P f ps q ->
  forall (xs:t nat n) (s:State), (forall Hi, s (ps[@Hi]) xx = xs[@Hi]) ->
  forall y, converges f xs y -> exists s' ts P', (P,s) --[ts]-->* (P',s') /\ s' q xx = y /\ Main P' = End.

Lemma implements_char (P:Program) {n} (f:PRFunction n) (ps:t Pid n) (q:Pid) :
  (forall (xs:t nat n) (s:State), (forall Hi, s (ps[@Hi]) xx = xs[@Hi]) ->
  (forall y, converges f xs y <-> exists s' ts P', (P,s) --[ts]-->* (P',s') /\ s' q xx = y /\ Main P' = End))
  -> implements P f ps q.

Lemma Encoding_rec_converges : forall {n} (f:PRFunction n) d Hd ps q i X Defs ns y,
  ~In q ps -> (forall p, In p ps -> p < i) -> q < i ->
  (forall Y, X <= Y < X + Gamma f -> fst (Defs Y) <> List.nil) ->
  (forall Y, X <= Y < X + Gamma f -> snd (Defs Y) = Encoding_rec f d Hd ps q i X Y) ->
  converges f ns y ->
  forall (s:State), (forall H, s ps[@H] xx = ns[@H]) ->
  exists tl s', (Build_Program Defs (Call X),s) --[tl]-->* (Build_Program Defs (Call (X + Gamma f)),s')
  /\ s' q xx = y /\ (forall p, p < i -> p <> q -> s' p xx = s p xx).

Theorem Encoding_converges : forall {n} (f:PRFunction n) ps q ns y,
  ~In q ps -> converges f ns y ->
  forall (s:State), (forall H, s ps[@H] xx = ns[@H]) ->
  exists c' tl, (Encoding f ps q, s) --[tl]-->* c' /\ Main (fst c') = End /\ snd c' q xx = y.

Lemma Encoding_rec_End : forall {n} (f:PRFunction n) d Hd ps q i X Defs,
  (forall Y, X <= Y < X + Gamma f -> fst (Defs Y) <> List.nil) ->
  (forall Y, X <= Y < X + Gamma f -> snd (Defs Y) = Encoding_rec f d Hd ps q i X Y) ->
  (forall p, In p ps -> p < i) -> q < i -> ~In q ps ->
  forall ns s, (forall H, s ps[@H] xx = ns[@H]) ->
  forall t s', (Build_Program Defs (Call X),s) --[t]-->* (Build_Program Defs End,s')
  -> exists t' s'', (Build_Program Defs (Call X),s) --[t']-->* (Build_Program Defs (Call (X + Gamma f)),s'')
  /\ (forall p, p < i -> p <> q -> s p xx = s'' p xx) /\ converges f ns (s'' q xx).

Theorem Encoding_converges' : forall {n} (f:PRFunction n) ps q ns y,
  ~In q ps -> forall (s:State), (forall H, s ps[@H] xx = ns[@H]) ->
  (exists c' tl, (Encoding f ps q, s) --[tl]-->* c' /\ Main (fst c') = End /\ snd c' q xx = y)
  -> converges f ns y.

Theorem Encoding_diverges : forall {n} (f:PRFunction n) ps q ns,
  ~In q ps -> diverges f ns ->
  forall (s:State), (forall H, s ps[@H] xx = ns[@H]) ->
  forall c tl, (Encoding f ps q, s) --[tl]-->* c -> Main (fst c) <> End.

Lemma vec_k_to_n_vmax : forall n k, 0 < n -> vmax (vec_k_to_n n k) = n + k - 1.

Theorem encoding_sound : forall n (f:PRFunction n),
  implements (Encoding' f) f (vec_1_to_n n) 0.

End Soundness.

Section WellFormedness.

Well formedness

We now show that implementation choreographies are well-formed. This is strictly speaking not necessary, but it is relevant.
We need to use the list of recursion variables up to a given bound.
Fixpoint RecVarList n : list RecVar :=
match n with
| 0 => (0::List.nil)%list
| S m => (n::RecVarList m)
end.

Lemma RecVarList_In : forall m n, m <= n -> List.In m (RecVarList n).

Lemma In_RecVarList : forall m n, List.In m (RecVarList n) -> m <= n.

Lemma RecVarList_incl : forall m n, m <= n ->
  (forall X, List.In X (RecVarList m) -> List.In X (RecVarList n)).

Choreography implementations are well-formed.
Lemma Encoding_Main_WF : forall {n} (f:PRFunction n) ps q,
  Choreography_WF (Main (Encoding f ps q)).

Lemma Encoding_Main_within_Xs : forall {n} (f:PRFunction n) ps q Xs,
  List.In 0 Xs -> within_Xs Xs (Main (Encoding f ps q)).

Lemma seq_compose_WF : forall {k m} (fs:t (PRFunction m) k) d Hd ps n q X Implement Y,
  (forall p, In p ps -> p < n) -> n + k <= q ->
  (forall k f ps' m' n' H X Y, (forall p, In p ps' -> p < m') -> m' < n' -> Choreography_WF (Implement k f H ps' m' n' X Y)) ->
  Choreography_WF (seq_compose fs d Hd ps n q X Implement Y).

Lemma Encoding_rec_WF : forall m (f:PRFunction m) d Hd ps q n X Y,
  ~In q ps -> (forall p, In p ps -> p < n) -> q < n ->
  Choreography_WF (Encoding_rec f d Hd ps q n X Y).

Lemma seq_compose_initial : forall {k m} (fs:t (PRFunction m) k) d Hd ps n q X Implement Y,
  (forall k f ps' m' n' H X Y, initial (Implement k f H ps' m' n' X Y)) ->
  initial (seq_compose fs d Hd ps n q X Implement Y).

Lemma Encoding_rec_initial : forall m (f:PRFunction m) d Hd ps q n X Y,
  initial (Encoding_rec f d Hd ps q n X Y).

Lemma Encoding_Procs_Vars_not_nil : forall {n} (f:PRFunction n) ps q X,
  Vars (Encoding f ps q) X <> List.nil.

Lemma seq_compose_within_Xs : forall {k m} (fs:t (PRFunction m) k) d Hd ps n q X Implement Y,
  (forall k f ps' m' n' H X Y, within_Xs (RecVarList (X+Gamma f)) (Implement k f H ps' m' n' X Y)) ->
  within_Xs (RecVarList (X+vsum (map Gamma fs))) (seq_compose fs d Hd ps n q X Implement Y).

Lemma Encoding_rec_within_Xs : forall m (f:PRFunction m) d Hd ps q n X,
  forall Y, within_Xs (RecVarList (X+Gamma f)) (Encoding_rec f d Hd ps q n X Y).

Lemma all_pids_In : forall m n, m <= n -> List.In m (all_pids n).

Lemma In_all_pids : forall m n, List.In m (all_pids n) -> m <= n.

Lemma all_pids_incl : forall m n, m <= n -> set_incl_pid (all_pids m) (all_pids n).

Lemma CCC_pn_all_pids_incl : forall C m n, m <= n ->
  (set_incl_pid (CCC_pn C (fun _ => all_pids m)) (all_pids m))
  -> (set_incl_pid (CCC_pn C (fun _ => all_pids n)) (all_pids n)).

Lemma CCC_pn_eta : forall p f f' C, (forall X, f X = f' X) -> List.In p (CCC_pn C f) -> List.In p (CCC_pn C f').

Lemma seq_compose_well_ann : forall {k m} (fs:t (PRFunction k) m) d Hd ps target init X Impl Y,
  (forall p, In p ps -> p <= init) -> (forall p, In p ps -> p <= target) -> target + m <= init ->
  (forall H p Hd' q i' X' Y', q <= i' -> (forall p, In p ps -> p <= q) ->
    List.In p (CCC_pn (Impl k fs[@H] Hd' ps q (S i') X' Y') (fun _ => all_pids (i' + Pi fs[@H]))) -> p <= i' + Pi fs[@H]) ->
  forall p, List.In p (CCC_pn (seq_compose fs d Hd ps (S target) (S init) X Impl Y) (fun _ => all_pids (init + vsum (map Pi fs)))) -> p <= init + vsum (map Pi fs).

Lemma Encoding_rec_well_ann : forall {m} (f:PRFunction m) d Hd ps q i X Y,
  (forall p, In p ps -> p <= i) -> q <= i -> forall p,
  List.In p (CCC_pn (Encoding_rec f d Hd ps q (S i) X Y) (fun _ => all_pids (i + Pi f))) -> p <= i + Pi f.

Lemma Encoding_WF : forall {n} (f:PRFunction n) ps q,
  ~In q ps -> CCP_WF (Encoding f ps q).

Lemma Encoding'_WF : forall {n} (f:PRFunction n),
  CCP_WF (Encoding' f).

End WellFormedness.