Factorization of Product Type Assignments in OCaml

Question

I am not at all satisfied with writing the code as follows:

let load_record_field cursor gets geti gett a = function
  | 0x01 -> let c, s = gets () in (a.a_record_uuid <- s; `More_record c)
  | 0x02 -> let c, s = gets () in (a.a_group <- s; `More_record c)
  | 0x03 -> let c, s = gets () in (a.a_title <- s; `More_record c)
  | 0x04 -> let c, s = gets () in (a.a_username <- s; `More_record c)
  | 0x07 -> let c, t = gett () in (a.a_creation_time <- t; `More_record c)
  .
  .
  .
  | 0xFF -> `End_of_record cursor

I minimized the template, but I was wondering if there was any OCaml magic that would allow me to completely eliminate it.

Answer 1

This is dead simple: just use closure to do the customization and write a function to abstract the template

let load_record_field cursor gets geti gett a x =
  let frob get set =
     let (c,s) = get () in
     set s; `More_record c
  in
  function
  | 0x01 -> frob gets (fun s -> a.a_record_uuid <- s)
  | 0x02 -> frob gets (fun s -> a.a_group <- s)
  | 0x03 -> frob gett (fun s -> a.a_title <- s)
  ...

etc.

You can do this even better if you use a macro package, for example, Jane Street Fields. This generates first class fields along with automatically created setters and getters. This would mean that you would not need to build a closure manually each time.

Answer 2

, :

frobnicate (function 
| 0x01 -> gets , a_record_uuid 
| 0x02 -> gets , a_group 
  ...
)

, OCaml, 1 ° Objective Caml " ", fun a s -> a.a_record_uuid <- s a_record_uuid ( ) 2 ° , :

exists 'a. int -> (unit -> record * 'a) * ('a -> record -> unit)

, 1 °, , :

type complex = { re : int ; im : int }
let re r c = { c with re = r }
let im r c = { c with im = i }

, , , . , ( 20 ).

2 °, , :

let t e read write = let c, x = read () in write x e ; `More_record c

:

let t = t a in
match 
  | 0x01 -> t gets a_record_uuid 
  | 0x02 -> t gets a_title
  ...

, CamlP4 - . , , ( , ):

let t read reference = let c, x = read () in reference := x ; `More_record c

match 
  | 0x01 -> t gets a.a_record_uuid
  ...

Answer 3

, : -)

---

, , - :

• . .

• " "

, . . gets gett .

• sf " "
• tf " "
• eor " "

tabulate lookup ; .

let sf set a c =     let c, s = gets() in (set a s; `More_record c)
let tf set a c =     let c, s = gett() in (set a t; `More_record c)
let eor    a c =     `End_of_record c

let fields = tabulate
  [ 0x01, sf a_record_uuid
  ; 0x02, sf a_group
  ; ...
  ; 0x07, tf a_creation_time
  ; ...
  ]

let load_record_field cursor gets geti gett a code = lookup fields code cursor a