OCaml 教程 / 对象与类（OCP）

(* 对象类型声明 *)
type point = < x : int; y : int >

let p : point = object
  method x = 3
  method y = 4
end

let () = Printf.printf "(%d, %d)\n" p#x p#y

(* 开放对象类型 —— 允许有更多方法 *)
type printable = < print : unit; .. >

let print_any (obj : printable) = obj#print

let p = object
  method print = print_endline "hello"
  method extra = 42
end

let () = print_any p  (* OK: p 有 print 方法，也有 extra，但不冲突 *)

(* 方法调用使用 # 符号 *)
let p = object
  method x = 3
  method y = 4
  method distance = sqrt (float_of_int (p#x * p#x + p#y * p#y))
end

let () = Printf.printf "distance: %f\n" p#distance

class point x_init y_init = object
  val x = x_init
  val y = y_init
  method x = x
  method y = y
  method move dx dy = {< x = x + dx; y = y + dy >}
end

let p = new point 3 4
let p2 = p#move 1 2

class counter init = object (self)
  val mutable count = init
  method get = count
  method increment = count <- count + 1
  method reset = count <- init
  method copy = {< >}  (* 浅拷贝 *)
  initializer
    Printf.printf "Counter created with %d\n" init
end

let c = new counter 0
let () = c#increment; c#increment
let () = Printf.printf "Count: %d\n" c#get  (* 2 *)

class point x y = object
  val x = x
  val y = y
  method x = x
  method y = y
  method distance = sqrt (float_of_int (x * x + y * y))
end

class colored_point x y color = object
  inherit point x y
  val color = color
  method color = color
  method to_string =
    Printf.sprintf "(%d, %d, %s)" x y color
end

let cp = new colored_point 3 4 "red"
let () = Printf.printf "%s, distance=%f\n" cp#to_string cp#distance

class animal name = object
  method name = name
  method speak = name ^ " makes a sound"
end

class cat name = object
  inherit animal name
  method! speak = name ^ " meows"  (* 覆盖 *)
  method purr = name ^ " purrs"
end

class dog name = object
  inherit animal name
  method! speak = name ^ " barks"
  method fetch = name ^ " fetches"
end

class virtual shape = object (self)
  method virtual area : float
  method virtual perimeter : float
  method describe =
    Printf.sprintf "area=%.2f, perimeter=%.2f"
      self#area self#perimeter
end

class circle r = object
  inherit shape
  method! area = 3.14159 *. float_of_int r ** 2.0
  method! perimeter = 2.0 *. 3.14159 *. float_of_int r
end

class rectangle w h = object
  inherit shape
  method! area = float_of_int (w * h)
  method! perimeter = float_of_int (2 * (w + h))
end

class widget name = object (self)
  method name = name
  method click = Printf.printf "%s clicked\n" name
  method render = Printf.printf "Rendering %s\n" name

  (* self 可以用于链式调用 *)
  method with_handler handler =
    handler (self : widget)
end

(* self 的类型可以通过约束来限制 *)
class type widget_type = object
  method name : string
  method click : unit
  method render : unit
end

(* 类类型 —— 类的接口 *)
class type printable = object
  method print : unit
end

class type comparable = object
  method compare : 'a -> int
end

(* 实现类类型 *)
class my_int n : printable = object
  method print = print_int n
end

type point = < x : int; y : int >
type color_point = < x : int; y : int; color : string >
type named_point = < x : int; y : int; name : string >

(* 子类型关系：color_point <: point *)
let p : point = (object
  method x = 3
  method y = 4
  method color = "red"
end : color_point)

(* 显式强制转换 *)
let cp : color_point = object
  method x = 3; method y = 4; method color = "red"
end
let p : point = (cp :> point)  (* 强制上转 *)

(* 对象与多态变体的结合 *)
type 'a event = < handle : 'a >

let click_handler : [`Click of int * int] event = object
  method handle = fun (`Click (x, y)) ->
    Printf.printf "Click at (%d, %d)\n" x y
end

let key_handler : [`Key of char] event = object
  method handle = fun (`Key c) ->
    Printf.printf "Key pressed: %c\n" c
end

class ['a] observable initial = object
  val mutable value = initial
  val mutable observers : ('a -> unit) list = []
  method get = value
  method set v =
    value <- v;
    List.iter (fun f -> f v) observers
  method subscribe f =
    observers <- f :: observers
end

let counter = new observable 0
let () = counter#subscribe (fun n -> Printf.printf "New value: %d\n" n)
let () = counter#set 1   (* 输出: New value: 1 *)
let () = counter#set 2   (* 输出: New value: 2 *)

class type command = object
  method execute : unit
  method undo : unit
end

class add_command (target : counter) n : command = object
  method execute = target#set (target#get + n)
  method undo = target#set (target#get - n)
end

and counter = object
  method get : int
  method set : int -> unit
end