Skip to content

Instantly share code, notes, and snippets.

@henrytill
Forked from tel/recur.ml
Created March 25, 2017 19:47
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save henrytill/44e2ab75c524bb8ee84b0e61ac981a27 to your computer and use it in GitHub Desktop.
Save henrytill/44e2ab75c524bb8ee84b0e61ac981a27 to your computer and use it in GitHub Desktop.
Not as bad as I feared
module type Functor = sig
type 'a t
val map : ('a -> 'b) -> ('a t -> 'b t)
end
module Mu (F : Functor) : sig
type t = { mu : t F.t }
val cata : ('a F.t -> 'a) -> (t -> 'a)
end = struct
type t = { mu : t F.t }
let rec cata phi t = phi (F.map (cata phi) t.mu)
end
module ListF (T : sig type a end) = struct
type 'a t = Nil | Cons of T.a * 'a
let map f = function
| Nil -> Nil
| Cons (x, a) -> Cons (x, f a)
end
module MuList (T : sig type a end) = struct
module ListA = ListF (T)
module Base = Mu (ListA)
include Base
let of_list l s =
let cons hd tl = { mu = ListA.Cons (hd, tl) } in
let nil = { mu = ListA.Nil } in
List.fold_right cons s nil
let to_list =
cata begin function
| ListA.Nil -> []
| ListA.Cons (hd, tl) -> hd :: tl
end
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment