properties.ml
· 1.0 KiB · OCaml
Raw
Playground
module Univ = struct
type t = ..
let id =
let id = ref 0 in
fun () ->
incr id ;
!id
module Embed (M : sig type t end) = struct
type t += E of M.t
let wrap m = E m
let read = function E m -> Some m | _ -> None
let new_property () =
let id = id () in
let set t v =
Hashtbl.replace t id @@ wrap v in
let get t =
Hashtbl.find_opt t id |> Fun.flip Option.bind read in
(set, get)
end
end
module IntWrapper = Univ.Embed(Int)
module StringWrapper = Univ.Embed(String)
let and_null = Hashtbl.create 16
let or_watt = Hashtbl.create 16
let name = StringWrapper.new_property ()
let age = IntWrapper.new_property ()
let money = IntWrapper.new_property ()
let get t (set, get) = get t
let set t (set, get) x = set t x
let () = set and_null name "and Null"
let () = set and_null age 28
let () = set and_null money 20
let () = set or_watt name "or Watt"
let () = set or_watt age 28
let () = set or_watt money 100
| 1 | module Univ = struct |
| 2 | type t = .. |
| 3 | let id = |
| 4 | let id = ref 0 in |
| 5 | fun () -> |
| 6 | incr id ; |
| 7 | !id |
| 8 | |
| 9 | module Embed (M : sig type t end) = struct |
| 10 | type t += E of M.t |
| 11 | let wrap m = E m |
| 12 | let read = function E m -> Some m | _ -> None |
| 13 | |
| 14 | let new_property () = |
| 15 | let id = id () in |
| 16 | let set t v = |
| 17 | Hashtbl.replace t id @@ wrap v in |
| 18 | let get t = |
| 19 | Hashtbl.find_opt t id |> Fun.flip Option.bind read in |
| 20 | (set, get) |
| 21 | end |
| 22 | end |
| 23 | |
| 24 | module IntWrapper = Univ.Embed(Int) |
| 25 | module StringWrapper = Univ.Embed(String) |
| 26 | |
| 27 | let and_null = Hashtbl.create 16 |
| 28 | let or_watt = Hashtbl.create 16 |
| 29 | |
| 30 | let name = StringWrapper.new_property () |
| 31 | let age = IntWrapper.new_property () |
| 32 | let money = IntWrapper.new_property () |
| 33 | |
| 34 | let get t (set, get) = get t |
| 35 | let set t (set, get) x = set t x |
| 36 | |
| 37 | let () = set and_null name "and Null" |
| 38 | let () = set and_null age 28 |
| 39 | let () = set and_null money 20 |
| 40 | let () = set or_watt name "or Watt" |
| 41 | let () = set or_watt age 28 |
| 42 | let () = set or_watt money 100 |