Variants (Algebraic Data Types)

12.1 Enumerations

type color = Red | Green | Blue

let to_string = function
  | Red -> "red" | Green -> "green" | Blue -> "blue"

12.2 Constructors with data

type shape =
  | Circle of float                       (* radius *)
  | Rectangle of float * float            (* width, height *)
  | Triangle of { a : float; b : float; c : float }   (* inline record *)

let area = function
  | Circle r -> Float.pi *. r *. r
  | Rectangle (w, h) -> w *. h
  | Triangle { a; b; c } ->
      let s = (a +. b +. c) /. 2. in
      sqrt (s *. (s -. a) *. (s -. b) *. (s -. c))

12.3 Recursive variants

type 'a tree =
  | Leaf
  | Node of 'a tree * 'a * 'a tree

let rec size = function
  | Leaf -> 0
  | Node (l, _, r) -> size l + 1 + size r

let rec insert x = function
  | Leaf -> Node (Leaf, x, Leaf)
  | Node (l, v, r) as t ->
      if x < v then Node (insert x l, v, r)
      else if x > v then Node (l, v, insert x r)
      else t

let rec to_list = function
  | Leaf -> []
  | Node (l, v, r) -> to_list l @ [v] @ to_list r

12.4 Expression trees — the classic example

type expr =
  | Num of int
  | Var of string
  | Add of expr * expr
  | Mul of expr * expr
  | Neg of expr
  | Let of string * expr * expr

let rec eval env = function
  | Num n -> n
  | Var x -> List.assoc x env
  | Add (a, b) -> eval env a + eval env b
  | Mul (a, b) -> eval env a * eval env b
  | Neg e -> - (eval env e)
  | Let (x, e, body) -> eval ((x, eval env e) :: env) body

let rec simplify = function
  | Add (Num 0, e) | Add (e, Num 0) -> simplify e
  | Mul (Num 1, e) | Mul (e, Num 1) -> simplify e
  | Mul (Num 0, _) | Mul (_, Num 0) -> Num 0
  | Add (a, b) -> Add (simplify a, simplify b)
  | Mul (a, b) -> Mul (simplify a, simplify b)
  | e -> e

12.5 Mutually recursive types

type stmt = Assign of string * expr | Block of stmt list | If of expr * stmt * stmt
and expr = Int of int | Ident of string | Call of string * expr list

12.6 Making illegal states unrepresentable

(* Bad: what if connected = false but session_id = Some _ ? *)
type conn_bad = { connected : bool; session_id : string option }

(* Good *)
type connection =
  | Disconnected
  | Connecting of { attempt : int }
  | Connected of { session_id : string }

12.7 Unboxed single-constructor types

type user_id = UserId of int [@@unboxed]   (* zero runtime cost wrapper *)