Skip to content

GitLab

C
cduce
Commit b8d175e6 authored by Pietro Abate's avatar Pietro Abate
Browse files
Options

[r2003-09-14 19:36:06 by cvscast] Cleaning + upgrade to OCaml 3.07+beta2 (use recursive modules) 

Original author: cvscast
Date: 2003-09-14 19:36:10+00:00
parent b214a5da
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1023 additions and 911 deletions
Makefile.distrib
View file @ b8d175e6
......@@ -71,6 +71,7 @@ CLEAN_DIRS = $(DIRS) tools tests
# Objects to build
OBJECTS = \
misc/serialize.cmo misc/custom.cmo \
misc/state.cmo misc/pool.cmo misc/encodings.cmo misc/bool.cmo \
misc/pretty.cmo misc/ns.cmo \
\
......
depend
View file @ b8d175e6
misc/serialize.cmo: misc/q_symbol.cmo misc/serialize.cmi
misc/serialize.cmx: misc/q_symbol.cmo misc/serialize.cmi
misc/custom.cmo: misc/q_symbol.cmo misc/serialize.cmi
misc/custom.cmx: misc/q_symbol.cmo misc/serialize.cmx
misc/state.cmo: misc/q_symbol.cmo misc/state.cmi
misc/state.cmx: misc/q_symbol.cmo misc/state.cmi
misc/pool.cmo: misc/q_symbol.cmo misc/state.cmi misc/pool.cmi
misc/pool.cmx: misc/q_symbol.cmo misc/state.cmx misc/pool.cmi
misc/pool.cmo: misc/q_symbol.cmo misc/custom.cmo misc/state.cmi misc/pool.cmi
misc/pool.cmx: misc/q_symbol.cmo misc/custom.cmx misc/state.cmx misc/pool.cmi
misc/encodings.cmo: misc/q_symbol.cmo misc/encodings.cmi
misc/encodings.cmx: misc/q_symbol.cmo misc/encodings.cmi
misc/bool.cmo: misc/q_symbol.cmo misc/bool.cmi
misc/bool.cmx: misc/q_symbol.cmo misc/bool.cmi
misc/bool.cmo: misc/q_symbol.cmo misc/custom.cmo misc/bool.cmi
misc/bool.cmx: misc/q_symbol.cmo misc/custom.cmx misc/bool.cmi
misc/pretty.cmo: misc/q_symbol.cmo misc/pretty.cmi
misc/pretty.cmx: misc/q_symbol.cmo misc/pretty.cmi
misc/ns.cmo: misc/q_symbol.cmo misc/encodings.cmi misc/pool.cmi misc/state.cmi misc/ns.cmi
misc/ns.cmx: misc/q_symbol.cmo misc/encodings.cmx misc/pool.cmx misc/state.cmx misc/ns.cmi
types/sortedList.cmo: misc/q_symbol.cmo types/sortedList.cmi
types/sortedList.cmx: misc/q_symbol.cmo types/sortedList.cmi
types/boolean.cmo: misc/q_symbol.cmo types/sortedList.cmi types/boolean.cmi
types/boolean.cmx: misc/q_symbol.cmo types/sortedList.cmx types/boolean.cmi
types/sortedList.cmo: misc/q_symbol.cmo misc/custom.cmo types/sortedList.cmi
types/sortedList.cmx: misc/q_symbol.cmo misc/custom.cmx types/sortedList.cmi
types/boolean.cmo: misc/q_symbol.cmo misc/custom.cmo types/sortedList.cmi types/boolean.cmi
types/boolean.cmx: misc/q_symbol.cmo misc/custom.cmx types/sortedList.cmx types/boolean.cmi
types/ident.cmo: misc/q_symbol.cmo misc/encodings.cmi misc/ns.cmi misc/pool.cmi \
types/sortedList.cmi
types/ident.cmx: misc/q_symbol.cmo misc/encodings.cmx misc/ns.cmx misc/pool.cmx \
......@@ -29,25 +33,29 @@ types/atoms.cmx: misc/q_symbol.cmo misc/encodings.cmx misc/ns.cmx misc/pool.cmx
types/normal.cmo: misc/q_symbol.cmo types/normal.cmi
types/normal.cmx: misc/q_symbol.cmo types/normal.cmi
types/types.cmo: misc/q_symbol.cmo types/atoms.cmi misc/bool.cmi types/chars.cmi \
misc/encodings.cmi types/ident.cmo types/intervals.cmi types/normal.cmi \
misc/ns.cmi misc/pretty.cmi types/sortedList.cmi misc/state.cmi \
types/types.cmi
misc/custom.cmo misc/encodings.cmi types/ident.cmo types/intervals.cmi \
types/normal.cmi misc/ns.cmi misc/pretty.cmi misc/serialize.cmi \
types/sortedList.cmi misc/state.cmi types/types.cmi
types/types.cmx: misc/q_symbol.cmo types/atoms.cmx misc/bool.cmx types/chars.cmx \
misc/encodings.cmx types/ident.cmx types/intervals.cmx types/normal.cmx \
misc/ns.cmx misc/pretty.cmx types/sortedList.cmx misc/state.cmx \
types/types.cmi
types/patterns.cmo: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi types/ident.cmo \
types/sortedList.cmi misc/state.cmi types/types.cmi types/patterns.cmi
types/patterns.cmx: misc/q_symbol.cmo types/atoms.cmx types/chars.cmx types/ident.cmx \
types/sortedList.cmx misc/state.cmx types/types.cmx types/patterns.cmi
misc/custom.cmx misc/encodings.cmx types/ident.cmx types/intervals.cmx \
types/normal.cmx misc/ns.cmx misc/pretty.cmx misc/serialize.cmx \
types/sortedList.cmx misc/state.cmx types/types.cmi
types/patterns.cmo: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi misc/custom.cmo \
types/ident.cmo types/sortedList.cmi misc/state.cmi types/types.cmi \
types/patterns.cmi
types/patterns.cmx: misc/q_symbol.cmo types/atoms.cmx types/chars.cmx misc/custom.cmx \
types/ident.cmx types/sortedList.cmx misc/state.cmx types/types.cmx \
types/patterns.cmi
types/sequence.cmo: misc/q_symbol.cmo types/atoms.cmi types/types.cmi types/sequence.cmi
types/sequence.cmx: misc/q_symbol.cmo types/atoms.cmx types/types.cmx types/sequence.cmi
types/sample.cmo: misc/q_symbol.cmo types/ident.cmo types/types.cmi types/sample.cmi
types/sample.cmx: misc/q_symbol.cmo types/ident.cmx types/types.cmx types/sample.cmi
types/builtin_defs.cmo: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi types/intervals.cmi \
types/sequence.cmi types/types.cmi types/builtin_defs.cmi
types/builtin_defs.cmx: misc/q_symbol.cmo types/atoms.cmx types/chars.cmx types/intervals.cmx \
types/sequence.cmx types/types.cmx types/builtin_defs.cmi
types/builtin_defs.cmo: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi types/ident.cmo \
types/intervals.cmi misc/ns.cmi types/sequence.cmi types/types.cmi \
types/builtin_defs.cmi
types/builtin_defs.cmx: misc/q_symbol.cmo types/atoms.cmx types/chars.cmx types/ident.cmx \
types/intervals.cmx misc/ns.cmx types/sequence.cmx types/types.cmx \
types/builtin_defs.cmi
runtime/value.cmo: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi misc/encodings.cmi \
types/ident.cmo types/intervals.cmi misc/ns.cmi types/sequence.cmi \
types/types.cmi runtime/value.cmi
......@@ -100,14 +108,14 @@ typing/typed.cmo: misc/q_symbol.cmo types/ident.cmo parser/location.cmi types/pa
types/types.cmi runtime/value.cmi
typing/typed.cmx: misc/q_symbol.cmo types/ident.cmx parser/location.cmx types/patterns.cmx \
types/types.cmx runtime/value.cmx
typing/typer.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/chars.cmi \
types/ident.cmo parser/location.cmi misc/ns.cmi types/patterns.cmi \
schema/schema_builtin.cmi schema/schema_types.cmi \
typing/typer.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/builtin_defs.cmi \
types/chars.cmi types/ident.cmo parser/location.cmi misc/ns.cmi \
types/patterns.cmi schema/schema_builtin.cmi schema/schema_types.cmi \
schema/schema_validator.cmi types/sequence.cmi misc/state.cmi \
typing/typed.cmo types/types.cmi typing/typer.cmi
typing/typer.cmx: misc/q_symbol.cmo parser/ast.cmx types/atoms.cmx types/chars.cmx \
types/ident.cmx parser/location.cmx misc/ns.cmx types/patterns.cmx \
schema/schema_builtin.cmx schema/schema_types.cmx \
typing/typer.cmx: misc/q_symbol.cmo parser/ast.cmx types/atoms.cmx types/builtin_defs.cmx \
types/chars.cmx types/ident.cmx parser/location.cmx misc/ns.cmx \
types/patterns.cmx schema/schema_builtin.cmx schema/schema_types.cmx \
schema/schema_validator.cmx types/sequence.cmx misc/state.cmx \
typing/typed.cmx types/types.cmx typing/typer.cmi
runtime/load_xml.cmo: misc/q_symbol.cmo types/atoms.cmi misc/encodings.cmi types/ident.cmo \
......@@ -121,16 +129,16 @@ runtime/run_dispatch.cmx: misc/q_symbol.cmo types/atoms.cmx types/chars.cmx misc
types/ident.cmx types/patterns.cmx types/types.cmx runtime/value.cmx \
runtime/run_dispatch.cmi
runtime/print_xml.cmo: misc/q_symbol.cmo types/atoms.cmi misc/encodings.cmi types/ident.cmo \
parser/location.cmi misc/ns.cmi types/sequence.cmi typing/typer.cmi \
runtime/value.cmi
parser/location.cmi misc/ns.cmi types/sequence.cmi runtime/value.cmi
runtime/print_xml.cmx: misc/q_symbol.cmo types/atoms.cmx misc/encodings.cmx types/ident.cmx \
parser/location.cmx misc/ns.cmx types/sequence.cmx typing/typer.cmx \
runtime/value.cmx
runtime/eval.cmo: misc/q_symbol.cmo types/ident.cmo types/patterns.cmi runtime/run_dispatch.cmi \
schema/schema_validator.cmi schema/schema_xml.cmi typing/typed.cmo \
parser/location.cmx misc/ns.cmx types/sequence.cmx runtime/value.cmx
runtime/eval.cmo: misc/q_symbol.cmo types/builtin_defs.cmi types/ident.cmo types/patterns.cmi \
runtime/run_dispatch.cmi schema/schema_validator.cmi \
schema/schema_xml.cmi types/sequence.cmi typing/typed.cmo \
typing/typer.cmi types/types.cmi runtime/value.cmi runtime/eval.cmi
runtime/eval.cmx: misc/q_symbol.cmo types/ident.cmx types/patterns.cmx runtime/run_dispatch.cmx \
schema/schema_validator.cmx schema/schema_xml.cmx typing/typed.cmx \
runtime/eval.cmx: misc/q_symbol.cmo types/builtin_defs.cmx types/ident.cmx types/patterns.cmx \
runtime/run_dispatch.cmx schema/schema_validator.cmx \
schema/schema_xml.cmx types/sequence.cmx typing/typed.cmx \
typing/typer.cmx types/types.cmx runtime/value.cmx runtime/eval.cmi
types/builtin.cmo: misc/q_symbol.cmo parser/ast.cmo types/atoms.cmi types/builtin_defs.cmi \
types/chars.cmi types/ident.cmo types/intervals.cmi runtime/load_xml.cmi \
......@@ -160,16 +168,19 @@ driver/webiface.cmo: misc/q_symbol.cmo driver/cduce.cmi driver/examples.cmo pars
misc/state.cmi
driver/webiface.cmx: misc/q_symbol.cmo driver/cduce.cmx driver/examples.cmx parser/location.cmx \
misc/state.cmx
misc/ns.cmi: misc/q_symbol.cmo misc/encodings.cmi
types/boolean.cmi: misc/q_symbol.cmo types/sortedList.cmi
misc/pool.cmi: misc/q_symbol.cmo misc/custom.cmo
misc/bool.cmi: misc/q_symbol.cmo misc/custom.cmo
misc/ns.cmi: misc/q_symbol.cmo misc/custom.cmo misc/encodings.cmi
types/sortedList.cmi: misc/q_symbol.cmo misc/custom.cmo
types/boolean.cmi: misc/q_symbol.cmo misc/custom.cmo
types/atoms.cmi: misc/q_symbol.cmo misc/encodings.cmi misc/ns.cmi
types/types.cmi: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi types/ident.cmo \
types/intervals.cmi types/sortedList.cmi
types/types.cmi: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi misc/custom.cmo \
types/ident.cmo types/intervals.cmi
types/patterns.cmi: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi types/ident.cmo \
types/types.cmi
types/sequence.cmi: misc/q_symbol.cmo types/atoms.cmi types/types.cmi
types/sample.cmi: misc/q_symbol.cmo types/types.cmi
types/builtin_defs.cmi: misc/q_symbol.cmo types/atoms.cmi types/types.cmi
types/builtin_defs.cmi: misc/q_symbol.cmo types/atoms.cmi types/ident.cmo types/types.cmi
runtime/value.cmi: misc/q_symbol.cmo types/atoms.cmi types/chars.cmi misc/encodings.cmi \
types/ident.cmo types/intervals.cmi types/types.cmi
schema/schema_types.cmi: misc/q_symbol.cmo runtime/value.cmi
......
misc/bool.ml
View file @ b8d175e6
module type ARG =
sig
type 'a t
val dump: Format.formatter -> 'a t -> unit
val equal: 'a t -> 'a t -> bool
val hash: 'a t -> int
val compare: 'a t -> 'a t -> int
end
module type S =
sig
type 'a elem
type 'a t
val dump: Format.formatter -> 'a t -> unit
val equal : 'a t -> 'a t -> bool
val compare: 'a t -> 'a t -> int
val hash: 'a t -> int
type elem
include Custom.T
val get: 'a t -> ('a elem list * 'a elem list) list
val get: t -> (elem list * elem list) list
val empty : 'a t
val full : 'a t
val cup : 'a t -> 'a t -> 'a t
val cap : 'a t -> 'a t -> 'a t
val diff : 'a t -> 'a t -> 'a t
val atom : 'a elem -> 'a t
val empty : t
val full : t
val cup : t -> t -> t
val cap : t -> t -> t
val diff : t -> t -> t
val atom : elem -> t
val iter: ('a elem-> unit) -> 'a t -> unit
val iter: (elem-> unit) -> t -> unit
val compute: empty:'b -> full:'b -> cup:('b -> 'b -> 'b)
-> cap:('b -> 'b -> 'b) -> diff:('b -> 'b -> 'b) ->
atom:('a elem -> 'b) -> 'a t -> 'b
atom:(elem -> 'b) -> t -> 'b
val print: string -> (Format.formatter -> 'a elem -> unit) -> 'a t ->
val print: string -> (Format.formatter -> elem -> unit) -> t ->
(Format.formatter -> unit) list
val trivially_disjoint: 'a t -> 'a t -> bool
val trivially_disjoint: t -> t -> bool
end
module Make(X : ARG) =
module Make(X : Custom.T) =
struct
type 'a elem = 'a X.t
type 'a t =
type elem = X.t
type t =
| True
| False
| Split of int * 'a elem * 'a t * 'a t * 'a t
| Split of int * elem * t * t * t
include Custom.Dummy
let rec equal a b =
(a == b) ||
......
misc/bool.mli
View file @ b8d175e6
module type ARG =
sig
type 'a t
val dump: Format.formatter -> 'a t -> unit
val equal: 'a t -> 'a t -> bool
val hash: 'a t -> int
val compare: 'a t -> 'a t -> int
end
module type S =
sig
type 'a elem
type 'a t
include Custom.T
type elem
val dump: Format.formatter -> 'a t -> unit
val get: t -> (elem list * elem list) list
val equal : 'a t -> 'a t -> bool
val compare: 'a t -> 'a t -> int
val hash: 'a t -> int
val empty : t
val full : t
val cup : t -> t -> t
val cap : t -> t -> t
val diff : t -> t -> t
val atom : elem -> t
val get: 'a t -> ('a elem list * 'a elem list) list
val empty : 'a t
val full : 'a t
val cup : 'a t -> 'a t -> 'a t
val cap : 'a t -> 'a t -> 'a t
val diff : 'a t -> 'a t -> 'a t
val atom : 'a elem -> 'a t
val iter: ('a elem-> unit) -> 'a t -> unit
val iter: (elem-> unit) -> t -> unit
val compute: empty:'b -> full:'b -> cup:('b -> 'b -> 'b)
-> cap:('b -> 'b -> 'b) -> diff:('b -> 'b -> 'b) ->
atom:('a elem -> 'b) -> 'a t -> 'b
atom:(elem -> 'b) -> t -> 'b
val print: string -> (Format.formatter -> 'a elem -> unit) -> 'a t ->
val print: string -> (Format.formatter -> elem -> unit) -> t ->
(Format.formatter -> unit) list
val trivially_disjoint : 'a t -> 'a t -> bool
val trivially_disjoint : t -> t -> bool
end
module Make(X : ARG) : S with type 'a elem = 'a X.t
module Make(X : Custom.T) : S with type elem = X.t
misc/custom.ml 0 → 100644
View file @ b8d175e6
module type T = sig
type t
(* Debugging *)
val dump: Format.formatter -> t -> unit
val check: t -> unit (* Check internal invariants *)
(* Data structures *)
val equal: t -> t -> bool
val hash: t -> int
val compare:t -> t -> int
(* Serialization *)
val serialize: t Serialize.Put.f
val deserialize: t Serialize.Get.f
end
module Dummy = struct
let dump ppf _ = assert false
let check _ = assert false
let equal t1 t2 = assert false
let hash t = assert false
let compare t1 t2 = assert false
let serialize t = assert false
let deserialize t = assert false
end
let dump_list ?(sep="; ") f ppf l =
Format.pp_print_string ppf "[ ";
(match l with
| [] -> ()
| [hd] -> f ppf hd
| hd::tl ->
f ppf hd;
List.iter (fun x -> Format.pp_print_string ppf sep; f ppf x) tl
);
Format.pp_print_string ppf " ]"
module String : T with type t = string = struct
type t = string
let dump = Format.pp_print_string
let check s = ()
let equal : t -> t -> bool = (=)
let compare : t -> t -> int = Pervasives.compare
let hash = Hashtbl.hash
let serialize = Serialize.Put.string
let deserialize = Serialize.Get.string
end
module Int : T with type t = int = struct
type t = int
let dump = Format.pp_print_int
let check s = ()
let equal : t -> t -> bool = (=)
let compare : t -> t -> int = Pervasives.compare
let hash x = x
let serialize = Serialize.Put.int
let deserialize = Serialize.Get.int
end
module Bool : T with type t = bool = struct
type t = bool
let dump = Format.pp_print_bool
let check s = ()
let equal : t -> t -> bool = (=)
let compare : t -> t -> int = Pervasives.compare
let hash x = if x then 1 else 0
let serialize = Serialize.Put.bool
let deserialize = Serialize.Get.bool
end
module List(X : T) = struct
module Elem = X
type t = X.t list
let dump = dump_list X.dump
let check l = List.iter X.check l
let rec equal l1 l2 =
(l1 == l2) ||
match (l1,l2) with
| x1::l1, x2::l2 -> (X.equal x1 x2) && (equal l1 l2)
| _ -> false
let rec hash accu = function
| [] -> 1 + accu
| x::l -> hash (17 * accu + X.hash x) l
let hash l = hash 1 l
let rec compare l1 l2 =
if l1 == l2 then 0
else match (l1,l2) with
| x1::l1, x2::l2 ->
let c = X.compare x1 x2 in if c <> 0 then c
else compare l1 l2
| [],_ -> -1
| _ -> 1
let serialize = Serialize.Put.list X.serialize
let deserialize = Serialize.Get.list X.deserialize
end
module Pair(X : T)(Y : T) = struct
module Fst = X
module Snd = Y
type t = X.t * Y.t
let dump ppf (x,y) = Format.fprintf ppf "(%a,%a)" X.dump x Y.dump y
let check (x,y) = X.check x; Y.check y
let compare (x1,y1) (x2,y2) =
let c = X.compare x1 x2 in if c <> 0 then c
else Y.compare y1 y2
let equal (x1,y1) (x2,y2) = (X.equal x1 x2) && (Y.equal y1 y2)
let hash (x,y) = X.hash x + 17 * Y.hash y
let serialize = Serialize.Put.pair X.serialize Y.serialize
let deserialize = Serialize.Get.pair X.deserialize Y.deserialize
end
misc/ns.ml
View file @ b8d175e6
......@@ -15,7 +15,8 @@ let split_qname s =
("", U.mk s)
include Pool.Make(U)
module P = Pool.Make(U)
include P
let empty = mk empty_str
let xml_ns = mk (U.mk "http://www.w3.org/XML/1998/namespace")
......@@ -81,38 +82,39 @@ module Printer = struct
type slot = Hint of U.t list | Set of U.t
module H = Hashtbl.Make(P)
type printer = {
mutable ns_to_prefix : slot array;
ns_to_prefix : slot ref H.t;
mutable prefixes : (U.t * t) list;
table : table;
mutable hints : U.t list;
mutable counter : int;
}
let ensure p ns =
let l = Array.length p.ns_to_prefix in
if ns >= l then
let a = Array.create (ns + 1 + 2 * l) (Hint []) in
Array.blit p.ns_to_prefix 0 a 0 l;
p.ns_to_prefix <- a
let get_prefix p ns =
try H.find p.ns_to_prefix ns
with Not_found ->
let r = ref (Hint []) in
H.add p.ns_to_prefix ns r;
r
let printer table =
let p =
{ ns_to_prefix = [| |];
{ ns_to_prefix = H.create 63;
prefixes = [];
table = table;
hints = [];
counter = 0
} in
ensure p empty;
p.ns_to_prefix.(empty) <- Set empty_str;
H.add p.ns_to_prefix empty (ref (Set empty_str));
Table.iter
(fun pr ns ->
ensure p ns;
if (U.get_str pr <> "") then
match p.ns_to_prefix.(ns) with
| Hint l -> p.hints <- pr::p.hints; p.ns_to_prefix.(ns) <- Hint (pr::l)
match get_prefix p ns with
| { contents = Hint l } as r ->
p.hints <- pr::p.hints;
r := Hint (pr::l)
| _ -> assert false) table;
p
......@@ -140,13 +142,12 @@ module Printer = struct
then p.prefixes <- (pr, ns) :: p.prefixes
let register_ns p ns =
ensure p ns;
match p.ns_to_prefix.(ns) with
| Hint l ->
match get_prefix p ns with
| { contents = Hint l } as r ->
let pr = find_good_prefix p ns l in
p.ns_to_prefix.(ns) <- Set pr;
r := Set pr;
add_prefix p pr ns
| Set _ -> ()
| _ -> ()
let register_tag p (ns,_) = register_ns p ns
let register_attr = register_tag
......@@ -154,7 +155,7 @@ module Printer = struct
let prefixes p = p.prefixes
let tag p (ns,l) =
match p.ns_to_prefix.(ns) with
match !(get_prefix p ns) with
| Set pr ->
let pr = U.get_str pr in
if pr = "" then (U.get_str l)
......@@ -164,7 +165,7 @@ module Printer = struct
let attr p (ns,l) =
if ns == empty then (U.get_str l)
else
match p.ns_to_prefix.(ns) with
match !(get_prefix p ns) with
| Set pr ->
let pr = U.get_str pr in
if pr = "" then assert false
......@@ -173,7 +174,7 @@ module Printer = struct
let any_ns p ns =
match p.ns_to_prefix.(ns) with
match !(get_prefix p ns) with
| Set pr ->
let pr = U.get_str pr in
if pr = "" then ".:*"
......
misc/ns.mli
View file @ b8d175e6
......@@ -2,13 +2,10 @@ open Encodings
exception UnknownPrefix of Utf8.t
type t = int (* Namespaces (URIs) *)
include Custom.T with type t = int (* Namespaces (URIs) *)
val mk: Utf8.t -> t
val value: t -> Utf8.t
val empty : t
val compare: t -> t -> int
val hash: t -> int
val equal: t -> t -> bool
type qname = t * Utf8.t
......
misc/pool.ml
View file @ b8d175e6
module type T =
sig
type t
include Custom.T
type value
val clear: unit -> unit
......@@ -9,15 +9,11 @@ sig
val dummy_max: t
val value: t -> value
val compare: t -> t -> int
val hash: t -> int
val equal: t -> t -> bool
end
module Make(H : Hashtbl.HashedType) =
struct
type t = int
include Custom.Int
type value = H.t
module Tbl = Hashtbl.Make(H)
......@@ -25,6 +21,7 @@ struct
let cache = State.ref "Pool.cache" (Tbl.create 63)
let values = State.ref "Pool.values" (Array.create 63 None)
let counter = State.ref "Pool.counter" 0
let check x = assert (!values.(x) <> None)
let clear () =
Tbl.clear !cache;
......@@ -50,10 +47,5 @@ struct
let dummy_max = max_int
let value n = match !values.(n) with Some x -> x | None -> assert false
let compare (n1 : int) (n2 : int) =
if n1 < n2 then -1 else if n1 = n2 then 0 else 1
let hash n = n
let equal (n1 : int) (n2 : int) = n1 = n2
end
misc/pool.mli
View file @ b8d175e6
module type T =
sig
type t
include Custom.T
(* Hashtbl.hash'able and Pervasives.compare'able type;
typically, t is an integer *)
type value
......@@ -17,10 +17,6 @@ sig
resp. smallest and largest than any other symbol *)
val value: t -> value
val compare: t -> t -> int
val hash: t -> int
val equal: t -> t -> bool
end
module Make(H : Hashtbl.HashedType) : T with type value = H.t and type t = int
......
misc/serialize.ml 0 → 100644
View file @ b8d175e6
module Put = struct
type t = {
buf : Buffer.t;
mutable cur_byte : int; (* 0..255 *)
mutable cur_bits : int; (* 0..7 *)
}
type 'a f = t -> 'a -> unit
let run f x =
let t = { buf = Buffer.create 1024; cur_byte = 0; cur_bits = 0 } in
f t x;
if t.cur_bits > 0 then Buffer.add_char t.buf (Char.chr t.cur_byte);
Buffer.contents t.buf
let bool t b =
if b then t.cur_byte <- t.cur_byte lor (1 lsl t.cur_bits);
if t.cur_bits = 7 then (
Buffer.add_char t.buf (Char.chr t.cur_byte);
t.cur_byte <- 0;
t.cur_bits <- 0
) else
t.cur_bits <- succ t.cur_bits
let rec bits t i nb = (* TODO: opt *)
if (nb > 0) then (bool t ((i land 1) <> 0); bits t (i lsr 1) (pred nb))
let rec int t i =
bits t i 4;
let i = i lsr 4 in
if i <> 0 then (bool t true; int t i) else (bool t false)
let string t s =
let l = String.length s in
int t l;
for i = 0 to l - 1 do
bits t (Char.code (s.[i])) 8
done
let rec list f t = function
| [] -> bool t false