Создание шаблона посетителя с полиморфными рекурсивными модулями

(Отказ от ответственности: я совершенно уверен, что это ни в коем случае не идиоматика. Если в OCaml есть какая-то альтернативная идиома обхода дерева, я все слышу :))

Я пишу игрушечный компилятор на OCaml, и мне хотелось бы, чтобы посетитель познакомился с моим большим типом синтаксического дерева. Я написал один, используя классы, но подумал, что было бы интересно попробовать реализовать его, используя модули / функторы. Моя иерархия типов огромна, поэтому позвольте мне проиллюстрировать, что я пытаюсь сделать.

Рассмотрим следующие определения типов (придумывая их на месте):

type expr = 
    SNum of int
  | SVarRef of string
  | SAdd of expr * expr
  | SDo of stmt list

and stmt = 
    SIf of expr * expr * expr
  | SAssign of string * expr

Позвольте мне вкратце проиллюстрировать использование. Скажем, например, я хотел собрать все SVarRef внутри программы. Если бы у меня был посетитель отображения (тот, который посещает каждый узел дерева и по умолчанию ничего не делает), я мог бы сделать следующее (в идеальном мире):

module VarCollector : (sig 
  include AST_VISITOR 
  val var_refs : (string list) ref 
end) = struct
  include MapVisitor

  let var_refs = ref []

  let s_var_ref (s : string) =
    var_refs := s::!var_refs
    SVarRef(s)
end

(* Where my_prog is a stmt type *)
let refs = begin 
  let _ = VarCollector.visit_stmt my_prog in
    VarCollector.!var_refs
end

Я должен отметить, что преимущество наличия функций для каждого конкретного варианта состоит в том, что моя фактическая кодовая база имеет тип, который имеет большое количество вариантов и не имеет смысла для фрагментации. Зависящие от варианта функции позволяют избежать повторных итерационных реализаций для других вариантов типа.

Кажется достаточно простым, но вот загвоздка: бывают разные типы посетителей. MapVisitor возвращает исходное синтаксическое дерево, поэтому оно имеет тип

sig
  (** Dispatches to variant implementations *)
  val visit_stmt : stmt -> stmt
  val visit_expr : expr -> expr
  (** Variant implementations *)
  val s_num : int -> expr
  val s_var_ref : string -> expr
  val s_add : (expr * expr) -> expr
  val s_do : stmt list -> expr
  val s_if : (expr * expr * expr) -> stmt
  val s_assign : (string * expr) -> stmt
end

В то же время можно представить сворачивающегося посетителя, у которого тип возвращаемого значения - несколько t для каждой функции. Пытаясь максимально абстрагироваться от этого, вот моя попытка:

module type AST_DISPATCHER = sig
  type expr_ret
  type stmt_ret
  val visit_expr : expr -> expr_ret
  val visit_stmt : stmt -> stmt_ret
end
(** Concrete type designation goes in AST_VISITOR_IMPL *)
module type AST_VISITOR_IMPL = sig
  type expr_ret
  type stmt_ret

  val s_num : int -> expr_ret
  val s_var_ref : string -> expr_ret
  val s_add : (expr * expr) -> expr_ret
  val s_do : stmt list -> expr_ret

  val s_if : (expr * expr * expr) -> stmt_ret
  val s_assign : (string * expr) -> stmt_ret
end
module type AST_VISITOR = sig
  include AST_VISITOR_IMPL
  include AST_DISPATCHER with type expr_ret := expr_ret
                          and type stmt_ret := stmt_ret
end

(** Dispatcher Implementation *)
module AstDispatcherF(IM : AST_VISITOR_IMPL) : AST_DISPATCHER = struct
  type expr_ret = IM.expr_ret
  type stmt_ret = IM.stmt_ret

  let visit_expr = function
    | SNum(i) -> IM.s_num i
    | SVarRef(s) -> IM.s_var_ref s
    | SAdd(l,r) -> IM.s_add (l,r)
    | SDo(sl) -> IM.s_do sl

  let visit_stmt = function
    | SIf(c,t,f) -> IM.s_if (c,t,f)
    | SAssign(s,e) -> IM.s_assign (s,e)
end
module rec MapVisitor : AST_VISITOR = struct
  type expr_ret = expr
  type stmt_ret = stmt
  module D : (AST_DISPATCHER with type expr_ret := expr_ret
                              and type stmt_ret := stmt_ret)
    = AstDispatcherF(MapVisitor)

  let visit_expr = D.visit_expr
  let visit_stmt = D.visit_stmt

  let s_num i = SNum i
  let s_var_ref s = SVarRef s
  let s_add (l,r) = SAdd(D.visit_expr l, D.visit_expr r)
  let s_do sl = SDo(List.map D.visit_stmt sl)

  let s_if (c,t,f) = SIf(D.visit_expr c, D.visit_expr t, D.visit_expr f)
  let s_assign (s,e) = SAssign(s, D.visit_expr e)
end

Однако запуск этого метода дает мне следующее сообщение об ошибке:

Error: Signature Mismatch:
       Values do not match:
         val visit_expr : expr -> expr_ret
       is not included in
         val visit_expr : expr -> expr_ret

Я знаю, что это означает, что я неправильно выражаю отношения между типами, но я не могу понять, что это за исправление в этом случае.