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.

Lemma CaseOption_Sem :
CaseOption ⊨c(CaseOption_steps) CaseOption_Rel.