Skip to content

Instantly share code, notes, and snippets.

@Drup
Created August 4, 2017 15:55
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Drup/05ae684209a5a5038f3260358529330c to your computer and use it in GitHub Desktop.
Save Drup/05ae684209a5a5038f3260358529330c to your computer and use it in GitHub Desktop.
A generic cascade/batseq/lazylist that works with any monad.
module type S = sig
type 'a m
val pure : 'a -> 'a m
val delayed : (unit -> 'a) -> 'a m
val map : ('a -> 'b) -> 'a m -> 'b m
val bind : 'a m -> ('a -> 'b m) -> 'b m
end
module Make (M : S) = struct
let (>>=) = M.bind
let (>|=) x f = M.map f x
type 'a node =
| Nil
| Cons of 'a * 'a t
and 'a t = 'a node M.m
let nil : _ t = M.pure Nil
let cons x xs : _ t = M.pure (Cons (x, xs))
let rec append (s1 : _ t) (s2 : _ t) : _ t =
s1 >>= function
| Nil -> s2
| Cons(e, s1) -> cons e (append s1 s2)
let rec map f s = s >|= function
| Nil -> Nil
| Cons(x, s) -> Cons(f x, map f s)
let rec fold_left f acc l =
l >>= function
| Cons (x, t) -> fold_left f (f acc x) t
| Nil -> acc
let rec fold_right f acc l =
l >>= function
| Cons (x, t) -> f (fold_right f acc t) x
| Nil -> acc
let rec filter f s = s >>= function
| Nil -> nil
| Cons(e, s) ->
if f e then
cons e (filter f s)
else
filter f s
let rec find f s = s >>= function
| Nil -> M.pure None
| Cons(e, s) ->
if f e then
M.pure (Some e)
else
find f s
end
module Seq = Make(struct
type 'a m = unit -> 'a
let pure x () = x
let delayed f = f
let map f x () = f (x ())
let bind x f () = f (x ()) ()
end)
module Lazy_list = Make(struct
type 'a m = 'a Lazy.t
let pure = Lazy.from_val
let delayed = Lazy.from_fun
let map f (lazy x) = lazy (f x)
let bind (lazy x) f = f x
end)
module LwtSeq = Make(struct
type 'a m = 'a Lwt.t
let pure = Lwt.return
let delayed = Lwt.wrap
let map = Lwt.map
let bind = Lwt.bind
end)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment