Allows to pass - as stdout.
Unix.kill !pid Sys.sigint
let time f ?(count=1) ?(msg="") x =
- if not !Options.verbose then f x
+ if not !Config.verbose then f x
else
let rec loop i =
Gc.compact();
- let oldstack = read_procmem () in
+ let oldstack = Utils.System.get_status "VmStk" in
let t1 = Unix.gettimeofday () in
let r = f x in
let t2 = Unix.gettimeofday () in
+ let newstack = Utils.System.get_status "VmStk" in
let t = (1000. *. (t2 -. t1)) in
Logger.verbose Format.err_formatter "%s: " msg;
if (count != 1) then Logger.verbose Format.err_formatter "run %i/%i, " i count;
- Logger.verbose Format.err_formatter "%fms (stack size: before=%s, after=%s)@\n" t oldstack (read_procmem());
+ Logger.verbose Format.err_formatter "%fms (stack size: before=%s, after=%s)@\n" t oldstack newstack;
if i >= count then (l:= t::!l;r)
else loop (i+1)
in
let libs_files = List.map (fun s -> "file:" ^ s) cxx_libs_objects
-let native_compile_flags = ref [A"-fno-PIC"]
+let native_compile_flags = if Sys.word_size = 64 then ref [A"-fno-PIC"] else ref []
let compile_flags = ref []
let dwsize = sprintf "-DWORDSIZE%i" Sys.word_size
let print ppf a =
fprintf ppf
- "Automaton (%i) :@\n\
+ "Unique ID: %i@\n\
States %a@\n\
Initial states: %a@\n\
Marking states: %a@\n\
let sline = Pretty.line (Pretty.length line) in
fprintf ppf "%s@\n" sline;
List.iter (fun s -> fprintf ppf "%s@\n" s) strings;
- fprintf ppf "%s@\n" sline
+ fprintf ppf "%s" sline
type jump_kind =
}
-extern "C" value sxsi_cpp_init(value unit)
+ML_BINDING value sxsi_cpp_init(value unit)
{
struct rlimit rlim;
init_exception();
#define NoAlloc
+//Must be used in front of every function that is called from OCaml.
+#if _M_IX86 || __i386
+#define ML_BINDING extern "C" __attribute__ ((force_align_arg_pointer))
+#else
+#define ML_BINDING extern "C"
+#endif
+
void register_custom_(char* name,
size_t size,
void sxsi_raise_msg(const char * msg);
-extern "C" value sxsi_cpp_init(value unit);
-
+ML_BINDING value sxsi_cpp_init(value unit);
#endif
--- /dev/null
+let index_empty_texts = ref true
+let sample_factor = ref 64
+let disable_text_collection = ref false
+let tc_threshold = ref 60000
+
+let query = ref ""
+let input_file = ref ""
+let output_file : string option ref = ref None
+let save_file = ref ""
+let count_only = ref false
+let time = ref false
+let bottom_up = ref false
+let no_jump = ref false
+let no_cache = ref false
+let verbose = ref false
+let text_index_type = ref 0
+let do_perf = ref false
+let twopass = ref false
+let repeat = ref 1
+let docstats = ref false
+let no_wrap_results = ref false
let init () = Memo.clear memo
let compute_jump auto tree tag states dir =
- if !Options.no_jump then
+ if !Config.no_jump then
if dir == DIR_LEFT then FIRST_CHILD states
else NEXT_SIBLING states
else
| BOTH(tr, NOP _, r) -> RIGHT (tr, r)
| _ -> op
in
- if not !Options.no_cache then add cache2 tag states op;
+ if not !Config.no_cache then add cache2 tag states op;
op
let get_transitions = function
ifprintf !logger_output fmt
let print ppf fmt =
- pp_open_hovbox ppf 0;
- kfprintf (fun _ ->
- pp_close_box ppf ();
- fprintf ppf "@?")
- ppf fmt
+ fprintf ppf fmt
let _verbose = ref false
let set_verbose b = _verbose := b
-let verbose ppf fmt =
- if !_verbose then begin
- pp_open_hovbox ppf 0;
- kfprintf (fun _ ->
- pp_close_box ppf ();
- fprintf ppf "@?")
- ppf fmt
- end else
- ikfprintf (fun _ ->
- pp_close_box ppf ();
- fprintf ppf "@?")
- ppf fmt
+let msg ppf fmt =
+ if !_verbose
+ then fprintf ppf fmt
+ else ifprintf ppf fmt
+
+let start_msg ppf s =
+ msg ppf "@[%s" s
+
+let end_msg ppf s =
+ msg ppf "@]%s@?" s
+
+let verbose a b = msg a b
val set_verbose : bool -> unit
val verbose : Format.formatter -> ('a, Format.formatter, unit) format -> 'a
+
+val start_msg : Format.formatter -> string -> unit
+val end_msg : Format.formatter -> string -> unit
+val msg : Format.formatter -> ('a, Format.formatter, unit) format -> 'a
let mk_runtime run auto doc arg count print outfile =
fun () ->
- if !Options.do_perf then start_perf ();
- let r = time ~count:!Options.repeat ~msg:"Execution time" (run auto doc) arg in
- if !Options.do_perf then stop_perf ();
- Logger.verbose Format.err_formatter "Number of results: %i@\n" (count r);
+ if !Config.do_perf then start_perf ();
+ let r = Utils.time ~count:!Config.repeat ~msg:"Execution time" (run auto doc) arg in
+ if !Config.do_perf then stop_perf ();
+ Logger.start_msg Format.err_formatter "[Debug] Number of results: ";
+ Logger.msg Format.err_formatter "%i" (count r);
+ Logger.end_msg Format.err_formatter "\n";
match outfile with
None -> ()
| Some file ->
- time ~count:1 ~msg:"Serialization time" (print file !Options.no_wrap_results doc) r
+ Utils.time ~count:1 ~msg:"Serialization time" (print file !Config.no_wrap_results doc) r
;;
let main v query_string output =
Tag.init (Tree.tag_operations v);
- if !Options.docstats then Tree.stats v;
+ if !Config.docstats then Tree.stats v;
let query =
- time ~msg:"Parsing query" XPath.parse query_string
+ Utils.time ~msg:"Parsing query" XPath.parse query_string
in
- Logger.verbose Format.err_formatter "Parsed query:%a@\n"
- XPath.Ast.print query;
+ Logger.start_msg Format.err_formatter "[Debug]";
+ Logger.msg Format.err_formatter " Parsed query: @\n @[<v 0> {";
+ Logger.msg Format.err_formatter " %a }@]" XPath.Ast.print query;
+ Logger.end_msg Format.err_formatter "\n\n";
let auto, bu_info =
- time ~msg:"Compiling query" Compile.compile query
+ Utils.time ~msg:"Compiling query" Compile.compile query
in
- if !Options.verbose then Ata.print Format.err_formatter auto;
+ Logger.start_msg Format.err_formatter "[Debug] Automaton: ";
+ Logger.msg Format.err_formatter "@\n @[<v 0>";
+ Logger.msg Format.err_formatter "%a" Ata.print auto;
+ Logger.end_msg Format.err_formatter "\n\n";
Gc.full_major();
Gc.compact();
Gc.set (tuned_gc);
let runtime =
- match !Options.bottom_up, bu_info with
+ match !Config.bottom_up, bu_info with
| true, Some [ (query, pattern) ] ->
- if !Options.count_only then
+ if !Config.count_only then
let module R = ResJIT.Count in
let module M = Runtime.Make(R) in
- mk_runtime M.bottom_up_run auto v (query, pattern) R.NS.length R.NS.serialize !Options.output_file
+ mk_runtime M.bottom_up_run auto v (query, pattern) R.NS.length R.NS.serialize !Config.output_file
else
let module R = ResJIT.Mat in
let module M = Runtime.Make(R) in
- mk_runtime M.bottom_up_run auto v (query, pattern) R.NS.length R.NS.serialize !Options.output_file
+ mk_runtime M.bottom_up_run auto v (query, pattern) R.NS.length R.NS.serialize !Config.output_file
| _ ->
(* run the query top_down *)
- if !Options.bottom_up then
+ if !Config.bottom_up then
Logger.verbose Format.err_formatter "Cannot run the query in bottom-up mode, using top-down evaluator@\n@?";
- if !Options.count_only then
+ if !Config.count_only then
let module R = ResJIT.Count in
let module M = Runtime.Make(R) in
- if !Options.twopass then
+ if !Config.twopass then
mk_runtime M.twopass_top_down_run auto v Tree.root R.NS.length R.NS.serialize None
else
- mk_runtime M.top_down_run auto v Tree.root R.NS.length R.NS.serialize !Options.output_file
+ mk_runtime M.top_down_run auto v Tree.root R.NS.length R.NS.serialize !Config.output_file
else
let module R = ResJIT.Mat in
let module M = Runtime.Make(R) in
- mk_runtime M.top_down_run auto v Tree.root R.NS.length R.NS.serialize !Options.output_file
+ mk_runtime M.top_down_run auto v Tree.root R.NS.length R.NS.serialize !Config.output_file
in
runtime ()
;;
try
Printexc.record_backtrace true;
let document =
- if Filename.check_suffix !Options.input_file ".srx"
+ if Filename.check_suffix !Config.input_file ".srx"
then
- time
- ~msg:"Loading file"
+ Utils.time
+ ~msg:"Loading Index file"
(Tree.load
- ~sample:!Options.sample_factor
- ~load_text:(not !Options.disable_text_collection))
- !Options.input_file
+ ~sample:!Config.sample_factor
+ ~load_text:(not !Config.disable_text_collection))
+ !Config.input_file
else
let v =
- time
- ~msg:"Parsing document"
+ Utils.time
+ ~msg:"Loading XML file"
(Tree.parse_xml_uri)
- !Options.input_file
+ !Config.input_file
in
let () =
- if !Options.save_file <> ""
+ if !Config.save_file <> ""
then
- time
+ Utils.time
~msg:"Writing file to disk"
(Tree.save v)
- !Options.save_file;
+ !Config.save_file;
in
v
in
- main document !Options.query !Options.output_file;
- Logger.verbose Format.err_formatter "Maximum resident set size: %s @\n" (read_procmem());
- Gc.full_major();
+ main document !Config.query !Config.output_file;
+IFDEF PROFILE
+ THEN
Profile.summary Format.err_formatter
+ ELSE ()
+END
with
| Ulexer.Loc.Exc_located ((x,y),e) ->
Logger.print Format.err_formatter "character %i-%i %s@\n" x y (Printexc.to_string e);
-open Utils
open Format
-
-let index_empty_texts = ref true
-let sample_factor = ref 64
-let disable_text_collection = ref false
-let tc_threshold = ref 60000
-
-let query = ref ""
-let input_file = ref ""
-let output_file = ref None
-let save_file = ref ""
-let count_only = ref false
-let time = ref false
-let bottom_up = ref false
-let no_jump = ref false
-let no_cache = ref false
-let verbose = ref false
-let text_index_type = ref 0
-let do_perf = ref false
-let twopass = ref false
-let repeat = ref 1
-let docstats = ref false
-let no_wrap_results = ref false
+open Config
let set_index_type = function
| "default" -> text_index_type := 0
List.iter (fun t ->
if t = "" then ()
else
- match String.explode t ':' with
+ match Utils.String.explode t ':' with
[ tr; lvl ] ->
let l = try int_of_string lvl with _ -> raise (Arg.Bad (lvl)) in
if Logger.is_logger tr then Logger.activate tr l
else raise (Arg.Bad (t))
| _ -> raise (Arg.Bad (t))
- ) (String.explode s ',')
+ ) (Utils.String.explode s ',')
let pretty_loggers () =
ignore(flush_str_formatter());
val parse_cmdline : unit -> unit
-val index_empty_texts : bool ref
-val sample_factor : int ref
-val disable_text_collection : bool ref
-val count_only : bool ref
-val query : string ref
-val input_file : string ref
-val output_file : string option ref
-val save_file : string ref
-val time : bool ref
-val tc_threshold : int ref
-val bottom_up : bool ref
-val no_jump : bool ref
-val no_cache : bool ref
-val verbose : bool ref
-val text_index_type : int ref
-val do_perf : bool ref
-val twopass : bool ref
-val repeat : int ref
-val docstats : bool ref
-val no_wrap_results : bool ref
let table = Hashtbl.create 103
let summary fmt =
+ Logger.start_msg fmt "[Stats] Function profiling:";
+ Logger.msg fmt "@\n @[<v 0>";
Hashtbl.iter (fun (m, f) d ->
let c, tl = !d in
let tspent =
List.fold_left (fun acc e -> e +. acc) 0. tl
in
- Format.fprintf fmt "%s: %s = called %i times, total: %fms, average: %fms\n"
+ Logger.msg fmt "%s: %s = called %i times, total: %fms, average: %fms@\n"
m f c tspent (tspent /. (float_of_int c))) table;
- Format.fprintf fmt "%!"
+ Logger.end_msg Format.err_formatter "\n\n"
+
let show_stats a =
let count = ref 0 in
Cache.Lvl3.iteri (fun _ _ _ _ b -> if not b then incr count) a;
- Logger.print err_formatter "@?L3JIT: %i used entries@\n@?" !count
+ Logger.start_msg err_formatter "[Debug] L3JIT used: ";
+ Logger.msg err_formatter "%i enttries" !count;
+ Logger.end_msg err_formatter "\n\n"
+
+ let _has_exit = ref false
let create () =
let v = Cache.Lvl3.create 1024 dummy in
- if !Options.verbose then at_exit (fun () -> show_stats v);
+ if !Config.verbose && not !_has_exit then begin
+ _has_exit := true;
+ at_exit (fun () -> show_stats v);
+ end;
v
let find t tlist s1 s2 =
let f = gen_code auto tlist s1 s2 in
LOG(__ "top-down-run" 2 "Inserting: %i, %a, %a\n%!"
(Uid.to_int tlist.Translist.Node.id) StateSet.print s1 StateSet.print s2);
- if not !Options.no_cache then add cache tlist s1 s2 f;
+ if not !Config.no_cache then add cache tlist s1 s2 f;
f
end
let do_text b t =
if Buffer.length t > 0 then begin
let s = Buffer.contents t in
- if (!Options.index_empty_texts) || not (is_whitespace s) then
+ if (!Config.index_empty_texts) || not (is_whitespace s) then
begin
open_tag b "<$>";
text b s;
close_tag build "";
LOG ( __ "parsing" 2 "%s\n" "Finished parsing");
LOG ( __ "indexing" 2 "%s\n" "Starting index construction");
- let r = close_document build in
+ let r = close_document build
+ in
LOG ( __ "indexing" 2 "%s\n" "Finished index construction");
r
in
Expat.set_end_element_handler parser_ (end_element_handler parser_ build buf);
Expat.set_character_data_handler parser_ (character_data_handler parser_ build buf);
LOG ( __ "parsing" 2 "%s\n" "Started parsing");
- open_document build !Options.sample_factor !Options.disable_text_collection !Options.text_index_type;
+ open_document build !Config.sample_factor !Config.disable_text_collection !Config.text_index_type;
open_tag build "";
parser_, finalize
let in_chan = open_in file in
let buffer = String.create 4096 in
let parser_, finalizer = create_parser () in
- let () =
+ let parse () =
try
while true do
let read = input in_chan buffer 0 4096 in
| End_of_file -> close_in in_chan
| e -> raise e
in
- finalizer ()
+ Utils.time ~msg:"Parsing XML file" parse ();
+ Utils.time ~msg:"Creating tree and text-collection index" finalizer ()
end
LOG ( __ "indexing" 2 "%s\n" "Initializing tag structure");
let _ = Tag.init (mk_tag_ops t) in
LOG ( __ "indexing" 2 "%s\n" "Starting tag table construction");
- let f, n, c, d = time collect_labels t ~msg:"Building tag relationship table" in
+ let f, n, c, d = Utils.time ~msg:"Building tag relationship table" collect_labels t in
let c = Array.map TagS.to_ptset c in
let n = Array.map TagS.to_ptset n in
let f = Array.map TagS.to_ptset f in
loop 0
end
;;
+
+module System =
+struct
+ let status () =
+ let pid = Unix.getpid() in
+ let cin = open_in (Printf.sprintf "/proc/%i/status" pid) in
+ let h = Hashtbl.create 17 in
+ try
+ while true do
+ let s = input_line cin in
+ Scanf.sscanf s "%s@: %s@\n" (fun k v ->
+ Hashtbl.replace h k v)
+ done;
+ (* never reached *)
+ h
+ with
+ End_of_file -> begin
+ close_in cin;
+ h
+ end
+ let get_status s = Hashtbl.find (status()) s
+
+ let pr_mem_status fmt h =
+ Format.fprintf fmt "[";
+ List.iter (fun k ->
+ let v = Hashtbl.find h k in
+ Format.fprintf fmt "%s: %s " k v
+ ) [ "VmStk"; "VmRSS"; "VmPeak" ];
+ Format.fprintf fmt "]"
+
+end
+
+module Timing =
+ struct
+ let _timings = Hashtbl.create 43
+ let _t_queue = Queue.create ()
+
+ let get_timing s =
+ try
+ Hashtbl.find _timings s
+ with
+ Not_found -> []
+
+ let set_timing s v =
+ Hashtbl.replace _timings s v
+
+
+ let display_result fmt msg sub l =
+ let h = Hashtbl.create 0 in
+ let tmin, tmax, ttotal, len, memo, memn =
+ List.fold_left (fun
+ (atmin, atmax, attotal, alen, _, _)
+ (t, om, nm) ->
+ (min t atmin,
+ max atmax t,
+ attotal +. t,
+ alen + 1,
+ om, nm))
+ (infinity, 0., 0., 0, h, h) l
+ in
+ Logger.start_msg fmt "[Stats] ";
+ Logger.msg fmt "%s %s:@\n @[<v 0>[" sub msg;
+ begin
+ if len <= 1 then
+ Logger.msg fmt
+ "@\n\
+| Time: %fms@\n"
+ tmin
+ else
+ Logger.msg fmt
+ "@\n\
+| Number of runs: %i@\n\
+| Average time: %fms@\n\
+| Minimum time: %fms@\n\
+| Maximum time: %fms@\n"
+ len
+ (ttotal /. (float_of_int len))
+ tmin
+ tmax
+
+ end;
+ Logger.msg fmt
+"| Memory before: %a@\n\
+| Memory after: %a@\n]@]"
+ System.pr_mem_status memo
+ System.pr_mem_status memn;
+ Logger.end_msg fmt "\n\n"
+
+
+let time f ?(count=1) ?(msg="") x =
+ if not !Config.verbose then f x
+ else
+ let rec loop i =
+ let oldmem = System.status () in
+ let t1 = Unix.gettimeofday () in
+ set_timing msg ((t1, oldmem, oldmem)::(get_timing msg));
+ let r = f x in
+ let t2 = Unix.gettimeofday () in
+ let newmem = System.status () in
+ let t1, oldmem, l =
+ match get_timing msg with
+ (a, b, _) :: l -> a,b,l
+ | _ -> assert false
+ in
+ let t = (1000. *. (t2 -. t1)) in
+ set_timing msg ((t, oldmem, newmem)::l);
+ if i >= count then r
+ else loop (i+1)
+ in
+ Queue.push msg _t_queue;
+ let r = loop 1 in
+ begin
+ if (Queue.peek _t_queue) = msg then
+ let pr_stack = Queue.fold (fun a e -> e::a) [] _t_queue in
+ Queue.clear _t_queue;
+ List.iter (fun msg' ->
+ let sub =
+ if msg' <> msg then "+" else "="
+ in
+ display_result Format.err_formatter msg' sub (get_timing msg')) pr_stack;
+ end;
+ r
+
+
+ end
+let time = Timing.time
return Obj_val<xml_tree_builder*>(v);
}
-extern "C" value caml_xml_tree_builder_create(value unit)
+ML_BINDING value caml_xml_tree_builder_create(value unit)
{
CAMLparam1(unit);
CAMLlocal1(result);
CAMLreturn(result);
}
-extern "C" value caml_xml_tree_builder_open_document(value vbuilder,
+ML_BINDING value caml_xml_tree_builder_open_document(value vbuilder,
value vsrate,
value vdtc,
value vidxtype)
CAMLreturn (Val_unit);
}
-extern "C" value caml_xml_tree_builder_close_document(value vbuilder)
+
+ML_BINDING value caml_xml_tree_builder_close_document(value vbuilder)
+
{
CAMLparam1(vbuilder);
CAMLlocal1(result);
CAMLreturn (result);
}
-extern "C" value caml_xml_tree_builder_open_tag(value vbuilder, value vtag)
+ML_BINDING value caml_xml_tree_builder_open_tag(value vbuilder, value vtag)
{
CAMLparam2(vbuilder, vtag);
const char * tag = String_val(vtag);
CAMLreturn (Val_unit);
}
-extern "C" value caml_xml_tree_builder_close_tag(value vbuilder, value vtag)
+ML_BINDING value caml_xml_tree_builder_close_tag(value vbuilder, value vtag)
{
CAMLparam2(vbuilder, vtag);
const char * tag = String_val(vtag);
CAMLreturn (Val_unit);
}
-extern "C" value caml_xml_tree_builder_text(value vbuilder, value vtext)
+ML_BINDING value caml_xml_tree_builder_text(value vbuilder, value vtext)
{
CAMLparam2(vbuilder, vtext);
const char * text = String_val(vtext);
return static_cast<xml_tree::tag_t>(Int_val(i));
}
-extern "C" value caml_xml_tree_save(value tree, value fd, value prefix)
+ML_BINDING value caml_xml_tree_save(value tree, value fd, value prefix)
{
CAMLparam3(tree, fd, prefix);
XMLTREE(tree)->save(Int_val(fd), String_val(prefix));
CAMLreturn (Val_unit);
}
-extern "C" value
+ML_BINDING value
caml_xml_tree_load(value fd, value prefix, value load_tc, value sf)
{
CAMLparam4(fd, prefix, load_tc, sf);
return (Val_unit);
}
-NoAlloc extern "C" value caml_xml_tree_root(value tree)
+NoAlloc ML_BINDING value caml_xml_tree_root(value tree)
{
return (Val_int(XMLTREE(tree)->root()));
}
-NoAlloc extern "C" value caml_xml_tree_size(value tree)
+NoAlloc ML_BINDING value caml_xml_tree_size(value tree)
{
return (Val_int(XMLTREE(tree)->size()));
}
-NoAlloc extern "C" value caml_xml_tree_num_tags(value tree)
+NoAlloc ML_BINDING value caml_xml_tree_num_tags(value tree)
{
return (Val_int(XMLTREE(tree)->num_tags()));
}
-NoAlloc extern "C" value caml_xml_tree_subtree_size(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_subtree_size(value tree, value node)
{
return (Val_int(XMLTREE(tree)->subtree_size(TREENODE(node))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_subtree_tags(value tree, value node, value tag)
{
return (Val_int(XMLTREE(tree)->subtree_tags(TREENODE(node),
TAG(tag))));
}
-NoAlloc extern "C" value caml_xml_tree_subtree_elements(value tree,
+NoAlloc ML_BINDING value caml_xml_tree_subtree_elements(value tree,
value node)
{
return (Val_int(XMLTREE(tree)->subtree_elements(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_is_leaf(value tree, value node){
+NoAlloc ML_BINDING value caml_xml_tree_is_leaf(value tree, value node){
return (Val_bool(XMLTREE(tree)->is_leaf(TREENODE(node))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_is_ancestor(value tree, value node1, value node2)
{
return (Val_bool(XMLTREE(tree)->is_ancestor(TREENODE(node1),
TREENODE(node2))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_is_child(value tree, value node1, value node2)
{
return (Val_bool(XMLTREE(tree)->is_child(TREENODE(node1),
TREENODE(node2))));
}
-NoAlloc extern "C" value caml_xml_tree_is_first_child(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_is_first_child(value tree, value node)
{
return (Val_bool(XMLTREE(tree)->is_first_child(TREENODE(node))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_is_right_descendant(value tree, value x, value y)
{
return (Val_bool(XMLTREE(tree)->is_right_descendant(TREENODE(x),
TREENODE(y))));
}
-NoAlloc extern "C" value caml_xml_tree_num_children(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_num_children(value tree, value node)
{
return (Val_int(XMLTREE(tree)->num_children(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_child_pos(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_child_pos(value tree, value node)
{
return (Val_int(XMLTREE(tree)->child_pos(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_depth(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_depth(value tree, value node)
{
return (Val_int(XMLTREE(tree)->depth(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_preorder(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_preorder(value tree, value node)
{
return (Val_int(XMLTREE(tree)->preorder(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_postorder(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_postorder(value tree, value node)
{
return (Val_int(XMLTREE(tree)->postorder(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_tag(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_tag(value tree, value node)
{
return (Val_int(XMLTREE(tree)->tag(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_parent(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_parent(value tree, value node)
{
return (Val_int(XMLTREE(tree)->parent(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_child(value tree, value node, value idx)
+NoAlloc ML_BINDING value caml_xml_tree_child(value tree, value node, value idx)
{
return (Val_int(XMLTREE(tree)->child(TREENODE(node), Int_val(idx))));
}
-NoAlloc extern "C" value caml_xml_tree_first_child(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_first_child(value tree, value node)
{
return (Val_int(XMLTREE(tree)->first_child(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_first_element(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_first_element(value tree, value node)
{
return (Val_int(XMLTREE(tree)->first_element(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_last_child(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_last_child(value tree, value node)
{
return (Val_int(XMLTREE(tree)->last_child(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_next_sibling(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_next_sibling(value tree, value node)
{
return (Val_int(XMLTREE(tree)->next_sibling(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_next_element(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_next_element(value tree, value node)
{
return (Val_int(XMLTREE(tree)->next_element(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_prev_sibling(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_prev_sibling(value tree, value node)
{
return (Val_int(XMLTREE(tree)->prev_sibling(TREENODE(node))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_tagged_child(value tree, value node, value tag)
{
return (Val_int(XMLTREE(tree)->tagged_child(TREENODE(node),
TAG(tag))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_select_child(value tree, value node, value tags)
{
return (Val_int(XMLTREE(tree)->select_child(TREENODE(node), TAGLIST(tags))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_tagged_sibling(value tree, value node, value tag)
{
return (Val_int(XMLTREE(tree)->tagged_sibling(TREENODE(node),
TAG(tag))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_select_sibling(value tree, value node, value tags)
{
return (Val_int(XMLTREE(tree)->select_sibling(TREENODE(node),
TAGLIST(tags))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_tagged_descendant(value tree, value node, value tag)
{
return (Val_int(XMLTREE(tree)->tagged_descendant(TREENODE(node),
TAG(tag))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_tagged_next(value tree, value node, value tag)
{
return (Val_int(XMLTREE(tree)->tagged_next(TREENODE(node),
TAG(tag))));
}
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
caml_xml_tree_select_descendant(value tree, value node, value tags)
{
return (Val_int(XMLTREE(tree)->select_descendant(TREENODE(node),
TAGLIST(tags))));
}
-NoAlloc extern "C" value caml_xml_tree_tagged_following_before(value tree,
+NoAlloc ML_BINDING value caml_xml_tree_tagged_following_before(value tree,
value node,
value tag,
value closing)
TREENODE(closing))));
}
-NoAlloc extern "C" value caml_xml_tree_select_following_before(value tree,
+NoAlloc ML_BINDING value caml_xml_tree_select_following_before(value tree,
value node,
value tags,
value closing)
-extern "C" value caml_xml_tree_get_text_collection(value tree)
+ML_BINDING value caml_xml_tree_get_text_collection(value tree)
{
CAMLparam1(tree);
CAMLlocal1(text);
CAMLreturn (text);
}
-NoAlloc extern "C" value caml_xml_tree_closing(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_closing(value tree, value node)
{
return (Val_int(XMLTREE(tree)->closing(TREENODE(node))));
}
-NoAlloc extern "C" value caml_xml_tree_nullt(value unit){
+NoAlloc ML_BINDING value caml_xml_tree_nullt(value unit){
return (Val_int(xml_tree::NIL));
}
-extern "C" value caml_xml_tree_print(value tree, value node, value fd)
+ML_BINDING value caml_xml_tree_print(value tree, value node, value fd)
{
CAMLparam3(tree, node, fd);
XMLTREE(tree)->print(TREENODE(node), Int_val(fd));
}
-extern "C" value caml_xml_tree_get_tag_name(value tree, value tag)
+ML_BINDING value caml_xml_tree_get_tag_name(value tree, value tag)
{
CAMLparam2(tree, tag);
CAMLlocal1(res);
CAMLreturn(res);
}
-NoAlloc extern "C" value caml_xml_tree_flush(value tree, value fd)
+NoAlloc ML_BINDING value caml_xml_tree_flush(value tree, value fd)
{
XMLTREE(tree)->flush(Int_val(fd));
return Val_unit;
}
-extern "C" value caml_xml_tree_register_tag(value tree, value str)
+ML_BINDING value caml_xml_tree_register_tag(value tree, value str)
{
CAMLparam2(tree, str);
value res;
}
#define BV_QUERY(pref, Pref) \
- extern "C" value caml_text_collection_## pref ##_bv(value tree, value str, value dobvv){ \
+ ML_BINDING value caml_text_collection_## pref ##_bv(value tree, value str, value dobvv){ \
CAMLparam3(tree, str, dobvv); \
CAMLlocal3(res, res_bv, res_array); \
int j; \
}; \
caml_initialize(&Field(res_array, i), Val_int(j)); \
}; \
- fprintf(stderr, "Raw results: %lu, Sorted reulsts %lu\n", uresults.size(), results.size()); \
+ fprintf(stderr, "Raw results: %zu, Sorted results %zu\n", uresults.size(), results.size()); \
free(cstr); \
res = caml_alloc(2, 0); \
Store_field(res, 0, res_bv); \
projects / SXSI / xpathcomp.git / commitdiff