OCaml 教程 / 类型推导深入

(* 推导 fun f x -> f (f x) *)
(* Step 1: f : α, x : β *)
(* Step 2: f x → α = β → γ *)
(* Step 3: f (f x) → β → γ = γ → δ → β = γ, δ = γ *)
(* 最终: (γ → γ) → γ → γ *)

let f = fun f x -> f (f x)
(* 类型: ('a -> 'a) -> 'a -> 'a *)

type typ =
  | TVar of string | TInt | TString
  | TArrow of typ * typ | TList of typ

type substitution = (string * typ) list

let rec apply_subst (s : substitution) : typ -> typ = function
  | TVar x -> (match List.assoc_opt x s with
    | Some t -> apply_subst s t | None -> TVar x)
  | TInt -> TInt | TString -> TString
  | TArrow (a, b) -> TArrow (apply_subst s a, apply_subst s b)
  | TList t -> TList (apply_subst s t)

let rec occurs (x : string) : typ -> bool = function
  | TVar y -> x = y | TInt | TString -> false
  | TArrow (a, b) -> occurs x a || occurs x b
  | TList t -> occurs x t

let rec unify : typ -> typ -> substitution = fun t1 t2 ->
  match t1, t2 with
  | TInt, TInt | TString, TString -> []
  | TVar x, t | t, TVar x ->
    if TVar x = t then []
    else if occurs x t then failwith "occurs check failed"
    else [(x, t)]
  | TArrow (a1, b1), TArrow (a2, b2) ->
    let s1 = unify a1 a2 in
    let s2 = unify (apply_subst s1 b1) (apply_subst s1 b2) in
    s2 @ s1
  | TList a, TList b -> unify a b
  | _ -> failwith "cannot unify"

(* unify(α → int, string → β) → [α = string, β = int] *)
(* unify(int list, α list) → [α = int] *)
(* unify(α, α list) → occurs check 失败！ *)

(* 1. 多态递归 —— 需要显式注解 *)
let rec (f : 'a -> 'a list list) = fun x -> f [x]

(* 2. GADT 模式匹配需要类型注解 *)
type _ expr = Int : int -> int expr | Bool : bool -> bool expr
let eval : type a. a expr -> a = function Int n -> n | Bool b -> b

(* 3. 多态递归自动推导失败的原因 *)
(* let rec f x = f [x] *)
(* f : 'a -> ??, [x] : 'a list, 应用 f 到 'a list *)
(* 统一化 'a = 'a list → occurs check 失败 *)

(* ✅ 公共 API 必须注解 *)
val sort : ('a -> 'a -> int) -> 'a list -> 'a list

(* ✅ 复杂函数签名应该注解 *)
let process_data (type a)
    (module S : Serializable with type t = a)
    (xs : a list) : string list =
  List.map S.to_json xs

(* ✅ 关键数据结构应该注解 *)
type user = {
  id : int; name : string;
  role : [`Admin | `User | `Guest];
}

(* ⚠️ 简单局部函数可以省略 *)
let double x = x * 2

(* 策略1：缩小范围 *)
let result : int = some_complex_expression  (* 强制报错位置 *)

(* 策略2：逐步构建 *)
let step1 = List.map f xs   (* # 检查 step1 的类型 *)
let step2 = List.filter g step1

(* 策略3：使用 toplevel *)
(* # let step1 = List.map f xs;; *)
(* val step1 : int list = [1; 2; 3] *)

(* 如果没有值限制，以下代码会破坏类型安全 *)
let id = ref (fun x -> x)  (* 假设 : ('a -> 'a) ref *)
id := (fun (x : int) -> x + 1)  (* 修正为 int -> int *)
let s = !id "hello"  (* 但实际是 int -> int，运行时崩溃！ *)

(* ❌ 触发 —— 函数应用不是值 *)
let r = ref []        (* '_weak1 list ref *)
let f = List.map Fun.id  (* 有弱类型变量 *)

(* ✅ 不触发 —— 是值 *)
let id = fun x -> x      (* 'a -> 'a *)
let empty = []            (* 'a list *)

(* 方法1：类型注解 *)
let r : int list ref = ref []

(* 方法2：eta-expansion *)
let make_ref () = ref []
(* 外部函数是值 → 多态化 *)

(* 方法3：重新设计 API *)
type 'a state = { mutable items : 'a list }

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

(* 阶段1：未固定 *)
r := [42]     (* '_weak1 固定为 int *)
(* 阶段2：已固定 *)
r := [1; 2]   (* OK: int list ref *)
(* r := ["x"]  (* 错误！ *) *)

(* ✅ 在函数内创建 *)
let create_state () = ref []
let () =
  let state = create_state () in
  state := [1; 2; 3]

(* ✅ 使用参数化类型 *)
type 'a state = { mutable items : 'a list; add : 'a -> unit }

(* 简单递归 —— 自动推导 *)
let rec length = function
  | [] -> 0 | _ :: xs -> 1 + length xs
(* 'a list -> int *)

(* 相互递归 *)
let rec even n = n = 0 || odd (n - 1)
and odd n = n <> 0 && even (n - 1)
(* int -> bool *)

(* 带累加器 *)
let rec sum_acc (acc : int) = function
  | [] -> acc | x :: xs -> sum_acc (acc + x) xs

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

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

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

let get_config cfg env =
  match List.assoc_opt cfg.key env with
  | Some s -> (match cfg.parse s with Some v -> v | None -> cfg.default)
  | None -> cfg.default

let port = int_config "PORT" 8080
let host = string_config "HOST" "localhost"

let env = [("PORT", "3000"); ("HOST", "example.com")]
let () = Printf.printf "http://%s:%d\n"
  (get_config host env) (get_config port env)