Set Implicit Arguments.
(*Require ne_list.*)
Require ne_tree.
Definition C := ne_tree.T.
Definition ret {A: Set}: A -> C A := @ne_tree.Leaf A.
Fixpoint bind (A B: Set) (m: C A) (k: A -> C B): C B :=
match m with
| ne_tree.Leaf a => k a
| ne_tree.Node ts => ne_tree.Node (ne_list.map (fun x => bind x k) ts)
end.
Let runit (a b: Set) (x: a) (f: a -> C b): bind (ret x) f = f x.
Definition M: Monad := Build_Monad C bind (@ret) runit lunit assoc.
Proof with auto.
unfold extMonad.
induction x using ne_tree.alt_ind; simpl...
replace (ne_list.map (fun x: C A => bind x f) l) with (ne_list.map (fun x: C A => bind x g) l)...
generalize H0. clear H0.
induction l; simpl; intros; rewrite H0...
rewrite IHl...
Qed.
Definition deterministic (X: Set) (x: M X) (v: X): Prop := x = ne_tree.Leaf v.
Proof with auto.
induction x; simpl; destruct x'; simpl; intros; try discriminate.
apply H.
inversion_clear H0...
destruct l; simpl; intros.
simpl.
intros.
rewrite (IHx t)...
inversion_clear H0...
discriminate.
destruct l0.
discriminate.
simpl in H0.
simpl.
inversion H0.
clear H0.
f_equal.
replace (bind x f) with (bind t f').
Focus 2.
symmetry.
apply IHx...
replace (ne_list.map (fun x0: C X => bind x0 f) l) with (ne_list.map (fun x0: C X' => bind x0 f') l0)...
assert (ne_tree.map xm (ne_tree.Node l) = ne_tree.map xm' (ne_tree.Node l0)).
simpl.
rewrite H3...
cset (IHx0 (ne_tree.Node l0) H0).
inversion_clear H1...
Qed.

Lemma map_bind (X Y Z: Set) (f: Y -> Z) (g: X -> M Y) (x: M X):
ne_tree.map f (bind x g) =
bind x (fun xx => ne_tree.map f (g xx)).