From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from mail1-relais-roc.national.inria.fr (mail1-relais-roc.national.inria.fr [192.134.164.82]) by walapai.inria.fr (8.13.6/8.13.6) with ESMTP id q472Y2is020064 for ; Mon, 7 May 2012 04:34:02 +0200 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AvYEANEzp0+FBoIF/2dsb2JhbABEgx6wWIIMAQEEAScTBgMBNQEBAwsLRlcGiBwEpxWEN4UkiQIBBpA8Y4hmjRyFdopMgng X-IronPort-AV: E=Sophos;i="4.75,540,1330902000"; d="scan'208";a="156981999" Received: from rabbit.math.nagoya-u.ac.jp (HELO mailhost.math.nagoya-u.ac.jp) ([133.6.130.5]) by mail1-smtp-roc.national.inria.fr with ESMTP; 07 May 2012 04:33:55 +0200 Received: from mailhost.math.nagoya-u.ac.jp (localhost [127.0.0.1]) by mailhost.math.nagoya-u.ac.jp (Postfix) with ESMTP id 37A08629D; Mon, 7 May 2012 11:33:53 +0900 (JST) Received: from mailhost.math.nagoya-u.ac.jp (camel-172.math.nagoya-u.ac.jp [172.16.254.4]) by mailhost.math.nagoya-u.ac.jp (Postfix) with ESMTP id EEB9F3A13; Mon, 7 May 2012 11:33:52 +0900 (JST) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=math.nagoya-u.ac.jp; h= subject:mime-version:content-type:from:in-reply-to:date:cc :content-transfer-encoding:message-id:references:to; s=alpha; bh=UCgxMIQBFcGGOrYKeQEujkscTqc=; b=eHCcDZESJAMrHyRAq0rkC0POjpHr KqOCh0Nv6yMO+EoxEuytNN3rKFANHlMWPI62U4puX+qiYfTz9X40dDcGMk47hFiI 46d5ZBbMIZj6CZ/hpCVXv7McJKwFQDf3s9x0tLtc9ZXjHn1JDHa1gfSff8e5XldL J6d9qv5StoKUWvc= DomainKey-Signature: a=rsa-sha1; h=Received:Subject:Mime-Version:Content-Type:From:In-Reply-To:Date:Cc:Content-Transfer-Encoding:Message-Id:References:To:X-Mailer; b=0WSsGVNc/SlailVrOuGcG78b1RCHEaFsJPR9HDykK6M8AsMKOh2e34XRT4rBMd9H1wtQ03/m91O+tzNwr5dMzkdW1A8M8pLdkHByOGdi36PU2ISrBm5V7POnZCR9bc+xFS+ymUZBQzJP17w+cuTol4kua9pL+jSkUUKxR6LA27w=; c=nofws; d=math.nagoya-u.ac.jp; q=dns; s=alpha Received: from [10.11.3.64] (unknown [118.103.30.26]) by mailhost.math.nagoya-u.ac.jp (Postfix) with ESMTPSA id A160539A2; Mon, 7 May 2012 11:33:49 +0900 (JST) Mime-Version: 1.0 (Apple Message framework v1084) Content-Type: text/plain; charset=us-ascii From: Jacques Garrigue In-Reply-To: <4A169BB4-3316-437A-9E73-FABEAEDB9D2F@math.nagoya-u.ac.jp> Date: Mon, 7 May 2012 11:34:02 +0900 Cc: OCaML Mailing List Message-Id: <9EAA1066-D3CE-4260-BCBC-9F044F450EB0@math.nagoya-u.ac.jp> References: <87r4uykb09.fsf@frosties.localnet> <415387F7-557D-40C7-8F9E-E8CDC5603E3C@math.nagoya-u.ac.jp> <87aa1lcohv.fsf@frosties.localnet> <4A169BB4-3316-437A-9E73-FABEAEDB9D2F@math.nagoya-u.ac.jp> To: Goswin von Brederlow X-Mailer: Apple Mail (2.1084) Content-Transfer-Encoding: 8bit X-MIME-Autoconverted: from quoted-printable to 8bit by walapai.inria.fr id q472Y2is020064 Subject: Re: [Caml-list] A shallow option type 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 [...]