(* Types. *)
type 'a t =
'a head Lazy.t
and
'a head =
| Nil
| Cons of 'a * 'a t
(* Égalité. *)
let rec equal eq xs ys =
match Lazy.force xs, Lazy.force ys with
| Nil, Nil ->
true
| Cons (x, xs), Cons (y, ys) ->
eq x y && equal eq xs ys
| _, _ ->
false
(* Construction. *)
let rec unfold (f: 'b -> ('a * 'b) option) (seed : 'b) : 'a t =
lazy (
match f seed with
| Some (x, seed) -> Cons (x, unfold f seed)
| None -> Nil
)
(* Destruction au moyen de Lazy.force *)
(* Concatenation. *)
let rec concat (xs : 'a t) (ys : 'a t) : 'a t =
lazy (
match Lazy.force xs with
| Cons (x, xs) -> Cons (x, concat xs ys)
| Nil -> Lazy.force ys
)
(*
let rec flatten (xss : 'a t t) : 'a t =
lazy (
match force xss with
| Nil ->
Nil
| Cons (xs, xss) ->
Lazy.force (concat xs (flatten xss))
)
*)
(* Segment initial fini. *)
let rec take (n : int) (xs : 'a t) : 'a t =
lazy (
if n = 0 then
Nil
else (
match Lazy.force xs with
| Nil -> Nil
| Cons (x, xs) -> Cons (x, take (n-1) xs)
)
)
(* Dernier élément d'un flot. *)
let rec last1 (default : 'a) (xs : 'a t) : 'a =
match Lazy.force xs with
| Nil ->
default
| Cons (x, xs) ->
last1 x xs
let last (xs : 'a t) : 'a option =
match Lazy.force xs with
| Nil ->
None
| Cons (x, xs) ->
Some (last1 x xs)
(* Itération. *)
let rec iter (f : 'a -> unit) (xs : 'a t) : unit =
match Lazy.force xs with
| Cons (x, xs) -> f x ; iter f xs
| Nil -> ()
let rec map (f : 'a -> 'b) (xs : 'a t) : 'b t =
lazy (
match Lazy.force xs with
| Nil ->
Nil
| Cons (x, xs) ->
Cons (f x, map f xs)
)
let rec map_one_many (f : 'a -> 'b t -> 'b t) (xs : 'a t) : 'b t =
lazy (
match Lazy.force xs with
| Nil ->
Nil
| Cons (x, xs) ->
Lazy.force (f x (map_one_many f xs))
)
let rec map_many_one (f : 'a t -> 'b * 'a t) (xs : 'a t) : 'b t =
lazy (
match Lazy.force xs with
| Nil ->
Nil
| Cons (_, _) ->
let y, xs = f xs in
Cons (y, map_many_one f xs)
)
(* Flots vs Listes. *)
let rec from_list xl =
lazy (
match xl with
| x :: xl -> Cons (x, from_list xl)
| [] -> Nil
)
let rec to_list xs =
match Lazy.force xs with
| Cons (x, xs) -> x :: to_list xs
| Nil -> []