(* * 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.
(* *** Termination *)
Definition CaseList_steps_cons {sigX X : Type} {cX : codable sigX X} (x : X) := 42 + 16 *size x.
Definition CaseList_steps_nil := 5.
Definition CaseList_steps {sigX X : Type} {cX : codable sigX X} (l:list X) :=
match l with
| nil => CaseList_steps_nil
| x::l' => CaseList_steps_cons x
end.
(* ** [IsNil] *)
Definition IsNil : pTM (sigList sigX)^+ bool 1 :=
Move Rmove;;
Switch ReadChar
(fun s =>
match s with
| Some (inr sigList_nil) =>
Return (Move Lmove) true
| _ => Return (Move Lmove) false
end).
Definition IsNil_Rel : pRel (sigList sigX)^+ bool 1 :=
Mk_R_p (
fun tin '(yout, tout) =>
forall (xs : list X) (s : nat),
tin ≃(;s) xs ->
match yout, xs with
| true, nil => tout ≃(;s) xs
| false, _ :: _ => tout ≃(;s) xs
| _, _ => False
end).
Definition IsNil_steps := 5.
(* ** Constructors *)
(* *** [nil] *)
Definition Constr_nil : pTM (sigList sigX)^+ unit 1 := WriteValue (@nil X).
Goal Constr_nil = WriteMove (inl STOP) Lmove;; WriteMove (inr sigList_nil) Lmove;; Write (inl START).
(* *** [cons] *)
Definition Constr_cons : pTM (sigList sigX)^+ unit 2 :=
LiftTapes (MoveRight _;; Move Lmove) [|Fin1|];;
LiftTapes (CopySymbols_L stop) [|Fin1;Fin0|];;
LiftTapes (WriteMove (inr sigList_cons) Lmove;; Write (inl START)) [|Fin0|].
Definition Constr_cons_size {sigX X : Type} {cX : codable sigX X} (y : X) (s0 : nat) := s0 - size y - 1.
Definition Constr_cons_Rel : pRel (sigList sigX)^+ unit 2 :=
ignoreParam (
fun tin tout =>
forall (l:list X) (y:X) (s0 s1 : nat),
tin[@Fin0] ≃(;s0) l ->
tin[@Fin1] ≃(;s1) y ->
tout[@Fin0] ≃(;Constr_cons_size y s0) y :: l /\
tout[@Fin1] ≃(;s1) y
).

Lemma Constr_cons_Realise : Constr_cons ⊨ Constr_cons_Rel.