Re: [Caml-list] A shallow option type

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

Sorry, the marshaling part was wrong.
Of course we need to do something about received values.
So here is a version that automatically attempts to internalize values
with tag sopt_tag when we apply either some or arg to them.
This should be safe, as if sopt_tag was used for another
type, this should be in a functional way.

	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 intern : 'a t -> 'a t
 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 = 31
 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 intern_aux x i =
   if i > last || Obj.is_int x || Obj.tag x <> sopt_tag || Obj.size x > 1 then
     invalid_arg "Sopt.intern"
   else
     if Obj.size x = 0 then i else intern_aux (Obj.field x 0) (i+1)
 let intern x = Obj.obj area.(intern_aux (Obj.repr x) 0)
 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
     let i = intern_aux x 0 in
     if i >= last then invalid_arg "Sopt.some" else area.(i+1)
 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
     let i = intern_aux x 0 in
     if i = 0 then invalid_arg "Sopt.arg" else area.(i-1)
 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


On 2012/05/07, at 10:27, Jacques Garrigue wrote:

> 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

[...]