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. OK, I Understand
 
Top