(** * Time complexity  We consider an obvious implementation of the language [BC] on a stack machine, as described in Section 3.4.2 of Bellantoni's PhD thesis.  - The polynomial [polytime n e] is an upper for the execution time.  - [sem_cost e vnl vsl] differs from above [sem e vnl vsl] by also computing the running time. *)
Section TIME.
Variable ptime_zero_cost ptime_succ_cost ptime_pred_cost ptime_cond_cost: nat.
Variable ptime_proj_cost : nat -> nat -> nat -> nat.
Fixpoint sem_cost_rec (sem_g sem_h0 sem_h1:list bs->list bs->bs*nat)(v:bs)(vnl vsl:list bs) :
bs * nat :=
match v with
| nil => sem_g vnl vsl
| b::v' =>
if b
then
let sem_cost := sem_cost_rec sem_g sem_h0 sem_h1 v' vnl vsl in
let sem_cost_h := sem_h1 (v'::vnl) (fst sem_cost :: vsl) in
(fst sem_cost_h, snd sem_cost + snd sem_cost_h)
else
let sem_cost := sem_cost_rec sem_g sem_h0 sem_h1 v' vnl vsl in
let sem_cost_h := sem_h0 (v'::vnl) (fst sem_cost :: vsl) in
(fst sem_cost_h, snd sem_cost + snd sem_cost_h)
end.
Fixpoint sem_cost (e:BC)(vnl vsl:list bs) : bs*nat :=
match e with
| zero => (nil, ptime_zero_cost)
| proj n s j => (
if leb (S j) n then
nth j vnl nil
else nth (j-n) vsl nil, ptime_proj_cost n s j
)
| succ b => (b :: hd nil vsl, ptime_succ_cost)
| pred => (tail (hd nil vsl), ptime_pred_cost)
| cond => (
match vsl with
| a :: b :: c :: d :: _ =>
match a with
| nil => b
| true :: _ => c
| false :: _ => d
end
| a :: b :: c :: _ =>
match a with
| nil => b
| true :: _ => c
| false :: _ => nil
end
| a :: b :: _ =>
match a with
| nil => b
| _ => nil
end
| _ => nil
end, ptime_cond_cost
)
| rec g h0 h1 =>
sem_cost_rec (sem_cost g) (sem_cost h0) (sem_cost h1) (hd nil vnl) (tail vnl) vsl
| comp _ _ h nl sl =>
let sem_cost_nl := List.map (fun ne => sem_cost ne vnl nil) nl in
let sem_cost_sl := List.map (fun se => sem_cost se vnl vsl) sl in
let sem_nl := List.map (@fst _ _) sem_cost_nl in
let sem_sl := List.map (@fst _ _) sem_cost_sl in
let cost_nl := List.map (@snd _ _) sem_cost_nl in
let cost_sl := List.map (@snd _ _) sem_cost_sl in
let sem_cost_h := sem_cost h sem_nl sem_sl in
(fst sem_cost_h, snd sem_cost_h + plusl cost_nl + plusl cost_sl)
end.

(* Specifications: *)
Lemma sem_cost_correct :
forall e n s,
arities e = ok_arities n s ->
forall vnl vsl,
fst (sem_cost e vnl vsl) = sem e vnl vsl.