Section Lookup.
(* There is no need to save [n]. [H] must be saved. We use the [Nth'] machine, because we don't want to introduce an additional [sigOption sigHEnt] to the alphabet. [Nth'] also doesn't save [a] (which is the parameter of [Nth'] here, not [n]). [Lookup] will overwrite and reset the variables [a] and [n], but save [H] (which is saved by [Nth']). *)
(* We could define [Lookup] over the alphabet [sigHeap], however, in the step machine, we want to read [a] and [n] from a different closure alphabet (sigList sigHClos). [a] is read from an address of a closure and [n] from a variable of this closure, and the output closure will also be copied to this alphabet. *)
Variable sigLookup : finType.
Variable retr_clos_lookup : Retract sigHClos sigLookup.
Variable retr_heap_lookup : Retract sigHeap sigLookup.
(* There are (more than) three possible ways how to encode [nat] on the [Heap] alphabet [sigLookup]:  - 1: as a heap address of a closure on the stack alphabet - 2: as a variable of a command inside a closure of the closure input alphabet - 3: as a "next" address of an heap entry  [a] is stored in the second way and [n] in the third way. *)
(* No 1 *)
Definition retr_nat_clos_ad : Retract sigNat sigHClos :=
Retract_sigPair_X _ _.
Definition retr_nat_lookup_clos_ad : Retract sigNat sigLookup :=
ComposeRetract retr_clos_lookup retr_nat_clos_ad.
(* No 2 *)
Definition retr_nat_clos_var : Retract sigNat sigHClos :=
Retract_sigPair_Y _ _.
Definition retr_nat_lookup_clos_var : Retract sigNat sigLookup :=
ComposeRetract retr_clos_lookup retr_nat_clos_var.
(* No 3 *)
Definition retr_nat_heap_entry : Retract sigNat sigHeap :=
Retract_sigList_X (Retract_sigOption_X (Retract_sigPair_Y _ (Retract_id _))).
Local Definition retr_nat_lookup_entry : Retract sigNat sigLookup :=
ComposeRetract retr_heap_lookup retr_nat_heap_entry.
(* Encoding of a closure on the heap alphabet *)
Definition retr_clos_heap : Retract sigHClos sigHeap := _.
Definition retr_clos_lookup_heap : Retract sigHClos sigLookup := ComposeRetract retr_heap_lookup retr_clos_heap.
Definition retr_hent_heap : Retract sigHEntr sigHeap := _.
Local Definition retr_hent_lookup : Retract sigHEntr sigLookup := ComposeRetract retr_heap_lookup retr_hent_heap.
Definition retr_hent'_heap : Retract sigHEntr' sigHeap := _.
Local Definition retr_hent'_lookup : Retract sigHEntr' sigLookup := ComposeRetract retr_heap_lookup retr_hent'_heap.
(* Tapes: t0: H t1: a t2: n t3: out t4: internal tape *)
Definition Lookup_Step : pTM sigLookup^+ (option bool) 5 :=
If (Nth' retr_heap_lookup retr_nat_lookup_clos_ad @ [|Fin0; Fin1; Fin4; Fin3|])
(If (CaseOption sigHEntr'_fin ⇑ retr_hent_lookup @ [|Fin4|])
(CasePair sigHClos_fin sigHAdd_fin ⇑ retr_hent'_lookup @ [|Fin4; Fin3|];;
If (CaseNat ⇑ retr_nat_lookup_clos_var @ [|Fin2|])
(Return (CopyValue _ @ [|Fin4; Fin1|];; (* n = S n' *)
Translate retr_nat_lookup_entry retr_nat_lookup_clos_ad @ [|Fin1|];;
Reset _ @ [|Fin4|];;
Reset _ @ [|Fin3 |])
None) (* continue *)
(Return (Reset _ @ [|Fin4|];; (* n = 0 *)
Reset _ @ [|Fin2|];;
Translate retr_clos_lookup_heap retr_clos_lookup @ [|Fin3|])
(Some true))) (* return true *)
(Return Nop (Some false))) (* return false *)
(Return Nop (Some false)) (* return false *)
.
Definition Lookup_Step_size (H : Heap) (a n : nat) : Vector.t (nat->nat) 5 :=
match nth_error H a with
| Some (Some (g, b)) =>
match n with
| S n' =>
[|(* 0 *) Nth'_size H a @>Fin0;
(* 1 *) Nth'_size H a @>Fin1 >> CopyValue_size b; (* 2 *) S; (* 3 *) Nth'_size H a @>Fin3 >> CasePair_size1 g >> Reset_size g; (* 4 *) Nth'_size H a @>Fin2 >> CaseOption_size_Some >> CasePair_size0 g >> Reset_size b|] | 0 => [|(* 0 *) Nth'_size H a @>Fin0; (* 1 *) Nth'_size H a @>Fin1; (* 2 *) Reset_size 0; (* 3 *) Nth'_size H a @>Fin3 >> CasePair_size1 g; (* 4 *) Nth'_size H a @>Fin2 >> CaseOption_size_Some >> CasePair_size0 g >> Reset_size b|] end | _ => default (* not specified *)
end.
Local Definition Lookup_Step_steps_CaseNat (n: nat) (e': HClos * HAdd) :=
let (g,b) := (fst e', snd e') in
match n with
| S _ => 1 + CopyValue_steps b + 1 + Translate_steps b + 1 + Reset_steps b + Reset_steps g
| O => 1 + Reset_steps b + 1 + Reset_steps 0 + Translate_steps g
end.
Local Definition Lookup_Step_steps_CaseOption (n:nat) (e: HEntr) :=
match e with
| Some ((g, b) as e') => 1 + CasePair_steps g + 1 + CaseNat_steps + Lookup_Step_steps_CaseNat n e'
| None => 0
end.
Local Definition Lookup_Step_steps_Nth' H a n :=
match nth_error H a with
| Some e => 1 + CaseOption_steps + Lookup_Step_steps_CaseOption n e
| None => 0
end.
Definition Lookup_Step_steps (H: Heap) (a: HAdd) (n: nat) :=
1 + Nth'_steps H a + Lookup_Step_steps_Nth' H a n.
Definition Lookup := While Lookup_Step.
Fixpoint Lookup_size (H : Heap) (a n : nat) {struct n} : Vector.t (nat -> nat) 5 :=
match nth_error H a with
| Some (Some (g, b)) =>
match n with
| S n' => Lookup_Step_size H a n >>> Lookup_size H b n'
| 0 => Lookup_Step_size H a n
end
| _ => default (* not specified *)
end.

Lemma Lookup_size_eq (H : Heap) (a n : nat) :
Lookup_size H a n =
match nth_error H a with
| Some (Some (g, b)) =>
match n with
| S n' => Lookup_Step_size H a n >>> Lookup_size H b n'
| 0 => Lookup_Step_size H a n
end
| _ => default (* not specified *)
end.