(* * Constructor and Deconstructor Machines for Lists *)
Local Arguments plus : simpl never. Local Arguments mult : simpl never.
Set Default Proof Using "Type".
Definition M1_Rel : pRel (sigList sigX)^+ unit 2 :=
ignoreParam (
fun tin tout =>
forall ls rs (x : X) (l : list X) (s1 : nat),
tin[@Fin0] = midtape (inl START :: ls) (inr sigList_cons)
(map inr (Encode_map _ _ x) ++ map inr (Encode_map _ _ l) ++ inl STOP :: rs) ->
isVoid_size tin[@Fin1] s1 ->
tout[@Fin0] = tin[@Fin0] /\
tout[@Fin1] ≃(; s1 - (S (size x))) x).
Definition CaseList_size0 {sigX X : Type} {cX : codable sigX X} (x : X) (s0 : nat) := S (s0 + size x).
Definition CaseList_size1 {sigX X : Type} {cX : codable sigX X} (x : X) (s1 : nat) := s1 - (S (size x)).
Definition CaseList_Rel : pRel (sigList sigX)^+ bool 2 :=
fun tin '(yout, tout) =>
forall (l : list X) (s0 s1 : nat),
tin[@Fin0] ≃(;s0) l ->
isVoid_size tin[@Fin1] s1 ->
match yout, l with
| false, nil =>
tout[@Fin0] ≃(;s0) @nil X /\
isVoid_size tout[@Fin1] s1
| true, x :: l' =>
tout[@Fin0] ≃(; CaseList_size0 x s0) l' /\
tout[@Fin1] ≃(; CaseList_size1 x s1) x
| _, _ => False
end.

Lemma CaseList_Realise : CaseList ⊨ CaseList_Rel.