optics subtyping via phantom type + class type

o.ml

class type a_setter = object
  method setter : unit
end

class type a_getter = object
  method getter : unit
end

class type a_lens = object
  inherit a_getter
  inherit a_setter
  method lens : unit
end

class type a_prism = object
  inherit a_setter
  method prism : unit
end

type (+'k, -'s, +'t, +'a, -'b) _t
type (+'k, -'s, +'t, +'a, -'b) t = unit -> ('k, 's, 't, 'a, 'b) _t

type (-'s, +'t, +'a, -'b) setter = (a_setter, 's, 't, 'a, 'b) t
type (-'s, +'t, +'a, -'b) getter = (a_getter, 's, 't, 'a, 'b) t
type (-'s, +'t, +'a, -'b) lens = (a_lens, 's, 't, 'a, 'b) t
type (-'s, +'t, +'a, -'b) prism = (a_prism, 's, 't, 'a, 'b) t

let (//) : ('k, 'a, 'b, 'c, 'd) t -> ('k, 'c, 'd, 'e, 'f) t -> ('k, 'a, 'b, 'e, 'f) t =
  fun _ _ -> assert false

let _1 : ('a * 'x, 'b * 'x, 'a, 'b) lens = assert false
let _2 : ('x * 'a, 'x * 'b, 'a, 'b) lens = assert false

let _Some : ('a Option.t, 'b Option.t, 'a, 'b) prism = assert false

let set : (#a_setter, 's, 't, 'a, 'b) t -> 'b -> 's -> 't = assert false
let get : (#a_getter, 's, 't, 'a, 'b) t -> 's -> 'a = assert false

let _1_2_set () = set (_1 // _2)
let _1_2_get () = get (_1 // _2)

let _Some_set () = set _Some
    (*
let _Some_get () = get _Some
       *)

let _1_Some_set () = set ((_1 :> _ setter) // (_Some :> _ setter))
(*
let _1_Some_get () = get ((_1 :> _ getter) // (_Some :> _ getter))
*)