recursive module as a fix point in OCaml - module

Question

Is it possible to write the module Nat as a fixpoint or a universal algebra for some functor NatF ?
module rec Nat : sig
type t = Z | S of Nat.t
end = struct
type t = Z | S of Nat.t
end
Presumably to_int would then be a regular fold
let rec to_int : Nat.t -> int = function Z -> 0 | S x -> 1 + to_int x

Answer 1

I am not sure that I fully understand your question, but it looks like that you want to define a fixed-point combinator on the type level, so that you can write,
module NatF = Fix(functor (F : F)(T:T) -> struct
type t = Z | S of F(T).t
end)
module R = NatF(struct type s type t = Z | S of s end)
It is possible, e.g.,
module type T = sig type t end
module type F = functor (T : T) -> T
module type F2F = functor (F : F) -> F
module type Fix = functor (F : F2F) -> F
module rec Fix : Fix = functor (F : F2F) -> F (Fix(F))
but the problem is that it will leave the resulting type R.t abstract, so you can't write the to_int function over R.t. Even if you will try to define the to_int function inside of the open-recursive functor, you won't be able to recurse over the F(T).t type of the S branch as it will be abstract.
So, I believe, that in the end, you will still have to rely either on the recursion that is implicit in the type definition or on recursive modules to tighten up the fixed point, e.g.,
module type T = sig type t end
module Nat (T : T) = struct
module type S = sig
type t = Z | S of T.t
end
end
module type F = functor (T : T) -> Nat(T).S
module type F2F = functor (F : F) -> F
module type Fix = functor (F : F2F) -> F
module rec Fix : Fix = functor (F : F2F) -> F (Fix(F))
module F = functor(F : F)(T : T) -> struct
type t = F(T).t = Z | S of T.t
end
module rec R : sig
type t = Z | S of R.t
end = Fix(F)(R)

Answer 2

rephrasing Ivg's answer and its issue (with a tweak to make it compile - interesting to understand "safe module")
module Ivg = struct
module type T = sig type t end
module type F = functor (T : T) -> T
module NatF (T : T) = struct
type t = Z | S of T.t
end
module type Fix = functor (F : F) -> T
module rec Fix : Fix =
functor (F : F) -> F (struct type t = Fix(F).t end) (*tweak - prevent loop at definition - cf "safe module" at https://caml.inria.fr/pub/papers/xleroy-recursive_modules-03.pdf *)
module Nat = Fix (NatF)
(* As mentioned by #ivg :
it will leave the resulting type Nat.t abstract,
so you can't write the to_int function over Nat.t.
Even if you will try to define the to_int function inside of the open-recursive functor,
you won't be able to recurse over the F(T).t type of the S branch as it will be abstract. *)
end
Whose solution can be approximated by
module type T = sig type t end
module type F = functor (T : T) -> T
module rec NatF : F =
functor (T : T) ->
struct
type t = Z | S of T.t
end
and FixedNat : T = struct
type t = NatF(FixedNat).t
end
Fix now statically know it is being applied to NatF.
But T is still abstract
I don't know any other way as of yet (modular implicit ?)

Answer 3

Another way of expressing Nat
(* type 't natF = Z | S of 't *)
module rec FixedNat : sig
module type Z = sig end
module type S = sig
val n : FixedNat.n
end
type n = Z | S of (module S)
end =
FixedNat
let rec to_int : FixedNat.n -> int = function
| Z -> 0
| S (module N) -> to_int N.n
which still does not express FixedNat as an explicit fix point of an algebra

Answer 4

Another approximate solution.
The encoding of modules fixed point can be done through its universal property for type level algebras
module Algebras = struct
(* type level natf_algebra : 'a natF -> 'a *)
module type natF_algebra = sig
type a
val zero : a
val succ : a -> a
end
(* A type level algebra lowered *)
type 'a natF_algebra = (module natF_algebra with type a = 'a)
(* is an ordinary value level algebra *)
type 'a natf = Z | S of 'a
type 'a natf_algebra = { alg : 'a natf -> 'a }
end
module Encoding = struct
open Algebras
(* Universal encoding *)
module type NatU = sig
module Ap : functor (F : natF_algebra) -> sig
val res : F.a
end
end
type natU = (module NatU)
(* recursive module *)
module rec FixedNat : sig
module type Z = sig end
module type S = sig
val n : FixedNat.n
end
type n = Z | S of (module S)
end =
FixedNat
end
module Equivalence = struct
open Algebras
open Encoding
let fixedNat_to_natU : FixedNat.n -> natU =
fun n ->
(module struct
module Ap (F : natF_algebra) = struct
let rec foldNat = function
| FixedNat.Z -> F.zero
| FixedNat.S (module N) -> foldNat N.n |> F.succ
let res = foldNat n
end
end)
let rec natU_to_fixedNat : natU -> FixedNat.n =
fun (module N) ->
let module M = N.Ap (struct
type a = FixedNat.n
let zero = FixedNat.Z
let succ x =
FixedNat.S
(module struct
let n = x
end)
end) in
M.res
end