Глава 3 . Объекты в OCaml

Класс point ниже определяет одну переменную класса x с начальным значением 0 и метод move. Переменная объявлена как изменяемая, поэтому метод может менять ее значение.

#class point =
   object 
     val mutable x = 0
     method get_x = x
     method move d = x <- x + d
   end;;

class point :
  object val mutable x : int method get_x : int method move : int -> unit end

Новая точка p является экземпляром класса point.

#let p = new point;;

val p : point = <obj>

Тип p указан как point. Это сокращение, автоматически созданное при определении класса выше, и расшифровывается как <get_x : int; move : int -> unit>, то есть методы класса point и их типы.

Вызовем методы p.

#p#get_x;;

- : int = 0

#p#move 3;;

 : unit = ()

#p#get_x;;

- : int = 3

Тело класса вычисляется только во время создания объекта. Однако в следующем примере переменная класса x инициализируется разными значениями для двух разных объектов.

#let x0 = ref 0;;

val x0 : int ref = {contents = 0}

#class point =
   object 
     val mutable x = incr x0; !x0
     method get_x = x
     method move d = x <- x + d
   end;;

class point :
  object val mutable x : int method get_x : int method move : int -> unit end

#new point#get_x;;

- : int = 1

#new point#get_x;;

- : int = 2

Класс point можно абстрагировать от начального значения координаты x.

#class point = fun x_init -> 
   object 
     val mutable x = x_init
     method get_x = x
     method move d = x <- x + d
   end;;

class point :
  int ->
  object val mutable x : int method get_x : int method move : int -> unit end

Как и в случае с функциями это определение можно записать в сокращенной форме.

#class point x_init =
   object 
     val mutable x = x_init
     method get_x = x
     method move d = x <- x + d
   end;;

class point :
  int ->
  object val mutable x : int method get_x : int method move : int -> unit end

Теперь экземпляр класса point является функцией и требует начальный параметр для создания нового объекта.

#new point;;

- : int -> point = <fun>

#let p = new point 7;;

val p : point = <obj>

Параметр x_init видим во всем определении класса, включая методы. Метод get_offset возвращает положение объекта относительно начальной точки.

#class point x_init =
   object 
     val mutable x = x_init
     method get_x = x
     method get_offset = x - x_init
     method move d = x <- x + d 
   end;;

class point :
  int ->
  object
    val mutable x : int
    method get_offset : int
    method get_x : int
    method move : int -> unit
  end

До определения тела класса могут вычисляться и связываться различные выражения, что бывает полезно для форсирования инвариантов. Например, точка может принудительно размещаться на ближайшем узле решетки:

#class adjusted_point x_init =
   let origin = (x_init / 10) * 10 in
   object 
     val mutable x = origin
     method get_x = x
     method get_offset = x - origin
     method move d = x <- x + d
   end;;

class adjusted_point :
  int ->
  object
    val mutable x : int
    method get_offset : int
    method get_x : int
    method move : int -> unit
  end

(Если координата x_init не попадает на решетку, можно возбудить исключение.) На самом деле, тот эже эффект дает вызов опеределения класса point со значением origin.

#class adjusted_point x_init =  point ((x_init / 10) * 10);;

class adjusted_point : int -> point

Еще один способ - поместить поправку в специальную функцию размещения.

#let new_adjusted_point x_init = new point ((x_init / 10) * 10);;

val new_adjusted_point : int -> point = <fun>

Впрочем, первый способ, как правило, предпочтительнее, поскольку код поправки входит в определение класса и наследуется.

Эта возможность позволяет создавать множественные конструкторы одного класса с разными начальными параметрами, как в других языках, а альтернативой ей являются инициализаторы, о которых речь пойдет в разделе 3.3.

Метод или инициализатор может посылать сообщения самому себе, то есть текущему объекту. Соответствующая переменная должна быть явно связана (в примере ниже - переменная s, но имя может быть любым; чаще всего используется self).

#class printable_point x_init =
   object (s)
     val mutable x = x_init
     method get_x = x
     method move d = x <- x + d
     method print = print_int s#get_x
   end;;

class printable_point :
  int ->
  object
    val mutable x : int
    method get_x : int
    method move : int -> unit
    method print : unit
  end

#let p = new printable_point 7;;

val p : printable_point = <obj>

#p#print;;

7- : unit = ()

Переменная s связывается динамически при вызове метода. В частности, при наследовании класса printable_point переменная s связывается с объектом субкласса.

Связывания let вычисляются при создании объекта, но есть также возможность вочислять выражения непосредственно после его конструирования. Такие выражения записываются как анонимные скрытые методы и называются инициализаторами. Они имеют доступ к самим себе и переменным класса.

#class printable_point x_init =
   let origin = (x_init / 10) * 10 in
   object (self)
     val mutable x = origin
     method get_x = x
     method move d = x <- x + d
     method print = print_int self#get_x
     initializer print_string "new point at "; self#print; print_newline()
   end;;

class printable_point :
  int ->
  object
    val mutable x : int
    method get_x : int
    method move : int -> unit
    method print : unit
  end

#let p = new printable_point 17;;

new point at 10
val p : printable_point = <obj>

Инициализаторы нельзя переопределять. С другой стороны, они вычисляются последовательно. Удобнее всего инициализаторы для форсирования инвариантов. Еще один пример приведен в разделе 5.1.

Ключевое слово virtual позволяет объявить метод, не определяя его. Реализация метода дается в субклассах. Класс с виртуальными методами помечается как virtual и не может инстациироваться (то есть создавать объекты этого класса нельзя). Он также определяет сокращение типа (вместе с виртуальными методами).

#class virtual abstract_point x_init =
   object (self)
     val mutable x = x_init
     method virtual get_x : int
     method get_offset = self#get_x - x_init
     method virtual move : int -> unit
   end;;

class virtual abstract_point :
  int ->
  object
    val mutable x : int
    method get_offset : int
    method virtual get_x : int
    method virtual move : int -> unit
  end

#class point x_init =
   object
     inherit abstract_point x_init
     method get_x = x
     method move d = x <- x + d 
   end;;

class point :
  int ->
  object
    val mutable x : int
    method get_offset : int
    method get_x : int
    method move : int -> unit
  end

Приватные методы не отображаются в интерфейсах объектов и могут быть вызваны только из других методов этих объектов.

#class restricted_point x_init =
   object (self)
     val mutable x = x_init
     method get_x = x
     method private move d = x <- x + d
     method bump = self#move 1
   end;;

class restricted_point :
  int ->
  object
    val mutable x : int
    method bump : unit
    method get_x : int
    method private move : int -> unit
  end

#let p = new restricted_point 0;;

val p : restricted_point = <obj>

#p#move 10;;

This expression has type restricted_point
It has no method move

#p#bump;;

- : unit = ()

Приватные методы видны в субклассах и наследуются, если только они не скрыты сигнатурой, и могут стать в субклассах публичными.

#class point_again x =
   object (self)
     inherit restricted_point x
     method virtual move : _
   end;;

class point_again :
  int ->
  object
    val mutable x : int
    method bump : unit
    method get_x : int
    method move : int -> unit
  end

Метка virtual добавлена здесь лишь для того, чтобы декларировать метод, не определяя его. Поскольку меткиprivate нет, метод становится публичным, сохраняя прежнее определение.

Альтернативное определение таково:

#class point_again x =
   object (self : < move : _; ..> )
     inherit restricted_point x
   end;;

class point_again :
  int ->
  object
    val mutable x : int
    method bump : unit
    method get_x : int
    method move : int -> unit
  end

Ограничение типа требует сделать метод move публичным, и этого достаточно, чтобы переопределить спецификатор private.

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

#class point_again x =
   object
     inherit restricted_point x as super
     method move = super#move 
   end;;

class point_again :
  int ->
  object
    val mutable x : int
    method bump : unit
    method get_x : int
    method move : int -> unit
  end

Естественно, приватные методы могут быть виртуальными. Ключевые слова в этом случае идут в таком порядке: method private virtual.

Интерфейсы классов выводятся из определения классов, но их можно определять явно, накладывая ограничения на тип класса. Как и определения класса, интерфейс создает сокращение типа.

#class type restricted_point_type = 
   object
     method get_x : int
     method bump : unit
 end;;

class type restricted_point_type =
  object method bump : unit method get_x : int end

#fun (x : restricted_point_type) -> x;;

- : restricted_point_type -> restricted_point_type = <fun>

Интерфейсы могут использоваться как для документирования класса, так и для ограничения его типа. Можно скрыть переменные класса и приватные методы. Публичные и виртуальные методы, однако, останутся доступными.

#class restricted_point' x = (restricted_point x : restricted_point_type);;

class restricted_point' : int -> restricted_point_type

Или, что то же самое:

#class restricted_point' = (restricted_point : int -> restricted_point_type);;

class restricted_point' : int -> restricted_point_type

Также интерфейс класса указывается в сигнатуре модуля и в этом случает ограничивает ее.

#module type POINT = sig 
   class restricted_point' : int ->
     object    
       method get_x : int
       method bump : unit
     end 
 end;;

module type POINT =
  sig
    class restricted_point' :
      int -> object method bump : unit method get_x : int end
  end

#module Point : POINT = struct 
   class restricted_point' = restricted_point
 end;;

module Point : POINT

Для демонстрации механизмов наследования мы создадим класс цветной точки, унаследовав его от точки. У нового класса будут все переменные класса и методы старого, и в придачу еще переменная класса c и метод color.

#class colored_point x (c : string) =
   object 
     inherit point x
     val c = c
     method color = c
   end;;

class colored_point :
  int ->
  string ->
  object
    val c : string
    val mutable x : int
    method color : string
    method get_offset : int
    method get_x : int
    method move : int -> unit
  end

#let p' = new colored_point 5 "red";;

val p' : colored_point = <obj>

#p'#get_x, p'#color;;

val p' : colored_point = <obj>

Точка и цветная точка несовместимы по типу, поскольку у точки нет метода color. Однако ниже приведена обобщенная функция get_succ_x, которая вызывает одноименный метод для любого объекта p, для которого он определен. Поэтому она будет работать и с точкой, и с цветной точкой.

#let get_succ_x p = p#get_x + 1;;

val get_succ_x : < get_x : int; .. > -> int = <fun>

#get_succ_x p + get_succ_x p';;

- : int = 8

Предварительное объявление методов не требуется:

#let set_x p = p#set_x;;

val set_x : < set_x : 'a; .. > -> 'a = <fun>

#let incr p = set_x p (get_succ_x p);;

val incr : < get_x : int; set_x : int -> 'a; .. > -> 'a = <fun>

Множественное наследование допускается. Сохраняется только последнее определение метода. Определяя метод, видимый в родительском классе, субкласс подменяет его. Определения родительских методов можно использовать повторно, явно указав предка. Ниже переменная super связана с printable_point. Имя super является псевдоидентификатором, который может использоваться только для вызова методов суперкласса, как в super#print.

#class printable_colored_point y c = 
   object (self)
     val c = c
     method color = c
     inherit printable_point y as super
     method print =
       print_string "(";
       super#print;
       print_string ", ";
       print_string (self#color);
       print_string ")"
   end;;

class printable_colored_point :
  int ->
  string ->
  object
    val c : string
    val mutable x : int
    method color : string
    method get_x : int
    method move : int -> unit
    method print : unit
  end

#let p' = new printable_colored_point 17 "red";;

new point at (10, red)
val p' : printable_colored_point = <obj>

#p'#print;;

(10, red)- : unit = ()

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

Ссылки можно определить как классы. Наивное определение, впрочем, не проходит проверку типов.

#class ref x_init =
   object 
     val mutable x = x_init
     method get = x
     method set y = x <- y
   end;;

Some type variables are unbound in this type:
  class ref :
    'a ->
    object val mutable x : 'a method get : 'a method set : 'a -> unit end
The method get has type 'a where 'a is unbound

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

#class ref (x_init:int) =
   object 
     val mutable x = x_init
     method get = x
     method set y = x <- y
   end;;

class ref :
  int ->
  object val mutable x : int method get : int method set : int -> unit
   end

Класс для полиморфной ссылке должен явно перечислять типы параметров в квадратных скобках в своем объявлении. Кроме того, эти типы должны быть связаны в теле класса ограничением.

#class ['a] ref x_init = 
   object 
     val mutable x = (x_init : 'a)
     method get = x
     method set y = x <- y
   end;;

class ['a] ref :
  'a -> object val mutable x : 'a method get : 'a method set : 'a -> unit end

#let r = new ref 1 in r#set 2; (r#get);;

- : int = 2

Тип параметра в объявлении может быть ограничен в теле определения класса. В описании типа класса окончательное значение типа параметра выводится оператором constraint.

#class ['a] ref_succ (x_init:'a) = 
   object
     val mutable x = x_init + 1
     method get = x
     method set y = x <- y
   end;;

class ['a] ref_succ :
  'a ->
  object
    constraint 'a = int
    val mutable x : int
    method get : int
    method set : int -> unit
  end

Рассмотрим более сложный пример: определим круг, центр которого может быть точкой любого типа. Дoполнительное ограничение типа мы поместим в метод move, так как свободных переменных среди параметров класса быть не должно.

#class ['a] circle (c : 'a) =
   object 
     val mutable center = c
     method center = center
     method set_center c = center <- c
     method move = (center#move : int -> unit)
   end;;

class ['a] circle :
  'a ->
  object
    constraint 'a = < move : int -> unit; .. >
    val mutable center : 'a
    method center : 'a
    method move : int -> unit
    method set_center : 'a -> unit
  end

Альтернативное определение с ключевым словом constraint в теле определения класса, приведено ниже. Тип #point здесь - это сокращение, созданное при определении класса point. Такая форма записи позволяет использовать любой объект, являющийся субклассом point. На самом деле она переводится в <get_x: int; move: int -> unit; ...>. Таким образом мы получаем альтернативное определение класса circle с чуть более строгим ограничением, предполагающим, что center имеет метод move.

#class ['a] circle (c : 'a) =
   object 
     constraint 'a = #point
     val mutable center = c
     method center = center
     method set_center c = center <- c
     method move = center#move
   end;;

class ['a] circle :
  'a ->
  object
    constraint 'a = < move : int -> unit; .. >
    val mutable center : 'a
    method center : 'a
    method move : int -> unit
    method set_center : 'a -> unit
  end

Класс colored_circle - это особая версия circle, ее центр должен быть объектом класса colored_point, кроме того добавляется метод color. При определении параметризованного класса экземпляр типа параметра должен быть задан явно (он записывается в квадратных скобках).

#class ['a] colored_circle c =
   object
     constraint 'a = #colored_point
     inherit ['a] circle c
     method color = center#color
   end;;

class ['a] colored_circle :
  'a ->
  object
    constraint 'a = #colored_point
    val mutable center : 'a
    method center : 'a
    method color : string
    method move : int -> unit
    method set_center : 'a -> unit
  end

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

Классический пример - итератор.

#List.fold_left;;

- : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = <fun>

#class ['a] intlist (l : int list) =
   object
     method empty = (l = [])
     method fold f (accu : 'a) = List.fold_left f accu l
   end;;

class ['a] intlist :
  int list ->
  object method empty : bool method fold : ('a -> int -> 'a) -> 'a -> 'a end

Кажется, что этот итератор полиморфный, но на самом деле, это не так.

#let l = new intlist [1; 2; 3];;

val l : '_a intlist = <obj>

#l#fold (fun x y -> x+y) 0;;

- : int = 6

#l;;

- : int intlist = <obj>

#l#fold (fun s x -> s ^ string_of_int x ^ " ") "";;

This expression has type int but is here used with type string

Итератор работает, как показывает первый пример со сложением чисел. Однако поскольку сами объекты не полиморфны (полиморфны только их конструкторы), в методе fold их тип фиксируется. Использование в итераторе строк приводит к ошибке.

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

#class intlist (l : int list) =
   object
     method empty = (l = [])
     method fold : 'a. ('a -> int -> 'a) -> 'a -> 'a =
       fun f accu -> List.fold_left f accu l
   end;;

class intlist :
  int list ->
  object method empty : bool method fold : ('a -> int -> 'a) -> 'a -> 'a end

#let l = new intlist [1; 2; 3];;

val l : intlist = <obj>

#l#fold (fun x y -> x+y) 0;;

- : int = 6

#l#fold (fun s x -> s ^ string_of_int x ^ " ") "";;

- : string = "1 2 3 "

Как видно из типа, показанного компилятором, типы полиморфных методов должны быть явно указаны в определении класса(сразу после имени метода), но могут остаться неявными в описании класса.

Тип бывает и вовсе опущен, если он уже известен благодаря наследованию или ограничениям. Вот пример переопределения метода:

#class intlist_rev l =
   object
     inherit intlist l
     method fold f accu = List.fold_left f accu (List.rev l)
   end;;

Следующая идиома позволяет разделять определение и описание:

#class type ['a] iterator =
   object method fold : ('b -> 'a -> 'b) -> 'b -> 'b end;;
 
 class intlist l =
   object (self : int #iterator)
     method empty = (l = [])
     method fold f accu = List.fold_left f accu l
   end;;

Идиома (self : int #iterator) дает гарантию, что объект реализует интерфейс iterator.

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

#let sum lst = lst#fold (fun x y -> x+y) 0;;

val sum : < fold : (int -> int -> int) -> int -> 'a; .. > -> 'a = <fun>

#sum l;;

This expression has type
  intlist = < empty : bool; fold : 'a. ('a -> int -> 'a) -> 'a -> 'a >
but is here used with type
  < empty : bool; fold : (int -> int -> int) -> int -> 'b >

Решение просто: тип параметра нужно ограничить.

#let sum (lst : _ #iterator) = lst#fold (fun x y -> x+y) 0;;

val sum : int #iterator -> int = <fun>

Разумеется, ограничения могут быть явно указаны в типах метода. При этом требуется перечислить только квантифицированные переменные.

#let sum lst =
   (lst : < fold : 'a. ('a -> _ -> 'a) -> 'a -> 'a; .. >)#fold (+) 0;;

val sum : < fold : 'a. ('a -> int -> 'a) -> 'a -> 'a; .. > -> int = <fun>

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

#class type point0 = object method get_x : int end;;

class type point0 = object method get_x : int end

#class distance_point x =
   object
     inherit point x
     method distance : 'a. (#point0 as 'a) -> int =
       fun other -> abs (other#get_x - x)
   end;;

class distance_point :
  int ->
  object
    val mutable x : int
    method distance : #point0 -> int
    method get_offset : int
    method get_x : int
    method move : int -> unit
  end

#let p = new distance_point 3 in
 (p#distance (new point 8), p#distance (new colored_point 1 "blue"));;

- : int * int = (5, 2)

Следует обратить внимание на специальный синтаксис (#point0 as 'a) - он используется для квантификации расширяемой части #point0. Если требуется полиморфизм в поле объекта, оно должно квантифицироваться отдельно.

#class multi_poly =
   object
     method m1 : 'a. (< n1 : 'b. 'b -> 'b; .. > as 'a) -> _ =
       fun o -> o#n1 true, o#n1 "hello"
     method m2 : 'a 'b. (< n2 : 'b -> bool; .. > as 'a) -> 'b -> _ =
       fun o x -> o#n2 x
   end;;

class multi_poly :
  object
    method m1 : < n1 : 'a. 'a -> 'a; .. > -> bool * string
    method m2 : < n2 : 'b -> bool; .. > -> 'b -> bool
  end

В методе m1 объект o должен по крайней мере иметь полиморфный метод n1. В методе m2 аргументы n2 и x должны иметь один и тот же тип, квантифицируемый на том же уровне, что и 'a.

Выделение подтипов не бывает неявным. Однако осуществляется онo двумя способами. Наиболее общий подход является полностью явным: должны быть заданы как область определения (domain), так и область значения (codomain) приведения типов.

Точка и цветная точка несовместимы по типу и не могут, например, входить в один и тот же список. Однако цветная точка может быть приведена к точке путем сокрытия метода color.

#let colored_point_to_point cp = (cp : colored_point :> point);;

val colored_point_to_point : colored_point -> point = <fun>

#let p = new point 3 and q = new colored_point 4 "blue";;

val p : point = <obj>
val q : colored_point = <obj>

#let l = [p; (colored_point_to_point q)];;

val l : point list = [<obj>; <obj>]

Объект типа t может отображаться как объект типа t' только в том случае, если t является подтипом t'. Например, к точке нельзя обратиться как к цветной точке.

#(p : point :> colored_point);;

Type point = < get_offset : int; get_x : int; move : int -> unit >
is not a subtype of type
  colored_point =
    < color : string; get_offset : int; get_x : int; move : int -> unit > 

Поэтому конкретизация приведения может быть небезопасной, должна по идее сочетаться с точным указанием типа и может привести к ошибке времени исполнения. Впрочем, в Objective Caml такая операция невозможна.

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

Область определения в приведении типа обычно опускается. Например, возможна такая конструкция:

#let to_point cp = (cp :> point);;

val to_point : #point -> point = <fun>

В этом случае функция colored_point_to_point является частным случаем функции to_point. Однако так бывает не всегда. Явное приведение более точно. Возьмем для примера следующий класс:

#class c0 = object method m = {< >} method n = 0 end;;

class c0 : object ('a) method m : 'a method n : int end

Объект типа c - это сокращение для <m : 'a> as 'a. Теперь возьмем декларацию типа:

#class type c1 =  object method m : c1 end;;

class type c1 = object method m : c1 end

Объект типа c1 - сокращение для <m : 'a> as 'a. Приведение объекта типа c1 к типу c0 допустимо:

#fun (x:c0) -> (x : c0 :> c1);;

- : c0 -> c1 = <fun>

Но здесь область определения опускать нельзя:

#fun (x:c0) -> (x :> c1);;

This expression cannot be coerced to type c1 = < m : c1 >; it has type
  c0 = < m : c0; n : int > as 'a
but is here used with type 'a
Type c0 = 'a is not compatible with type 'a 
Type c0 = 'a is not compatible with type c1 = < m : c1 > 
Only the first object type has a method n.
This simple coercion was not fully general. Consider using a double coercion.

Выход в использовании явной формы. Иногда проблему помогает разрешить изменение определения класса.

#class type c2 =  object ('a) method m : 'a end;;

class type c2 = object ('a) method m : 'a end

#fun (x:c0) -> (x :> c2);;

- : c0 -> c2 = <fun>

Несмотря на свои различия, классы c1 и c2 расширяются в один и тот же тип объекта (общие имена и типы методов). Кроме того, когда область определения остается неявной, а область значения является сокращением известного типа класса, для функции приведения используется тип класса, а не объекта. Поэтому при приведении субкласса к суперклассу в большинстве случаев можно оставлять область определения неявной. Тип приведения всегда можно посмотреть:

#let to_c1 x = (x :> c1);;

val to_c1 : < m : #c1; .. > -> c1 = <fun>

#let to_c2 x = (x :> c2);;

val to_c2 : #c2 -> c2 = <fun>

Обратите внимание на различие приведений: во втором случае тип #c2 = < m : 'a; .. > as 'a полиморфически рекурсивен (согласно явной рекурсии в типе класса c2), потому и возможно преобразование к объекту класса c0. С другой стороны, c1 в первом случае расширяется только до m : < m : c1; .. >; .. > (вспомним #c1 = < m : c1; .. >, причем рекурсия не появляется. Кроме того, можно заметить, что тип to_c2 - #c2 -> c2, хотя тип to_c1 более общий, чем #c1 -> c1. Это не совсем так, поскольку возможны типы классов, для которых некоторые экземляры #c не будут подтипами c (это объясняется в разделе 3.15). Кроме того, для класса без парамтеров приведение (_ :> c) будет более общим, чем (_ : #c :> c).

Зачастую ошибочно пытаются определить функцию приведения во время определения класса. Проблема в том, что в этом случае сокращение типа еше не сформировано, потому и субтипы его неизвестны. Так что функция приведения (_ :> c) или (_ : #c :> c) становится функцией идентичности.

#function x -> (x :> 'a);;

- : 'a -> 'a = <fun>

Таким образом, если приведение применяется, как в примере ниже к self, тип self объединяется с закрытым типом c (закрытый тип - это объектный тип без многоточия). В результате тип self должен быть также закрыт, что недопустимо, поскольку не позволит в дальнейшем расширять его. Поэтому в случаях, когда при объединении двух типов получучается закрытый объектный тип, генерируется ошибка.

#class c = object method m = 1 end
 and d = object (self)
   inherit c
   method n = 2
   method as_c = (self :> c)
 end;;

This expression cannot be coerced to type c = < m : int >; it has type
  < as_c : 'a; m : int; n : int; .. >
but is here used with type c = < m : int >
Self type cannot be unified with a closed object type

Однако, наиболее распространенный случай, а именно приведение self к текущему классу рапознается мехнизмом проверки типов и типизируется правильно.

#class c = object (self) method m = (self :> c) end;;

class c : object method m : c end

В результате становится возможной идиома, сохраняющая список всех объектов, принадлежащих к некоему классу или его субклассам:

#let all_c = ref [];;

val all_c : '_a list ref = {contents = []}

#class c (m : int) =
   object (self)
     method m = m
     initializer all_c := (self :> c) :: !all_c
   end;;

class c : int -> object method m : int end

Эта идиома позволяет получить объект, тип которого был приведен к суперклассу:

#let rec lookup_obj obj = function [] -> raise Not_found
   | obj' :: l ->
      if (obj :> < >) = (obj' :> < >) then obj' else lookup_obj obj l ;;

val lookup_obj : < .. > -> (< .. > as 'a) list -> 'a = <fun>

#let lookup_c obj = lookup_obj obj !all_c;;

val lookup_c : < .. > -> < m : int > = <fun>

Тип < m : int > является просто расширением с, поскольку используется ссылка. Словом, функция действительно вернула объект класса c.

Проблемы, описанной выше можно и вовсе избежать, определив сначала сокращение с помощью типа класса.

#class type c' = object method m : int end;;

class type c' = object method m : int end

#class c : c' = object method m = 1 end
 and d = object (self)
   inherit c
   method n = 2
   method as_c = (self :> c')
 end;;

class c : c'
class d : object method as_c : c' method m : int method n : int end

Другой способ состоит в том, чтобы воспользоваться виртуальным классом - при наследовании от него все методы c будут иметь тот же тип, что и методы c'.

#class virtual c' = object method virtual m : int end;;

class virtual c' : object method virtual m : int end

#class c = object (self) inherit c' method m = 1 end;;

class c : object method m : int end

Можно также задать сокращение типа явно:

#type c' = <m : int>;;

Впрочем сокращение #c' так определить не получится. Оно задается определением либо класса, либо типа класса. Сокращения со знаком диеза # неявно включют анонимную переменную .., а ее явно именовать нельзя. Наиболее близок к цели следующий код:

#type 'a c'_class = 'a constraint 'a = < m : int; .. >;;

Здесь появляется дополнительная переменная типа, фиксирующая открытость объекта.

Можно написать версию класса point без присвоения переменной экземпляра. Конструкция {<...>} возвращает копию self (то есть текущего объекта) и способная изменять некторые переменные экземпляра.

#class functional_point y =
   object 
     val x = y
     method get_x = x
     method move d = {< x = x + d >}
   end;;

class functional_point :
  int ->
  object ('a) val x : int method get_x : int method move : int -> 'a end

#let p = new functional_point 7;;

val p : functional_point = <obj>

#p#get_x;;

- : int = 7

#(p#move 3)#get_x;;

- : int = 10

#p#get_x;;

- : int = 7

Обратите внимание, что сокращение типа functional_point рекурсивно, что видно в типе класса functional_point: тип self - 'a, а кроме того 'a появляется внутри типа метода move.

Вышеприведенное определение functional_point не эквивалентно следующему:

#class bad_functional_point y =
   object 
     val x = y
     method get_x = x
     method move d = new functional_point (x+d)
   end;;

class bad_functional_point :
  int ->
  object
    val x : int
    method get_x : int
    method move : int -> functional_point
  end

#let p = new functional_point 7;; 

val p : functional_point = <obj>

#p#get_x;;

- : int = 7

#(p#move 3)#get_x;;

- : int = 10

#p#get_x;;

- : int = 7

Объекты обоих классов ведут себя одинаково, но объекты их субклассов будут различаться. Субкласс второго класса в методе move будет по-прежнему возвращать объект родительского класса, а в первом случае метод вернет объект субкласса.

Такая техника часто используется вместе с бинарными методами, что показано в разделе 5.2.1.

Как императивные, так и функциональные объекты можно клонировать. Библиотечная функция OO.copy создает поверхностную копию объекта, то есть возвращает объект, равный предыдущему. Переменные экземпляра копируются, однако их содержание разделяется между оригиналом и копией. Присвоение значения переменной через вызов метода у копии не затрагивает оригинал и наоброт. Более глубокое присвоение (если, например, переменная является ссылкой), разумеется, затронет оба объекта.

Тип OO.copy таков:

#Oo.copy;;

- : (< .. > as 'a) -> 'a = <fun>

Ключевое слово as в данном случае связывает переменную типа 'a с объектом типа < .. >. Таким образом, OO.copy принимает объект с любыми методами (что соотвествует многоточию) и возвращает объект того же типа. Тип функции отличается от < .. > -> < .. >, поскольку каждое многоточие соответствует разным наборам методов - оно ведет себя как переменная типа.

#let p = new point 5;;

val p : point = <obj>

#let q = Oo.copy p;;

val q : < get_offset : int; get_x : int; move : int -> unit > = <obj> 

#q#move 7; (p#get_x, q#get_x);;

- : int * int = (5, 12)

OO.copy p работает как p#copy, если в классе p определен публичный метод copy с телом {< >}.

Объекты сравниваются с помощью обобщенных функций = и <>. Два объекты равны тогда и только тогда, когда имеет место их физическое равенство. В частности, объект и его копия не равны.

#let q = Oo.copy p;;

val q : < get_offset : int; get_x : int; move : int -> unit > = <obj>

#p = q, p = p;;

- : bool * bool = (false, true)

Можно использовать и другие обобщенные операторы сравнения (<, <= и т.д.). Отношение < задает неопределенный, но строгий порядок объектов. Он фиксируется раз и навсегда после создания объектов и в дальнейшем не подвергается изменениям.

Клонирование и переопределение взаимозаменяемы, когда используются внутри объекта и не переопределяют полей.

#class copy =
   object
     method copy = {< >}
   end;;

class copy : object ('a) method copy : 'a end

#class copy =
   object (self)
     method copy = Oo.copy self
   end;;

class copy : object ('a) method copy : 'a end

Только переопределение позволяет переопределять поля, и только примитив OO.copy может использоваться извне.

Клонирование также помогает сохранять и восстанавливать состояние объектов.

#class backup = 
   object (self : 'mytype)
     val mutable copy = None
     method save = copy <- Some {< copy = None >}
     method restore = match copy with Some x -> x | None -> self
   end;;

class backup :
  object ('a)
    val mutable copy : 'a option
    method restore : 'a
    method save : unit
  end

Такой класс допускает сохранение только одного уровня, но множественное наследование позволяет добавить возможность сохранения в любой класс.

#class ['a] backup_ref x = object inherit ['a] ref x inherit backup end;;

class ['a] backup_ref :
  'a ->
  object ('b)
    val mutable copy : 'b option
    val mutable x : 'a
    method get : 'a
    method restore : 'b
    method save : unit
    method set : 'a -> unit
  end

#let rec get p n = if n = 0 then p # get else get (p # restore) (n-1);;

val get : (< get : 'b; restore : 'a; .. > as 'a) -> int -> 'b = <fun>

#let p = new backup_ref 0  in
 p # save; p # set 1; p # save; p # set 2; 
 [get p 0; get p 1; get p 2; get p 3; get p 4];;

- : int list = [2; 1; 1; 1; 1]

Один из вариантов может сохранять все копии (метод clear позвляет вручную удалять их).

#class backup = 
   object (self : 'mytype)
     val mutable copy = None
     method save = copy <- Some {< >}
     method restore = match copy with Some x -> x | None -> self
     method clear = copy <- None
   end;;

class backup :
  object ('a)
    val mutable copy : 'a option
    method clear : unit
    method restore : 'a
    method save : unit
  end

#class ['a] backup_ref x = object inherit ['a] ref x inherit backup end;;

class ['a] backup_ref :
  'a ->
  object ('b)
    val mutable copy : 'b option
    val mutable x : 'a
    method clear : unit
    method get : 'a
    method restore : 'b
    method save : unit
    method set : 'a -> unit
  end

#let p = new backup_ref 0  in
 p # save; p # set 1; p # save; p # set 2; 
 [get p 0; get p 1; get p 2; get p 3; get p 4];;

- : int list = [2; 1; 0; 0; 0]

Рекурсивные классы позволяют опеределить объекты со взаимно рекурсивными типами.

#class window =
   object 
     val mutable top_widget = (None : widget option)
     method top_widget = top_widget
   end
 and widget (w : window) =
   object
     val window = w
     method window = window
   end;;

class window :
  object
    val mutable top_widget : widget option
    method top_widget : widget option
  end
class widget :
  window -> object val window : window method window : window end

Несмотря на взаимную рекурсивность типов, классы window и widget сами по себе независимы.

Бинарным называется метод, аргумент которого имеет тот же тип, что и сам объект. Класс comparable ниже представляет собой шаблон для классов с методом leq типа 'a -> bool, где 'a связывается с типом самого объекта. Таким образом, #comparable разворачивается в < leq : 'a -> bool; .. > as 'a. Здесь же показано, что связка as позволяет писать рекурсивные классы.

#class virtual comparable = 
   object (_ : 'a)
     method virtual leq : 'a -> bool
   end;;

class virtual comparable : object ('a) method virtual leq : 'a -> bool end

Ниже приведено определение класса money как субкласса comparable. На самом деле это просто обертка для чисел с плавающей точкой, позволяющая сравнивать их как объекты. Дополнительные операции появятся позже. Параметр класса x ограничен по типу, так как примитив <= в Objective Caml является полиморфной функцией сравнения. Конструкция inherit гарантирует, что экземпляры класса будут также экземплярами #comparable.

#class money (x : float) =
   object
     inherit comparable
     val repr = x
     method value = repr
     method leq p = repr <= p#value
   end;;

class money :
  float ->
  object ('a)
    val repr : float
    method leq : 'a -> bool
    method value : float
  end

Обратите внимание, что тип money нельзя считать подтипом comparable, так как в методе leq тип объекта находится в контравариантной позиции. Действительно, объект m класса money включает метод leq, который ожидает аргумента типа money, так как пользуется его методом value. Если принять тип m как comparable, то это значит, что метод leq может быть вызван с объектом, не имеющим метода value, а это приведет к ошибке.

Аналогично, тип money2 ниже не является подтипом money.

#class money2 x =
   object   
     inherit money x
     method times k = {< repr = k *. repr >}
   end;;

class money2 :
  float ->
  object ('a)
    val repr : float
    method leq : 'a -> bool
    method times : float -> 'a
    method value : float
  end

Возможно, однако, определить функции, работающие с объектами обоих типов: функция min будет возвращать меньший их объектов, типы которых объединяются с помощью #comparable. Тип этой функции отличается от #comparable -> #comparable -> #comparable, поскольку сокращение #comparable скрывает переменную типа (многоточие). Всякий раз это сокращение порождает новую переменную.

#let min (x : #comparable) y =
   if x#leq y then x else y;;

val min : (#comparable as 'a) -> 'a -> 'a = <fun>

Эта функция работает как с money, так и с money2.

#(min (new money  1.3) (new money 3.1))#value;;

- : float = 1.3

#(min (new money2 5.0) (new money2 3.14))#value;;

- : float = 3.14

Другие примеры бинарных методов можно найти в разделах 5.2.1 и 5.2.3.

В методе times используется функциональное обновление. Определение new money2 (k *. repr) (вместо {< repr = k *. repr >}) будет неправильно работать в случае наследования: для субкласса money2 money3 такой метод вместо money3 вернул бы объект класса money2.

Классу money не помешал бы еще один бинарный метод:

#class money x =
   object (self : 'a)
     val repr = x
     method value = repr
     method print = print_float repr
     method times k = {< repr = k *. x >}
     method leq (p : 'a) = repr <= p#value
     method plus (p : 'a) = {< repr = x +. p#value >}
   end;;

class money :
  float ->
  object ('a)
    val repr : float
    method leq : 'a -> bool
    method plus : 'a -> 'a
    method print : unit
    method times : float -> 'a
    method value : float
  end

В классе money заметна проблема, зачастую присущая бинарным методам. Ради взаимодействия с другими объектами того же класса представление money должно быть открыто с помощью методов типа value. Если убрать все бинарные методы (в данном случае, leq и plus), представление может быть скрыто внутри объекта, и метод value будет ненужен. Однако, это невозможно, так как бинарный метод требует доступа к объектам того же класса, но отличающимся от текущего экземпляра.

#class safe_money x =
   object (self : 'a)
     val repr = x
     method print = print_float repr
     method times k = {< repr = k *. x >}
   end;;

class safe_money :
  float ->
  object ('a)
    val repr : float
    method print : unit
    method times : float -> 'a
  end

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

#module type MONEY = 
   sig 
     type t
     class c : float -> 
       object ('a)
         val repr : t
         method value : t
         method print : unit
         method times : float -> 'a
         method leq : 'a -> bool
         method plus : 'a -> 'a 
       end
   end;;
 
 module Euro : MONEY = 
   struct
     type t = float
     class c x =
       object (self : 'a)
         val repr = x
         method value = repr
         method print = print_float repr
         method times k = {< repr = k *. x >}
         method leq (p : 'a) = repr <= p#value
         method plus (p : 'a) = {< repr = x +. p#value >}
       end
   end;;

Другие примеры функций-друзей приведены в разделе 5.2.3. Подобная техника применяется, когда внутри группы объектов (в данном случае - объектов одного класса) и функций должно быть доступна внутреннее представление, скрытое при этом от внешнего мира. Решение в таких ситуациях одно: объявлять всех друзей в одном модуле и с помощью ограничения сигнатуры делать представление абстрактным за пределами модуля.

• Классы и объекты
• Ссылка на себя
• Инициализаторы
• Виртуальные методы
• Приватные методы
• Интерфейсы классов
• Наследование
• Множественное наследование
• Параметризованные классы
• Полиморфные методы
• Приведение типов
• Функциональные объекты
• Клонирование объектов
• Рекурсивные классы
• Бинарные методы
• Друзья