Section Monad.
Definition state := nat.
Definition monad (A:Type) := state → state * A.
Definition Meval {A:Type} (m:monad A) st := m st.
Definition Meq {A:Type} (m:monad A) := ∀ st, st = fst (Meval m st).
Definition Mlt {A:Type} (m:monad A) := ∀ st, st < fst (Meval m st).
Definition Mle {A:Type} (m:monad A) := ∀ st, st ≤ fst (Meval m st).
Definition Mdo {A B:Type} (ma:monad A) (mb:monad B) := ma >>= (λ _, mb).
Infix ">>" := Mdo (at level 15, left associativity) : monad_scope. (* level at random… *)
(*Definition Mmake {A B:Type} (f:A→B) x:= Mreturn (f x).*)
Definition Mupdate (f:nat→nat) := (λ st, ((f st),tt)):monad unit.
Definition Mmap2 {A B C:Type} (f:A→B→C) (ma:monad A) (mb:monad B):=
(λ s0, let (s1,a) := ma s0 in let (s2,b) := mb s1 in (s2,(f a b))):monad C.
(* pair is already defined as we want *)
(* cons is already defined as we want *)
Definition triple {A B C:Type} (x:A*B) (c:C) := (fst x,snd x,c):A*B*C.
Notation "ma >>+ mb" := (Mmap2 pair ma mb) (at level 15, left associativity):monad_scope.
Notation "mab >>++ mc" := (Mmap2 triple mab mc) (at level 15, left associativity):monad_scope.
Notation "mx >>:: mxs" :=  (Mmap2 cons mx mxs) (at level 15, left associativity):monad_scope.
Definition Mbind2 {A B C:Type} (mab:monad (A*B)) (f:A→B→monad C) :=
(λ st, let (st',ab):= Meval mab st in let m':=f (fst ab) (snd ab) in m' st'):monad C.
Infix ">>==" := Mbind2 (at level 15, left associativity) : monad_scope.
Fixpoint lm_to_ml {A:Type} (lm:list (monad A)) : monad (list A):=
match lm with
| [] => Mreturn []
| m::ms => m >>::(lm_to_ml ms)
end.

Lemma all_lt_lm_to_ml_le {A:Type} (lm:list (monad A)):
(Forall Mlt lm) → Mle (lm_to_ml lm).