(* 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 -> []