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.
Variable ptime_zero ptime_succ ptime_pred ptime_cond: pol.
Variable ptime_proj : nat -> nat -> nat -> pol.
Hypothesis ptime_zero_spec :
snd (sem_cost zero nil nil) <= peval ptime_zero nil.
Hypothesis ptime_zero_wf : pWF ptime_zero.
Hypothesis ptime_zero_arity : parity ptime_zero = 0.
Hypothesis ptime_succ_spec : forall b,
snd (sem_cost (succ b) nil nil) <= peval ptime_succ nil.
Hypothesis ptime_succ_wf : pWF ptime_succ.
Hypothesis ptime_succ_arity : parity ptime_succ = 0.
Hypothesis ptime_proj_spec : forall n s i l,
length l = n ->
snd (sem_cost (proj n s i) l nil) <= peval (ptime_proj n s i) (map (@length _) l).
Hypothesis ptime_proj_wf : forall n s i, pWF (ptime_proj n s i).
Hypothesis ptime_proj_arity : forall n s i, parity (ptime_proj n s i) = n.
Hypothesis ptime_cond_spec :
snd (sem_cost cond nil nil) <= peval ptime_cond nil.
Hypothesis ptime_cond_wf : pWF ptime_cond.
Hypothesis ptime_cond_arity : parity ptime_cond = 0.
Hypothesis ptime_pred_spec :
snd (sem_cost pred nil nil) <= peval ptime_pred nil.
Hypothesis ptime_pred_wf : pWF ptime_pred.
Hypothesis ptime_pred_arity : parity ptime_pred = 0.
Fixpoint poly_time n (e:BC) : pol :=
match e with
| zero => ptime_zero
| succ _ => ptime_succ
| pred => ptime_pred
| cond  => ptime_cond
| proj n s i => ptime_proj n s i
| rec g h0 h1 =>
pplus (pshift (poly_time (n - 1) g))
(pmult (pproj n 0) (pplus (poly_time n h0) (poly_time n h1)))
| comp n0 s h rl tl =>
pplus (pplus (pcst n0 0) (pcomp (poly_time (length rl) h) (map (poly_BC n0) rl)))
(pplus (pplusl (map (poly_time n0) rl)) (pplusl (map (poly_time n0) tl)))
end.

Lemma sem_cost_bounded : forall e n s,
arities e = ok_arities n s ->
(forall vnl vsl,
length vnl = n ->
length vsl = s ->
snd (sem_cost e vnl vsl) <=
peval (poly_time n e) (List.map (@length _) vnl)).