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
[...]
--
Caml-list mailing list. Subscription management and archives:
https://sympa-roc.inria.fr/wws/info/caml-list
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners
Bug reports: http://caml.inria.fr/bin/caml-bugs
