Source file CCLazy_list.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

(* This file is free software, part of containers. See file "license" for more details. *)

(** {1 Lazy List} *)

type +'a t = 'a node lazy_t
and +'a node =
  | Nil
  | Cons of 'a * 'a t

let empty = Lazy.from_val Nil

let return x = Lazy.from_val (Cons (x, empty))

let is_empty = function
  | lazy Nil -> true
  | lazy (Cons _) -> false

let cons x tl = Lazy.from_val (Cons (x,tl))

let head = function
  | lazy Nil -> None
  | lazy (Cons (x, tl)) -> Some (x,tl)

let length l =
  let rec aux acc l = match l with
    | lazy Nil -> acc
    | lazy (Cons (_, tl)) -> aux (acc+1) tl
  in
  aux 0 l

(*$Q
  Q.(list int) (fun l -> length (of_list l) = List.length l)
*)

let rec map ~f l =
  lazy (
    match l with
      | lazy Nil -> Nil
      | lazy (Cons (x,tl)) -> Cons (f x, map ~f tl)
  )

let filter ~f l =
  let rec aux f l = match l with
    | lazy Nil -> Nil
    | lazy (Cons (x,tl)) when f x -> Cons (x, lazy (aux f tl))
    | lazy (Cons (_, tl)) ->  aux f tl
  in
  lazy (aux f l)

(*$=
  [2;4;6] (of_list [1;2;3;4;5;6;7] |> filter ~f:(fun x -> x mod 2=0) |> to_list)
  [2;4;6] (of_gen Gen.(1 -- max_int) |> filter ~f:(fun x -> x mod 2=0) |> take 3 |> to_list)
*)

let rec take n l =
  lazy (
    match l with
      | _ when n=0 -> Nil
      | lazy Nil -> Nil
      | lazy (Cons (x,tl)) -> Cons (x, take (n-1) tl)
  )

let rec append a b =
  lazy (
    match a with
      | lazy Nil -> Lazy.force b
      | lazy (Cons (x,tl)) -> Cons (x, append tl b)
  )

(*$Q
  Q.(pair (list int) (list int)) (fun (l1,l2) ->\
    length (append (of_list l1) (of_list l2)) = List.length l1 + List.length l2)
*)

let rec flat_map ~f l =
  lazy (
    match l with
      | lazy Nil -> Nil
      | lazy (Cons (x,tl)) ->
        let res = append (f x) (flat_map ~f tl) in
        Lazy.force res
  )

let default ~default l =
  lazy (
    match l with
      | lazy Nil -> Lazy.force default
      | lazy l -> l
  )

(*$=
  [1] (default (return 1) empty |> to_list)
*)

module Infix = struct
  let (>|=) x f = map ~f x
  let (>>=) x f = flat_map ~f x
  let (<|>) a b = default ~default:b a
end

include Infix

type 'a gen = unit -> 'a option

let rec of_gen g =
  lazy (
    match g()  with
      | None -> Nil
      | Some x -> Cons (x, of_gen g)
  )

(*$Q
  Q.(list int) (fun l -> l = (Gen.of_list l |> of_gen |> to_list))
*)

let rec of_list = function
  | [] -> empty
  | x :: tl -> cons x (of_list tl)

let to_list_rev l =
  let rec aux acc = function
    | lazy Nil -> acc
    | lazy (Cons (x,tl)) -> aux (x::acc) tl
  in
  aux [] l

let to_list l = List.rev (to_list_rev l)

(*$Q
  Q.(list int) (fun l -> l = to_list (of_list l))
*)

let to_gen l =
  let l = ref l in
  fun () -> match !l with
    | lazy Nil -> None
    | lazy (Cons (x,tl)) -> l := tl; Some x

(*$Q
  Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list))
*)