er.ml

module Make() : sig
  type field = ..

  type 'a field_access =
      { get : field -> 'a option
      ; set : 'a -> field
      ; default : 'a
      }

  type t

  val empty : t

  val ( .-() ) : t -> 'a field_access -> 'a

  val ( .-()<- ) : t -> 'a field_access -> 'a -> t

  val get : 'a field_access -> t -> 'a

  val set : 'a field_access -> 'a -> t -> t
end = struct
  type field = ..

  type t = field list

  type 'a field_access =
      { get : field -> 'a option
      ; set : 'a -> field
      ; default : 'a
      }

  let empty = []

  let (.-()) t f =
    Option.value (List.find_map f.get t) ~default:f.default

  let (.-()<-) t f v = f.set v :: t

  let get f t =
    t.-(f)

  let set f v t =
    t.-(f) <- v
end

(* type r = { .. } *)
module R = Make()

(* type r += { a : int = 0 } *)
type R.field += A of int
let a =
  { R.get = (function A v -> Some v | _ -> None)
  ; R.set = (fun v -> A v)
  ; R.default = 0
  }

(* type r += { b : string = "" } *)
type R.field += B of string
let b =
  { R.get = (function B v -> Some v | _ -> None)
  ; R.set = (fun v -> B v)
  ; R.default = ""
  }

let () =
  let open R in
  let r1 =
    empty
    |> set a 42
    |> set b "foobar"
  in
  let va = r1.-(a) in
  let vb = r1.-(b) in
  Printf.printf "{ a = %d; b = %s }\n" va vb