Require Import Coq.ZArith.ZArith.
Require Import Crypto.Util.LetIn.
Require Import Crypto.Util.ZUtil.Definitions.
Require Import Crypto.Util.ZUtil.CPS.
Require Import Crypto.Util.IdfunWithAlt.
Require Import Crypto.Util.CPSUtil.
Require Import Crypto.Arithmetic.Core.
Require Import Crypto.Util.Tactics.VM.

Create HintDb arithmetic_cps_unfolder.

Hint Unfold Core.div Core.modulo : arithmetic_cps_unfolder.

Ltac make_parameterized_sig t :=
  refine (_ : { v : _ | v = t });
  eexists; cbv delta [t
                        Core.B.Positional.chained_carries_reduce_cps_step
                        B.limb ListUtil.sum ListUtil.sum_firstn
                        CPSUtil.Tuple.mapi_with_cps CPSUtil.Tuple.mapi_with'_cps CPSUtil.flat_map_cps CPSUtil.on_tuple_cps CPSUtil.fold_right_cps2
                        Decidable.dec Decidable.dec_eq_Z
                        id_tuple_with_alt id_tuple'_with_alt id_tuple_with_alt_cps'
                        Z.add_get_carry_full Z.mul_split
                        Z.add_get_carry_full_cps Z.mul_split_cps Z.mul_split_cps'
                        Z.add_get_carry_cps];
  repeat autorewrite with pattern_runtime;
  reflexivity.

Notation parameterize_sig t := ltac:(let v := t in make_parameterized_sig v) (only parsing).

Ltac make_parameterized_from_sig t_sig :=
  let t := (eval cbv [proj1_sig t_sig] in (proj1_sig t_sig)) in
  let t := pattern_strip t in
  exact t.

Notation parameterize_from_sig t := ltac:(let v := t in make_parameterized_from_sig v) (only parsing).

Ltac make_parameterized_eq t t_sig :=
  let t := apply_patterned t in
  exact (proj2_sig t_sig : t = _).

Notation parameterize_eq t t_sig := ltac:(let v := t in let v_sig := t_sig in make_parameterized_eq v v_sig) (only parsing).

Ltac basesystem_partial_evaluation_RHS_fast :=
  repeat autorewrite with pattern_runtime;
  let t := match goal with |- _ _ ?t => t end in
  let t := pattern_strip t in
  let t1 := fresh "t1" in
  pose t as t1;
  let t1' := apply_patterned t1 in
  transitivity t1';
  [replace_with_vm_compute t1; clear t1|reflexivity].

Module B.
  Module Associational.
    (**
<<
#!/bin/bash
for i in eval multerm mul_cps mul split_cps split reduce_cps reduce negate_snd_cps negate_snd carryterm_cps carryterm carry_cps carry; do
    echo "    Definition ${i}_sig := parameterize_sig (@Core.B.Associational.${i}).";
    echo "    Definition ${i} := parameterize_from_sig ${i}_sig.";
    echo "    Definition ${i}_eq := parameterize_eq ${i} ${i}_sig.";
    echo "    Hint Unfold ${i} : basesystem_partial_evaluation_unfolder.";
    echo "    Hint Rewrite <- ${i}_eq : pattern_runtime."; echo "";
done
echo "  End Associational."
echo "  Module Positional."
for i in to_associational_cps to_associational eval zeros add_to_nth_cps add_to_nth place_cps place from_associational_cps from_associational carry_cps carry chained_carries_cps chained_carries encode add_cps mul_cps reduce_cps carry_reduce_cps  chained_carries_reduce_cps_step chained_carries_reduce_cps chained_carries_reduce negate_snd_cps split_cps scmul_cps unbalanced_sub_cps sub_cps sub opp_cps Fencode Fdecode eval_from select_cps select; do
  echo "    Definition ${i}_sig := parameterize_sig (@Core.B.Positional.${i}).";
  echo "    Definition ${i} := parameterize_from_sig ${i}_sig.";
  echo "    Definition ${i}_eq := parameterize_eq ${i} ${i}_sig.";
  echo "    Hint Unfold ${i} : basesystem_partial_evaluation_unfolder.";
  echo "    Hint Rewrite <- ${i}_eq : pattern_runtime."; echo "";
done
echo "  End Positional."
echo "End B."
echo ""
for i in modulo_cps div_cps modulo div; do
  echo "Definition ${i}_sig := parameterize_sig (@Core.${i}).";
  echo "Definition ${i} := parameterize_from_sig ${i}_sig.";
  echo "Definition ${i}_eq := parameterize_eq ${i} ${i}_sig.";
  echo "Hint Unfold ${i} : basesystem_partial_evaluation_unfolder.";
  echo "Hint Rewrite <- ${i}_eq : pattern_runtime."; echo "";
done
>> *)
    Definition eval_sig := parameterize_sig (@Core.B.Associational.eval).
    Definition eval := parameterize_from_sig eval_sig.
    Definition eval_eq := parameterize_eq eval eval_sig.
    Hint Unfold eval : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- eval_eq : pattern_runtime.

    Definition multerm_sig := parameterize_sig (@Core.B.Associational.multerm).
    Definition multerm := parameterize_from_sig multerm_sig.
    Definition multerm_eq := parameterize_eq multerm multerm_sig.
    Hint Unfold multerm : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- multerm_eq : pattern_runtime.

    Definition mul_cps_sig := parameterize_sig (@Core.B.Associational.mul_cps).
    Definition mul_cps := parameterize_from_sig mul_cps_sig.
    Definition mul_cps_eq := parameterize_eq mul_cps mul_cps_sig.
    Hint Unfold mul_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- mul_cps_eq : pattern_runtime.

    Definition mul_sig := parameterize_sig (@Core.B.Associational.mul).
    Definition mul := parameterize_from_sig mul_sig.
    Definition mul_eq := parameterize_eq mul mul_sig.
    Hint Unfold mul : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- mul_eq : pattern_runtime.

    Definition split_cps_sig := parameterize_sig (@Core.B.Associational.split_cps).
    Definition split_cps := parameterize_from_sig split_cps_sig.
    Definition split_cps_eq := parameterize_eq split_cps split_cps_sig.
    Hint Unfold split_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- split_cps_eq : pattern_runtime.

    Definition split_sig := parameterize_sig (@Core.B.Associational.split).
    Definition split := parameterize_from_sig split_sig.
    Definition split_eq := parameterize_eq split split_sig.
    Hint Unfold split : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- split_eq : pattern_runtime.

    Definition reduce_cps_sig := parameterize_sig (@Core.B.Associational.reduce_cps).
    Definition reduce_cps := parameterize_from_sig reduce_cps_sig.
    Definition reduce_cps_eq := parameterize_eq reduce_cps reduce_cps_sig.
    Hint Unfold reduce_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- reduce_cps_eq : pattern_runtime.

    Definition reduce_sig := parameterize_sig (@Core.B.Associational.reduce).
    Definition reduce := parameterize_from_sig reduce_sig.
    Definition reduce_eq := parameterize_eq reduce reduce_sig.
    Hint Unfold reduce : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- reduce_eq : pattern_runtime.

    Definition negate_snd_cps_sig := parameterize_sig (@Core.B.Associational.negate_snd_cps).
    Definition negate_snd_cps := parameterize_from_sig negate_snd_cps_sig.
    Definition negate_snd_cps_eq := parameterize_eq negate_snd_cps negate_snd_cps_sig.
    Hint Unfold negate_snd_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- negate_snd_cps_eq : pattern_runtime.

    Definition negate_snd_sig := parameterize_sig (@Core.B.Associational.negate_snd).
    Definition negate_snd := parameterize_from_sig negate_snd_sig.
    Definition negate_snd_eq := parameterize_eq negate_snd negate_snd_sig.
    Hint Unfold negate_snd : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- negate_snd_eq : pattern_runtime.

    Definition carryterm_cps_sig := parameterize_sig (@Core.B.Associational.carryterm_cps).
    Definition carryterm_cps := parameterize_from_sig carryterm_cps_sig.
    Definition carryterm_cps_eq := parameterize_eq carryterm_cps carryterm_cps_sig.
    Hint Unfold carryterm_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- carryterm_cps_eq : pattern_runtime.

    Definition carryterm_sig := parameterize_sig (@Core.B.Associational.carryterm).
    Definition carryterm := parameterize_from_sig carryterm_sig.
    Definition carryterm_eq := parameterize_eq carryterm carryterm_sig.
    Hint Unfold carryterm : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- carryterm_eq : pattern_runtime.

    Definition carry_cps_sig := parameterize_sig (@Core.B.Associational.carry_cps).
    Definition carry_cps := parameterize_from_sig carry_cps_sig.
    Definition carry_cps_eq := parameterize_eq carry_cps carry_cps_sig.
    Hint Unfold carry_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- carry_cps_eq : pattern_runtime.

    Definition carry_sig := parameterize_sig (@Core.B.Associational.carry).
    Definition carry := parameterize_from_sig carry_sig.
    Definition carry_eq := parameterize_eq carry carry_sig.
    Hint Unfold carry : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- carry_eq : pattern_runtime.

  End Associational.
  Module Positional.
    Definition to_associational_cps_sig := parameterize_sig (@Core.B.Positional.to_associational_cps).
    Definition to_associational_cps := parameterize_from_sig to_associational_cps_sig.
    Definition to_associational_cps_eq := parameterize_eq to_associational_cps to_associational_cps_sig.
    Hint Unfold to_associational_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- to_associational_cps_eq : pattern_runtime.

    Definition to_associational_sig := parameterize_sig (@Core.B.Positional.to_associational).
    Definition to_associational := parameterize_from_sig to_associational_sig.
    Definition to_associational_eq := parameterize_eq to_associational to_associational_sig.
    Hint Unfold to_associational : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- to_associational_eq : pattern_runtime.

    Definition eval_sig := parameterize_sig (@Core.B.Positional.eval).
    Definition eval := parameterize_from_sig eval_sig.
    Definition eval_eq := parameterize_eq eval eval_sig.
    Hint Unfold eval : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- eval_eq : pattern_runtime.

    Definition zeros_sig := parameterize_sig (@Core.B.Positional.zeros).
    Definition zeros := parameterize_from_sig zeros_sig.
    Definition zeros_eq := parameterize_eq zeros zeros_sig.
    Hint Unfold zeros : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- zeros_eq : pattern_runtime.

    Definition add_to_nth_cps_sig := parameterize_sig (@Core.B.Positional.add_to_nth_cps).
    Definition add_to_nth_cps := parameterize_from_sig add_to_nth_cps_sig.
    Definition add_to_nth_cps_eq := parameterize_eq add_to_nth_cps add_to_nth_cps_sig.
    Hint Unfold add_to_nth_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- add_to_nth_cps_eq : pattern_runtime.

    Definition add_to_nth_sig := parameterize_sig (@Core.B.Positional.add_to_nth).
    Definition add_to_nth := parameterize_from_sig add_to_nth_sig.
    Definition add_to_nth_eq := parameterize_eq add_to_nth add_to_nth_sig.
    Hint Unfold add_to_nth : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- add_to_nth_eq : pattern_runtime.

    Definition place_cps_sig := parameterize_sig (@Core.B.Positional.place_cps).
    Definition place_cps := parameterize_from_sig place_cps_sig.
    Definition place_cps_eq := parameterize_eq place_cps place_cps_sig.
    Hint Unfold place_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- place_cps_eq : pattern_runtime.

    Definition place_sig := parameterize_sig (@Core.B.Positional.place).
    Definition place := parameterize_from_sig place_sig.
    Definition place_eq := parameterize_eq place place_sig.
    Hint Unfold place : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- place_eq : pattern_runtime.

    Definition from_associational_cps_sig := parameterize_sig (@Core.B.Positional.from_associational_cps).
    Definition from_associational_cps := parameterize_from_sig from_associational_cps_sig.
    Definition from_associational_cps_eq := parameterize_eq from_associational_cps from_associational_cps_sig.
    Hint Unfold from_associational_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- from_associational_cps_eq : pattern_runtime.

    Definition from_associational_sig := parameterize_sig (@Core.B.Positional.from_associational).
    Definition from_associational := parameterize_from_sig from_associational_sig.
    Definition from_associational_eq := parameterize_eq from_associational from_associational_sig.
    Hint Unfold from_associational : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- from_associational_eq : pattern_runtime.

    Definition carry_cps_sig := parameterize_sig (@Core.B.Positional.carry_cps).
    Definition carry_cps := parameterize_from_sig carry_cps_sig.
    Definition carry_cps_eq := parameterize_eq carry_cps carry_cps_sig.
    Hint Unfold carry_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- carry_cps_eq : pattern_runtime.

    Definition carry_sig := parameterize_sig (@Core.B.Positional.carry).
    Definition carry := parameterize_from_sig carry_sig.
    Definition carry_eq := parameterize_eq carry carry_sig.
    Hint Unfold carry : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- carry_eq : pattern_runtime.

    Definition chained_carries_cps_sig := parameterize_sig (@Core.B.Positional.chained_carries_cps).
    Definition chained_carries_cps := parameterize_from_sig chained_carries_cps_sig.
    Definition chained_carries_cps_eq := parameterize_eq chained_carries_cps chained_carries_cps_sig.
    Hint Unfold chained_carries_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- chained_carries_cps_eq : pattern_runtime.

    Definition chained_carries_sig := parameterize_sig (@Core.B.Positional.chained_carries).
    Definition chained_carries := parameterize_from_sig chained_carries_sig.
    Definition chained_carries_eq := parameterize_eq chained_carries chained_carries_sig.
    Hint Unfold chained_carries : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- chained_carries_eq : pattern_runtime.

    Definition encode_sig := parameterize_sig (@Core.B.Positional.encode).
    Definition encode := parameterize_from_sig encode_sig.
    Definition encode_eq := parameterize_eq encode encode_sig.
    Hint Unfold encode : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- encode_eq : pattern_runtime.

    Definition add_cps_sig := parameterize_sig (@Core.B.Positional.add_cps).
    Definition add_cps := parameterize_from_sig add_cps_sig.
    Definition add_cps_eq := parameterize_eq add_cps add_cps_sig.
    Hint Unfold add_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- add_cps_eq : pattern_runtime.

    Definition mul_cps_sig := parameterize_sig (@Core.B.Positional.mul_cps).
    Definition mul_cps := parameterize_from_sig mul_cps_sig.
    Definition mul_cps_eq := parameterize_eq mul_cps mul_cps_sig.
    Hint Unfold mul_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- mul_cps_eq : pattern_runtime.

    Definition reduce_cps_sig := parameterize_sig (@Core.B.Positional.reduce_cps).
    Definition reduce_cps := parameterize_from_sig reduce_cps_sig.
    Definition reduce_cps_eq := parameterize_eq reduce_cps reduce_cps_sig.
    Hint Unfold reduce_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- reduce_cps_eq : pattern_runtime.

    Definition carry_reduce_cps_sig := parameterize_sig (@Core.B.Positional.carry_reduce_cps).
    Definition carry_reduce_cps := parameterize_from_sig carry_reduce_cps_sig.
    Definition carry_reduce_cps_eq := parameterize_eq carry_reduce_cps carry_reduce_cps_sig.
    Hint Unfold carry_reduce_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- carry_reduce_cps_eq : pattern_runtime.

    Definition chained_carries_reduce_cps_step_sig := parameterize_sig (@Core.B.Positional.chained_carries_reduce_cps_step).
    Definition chained_carries_reduce_cps_step := parameterize_from_sig chained_carries_reduce_cps_step_sig.
    Definition chained_carries_reduce_cps_step_eq := parameterize_eq chained_carries_reduce_cps_step chained_carries_reduce_cps_step_sig.
    Hint Unfold chained_carries_reduce_cps_step : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- chained_carries_reduce_cps_step_eq : pattern_runtime.

    Definition chained_carries_reduce_cps_sig := parameterize_sig (@Core.B.Positional.chained_carries_reduce_cps).
    Definition chained_carries_reduce_cps := parameterize_from_sig chained_carries_reduce_cps_sig.
    Definition chained_carries_reduce_cps_eq := parameterize_eq chained_carries_reduce_cps chained_carries_reduce_cps_sig.
    Hint Unfold chained_carries_reduce_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- chained_carries_reduce_cps_eq : pattern_runtime.

    Definition chained_carries_reduce_sig := parameterize_sig (@Core.B.Positional.chained_carries_reduce).
    Definition chained_carries_reduce := parameterize_from_sig chained_carries_reduce_sig.
    Definition chained_carries_reduce_eq := parameterize_eq chained_carries_reduce chained_carries_reduce_sig.
    Hint Unfold chained_carries_reduce : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- chained_carries_reduce_eq : pattern_runtime.

    Definition negate_snd_cps_sig := parameterize_sig (@Core.B.Positional.negate_snd_cps).
    Definition negate_snd_cps := parameterize_from_sig negate_snd_cps_sig.
    Definition negate_snd_cps_eq := parameterize_eq negate_snd_cps negate_snd_cps_sig.
    Hint Unfold negate_snd_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- negate_snd_cps_eq : pattern_runtime.

    Definition split_cps_sig := parameterize_sig (@Core.B.Positional.split_cps).
    Definition split_cps := parameterize_from_sig split_cps_sig.
    Definition split_cps_eq := parameterize_eq split_cps split_cps_sig.
    Hint Unfold split_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- split_cps_eq : pattern_runtime.

    Definition scmul_cps_sig := parameterize_sig (@Core.B.Positional.scmul_cps).
    Definition scmul_cps := parameterize_from_sig scmul_cps_sig.
    Definition scmul_cps_eq := parameterize_eq scmul_cps scmul_cps_sig.
    Hint Unfold scmul_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- scmul_cps_eq : pattern_runtime.

    Definition unbalanced_sub_cps_sig := parameterize_sig (@Core.B.Positional.unbalanced_sub_cps).
    Definition unbalanced_sub_cps := parameterize_from_sig unbalanced_sub_cps_sig.
    Definition unbalanced_sub_cps_eq := parameterize_eq unbalanced_sub_cps unbalanced_sub_cps_sig.
    Hint Unfold unbalanced_sub_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- unbalanced_sub_cps_eq : pattern_runtime.

    Definition sub_cps_sig := parameterize_sig (@Core.B.Positional.sub_cps).
    Definition sub_cps := parameterize_from_sig sub_cps_sig.
    Definition sub_cps_eq := parameterize_eq sub_cps sub_cps_sig.
    Hint Unfold sub_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- sub_cps_eq : pattern_runtime.

    Definition sub_sig := parameterize_sig (@Core.B.Positional.sub).
    Definition sub := parameterize_from_sig sub_sig.
    Definition sub_eq := parameterize_eq sub sub_sig.
    Hint Unfold sub : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- sub_eq : pattern_runtime.

    Definition opp_cps_sig := parameterize_sig (@Core.B.Positional.opp_cps).
    Definition opp_cps := parameterize_from_sig opp_cps_sig.
    Definition opp_cps_eq := parameterize_eq opp_cps opp_cps_sig.
    Hint Unfold opp_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- opp_cps_eq : pattern_runtime.

    Definition Fencode_sig := parameterize_sig (@Core.B.Positional.Fencode).
    Definition Fencode := parameterize_from_sig Fencode_sig.
    Definition Fencode_eq := parameterize_eq Fencode Fencode_sig.
    Hint Unfold Fencode : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- Fencode_eq : pattern_runtime.

    Definition Fdecode_sig := parameterize_sig (@Core.B.Positional.Fdecode).
    Definition Fdecode := parameterize_from_sig Fdecode_sig.
    Definition Fdecode_eq := parameterize_eq Fdecode Fdecode_sig.
    Hint Unfold Fdecode : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- Fdecode_eq : pattern_runtime.

    Definition eval_from_sig := parameterize_sig (@Core.B.Positional.eval_from).
    Definition eval_from := parameterize_from_sig eval_from_sig.
    Definition eval_from_eq := parameterize_eq eval_from eval_from_sig.
    Hint Unfold eval_from : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- eval_from_eq : pattern_runtime.

    Definition select_cps_sig := parameterize_sig (@Core.B.Positional.select_cps).
    Definition select_cps := parameterize_from_sig select_cps_sig.
    Definition select_cps_eq := parameterize_eq select_cps select_cps_sig.
    Hint Unfold select_cps : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- select_cps_eq : pattern_runtime.

    Definition select_sig := parameterize_sig (@Core.B.Positional.select).
    Definition select := parameterize_from_sig select_sig.
    Definition select_eq := parameterize_eq select select_sig.
    Hint Unfold select : basesystem_partial_evaluation_unfolder.
    Hint Rewrite <- select_eq : pattern_runtime.

  End Positional.
End B.

Definition modulo_cps_sig := parameterize_sig (@Core.modulo_cps).
Definition modulo_cps := parameterize_from_sig modulo_cps_sig.
Definition modulo_cps_eq := parameterize_eq modulo_cps modulo_cps_sig.
Hint Unfold modulo_cps : basesystem_partial_evaluation_unfolder.
Hint Rewrite <- modulo_cps_eq : pattern_runtime.

Definition div_cps_sig := parameterize_sig (@Core.div_cps).
Definition div_cps := parameterize_from_sig div_cps_sig.
Definition div_cps_eq := parameterize_eq div_cps div_cps_sig.
Hint Unfold div_cps : basesystem_partial_evaluation_unfolder.
Hint Rewrite <- div_cps_eq : pattern_runtime.

Definition modulo_sig := parameterize_sig (@Core.modulo).
Definition modulo := parameterize_from_sig modulo_sig.
Definition modulo_eq := parameterize_eq modulo modulo_sig.
Hint Unfold modulo : basesystem_partial_evaluation_unfolder.
Hint Rewrite <- modulo_eq : pattern_runtime.

Definition div_sig := parameterize_sig (@Core.div).
Definition div := parameterize_from_sig div_sig.
Definition div_eq := parameterize_eq div div_sig.
Hint Unfold div : basesystem_partial_evaluation_unfolder.
Hint Rewrite <- div_eq : pattern_runtime.


Require Import VST.floyd.proofauto.
Require Import pile.
Instance PileCompSpecs : compspecs. make_compspecs prog. Defined.
Require Import simple_spec_stdlib.
Require Import PileModel.

Definition tlist := Tstruct _list noattr.
Definition tpile := Tstruct _pile noattr.

Fixpoint listrep (sigma: list Z) (x: val) : mpred :=
 match sigma with
 | h::hs =>
    EX y:val,
       !! (0 <= h <=  Int.max_signed) &&
      data_at Ews tlist (Vint (Int.repr h), y) x
     * malloc_token Ews tlist x
     * listrep hs y
 | nil =>
    !! (x = nullval) && emp
 end.

Lemma listrep_local_facts:
  forall sigma p,
   listrep sigma p |--
   !! (is_pointer_or_null p /\ (p=nullval <-> sigma=nil) /\ Forall (Z.le 0) sigma).
Proof.
intros.
revert p; induction sigma;
  unfold listrep; fold listrep; intros.
  entailer!; intuition.
Intros y. entailer!.
split.
split; intro. subst p. destruct H0; contradiction. discriminate.
constructor; auto. lia.
Qed.

#[export] Hint Resolve listrep_local_facts : saturate_local.

Lemma listrep_valid_pointer:
  forall sigma p,
   listrep sigma p |-- valid_pointer p.
Proof.
 destruct sigma; unfold listrep; fold listrep;
 intros; entailer!; auto with valid_pointer.
Qed.

#[export] Hint Resolve listrep_valid_pointer : valid_pointer.

Opaque listrep.

Definition pilerep (sigma: list Z) (p: val) : mpred :=
  EX x:val, data_at Ews tpile x p * listrep sigma x.

Lemma pilerep_local_facts: forall sigma p,
    pilerep sigma p |-- !! (isptr p /\ Forall (Z.le 0) sigma).
Proof.
intros. unfold pilerep. Intros x. entailer!.
Qed.

Lemma pilerep_valid_pointer: forall sigma p,
    pilerep sigma p |-- valid_pointer p.
Proof.
intros. unfold pilerep. Intros x. entailer!.
Qed.

Definition pile_freeable (p: val) : mpred :=
            malloc_token Ews tpile p.

#[export] Hint Resolve pilerep_local_facts : saturate_local.
#[export] Hint Resolve pilerep_valid_pointer : valid_pointer.

Local Open Scope assert.

Definition Pile_new_spec :=
 DECLARE _Pile_new
 WITH gv: globals
 PRE [ ] PROP() PARAMS() GLOBALS(gv) SEP(mem_mgr gv)
 POST[ tptr tpile ]
   EX p: val,
      PROP() LOCAL(temp ret_temp p)
      SEP(pilerep nil p; pile_freeable p; mem_mgr gv).

Definition Pile_add_spec :=
 DECLARE _Pile_add
 WITH p: val, n: Z, sigma: list Z, gv: globals
 PRE [ tptr tpile, tint  ]
    PROP(0 <= n <= Int.max_signed)
    PARAMS (p; Vint (Int.repr n)) GLOBALS (gv)
    SEP(pilerep sigma p; mem_mgr gv)
 POST[ tvoid ]
    PROP() LOCAL()
    SEP(pilerep (n::sigma) p; mem_mgr gv).

Definition Pile_count_spec :=
 DECLARE _Pile_count
 WITH p: val, sigma: list Z
 PRE [ tptr tpile  ]
    PROP(0 <= sumlist sigma <= Int.max_signed)
    PARAMS (p) GLOBALS ()
    SEP (pilerep sigma p)
 POST[ tint ]
      PROP()
      LOCAL(temp ret_temp (Vint (Int.repr (sumlist sigma))))
      SEP(pilerep sigma p).

Definition Pile_free_spec :=
 DECLARE _Pile_free
 WITH p: val, sigma: list Z, gv: globals
 PRE [ tptr tpile  ]
    PROP()
    PARAMS (p) (GLOBALS (gv)
    SEP(pilerep sigma p; pile_freeable p; mem_mgr gv))
 POST[ tvoid ]
     PROP() LOCAL() SEP(mem_mgr gv).

Definition PileASI:funspecs := [ Pile_new_spec; Pile_add_spec; Pile_count_spec; Pile_free_spec].


Load LFindLoad.
From lfind Require Import LFind.

                    From adtind Require Import goal20.

 Require Import Extraction.
 Extract Inductive nat => nat [ "(O)" "S" ].
 Extract Inductive list => list [ "Nil" "Cons" ].
Definition lfind_example_1  := ( Cons Zero (Cons (Succ (Succ (Succ Zero))) (Cons Zero Nil))).
Definition lfind_example_2  := ( Cons Zero (Cons Zero (Cons (Succ (Succ (Succ Zero))) Nil))).
Definition lfind_example_3  := ( Cons (Succ (Succ Zero)) Nil).
Definition lfind_example_4  := ( Cons Zero (Cons (Succ Zero) (Cons (Succ (Succ (Succ Zero))) Nil))).
Definition lfind_example_5  := ( Cons (Succ Zero) (Cons (Succ Zero) Nil)).
Definition lfind_example_6  := ( Cons (Succ (Succ Zero))         (Cons (Succ Zero) (Cons (Succ (Succ Zero)) Nil))).
Definition lfind_example_7  := ( Cons (Succ Zero)         (Cons (Succ (Succ (Succ Zero))) (Cons (Succ (Succ Zero)) Nil))).
Definition lfind_example_8  := ( Cons (Succ (Succ (Succ Zero)))         (Cons Zero (Cons (Succ Zero) (Cons Zero Nil)))).
Definition lfind_example_9  := ( Cons Zero (Cons (Succ Zero) Nil)).
Definition lfind_example_10  := ( Cons (Succ Zero) Nil).
Definition lfind_example_11  := ( Cons Zero (Cons Zero (Cons Zero Nil))).
Definition lfind_example_12  := ( Cons (Succ (Succ (Succ (Succ Zero)))) Nil).
Definition lfind_example_13  := ( Cons (Succ Zero) (Cons Zero Nil)).
Definition lfind_example_14  := ( Cons Zero (Cons Zero (Cons (Succ Zero) (Cons Zero Nil)))).
Definition lfind_example_15  := ( Cons Zero (Cons Zero Nil)).
Definition lfind_example_16  := ( Cons Zero (Cons (Succ Zero) (Cons Zero Nil))).
Definition lfind_example_17  := ( Cons (Succ (Succ Zero)) (Cons Zero Nil)).
Definition lfind_example_18  := ( Cons Zero         (Cons Zero            (Cons Zero (Cons Zero (Cons Zero (Cons (Succ Zero) Nil)))))).
Definition lfind_example_19  := ( Cons Zero Nil).

                    Extraction "/home/yousef/lemmafinder/benchmark/_lfind_clam_lf_goal20_theorem0_40_lem/lfind_extraction.ml" lfind_example_1 lfind_example_2 lfind_example_3 lfind_example_4 lfind_example_5 lfind_example_6 lfind_example_7 lfind_example_8 lfind_example_9 lfind_example_10 lfind_example_11 lfind_example_12 lfind_example_13 lfind_example_14 lfind_example_15 lfind_example_16 lfind_example_17 lfind_example_18 lfind_example_19 .


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^198 - 17
Base: 22
***)

Definition curve : CurveParameters :=
  {|
    sz := 9%nat;
    base := 22;
    bitwidth := 32;
    s := 2^198;
    c := [(1, 17)];
    carry_chains := Some [seq 0 (pred 9); [0; 1]]%nat;

    a24 := None;
    coef_div_modulus := Some 2%nat;

    goldilocks := None;
    karatsuba := None;
    montgomery := false;
    freeze := Some true;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


Require Import Crypto.Specific.Framework.SynthesisFramework.
Require Import Crypto.Specific.solinas32_2e256m2e224p2e192p2e96m1_12limbs.CurveParameters.

Module P <: PrePackage.
  Definition package : Tag.Context.
  Proof. make_Synthesis_package curve extra_prove_mul_eq extra_prove_square_eq. Defined.
End P.

Module Export S := PackageSynthesis P.


From RecordUpdate Require Import RecordSet.
Import RecordSetNotations.

From Goose.github_com.mit_pdos.go_journal Require Import wal.

From Perennial.Helpers Require Import Transitions.
From Perennial.program_proof Require util_proof.
From Perennial.program_proof Require Import disk_prelude disk_lib.
From Perennial.program_proof Require Import wal.abstraction.

Implicit Types (txn_id:nat) (pos: u64).

#[global]
Existing Instance r_mbind.
#[global]
Existing Instance fallback_genPred.

Definition update_durable: transition log_state.t unit :=
  new_durable ← suchThat
              (λ s new_durable,
               (s.(log_state.durable_lb) ≤
                new_durable <
                length s.(log_state.txns))%nat);
  modify (set log_state.durable_lb (λ _, new_durable)).

Definition update_installed: transition log_state.t nat :=
  new_installed ← suchThat
              (λ s new_installed,
                 (s.(log_state.installed_lb) ≤
                  new_installed ≤
                  s.(log_state.durable_lb))%nat);
  modify (set log_state.installed_lb (λ _, new_installed));;
  ret new_installed.

Definition log_crash : transition log_state.t unit :=
  crash_txn ← suchThat
            (λ s (crash_txn: nat),
               (s.(log_state.durable_lb) ≤ crash_txn < length s.(log_state.txns))%nat);
  modify (set log_state.txns (fun txns => take (S crash_txn) txns));;
  modify (set log_state.durable_lb (fun _ => crash_txn));;
  ret tt.

Lemma log_crash_unfold σ σ' :
  relation.denote log_crash σ σ' () ↔
  ∃ (crash_txn:nat),
    (σ.(log_state.durable_lb) ≤ crash_txn < length σ.(log_state.txns))%nat ∧
    σ' = (set log_state.txns (take (S crash_txn)) σ)
           <|log_state.durable_lb := crash_txn|>.
Proof.
  rewrite /log_crash.
  split; simpl; intros.
  - monad_inv.
    eauto.
  - destruct H as (crash_txn & Hbounds & ->).
    eapply (relation.bind_runs _ _ _ _ crash_txn).
    + simpl.
      constructor; eauto.
    + monad_simpl.
Qed.

Definition suchThatMax {Σ} (pred: Σ -> nat -> Prop) : transition Σ nat :=
  suchThat (λ s x, pred s x ∧ ∀ y, pred s y -> y ≤ x).

Definition log_flush (pos:u64) (txn_id: nat) : transition log_state.t unit :=
  assert (λ s, is_txn s.(log_state.txns) txn_id pos);;
  new_durable ← suchThat
              (λ s (new_durable: nat),
                 (Nat.max s.(log_state.durable_lb) txn_id ≤ new_durable < length s.(log_state.txns))%nat);
  modify (set log_state.durable_lb (λ _, (new_durable)));;
  ret tt.

Definition allocPos : transition log_state.t u64 :=
  suchThat (λ s (pos': u64),
            (∀ (pos: u64) txn_id,
                is_txn s.(log_state.txns) txn_id pos ->
                int.Z pos ≤ int.Z pos')).

Definition log_mem_append (txn: list update.t): transition log_state.t u64 :=
  pos ← allocPos;
  modify (set log_state.txns (fun txns => txns ++ [(pos,txn)]));;
  ret pos.

Lemma list_singleton_lookup {A} (i: nat) (x1 x2: A) :
  [x1] !! i = Some x2 ->
  (i = 0%nat) ∧ x1 = x2.
Proof.
  destruct i; simpl.
  - inversion 1; auto.
  - rewrite lookup_nil; inversion 1.
Qed.

Theorem mem_append_preserves_wf σ pos upds :
  addrs_wf upds σ.(log_state.d) ->
  (* pos should be at least as high as any position given out *)
  (∀ (pos': u64) txn_id,
      is_txn σ.(log_state.txns) txn_id pos' ->
      int.Z pos' ≤ int.Z pos) ->
  wal_wf σ ->
  wal_wf (set log_state.txns (λ txns, txns ++ [(pos, upds)]) σ).
Proof.
  simpl.
  intros Haddrwf Hpos_highest Hwf.
  destruct_and! Hwf.
  split_and!; simpl; auto.
  - rewrite /log_state.updates /=.
    rewrite /addrs_wf.
    rewrite txn_upds_app.
    apply Forall_app_2; eauto.
    rewrite txn_upds_single //.
  - rewrite fmap_app.
    simpl.
    apply list_mono_app.
    split_and!; auto.
    { apply list_mono_singleton. }
    intros.
    apply list_singleton_lookup in Hx2 as [-> ->].
    eapply Hpos_highest; eauto.
    rewrite /is_txn.
    rewrite -list_lookup_fmap; eauto.
  - len.
Qed.

Theorem log_mem_append_preserves_wf txn σ σ' pos :
  addrs_wf txn σ.(log_state.d) ->
  wal_wf σ ->
  relation.denote (log_mem_append txn) σ σ' pos ->
  wal_wf σ'.
Proof.
  simpl.
  intros Haddrwf Hwf Htrans; monad_inv.
  eapply mem_append_preserves_wf; eauto.
Qed.

Definition disk_at_txn_id (txn_id: nat) (s:log_state.t): disk :=
  apply_upds (txn_upds (take (S txn_id) (log_state.txns s))) s.(log_state.d).

Definition updates_for_addr (a: u64) (l : list update.t) : list Block :=
  update.b <$> filter (λ u, u.(update.addr) = a) l.

Definition updates_since (txn_id: nat) (a: u64) (s : log_state.t) : list Block :=
  updates_for_addr a (txn_upds (drop (S txn_id) (log_state.txns s))).

Fixpoint latest_update (base: Block) (upds: list Block) : Block :=
  match upds with
  | u :: upds' =>
    latest_update u upds'
  | nil => base
  end.

Definition last_disk (s:log_state.t): disk :=
  disk_at_txn_id (length (log_state.txns s)) s.

Definition no_updates_since σ a txn_id :=
  Forall (λ u, u.(update.addr) ≠ a)
         (txn_upds (drop (S txn_id) (log_state.txns σ))).

Definition log_read_cache (a:u64): transition log_state.t (option Block) :=
  ok ← any bool;
  if (ok:bool)
  then d ← reads last_disk;
       match d !! int.Z a with
       | None => undefined
       | Some b => ret (Some b)
       end
  else
    (* on miss, read makes [installed_to] precise enough so the caller can
    use [log_read_installed] and together get the current value at [a] *)
    update_durable;;
    update_installed;;
    suchThat (fun s (_:unit) =>
                no_updates_since s a s.(log_state.installed_lb));;
    ret None.

Definition installed_disk (s:log_state.t): disk :=
  disk_at_txn_id s.(log_state.installed_lb) s.

Definition log_read_installed (a:u64): transition log_state.t Block :=
  installed_txn_id ← suchThat (fun s txn_id =>
                                 s.(log_state.installed_lb) ≤
                                 txn_id <
                                 length s.(log_state.txns))%nat;
  d ← reads (disk_at_txn_id installed_txn_id);
  unwrap (d !! int.Z a).


Require Import SpecCert.Formalism.

Require Import SpecCert.x86.Event.
Require Import SpecCert.x86.Architecture.
Require Import SpecCert.x86.Transition.Event.

Definition x86Context
           (S: Type) :=
  HardwareSoftwareMapping (Architecture S) S.

Definition pre_condition
           {S :Type} :=
  Architecture S -> Prop.

Definition post_condition
           {S :Type} :=
  Architecture S -> Architecture S -> Prop.

Definition no_pre
           {S :Type} :=
  fun (a: Architecture S) => True.

Definition id_post
           {S :Type} :=
  fun (a a':Architecture S) => a = a'.

Definition x86_precondition
           {Label: Type}
           (a:  Architecture Label)
           (ev: x86Event)
  : Prop :=
  match ev with
  | DisableInterrupt     => no_pre
  | EnableInterrupt      => no_pre
  | Write addr value     => no_pre
  | Read r addr value    => read_pre r addr value
  | OpenSmram            => open_smram_pre
  | CloseSmram           => close_smram_pre
  | LockSmramc           => lock_smramc_pre
  | NextInstruction pa   => no_pre
  | ReceiveInterrupt i   => no_pre
  end a.

Definition x86_postcondition
           {S:       Type}
           (context: x86Context S)
           (h:       Architecture S)
           (ev:      x86Event)
           (h':      Architecture S)
  : Prop :=
  match ev with
  | DisableInterrupt     => disable_interrupt_post
  | EnableInterrupt      => enable_interrupt_post
  | Write addr value     => write_post context addr value
  | Read _ addr value    => read_post addr
  | OpenSmram            => open_smram_post
  | CloseSmram           => close_smram_post
  | LockSmramc           => lock_smramc_post
  | NextInstruction pa   => nextinstr_post pa
  | ReceiveInterrupt i   => receive_interrupt_post i
  end h h'.


Require Import FP.CoreData.
Require Import FP.Classes.

Import ClassesNotation.
Import CoreDataNotation.

Instance N_One : One positive := { one := 1%positive }.
Instance N_Plus : Plus positive := { plus := BinPos.Pos.add }.

Fixpoint pos_cofold' {w} `{! Comonad w } {A}
    (f:positive -> w A -> A) (aW:w A) (n:positive) : A :=
  let double_cofold :=
    pos_cofold' $ fun n aW =>
      let aW := codo aW => f (xI n) aW in
      f (xO n) aW
  in
  match n with
  | xH => coret aW
  | xO n =>
      let aW := codo aW => double_cofold aW n in
      f xH aW
  | xI n =>
      let aW := codo aW => f (xO n) aW in
      let aW := codo aW => double_cofold aW n in
      f xH aW
  end.
Definition pos_cofold {w} `{! Comonad w } {A}
    (f:positive -> w A -> A) (aW:w A) (n:positive) : A :=
  let aW := codo aW => f n aW in
  pos_cofold' f aW n.
Instance pos_Foldable : Foldable positive positive :=
  { cofold := @pos_cofold }.

Fixpoint pos_coiter' {w} `{! Comonad w } {A}
    (f:w A -> positive -> A) (aW:w A) (n:positive) : A :=
  let double_cofold :=
    pos_coiter' $ fun aW n =>
      let aW := codo aW => f aW (xO n) in
      f aW (xI n)
  in
  match n with
  | xH => coret aW
  | xO n =>
      let aW := codo aW => f aW xH in
      double_cofold aW n
  | xI n =>
      let aW := codo aW => f aW xH in
      let aW := codo aW => double_cofold aW n in
      f aW (xO n)
  end.
Definition pos_coiter {w} `{! Comonad w } {A}
    (f:w A -> positive -> A) (aW:w A) (n:positive) : A :=
  let aW := codo aW => pos_coiter' f aW n in
  f aW n.
Instance pos_Iterable : Iterable positive positive :=
  { coiter := @pos_coiter }.

Fixpoint pos_coloopr' {w} `{! Comonad w } {A}
    (f:w A -> A) (aW:w A) (n:positive) : A :=
  let double_coloopr :=
    pos_coloopr' $ fun aW =>
      let aW := codo aW => f aW in
      f aW
  in
  match n with
  | xH => coret aW
  | xO n =>
      let aW := codo aW => double_coloopr aW n in
      f aW
  | xI n =>
      let aW := codo aW => double_coloopr aW n in
      let aW := codo aW => f aW in
      f aW
  end.
Definition pos_coloopr {w} `{! Comonad w } {A}
    (f:w A -> A) (aW:w A) (n:positive) : A :=
  let aW := codo aW => pos_coloopr' f aW n in
  f aW.

Fixpoint pos_coloopl' {w} `{! Comonad w } {A}
    (f:w A -> A) (aW:w A) (n:positive) : A :=
  let double_coloopl :=
    pos_coloopl' $ fun aW =>
      let aW := codo aW => f aW in
      f aW
  in
  match n with
  | xH => coret aW
  | xO n =>
      let aW := codo aW => f aW in
      double_coloopl aW n
  | xI n =>
      let aW := codo aW => f aW in
      let aW := codo aW => f aW in
      double_coloopl aW n
  end.
Definition pos_coloopl {w} `{! Comonad w } {A}
    (f:w A -> A) (aW:w A) (n:positive) : A :=
  let aW := codo aW => f aW in
  pos_coloopl' f aW n.
Instance pos_Peano : Peano positive :=
  { pzero := xH
  ; psucc := BinPos.Pos.succ
  ; coloopr := @pos_coloopr
  ; coloopl := @pos_coloopl
  }.


Require Import MirrorCore.Subst.FMapSubst.
Require Import MirrorCore.Lambda.Expr.
Require Import MirrorCore.Lambda.ExprSubst.
Require Import MirrorCore.Lambda.ExprUnify_simul.
Require Import MirrorCore.Lambda.ExprLift.
Require Import MirrorCore.STac.STac.
Require Import McExamples.Simple.Simple.

Set Implicit Arguments.
Set Strict Implicit.

Definition E := expr typ func.
Instance RType_typ : RType typ := _.
Instance Expr_E : Expr _ E := Expr_expr.

Definition subst : Type := FMapSubst.SUBST.raw E.
Instance Subst_subst : Subst subst E := FMapSubst.SUBST.Subst_subst _.
Instance SubstUpdate_subst : SubstUpdate subst E := FMapSubst.SUBST.SubstUpdate_subst (@instantiate typ func).

Notation "a @ b" := (App a b) (at level 30).
Let eq_nat (a b : E) : E := Inj (Eq tyNat) @ a @ b.
Let plus (a b : E) : E := Inj Plus @ a @ b.
Let n (n : nat) : E := Inj (N n).

(* forall n, 0 + n = n *)
Definition RW1 : RW typ E subst :=
{| lem := {| Lemma.vars := tyNat :: nil
           ; Lemma.premises := nil
           ; Lemma.concl := (tyNat, plus (n 0) (Var 0), Var 0) |}
 ; side_solver := use_list nil
 |}.

(* forall n, n + 0 = n *)
Definition RW2 : RW typ E subst :=
{| lem := {| Lemma.vars := tyNat :: nil
           ; Lemma.premises := nil
           ; Lemma.concl := (tyNat, plus (Var 0) (n 0), Var 0) |}
 ; side_solver := use_list nil
 |}.

Definition rewrite (rw : RW typ E subst) tus tvs (t : typ) (e : E) : option E :=
  match
    @rewrite_here typ E _ subst _ _ (@vars_to_uvars typ func)
                  (fun tus tvs u e1 e2 t s =>
                     @ExprUnify_simul.exprUnify subst typ func _ _ _ _ _ 10 tus tvs u s e1 e2 t)
                  (@instantiate typ func) rw tus tvs t nil e (@empty _ _ _) 0
  with
    | None => None
    | Some (e',_) => Some e'
  end.

Definition rewrite_top (rw : RW typ E subst) : stac typ E subst :=
  fun tus tvs sub hyps goal =>
    match
      @rewrite_here typ E _ subst _ _ (@vars_to_uvars typ func)
                    (fun tus tvs u e1 e2 t s =>
                       @ExprUnify_simul.exprUnify subst typ func _ _ _ _ _ 10 tus tvs u s e1 e2 t)
                    (@instantiate typ func) rw tus tvs tyProp hyps goal sub 0
    with
      | None => Fail
      | Some (g',s') => More nil nil s' hyps g'
    end.

Section above_binders.
  Variable rw : tenv typ -> tenv typ -> typ -> E -> nat -> subst -> option (E * subst).

  (** NOTE: There should still be room to optimize this b/c the option monad is
   ** pretty inefficient
   **)
  Fixpoint bottom_up' (under : nat) (tus tvs : tenv typ)
           (t : typ) (e : E) (s : subst) {struct e}
  : (E * subst) :=
    match e with
      | Var n => match rw tus tvs t e under s with
                   | None => (e,s)
                   | Some x => x
                 end
      | UVar _ => (e,s)
      | Inj _ => match rw tus tvs t e under s with
                   | None => (e,s)
                   | Some x => x
                 end
      | App a b =>
        match bottom_up_simul' under tus tvs a s with
          | None => (e,s)
          | Some (tyArr td t,(a',s')) =>
            let (b',s'') := bottom_up' under tus tvs td b s' in
            match rw tus tvs t (App a' b') under s'' with
              | None => (App a' b', s'')
              | Some x => x
            end
          | _ => (e,s)
        end
      | Abs _ _ => match rw tus tvs t e under s with
                     | None => (e,s)
                     | Some x => x
                   end
    end
  with bottom_up_simul' (under : nat) (tus tvs : tenv typ)
                        (e : E) (s : subst) {struct e}
  : option (typ * (E * subst)) :=
    match e with
      | Var n =>
        match nth_error tvs n with
          | None => None
          | Some t => Some match rw tus tvs t e under s with
                             | None => (t,(e,s))
                             | Some x => (t,x)
                           end
        end
      | UVar n =>
        match nth_error tus n with
          | None => None
          | Some t => Some (t,(e,s))
        end
      | Inj _ =>
        match typeof_expr tus tvs e with
          | None => None
          | Some t => Some match rw tus tvs t e under s with
                             | None => (t,(e,s))
                             | Some x => (t,x)
                           end
        end
      | App a b =>
        match bottom_up_simul' under tus tvs a s with
          | None => None
          | Some (tyArr td t,(a',s')) =>
            let (b',s'') := bottom_up' under tus tvs td b s' in
            Some match rw tus tvs t (App a' b') under s'' with
                   | None => (t,(App a' b', s''))
                   | Some x => (t,x)
                 end
          | _ => None
        end
      | Abs _ _ =>
        match typeof_expr tus tvs e with
          | None => None
          | Some t =>
            Some match rw tus tvs t e under s with
                   | None => (t,(e,s))
                   | Some x => (t,x)
                 end
        end
    end.
  Definition bottom_up tus tvs t e s :=
    Some (bottom_up' 0 tus tvs t e s).

End above_binders.

Definition autorewrite : RWs typ E subst -> stac typ E subst :=
  @rewrite_bottom_up typ E RType_typ _ subst _ _ (@vars_to_uvars typ func)
                    (fun tus tvs u e1 e2 t s =>
                       @ExprUnify_simul.exprUnify subst typ func _ _ _ _ _ 10 tus tvs u s e1 e2 t)
                    (@instantiate typ func)
                    bottom_up.

Let all := fun t => match t with
                      | tyNat => RW1 :: RW2 :: nil
                      | _ => nil
                    end.

(*
Eval vm_compute in
    (rewrite RW1) nil (tyNat :: nil) tyNat (Inj Plus @ Inj (N 0) @ Var 0).
*)

(*
Time Eval vm_compute in
    let goal := eq_nat (plus (n 0) (plus (Var 0) (n 0))) (plus (plus (plus (n 0) (Var 0)) (n 0)) (n 0)) in
    autorewrite all nil (tyNat :: nil) (@empty _ _ _) nil goal.

Eval cbv beta iota zeta delta - [ plus n ] in (big_plus_ignore (Var 0) 2).
*)

Fixpoint big_plus_ignore acc n' : E :=
  match n' with
    | 0 => acc
    | S n' => plus (big_plus_ignore (n 0) n') (plus (big_plus_ignore acc n') (big_plus_ignore (n 0) n'))
  end.

Time Eval vm_compute in
    let goal := eq_nat (big_plus_ignore (Var 0) 10) (big_plus_ignore (Var 0) 10) in
    autorewrite all nil (tyNat :: nil) (@empty _ _ _) nil goal.

Fixpoint big_plus_ignore_sem acc n' : nat :=
  match n' with
    | 0 => acc
    | S n' => (big_plus_ignore_sem 0 n') + ((big_plus_ignore_sem acc n') + (big_plus_ignore_sem 0 n'))
  end.

Create HintDb plus_rw.
Hint Rewrite plus_O_n : plus_rw.
Hint Rewrite <- plus_n_O : plus_rw.

Goal forall x, (big_plus_ignore_sem x 10) = (big_plus_ignore_sem x 10).
  intro.
  Opaque Peano.plus.
  simpl.
  Time autorewrite with plus_rw.
  reflexivity.
Qed.