ocaml class 方法接受派生 classes

ocaml class with method accepting derived classes

考虑以下代码:

module Proxy = struct
  type 'a t
end

class qObject proxy = object(self : 'self)
  method proxy : 'self Proxy.t = proxy
end

class qWidget proxy = object(self : 'self)
  inherit qObject proxy
  method add : qWidget -> unit = fun w -> ()
  method as_qWidget = (self :> qWidget)
end

class qButton proxy = object(self : 'self)
  inherit qWidget proxy
  method text = "button"
end

let qObject_proxy : qObject Proxy.t = Obj.magic 0
let qWidget_proxy : qWidget Proxy.t = Obj.magic 0
let qButton_proxy : qButton Proxy.t = Obj.magic 0

let qObject = new qObject qObject_proxy
let qWidget = new qWidget qWidget_proxy
let qButton = new qButton qButton_proxy

let () = qWidget#add qWidget
let () = qWidget#add qButton#as_qWidget

该代码的类型和编译都很好。但是 qButton 必须手动转换为我想要消除的 qWidget。我希望 qWidget#add 接受另一个 qWidget 或任何派生的 class(如 qButton)。我认为 #qWidget 是正确的类型,但这不起作用:

class qWidget proxy = object(self : 'self)
  inherit qObject proxy
  method add : #qWidget -> unit = fun w -> ()
end

Error: Some type variables are unbound in this type: ...
The method add has type 'c -> unit where 'c is unbound

class qWidget proxy = object(self : 'self)
  inherit qObject proxy
  method add : 'a . (#qWidget as 'a) -> unit = fun w -> ()
end

Error: The universal type variable 'a cannot be generalized:
it escapes its scope.

是否有一些我没有看到的解决方法?

我找到了解决这个问题的方法。诀窍是 add 不需要从 qWidget 派生的对象,而只需要一个可以将其自身转换为 qWidget 的对象,就像 as_qWidget 方法一样。这样就可以将对 qWidget 的必要转换拉入方法中,而无需麻烦的#qWidget。

class qWidget proxy = object(self : 'self)
  inherit qObject proxy
  method add : 'a . (<as_qWidget : qWidget; ..> as 'a) -> unit
             = fun w -> let w = w#as_qWidget in ()
  method as_qWidget = (self :> qWidget)
end