Связывание типа ocaml из-за специализированного рекурсивного использования типа

Question

У меня есть параметризованный тип, который рекурсивно использует сам себя, но со специализированным параметром типа, и когда я реализую универсальный оператор, тип этого оператора слишком тесно связан из-за случая, который обрабатывает специализированное поддерево. В первом примере кода показана проблема, а во втором - обходной путь, который я бы предпочел не использовать, поскольку в реальном коде немало случаев, поэтому дублирование кода таким образом представляет опасность для обслуживания.

Вот минимальный тестовый пример, который показывает проблему:

module Op1 = struct
  type 'a t = A | B  (* 'a is unused but it and the _ below satisfy a sig *)

  let map _ x = match x with
    | A -> A
    | B -> B
end

module type SIG = sig
  type ('a, 'b) t =
    | Leaf  of 'a * 'b
    (* Here a generic ('a, 'b) t contains a specialized ('a, 'a Op1.t) t. *)
    | Inner of 'a * ('a, 'a Op1.t) t * ('a, 'b) t

  val map : ('a -> 'b) -> ('a_t -> 'b_t) -> ('a, 'a_t) t -> ('b, 'b_t) t
end

module Impl : SIG = struct
  type ('a, 'b) t =
    | Leaf  of 'a * 'b
    | Inner of 'a * ('a, 'a Op1.t) t * ('a, 'b) t

  (* Fails signature check:
       Values do not match:
         val map :
           ('a -> 'b) ->
           ('a Op1.t -> 'b Op1.t) -> ('a, 'a Op1.t) t -> ('b, 'b Op1.t) t
       is not included in
         val map :
           ('a -> 'b) -> ('a_t -> 'b_t) -> ('a, 'a_t) t -> ('b, 'b_t) t
   *)
  let rec map f g n = match n with
    | Leaf  (a, b)    -> Leaf  (f a, g b)
    (* possibly because rec call is applied to specialized sub-tree *)
    | Inner (a, x, y) -> Inner (f a, map f (Op1.map f) x, map f g y)
end

Это модифицированная версия Impl.map Устранена проблема, но возникает опасность технического обслуживания.

  let rec map f g n = match n with
    | Leaf  (a, b)    -> Leaf  (f a, g b)
    | Inner (a, x, y) -> Inner (f a, map_spec f x, map f g y)
  and map_spec f n = match n with
    | Leaf  (a, b)    -> Leaf  (f a, Op1.map f b)
    | Inner (a, x, y) -> Inner (f a, map_spec f x, map_spec f y)

Есть ли способ заставить это работать без дублирования тела let rec map?

---

Применение решения Гаше дает следующий рабочий код:

let rec map
    : 'a 'b 'c 'd . ('a -> 'b) -> ('c -> 'd) -> ('a, 'c) t -> ('b, 'd) t
  = fun f g n -> match n with
    | Leaf  (a, b)    -> Leaf  (f a, g b)
    | Inner (a, x, y) -> Inner (f a, map f (Op1.map f) x, map f g y)

Answer 1

Этот стиль рекурсии в определениях типов данных называется "нерегулярный": рекурсивный тип 'a t повторно используется в случае foo t где foo отличается от единственной переменной 'a используется в определении. Другой известный пример - это тип полных бинарных деревьев (ровно 2^n листьев):

type 'a full_tree =
  | Leaf of 'a
  | Node of ('a * 'a) full_tree

Рекурсивные функции, управляющие этими типами данных, обычно страдают от мономорфного ограничения рекурсии языков с выводом типов. Когда вы делаете вывод типа, вы должны догадаться, каким может быть тип рекурсивной функции, прежде чем проверять тип ее тела (как это можно использовать внутри). Языки ML уточняют это предположение путем объединения / вывода, но могут быть выведены только мономорфные типы. Если ваша функция использует себя полиморфно (она рекурсивно вызывает себя для другого типа, отличного от того, что она использовала в качестве входных данных), это не может быть выведено (это неразрешимо в общем случае).

let rec depth = function
| Leaf _ -> 1
| Node t -> 1 + depth t
                      ^
   Error: This expression has type ('a * 'a) full_tree
   but an expression was expected of type 'a full_tree

Начиная с 3.12, OCaml позволяет использовать явную полиморфную аннотацию вида 'a 'b . foo, имея в виду forall 'a 'b. foo:

let rec depth : 'a . 'a full_tree -> int = function
| Leaf _ -> 1
| Node t -> 1 + depth t

Вы можете сделать то же самое в вашем примере. Тем не менее, я не смог скомпилировать тип после использования аннотации в сигнатуре вашего модуля, так как это выглядит неправильно ('a_t просто странно). Вот что я использовал, чтобы заставить это работать:

let rec map : 'a 'b . ('a -> 'b) -> ('a Op1.t -> 'b Op1.t) ->
                      ('a, 'a Op1.t) t -> ('b, 'b Op1.t) t
= fun f g n -> match n with
  | Leaf  (a, b)    -> Leaf  (f a, g b)
  | Inner (a, x, y) -> Inner (f a, map f (Op1.map f) x, map f g y)