• API
• FAQ
• Tools
• Archive
SHARE
TWEET

# Untitled

a guest Sep 15th, 2018 34 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. type 'a t =
2.   | Empty
3.   | Pure of 'a
4.   | Unfold :
5.     { init : 's
6.     ; run : 'r . 's -> ('s -> 'a -> 'r) -> 'r -> 'r } -> 'a t
7.   | Bind : 'e t * ('e -> 'a t) -> 'a t
8.
9. let empty = Empty
10. let pure x = Pure x
11.
12. let rec map : type a b . (a -> b) -> a t -> b t =
13.   fun f -> function
14.   | Empty -> Empty
15.   | Pure x -> Pure (f x)
16.   | Unfold u ->
17.     let run s y = u.run s (fun s x -> y s (f x)) in
18.     Unfold { u with run }
19.   | Bind (s, g) -> Bind (s, fun x -> map f (g x))
20. [@@inline always]
21.
22. let rec filter p = function
23.   | Empty -> Empty
24.   | Pure x as y when p x -> y
25.   | Pure _ -> Empty
26.   | Unfold u ->
27.     let rec run s y n = u.run
28.       s
29.       (fun [@inline] s x -> if p x then y s x else run s y n)
30.       n in
31.     Unfold { u with run }
32.   | Bind (s, g) -> Bind (s, fun x -> filter p (g x))
33. [@@inline always]
34.
35. let rec iter : type a . (a -> unit) -> a t -> unit =
36.   fun f -> function
37.   | Empty -> ()
38.   | Pure x -> f x
39.   | Unfold u ->
40.     let rec loop st =
41.       u.run st
42.         (fun s x -> f x; loop s)
43.         () in
44.     loop u.init
45.   | Bind (s, g) ->
46.     iter (fun x -> iter f (g x)) s
47.
48. let sum s =
49.   let res = ref 0 in
50.   (iter [@inlined]) (fun x -> res := !res + x) s;
51.   !res
52. [@@inline always]
53.
54. let enum low high =
55.   let run st on_val on_zero =
56.     if st > high then on_zero else on_val (st + 1) st in
57.   Unfold { init = low; run }
58. [@@inline always]
59.
60. let rec bind : type a b . (a -> b t) -> a t -> b t =
61.   fun f -> function
62.   | Empty -> Empty
63.   | Pure x -> f x
64.   | Bind (s, g) -> Bind (s, fun x -> bind f (g x))
65.   | s -> Bind (s, f)
66.
67. let (>>=) x f = bind f x
68.
69. let high = 100_000_000
70.
71. let res = enum 1 high
72.   |> filter (fun x -> x mod 2 = 0)
73.   |> map (( * ) 2)
74.   >>= pure
75.   |> map (fun x -> x)
76.   >>= pure
77.   |> map (fun x -> x)
78.   >>= pure
79.   |> filter (fun _ -> true)
80.   >>= pure
81.   |> map (fun x -> x)
82.   >>= pure
83.   >>= pure
84.   >>= pure
85.   |> map (fun x -> x)
86.   >>= pure
87.   |> map (fun x -> x)
88.   >>= pure
89.   |> filter (fun _ -> true)
90.   |> sum
91.
92. let _ = Printf.printf "%d\n" res
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.

Top