Require Import Coq.ZArith.ZArith.
Require Import Coq.Strings.String.
Require Import Coq.micromega.Lia.
Require Import coqutil.Byte.
Require Import coqutil.Word.Interface.
Require Import coqutil.Word.Properties.
Require Import coqutil.Map.Interface.
Require Import coqutil.Map.Properties.
Require Import coqutil.Tactics.Tactics.
Require Import bedrock2.Syntax.
Require Import bedrock2.WeakestPrecondition.
Require Import bedrock2.Map.Separation.
Require Import bedrock2.Map.SeparationLogic.
Require Import Crypto.Bedrock.Field.Common.Tactics.
Require Import Crypto.Bedrock.Field.Common.Types.
Require Import Crypto.Bedrock.Field.Common.Util.
Require Import Crypto.Bedrock.Field.Common.Arrays.ByteBounds.
Require Import Crypto.Bedrock.Field.Common.Arrays.MakeAccessSizes.
Require Import Crypto.Bedrock.Field.Common.Arrays.MaxBounds.
Require Import Crypto.Bedrock.Field.Translation.Proofs.Equivalence.
Require Import Crypto.Bedrock.Field.Common.Names.MakeNames.
Require Import Crypto.Bedrock.Field.Translation.Func.
Require Import Crypto.Util.ListUtil.
Require Import Crypto.Language.API.
Require Import Coq.Lists.List. (* after SeparationLogic *)

Import Language.Compilers.

Require Import Crypto.Util.Notations.
Local Open Scope Z_scope.

Ltac map_bounds_listonly t bounds :=
  lazymatch bounds with
  | (?a, ?b) =>
    let x := map_bounds_listonly t a in
    let y := map_bounds_listonly t b in
    constr:((x, y))
  | tt => constr:(tt)
  | ?b =>
    let bt := lazymatch type of b with
             | ?bt => bt end in
    let bt := (eval cbn in bt) in
    lazymatch bt with
    | option (list _) => t b
    | _ => constr:(tt)
    end
  end.

Ltac crush_argument_equivalence_subgoals :=
  repeat match goal with
         | _ => progress cbn [hd tl]
         | _ => progress cbv [WeakestPrecondition.literal]
         | _ => rewrite word.of_Z_unsigned
         | _ => rewrite map.get_put_diff by congruence
         | _ => rewrite map.get_put_same by auto
         | |- WeakestPrecondition.get _ _ _ => eexists
         | |- map word.unsigned _ = map byte.unsigned _ =>
           erewrite map_unsigned_of_Z,map_word_wrap_bounded
             by eauto using byte_unsigned_within_max_bounds
         | _ => solve [apply Forall_word_unsigned_within_access_size;
                       auto using width_0mod_8]
         | _ => solve [auto using Forall_map_unsigned,
                       Forall_map_byte_unsigned]
         | _ => solve [apply word.unsigned_range]
         | _ => solve [auto using eval_bytes_range]
         | _ => reflexivity
         end.

Ltac next_argument :=
  exists 1%nat; cbn [firstn skipn hd]; split;
         [ repeat lazymatch goal with
                  | |- Lift1Prop.ex1 _ _ =>
                    eexists; sepsimpl;
                    [ solve [crush_argument_equivalence_subgoals] .. | ]
                  | |- exists _, _ =>
                    eexists; sepsimpl;
                    [ solve [crush_argument_equivalence_subgoals] .. | ]
                  end | ].

Ltac ssubst :=
  repeat match goal with
         | H : literal (word.unsigned _) (eq _) |- _ =>
           let H' := fresh in
           inversion H as [H']; clear H;
           rewrite word.of_Z_unsigned in H'
         | H : word.unsigned _ = word.unsigned _ |- _ =>
           apply word.unsigned_inj in H
         | H : ?x = _ |- _ => subst x
         | H : _ = ?x |- _ => subst x
         end.

Ltac map_simplify :=
  repeat match goal with
         | _ => rewrite map.get_put_diff by congruence
         | _ => rewrite map.get_put_same
         end.

Ltac type_simplify :=
  cbv [expr.Interp] in *;
  cbn [fst snd type.app_curried type.final_codomain
           Compilers.base_interp] in *.
Ltac lists_reserved_simplify :=
  cbn [LoadStoreList.lists_reserved_with_initial_context
         LoadStoreList.extract_listnames
         LoadStoreList.lists_reserved
         make_innames make_innames' make_outnames make_names
         fst snd app type.final_codomain
         base_rtype_of_ltype
         rep.rtype_of_ltype rep.equiv rep.Z rep.listZ_mem
         map.of_list_zip map.putmany_of_list_zip
         Flatten.flatten_argnames Flatten.flatten_base_ltype
         Flatten.flatten_listonly_base_ltype ]; type_simplify.
Ltac translator_simplify :=
  cbn [fst snd type.final_codomain
           LoadStoreList.list_lengths_from_args
           LoadStoreList.list_lengths_from_value
           LoadStoreList.access_sizes_good_args
           LoadStoreList.base_access_sizes_good
           LoadStoreList.access_sizes_good
           LoadStoreList.base_access_sizes_good
           LoadStoreList.within_access_sizes_args
           LoadStoreList.within_base_access_sizes
           equivalent_flat_args equivalent_flat_base
           WeakestPrecondition.dexpr
           WeakestPrecondition.expr
           WeakestPrecondition.expr_body
           rep.equiv rep.Z rep.listZ_mem ].

Ltac access_size_simplify :=
  let do_simpl w v :=
    lazymatch v with access_size.one => idtac | access_size.two => idtac | access_size.four => idtac end;
    let from := constr:(Z.of_nat (@Memory.bytes_per w v)) in
    let to := (eval compute in from) in
    progress change from with to in * in
  repeat match goal with
         | H: context [Z.of_nat (@Memory.bytes_per ?w ?v)] |- _ => do_simpl w v
         | |- context [Z.of_nat (@Memory.bytes_per ?w ?v)] => do_simpl w v
         end.

Ltac simplify_translate_func_postcondition :=
  match goal with
    H : context [sep _ _ ?m] |- context [_ ?m] =>
    cbn - [Memory.bytes_per translate_func] in H
  end;
  sepsimpl_hyps.

Ltac setup_lists_reserved :=
  lists_reserved_simplify;
  translator_simplify;
  try match goal with
      | H : context [map byte.unsigned ?bs] |- _ =>
        assert (map byte.unsigned bs
                = map word.unsigned
                      (map word.of_Z (map byte.unsigned bs)))
          by (erewrite map_unsigned_of_Z, map_word_wrap_bounded;
              eauto using byte_unsigned_within_max_bounds)
      end.

Ltac handle_lists_reserved :=
  repeat match goal with
         | _ => progress sepsimpl;
                auto using Forall_map_unsigned,
                Forall_map_byte_unsigned
         | _ => rewrite bits_per_word_eq_width
             by auto using width_0mod_8
         | _ => erewrite map_unsigned_of_Z,map_word_wrap_bounded
             by eauto using byte_unsigned_within_max_bounds
         | |- WeakestPrecondition.get _ _ _ =>
           eexists; map_simplify; solve [eauto]
         | _ => congruence
         end.

Ltac get_pointer wa :=
  match goal with
  | H : sep _ _ ?m |- context [?m] =>
    match type of H with
      context [_ ?pa wa] => constr:(pa)
    end
  | _ => fail "unable to find pointers for" wa
  end.

Ltac get_value_of_pointer p :=
  match goal with
  | H : sep _ _ ?m |- context [?m] =>
    match type of H with
      context [_ p ?x] => constr:(x)
    end
  | _ => fail "unable to find value of pointer" p
  end.

Ltac get_bedrock2_arglist args :=
  lazymatch args with
  | (?a, ?b) =>
    let x := get_bedrock2_arglist a in
    let y := get_bedrock2_arglist b in
    let ptrs := (eval cbv [app] in (x ++ y)%list) in
    constr:(ptrs)
  | tt => constr:(@nil (Semantics.word)) (* end of args *)
  | ?x =>
    lazymatch type of x with
    | list _ =>
      lazymatch x with
      | map word.unsigned ?ws =>
        let p := get_pointer ws in constr:(cons p nil)
      | map byte.unsigned ?bs =>
        let p := get_pointer bs in constr:(cons p nil)
      | _ => fail "unable to find words or bytes for the list" x
      end
    | Z =>
      lazymatch x with
      | word.unsigned ?w => constr:(cons w nil)
      | _ => fail "expected something of the form (word.unsigned _), got" x
      end
    | ?t => fail "unexpected argument type" t "for argument" x
    end
  end.

Ltac get_out_array_ptrs arg_ptrs all_ptrs :=
  let n := constr:((length all_ptrs - length arg_ptrs)%nat) in
  let out_ptrs := (eval lazy in (firstn n all_ptrs)) in
  out_ptrs.

Ltac exists_out_array_placeholder zs words ptr :=
  repeat match goal with
         | _ => progress handle_lists_reserved
         | |- Lift1Prop.ex1 _ _ =>
           first [ exists zs
                        | exists words
                        | exists ptr ]
         end.
Ltac exists_all_placeholders out_array_ptrs :=
  lazymatch out_array_ptrs with
  | cons ?p ?ptrs' =>
    let bits := get_value_of_pointer p in
    let zs :=
        lazymatch type of bits with
        | list word.rep => constr:(map word.unsigned bits)
        | list Init.Byte.byte => constr:(map byte.unsigned bits)
        | ?t => fail "unexpected placeholder type" t
        end in
    let words :=
        lazymatch type of bits with
        | list word.rep => constr:(bits)
        | list Init.Byte.byte =>
          constr:(map word.of_Z (map byte.unsigned bits))
        | ?t => fail "unexpected placeholder type" t
        end in
    exists_out_array_placeholder zs words p;
    exists_all_placeholders ptrs'
  | nil => idtac
  end.

Ltac canonicalize_arrays :=
  repeat match goal with
         | _ => progress access_size_simplify
         | |- context [Array.array
                         (Scalars.truncated_scalar access_size.word)
                         ?size ?start (map word.unsigned ?xs)] =>
           seprewrite (array_truncated_scalar_scalar_iff1 xs start size)
         | |- context [Array.array
                         (Scalars.truncated_scalar access_size.one)
                         ?size ?start ?xs] =>
           seprewrite (array_truncated_scalar_ptsto_iff1 xs start size)
         | H : sep _ _ ?m |- context [?m] =>
           seprewrite_in array_truncated_scalar_scalar_iff1 H
         | H : sep _ _ ?m |- context [?m] =>
           seprewrite_in array_truncated_scalar_ptsto_iff1 H
         | _ => rewrite <-@word_size_in_bytes_eq in * by eauto
         | _ => rewrite byte_map_of_Z_unsigned by auto
         | _ => rewrite map_unsigned_of_Z by auto
         | _ => erewrite map_word_wrap_bounded by
               eauto using byte_unsigned_within_max_bounds
         end.

Ltac solve_translate_func_subgoals prove_bounds t :=
  auto using make_innames_varname_gen_disjoint,
  make_outnames_varname_gen_disjoint,
  make_innames_make_outnames_disjoint,
  flatten_make_innames_NoDup, flatten_make_outnames_NoDup;
  pose proof bits_per_word_eq_width width_0mod_8;
  pose proof width_ge_8;
  repeat match goal with
         | _ => progress sepsimpl
         | _ => progress translator_simplify
         | _ => progress access_size_simplify
         | |- context [expr.interp] => progress type_simplify
         | |- (_, _) = (_, _) => apply f_equal2
         | |- Forall _ _ =>
           eapply max_bounds_range_iff; solve [prove_bounds]
         | |- Forall _ _ =>
           eapply byte_bounds_range_iff; solve [prove_bounds]
         | |- context [Z.le] => lia
         | _ => reflexivity
         | _ => t
         end.

Ltac prove_bounds_direct :=
  match goal with
  | H : _ |- _ => apply H; solve [auto]
  end.


(**
CoLoR, a Coq library on rewriting and termination.
See the COPYRIGHTS and LICENSE files.

- Frederic Blanqui, 2009-11-02

violation of variable condition
*)

Set Implicit Arguments.

From CoLoR Require Import LogicUtil ATrs AVariables BoolUtil EqUtil ListUtil RelUtil
  NatUtil APosition.

Section S.

  Variable Sig : Signature.

  Notation rules := (rules Sig).

  Lemma var_cond_mod : forall E R : rules,
    ~rules_preserve_vars R -> EIS (red_mod E R).

  Proof.
    intros E R. rewrite <- brules_preserve_vars_ok, <- false_not_true.
    unfold brules_preserve_vars.
    rewrite (forallb_neg (@brule_preserve_vars_ok Sig)).
    intros [[l r] [h1 h2]]. simpl in *. rewrite not_incl in h2.
    2: apply eq_nat_dec.
    destruct h2. destruct H. destruct (in_vars_subterm H). rename x0 into p.
    destruct (subterm_pos_elim H1). rename x0 into c. destruct a.
    set (s := single x l). set (f := iter l (fill (subc s c))).
    exists f. unfold IS. induction i; simpl in *. exists (f 0). split.
    apply rt_refl. exists l. exists r. exists Hole. simpl. exists s.
    repeat split. hyp. unfold s. rewrite sub_single_not_var. refl. hyp.
    rewrite H3, sub_fill. unfold s, single. simpl.
    rewrite (beq_refl beq_nat_ok). refl. unfold f. apply red_mod_fill. hyp.
  Qed.

  Lemma var_cond : forall R : rules, ~rules_preserve_vars R -> EIS (red R).

  Proof. intros. rewrite <- red_mod_empty. apply var_cond_mod. hyp. Qed.

End S.

Ltac var_cond Sig :=
  (apply var_cond_mod || apply var_cond);
    rewrite <- (ko (@brules_preserve_vars_ok Sig));
      (check_eq || fail 10 "variable condition satisfied").


Require Import List.
Import ListNotations.
Require Import String.

(* Borrow from CompCert *)
Require Import Cryptol.Coqlib.
Require Import Cryptol.Bitvectors.

Require Import Cryptol.AST.
Require Import Cryptol.Semantics.
Require Import Cryptol.Utils.
Require Import Cryptol.Builtins.
Require Import Cryptol.BuiltinSem.
Require Import Cryptol.BuiltinSyntax.
Require Import Cryptol.Values.
Require Import Cryptol.Bitstream.
Require Import Cryptol.Lib.
Require Import Cryptol.GlobalExtends.
Require Import Cryptol.GetEachN.

Require Import Cryptol.EvalTac.
Require Import Cryptol.Eager.

Import HaskellListNotations.
Open Scope string.

Require Import HMAC.HMAC.

Require Import HMAC.HMAC_spec.

Require Import HMAC.HMAC_lib.

Require Import HMAC.Kinit_eval.

(* lemma for when the length of the key is the same as the length of the block *)
Lemma Hmac_eval_keylen_is_blocklength :
  forall (key : ext_val) keylen,
    has_type key (bytestream keylen) ->
    forall GE TE SE,
      wf_env ge GE TE SE ->
      (forall id, In id [(371, "ks");(372, "okey");(373, "ikey");(374, "internal")] -> GE id = None) ->
      forall h hf,
        good_hash h GE TE SE hf ->
        forall msg msglen unused,
          has_type msg (bytestream msglen) ->
          exists v,
            eager_eval_expr GE TE SE (apply (tapply (EVar hmac) ((typenum (Z.of_nat msglen)) :: (typenum (Z.of_nat keylen)) :: (typenum unused) :: (typenum (Z.of_nat keylen)) :: nil)) (h :: h :: h :: (EValue key) :: (EValue msg) :: nil)) (to_sval v) /\ hmac_model hf key msg = Some v.
Proof.
  intros.
  rename H into Hkeytype.
  rename H1 into HIDs.
  rename H2 into Hgood_hash.
  rename H3 into Hmsgtype.
  init_globals ge.
  abstract_globals ge.
  edestruct good_hash_complete_eval; eauto.
  repeat break_exists.
  destruct H.

  inversion Hkeytype. subst.
  inversion Hmsgtype. subst.
  remember (hf (eseq (map (fun x3 : ext_val => xor_const 54 x3) l ++ l0))) as hv1.
  assert (HT : exists n, has_type hv1 (tseq n tbit)). {
    assert (exists n, has_type (eseq (map (fun x3 : ext_val => xor_const 54 x3) l ++ l0)) (bytestream n)). {
      eexists. econstructor.
      rewrite Forall_app. split.
      eapply Forall_map. eauto.
      intros. eapply xor_const_byte; eauto.
      eauto.
    }
    break_exists.
    eapply H1 in H2.
    repeat break. subst. eauto.
  }
  break_exists.
  edestruct ext_val_list_of_strictval; try eassumption.

  eexists; split.

  e. e. e. e. e. e. e. e. e.
  gen_global hmac.
  ag.

  e.
  e.
  e.
  e.
  e. e.
  e.
  e.
  e.
  e.
  e.

  e.
  e.
  lv.
  e. e. e. e. e.

  ag.

  e. e.
  e. e.

  g.
  e.

  (* evaluate the match *)
  econstructor. econstructor.

  g.

  (* call Kinit function *)
  (* START *)
  {
    eapply kinit_eval.
    solve_wf_env.
    exact Hkeytype.
    eapply good_hash_same_eval; eauto.
    gex.
    lv. et. et. et. lv.
  }  (* END *)

  simpl.
  rewrite list_of_strictval_of_strictlist.
  reflexivity.

  (* Begin model section *)
  {
    eapply eager_eval_bind_senvs. eassumption.
    instantiate (1 := fun x => to_sval (xor_const 92 x)).
    intros. e. e. e.
    ag.
    e. e. lv. e. e. e. ag.
    e. e. e.
    reflexivity.
    e. lv. lv.
    simpl.
    inversion H6. subst. simpl.
    unfold strictnum.
    unfold Z.to_nat. unfold Pos.to_nat.
    unfold Pos.iter_op. unfold Init.Nat.add.
    rewrite xor_num. reflexivity.
    rewrite H7. eassumption.
    congruence.
  }
  (* End model section *)

  e. g.
  e. e. e. e. ag.
  e. e. e. e. e. lv. e. e. e. e. e. ag.
  e. e. e. e. g.
  e. ec. ec.
  g.
  { (* TODO: make this one tactic *)
    eapply kinit_eval.
    solve_wf_env.
    exact Hkeytype.
    eapply good_hash_same_eval; eauto.
    gex.
    lv. et. et. et. lv.
  }
  simpl.
  rewrite list_of_strictval_of_strictlist.
  reflexivity.

  eapply eager_eval_bind_senvs. eassumption.
  instantiate (1 := fun x => to_sval (xor_const 54 x)).
  intros. e. e. e. ag.
  e. e. lv. e. e. e. ag.
  e. e. e. reflexivity.
  e. lv. lv.
  inversion H6. subst. simpl.
  unfold strictnum.
  rewrite xor_num. reflexivity.
  rewrite H7. eassumption.
  simpl. unfold Pos.to_nat. simpl. congruence.

  e. lv. e. lv. lv.

  unfold to_sval. fold to_sval.
  rewrite append_strict_list.
  reflexivity.

  eapply global_extends_eager_eval.

  replace (map (fun x3 : ext_val => to_sval (xor_const 54 x3)) l) with
      (map to_sval (map (fun x3 => xor_const 54 x3) l)) by (rewrite list_map_compose; reflexivity).
  rewrite <- list_append_map.
  remember (app (map (fun x3 : ext_val => xor_const 54 x3) l) l0) as ll.
  replace (strict_list (map to_sval ll)) with (to_sval (eseq ll)) by (reflexivity).
  subst ll.

  eapply H1.
  econstructor.

  rewrite Forall_app. split; auto.
  eapply Forall_map. eassumption.

  intros. eapply xor_const_byte; eauto.

  unfold bind_decl_groups.
  unfold bind_decl_group.
  unfold declare.

  gex.

  e. lv.

  simpl.
  rewrite <- Heqhv1.
  rewrite H3. reflexivity.

  e. lv. lv.

  rewrite append_strict_list. reflexivity.
  eapply global_extends_eager_eval.

  (* get to_sval out to outside *)
  (* evaluate the hash function *)

  replace (map (fun x4 : ext_val => to_sval (xor_const 92 x4)) l) with
  (map to_sval (map (xor_const 92) l)) by
      (clear -l;
       induction l; simpl; auto; f_equal; eapply IHl; eauto).

  rewrite get_each_n_map_commutes.

  rewrite map_strict_list_map_map_to_sval.
  rewrite <- list_append_map.
  rewrite strict_list_map_to_sval.

  assert (exists n, has_type (eseq (map (xor_const 92) l ++ map eseq (get_each_n (Pos.to_nat 8) x4))) (bytestream n)). {
    eapply has_type_seq_append.
    exists (Datatypes.length (map (xor_const 92) l)).
    econstructor.
    eapply Forall_map. eassumption.
    intros. eapply xor_const_byte; eauto.
    subst hv1.
    inversion H2. subst.
    rewrite <- H6 in *.
    eapply list_of_strictval_to_sval in H3. inversion H3.
    subst.
    remember H1 as HHash.
    clear HeqHHash.
    symmetry in H6.
    eapply good_hash_fully_padded in H6; try eassumption.
    eapply type_stream_of_bytes in H6; eauto.

  }

  break_exists.
  eapply H1 in H6. break_and. eassumption.

  gex.

  (* our result matches the model *)
  subst hv1.
  eapply list_of_strictval_to_sval in H3.
  simpl. rewrite H3.

  reflexivity.

  Unshelve.
  all: exact id.

Qed.


Require Export Coq.Lists.List.
Require Export Hex.
Require Export LTree2.
Require Export HashTable.

Import ListNotations.
Local Open Scope list_scope.
Notation "[ x , .. , y ]" := (cons x .. (cons y nil) ..).

Definition is_nilb {X} (l: list X) :=
match l with
| [] => true
| _::_ => false
end.

Section Structures.

Variable BN : Type.
Variable modN : BN -> BN -> BN.
Variable multN : BN -> BN -> BN.
Variable divN : BN -> BN -> BN.
Variable doubleN : BN -> BN.
Variable plusN : BN -> BN -> BN.

Definition Timestamp := BN.
Definition Currency := BN.
Definition HexSPK := hex.
Variable succN : BN -> BN.
Variable nat2bn : nat -> BN.

Record Account := account {
 balance_weight: BN;
 balance: Currency;
 isForging: bool;
 isPublishing: bool;
 isMarkable: bool;
 isMarkFollowing: bool;
 isMarkUnfollowing: bool;
 tfdepth:  option nat;
 publicKey: HexSPK
}.

Record Transaction := transaction {
sender : Account;
recipient: Account;
amount: Currency;
fee: Currency;
ttimestamp: Timestamp
}.

Definition BS := HexN.

Record Block := block {
transactions: list Transaction;
nMarked: nat;
baseTarget: BN;
totalDifficulty: BN;
generator: Account;
generationSignature: BS;
btimestamp: Timestamp
}.

Definition eqb_block (b1 b2: Block) :=
 eqb_hexs (generationSignature b1) (generationSignature b2).

Variable Digest : Type.
Variable dig2string : Digest -> BS.
Variable hashfun : HexN -> Digest.

Definition calcGenerationSignature (pb: Block) (acc: Account) : BS :=
  dig2string (hashfun ((generationSignature pb) ++ [publicKey acc])).

(*implemenation goes to Simulation*)
Variable formBlock : Block -> Account -> Timestamp -> list Transaction -> HexSPK -> Block.

Record Blockchain := blocktree {
 blocks : LTree Block
}.

Check Blockchain.

Definition lastblocks (bc: Blockchain) : list Block :=
match bc with
 | blocktree bs => [lastnode bs]
end.

Definition lastblock (bc: Blockchain) :  Block :=
match bc with
 | blocktree bs => lastnode bs
end.

Variable block_difficulty: Block -> BN.
(*zero*)
Variable BN0 : BN.
(*unit*)
Variable BN1 : BN.
(*greater-equal*)
Variable geN : BN -> BN -> bool.

Definition pushBlock (pb: Block) (bc: Blockchain) (b: Block) :=
match bc with
| blocktree bs =>  let (parb, newbs) :=  ltree_grow2 pb b eqb_block bs in
                                         (parb, blocktree newbs)
end.

Definition markBlock (n:nat) (b: Block) :=
block (transactions b) (S n) (baseTarget b) (totalDifficulty b) (generator b) (generationSignature b) (btimestamp b).

(*
Definition adjustTotalDifficulty (pb b: Block) :=
block (transactions b) true (baseTarget b) (plusN (totalDifficulty pb) (block_difficulty b)) (generator b) (generationSignature b) (btimestamp b).
*)

Variable markTimestamp : Timestamp.

Definition isnatpos (n:nat) :=
match n with
| O => false
| S _ => true
end.

Definition generateBlock (bc: Blockchain) (pb: Block) (acc: Account) (ts: Timestamp)
                         (txs: list Transaction) (pk: HexSPK) : Block * option Block * Blockchain :=
match bc with
| blocktree bs => let newblock' := formBlock pb acc ts txs pk in
                  let bMark := isnatpos (nMarked pb) in
                  let bTimeMore := geN ts markTimestamp in
                  let bBlockOld := negb (geN (btimestamp pb) markTimestamp) in
                  let newblock := if orb bMark (andb (isMarkable acc) (andb bTimeMore bBlockOld)) then
                                     markBlock (nMarked pb) newblock' else newblock' in
                  let (parb, newbc) := pushBlock pb bc newblock in
                  (newblock, parb, newbc)
end.

Record Node := node {
 nodechain: Blockchain;
 changedBlock: option Block;
 unconfirmedTxs: list Transaction;
 pending_blocks: list (Block*Block);
 open_blocks: list Block;
 (*pending_open_blocks: list Block;*)
 node_account: Account
}.

Variable canforge:  Node -> Timestamp -> Block -> bool.

Definition effectiveBalance := balance.

(*Fixpoint addSortedBlock (b: Block) (lb: list Block) :=
match lb with
| [] => [b]
| b'::bs => if negb (geN (baseTarget b) (baseTarget b')) then
               b::lb
            else b'::(addSortedBlock b bs)
end.*)

(*
Fixpoint addSortedBlock (b: Block) (lb: list Block) :=
match lb with
| [] => [b]
| b'::bs => if (geN (btimestamp b) (btimestamp b')) then
               b::lb
            else b'::(addSortedBlock b bs)
end.*)

Fixpoint addSortedBlock (b: Block) (lb: list Block) :=
match lb with
| [] => [b]
| b'::bs => if (geN (totalDifficulty b) (totalDifficulty b')) then
               b::lb
            else b'::(addSortedBlock b bs)
end.

Definition earlierBlock (mb1 mb2: option Block) :=
match (mb1, mb2) with
| (Some b1, Some b2) => if (geN (btimestamp b1) (btimestamp b2)) then mb2 else mb1
| (Some b1, None) => Some b1
| (None, Some b2) => Some b2
| (None, None) => None
end.

(*
 balance_weight: BN;
 balance: Currency;
 isForging: bool;
 isPublishing: bool;
 isMarkable: bool;
 isMarkFollowing: bool;
 tfdepth:  option nat;
 publicKey: HexSPK
*)

(* nodechain: Blockchain;
 changedBlock: option Block;
 unconfirmedTxs: list Transaction;
 pending_blocks: list (Block*Block);
 open_blocks: list Block;
 node_account: Account*)

Definition forge_block  (nd: Node) (ts: Timestamp) (pb: Block) : Node :=
let txs := unconfirmedTxs nd in
let acct := node_account nd in
let bc := nodechain nd in
let pk := publicKey acct in
let effb := effectiveBalance acct in
let canf := canforge nd ts pb in
let pendb := pending_blocks nd in
let openb := open_blocks nd in
(*let popenb := pending_open_blocks nd in*)
let chb := changedBlock nd in
match canf with
 | true => let (newbp, newbc) := generateBlock bc pb acct ts txs pk in
           let (newb, parb) := newbp in
             node newbc (earlierBlock chb parb) [] ((pb,newb)::pendb) (addSortedBlock newb openb) acct
 | false =>  node bc    chb                     [] pendb              (addSortedBlock pb openb)  acct
end.

Fixpoint splitn {X} (n: nat) (l: list X) :=
match n with
| O => ([], l)
| S n' => match l with
          | [] => ([], [])
          | x::xs => let (l1, l2) := splitn n' xs in
                               (x::l1, l2)
          end
end.

(*Variable tfdepth : option nat.*)

Check List.fold_left.

Fixpoint blt_nat (n m : nat) : bool :=
  match n with
  | O =>
    match m with
      | O => false
      | S _ => true
      end
  | S n' =>
      match m with
      | O => false
      | S m' => blt_nat n' m'
      end
  end.

Variable lengthConfirmation : nat.

Definition markedBlocks (b: Block) :=
andb (blt_nat (nMarked b) lengthConfirmation) (blt_nat 0 (nMarked b)).

Definition unmarkedBlocks (b: Block) :=
negb (isnatpos (nMarked b)).

(*List.fold_left (fun l => fun b => addSortedBlock b l) (pending_open_blocks newn) splobt*)

Definition splitBlocks (tfdepth: option nat) (opb: list Block) (defl: list Block):=
match tfdepth with
      | None => (opb, nil)
      | Some tfd => match tfd with
                     | O => (defl, nil)
                     | S _ => splitn tfd opb
                    end
end.

(*
Record Account := account {
 balance_weight: BN;
 balance: Currency;
 isForging: bool;
 isPublishing: bool;
 isMarkable: bool;
 isMarkFollowing: bool;
 isMarkUnfollowing: bool;
 tfdepth:  option nat;
 publicKey: HexSPK
}.
*)

Definition forge_blocks (nd: Node) (ts: Timestamp) : Node :=
           let acc := (node_account nd) in

           let bc := nodechain nd in
           let opb := open_blocks nd in
           let (blocks', rb') := splitBlocks (tfdepth acc) opb (lastblocks bc) in
           let (blocks, rb) := if (isMarkFollowing acc) then
                               let (l,l') := List.partition markedBlocks blocks' in (l, l'++rb')
                               else if (isMarkUnfollowing acc) then
                               let (l,l') := List.partition unmarkedBlocks blocks' in (l, l'++rb')
                               else (blocks', rb') in
           let bConfirmed := match opb with
                             | [] => false
                             | b::_ => blt_nat lengthConfirmation (nMarked b)
                             end in
           let acc' :=  account (balance_weight acc) (balance acc) (isForging acc) (isPublishing acc) (isMarkable acc)
                        (andb (isMarkFollowing acc) (negb bConfirmed)) (orb (isMarkUnfollowing acc) (andb bConfirmed (isMarkFollowing acc)))
                        (tfdepth acc)  (publicKey acc) in
           let nd' := node (nodechain nd) (changedBlock nd) (unconfirmedTxs nd) (pending_blocks nd) rb acc' in
           let newn := List.fold_left (fun n => fun pb => forge_block n ts pb) blocks nd' in newn.

(*
 balance_weight: BN;
 balance: Currency;
 isForging: bool;
 isPublishing: bool;
 tfdepth:  option nat;
 publicKey: HexSPK
*)

Definition defaultAccount pk :=
account BN1 BN0 true true false false false (Some 0) pk.

Fixpoint xseries {X} (n:nat) (x:X) (succX : X -> X) :=
match n with
| O => []
| S n' => x :: (xseries n' (succX x) succX)
end.

Variable nFixAccounts : nat.
Variable accountParams: list (BN*bool*bool*bool*option nat).

Compute (fst (1,2,3)).

Fixpoint fixAccounts (h: HexSPK) (n: nat) (l: list (BN*bool*bool*bool*option nat)) : list Account :=
match n with
| O => []
| S n' => match l with
          | [] => (defaultAccount h) :: (fixAccounts (succH h) n' l)
          | ap :: l' => let (f1,tfd)  := ap in
                        let (f2, iMF) := f1 in
                        let (f3, iMA) := f2 in
                        let (w, iP) := f3 in
                        (account w BN0 true iP iMA iMF false tfd h) :: (fixAccounts (succH h) n' l')
          end
end.

Variable systemBalance: Currency.

Definition sysAccounts :=
 let accs0 := fixAccounts H1 nFixAccounts accountParams in
 let w := List.fold_left plusN (List.map balance_weight accs0) BN0 in
 List.map (fun acc => account (balance_weight acc)
                                         (divN (multN (balance_weight acc) systemBalance) w)
                                         (isForging acc) (isPublishing acc) (isMarkable acc) (isMarkFollowing acc) (isMarkUnfollowing acc) (tfdepth acc) (publicKey acc)) accs0.

Record Connection := connection {
 from_node: Node;
 to_node: Node
}.

Inductive System := system {
 nodes: list Node;
 connections: list Connection;
 accounts: list Account;
 timestamp: Timestamp
}.

Definition godAccount := account BN0 BN0 false false false false false None H0.

Variable goalBlockTime : BN.
Variable MaxRand : BN.

Definition initialBaseTarget : BN := divN MaxRand (doubleN (multN systemBalance goalBlockTime)).
Definition maxBaseTarget : BN := multN initialBaseTarget systemBalance.

Check List.fold_left.

(*
 balance_weight: BN;
 balance: Currency;
 isForging: bool;
 isPublishing: bool;
 tfdepth:  option nat;
 publicKey: HexSPK
*)

Definition genesisBlock := block [] 0 initialBaseTarget initialBaseTarget godAccount [H0] BN0.

Definition genesisState :=
let accs := sysAccounts in
let chain := blocktree (tgen genesisBlock) in
let nodes := List.map (fun acc => node chain None [] [] [genesisBlock] acc) accs in
    system nodes [] (godAccount::accs) BN0.

Definition sendBlock (sender receiver: Node) (bseq: Block*Block): Node :=
let (prevb, newb) := bseq in
let rcvr_bc := nodechain receiver in
let gen := node_account sender in
let gs := calcGenerationSignature prevb gen in
let chb := changedBlock receiver in
if (eqb_hexs gs (generationSignature newb)) then
    let (parb, newbc) := pushBlock prevb rcvr_bc newb in
    node newbc (earlierBlock chb parb) (unconfirmedTxs receiver)
                (pending_blocks receiver) (addSortedBlock newb (open_blocks receiver)) (node_account receiver)
else receiver.

Definition eqbAccounts a1 a2:= eqb_hex (publicKey a1) (publicKey a2).

Definition sendBlocks (sender receiver: Node): Node :=
match andb (negb (eqbAccounts (node_account sender) (node_account receiver))) (isPublishing (node_account sender)) with
| false => receiver
| true => List.fold_left (fun n => fun pbb => sendBlock sender n pbb) (pending_blocks sender) receiver
end.

Print rebalanceS_till.

(*rebalanceS_till {X S: Type} (x:X) (w: X -> S) (eqX: X -> X -> bool) (s0: S) (geS: S-> S -> bool) (plusS: S -> S -> S)
                                           (s: S) (t: LTree X) *)
Definition postforge (n: Node) :=
let bc := nodechain n in
let txs := unconfirmedTxs n in
let acc := node_account n in
let chb := changedBlock n in
let newbc := match (tfdepth acc) with
             | None => bc
             | Some tfd => match tfd with
                           | O =>  match bc with
                                    | blocktree bs => match chb with
                                                       | Some chb' => blocktree (rebalanceS_till chb' block_difficulty eqb_block BN0 geN plusN BN0 bs)
                                                       | None => bc
                                                      end
                                   end
                           | S _ => bc
                           end
            end in
node newbc None txs [] (open_blocks n) acc.

Definition rebalance_chain (n: Node) :=
let bc := nodechain n in
let txs := unconfirmedTxs n in
let acc := node_account n in
let chb := changedBlock n in
let newbc := match bc with
 | blocktree bs => blocktree (snd (rebalanceS block_difficulty eqb_block BN0 geN plusN BN0 bs (None, [])))
end in
    node newbc None txs [] (open_blocks n) acc.

Definition rebalance_sys (s: System) :=
system (List.map rebalance_chain (nodes s)) (connections s) (accounts s) (timestamp s).

Definition systemEvents (ts: Timestamp) (sys: System) : System :=
let nodes' := List.map (fun n => forge_blocks n ts) (nodes sys) in
let (nonForgers, forgers) := partition (fun n => is_nilb (pending_blocks n)) nodes' in
let alteredNodes :=
List.map (fun n_to => List.fold_left (fun n_to' => fun n_from => sendBlocks n_from n_to') forgers n_to) nodes' in
  system (List.map postforge alteredNodes) (connections sys) (accounts sys) ts.

(*
nodes: list Node;
 connections: list Connection;
 accounts: list Account;
 timestamp: Timestamp*)

Fixpoint systemTransform (sys: System) (count: nat): System :=
let t:=timestamp sys in
match count with
| O => sys
| S c' =>  systemTransform (systemEvents (succN t) sys) c'
end.

Definition sys n := systemTransform genesisState n.
Definition sysblocks s := List.map blocks (List.map nodechain (nodes s)).

Inductive mhex :=
| N0: mhex
| N1: mhex
| N2: mhex
| N3: mhex
| N4: mhex
| N5: mhex
| N6: mhex
| N7: mhex
| N8: mhex
| N9: mhex
| NA: mhex
| NB: mhex
| NC: mhex
| ND: mhex
| NE: mhex
| NF: mhex
| M0: mhex
| M1: mhex
| M2: mhex
| M3: mhex
| M4: mhex
| M5: mhex
| M6: mhex
| M7: mhex
| M8: mhex
| M9: mhex
| MA: mhex
| MB: mhex
| MC: mhex
| MD: mhex
| ME: mhex
| MF: mhex.

Definition hex2mhex (m:bool) (h:hex) :=
match m with
| false => match h with
           | Hex.H0 => N0
           | Hex.H1 => N1
           | Hex.H2 => N2
           | Hex.H3 => N3
           | Hex.H4 => N4
           | Hex.H5 => N5
           | Hex.H6 => N6
           | Hex.H7 => N7
           | Hex.H8 => N8
           | Hex.H9 => N9
           | Hex.HA => NA
           | Hex.HB => NB
           | Hex.HC => NC
           | Hex.HD => ND
           | Hex.HE => NE
           | Hex.HF => NF
           end
| true =>  match h with
           | Hex.H0 => M0
           | Hex.H1 => M1
           | Hex.H2 => M2
           | Hex.H3 => M3
           | Hex.H4 => M4
           | Hex.H5 => M5
           | Hex.H6 => M6
           | Hex.H7 => M7
           | Hex.H8 => M8
           | Hex.H9 => M9
           | Hex.HA => MA
           | Hex.HB => MB
           | Hex.HC => MC
           | Hex.HD => MD
           | Hex.HE => ME
           | Hex.HF => MF
           end
end.

Definition showblock (b: Block) := hex2mhex (isnatpos (nMarked b)) (publicKey (generator b)).

Definition signs n := List.map (fun tb => ltree_map (fun b => showblock b) tb) (List.map blocks (List.map nodechain (nodes (sys n)))).
Definition sysigns s := List.map (fun tb => ltree_map (fun b => showblock b) tb) (sysblocks s).
Definition sysaccs s := List.map (node_account) (nodes s).

Definition addsucc (ht: nattable nat) (k: nat) :=
match (search_table k ht) with
| None => (k, 1) :: ht
| Some v => modify_key k (v+1) ht
end.

Definition generators s := List.map (fun tb => ltree_foldl (fun ht => fun b => addsucc ht (hex2nat (publicKey (generator b)))) tb []) (sysblocks s).

End Structures.

Extraction Language Haskell.
Extraction "postructures" ltree2list ltreelen systemTransform sys sysigns signs
       maxBaseTarget baseTarget List.filter btimestamp publicKey
       effectiveBalance List.nth ltree_list_map fold1 sysblocks generators lastnode lastnodes rebalance_sys sysaccs.


Require Import RamifyCoq.sample_mark.env_unionfind_iter.
Require Import RamifyCoq.graph.graph_model.
Require Import RamifyCoq.graph.path_lemmas.
Require Import RamifyCoq.graph.subgraph2.
Require Import RamifyCoq.graph.graph_relation.
Require Import RamifyCoq.graph.reachable_computable.
Require Import RamifyCoq.msl_application.Graph.
Require Import RamifyCoq.msl_application.UnionFindGraph.
Require Import RamifyCoq.msl_application.GList.
Require Import RamifyCoq.msl_application.GList_UnionFind.
Require Import RamifyCoq.floyd_ext.share.
Require Import RamifyCoq.sample_mark.spatial_graph_uf_iter.

Local Coercion UGraph_LGraph: Graph >-> LGraph.
Local Coercion LGraph_SGraph: LGraph >-> SGraph.
Local Identity Coercion ULGraph_LGraph: LGraph >-> UnionFindGraph.LGraph.
Local Identity Coercion LGraph_LabeledGraph: UnionFindGraph.LGraph >-> LabeledGraph.
Local Identity Coercion SGraph_PointwiseGraph: SGraph >-> PointwiseGraph.
Local Coercion pg_lg: LabeledGraph >-> PreGraph.

Notation vertices_at sh P g:= (@vertices_at _ _ _ _ _ mpred (@SGP pSGG_VST nat unit (sSGG_VST sh)) (SGA_VST sh) P g).
Notation whole_graph sh g := (vertices_at sh (vvalid g) g).
Notation graph sh x g := (@reachable_vertices_at _ _ _ _ _ _ _ _ _ _ (@SGP pSGG_VST nat unit (sSGG_VST sh)) _ x g).
Notation Graph := (@Graph pSGG_VST).
Notation uf_under_bound g := (uf_under_bound id g).
Existing Instances maGraph finGraph liGraph RGF.

Definition find_spec :=
 DECLARE _find
  WITH sh: wshare, g: Graph, x: pointer_val
  PRE [ _x OF (tptr (Tstruct _Node noattr))]
          PROP  (vvalid g x /\ uf_under_bound g)
          LOCAL (temp _x (pointer_val_val x))
          SEP   (whole_graph sh g)
  POST [ tptr (Tstruct _Node noattr) ]
        EX g': Graph, EX rt : pointer_val,
        PROP (uf_equiv g g' /\ uf_root g' x rt /\ uf_under_bound g' /\ rank_unchanged g g')
        LOCAL (temp ret_temp (pointer_val_val rt))
        SEP (whole_graph sh g').

Definition Gprog : funspecs := ltac:(with_library prog [find_spec]).

Lemma false_Cne_eq: forall x y, typed_false tint (force_val (sem_cmp_pp Cne (pointer_val_val x) (pointer_val_val y))) -> x = y.
Proof.
  intros. hnf in H. destruct x, y; inversion H; auto. simpl in H. clear H1. unfold sem_cmp_pp in H. simpl in H. destruct (eq_block b b0).
  - destruct (Ptrofs.eq i i0) eqn:? .
    + pose proof (Ptrofs.eq_spec i i0). rewrite Heqb1 in H0. subst; auto.
    + simpl in H. inversion H.
  - simpl in H. inversion H.
Qed.

Lemma true_Cne_neq: forall x y, typed_true tint (force_val (sem_cmp_pp Cne (pointer_val_val x) (pointer_val_val y))) -> x <> y.
Proof.
  intros. hnf in H. destruct x, y; inversion H; [|intro; inversion H0..]. simpl in H. clear H1. unfold sem_cmp_pp in H. simpl in H. destruct (eq_block b b0).
  - destruct (Ptrofs.eq i i0) eqn:? .
    + simpl in H. inversion H.
    + subst b0. pose proof (Ptrofs.eq_spec i i0). rewrite Heqb1 in H0. intro; apply H0. inversion H1. reflexivity.
  - intro. inversion H0. auto.
Qed.

Lemma graph_local_facts: forall sh x (g: Graph), vvalid g x -> whole_graph sh g |-- valid_pointer (pointer_val_val x).
Proof.
  intros. eapply derives_trans; [apply (@vertices_at_ramif_1_stable _ _ _ _ SGBA_VST _ _ (SGA_VST sh) g (vvalid g) x (vgamma g x)); auto |].
  simpl vertex_at at 1. unfold binode. entailer!.
Qed.

Lemma body_find: semax_body Vprog Gprog f_find find_spec.
Proof.
  start_function.
  destruct H. remember (vgamma g x) as rpa eqn:?H. destruct rpa as [r pa]. symmetry in H1.
  (* tmp = x *)
  Opaque pointer_val_val. forward. Transparent pointer_val_val.
  (* p = x -> parent; *)
  localize [data_at sh node_type (vgamma2cdata (vgamma g x)) (pointer_val_val x)].
  rewrite H1. simpl vgamma2cdata. forward. 1: entailer!; destruct pa; simpl; auto.
  unlocalize [whole_graph sh g].
  1: rewrite H1; simpl; apply (@vertices_at_ramif_1_stable _ _ _ _ SGBA_VST _ _ (SGA_VST sh) g (vvalid g) x (r, pa)); auto.
  forward_while (EX p: pointer_val, EX ppa: pointer_val,
                 PROP (reachable g x p /\ vgamma g p = (vlabel g p, ppa))
                 LOCAL (temp _p (pointer_val_val ppa); temp _tmp (pointer_val_val p); temp _x (pointer_val_val x))
                 SEP (vertices_at sh (vvalid g) g)).
  - Exists x pa. entailer!. split; [apply reachable_refl | f_equal; simpl in H1; inversion H1]; auto.
  - entailer!. destruct H2. apply reachable_foot_valid in H2. pose proof (valid_parent _ _ _ _ H2 H6). apply denote_tc_test_eq_split; apply graph_local_facts; auto.
  - destruct H2. apply true_Cne_neq in HRE.
    Opaque pointer_val_val. forward. Transparent pointer_val_val. remember (vgamma g ppa) as rpa eqn:?H. destruct rpa as [mr mgpa]. symmetry in H4.
    assert (H_VALID_PPA: vvalid g ppa) by (apply (valid_parent _ p (vlabel g p)); [apply reachable_foot_valid in H2 |]; auto).
    localize [data_at sh node_type (vgamma2cdata (vgamma g ppa)) (pointer_val_val ppa)].
    rewrite H4. simpl vgamma2cdata. forward. 1: entailer!; destruct mgpa; simpl; auto.
    unlocalize [whole_graph sh g].
    1: rewrite H4; simpl; apply (@vertices_at_ramif_1_stable _ _ _ _ SGBA_VST _ _ (SGA_VST sh) g (vvalid g) ppa (mr, mgpa)); auto.
    Exists (ppa, mgpa). simpl fst. simpl snd. assert (mr = vlabel g ppa) by (simpl in H4; inversion H4; auto). rewrite <- H5. entailer !.
    apply reachable_edge with p; auto. apply (vgamma_not_edge g p (vlabel g p)); auto. apply reachable_foot_valid in H2; auto.
  - destruct H2. apply false_Cne_eq in HRE. subst ppa. assert (uf_root g x p) by (split; intros; auto; apply (parent_loop g p (vlabel g p) y); auto).
    forward_while (EX g': Graph, EX tmp: pointer_val, EX xv: pointer_val,
                   PROP (uf_equiv g g' /\ uf_root g' xv p /\ uf_under_bound g' /\ rank_unchanged g g')
                   LOCAL (temp _p (pointer_val_val p); temp _tmp (pointer_val_val tmp); temp _x (pointer_val_val xv))
                   SEP (whole_graph sh g')).
    + Exists g p x. entailer !. split; [apply (uf_equiv_refl _  (liGraph g)) | repeat intro; auto].
    + entailer!. apply denote_tc_test_eq_split; apply graph_local_facts.
      * destruct H5 as [_ [[? _] _]]. apply reachable_head_valid in H5; assumption.
      * destruct H5 as [[? _] _]. rewrite <- H5. apply reachable_foot_valid in H2; assumption.
    + destruct H5 as [? [? [? ?]]]. apply true_Cne_neq in HRE. remember (vgamma g' xv) as rpa eqn:?H. destruct rpa as [xr xpa]. symmetry in H9.
      assert (H_VALID_XV: vvalid g' xv) by (destruct H6 as [? _]; apply reachable_head_valid in H6; auto).
      localize [data_at sh node_type (vgamma2cdata (vgamma g' xv)) (pointer_val_val xv)].
      rewrite H9. simpl vgamma2cdata. forward. 1: entailer!; destruct xpa; simpl; auto.
      unlocalize [whole_graph sh g'].
      1: rewrite H9; apply (@vertices_at_ramif_1_stable _ _ _ _ SGBA_VST _ _ (SGA_VST sh) g' (vvalid g') xv (xr, xpa)); auto.
      assert (weak_valid g' p) by (right; destruct H5; rewrite <- H5; apply reachable_foot_valid in H2; auto).
      assert (vvalid g' xv) by (destruct H6; apply reachable_head_valid in H6; auto).
      assert (~ reachable g' p xv) by (intro; destruct H6 as [_ ?]; specialize (H6 _ H12); auto).
      assert (vertices_at sh (vvalid (Graph_gen_redirect_parent g' xv p H10 H11 H12)) (Graph_gen_redirect_parent g' xv p H10 H11 H12) =
              vertices_at sh (vvalid g') (Graph_gen_redirect_parent g' xv p H10 H11 H12)). {
        apply vertices_at_Same_set. unfold Ensembles.Same_set, Ensembles.Included, Ensembles.In. simpl. intuition. }
      assert (H_P_NOT_NULL: p <> null) by (apply reachable_foot_valid in H2; intro; subst p; apply (valid_not_null g null H2); simpl; auto).
      localize [data_at sh node_type (Vint (Int.repr (Z.of_nat xr)), pointer_val_val xpa) (pointer_val_val xv)].
      forward. unlocalize [whole_graph sh (Graph_gen_redirect_parent g' xv p H10 H11 H12)].
      1: rewrite H13; apply (@graph_gen_redirect_parent_ramify _ (sSGG_VST sh)); auto.
      Opaque pointer_val_val. forward. Transparent pointer_val_val.
      Exists (((Graph_gen_redirect_parent g' xv p H10 H11 H12), xpa), xpa). simpl fst. simpl snd. entailer !. split; [|split].
      * apply (graph_gen_redirect_parent_equiv' g g' xv p); auto.
      * apply (uf_root_gen_dst_preserve g' (liGraph g')); auto.
        -- apply (vgamma_not_reachable _ _ xr); auto. pose proof (uf_root_not_eq_root_vgamma g' _ _ _ _ H9 H6 HRE). auto.
        -- apply (vgamma_uf_root g' xv xr xpa p); auto.
      * apply uf_under_bound_redirect_parent; auto.
    + destruct H5 as [? [? ?]]. forward. Exists g' p. entailer !. split; [|auto]. rewrite <- (uf_equiv_root_the_same g g' x p); auto.
Qed. (* Original: 118.49 secs; VST 2.*: 3.12 secs *)


Require Import Poulet4.P4light.Syntax.Typed.
Require Import Poulet4.P4light.Syntax.Syntax.
Require Import Poulet4.P4light.Syntax.Value.
Require Import Poulet4.P4light.Semantics.Semantics.
Require Import Poulet4.P4light.Syntax.P4defs.
Require Import Poulet4.P4light.Syntax.P4Notations.
Require Import Poulet4.P4light.Architecture.V1ModelTarget.
Require Import ProD3.core.SvalRefine.
Require Import ProD3.core.Members.
Require Import Coq.Strings.String.
Require Import Coq.Lists.List.
Import ListNotations.
Open Scope list_scope.
Open Scope string_scope.

(* A simplified switch model to demonstrate bloom filter application. *)

Section Switch.

Context {tags_t: Type} {tags_t_inhabitant : Inhabitant tags_t}.

Notation ident := string.
Notation path := (list ident).
Notation Val := (@ValueBase bool).
Notation Expression := (@Expression tags_t).
Notation P4Type := (@P4Type tags_t).
Notation extern_state := (@extern_state tags_t Expression).

Instance target : @Target tags_t Expression := V1Model.

Variable ge : genv.
Variable M : P4Type.

Definition standard_metadata_t : P4Type :=
  TypStruct
    [(!"ingress_port", TypBit 9); (!"egress_spec", TypBit 9); (!"egress_port", TypBit 9);
    (!"instance_type", TypBit 32); (!"packet_length", TypBit 32); (!"enq_timestamp", TypBit 32);
    (!"enq_qdepth", TypBit 19); (!"deq_timedelta", TypBit 32); (!"deq_qdepth", TypBit 19);
    (!"ingress_global_timestamp", TypBit 48); (!"egress_global_timestamp", TypBit 48);
    (!"mcast_grp", TypBit 16); (!"egress_rid", TypBit 16); (!"checksum_error", TypBit 1);
    (!"parser_error", TypError); (!"priority", TypBit 3)].

Inductive port :=
  | port_int
  | port_ext.

Definition port_to_Z (p : port) :=
  match p with
  | port_int => 0
  | port_ext => 1
  end.

Definition port_to_sval (p : port) :=
  ValBaseBit (P4Arith.to_loptbool 9 (port_to_Z p)).

Definition out_port_to_Z (p : option port) :=
  match p with
  | Some p => port_to_Z p
  | None => 511
  end.

Definition out_port_to_sval (p : option port) :=
  ValBaseBit (P4Arith.to_loptbool 9 (out_port_to_Z p)).

Inductive process_packet : extern_state -> (Z * port) -> extern_state -> option (Z * port) -> Prop :=
  | process_packet_intro : forall es data in_port es' data' out_port meta' std_meta' class_name inst_path targs fd m',
      PathMap.get ["main"; "ig"] (ge_inst ge) = Some {|iclass:=class_name; ipath:=inst_path; itargs:=targs|} ->
      PathMap.get ([class_name; "apply"]) (ge_func ge) = Some fd ->
      0 <= data < Z.pow 2 16 ->
      let hdr := ValBaseStruct [("myHeader",
        ValBaseHeader [("data", ValBaseBit (P4Arith.to_loptbool 16 data))] (Some true))] in
      let meta := force ValBaseNull (uninit_sval_of_typ None M) in
      let std_meta := update "ingress_port" (port_to_sval in_port) (force ValBaseNull (uninit_sval_of_typ None standard_metadata_t)) in
      0 <= data' < Z.pow 2 16 ->
      let hdr' := ValBaseStruct [("myHeader",
        ValBaseHeader [("data", ValBaseBit (P4Arith.to_loptbool 16 data'))] (Some true))] in
      Members.get "egress_spec" std_meta' = out_port_to_sval out_port ->
      exec_func ge read_ndetbit inst_path (PathMap.empty, es) fd nil [hdr; meta; std_meta]
          (m', es') [hdr'; meta'; std_meta'] (SReturn ValBaseNull) ->
      process_packet es (data, in_port) es' (option_map (pair data') out_port).

Inductive process_packets : extern_state -> list (Z * port) -> extern_state -> list (option (Z * port)) -> Prop :=
  | process_packets_nil : forall es,
      process_packets es [] es []
  | process_packets_cons : forall es1 p p' es2 ps ps' es3,
      process_packet es1 p es2 p' ->
      process_packets es2 ps es3 ps' ->
      process_packets es1 (p :: ps) es3 (p' :: ps').

End Switch.


From Coq Require Import String List ZArith.
From compcert Require Import Coqlib Integers Floats AST Ctypes Cop Clight Clightdefs.
Import Clightdefs.ClightNotations.
Local Open Scope Z_scope.
Local Open Scope string_scope.
Local Open Scope clight_scope.

Module Info.
  Definition version := "3.11".
  Definition build_number := "".
  Definition build_tag := "".
  Definition build_branch := "".
  Definition arch := "x86".
  Definition model := "64".
  Definition abi := "standard".
  Definition bitsize := 64.
  Definition big_endian := false.
  Definition source_file := "prims.c".
  Definition normalized := true.
End Info.

Definition _Coq_Numbers_BinNums_Zneg_arg_0 : ident := $"Coq_Numbers_BinNums_Zneg_arg_0".
Definition _Coq_Numbers_BinNums_Zneg_args : ident := $"Coq_Numbers_BinNums_Zneg_args".
Definition _Coq_Numbers_BinNums_Zpos_arg_0 : ident := $"Coq_Numbers_BinNums_Zpos_arg_0".
Definition _Coq_Numbers_BinNums_Zpos_args : ident := $"Coq_Numbers_BinNums_Zpos_args".
Definition _Coq_Numbers_BinNums_xI_arg_0 : ident := $"Coq_Numbers_BinNums_xI_arg_0".
Definition _Coq_Numbers_BinNums_xI_args : ident := $"Coq_Numbers_BinNums_xI_args".
Definition _Coq_Numbers_BinNums_xO_arg_0 : ident := $"Coq_Numbers_BinNums_xO_arg_0".
Definition _Coq_Numbers_BinNums_xO_args : ident := $"Coq_Numbers_BinNums_xO_args".
Definition ___builtin_ais_annot : ident := $"__builtin_ais_annot".
Definition ___builtin_annot : ident := $"__builtin_annot".
Definition ___builtin_annot_intval : ident := $"__builtin_annot_intval".
Definition ___builtin_bswap : ident := $"__builtin_bswap".
Definition ___builtin_bswap16 : ident := $"__builtin_bswap16".
Definition ___builtin_bswap32 : ident := $"__builtin_bswap32".
Definition ___builtin_bswap64 : ident := $"__builtin_bswap64".
Definition ___builtin_clz : ident := $"__builtin_clz".
Definition ___builtin_clzl : ident := $"__builtin_clzl".
Definition ___builtin_clzll : ident := $"__builtin_clzll".
Definition ___builtin_ctz : ident := $"__builtin_ctz".
Definition ___builtin_ctzl : ident := $"__builtin_ctzl".
Definition ___builtin_ctzll : ident := $"__builtin_ctzll".
Definition ___builtin_debug : ident := $"__builtin_debug".
Definition ___builtin_expect : ident := $"__builtin_expect".
Definition ___builtin_fabs : ident := $"__builtin_fabs".
Definition ___builtin_fabsf : ident := $"__builtin_fabsf".
Definition ___builtin_fmadd : ident := $"__builtin_fmadd".
Definition ___builtin_fmax : ident := $"__builtin_fmax".
Definition ___builtin_fmin : ident := $"__builtin_fmin".
Definition ___builtin_fmsub : ident := $"__builtin_fmsub".
Definition ___builtin_fnmadd : ident := $"__builtin_fnmadd".
Definition ___builtin_fnmsub : ident := $"__builtin_fnmsub".
Definition ___builtin_fsqrt : ident := $"__builtin_fsqrt".
Definition ___builtin_membar : ident := $"__builtin_membar".
Definition ___builtin_memcpy_aligned : ident := $"__builtin_memcpy_aligned".
Definition ___builtin_read16_reversed : ident := $"__builtin_read16_reversed".
Definition ___builtin_read32_reversed : ident := $"__builtin_read32_reversed".
Definition ___builtin_sel : ident := $"__builtin_sel".
Definition ___builtin_sqrt : ident := $"__builtin_sqrt".
Definition ___builtin_unreachable : ident := $"__builtin_unreachable".
Definition ___builtin_va_arg : ident := $"__builtin_va_arg".
Definition ___builtin_va_copy : ident := $"__builtin_va_copy".
Definition ___builtin_va_end : ident := $"__builtin_va_end".
Definition ___builtin_va_start : ident := $"__builtin_va_start".
Definition ___builtin_write16_reversed : ident := $"__builtin_write16_reversed".
Definition ___builtin_write32_reversed : ident := $"__builtin_write32_reversed".
Definition ___compcert_i64_dtos : ident := $"__compcert_i64_dtos".
Definition ___compcert_i64_dtou : ident := $"__compcert_i64_dtou".
Definition ___compcert_i64_sar : ident := $"__compcert_i64_sar".
Definition ___compcert_i64_sdiv : ident := $"__compcert_i64_sdiv".
Definition ___compcert_i64_shl : ident := $"__compcert_i64_shl".
Definition ___compcert_i64_shr : ident := $"__compcert_i64_shr".
Definition ___compcert_i64_smod : ident := $"__compcert_i64_smod".
Definition ___compcert_i64_smulh : ident := $"__compcert_i64_smulh".
Definition ___compcert_i64_stod : ident := $"__compcert_i64_stod".
Definition ___compcert_i64_stof : ident := $"__compcert_i64_stof".
Definition ___compcert_i64_udiv : ident := $"__compcert_i64_udiv".
Definition ___compcert_i64_umod : ident := $"__compcert_i64_umod".
Definition ___compcert_i64_umulh : ident := $"__compcert_i64_umulh".
Definition ___compcert_i64_utod : ident := $"__compcert_i64_utod".
Definition ___compcert_i64_utof : ident := $"__compcert_i64_utof".
Definition ___compcert_va_composite : ident := $"__compcert_va_composite".
Definition ___compcert_va_float64 : ident := $"__compcert_va_float64".
Definition ___compcert_va_int32 : ident := $"__compcert_va_int32".
Definition ___compcert_va_int64 : ident := $"__compcert_va_int64".
Definition _alloc : ident := $"alloc".
Definition _alloc_make_Coq_Numbers_BinNums_Z_Zpos : ident := $"alloc_make_Coq_Numbers_BinNums_Z_Zpos".
Definition _alloc_make_Coq_Numbers_BinNums_positive_xI : ident := $"alloc_make_Coq_Numbers_BinNums_positive_xI".
Definition _alloc_make_Coq_Numbers_BinNums_positive_xO : ident := $"alloc_make_Coq_Numbers_BinNums_positive_xO".
Definition _args : ident := $"args".
Definition _bit : ident := $"bit".
Definition _get_Coq_Numbers_BinNums_Z_tag : ident := $"get_Coq_Numbers_BinNums_Z_tag".
Definition _get_Coq_Numbers_BinNums_Zneg_args : ident := $"get_Coq_Numbers_BinNums_Zneg_args".
Definition _get_Coq_Numbers_BinNums_Zpos_args : ident := $"get_Coq_Numbers_BinNums_Zpos_args".
Definition _get_Coq_Numbers_BinNums_positive_tag : ident := $"get_Coq_Numbers_BinNums_positive_tag".
Definition _get_Coq_Numbers_BinNums_xI_args : ident := $"get_Coq_Numbers_BinNums_xI_args".
Definition _get_Coq_Numbers_BinNums_xO_args : ident := $"get_Coq_Numbers_BinNums_xO_args".
Definition _heap : ident := $"heap".
Definition _i : ident := $"i".
Definition _limit : ident := $"limit".
Definition _main : ident := $"main".
Definition _make_Coq_Numbers_BinNums_Z_Z0 : ident := $"make_Coq_Numbers_BinNums_Z_Z0".
Definition _make_Coq_Numbers_BinNums_positive_xH : ident := $"make_Coq_Numbers_BinNums_positive_xH".
Definition _p : ident := $"p".
Definition _t : ident := $"t".
Definition _temp : ident := $"temp".
Definition _thread_info : ident := $"thread_info".
Definition _tinfo : ident := $"tinfo".
Definition _uint63_add : ident := $"uint63_add".
Definition _uint63_from_Z : ident := $"uint63_from_Z".
Definition _uint63_from_positive : ident := $"uint63_from_positive".
Definition _uint63_mul : ident := $"uint63_mul".
Definition _uint63_to_Z : ident := $"uint63_to_Z".
Definition _x : ident := $"x".
Definition _y : ident := $"y".
Definition _z : ident := $"z".
Definition _t'1 : ident := 128%positive.
Definition _t'2 : ident := 129%positive.
Definition _t'3 : ident := 130%positive.
Definition _t'4 : ident := 131%positive.
Definition _t'5 : ident := 132%positive.
Definition _t'6 : ident := 133%positive.
Definition _t'7 : ident := 134%positive.

Definition f_uint63_from_positive := {|
  fn_return := tlong;
  fn_callconv := cc_default;
  fn_params := ((_p, tlong) :: nil);
  fn_vars := nil;
  fn_temps := ((_t'5, tlong) ::
               (_t'4, (tptr (Tstruct _Coq_Numbers_BinNums_xO_args noattr))) ::
               (_t'3, tlong) ::
               (_t'2, (tptr (Tstruct _Coq_Numbers_BinNums_xI_args noattr))) ::
               (_t'1, tuint) :: (_t'7, tulong) :: (_t'6, tulong) :: nil);
  fn_body :=
(Ssequence
  (Scall (Some _t'1)
    (Evar _get_Coq_Numbers_BinNums_positive_tag (Tfunction
                                                  (Tcons tulong Tnil) tuint
                                                  cc_default))
    ((Etempvar _p tlong) :: nil))
  (Sswitch (Etempvar _t'1 tuint)
    (LScons (Some 0)
      (Ssequence
        (Ssequence
          (Scall (Some _t'2)
            (Evar _get_Coq_Numbers_BinNums_xI_args (Tfunction
                                                     (Tcons tulong Tnil)
                                                     (tptr (Tstruct _Coq_Numbers_BinNums_xI_args noattr))
                                                     cc_default))
            ((Etempvar _p tlong) :: nil))
          (Ssequence
            (Sset _t'7
              (Efield
                (Ederef
                  (Etempvar _t'2 (tptr (Tstruct _Coq_Numbers_BinNums_xI_args noattr)))
                  (Tstruct _Coq_Numbers_BinNums_xI_args noattr))
                _Coq_Numbers_BinNums_xI_arg_0 tulong))
            (Scall (Some _t'3)
              (Evar _uint63_from_positive (Tfunction (Tcons tlong Tnil) tlong
                                            cc_default))
              ((Etempvar _t'7 tulong) :: nil))))
        (Sreturn (Some (Ebinop Oadd
                         (Ebinop Oshl
                           (Ebinop Oadd
                             (Ebinop Omul (Econst_int (Int.repr 2) tint)
                               (Ebinop Oshr (Etempvar _t'3 tlong)
                                 (Econst_int (Int.repr 1) tint) tlong) tlong)
                             (Econst_int (Int.repr 1) tint) tlong)
                           (Econst_int (Int.repr 1) tint) tlong)
                         (Econst_int (Int.repr 1) tint) tlong))))
      (LScons (Some 1)
        (Ssequence
          (Ssequence
            (Scall (Some _t'4)
              (Evar _get_Coq_Numbers_BinNums_xO_args (Tfunction
                                                       (Tcons tulong Tnil)
                                                       (tptr (Tstruct _Coq_Numbers_BinNums_xO_args noattr))
                                                       cc_default))
              ((Etempvar _p tlong) :: nil))
            (Ssequence
              (Sset _t'6
                (Efield
                  (Ederef
                    (Etempvar _t'4 (tptr (Tstruct _Coq_Numbers_BinNums_xO_args noattr)))
                    (Tstruct _Coq_Numbers_BinNums_xO_args noattr))
                  _Coq_Numbers_BinNums_xO_arg_0 tulong))
              (Scall (Some _t'5)
                (Evar _uint63_from_positive (Tfunction (Tcons tlong Tnil)
                                              tlong cc_default))
                ((Etempvar _t'6 tulong) :: nil))))
          (Sreturn (Some (Ebinop Oadd
                           (Ebinop Oshl
                             (Ebinop Omul (Econst_int (Int.repr 2) tint)
                               (Ebinop Oshr (Etempvar _t'5 tlong)
                                 (Econst_int (Int.repr 1) tint) tlong) tlong)
                             (Econst_int (Int.repr 1) tint) tlong)
                           (Econst_int (Int.repr 1) tint) tlong))))
        (LScons (Some 2)
          (Sreturn (Some (Ebinop Oadd
                           (Ebinop Oshl (Econst_int (Int.repr 1) tint)
                             (Econst_int (Int.repr 1) tint) tint)
                           (Econst_int (Int.repr 1) tint) tint)))
          LSnil)))))
|}.

Definition f_uint63_from_Z := {|
  fn_return := tlong;
  fn_callconv := cc_default;
  fn_params := ((_z, tlong) :: nil);
  fn_vars := nil;
  fn_temps := ((_t'5, tlong) ::
               (_t'4, (tptr (Tstruct _Coq_Numbers_BinNums_Zneg_args noattr))) ::
               (_t'3, tlong) ::
               (_t'2, (tptr (Tstruct _Coq_Numbers_BinNums_Zpos_args noattr))) ::
               (_t'1, tuint) :: (_t'7, tulong) :: (_t'6, tulong) :: nil);
  fn_body :=
(Ssequence
  (Scall (Some _t'1)
    (Evar _get_Coq_Numbers_BinNums_Z_tag (Tfunction (Tcons tulong Tnil) tuint
                                           cc_default))
    ((Etempvar _z tlong) :: nil))
  (Sswitch (Etempvar _t'1 tuint)
    (LScons (Some 0)
      (Sreturn (Some (Econst_int (Int.repr 0) tint)))
      (LScons (Some 1)
        (Ssequence
          (Ssequence
            (Scall (Some _t'2)
              (Evar _get_Coq_Numbers_BinNums_Zpos_args (Tfunction
                                                         (Tcons tulong Tnil)
                                                         (tptr (Tstruct _Coq_Numbers_BinNums_Zpos_args noattr))
                                                         cc_default))
              ((Etempvar _z tlong) :: nil))
            (Ssequence
              (Sset _t'7
                (Efield
                  (Ederef
                    (Etempvar _t'2 (tptr (Tstruct _Coq_Numbers_BinNums_Zpos_args noattr)))
                    (Tstruct _Coq_Numbers_BinNums_Zpos_args noattr))
                  _Coq_Numbers_BinNums_Zpos_arg_0 tulong))
              (Scall (Some _t'3)
                (Evar _uint63_from_positive (Tfunction (Tcons tlong Tnil)
                                              tlong cc_default))
                ((Etempvar _t'7 tulong) :: nil))))
          (Sreturn (Some (Etempvar _t'3 tlong))))
        (LScons (Some 2)
          (Ssequence
            (Ssequence
              (Scall (Some _t'4)
                (Evar _get_Coq_Numbers_BinNums_Zneg_args (Tfunction
                                                           (Tcons tulong
                                                             Tnil)
                                                           (tptr (Tstruct _Coq_Numbers_BinNums_Zneg_args noattr))
                                                           cc_default))
                ((Etempvar _z tlong) :: nil))
              (Ssequence
                (Sset _t'6
                  (Efield
                    (Ederef
                      (Etempvar _t'4 (tptr (Tstruct _Coq_Numbers_BinNums_Zneg_args noattr)))
                      (Tstruct _Coq_Numbers_BinNums_Zneg_args noattr))
                    _Coq_Numbers_BinNums_Zneg_arg_0 tulong))
                (Scall (Some _t'5)
                  (Evar _uint63_from_positive (Tfunction (Tcons tlong Tnil)
                                                tlong cc_default))
                  ((Etempvar _t'6 tulong) :: nil))))
            (Sreturn (Some (Eunop Oneg (Etempvar _t'5 tlong) tlong))))
          LSnil)))))
|}.

Definition f_uint63_to_Z := {|
  fn_return := tlong;
  fn_callconv := cc_default;
  fn_params := ((_tinfo, (tptr (Tstruct _thread_info noattr))) ::
                (_t, tlong) :: nil);
  fn_vars := nil;
  fn_temps := ((_temp, tlong) :: (_i, tuint) :: (_bit, tbool) ::
               (_t'5, tulong) :: (_t'4, tulong) :: (_t'3, tulong) ::
               (_t'2, tulong) :: (_t'1, tulong) :: nil);
  fn_body :=
(Ssequence
  (Sifthenelse (Ebinop Oeq (Etempvar _t tlong) (Econst_int (Int.repr 1) tint)
                 tint)
    (Ssequence
      (Scall (Some _t'1)
        (Evar _make_Coq_Numbers_BinNums_Z_Z0 (Tfunction Tnil tulong
                                               cc_default)) nil)
      (Sreturn (Some (Etempvar _t'1 tulong))))
    Sskip)
  (Ssequence
    (Sset _temp (Ecast (Econst_int (Int.repr 0) tint) tlong))
    (Ssequence
      (Ssequence
        (Sset _i
          (Ecast
            (Ebinop Osub
              (Ebinop Omul (Esizeof tlong tulong)
                (Econst_int (Int.repr 8) tint) tulong)
              (Econst_int (Int.repr 1) tint) tulong) tuint))
        (Sloop
          (Ssequence
            (Sifthenelse (Ebinop Ogt (Etempvar _i tuint)
                           (Econst_int (Int.repr 0) tint) tint)
              Sskip
              Sbreak)
            (Ssequence
              (Sset _bit
                (Ecast
                  (Ebinop Oshr
                    (Ebinop Oand (Etempvar _t tlong)
                      (Ebinop Oshl (Econst_int (Int.repr 1) tint)
                        (Etempvar _i tuint) tint) tlong) (Etempvar _i tuint)
                    tlong) tbool))
              (Sifthenelse (Etempvar _bit tbool)
                (Sifthenelse (Etempvar _temp tlong)
                  (Ssequence
                    (Scall (Some _t'2)
                      (Evar _alloc_make_Coq_Numbers_BinNums_positive_xI
                      (Tfunction
                        (Tcons (tptr (Tstruct _thread_info noattr))
                          (Tcons tulong Tnil)) tulong cc_default))
                      ((Etempvar _tinfo (tptr (Tstruct _thread_info noattr))) ::
                       (Etempvar _temp tlong) :: nil))
                    (Sset _temp (Etempvar _t'2 tulong)))
                  (Ssequence
                    (Scall (Some _t'3)
                      (Evar _make_Coq_Numbers_BinNums_positive_xH (Tfunction
                                                                    Tnil
                                                                    tulong
                                                                    cc_default))
                      nil)
                    (Sset _temp (Etempvar _t'3 tulong))))
                (Sifthenelse (Etempvar _temp tlong)
                  (Ssequence
                    (Scall (Some _t'4)
                      (Evar _alloc_make_Coq_Numbers_BinNums_positive_xO
                      (Tfunction
                        (Tcons (tptr (Tstruct _thread_info noattr))
                          (Tcons tulong Tnil)) tulong cc_default))
                      ((Etempvar _tinfo (tptr (Tstruct _thread_info noattr))) ::
                       (Etempvar _temp tlong) :: nil))
                    (Sset _temp (Etempvar _t'4 tulong)))
                  Sskip))))
          (Sset _i
            (Ebinop Osub (Etempvar _i tuint) (Econst_int (Int.repr 1) tint)
              tuint))))
      (Ssequence
        (Scall (Some _t'5)
          (Evar _alloc_make_Coq_Numbers_BinNums_Z_Zpos (Tfunction
                                                         (Tcons
                                                           (tptr (Tstruct _thread_info noattr))
                                                           (Tcons tulong
                                                             Tnil)) tulong
                                                         cc_default))
          ((Etempvar _tinfo (tptr (Tstruct _thread_info noattr))) ::
           (Etempvar _temp tlong) :: nil))
        (Sreturn (Some (Etempvar _t'5 tulong)))))))
|}.

Definition f_uint63_add := {|
  fn_return := tlong;
  fn_callconv := cc_default;
  fn_params := ((_x, tlong) :: (_y, tlong) :: nil);
  fn_vars := nil;
  fn_temps := nil;
  fn_body :=
(Sreturn (Some (Ebinop Oadd
                 (Ebinop Oshl
                   (Ebinop Oadd
                     (Ebinop Oshr (Etempvar _x tlong)
                       (Econst_int (Int.repr 1) tint) tlong)
                     (Ebinop Oshr (Etempvar _y tlong)
                       (Econst_int (Int.repr 1) tint) tlong) tlong)
                   (Econst_int (Int.repr 1) tint) tlong)
                 (Econst_int (Int.repr 1) tint) tlong)))
|}.

Definition f_uint63_mul := {|
  fn_return := tlong;
  fn_callconv := cc_default;
  fn_params := ((_x, tlong) :: (_y, tlong) :: nil);
  fn_vars := nil;
  fn_temps := nil;
  fn_body :=
(Sreturn (Some (Ebinop Oadd
                 (Ebinop Oshl
                   (Ebinop Omul
                     (Ebinop Oshr (Etempvar _x tlong)
                       (Econst_int (Int.repr 1) tint) tlong)
                     (Ebinop Oshr (Etempvar _y tlong)
                       (Econst_int (Int.repr 1) tint) tlong) tlong)
                   (Econst_int (Int.repr 1) tint) tlong)
                 (Econst_int (Int.repr 1) tint) tlong)))
|}.

Definition composites : list composite_definition :=
(Composite _thread_info Struct
   (Member_plain _alloc (tptr tulong) :: Member_plain _limit (tptr tulong) ::
    Member_plain _heap (tptr (Tstruct _heap noattr)) ::
    Member_plain _args (tarray tulong 1024) :: nil)
   noattr ::
 Composite _Coq_Numbers_BinNums_xI_args Struct
   (Member_plain _Coq_Numbers_BinNums_xI_arg_0 tulong :: nil)
   noattr ::
 Composite _Coq_Numbers_BinNums_xO_args Struct
   (Member_plain _Coq_Numbers_BinNums_xO_arg_0 tulong :: nil)
   noattr ::
 Composite _Coq_Numbers_BinNums_Zpos_args Struct
   (Member_plain _Coq_Numbers_BinNums_Zpos_arg_0 tulong :: nil)
   noattr ::
 Composite _Coq_Numbers_BinNums_Zneg_args Struct
   (Member_plain _Coq_Numbers_BinNums_Zneg_arg_0 tulong :: nil)
   noattr :: nil).

Definition global_definitions : list (ident * globdef fundef type) :=
((___compcert_va_int32,
   Gfun(External (EF_runtime "__compcert_va_int32"
                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
     (Tcons (tptr tvoid) Tnil) tuint cc_default)) ::
 (___compcert_va_int64,
   Gfun(External (EF_runtime "__compcert_va_int64"
                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
     (Tcons (tptr tvoid) Tnil) tulong cc_default)) ::
 (___compcert_va_float64,
   Gfun(External (EF_runtime "__compcert_va_float64"
                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
     (Tcons (tptr tvoid) Tnil) tdouble cc_default)) ::
 (___compcert_va_composite,
   Gfun(External (EF_runtime "__compcert_va_composite"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default)) (Tcons (tptr tvoid) (Tcons tulong Tnil))
     (tptr tvoid) cc_default)) ::
 (___compcert_i64_dtos,
   Gfun(External (EF_runtime "__compcert_i64_dtos"
                   (mksignature (AST.Tfloat :: nil) AST.Tlong cc_default))
     (Tcons tdouble Tnil) tlong cc_default)) ::
 (___compcert_i64_dtou,
   Gfun(External (EF_runtime "__compcert_i64_dtou"
                   (mksignature (AST.Tfloat :: nil) AST.Tlong cc_default))
     (Tcons tdouble Tnil) tulong cc_default)) ::
 (___compcert_i64_stod,
   Gfun(External (EF_runtime "__compcert_i64_stod"
                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
     (Tcons tlong Tnil) tdouble cc_default)) ::
 (___compcert_i64_utod,
   Gfun(External (EF_runtime "__compcert_i64_utod"
                   (mksignature (AST.Tlong :: nil) AST.Tfloat cc_default))
     (Tcons tulong Tnil) tdouble cc_default)) ::
 (___compcert_i64_stof,
   Gfun(External (EF_runtime "__compcert_i64_stof"
                   (mksignature (AST.Tlong :: nil) AST.Tsingle cc_default))
     (Tcons tlong Tnil) tfloat cc_default)) ::
 (___compcert_i64_utof,
   Gfun(External (EF_runtime "__compcert_i64_utof"
                   (mksignature (AST.Tlong :: nil) AST.Tsingle cc_default))
     (Tcons tulong Tnil) tfloat cc_default)) ::
 (___compcert_i64_sdiv,
   Gfun(External (EF_runtime "__compcert_i64_sdiv"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
     cc_default)) ::
 (___compcert_i64_udiv,
   Gfun(External (EF_runtime "__compcert_i64_udiv"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
     cc_default)) ::
 (___compcert_i64_smod,
   Gfun(External (EF_runtime "__compcert_i64_smod"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
     cc_default)) ::
 (___compcert_i64_umod,
   Gfun(External (EF_runtime "__compcert_i64_umod"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
     cc_default)) ::
 (___compcert_i64_shl,
   Gfun(External (EF_runtime "__compcert_i64_shl"
                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
                     cc_default)) (Tcons tlong (Tcons tint Tnil)) tlong
     cc_default)) ::
 (___compcert_i64_shr,
   Gfun(External (EF_runtime "__compcert_i64_shr"
                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
                     cc_default)) (Tcons tulong (Tcons tint Tnil)) tulong
     cc_default)) ::
 (___compcert_i64_sar,
   Gfun(External (EF_runtime "__compcert_i64_sar"
                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tlong
                     cc_default)) (Tcons tlong (Tcons tint Tnil)) tlong
     cc_default)) ::
 (___compcert_i64_smulh,
   Gfun(External (EF_runtime "__compcert_i64_smulh"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
     cc_default)) ::
 (___compcert_i64_umulh,
   Gfun(External (EF_runtime "__compcert_i64_umulh"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default)) (Tcons tulong (Tcons tulong Tnil)) tulong
     cc_default)) ::
 (___builtin_ais_annot,
   Gfun(External (EF_builtin "__builtin_ais_annot"
                   (mksignature (AST.Tlong :: nil) AST.Tvoid
                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
     (Tcons (tptr tschar) Tnil) tvoid
     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
 (___builtin_bswap64,
   Gfun(External (EF_builtin "__builtin_bswap64"
                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
     (Tcons tulong Tnil) tulong cc_default)) ::
 (___builtin_bswap,
   Gfun(External (EF_builtin "__builtin_bswap"
                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
     (Tcons tuint Tnil) tuint cc_default)) ::
 (___builtin_bswap32,
   Gfun(External (EF_builtin "__builtin_bswap32"
                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
     (Tcons tuint Tnil) tuint cc_default)) ::
 (___builtin_bswap16,
   Gfun(External (EF_builtin "__builtin_bswap16"
                   (mksignature (AST.Tint :: nil) AST.Tint16unsigned
                     cc_default)) (Tcons tushort Tnil) tushort cc_default)) ::
 (___builtin_clz,
   Gfun(External (EF_builtin "__builtin_clz"
                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
     (Tcons tuint Tnil) tint cc_default)) ::
 (___builtin_clzl,
   Gfun(External (EF_builtin "__builtin_clzl"
                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
     (Tcons tulong Tnil) tint cc_default)) ::
 (___builtin_clzll,
   Gfun(External (EF_builtin "__builtin_clzll"
                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
     (Tcons tulong Tnil) tint cc_default)) ::
 (___builtin_ctz,
   Gfun(External (EF_builtin "__builtin_ctz"
                   (mksignature (AST.Tint :: nil) AST.Tint cc_default))
     (Tcons tuint Tnil) tint cc_default)) ::
 (___builtin_ctzl,
   Gfun(External (EF_builtin "__builtin_ctzl"
                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
     (Tcons tulong Tnil) tint cc_default)) ::
 (___builtin_ctzll,
   Gfun(External (EF_builtin "__builtin_ctzll"
                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
     (Tcons tulong Tnil) tint cc_default)) ::
 (___builtin_fabs,
   Gfun(External (EF_builtin "__builtin_fabs"
                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
     (Tcons tdouble Tnil) tdouble cc_default)) ::
 (___builtin_fabsf,
   Gfun(External (EF_builtin "__builtin_fabsf"
                   (mksignature (AST.Tsingle :: nil) AST.Tsingle cc_default))
     (Tcons tfloat Tnil) tfloat cc_default)) ::
 (___builtin_fsqrt,
   Gfun(External (EF_builtin "__builtin_fsqrt"
                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
     (Tcons tdouble Tnil) tdouble cc_default)) ::
 (___builtin_sqrt,
   Gfun(External (EF_builtin "__builtin_sqrt"
                   (mksignature (AST.Tfloat :: nil) AST.Tfloat cc_default))
     (Tcons tdouble Tnil) tdouble cc_default)) ::
 (___builtin_memcpy_aligned,
   Gfun(External (EF_builtin "__builtin_memcpy_aligned"
                   (mksignature
                     (AST.Tlong :: AST.Tlong :: AST.Tlong :: AST.Tlong ::
                      nil) AST.Tvoid cc_default))
     (Tcons (tptr tvoid)
       (Tcons (tptr tvoid) (Tcons tulong (Tcons tulong Tnil)))) tvoid
     cc_default)) ::
 (___builtin_sel,
   Gfun(External (EF_builtin "__builtin_sel"
                   (mksignature (AST.Tint :: nil) AST.Tvoid
                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
     (Tcons tbool Tnil) tvoid
     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
 (___builtin_annot,
   Gfun(External (EF_builtin "__builtin_annot"
                   (mksignature (AST.Tlong :: nil) AST.Tvoid
                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
     (Tcons (tptr tschar) Tnil) tvoid
     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
 (___builtin_annot_intval,
   Gfun(External (EF_builtin "__builtin_annot_intval"
                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tint
                     cc_default)) (Tcons (tptr tschar) (Tcons tint Tnil))
     tint cc_default)) ::
 (___builtin_membar,
   Gfun(External (EF_builtin "__builtin_membar"
                   (mksignature nil AST.Tvoid cc_default)) Tnil tvoid
     cc_default)) ::
 (___builtin_va_start,
   Gfun(External (EF_builtin "__builtin_va_start"
                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
 (___builtin_va_arg,
   Gfun(External (EF_builtin "__builtin_va_arg"
                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
                     cc_default)) (Tcons (tptr tvoid) (Tcons tuint Tnil))
     tvoid cc_default)) ::
 (___builtin_va_copy,
   Gfun(External (EF_builtin "__builtin_va_copy"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tvoid
                     cc_default))
     (Tcons (tptr tvoid) (Tcons (tptr tvoid) Tnil)) tvoid cc_default)) ::
 (___builtin_va_end,
   Gfun(External (EF_builtin "__builtin_va_end"
                   (mksignature (AST.Tlong :: nil) AST.Tvoid cc_default))
     (Tcons (tptr tvoid) Tnil) tvoid cc_default)) ::
 (___builtin_unreachable,
   Gfun(External (EF_builtin "__builtin_unreachable"
                   (mksignature nil AST.Tvoid cc_default)) Tnil tvoid
     cc_default)) ::
 (___builtin_expect,
   Gfun(External (EF_builtin "__builtin_expect"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default)) (Tcons tlong (Tcons tlong Tnil)) tlong
     cc_default)) ::
 (___builtin_fmax,
   Gfun(External (EF_builtin "__builtin_fmax"
                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil) AST.Tfloat
                     cc_default)) (Tcons tdouble (Tcons tdouble Tnil))
     tdouble cc_default)) ::
 (___builtin_fmin,
   Gfun(External (EF_builtin "__builtin_fmin"
                   (mksignature (AST.Tfloat :: AST.Tfloat :: nil) AST.Tfloat
                     cc_default)) (Tcons tdouble (Tcons tdouble Tnil))
     tdouble cc_default)) ::
 (___builtin_fmadd,
   Gfun(External (EF_builtin "__builtin_fmadd"
                   (mksignature
                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
                     AST.Tfloat cc_default))
     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
     cc_default)) ::
 (___builtin_fmsub,
   Gfun(External (EF_builtin "__builtin_fmsub"
                   (mksignature
                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
                     AST.Tfloat cc_default))
     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
     cc_default)) ::
 (___builtin_fnmadd,
   Gfun(External (EF_builtin "__builtin_fnmadd"
                   (mksignature
                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
                     AST.Tfloat cc_default))
     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
     cc_default)) ::
 (___builtin_fnmsub,
   Gfun(External (EF_builtin "__builtin_fnmsub"
                   (mksignature
                     (AST.Tfloat :: AST.Tfloat :: AST.Tfloat :: nil)
                     AST.Tfloat cc_default))
     (Tcons tdouble (Tcons tdouble (Tcons tdouble Tnil))) tdouble
     cc_default)) ::
 (___builtin_read16_reversed,
   Gfun(External (EF_builtin "__builtin_read16_reversed"
                   (mksignature (AST.Tlong :: nil) AST.Tint16unsigned
                     cc_default)) (Tcons (tptr tushort) Tnil) tushort
     cc_default)) ::
 (___builtin_read32_reversed,
   Gfun(External (EF_builtin "__builtin_read32_reversed"
                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
     (Tcons (tptr tuint) Tnil) tuint cc_default)) ::
 (___builtin_write16_reversed,
   Gfun(External (EF_builtin "__builtin_write16_reversed"
                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
                     cc_default)) (Tcons (tptr tushort) (Tcons tushort Tnil))
     tvoid cc_default)) ::
 (___builtin_write32_reversed,
   Gfun(External (EF_builtin "__builtin_write32_reversed"
                   (mksignature (AST.Tlong :: AST.Tint :: nil) AST.Tvoid
                     cc_default)) (Tcons (tptr tuint) (Tcons tuint Tnil))
     tvoid cc_default)) ::
 (___builtin_debug,
   Gfun(External (EF_external "__builtin_debug"
                   (mksignature (AST.Tint :: nil) AST.Tvoid
                     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|}))
     (Tcons tint Tnil) tvoid
     {|cc_vararg:=(Some 1); cc_unproto:=false; cc_structret:=false|})) ::
 (_alloc_make_Coq_Numbers_BinNums_positive_xI,
   Gfun(External (EF_external "alloc_make_Coq_Numbers_BinNums_positive_xI"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default))
     (Tcons (tptr (Tstruct _thread_info noattr)) (Tcons tulong Tnil)) tulong
     cc_default)) ::
 (_alloc_make_Coq_Numbers_BinNums_positive_xO,
   Gfun(External (EF_external "alloc_make_Coq_Numbers_BinNums_positive_xO"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default))
     (Tcons (tptr (Tstruct _thread_info noattr)) (Tcons tulong Tnil)) tulong
     cc_default)) ::
 (_make_Coq_Numbers_BinNums_positive_xH,
   Gfun(External (EF_external "make_Coq_Numbers_BinNums_positive_xH"
                   (mksignature nil AST.Tlong cc_default)) Tnil tulong
     cc_default)) ::
 (_make_Coq_Numbers_BinNums_Z_Z0,
   Gfun(External (EF_external "make_Coq_Numbers_BinNums_Z_Z0"
                   (mksignature nil AST.Tlong cc_default)) Tnil tulong
     cc_default)) ::
 (_alloc_make_Coq_Numbers_BinNums_Z_Zpos,
   Gfun(External (EF_external "alloc_make_Coq_Numbers_BinNums_Z_Zpos"
                   (mksignature (AST.Tlong :: AST.Tlong :: nil) AST.Tlong
                     cc_default))
     (Tcons (tptr (Tstruct _thread_info noattr)) (Tcons tulong Tnil)) tulong
     cc_default)) ::
 (_get_Coq_Numbers_BinNums_positive_tag,
   Gfun(External (EF_external "get_Coq_Numbers_BinNums_positive_tag"
                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
     (Tcons tulong Tnil) tuint cc_default)) ::
 (_get_Coq_Numbers_BinNums_Z_tag,
   Gfun(External (EF_external "get_Coq_Numbers_BinNums_Z_tag"
                   (mksignature (AST.Tlong :: nil) AST.Tint cc_default))
     (Tcons tulong Tnil) tuint cc_default)) ::
 (_get_Coq_Numbers_BinNums_xI_args,
   Gfun(External (EF_external "get_Coq_Numbers_BinNums_xI_args"
                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
     (Tcons tulong Tnil) (tptr (Tstruct _Coq_Numbers_BinNums_xI_args noattr))
     cc_default)) ::
 (_get_Coq_Numbers_BinNums_xO_args,
   Gfun(External (EF_external "get_Coq_Numbers_BinNums_xO_args"
                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
     (Tcons tulong Tnil) (tptr (Tstruct _Coq_Numbers_BinNums_xO_args noattr))
     cc_default)) ::
 (_get_Coq_Numbers_BinNums_Zpos_args,
   Gfun(External (EF_external "get_Coq_Numbers_BinNums_Zpos_args"
                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
     (Tcons tulong Tnil)
     (tptr (Tstruct _Coq_Numbers_BinNums_Zpos_args noattr)) cc_default)) ::
 (_get_Coq_Numbers_BinNums_Zneg_args,
   Gfun(External (EF_external "get_Coq_Numbers_BinNums_Zneg_args"
                   (mksignature (AST.Tlong :: nil) AST.Tlong cc_default))
     (Tcons tulong Tnil)
     (tptr (Tstruct _Coq_Numbers_BinNums_Zneg_args noattr)) cc_default)) ::
 (_uint63_from_positive, Gfun(Internal f_uint63_from_positive)) ::
 (_uint63_from_Z, Gfun(Internal f_uint63_from_Z)) ::
 (_uint63_to_Z, Gfun(Internal f_uint63_to_Z)) ::
 (_uint63_add, Gfun(Internal f_uint63_add)) ::
 (_uint63_mul, Gfun(Internal f_uint63_mul)) :: nil).

Definition public_idents : list ident :=
(_uint63_mul :: _uint63_add :: _uint63_to_Z :: _uint63_from_Z ::
 _uint63_from_positive :: _get_Coq_Numbers_BinNums_Zneg_args ::
 _get_Coq_Numbers_BinNums_Zpos_args :: _get_Coq_Numbers_BinNums_xO_args ::
 _get_Coq_Numbers_BinNums_xI_args :: _get_Coq_Numbers_BinNums_Z_tag ::
 _get_Coq_Numbers_BinNums_positive_tag ::
 _alloc_make_Coq_Numbers_BinNums_Z_Zpos :: _make_Coq_Numbers_BinNums_Z_Z0 ::
 _make_Coq_Numbers_BinNums_positive_xH ::
 _alloc_make_Coq_Numbers_BinNums_positive_xO ::
 _alloc_make_Coq_Numbers_BinNums_positive_xI :: ___builtin_debug ::
 ___builtin_write32_reversed :: ___builtin_write16_reversed ::
 ___builtin_read32_reversed :: ___builtin_read16_reversed ::
 ___builtin_fnmsub :: ___builtin_fnmadd :: ___builtin_fmsub ::
 ___builtin_fmadd :: ___builtin_fmin :: ___builtin_fmax ::
 ___builtin_expect :: ___builtin_unreachable :: ___builtin_va_end ::
 ___builtin_va_copy :: ___builtin_va_arg :: ___builtin_va_start ::
 ___builtin_membar :: ___builtin_annot_intval :: ___builtin_annot ::
 ___builtin_sel :: ___builtin_memcpy_aligned :: ___builtin_sqrt ::
 ___builtin_fsqrt :: ___builtin_fabsf :: ___builtin_fabs ::
 ___builtin_ctzll :: ___builtin_ctzl :: ___builtin_ctz :: ___builtin_clzll ::
 ___builtin_clzl :: ___builtin_clz :: ___builtin_bswap16 ::
 ___builtin_bswap32 :: ___builtin_bswap :: ___builtin_bswap64 ::
 ___builtin_ais_annot :: ___compcert_i64_umulh :: ___compcert_i64_smulh ::
 ___compcert_i64_sar :: ___compcert_i64_shr :: ___compcert_i64_shl ::
 ___compcert_i64_umod :: ___compcert_i64_smod :: ___compcert_i64_udiv ::
 ___compcert_i64_sdiv :: ___compcert_i64_utof :: ___compcert_i64_stof ::
 ___compcert_i64_utod :: ___compcert_i64_stod :: ___compcert_i64_dtou ::
 ___compcert_i64_dtos :: ___compcert_va_composite ::
 ___compcert_va_float64 :: ___compcert_va_int64 :: ___compcert_va_int32 ::
 nil).

Definition prog : Clight.program :=
  mkprogram composites global_definitions public_idents _main Logic.I.