OCaml 教程 / 多态与受限多态

(* 最简单的多态函数 *)
let id x = x
(* 类型: 'a -> 'a *)

let swap (a, b) = (b, a)
(* 类型: 'a * 'b -> 'b * 'a *)

let compose f g x = f (g x)
(* 类型: ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c *)

(* 类型变量可以出现在多个位置，表示同一类型 *)
let pair x = (x, x)
(* 类型: 'a -> 'a * 'a  —— 两个位置必须相同 *)

(* 不同的类型变量表示独立类型 *)
let ignore_second a _b = a
(* 类型: 'a -> 'b -> 'a *)

(* 编译器推导过程 *)
let rec map f = function
  | [] -> []
  | x :: xs -> f x :: map f xs
(* 推导结果: ('a -> 'b) -> 'a list -> 'b list *)

let id = fun x -> x

(* 在不同上下文中使用 *)
let n : int = id 42        (* id 作为 int -> int *)
let s : string = id "hello" (* id 作为 string -> string *)

(* ✅ let-polymorphism: OK *)
let id x = x
let pair = (id 42, id "hello")

(* ❌ lambda-polymorphism: 不能在同一个 lambda 内多态使用 *)
(* fun x -> (x 42, x "hello")  (* 错误！x 不能同时是 int->int 和 string->string *) *)

(* 如果没有值限制，以下代码会导致类型错误 *)
let r = ref []        (* 这里会触发值限制 *)
(* 不能让它同时成为 int list ref 和 string list ref *)

(* ✅ OK —— 是值 *)
let empty = []
let id = fun x -> x

(* ❌ 触发值限制 —— 函数应用不是值 *)
let r = ref []

(* ✅ 修复方式 1：加类型注解 *)
let r : int list ref = ref []

(* ✅ 修复方式 2：使用泛型函数 *)
let make_ref () = ref []

# let r = ref [];;
val r : '_weak1 list ref = {contents = []}

(* '_weak1 是弱类型变量，一旦使用就会被固定 *)
r := [42];
(* r 的类型变成 int list ref *)

(* 通过 module type 约束多态函数 *)
module type Comparable = sig
  type t
  val compare : t -> t -> int
end

module MakeSet (C : Comparable) : sig
  type elt = C.t
  type t
  val empty : t
  val add : elt -> t -> t
  val mem : elt -> t -> bool
end = struct
  type elt = C.t
  type t = elt list
  let empty = []
  let add x xs = if List.mem x xs then xs else x :: xs
  let mem = List.mem
end

(* 字典传递风格 *)
type 'a show = { show : 'a -> string }

let show_int = { show = string_of_int }
let show_string = { show = fun s -> "\"" ^ s ^ "\"" }
let show_list show_a =
  { show = fun xs ->
      "[" ^ String.concat "; " (List.map show_a.show xs) ^ "]" }

(* 多态函数接受 show 字典 *)
let print_any show_a x = print_endline (show_a.show x)

let print_sorted (type a) (module Ord : Set.OrderedType with type t = a) xs =
  let module S = Set.Make(Ord) in
  let s = List.fold_right S.add xs S.empty in
  S.elements s

(* 类型: int -> (int -> int) -> int *)
let rec apply_n n f =
  if n <= 0 then fun x -> x
  else compose f (apply_n (n - 1) f)

(* 真正的多态递归 —— 类型树 *)
type 'a tree =
  | Leaf of 'a
  | Node of 'a tree list

(* 需要显式类型注解来启用多态递归 *)
let rec (map_tree : ('a -> 'b) -> 'a tree -> 'b tree) = fun f -> function
  | Leaf x -> Leaf (f x)
  | Node children -> Node (List.map (map_tree f) children)

(* 推导 fun x -> x + 1 *)
(* Step 1: x : 'a *)
(* Step 2: (+) : int -> int -> int *)
(* Step 3: 统一 'a 与 int *)
(* 结果: int -> int *)

module type Printable = sig
  type t
  val to_string : t -> string
end

module PrintUtils (P : Printable) = struct
  let print_list xs =
    List.iter (fun x -> print_endline (P.to_string x)) xs

  let print_option = function
    | None -> print_endline "None"
    | Some x -> print_endline (P.to_string x)
end

(* 在 .mli 文件中声明多态类型 *)
val concat_map : ('a -> 'b list) -> 'a list -> 'b list

(* 在 .ml 文件中实现 *)
let concat_map f xs = List.concat (List.map f xs)

type 'a serializer = {
  to_json : 'a -> string;
  of_json : string -> 'a option;
}

let int_serializer = {
  to_json = string_of_int;
  of_json = (fun s -> try Some (int_of_string s) with _ -> None);
}

let list_serializer s = {
  to_json = fun xs ->
    "[" ^ String.concat "," (List.map s.to_json xs) ^ "]";
  of_json = fun _s -> failwith "not implemented";
}

type 'a config_entry = {
  key : string;
  default : 'a;
  parse : string -> 'a option;
}

let string_entry key default = {
  key; default;
  parse = (fun s -> Some s);
}

let int_entry key default = {
  key; default;
  parse = (fun s -> try Some (int_of_string s) with _ -> None);
}