* Now a data structure can register operations for tags via the Tag module.
CAMLreturn(Val_bool(GRAMMAR(grammar)->isNil(Long_val(rule))));
}
-extern "C" value caml_grammar_get_tag(value grammar, value symbol)
+extern "C" value caml_grammar_get_tag(value grammar, value tag)
{
CAMLparam1(grammar);
CAMLlocal1(res);
- const char * s = (GRAMMAR(grammar)->getTagName(Long_val(symbol) >> 2)).c_str();
+ const char * s = (GRAMMAR(grammar)->getTagName(Long_val(tag))).c_str();
res = caml_copy_string(s);
CAMLreturn(res);
}
CAMLparam1(grammar);
CAMLreturn(Val_int(GRAMMAR(grammar)->getParamPos(Long_val(rule))));
}
+
+extern "C" value caml_grammar_translate_tag(value grammar, value tag)
+{
+ CAMLparam1(grammar);
+ CAMLreturn(Val_int(GRAMMAR(grammar)->translateTag(Int_val(tag))));
+}
+
+extern "C" value caml_grammar_register_tag(value grammar, value str)
+{
+ CAMLparam2(grammar, str);
+ char * s = String_val(str);
+ CAMLreturn(Val_int(GRAMMAR(grammar)->getTagID(s)));
+}
external is_nil : t -> t_symbol -> bool = "caml_grammar_is_nil"
-external get_tag : t -> t_symbol -> string = "caml_grammar_get_tag"
+external translate_tag : t -> Tag.t -> Tag.t = "caml_grammar_translate_tag"
+external to_string : t -> Tag.t -> string = "caml_grammar_get_tag"
+external register_tag : t -> string -> Tag.t = "caml_grammar_register_tag"
+
+
+
+let tag_operations t = {
+ Tag.tag = (fun s -> register_tag t s);
+ Tag.to_string = (fun s -> to_string t s);
+ Tag.translate = (fun s -> translate_tag t s);
+}
external get_symbol_at : t -> symbol -> node -> symbol = "caml_grammar_get_symbol_at"
external first_child : t -> symbol -> node -> node = "caml_grammar_first_child"
n land 3 == 2
+let symbol_tag (n : t_symbol) = (Node.to_int n) lsr 2
+;;
+let get_tag g (n : t_symbol) = to_string g (symbol_tag n)
+
+
+
external parameter : [< any_type ] Node.t -> p_symbol = "%identity"
external terminal : [< any_type ] Node.t -> t_symbol = "%identity"
external non_terminal : [< any_type ] Node.t -> n_symbol = "%identity"
in
Unix.close fd;
traversal g;
+ Tag.init (tag_operations g);
g
let main v query_string output =
- Tag.init (Tree.tag_pool v);
+ Tag.init (Tree.tag_operations v);
let query =
time ~msg:"Parsing query" XPath.parse query_string
in
let g = time ~msg:"Loading grammar" (Grammar.load !Options.input_file) true in
begin
ignore(g);
+ Unix.sleep 10; (* Leave monitoring process the time to read the HWM *)
exit 0
end
else if Filename.check_suffix !Options.input_file ".srx"
type t = int
-type pool
type operations = {
- tag : pool -> string -> t;
- to_string : pool -> t ->string;
- nullt : pool -> t;
- translate : pool -> t -> t
+ tag : string -> t;
+ to_string : t ->string;
+ translate : t -> t
}
+type intern = {
+ mutable tag_ : string -> t;
+ mutable to_string_ : t ->string;
+ mutable translate_ : t -> t
+}
+
+
+
+
+
let dummy_fun =function _ -> failwith "Tag.ml Uninitialized tag structure"
+let ops = {
+ tag_ = dummy_fun;
+ to_string_ = dummy_fun;
+ translate_ = dummy_fun
+}
+
+let init p =
+ ops.tag_ <- p.tag;
+ ops.to_string_ <- p.to_string;
+ ops.translate_ <- p.translate
+
+let tag s = ops.tag_ s
+let to_string t = ops.to_string_ t
+let translate s = ops.translate_ s
-external null_pool : unit -> pool = "caml_xml_tree_nullt"
-external null_tag : unit -> t = "caml_xml_tree_nullt"
-external register_tag : pool -> string -> t = "caml_xml_tree_register_tag"
-external tag_name : pool -> t -> string = "caml_xml_tree_get_tag_name"
-external num_tags : pool -> int = "caml_xml_tree_num_tags"
-let nullt = null_tag ()
+
+let nullt = ~-1
let dummy = nullt
(* Defined in XMLTree.cpp *)
let document_node = 0
let attribute_data_close= 7
-let pool = Weak.create 1
-
-let init p = Weak.set pool 0 (Some p)
-
-let get_pool () = match Weak.get pool 0 with
- | Some x -> x
- | None -> failwith "Tag.ml: Uninitialized Document"
-
-let tag s = match s with
- | "<$>" -> pcdata
- | "<@>" -> attribute
- | "" -> document_node
- | "<@$>" -> attribute_data
- | _ -> register_tag (get_pool()) s
-
let compare = (-)
let equal = (==)
let hash x = x
-
-let to_string t =
- if t == pcdata then "<$>"
- else if t == attribute_data then "<@$>"
- else if t == attribute then "<@>"
- else if t == nullt then "<!NIL!>"
- else tag_name (get_pool()) t
-
-
-let xml_operations = {
- tag = (fun _ x -> tag x);
- to_string = (fun _ x -> to_string x);
- nullt = (fun _ -> nullt);
- translate = (fun _ x -> x);
-}
-
-
-
-
+(*
let dump_tags () =
Format.eprintf "Tags are:\n";
let doc = get_pool() in
for i = 0 to ntags - 1 do
Format.eprintf "%i, -><%s/>\n%!" i (to_string i)
done
-
+*)
let print ppf t = Format.fprintf ppf "%s" (to_string t)
let dump = print
+
+
+
+
+
+
+
+
+
+
+(* To move *)
+
type t = int
-type pool
+
type operations = {
- tag : pool -> string -> t;
- to_string : pool -> t -> string;
- nullt : pool -> t;
- translate : pool -> t -> t
+ tag : string -> t;
+ to_string : t -> string;
+ translate : t -> t
}
-val tag : string -> t
val document_node : t
val attribute : t
val attribute_close : t
val pcdata_close : t
val attribute_data_close : t
+val nullt : t
+val dummy : t
-val init : pool -> (* operations -> *) unit
-val to_string : t -> string
val compare : t -> t -> int
val equal : t -> t -> bool
-val nullt : t
-val dummy : t
+
+
val dump : Format.formatter -> t -> unit
val check : t -> unit (* Check internal invariants *)
val hash : t -> int
val print : Format.formatter -> t -> unit
-val dump_tags : unit -> unit
+val init : operations -> unit
+
+val tag : string -> t
+val to_string : t -> string
+val translate : t -> t
+
+
type tree
+external register_tag : tree -> string -> Tag.t = "caml_xml_tree_register_tag"
+
+external tag_name : tree -> Tag.t -> string = "caml_xml_tree_get_tag_name"
+
+let tag t = (); fun s ->
+ match s with
+ | "<$>" -> Tag.pcdata
+ | "<@>" -> Tag.attribute
+ | "" -> Tag.document_node
+ | "<@$>" -> Tag.attribute_data
+ | _ -> register_tag t s
+
+let to_string d = ();
+ fun t ->
+ if t == Tag.pcdata then "<$>"
+ else if t == Tag.attribute_data then "<@$>"
+ else if t == Tag.attribute then "<@>"
+ else if t == Tag.nullt then "<!NIL!>"
+ else tag_name d t
+
+let translate x = x
+
+let mk_tag_ops t = {
+ Tag.tag = tag t;
+ Tag.to_string = to_string t;
+ Tag.translate = translate
+}
+
module TreeBuilder =
struct
type t
}
-
+let tag_operations t = mk_tag_ops t.doc
(*
external parse_xml_uri : string -> int -> bool -> bool -> int -> tree = "caml_call_shredder_uri"
external parse_xml_string : string -> int -> bool -> bool -> int -> tree = "caml_call_shredder_string"
let is_root t = t == root
let node_of_t t =
- let _ = Tag.init (Obj.magic t) in
+ let _ = Tag.init (mk_tag_ops t) in
let f, n, c, d = time collect_labels t ~msg:"Building tag relationship table" in
let c = Array.map TagS.to_ptset c in
let n = Array.map TagS.to_ptset n in
let size t = tree_size t.doc;;
-external pool : tree -> Tag.pool = "%identity"
-
let magic_string = "SXSI_INDEX"
let version_string = "3"
-let tag_pool t = pool t.doc
-
let equal a b = a == b
let nts = function
val parse_xml_string : string -> t
val save : t -> string -> unit
val load : ?sample:int -> ?load_text:bool -> string -> t
-val tag_pool : t -> Tag.pool
val nil : node
val stats : t -> unit
val num_tags : t -> int
-val tag_pool : t -> Tag.pool
+
+val tag_operations : t -> Tag.operations
val print_xml : t -> node -> Unix.file_descr -> unit
val flush : t -> Unix.file_descr -> unit