(* Lazy Rose Trees *)
Set Implicit Arguments.
Record Lazy (T : Type) := lazy { force : T }.
Inductive Rose (A : Type) : Type :=
MkRose : A -> Lazy (list (Rose A)) -> Rose A.
Definition returnRose {A : Type} (x : A) := MkRose x (lazy nil).
Fixpoint joinRose {A : Type} (r : Rose (Rose A)) : Rose A :=
match r with
| MkRose (MkRose a ts) tts =>
MkRose a (lazy ((List.map joinRose (force tts)) ++ (force ts)))
end.
Fixpoint repeatRose {A : Type} (n : nat) (r : Rose A) :=
match r with
| MkRose a ts => MkRose a (lazy (concat (repeat (force ts) n)))
end.
Fixpoint fmapRose {A B : Type} (f : A -> B) (r : Rose A) : Rose B :=
match r with
| MkRose x rs => MkRose (f x) (lazy (List.map (fmapRose f) (force rs)))
end.
Definition bindRose {A B : Type} (m : Rose A) (k : A -> Rose B) : Rose B :=
joinRose (fmapRose k m).

(* Specifications: *)
(* (* CH: these seem unused now *)
Lemma joinRoseFmapRose :
forall {A B} (f: A -> B) (x : Rose A),
fmapRose f x = joinRose (fmapRose (fun x0 : A => returnRose (f x0)) x).
Lemma monadFunctorLaw :
(forall A B (f : A -> B) a,
fmapRose f a = bindRose a (fun x => returnRose (f x))).
(* CH: TODO: need a proper induction principle for rose trees *)
Lemma fmapRose_id : forall a (rose : Rose a) f,
(forall x : a, f x = x) ->
fmapRose f rose = rose.