Fixpoint Concat (l : Tlist_setoid) : Tlist_setoid -> Tlist_setoid :=
fun m : Tlist_setoid =>
match l with
| Empty => m
| Concat1 a l1 => Concat1 a (Concat l1 m)
end.

(* Specifications: *)
Lemma Diff_Concat1_Empty :
forall (a : A) (l : Tlist), ~ Equal_Tlist (Concat1 a l) Empty.
Lemma Concat_congl : Map2_congl_law Concat.
Lemma Concat_congr : Map2_congr_law Concat.
Definition Concat_map2 := Build_Map2 Concat_congl Concat_congr.
Lemma Mass_FreeMonoid : Monoid_ass Concat_map2.
Lemma Midl_FreeMonoid : Monoid_idl Concat_map2 Empty.
Lemma Midr_FreeMonoid : Monoid_idr Concat_map2 Empty.
Canonical Structure FreeMonoid :=
Build_Monoid Mass_FreeMonoid Midl_FreeMonoid Midr_FreeMonoid.