Source file CCFun.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

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

(** {1 Basic Functions} *)

let opaque_identity x = x

(* import standard implementations, if any *)

include Sys
include CCShims_.Stdlib
include CCShimsFun_

let compose f g x = g (f x)

let compose_binop f g x y = g (f x) (f y)

let curry f x y = f (x,y)

let uncurry f (x,y) = f x y

let tap f x = ignore (f x); x

let lexicographic f1 f2 x y =
  let c = f1 x y in
  if c <> 0 then c else f2 x y

let finally ~h ~f =
  try
    let x = f () in
    ignore (h ());
    x
  with e ->
    ignore (h ());
    raise e

let finally1 ~h f x =
  try
    let res = f x in
    ignore (h ());
    res
  with e ->
    ignore (h ());
    raise e

let finally2 ~h f x y =
  try
    let res = f x y in
    ignore (h ());
    res
  with e ->
    ignore (h ());
    raise e

let rec iterate n f x =
  if n < 0 then
    invalid_arg "CCFun.iterate"
  else if n = 0 then
    x
  else
    iterate (n - 1) f (f x)

(*$= iterate & ~printer:Q.Print.int
  10 (iterate 0 succ 10)
  11 (iterate 1 succ 10)
  12 (iterate 2 succ 10)
  15 (iterate 5 succ 10)
*)
(*$R
  assert_raises
  (Invalid_argument "CCFun.iterate")
  (fun () -> iterate (-1) succ 10)
*)

module Infix = struct
  (* default implem for some operators *)
  let (|>) x f = f x
  let (@@) f x = f x

  let (%>) = compose
  let (%) f g x = f (g x)
end

(*$T
  CCFun.((succ %> string_of_int) 2 = "3")
  CCFun.((( * ) 3 % succ) 5 = 18)
  CCFun.(succ @@ ( * ) 2 @@ pred @@ 3 = 5)
  CCFun.(3 |> succ |> ( * ) 5 |> pred = 19)
*)

include Infix

module Monad(X : sig type t end) = struct
  type 'a t = X.t -> 'a
  let return x _ = x
  let (>|=) f g x = g (f x)
  let (>>=) f g x = g (f x) x
end