Section CaseOption.
(* Switching of option reduces to matching of sums with [Empty_set] *)
Variable X : Type.
Variable (sigX : finType).
Hypothesis (codX : codable sigX X).
(* Compute encode (None : option nat). *)
(* Compute encode (Some 42). *)
(* ** Deconstructor for Option Types *)
Let sig := FinType (EqType (sigSum sigX (FinType(EqType Empty_set)))).
Let tau := FinType (EqType (sigOption sigX)).
Definition CaseOption_size_Some := S.
Definition CaseOption_size_None := S >> S.
Definition CaseOption_Rel : Rel (tapes tau^+ 1) (bool * tapes tau^+ 1) :=
Mk_R_p (fun tin '(yout, tout) =>
forall (o : option X) (s : nat),
tin ≃(;s) o ->
match yout, o with
| true, Some x => tout ≃(;CaseOption_size_Some s) x
| false, None => isVoid_size tout (CaseOption_size_None s)
| _, _ => False
end).
Local Program Instance Retract_sigOption_sigSum :
Retract (sigSum sigX Empty_set) (sigOption sigX) :=
{|
Retr_f x := match x : (sigSum sigX (FinType (EqType Empty_set))) with
| sigSum_X a => sigOption_X a
| sigSum_Y b => match b with end
| sigSum_inl => sigOption_Some
| sigSum_inr => sigOption_None
end;
Retr_g y := match y with
| sigOption_X a => Some (sigSum_X a)
| sigOption_Some => Some (sigSum_inl)
| sigOption_None => Some (sigSum_inr)
end;
|}.
Next Obligation.
abstract now intros x y; split;
[ now destruct y; intros H; inv H
| intros ->; now destruct x as [ a | [] | | ]
].
Defined.
Definition CaseOption : pTM (sigOption sigX)^+ bool 1 :=
If (ChangeAlphabet (CaseSum (sigX) (FinType (EqType Empty_set))) _)
(Return Nop true)
(Return (ResetEmpty _) false).
Definition opt_to_sum (o : option X) : X + unit :=
match o with
| Some x => inl x
| None => inr tt
end.
Definition CaseOption_steps := 7.
(* ** Constructors for Option Types *)
Definition Constr_Some_Rel : Rel (tapes tau^+ 1) (unit * tapes tau^+ 1) :=
Mk_R_p (ignoreParam(
fun tin tout =>
forall (x : X) (s : nat),
tin ≃(;s) x ->
tout ≃(;pred s) Some x)).
Definition Constr_Some : pTM (sigOption sigX)^+ unit 1 :=
ChangeAlphabet (Constr_inl sigX (FinType (EqType Empty_set))) _.
Definition Constr_Some_steps := 3.

Lemma Constr_Some_Sem : Constr_Some ⊨c(Constr_Some_steps) Constr_Some_Rel.