Re: [Caml-list] A shallow option type

[Jacques Garrigue <garrigue@math.nagoya-u.ac.jp>]

Here is another variant using normal values.
The advantage is that it does no tricks with bits, and supports
marshaling.
It is less efficient because the search is linear, but by using as
tag (lazy_tag -1) we can avoid being too inefficient in most cases.
Note however that after marshaling the values are going to
have the same tag, so this is going to be much less efficient.

Jacques

module Sopt : sig
  type +'a t
  val none : 'a t
  val some : 'a -> 'a t
  val is_none : 'a t -> bool
  val arg  : 'a t -> 'a
  val depth : 'a t -> int
end = struct
  type 'a t = Obj.t
  let sopt_tag = Obj.lazy_tag - 1
  let none = Obj.new_block sopt_tag 0
  let last = 255
  let area = Array.create (last+1) none
  let () =
    for i = 1 to last do
      let stub = Obj.new_block sopt_tag 1 in
      Obj.set_field stub 0 area.(i-1);
      area.(i) <- stub
    done
  let is_none x = (x == none)
  let rec some_aux x i =
    if i < last then
      if x == area.(i) then area.(i+1) else some_aux x (i+1)
    else (* i = last *)
      if x == area.(last) then invalid_arg "Sopt.some" else x
  let some (x : 'a) : 'a t =
    let x = Obj.repr x in
    if Obj.is_int x || Obj.tag x <> sopt_tag then Obj.obj x
    else Obj.obj (some_aux x 0)
  let rec arg_aux x i =
    if i <= last then
      if x == area.(i) then area.(i-1) else arg_aux x (i+1)
    else
      if x == area.(0) then invalid_arg "Sopt.arg" else x
  let arg (x : 'a t) : 'a =
    let x = Obj.repr x in
    if Obj.is_int x || Obj.tag x <> sopt_tag then Obj.obj x
    else Obj.obj (arg_aux x 1)
  let rec depth_aux x i =
    if i <= last then
      if x == area.(i) then i else depth_aux x (i+1)
    else -1
  let depth x = depth_aux (Obj.repr x) 0
end