Inductive variable := x | y | p | q | x0 | m | c | n' | m' | r | r'.
Inductive function := pred_doubleF | succ_double_maskF | double_maskF | double_pred_maskF | sub_maskF | sub_mask_carryF | compare_contEqF | compare_contGtF | compare_contLtF | compareF | succ_doubleF | doubleF | subF | compare0F | lebF | moduloF | errF | sub_auxF | leb_auxF | pos_moduloOF | pos_moduloIF | pos_moduloF | condF | succF | addF | add_carryF | add0F | mul_modF | mul_mod_auxF | exp_modF | exp_mod_auxF | mod_auxF | modF | boundF.
Inductive constructor := TrueC | FalseC | PairC | EqC | LtC | GtC | XIC | XOC | XHC | N0C | NposC | IsNulC | IsPosC | IsNegC | errC.
Scheme Equality for variable.
Scheme Equality for constructor.
Scheme Equality for function.
Module EMSyntax <: 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 EMSyntax.
Module Import Syn := Interface.MkSyn(EMSyntax).
Definition var_coercion : variable -> term := var_coercion_gen.
Coercion var_coercion : variable >-> term.
Notation " x '#' l " := (capply x (map var_coercion l)) (at level 50).
(* Some notations for the constructors *)
Notation "'XO' a" := (capply XOC [var_coercion a]) (at level 60).
Notation "'XI' a" := (capply XIC [var_coercion a]) (at level 60).
Notation "'Ispos' a" := (capply IsPosC [var_coercion a]) (at level 60).
Notation "'NPos' a" := (capply NposC [var_coercion a]) (at level 60).
Notation "'XH'" := (capply XHC []) (at level 60).
Notation "'Isnul'" := (capply IsNulC []) (at level 60).
Notation "'Isneg'" := (capply IsNegC []) (at level 60).
Notation "'GT'" := (capply GtC []) (at level 60).
Notation "'LT'" := (capply LtC []) (at level 60).
Notation "'EQ'" := (capply EqC []) (at level 60).
Notation "'N0'" := (capply N0C []) (at level 60).
Notation "'TRUE'" := (capply TrueC []) (at level 60).
Notation "'FALSE'" := (capply FalseC []) (at level 60).
(* Mostly generated using: Extraction Language Haskell. Recursive Extraction N.modulo.*)
Definition em_prog : list rule := [
pred_doubleF (: XI p :) --> capply XIC [XO p];
pred_doubleF (: XO p :) --> capply XIC [pred_doubleF (: p :)];
pred_doubleF (: XH :) --> XH;
succ_double_maskF (: Isnul :) --> capply IsPosC [XH];
succ_double_maskF (: Ispos p :)  --> capply IsPosC [XI p];
succ_double_maskF (: Isneg :) --> Isneg;
double_maskF (: Ispos p :) --> capply IsPosC [XO p];
double_maskF (: x0 :) --> x0;
double_pred_maskF (: XI p :) -->
capply IsPosC [capply XOC [XO p]];
double_pred_maskF (: XO p :) -->
capply IsPosC [capply XOC [pred_doubleF (: p :)]];
double_pred_maskF (: XH :) --> Isnul;
sub_maskF (: XI p, XI q :) --> double_maskF (: sub_maskF (: p, q :) :);
sub_maskF (: XI p, XO q :) --> succ_double_maskF (: sub_maskF (: p, q :) :);
sub_maskF (: XI p, XH :) --> capply IsPosC [XO p];
sub_maskF (: XO p, XI q :) -->
succ_double_maskF (: sub_mask_carryF (: p, q :) :);
sub_maskF (: XO p, XO q :) --> double_maskF (: sub_maskF (: p, q :) :);
sub_maskF (: XO p, XH :) --> capply IsPosC [pred_doubleF (: p :)];
sub_maskF (: XH, XH :) --> Isnul;
sub_maskF (: XH, q :) --> Isneg;
sub_mask_carryF (: XI p, XI q :) -->
succ_double_maskF (: sub_mask_carryF (: p, q :) :);
sub_mask_carryF (: XI p, XO q :) -->
double_maskF (: sub_maskF (: p, q :) :);
sub_mask_carryF (: XI p, XH :) --> capply IsPosC [pred_doubleF (: p :)];
sub_mask_carryF (: XO p, XI q :) -->
double_maskF (: sub_mask_carryF (: p, q :) :);
sub_mask_carryF (: XO p, XO q :) -->
succ_double_maskF (: sub_mask_carryF (: p, q :) :);
sub_mask_carryF (: XO p, XH :) --> double_pred_maskF (: p :);
sub_mask_carryF (: XH, q :) --> Isneg;
(* compare_cont with r specified, to have ppo *)
compare_contEqF (: XI p, XI q :) --> compare_contEqF (: p, q :);
compare_contEqF (: XI p, XO q :) --> compare_contGtF (: p, q :);
compare_contEqF (: XI p, XH :) --> GT;
compare_contEqF (: XO p, XI q :) --> compare_contLtF (: p, q :);
compare_contEqF (: XO p, XO q :) --> compare_contEqF (: p, q :);
compare_contEqF (: XO p, XH :) --> GT;
compare_contEqF (: XH, XH :) --> EQ;
compare_contEqF (: XH, q :) --> LT;
compare_contLtF (: XI p, XI q :) --> compare_contLtF (: p, q :);
compare_contLtF (: XI p, XO q :) --> compare_contGtF (: p, q :);
compare_contLtF (: XI p, XH :) --> GT;
compare_contLtF (: XO p, XI q :) --> compare_contLtF (: p, q :);
compare_contLtF (: XO p, XO q :) --> compare_contLtF (: p, q :);
compare_contLtF (: XO p, XH :) --> GT;
compare_contLtF (: XH, XH :) --> LT;
compare_contLtF (: XH, q :) --> LT;
compare_contGtF (: XI p, XI q :) --> compare_contGtF (: p, q :);
compare_contGtF (: XI p, XO q :) --> compare_contGtF (: p, q :);
compare_contGtF (: XI p, XH :) --> GT;
compare_contGtF (: XO p, XI q :) --> compare_contLtF (: p, q :);
compare_contGtF (: XO p, XO q :) --> compare_contGtF (: p, q :);
compare_contGtF (: XO p, XH :) --> GT;
compare_contGtF (: XH, XH :) --> GT;
compare_contGtF (: XH, q :) --> LT;
compareF (: p, q :) -->  compare_contEqF (: p, q :);
succ_doubleF (: N0 :) --> capply NposC [XH];
succ_doubleF (: NPos p :) --> capply NposC [XI p];
doubleF (: N0 :) --> N0;
doubleF (: NPos p :) --> capply NposC [XO p];
(* added for case *)
sub_auxF (: Ispos p :) --> NPos p;
sub_auxF (: p :) --> N0;
subF (: N0, m :) --> N0;
subF (: NPos p, N0 :) --> NPos p;
subF (: NPos p, NPos q :) --> sub_auxF (: sub_maskF (: p, q :) :);
compare0F (: N0, N0 :) --> EQ;
compare0F (: N0, NPos q :) --> LT;
compare0F (: NPos n', N0 :) --> GT;
compare0F (: NPos n', NPos m' :) --> compareF (: n', m' :);
leb_auxF (: GT :) --> FALSE;
leb_auxF (: q :) --> TRUE;
lebF (:x, y :) --> leb_auxF (: compare0F (: x, y :) :);
condF (: TRUE, x, y :) --> x;
condF (: FALSE, x, y :) --> y;
mod_auxF (: XH, capply NposC [XH] :) --> N0 ;
mod_auxF (: XH, m :) --> capply NposC [XH] ;
mod_auxF (: XO x, m :) -->
condF (: lebF (: m, doubleF (: mod_auxF (: x, m :) :) :),
subF (: doubleF (: mod_auxF (: x, m :) :), m :),
doubleF (: mod_auxF (: x, m :) :) :) ;
mod_auxF (: XI x, m :) -->
condF (: lebF (: m, succ_doubleF (: mod_auxF (: x, m :) :) :),
subF (: succ_doubleF (: mod_auxF (: x, m :):), m :),
succ_doubleF (: mod_auxF (: x, m :) :) :) ;
modF (: N0, m :) --> N0;
modF (: NPos x, m :) --> mod_auxF (: x, m :);
(* back to extracted code *)
succF (: XI p :) --> capply XOC [succF (: p :)];
succF (: XO p :) --> XI p;
succF (: XH :) --> capply XOC [XH];
addF (: XI p, XI q :) --> capply XOC [add_carryF (: p, q :)];
addF (: XI p, XO q :) --> capply XIC [addF (: p, q :)];
addF (: XI p, XH :) --> capply XOC [succF (: p :)];
addF (: XO p, XI q :) --> capply XIC [addF (: p, q :)];
addF (: XO p, XO q :) --> capply XOC [addF (: p, q :)];
addF (: XO p, XH :) --> XI p;
addF (: XH, XI q :) --> capply XOC [succF (: q :)];
addF (: XH, XO q :) --> XI q;
addF (: XH, XH :) --> capply XOC [XH];
add_carryF (: XI p, XI q :) --> capply XIC [add_carryF (: p, q :)];
add_carryF (: XI p, XO q :) --> capply XOC [add_carryF (: p, q :)];
add_carryF (: XI p, XH :) --> capply XIC [succF (: p :)];
add_carryF (: XO p, XI q :) --> capply XOC [add_carryF (: p, q :)];
add_carryF (: XO p, XO q :) --> capply XIC [addF (: p, q :)];
add_carryF (: XO p, XH :) --> capply XOC [succF (: p :)];
add_carryF (: XH, XI q :) --> capply XIC [succF (: q :)];
add_carryF (: XH, XO q :) --> capply XOC [succF (: q :)];
add_carryF (: XH, XH :) --> capply XIC [XH];
add0F (: N0, m :) --> m;
add0F (: NPos p, N0 :) --> NPos p;
add0F (: NPos p, NPos q :)--> capply NposC [addF (: p, q :)];
mul_mod_auxF (: XI p, y, m, XO x :) -->
modF (: add0F (: y, doubleF (: mul_mod_auxF (: p, y, m, x :) :):), m :);
mul_mod_auxF (: XO p, y, m, XO x :) -->
modF (: doubleF (: mul_mod_auxF (: p, y, m, x :) :), m :);
mul_mod_auxF (: XH, y, m, x :) --> modF (: y, m :);
mul_modF (: N0, y, m, p :) --> N0;
mul_modF (: NPos x , y, m, p :) --> mul_mod_auxF (: x, y, m, p :);
exp_mod_auxF (: x, XH, m, p :) --> modF (: x, m :);
exp_mod_auxF (: x, XO y, m, p :) -->
mul_modF (: exp_mod_auxF (: x, y, m, p :), exp_mod_auxF (: x, y, m, p :), m, p :) ;
exp_mod_auxF (: x, XI y, m, p :) -->
mul_modF (: modF (: x, m :), mul_modF (: exp_mod_auxF (: x, y, m, p :), exp_mod_auxF (: x, y, m, p :), m, p :), m, p :);
boundF (: N0 :) --> XH;
boundF (: NPos p :) --> boundF (: p :);
boundF (: XH :) --> capply XOC [XH];
boundF (: XI x :) --> capply XOC [boundF (: x :)];
boundF (: XO x :) --> capply XOC [boundF (: x :)];
exp_modF (: x, N0 , m :) --> modF(: capply NposC [XH], m :) ;
exp_modF (: x, NPos y, m :) --> exp_mod_auxF (: x, y, m, boundF (: m :) :)
].
Module EMProg <: Syn.PROGRAM.
Definition prog := em_prog.
End EMProg.
Module Import Prog := Syn.MkProg (EMProg).
Definition rank : function -> nat := ltac:(autorank function_beq ranklist).

(* 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.