Set Implicit Arguments.
Unset Strict Implicit.

Require Import configuration actor.

Inductive Step (Id : Set) :=
| receive : Id -> Id -> Ide -> Step Id
| send : Id -> Id -> Ide -> Step Id
| create : Id -> Id -> Step Id.

Inductive TP (Id LS : Set) :=
| Initial : TP Id LS
| then' : TP Id LS -> Step Id -> TP Id LS.

Notation "tp 'then' step" := (then' tp step)  (at level 0).

Parameter config : forall Id LS : Set, TP Id LS -> Cfg (Actor Id LS).
Axiom ready_to : forall Id LS : Set, LS -> Step Id -> Prop. (* ? *)
Parameter next : forall Id LS : Set, LS -> Step Id -> LS.
Parameter new_ls : forall LS : Set, LS -> LS.

Inductive before {Id LS : Set} (T : TP Id LS) (s : Cfg (Actor Id LS)) (ls : LS) : Step Id -> Prop :=
| before_receiving : forall id fr c,
                       config T = s ++ (actor id ls) ++ (message fr id c) ->
                       ready_to ls (receive id fr c) ->
                       before T s ls (receive id fr c)
| before_sending : forall id to c,
                     config T = s ++ (actor id ls) ->
                     ready_to ls (send id to c) ->
                     before T s ls (send id to c)
| before_creating : forall id id',
                      config T = s ++ (actor id ls) ->
                      unique_ids ((config T) ++ (actor id' (new_ls ls))) ->
                      ready_to ls (create id id') ->
                      before T s ls (create id id').

Inductive after {Id LS : Set} (T : TP Id LS) (s : Cfg (Actor Id LS)) (ls : LS) : Step Id -> Prop :=
| after_receiving : forall id fr c,
                      config (T then (receive id fr c)) =
                      s ++ (actor id (next ls (receive id fr c))) ->
                      after T s ls (receive id fr c)
| after_sending : forall id to c,
                    config (T then (send id to c)) =
                    s ++ (actor id (next ls (send id to c))) ++ (message id to c) ->
                    after T s ls (send id to c)
| after_creating : forall id id',
                     config (T then (create id id')) =
                     s ++ (actor id (next ls (create id id'))) ++ (actor id' (new_ls ls)) ->
                     after T s ls (create id id').

Local Arguments before : clear implicits.
Local Arguments after : clear implicits.
Axiom transition_step : forall Id LS T s ls step,
                          before Id LS T s ls step ->
                          after Id LS T s ls step.

Lemma trans_receive : forall Id LS T (id : Id) s (ls : LS) fr c,
                        config T = s ++
                                     (actor id ls) ++
                                     (message fr id c) /\
                        ready_to ls (receive id fr c) ->
                        config (then' T (receive id fr c)) =
                        s ++ (actor id (next ls (receive id fr c))).
Proof.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas32_2e450m2e225m1_20limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition carry :
  { carry : feBW_loose -> feBW_tight
  | forall a, phiBW_tight (carry a) = (phiBW_loose a) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_carry ().
  Show Ltac Profile.
Time Defined.

Print Assumptions carry.


Require Import Utf8.

(** * Intensional Type Theory with Guarded Recursive Types qua Fixed Points on Universes *)

(** ** Syntactic Motivation *)
(** *** II.A: Fixed Points on Universes *)
Inductive later (T: Type) : Type :=
  next : T -> later T.
Arguments next [T] _.
Notation "▸ T" := (later T) (at level 50). (* \blacktriangleright *)
Definition lapp {A B:Type} (t : ▸(A->B)) (u : ▸A) : ▸B :=
  match t,u with
  | next t', next u' => next (t' u')
  end.
Notation "t ⊛ u" := (lapp t u) (at level 49). (* \circledast *)

(** Verify the paper's definitional equalities *)
Definition nd_compose {A B C:Type} (f:B->C) (g:A->B) : A -> C :=
  λ a, f (g a).
Notation "f ∘ g" := (nd_compose f g) (at level 55).
Lemma next_id : forall (T:Type) u, next (λ (x:T), x) ⊛ u = u.
Proof. intros. destruct u. simpl. reflexivity. Qed.
Lemma next_compose : forall (A B C:Type) s t u,
                       next (@nd_compose A B C) ⊛ s ⊛ t ⊛ u = s ⊛ (t ⊛ u).
Proof. intros. destruct s; destruct t; destruct u. simpl. unfold nd_compose. reflexivity. Qed.
Lemma next_app : forall (A B :Type) (t:A->B) u,
                   next t ⊛ next u = next (t u).
Proof. intros. simpl. reflexivity. Qed.
Lemma next_right : forall (A B:Type) u (t:A),
                     u ⊛ next t = next (λ (g:A->B), g t) ⊛ u.
Proof. intros. destruct u. simpl. reflexivity. Qed.

(* Fixpoints *)
Axiom gfix : forall {A:Type}, ((▸A)->A) -> A.
Axiom gfix_red : forall {A:Type} (f:(▸A)->A),
                   gfix f = f (next (gfix f)).

Axiom grec : forall {U:Type}, (▸U -> U) -> U.
Notation "'μ' X , A" := (grec (fun X => A)) (at level 44).

Axiom tlater : forall {T:Type}, ▸ T -> T.
Notation "▹ T" := (tlater T) (at level 50). (* \triangleright *)
(** Guarding is enforced by requiring ▹ to force later versions *)

Open Scope type_scope.
Example Str : Type := μ X , nat * ▹ X.

(** ** II.B: Example: A domain equation using dependent types *)

Definition pfix {A B:Type} (t:((A->▸B)->A->B)) : A -> B :=
  gfix (λ (y:▸(A->B)), t (λ a, y ⊛ next a)).
Require Import Setoid.
Lemma pfix_red : forall {A B:Type} t,
                   @pfix A B t = t (λ y, next (pfix t y)).
Proof. intros. unfold pfix.
       rewrite gfix_red at 1. f_equal.
Qed.

Require Import Coq.Vectors.Fin.
Definition F X (n:nat) := (Fin.t n + ((▹ X n) * (▹ X n)) + (▹ X (plus n 1))).
Definition Lam (n:nat) : Type :=
  pfix (fun X => λ n, F X n) n.


Require Import Coq.Arith.Arith.
Require Import RamifyCoq.lib.Coqlib.
Require Import RamifyCoq.lib.EnumEnsembles.
Require Import RamifyCoq.lib.EquivDec_ext.
Require Import RamifyCoq.lib.List_ext.
Require Import RamifyCoq.graph.graph_model.
Require Import RamifyCoq.graph.path_lemmas.
Require Import RamifyCoq.graph.subgraph2.
Require Import RamifyCoq.graph.MathGraph.
Require Import RamifyCoq.graph.FiniteGraph.
Require Import RamifyCoq.graph.reachable_computable.
Require Import Coq.Lists.List.

Section LIST_MODEL.

  Context {Vertex: Type}.
  Context {Edge: Type}.
  Context {EV: EqDec Vertex eq}.
  Context {EE: EqDec Edge eq}.

  Variable G : PreGraph Vertex Edge.

  Definition is_list (x: Vertex) : Prop :=
    exists p, valid_path G p /\ forall y, reachable G x y -> exists (py: path), unique (fun pa => G |= pa is x ~o~> y satisfying (fun _ => True)) py /\ Subpath G py p.

  Definition graph_list_isomorphism (l: list Vertex) (root: Vertex) : Prop :=
    (forall s d, reachable G root s /\ reachable G root d /\ G |= s ~> d <-> exists l1 l2, l = l1 ++ s :: d :: l2) /\ (forall v, reachable G root v <-> In v l) /\ NoDup l.

  Context {is_null: DecidablePred Vertex}.
  Context {MA: MathGraph G is_null}.
  Context {LF: LocalFiniteGraph G}.

  Lemma list_expand_nil_or_single: forall root l r,
      vvalid G root -> is_list root -> l = @new_working_list _ _ is_null nil (map (dst G) (edge_func G root)) (root :: r) -> l = nil \/ (exists v, l = v :: nil /\ G |= root ~> v).
  Proof.
    intros. destruct l. 1: left; auto. destruct l.
    + right. exists v; split; auto. assert (In v (v :: nil)) by apply in_eq. rewrite H1 in H2. rewrite in_new_working_list in H2. destruct H2 as [? [? ?]].
      rewrite app_nil_l in H2. rewrite <- edge_func_step in H2. split; [|split]; auto. rewrite step_spec in H2. destruct H2 as [e [? [? ?]]].
      destruct (valid_graph G e H2) as [_ ?]. hnf in H7. rewrite H6 in H7. destruct H7; [exfalso |]; auto.
    + exfalso. destruct LF in H1. unfold edge_func in H1. simpl in H1. destruct (local_enumerable root) as [l' [? ?]].
      simpl in H1. unfold Ensembles.In in i. destruct H0 as [lf [? ?]].
      assert (forall v', In v' (v :: v0 :: l) -> reachable G root v'). {
        intros. rewrite H1 in H3. rewrite in_new_working_list in H3. rewrite app_nil_l in H3. destruct H3 as [? [? ?]].
        rewrite in_map_iff in H3. destruct H3 as [e [? ?]]. exists (root, e :: nil). split; split; simpl; auto.
        + rewrite i in H6. destruct H6. unfold strong_evalid. rewrite H7. rewrite H3. do 3 (split; auto).
          destruct (valid_graph G e H6) as [_ ?]. hnf in H8. rewrite H3 in H8. destruct H8; [exfalso | ]; auto.
        + hnf. rewrite Forall_forall. intros; auto.
      } unfold new_working_list in H1. symmetry in H1. apply filter_2_cons in H1. destruct H1 as [l1 [l2 [l3 [? [? [? [? [? ?]]]]]]]]. simpl in H1. apply map_2_mid in H1.
      destruct H1 as [y1 [y2 [m1 [m2 [m3 [? [? [? [? [? ?]]]]]]]]]]. rewrite H1 in n. apply NoDup_app_r in n. apply NoDup_cons_2 in n.
      assert (reachable G root v) by apply H3, in_eq. assert (reachable G root v0) by apply H3, in_cons, in_eq. apply H2 in H14. apply H2 in H15.
      destruct H14 as [pv [[? ?] ?]]. destruct H15 as [pv0 [[? ?] ?]].
      assert (G |= (root, y1 :: nil) is root ~o~> v satisfying (fun _ => True)). {
        split; split; intros; auto. 2: hnf; rewrite Forall_forall; intros; auto. simpl. unfold strong_evalid. rewrite H12.
        assert (In y1 l') by (rewrite H1; rewrite in_app_iff; right; apply in_eq). rewrite i in H20. destruct H20. rewrite H21.
        apply reachable_by_path_is_reachable in H14. apply reachable_foot_valid in H14. split; auto.
      } pose proof (H16 _ H20).
      assert (G |= (root, y2 :: nil) is root ~o~> v0 satisfying (fun _ => True)). {
        split; split; intros; auto. 2: hnf; rewrite Forall_forall; intros; auto. simpl. unfold strong_evalid. rewrite H13.
        assert (In y2 l') by (rewrite H1; rewrite in_app_iff; right; right; rewrite in_app_iff; right; apply in_eq). rewrite i in H22. destruct H22. rewrite H23.
        apply reachable_by_path_is_reachable in H15. apply reachable_foot_valid in H15. split; auto.
      } pose proof (H18 _ H22). apply n. rewrite in_app_iff. right.
      assert (In_path G v lf) by (apply (In_path_Subpath _ pv); auto; rewrite H21, <- H12; right; exists y1; simpl; tauto).
      assert (In_path G v0 lf) by (apply (In_path_Subpath _ pv0); auto; rewrite H23, <- H13; right; exists y2; simpl; tauto).
      pose proof (valid_path_reachable _ _ _ _ H0 H24 H25). destruct H26; destruct H26 as [[vl pl] ?].
      - assert (G |= (path_glue (root, y1 :: nil) (vl, pl)) is root ~o~> v0 satisfying (fun _ => True)) by (apply reachable_by_path_merge with v; auto).
        unfold path_glue, fst, snd in H27. rewrite <- app_comm_cons, app_nil_l in H27. apply H18 in H27. rewrite H23 in H27. inversion H27. apply in_eq.
      - assert (G |= (path_glue (root, y2 :: nil) (vl, pl)) is root ~o~> v satisfying (fun _ => True)) by (apply reachable_by_path_merge with v0; auto).
        unfold path_glue, fst, snd in H27. rewrite <- app_comm_cons, app_nil_l in H27. apply H16 in H27. rewrite H21 in H27. inversion H27. apply in_eq.
  Qed.

  (* Print Assumptions list_expand_nil_or_single. *)

  Definition list_composed_by_edges (l: list Vertex) : Prop := forall l1 l2 s d, l = l1 ++ s :: d :: l2 -> G |= s ~> d.

  Lemma list_composed_by_edges_nil: list_composed_by_edges nil.
  Proof. repeat intro. assert (@length Vertex nil = length (l1 ++ s :: d :: l2)) by (rewrite H; tauto). rewrite app_length in H0; simpl in H0. intuition. Qed.

  Lemma list_composed_by_edges_single: forall v, list_composed_by_edges (v :: nil).
  Proof.
    repeat intro. exfalso. assert (length (v :: nil) = length (l1 ++ s :: d :: l2)) by (rewrite H; tauto). rewrite app_length in H0. simpl in H0. intuition.
  Qed.

  Lemma lcbe_rev_cons: forall v l, list_composed_by_edges (rev (v :: l)) -> list_composed_by_edges (rev l).
  Proof.
    intros. rewrite <- (app_nil_l l), app_comm_cons, rev_app_distr in H. simpl in H. unfold list_composed_by_edges in *. intros.
    specialize (H l1 (l2 +:: v) s d). apply H. rewrite H0. rewrite <- app_assoc. simpl. auto.
  Qed.

  Lemma lcbe_rev_cons_inv: forall v root l, G |= root ~> v -> list_composed_by_edges (rev (root :: l)) -> list_composed_by_edges (rev (v :: root :: l)).
  Proof.
    intros. rewrite <- (app_nil_l (root :: l)), app_comm_cons, rev_app_distr. simpl rev at 2. unfold list_composed_by_edges in *. intros. destruct l2.
    + simpl in H1. rewrite <- (app_nil_l (d :: nil)), (app_comm_cons nil (d :: nil) s) in H1. rewrite app_assoc in H1.
      do 2 (apply app_inj_tail in H1; destruct H1). subst. auto.
    + assert (v0 :: l2 <> nil) by (intro; inversion H2). apply exists_last in H2. destruct H2 as [l' [a ?]]. rewrite e in H1.
      rewrite app_comm_cons, (app_comm_cons (d :: l') (a :: nil) s), app_assoc in H1. apply app_inj_tail in H1. destruct H1. apply (H0 l1 l'); auto.
  Qed.

  Lemma is_list_edge: forall root v, G |= root ~> v -> is_list root -> is_list v.
  Proof.
    intros. unfold is_list in *. destruct H0 as [p [? ?]]. exists p. split; auto. intros.
    destruct H2 as [[v' pv] ?]. assert (v' = v) by (destruct H2 as [[? _] _]; simpl in H2; auto). subst v'. destruct H as [? [? ?]]. rewrite step_spec in H4.
    destruct H4 as [e [? [? ?]]].
    assert (forall pp, G |= pp is v ~o~> y satisfying (fun _ => True) -> G |= (path_glue (root, e :: nil) pp) is root ~o~> y satisfying (fun _ => True)). {
      intros. apply reachable_by_path_merge with v; auto. split; split; simpl; auto.
      + unfold strong_evalid. rewrite H5, H6. split; auto.
      + hnf. rewrite Forall_forall. intros; auto.
    }
    pose proof (H7 _ H2). unfold path_glue, fst, snd in H8. rewrite <- app_comm_cons, app_nil_l in H8. pose proof (reachable_by_path_is_reachable _ _ _ _ _ H8).
    apply H1 in H9. clear H1. destruct H9 as [py [[? ?] ?]]. pose proof (H9 _ H8). exists (v, pv). split; split; auto.
    + intros. specialize (H7 _ H12). destruct x' as [x px]. assert (x = v) by (destruct H12 as [[? _] _]; simpl in H12; auto). subst x.
      unfold path_glue, fst, snd in H7. rewrite <- app_comm_cons, app_nil_l in H7. specialize (H9 _ H7). rewrite H9 in H11. inversion H11. auto.
    + simpl. destruct H10. subst py. simpl in *. clear -H10. unfold incl in *. intros. apply H10. right; auto.
    + simpl. destruct H10. subst py. simpl in *. unfold In_path. clear -H6 H10. right. exists e. split; intuition.
  Qed.

  Lemma construct_reachable_edge:
    forall lim root r, vvalid G root -> is_list root -> list_composed_by_edges (rev (root :: r)) -> list_composed_by_edges (rev (@construct_reachable _ _ _ _ G is_null _ (lim, root :: nil, r))).
  Proof.
    intros lim root r. remember (lengthInput (lim, root :: nil, r)) as n. assert (lengthInput (lim, root :: nil, r) <= n) by intuition. clear Heqn.
    revert n lim root r H. induction n; intros.
    + simpl in H. rewrite construct_reachable_unfold. destruct (le_dec lim (length r)); [apply (lcbe_rev_cons root) | exfalso]; intuition.
    + rewrite construct_reachable_unfold. unfold lengthInput in H, IHn. destruct (le_dec lim (length r)). 1: apply (lcbe_rev_cons root); auto.
      remember (@new_working_list _ _ is_null nil (map (dst G) (edge_func G root)) (root :: r)).
      assert (l = nil \/ exists v, l = (v :: nil) /\ G |= root ~> v) by (apply (list_expand_nil_or_single _ _ r); auto). destruct H3.
      - clear Heql. subst l. simpl. rewrite construct_reachable_unfold. auto.
      - destruct H3 as [v [? ?]]. rewrite H3. simpl. apply IHn.
        * simpl. clear - H n0. intuition.
        * hnf in H4. intuition.
        * apply (is_list_edge root); auto.
        * apply lcbe_rev_cons_inv; auto.
  Qed.

  Lemma is_list_no_self_loop: forall root s, vvalid G root -> is_list root -> reachable G root s -> G |= s ~> s -> False.
  Proof.
    intros. destruct H2 as [? [? ?]]. rewrite step_spec in H4. destruct H4 as [e [? [? ?]]].
    assert (G |= (s, e :: nil) is s ~o~> s satisfying (fun _ => True)). {
      split; split; simpl; auto.
      + unfold strong_evalid. rewrite H5, H6. split; auto.
      + hnf. rewrite Forall_forall; intros; auto.
    } destruct H0 as [pf [? ?]]. apply H8 in H1. clear H8. destruct H1 as [ps [[? ?] ?]]. destruct ps as [v ps].
    assert (v = root) by (destruct H1 as [[? _] _]; simpl in H1; auto). subst v. pose proof (reachable_by_path_merge _ _ _ _ _ _ _ H1 H7). unfold path_glue, fst, snd in H10.
    apply H8 in H10. inversion H10. pose proof (f_equal (@length Edge) H12). rewrite app_length in H11. simpl in H11. intuition.
  Qed.

  Lemma is_list_edge_dst_the_same: forall root s d v, vvalid G root -> is_list root -> reachable G root s -> G |= s ~> d -> G |= s ~> v -> d = v.
  Proof.
    intros. assert (reachable G root d) by (apply reachable_edge with s; auto). assert (reachable G root v) by (apply reachable_edge with s; auto).
    destruct H0 as [pf [? ?]]. apply H6 in H4. destruct H4 as [pd [[? ?] ?]]. apply H6 in H5. destruct H5 as [pv [[? ?] ?]].
    assert (In_path G v pf) by (apply In_path_Subpath with pv; auto; destruct H5 as [[_ ?] _]; apply pfoot_in; auto).
    assert (In_path G d pf) by (apply In_path_Subpath with pd; auto; destruct H4 as [[_ ?] _]; apply pfoot_in; auto).
    pose proof (valid_path_reachable _ _ _ _ H0 H11 H12). clear H8 H10 H11 H12. destruct H2 as [? [? ?]]. rewrite step_spec in H10. destruct H10 as [ed [? [? ?]]].
    destruct H3 as [? [? ?]]. rewrite step_spec in H15. destruct H15 as [ev [? [? ?]]]. destruct H1 as [ps ?].
    assert (G |= (s, ed :: nil) is s ~o~> d satisfying (fun _ => True)). {
      split; split; simpl; auto.
      + unfold strong_evalid. rewrite H11, H12; split; auto.
      + hnf. rewrite Forall_forall; intros; auto.
    }
    assert (G |= (s, ev :: nil) is s ~o~> v satisfying (fun _ => True)). {
      split; split; simpl; auto.
      + unfold strong_evalid. rewrite H16, H17; split; auto.
      + hnf. rewrite Forall_forall; intros; auto.
    } destruct ps as [vs ps]. assert (vs = root) by (destruct H1 as [[? _] _]; simpl in H1; auto). subst vs.
    pose proof (reachable_by_path_merge _ _ _ _ _ _ _ H1 H18). unfold path_glue, fst, snd in H20.
    pose proof (reachable_by_path_merge _ _ _ _ _ _ _ H1 H19). unfold path_glue, fst, snd in H21. clear H4 H5. pose proof (H7 _ H20). pose proof (H9 _ H21). destruct H13.
    + destruct H13 as [[v' pv'] ?]. assert (v' = v) by (destruct H13 as [[? _] _]; simpl in H13; auto). subst v'.
      pose proof (reachable_by_path_merge _ _ _ _ _ _ _ H21 H13). unfold path_glue, fst, snd in H22. apply H7 in H22. rewrite H4 in H22. inversion H22.
      pose proof (f_equal (@length Edge) H24). rewrite !app_length in H23. simpl in H23. assert (length pv' = 0) by intuition. destruct pv'. 2: inversion H25.
      clear H23 H25. rewrite app_nil_r in H24. apply app_inj_tail in H24. destruct H24. subst ed. rewrite H12 in H17. auto.
    + destruct H13 as [[d' pd'] ?]. assert (d' = d) by (destruct H13 as [[? _] _]; simpl in H13; auto). subst d'.
      pose proof (reachable_by_path_merge _ _ _ _ _ _ _ H20 H13). unfold path_glue, fst, snd in H22. apply H9 in H22. rewrite H5 in H22. inversion H22.
      pose proof (f_equal (@length Edge) H24). rewrite !app_length in H23. simpl in H23. assert (length pd' = 0) by intuition. destruct pd'. 2: inversion H25.
      clear H23 H25. rewrite app_nil_r in H24. apply app_inj_tail in H24. destruct H24. subst ed. rewrite H12 in H17. auto.
  Qed.

  Lemma is_list_edge_src_the_same: forall root s d v, vvalid G root -> is_list root -> reachable G root s -> reachable G root v -> G |= s ~> d -> G |= v ~> d -> s = v.
  Proof.
    intros. destruct H3 as [? [? ?]]. rewrite step_spec in H6. destruct H6 as [es [? [? ?]]]. destruct H4 as [? [? ?]]. rewrite step_spec in H10. destruct H10 as [ev [? [? ?]]].
    assert (G |= (s, es :: nil) is s ~o~> d satisfying (fun _ => True)). {
      split; split; simpl; auto; [unfold strong_evalid; rewrite H7, H8; split; auto | hnf; rewrite Forall_forall; intros; auto].
    }
    assert (G |= (v, ev :: nil) is v ~o~> d satisfying (fun _ => True)). {
      split; split; simpl; auto; [unfold strong_evalid; rewrite H11, H12; split; auto | hnf; rewrite Forall_forall; intros; auto].
    } destruct H1 as [[vs ps] ?]. destruct H2 as [[vv pv] ?].
    pose proof (reachable_by_path_merge _ _ _ _ _ _ _ H1 H13). unfold path_glue, fst, snd in H15.
    pose proof (reachable_by_path_merge _ _ _ _ _ _ _ H2 H14). unfold path_glue, fst, snd in H16. destruct H0 as [pf [? ?]].
    pose proof (reachable_by_path_is_reachable _ _ _ _ _ H16). apply H17 in H18. destruct H18 as [pp [[? ?] ?]]. apply H19 in H15. apply H19 in H16. rewrite H15 in H16.
    inversion H16. apply app_inj_tail in H23. destruct H23. subst es. rewrite H7 in H11. auto.
  Qed.

  Lemma construct_reachable_tail_preserve: forall lim p r, exists l', @construct_reachable _ _ _ _ G is_null _ (lim, p, r) = l' ++ r.
  Proof.
    intros lim p r. remember (lengthInput (lim, p, r)) as n. assert (lengthInput (lim, p, r) <= n) by intuition. clear Heqn. revert lim p r H. induction n; intros.
    + simpl in H. rewrite construct_reachable_unfold. destruct p. exists nil; rewrite app_nil_l; auto. destruct (le_dec lim (length r)).
      exists nil; rewrite app_nil_l; auto. exfalso; intuition.
    + simpl in H. rewrite construct_reachable_unfold. destruct p. exists nil; rewrite app_nil_l; auto. destruct (le_dec lim (length r)). exists nil; rewrite app_nil_l; auto.
      remember (@new_working_list _ _ is_null p (map (dst G) (edge_func G v)) (v :: r)). simpl. simpl in IHn. specialize (IHn lim l (v :: r)).
      assert (lim - length (v :: r) <= n) by (simpl; intuition). apply IHn in H0. destruct H0 as [l1 ?]. rewrite app_cons_assoc in H0. exists (l1 +:: v). auto.
  Qed.

  Theorem is_list_is_list: forall root, vvalid G root -> EnumCovered Vertex (reachable G root) -> is_list root -> {l | graph_list_isomorphism l root}.
  Proof.
    intros. remember (@construct_reachable _ _ _ _ G is_null _ (length (proj1_sig X), root :: nil, nil)). destruct (finite_reachable_computable' _ _ X l H Heql).
    hnf in H1. exists (rev l). split; [|split].
    + intros. destruct X as [ss [? ?]]. simpl in Heql. unfold Ensembles.In in i.
      assert (list_composed_by_edges (rev (root :: nil))) by (simpl; apply list_composed_by_edges_single). apply (construct_reachable_edge (length ss) _ nil H H0) in H3.
      hnf in H3. rewrite <- Heql in H3. split; intros.
      - destruct H4 as [? [? ?]]. pose proof H4. rewrite <- H1, in_rev in H4. apply in_split in H4. destruct H4 as [l1 [l2 ?]]. exists l1. destruct l2.
        * exfalso. pose proof H5. rewrite <- H1, in_rev, H4 in H8. rewrite in_app_iff in H8. simpl in H8. destruct H8 as [? | [? | ?]]; auto.
          2: subst d; apply (is_list_no_self_loop root s); auto. destruct l1. 1: inversion H8.
          assert (v = root). {
            rewrite construct_reachable_unfold in Heql. destruct (le_dec (length ss) (length nil)). 1: rewrite Heql in H4; simpl in H4; inversion H4.
            remember (@new_working_list _ _ is_null nil (map (dst G) (edge_func G root)) (root :: nil)). simpl in Heql.
            destruct (construct_reachable_tail_preserve (length ss) l0 (root :: nil)) as [l' ?]. rewrite <- Heql in H9. rewrite H9 in H4.
            rewrite rev_unit in H4. simpl in H4. inversion H4. auto.
          } subst v. simpl in H8. destruct H8.
          1: {
            subst d. destruct H0 as [pf [? ?]]. apply H8 in H5. clear H8. destruct H5 as [pr [[? ?] ?]].
            assert (G |= (root, nil) is root ~o~> root satisfying (fun _ => True)) by
                (split; split; simpl; auto; red; simpl; auto).
            destruct H7 as [[vr ps] ?]. destruct H6 as [? [? ?]]. rewrite step_spec in H12. destruct H12 as [e [? [? ?]]].
            assert (G |= (s, e :: nil) is s ~o~> root satisfying (fun _ => True)). {
              split; split; simpl; auto.
              + unfold strong_evalid. rewrite H13, H14. split; auto.
              + hnf. rewrite Forall_forall; intros; auto.
            } pose proof (reachable_by_path_merge _ _ _ _ _ _ _ H7 H15). unfold path_glue, fst, snd in H16. apply H8 in H10. apply H8 in H16. rewrite H10 in H16.
            inversion H16. destruct ps; simpl in H19; inversion H19.
          }
          1: {
            apply in_split in H8. destruct H8 as [l0 [l2 ?]]. subst l1. assert (root :: l0 <> nil) by (intro HS; inversion HS). apply exists_last in H8.
            destruct H8 as [l' [a ?]]. rewrite app_comm_cons, e in H4. rewrite <- app_cons_assoc, <- app_assoc in H4. simpl in H4. specialize (H3 _ _ _ _ H4).
            assert (a = s) by (apply (is_list_edge_src_the_same root _ d); auto; rewrite <- H1, in_rev, H4, in_app_iff; right; apply in_eq). subst a.
            assert (NoDup (rev l)) by (apply Permutation_NoDup with (l := l); auto; apply Permutation_rev). rewrite H4 in H8. apply NoDup_app_r in H8.
            apply NoDup_cons_2 in H8. apply H8. simpl. right. rewrite in_app_iff. right. apply in_eq.
          }
        * specialize (H3 _ _ _ _ H4). assert (d = v) by (apply (is_list_edge_dst_the_same root s); auto). subst v. exists l2; auto.
      - destruct H4 as [l1 [l2 ?]]. split; [|split]; [apply H1; rewrite in_rev; rewrite H4; rewrite in_app_iff; right ..|]; [apply in_eq | right; apply in_eq |].
        apply (H3 l1 l2); auto.
    + intros; rewrite <- in_rev, H1; tauto.
    + apply Permutation_NoDup with (l := l); auto. apply Permutation_rev.
  Qed.

  (* Print Assumptions is_list_is_list. *)

End LIST_MODEL.


Require Import HoTT.
From HoTT.Categories Require Import Category Functor NaturalTransformation.
From GR.bicategories Require Import
     bicategory.bicategory
     bicategory.adjoint
     bicategory.adjoint_unique
     bicategory.equivalence
     bicategory.equiv_to_adjequiv
     bicategory.univalent
     bicategory.examples.full_sub
     bicategory.examples.precat
     bicategory.examples.cat
     bicategory.examples.image
     lax_functor.lax_functor
     lax_functor.examples.restriction
     lax_functor.examples.image_restriction.

Definition local_equivalence
           `{Funext}
           {C D : BiCategory}
           (F : LaxFunctor C D)
  : Type
  := forall (X Y : C), @is_adjoint_equivalence PreCat _ _ (Fmor F X Y).

Definition restrict_local_equivalence
           `{Funext}
           {C D : BiCategory}
           (P : C -> hProp)
           (F : LaxFunctor C D)
           (HF : local_equivalence F)
  : local_equivalence (lax_restriction F P).
Proof.
  intros X Y.
  apply HF.
Defined.

Definition essentially_surjective
           `{Funext}
           {C D : BiCategory}
           (F : LaxFunctor C D)
  : Type
  := forall (Y : D), merely {X : C & F X = Y}.

Global Instance is_hprop_essentially_surjective
       `{Funext}
       {C D : BiCategory}
       (F : LaxFunctor C D)
  : IsHProp (essentially_surjective F)
  := _.

Definition image_essentialy_surjective
           `{Funext}
           {C D : BiCategory}
           (F : LaxFunctor C D)
  : essentially_surjective (restrict_image F).
Proof.
  intros [Y HY] ; cbn in *.
  simple refine (Trunc_rec _ HY).
  intros [X HX].
  apply tr.
  refine (X;_).
  apply path_sigma_hprop ; simpl.
  apply HX.
Defined.

Definition image_local_equivalence
           `{Funext}
           {C D : BiCategory}
           (F : LaxFunctor C D)
           (HF : local_equivalence F)
  : local_equivalence (restrict_image F).
Proof.
  intros X Y.
  apply HF.
Defined.

Definition weak_equivalence
           `{Funext}
           {C D : BiCategory}
           (F : LaxFunctor C D)
  : Type
  := local_equivalence F * essentially_surjective F.


Require Import mathcomp.ssreflect.ssreflect.

Lemma foobar : forall n : nat, n = n.
Proof.
  induction n. {
    have h1: 0 = 0 by auto.
    assumption.
  } {
    have h1: S n = S n by auto.
    assumption.
  }
Qed.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas32_2e256m2e32m977_12limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition carry :
  { carry : feBW_loose -> feBW_tight
  | forall a, phiBW_tight (carry a) = (phiBW_loose a) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_carry ().
  Show Ltac Profile.
Time Defined.

Print Assumptions carry.


(*|
**TLA modalities**

This file has some basic results about the TLA modalities, especially relating
them to each other. For example one of the theorems with a slightly involved
proof is that `□◇ (p ∨ q) = □◇ p ∨ □◇ q`, despite the fact that □ on its own
does not distribute over ∨.

|*)

From Coq Require Import Setoid.
From TLA Require Import defs automation.
From TLA Require Import classical.

Section TLA.

Context [Σ: Type].

Notation exec := (exec Σ).
Notation predicate := (predicate Σ).

Implicit Types (e: exec) (p q: predicate) (a: action Σ).
Implicit Types (n m k: nat).

Theorem eventually_to_always p :
  ◇ p == ! (□ (! p)).
Proof.
  tla_simp.
Qed.

Theorem always_to_eventually p :
  □ p == ! (◇ (! p)).
Proof.
  tla_simp.
Qed.

Theorem always_idem p :
  □ □ p == □ p.
Proof.
  unseal.
  split.
  - intros H k.
    specialize (H k 0).
    rewrite //= in H.
  - intuition auto.
Qed.

Theorem eventually_idem p :
  ◇ ◇ p == ◇ p.
Proof.
  dual always_idem.
Qed.

Hint Rewrite always_idem eventually_idem : tla.

Theorem always_intro p :
  (⊢ p) ↔ ⊢ □ p.
Proof.
  unseal.
  split; intros H e; [ by eauto | ].
  specialize (H e 0).
  rewrite drop_0 // in H.
Qed.

Theorem implies_generalize p1 p2 :
  (⊢ p1 → p2) → (⊢ □ p1 → □ p2).
Proof.
  unfold valid; autounfold with tla.
  eauto.
Qed.

Theorem impl_under_always p1 p2 :
  (p1 ⊢ p2) → (□ p1 ⊢ □ p2).
Proof.
  apply implies_generalize.
Qed.

Theorem always_intro_impl p q :
  (□p ⊢ q) → (□p ⊢ □ q).
Proof.
  intros H. apply impl_under_always in H.
  rewrite <- H.
  rewrite always_idem //.
Qed.

Theorem always_and p1 p2 :
  □(p1 ∧ p2) == (□p1 ∧ □ p2).
Proof.
  unseal.
  intuition eauto.
  - destruct (H k); auto.
  - destruct (H k); auto.
Qed.

Theorem later_and p1 p2 :
  later (p1 ∧ p2) == (later p1 ∧ later p2).
Proof.
  unseal.
Qed.

Theorem later_or p1 p2 :
  later (p1 ∨ p2) == (later p1 ∨ later p2).
Proof.
  unseal.
Qed.

Theorem eventually_or p1 p2 :
  ◇(p1 ∨ p2) == (◇p1 ∨ ◇ p2).
Proof.
  dual always_and.
Qed.

Theorem always_eventually_distrib p1 p2 :
  □◇ (p1 ∨ p2) == ((□◇ p1) ∨ (□◇ p2)).
Proof.
  unseal.
  split.
  - intros H.
    apply classical.double_negation.
    rewrite classical.not_or !classical.not_forall.
    setoid_rewrite classical.not_exists.
    intros H1.
    destruct H1 as [[x1 Hnot1] [x2 Hnot2]].
    destruct (H (Nat.max x1 x2)) as [k H1or2].
    destruct H1or2 as [H1|H2].
    { apply (Hnot1 (k + Nat.max x1 x2 - x1)).
      assert (k + Nat.max x1 x2 - x1 + x1 = k + Nat.max x1 x2) by lia.
      congruence. }
    { apply (Hnot2 (k + Nat.max x1 x2 - x2)).
      assert (k + Nat.max x1 x2 - x2 + x2 = k + Nat.max x1 x2) by lia.
      congruence. }
  - intros [H|H]; intros k.
    + destruct (H k) as [k' ?]; eauto.
    + destruct (H k) as [k' ?]; eauto.
Qed.

Theorem eventually_and p1 p2 :
  ◇ (p1 ∧ p2) ⊢ ◇ p1 ∧ ◇ p2.
Proof. unseal. Qed.

(* this is a weakening; the left side says they happen at the same time, while
the right allows them to happen only separately *)
Theorem always_eventually_and p1 p2 :
  □◇ (p1 ∧ p2) ⊢ □◇ p1 ∧ □◇ p2.
Proof.
  rewrite -> eventually_and.
  rewrite always_and //.
Qed.

Theorem eventually_always_distrib p1 p2 :
  ◇□ (p1 ∧ p2) == ((◇□ p1) ∧ (◇□ p2)).
Proof.
  dual always_eventually_distrib.
Qed.

Theorem always_or p1 p2 :
  □ p1 ∨ □ p2 ⊢ □ (p1 ∨ p2).
Proof.
  dual eventually_and.
Qed.

Theorem eventually_always_or p1 p2 :
  ◇□ p1 ∨ ◇□ p2 ⊢ ◇□ (p1 ∨ p2).
Proof.
  dual always_eventually_and.
Qed.

Lemma always_eventually_reverse p :
  □◇ p == ! ◇□ !p.
Proof.
  tla_simp.
Qed.

Lemma eventually_always_reverse p :
  ◇□ p == ! □◇ !p.
Proof.
  tla_simp.
Qed.

Theorem always_eventually_idem p :
  □ ◇ □ ◇ p == □ ◇ p.
Proof.
  unseal.
  repeat setoid_rewrite drop_drop.
  split.
  - intros H k.
    specialize (H k).
    destruct H as [k' H].
    specialize (H 0).
    destruct H as [k'' H].
    eauto.
  - intros H k.
    exists 0. intros k'.
    destruct (H (k + k')) as [k'' H'].
    exists k''.
    replace (k'' + k' + 0 + k) with (k'' + (k + k')) by lia.
    done.
Qed.

Theorem eventually_always_idem p :
  ◇ □ ◇ □ p == ◇ □ p.
Proof.
  dual always_eventually_idem.
Qed.

Hint Rewrite always_eventually_idem eventually_always_idem : tla.

Theorem always_weaken p :
  □ p ⊢ p.
Proof.
  unseal.
  specialize (H 0).
  rewrite drop_0 // in H.
Qed.

Theorem always_weaken_eventually p :
  □ p ⊢ ◇ p.
Proof.
  autounfold with tla.
  intros e H.
  exists 0; eauto.
Qed.

Theorem always_and_eventually p q :
  □ p ∧ ◇ q ⊢ ◇ (p ∧ q).
Proof. unseal. Qed.

Theorem always_to_later p :
  □ p ⊢ later p.
Proof.
  unseal.
Qed.

Theorem later_to_eventually p :
  later p ⊢ ◇ p.
Proof.
  unseal.
Qed.

Theorem always_expand p :
  □ p == (p ∧ □ p).
Proof.
  tla_split; [ | tla_prop ].
  - tla_split; [ | tla_prop ].
    apply always_weaken.
Qed.

Lemma add_1_succ (n: nat) : n + 1 = S n.
Proof. lia. Qed.

Theorem always_unroll p :
  □ p == (p ∧ later (□ p)).
Proof.
  apply equiv_to_impl; unseal.
  { intuition eauto.
    rewrite -(drop_0 e) //. }
  intuition eauto.
  setoid_rewrite add_1_succ in H1.
  destruct k.
  { rewrite drop_0 //. }
  { eauto. }
Qed.

Theorem always_induction p :
  □ p == (p ∧ □(p → later p)).
Proof.
  apply equiv_to_impl.
  - unseal.
    intuition eauto.
    rewrite -(drop_0 e) //.
  - unseal.
    destruct H as [Hp Hlater] .
    generalize dependent e.
    induction k; intros; eauto.
    rewrite drop_0 //.
Qed.

Lemma impl_intro'_iff p q r :
  (p ⊢ q → r) ↔
  (p ∧ q ⊢ r).
Proof. unseal. Qed.

Lemma impl_intro' p q r :
  (p ∧ q ⊢ r) →
  (p ⊢ q → r).
Proof. unseal. Qed.

Lemma impl_intro'_2 p q r :
  (p ⊢ q → r) →
  (p ∧ q ⊢ r).
Proof. unseal. Qed.

Theorem always_induction_impl p q r :
  (□ p ∧ q ⊢ r) →
  (□ p ∧ r ⊢ later r) →
  (□ p ⊢ □(q → □r)).
Proof.
  intros Hr Hind.
  apply always_intro_impl.
  rewrite (always_induction r).
  apply impl_intro'.
  tla_split; auto.
  transitivity (□p)%L; [ unseal | ].
  apply always_intro_impl.
  apply impl_intro'.
  auto.
Qed.

Theorem always_induction_impl_pred a (Q R: Σ → Prop) :
  (∀ s s', Q s → a s s' → R s) →
  (∀ s s', R s → a s s' → R s') →
  (□ ⟨a⟩ ⊢ □(⌜Q⌝ → □⌜R⌝)).
Proof.
  intros HR Hind.
  apply always_induction_impl.
  { rewrite always_weaken. unseal. }
  { rewrite always_weaken. unseal. }
Qed.

Theorem later_always p :
  □ p ⊢ later (□ p).
Proof.
  rewrite {1}always_unroll.
  unseal.
Qed.

Theorem later_eventually p :
  (p ∨ later (◇ p)) == ◇ p.
Proof.
  unseal.
  intuition (deex; eauto).
  { exists 0; rewrite drop_0 //. }
  setoid_rewrite add_1_succ.
  destruct k; eauto.
  rewrite drop_0 in H; auto.
Qed.

Theorem later_eventually_weaken p :
  later (◇ p) ⊢ ◇ p.
Proof.
  rewrite <- later_eventually at 2.
  unseal.
Qed.

Theorem always_eventually_always (p: predicate) :
  □◇□ p == ◇□ p.
Proof.
  tla_split.
  - apply always_weaken.
  - unseal.
    destruct H as [k' Hp].
    exists k'. intros k''.
    replace (k'' + k' + k) with ((k'' + k) + k') by lia.
    eauto.
Qed.

Theorem eventually_always_eventually (p: predicate) :
  ◇□◇ p == □◇ p.
Proof.
  dual always_eventually_always.
Qed.

(*|

---------------------------------
Characterization of modalities
---------------------------------

Modalities can be composed. Here we show that □ and ◇ only give rise to 4
distinct modalities.

|*)

(*|
For simplicity we represent a chain of modalities `□ (◇ (◇ (□ ...)) p)` by
interpreting a list of booleans, where true is □ and false is ◇. Yes, we could
do something cleaner.
|*)
Fixpoint modality_chain (l: list bool) (p: predicate) : predicate :=
  match l with
  | nil => p
  | true :: l => □ (modality_chain l p)
  | false :: l => ◇ (modality_chain l p)
  end.

Example modality_chain_ex (p: predicate) :
  modality_chain [true; false; false; true] p = (□ (◇ (◇ (□ p))))%L.
Proof. reflexivity. Qed.

Hint Rewrite always_idem eventually_idem : tla.
Hint Rewrite always_eventually_idem eventually_always_idem : tla.
Hint Rewrite always_eventually_always eventually_always_eventually : tla.

Theorem modality_chain_reduces (l: list bool) (p: predicate) :
  (modality_chain l p == p) ∨
  (modality_chain l p == ◇ p) ∨
  (modality_chain l p == □ p) ∨
  (modality_chain l p == ◇□ p) ∨
  (modality_chain l p == □◇ p).
Proof.
  induction l; simpl.
  - eauto.
  - destruct a; simpl.
    + destruct IHl as [-> | [-> | [-> | [-> | ->]]]]; tla_simp; eauto.
    + destruct IHl as [-> | [-> | [-> | [-> | ->]]]]; tla_simp; eauto.
Qed.

End TLA.

Hint Rewrite always_idem eventually_idem : tla.
Hint Rewrite always_eventually_idem eventually_always_idem : tla.
Hint Rewrite always_eventually_always eventually_always_eventually : tla.


Require Import
  Coq.Unicode.Utf8
  HoTTClasses.implementations.list
  HoTT.Basics.Overture
  HoTT.Spaces.Nat.

Declare Scope ne_list_scope.

Delimit Scope ne_list_scope with ne_list.

Open Scope ne_list_scope.

(** Nonempty list implementation [ne_list.ne_list]. *)

Module ne_list.

Section with_type.
  Context {T: Type}.

(** A nonempty list. Below there is an implicit coercion
    [ne_list >-> list]. *)

  Inductive ne_list : Type
    := one: T → ne_list | cons: T → ne_list → ne_list.

  Fixpoint app (a b: ne_list): ne_list :=
    match a with
    | one x => cons x b
    | cons x y => cons x (app y b)
    end.

  Fixpoint foldr {R} (u: T → R) (f: T → R → R) (a: ne_list): R :=
    match a with
    | one x => u x
    | cons x y => f x (foldr u f y)
    end.

  Fixpoint foldr1 (f: T → T → T) (a: ne_list): T :=
    match a with
    | one x => x
    | cons x y => f x (foldr1 f y)
    end.

  Definition head (l: ne_list): T
    := match l with one x => x | cons x _ => x end.

  Fixpoint to_list (l: ne_list): list T :=
    match l with
    | one x => x :: nil
    | cons x xs => x :: to_list xs
    end.

  Fixpoint from_list (x: T) (xs: list T): ne_list :=
    match xs with
    | nil => one x
    | Datatypes.cons h t => cons x (from_list h t)
    end.

  Definition tail (l: ne_list): list T
    := match l with one _ => nil | cons _ x => to_list x end.

  Lemma decomp_eq (l: ne_list): l = from_list (head l) (tail l).
  Proof with auto.
    induction l...
    destruct l...
    cbn in *.
    rewrite IHl...
  Qed.

  Definition last: ne_list → T := foldr1 (fun x y => y).

  Fixpoint replicate_Sn (x: T) (n: nat): ne_list :=
    match n with
    | 0 => one x
    | S n' => cons x (replicate_Sn x n')
    end.

  Fixpoint take (n: nat) (l: ne_list): ne_list :=
    match l, n with
    | cons x xs, S n' => take n' xs
    | _, _ => one (head l)
    end.

  Fixpoint front (l: ne_list) : list T :=
    match l with
    | one _ => nil
    | cons x xs => x :: front xs
    end.

  Lemma two_level_rect (P: ne_list → Type)
    (Pone: ∀ x, P (one x))
    (Ptwo: ∀ x y, P (cons x (one y)))
    (Pmore: ∀ x y z, P z → (∀ y', P (cons y' z)) → P (cons x (cons y z)))
    : ∀ l, P l.
  Proof with auto.
   cut (∀ l, P l * ∀ x, P (cons x l)).
   - intros. apply X.
   - destruct l...
     revert t.
     induction l...
     intros.
     split.
     + apply IHl.
     + intro. apply Pmore; intros; apply IHl.
  Qed.

  Lemma tl_length (l: ne_list)
    : S (length (tl (to_list l))) = length (to_list l).
  Proof. destruct l; reflexivity. Qed.
End with_type.

Arguments ne_list : clear implicits.

Fixpoint tails {T} (l: ne_list T): ne_list (ne_list T) :=
  match l with
  | one x => one (one x)
  | cons x y => cons l (tails y)
  end.

Lemma tails_are_shorter {T} (y x: ne_list T):
  InList x (to_list (tails y)) →
  le (length (to_list x)) (length (to_list y)).
Proof with auto.
 induction y; cbn.
 - intros [[] | C].
   + constructor.
   + elim C.
 - intros [[] | C]...
Qed.

Fixpoint map {A B} (f: A → B) (l: ne_list A): ne_list B :=
  match l with
  | one x => one (f x)
  | cons h t => cons (f h) (map f t)
  end.

Lemma list_map {A B} (f: A → B) (l: ne_list A)
  : to_list (map f l) = list.map f (to_list l).
Proof.
  induction l.
  - reflexivity.
  - cbn. rewrite <- IHl. reflexivity.
Qed.

Fixpoint inits {A} (l: ne_list A): ne_list (ne_list A) :=
  match l with
  | one x => one (one x)
  | cons h t => cons (one h) (map (cons h) (inits t))
  end.

Fixpoint zip {A B: Type} (l: ne_list A) (m: ne_list B)
  : ne_list (A * B) :=
  match l with
  | one a => one (a, head m)
  | cons a l =>
      match m with
      | one b => one (a, b)
      | cons b m => cons (a, b) (zip l m)
      end
  end.

  Module notations.

    Global Notation ne_list := ne_list.

    Global Notation "[: x :]" := (one x) : ne_list_scope.

    Global Notation "[: x ; .. ; y ; z :]"
        := (cons x .. (cons y (one z)) ..) : ne_list_scope.

    Global Infix ":::" := cons (at level 60, right associativity) : ne_list_scope.

  End notations.

End ne_list.

Global Coercion ne_list.to_list : ne_list.ne_list >-> list.