Inductive variable := x | y.
Inductive function := succ | addf | addt | mult | main | errF.
Inductive constructor := zero | suc0 | suc1 | errC. (* binary numbers, LSB first *)
Scheme Equality for variable.
Scheme Equality for function.
Scheme Equality for constructor.
Module BASyntax <: Interface.SYNTAX.
Definition variable := variable.
Definition function := function.
Definition constructor := constructor.
Definition function_default := errF.
Definition constructor_default := errC.
Definition variable_eq_dec := variable_eq_dec.
Definition function_eq_dec := function_eq_dec.
Definition constructor_eq_dec := constructor_eq_dec.
End BASyntax.
Module Import Syn := Interface.MkSyn(BASyntax).
Definition var_coercion : variable -> term := var_coercion_gen.
Coercion var_coercion : variable >-> term.
Notation " 'Z' " := (capply zero []).
Notation "x '!0'" := (capply suc0 (@cons term x nil)) (at level 60).
Notation "x '!1'" := (capply suc1 (@cons term x nil)) (at level 60).
Definition ba_prog : list rule := [
(* successor *)
succ (: Z :)   --> Z!1;  (* succ(0) -> S1(0) = "01" *)
succ (: x!0 :) --> x!1;    (* succ(S0(x)) -> S1(x)  "x0" + 1 = "x1" *)
succ (: x!1 :) --> (succ (: x :))!0; (* succ(S1(x)) -> S0(succ(x))    "x1" + 1 = "(x+1)0" *)
(* addition, no carry *)
addf (: Z, y :)     --> y; (* 0 + y + 0 = y *)
addf (: x, Z :)     --> x; (* x + 0 + 0 = x *)
addf (: x!0, y!0 :) --> (addf (: x, y :))!0; (* "x0" + "y0" + 0 = "(x+y+0)0" *)
addf (: x!0, y!1 :) --> (addf (: x, y :))!1; (* "x0" + "y1" + 0 = "(x+y+0)1" *)
addf (: x!1, y!0 :) --> (addf (: x, y :))!1; (* "x1" + "y0" + 0 = "(x+y+0)1" *)
addf (: x!1, y!1 :) --> (addt (: x, y :))!0; (* "x1" + "y1" + 0 = "(x+y+1)0" *)
(* addition, with carry *)
addt (: Z, y :)     --> succ (: y :); (* 0 + y + 1 = y+1 *)
addt (: x, Z :)     --> succ (: x :); (* x + 0 + 1 = x+1 *)
addt (: x!0, y!0 :) --> (addf (: x, y :))!1; (* "x0" + "y0" + 1 = "(x+y+0)1" *)
addt (: x!0, y!1 :) --> (addt (: x, y :))!0; (* "x0" + "y1" + 1 = "(x+y+1)0" *)
addt (: x!1, y!0 :) --> (addt (: x, y :))!0; (* "x1" + "y0" + 1 = "(x+y+1)0" *)
addt (: x!1, y!1 :) --> (addt (: x, y :))!1; (* "x1" + "y1" + 1 = "(x+y+1)1" *)
(* multiplication *)
mult (: Z, y :)   --> Z;
mult (: x!0, y :) --> (mult (: x, y :))!0;
mult (: x!1, y :) --> addf (: y, (mult (: x, y :))!0 :) ;
(* main computation *)
main (: x :) --> addf (: addf (: mult (: x, mult (: x, x :) :), (* X³ *)
mult (: Z!1!0!1, x :) :), (* + 5X *)
Z!1 :)                    (* + 1 *)
].
Module BAProg <: Syn.PROGRAM.
Definition prog := ba_prog.
End BAProg.
Module Import Prog := Syn.MkProg (BAProg).
Definition rank : function -> nat := ltac:(autorank function_beq ranklist).

(* Specifications: *)
(* It's a program *)
Proposition BinaryOp_is_wf: wf_prog.
Definition cs (c : constructor) := 1. (* same for all *)
(* QI *)
Lemma qic_nonzero : constructor_non_zero cs.
Ltac qif_monotonic_tac :=
repeat (apply forall2_le_suml || apply forall2_le_maxl ||
apply Plus.plus_le_compat_r || apply Plus.plus_le_compat_l || apply Plus.plus_le_compat ||
apply Nat.max_le_compat_r || apply Nat.max_le_compat_l || apply Nat.max_le_compat ||
apply Mult.mult_le_compat_l || apply Mult.mult_le_compat_r
); trivial.
Lemma qif_monotonic : monotonicity_qif qif.
Lemma qi_is_compatible : compatible_QI qic qif.
Proposition qi_is_valid : valid_QI mcs qic qif cs.
(* P-criterion *)
Theorem polytime: forall i s p c f lv d v,
let t := fapply f lv in
let pi := cbv_update i s p c t d v in
cbv_wf pi -> cache_bounded qic qif c ->
cbv_size pi <= global_bound mcs qif f lv c.