[ocaml-extlib] r417 committed - fix OCaml 4 Hashtbl compatibility, by choosing appropriate...

[codesite...@google.com]

Revision: 417
Author: ygrekheretix
Date: Mon Nov 11 06:39:49 2013 UTC
Log: fix OCaml 4 Hashtbl compatibility, by choosing appropriate
code path with camlp4 at compile-time (Closes issue 26)

http://code.google.com/p/ocaml-extlib/source/detail?r=417

Added:
/trunk/extlib/configure.ml
/trunk/extlib/extHashtbl.mlpp
Deleted:
/trunk/extlib/extHashtbl.ml
Modified:
/trunk/extlib/Makefile

=======================================
--- /dev/null
+++ /trunk/extlib/configure.ml Mon Nov 11 06:39:49 2013 UTC
@@ -0,0 +1,1 @@
+let () = print_endline (if Sys.ocaml_version >= "4.00.0" then "-D OCAML4"
else ""); exit 0
=======================================
--- /dev/null
+++ /trunk/extlib/extHashtbl.mlpp Mon Nov 11 06:39:49 2013 UTC
@@ -0,0 +1,159 @@
+(*
+ * ExtHashtbl, extra functions over hashtables.
+ * Copyright (C) 2003 Nicolas Cannasse
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version,
+ * with the special exception on linking described in file LICENSE.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
+ *)
+
+
+module Hashtbl =
+ struct
+
+IFDEF OCAML4 THEN
+ external old_hash_param :
+ int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
+END
+
+ type ('a, 'b) h_bucketlist =
+ | Empty
+ | Cons of 'a * 'b * ('a, 'b) h_bucketlist
+
+IFDEF OCAML4 THEN
+ type ('a, 'b) h_t = {
+ mutable size: int;
+ mutable data: ('a, 'b) h_bucketlist array;
+ mutable seed: int;
+ initial_size: int;
+ }
+ELSE
+ type ('a, 'b) h_t = {
+ mutable size: int;
+ mutable data: ('a, 'b) h_bucketlist array
+ }
+END
+
+ include Hashtbl
+ let create n = Hashtbl.create (* no seed *) n
+
+ external h_conv : ('a, 'b) t -> ('a, 'b) h_t = "%identity"
+ external h_make : ('a, 'b) h_t -> ('a, 'b) t = "%identity"
+
+ let exists = mem
+
+ let enum h =
+ let rec make ipos ibuck idata icount =
+ let pos = ref ipos in
+ let buck = ref ibuck in
+ let hdata = ref idata in
+ let hcount = ref icount in
+ let force() =
+ (** this is a hack in order to keep an O(1) enum constructor **)
+ if !hcount = -1 then begin
+ hcount := (h_conv h).size;
+ hdata := Array.copy (h_conv h).data;
+ end;
+ in
+ let rec next() =
+ force();
+ match !buck with
+ | Empty ->
+ if !hcount = 0 then raise Enum.No_more_elements;
+ incr pos;
+ buck := Array.unsafe_get !hdata !pos;
+ next()
+ | Cons (k,i,next_buck) ->
+ buck := next_buck;
+ decr hcount;
+ (k,i)
+ in
+ let count() =
+ if !hcount = -1 then (h_conv h).size else !hcount
+ in
+ let clone() =
+ force();
+ make !pos !buck !hdata !hcount
+ in
+ Enum.make ~next ~count ~clone
+ in
+ make (-1) Empty (Obj.magic()) (-1)
+
+ let keys h =
+ Enum.map (fun (k,_) -> k) (enum h)
+
+ let values h =
+ Enum.map (fun (_,v) -> v) (enum h)
+
+ let map f h =
+ let rec loop = function
+ | Empty -> Empty
+ | Cons (k,v,next) -> Cons (k,f v,loop next)
+ in
+ h_make { (h_conv h) with
+ data = Array.map loop (h_conv h).data;
+ }
+
+IFDEF OCAML4 THEN
+ (* copied from stdlib :( *)
+ let key_index h key =
+ (* compatibility with old hash tables *)
+ if Obj.size (Obj.repr h) >= 3
+ then (seeded_hash_param 10 100 (h_conv h).seed key) land (Array.length
(h_conv h).data - 1)
+ else (old_hash_param 10 100 key) mod (Array.length (h_conv h).data)
+ELSE
+ let key_index h key = (hash key) mod (Array.length (h_conv h).data)
+END
+
+ let remove_all h key =
+ let hc = h_conv h in
+ let rec loop = function
+ | Empty -> Empty
+ | Cons(k,v,next) ->
+ if k = key then begin
+ hc.size <- pred hc.size;
+ loop next
+ end else
+ Cons(k,v,loop next)
+ in
+ let pos = key_index h key in
+ Array.unsafe_set hc.data pos (loop (Array.unsafe_get hc.data pos))
+
+ let find_default h key defval =
+ let rec loop = function
+ | Empty -> defval
+ | Cons (k,v,next) ->
+ if k = key then v else loop next
+ in
+ let pos = key_index h key in
+ loop (Array.unsafe_get (h_conv h).data pos)
+
+ let find_option h key =
+ let rec loop = function
+ | Empty -> None
+ | Cons (k,v,next) ->
+ if k = key then Some v else loop next
+ in
+ let pos = key_index h key in
+ loop (Array.unsafe_get (h_conv h).data pos)
+
+ let of_enum e =
+ let h = create (if Enum.fast_count e then Enum.count e else 0) in
+ Enum.iter (fun (k,v) -> add h k v) e;
+ h
+
+ let length h =
+ (h_conv h).size
+
+ end
=======================================
--- /trunk/extlib/extHashtbl.ml Mon Jun 11 13:16:33 2012 UTC
+++ /dev/null
@@ -1,135 +0,0 @@
-(*
- * ExtHashtbl, extra functions over hashtables.
- * Copyright (C) 2003 Nicolas Cannasse
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version,
- * with the special exception on linking described in file LICENSE.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
- *)
-
-
-module Hashtbl =
- struct
-
- type ('a, 'b) h_bucketlist =
- | Empty
- | Cons of 'a * 'b * ('a, 'b) h_bucketlist
-
- type ('a, 'b) h_t = {
- mutable size: int;
- mutable data: ('a, 'b) h_bucketlist array
- }
-
- include Hashtbl
- let create n = Hashtbl.create (* no seed *) n
-
- external h_conv : ('a, 'b) t -> ('a, 'b) h_t = "%identity"
- external h_make : ('a, 'b) h_t -> ('a, 'b) t = "%identity"
-
- let exists = mem
-
- let enum h =
- let rec make ipos ibuck idata icount =
- let pos = ref ipos in
- let buck = ref ibuck in
- let hdata = ref idata in
- let hcount = ref icount in
- let force() =
- (** this is a hack in order to keep an O(1) enum constructor **)
- if !hcount = -1 then begin
- hcount := (h_conv h).size;
- hdata := Array.copy (h_conv h).data;
- end;
- in
- let rec next() =
- force();
- match !buck with
- | Empty ->
- if !hcount = 0 then raise Enum.No_more_elements;
- incr pos;
- buck := Array.unsafe_get !hdata !pos;
- next()
- | Cons (k,i,next_buck) ->
- buck := next_buck;
- decr hcount;
- (k,i)
- in
- let count() =
- if !hcount = -1 then (h_conv h).size else !hcount
- in
- let clone() =
- force();
- make !pos !buck !hdata !hcount
- in
- Enum.make ~next ~count ~clone
- in
- make (-1) Empty (Obj.magic()) (-1)
-
- let keys h =
- Enum.map (fun (k,_) -> k) (enum h)
-
- let values h =
- Enum.map (fun (_,v) -> v) (enum h)
-
- let map f h =
- let rec loop = function
- | Empty -> Empty
- | Cons (k,v,next) -> Cons (k,f v,loop next)
- in
- h_make {
- size = (h_conv h).size;
- data = Array.map loop (h_conv h).data;
- }
-
- let remove_all h key =
- let hc = h_conv h in
- let rec loop = function
- | Empty -> Empty
- | Cons(k,v,next) ->
- if k = key then begin
- hc.size <- pred hc.size;
- loop next
- end else
- Cons(k,v,loop next)
- in
- let pos = (hash key) mod (Array.length hc.data) in
- Array.unsafe_set hc.data pos (loop (Array.unsafe_get hc.data pos))
-
- let find_default h key defval =
- let rec loop = function
- | Empty -> defval
- | Cons (k,v,next) ->
- if k = key then v else loop next
- in
- let pos = (hash key) mod (Array.length (h_conv h).data) in
- loop (Array.unsafe_get (h_conv h).data pos)
-
- let find_option h key =
- let rec loop = function
- | Empty -> None
- | Cons (k,v,next) ->
- if k = key then Some v else loop next
- in
- let pos = (hash key) mod (Array.length (h_conv h).data) in
- loop (Array.unsafe_get (h_conv h).data pos)
-
- let of_enum e =
- let h = create (if Enum.fast_count e then Enum.count e else 0) in
- Enum.iter (fun (k,v) -> add h k v) e;
- h
-
- let length h =
- (h_conv h).size
-
- end
=======================================
--- /trunk/extlib/Makefile Sun Jul 7 07:01:22 2013 UTC
+++ /trunk/extlib/Makefile Mon Nov 11 06:39:49 2013 UTC
@@ -15,9 +15,12 @@

.PHONY: all opt cmxs doc install uninstall clean release

-all:
+build: all opt
+extHashtbl.ml: extHashtbl.mlpp
+ camlp4of $(shell ocaml configure.ml) -impl $< -o $@
+all: $(SRC)
ocamlc -g -a -o extLib.cma $(SRC)
-opt:
+opt: $(SRC)
ocamlopt -g -a -o extLib.cmxa $(SRC)
cmxs: opt
ocamlopt -shared -linkall extLib.cmxa -o extLib.cmxs
@@ -32,7 +35,7 @@
ocamlfind remove extlib

clean:
- rm -f *.cmo *.cmx *.o *.obj *.cmi *.cma *.cmxa *.cmxs *.a *.lib doc/*.html
+ rm -f *.cmo *.cmx *.o *.obj *.cmi *.cma *.cmxa *.cmxs *.a *.lib
doc/*.html extHashtbl.ml

release:
svn export . extlib-$(VERSION)