From: Kim Nguyễn Date: Fri, 26 Oct 2012 12:41:52 +0000 (+0200) Subject: Merge branch 'handle-stdout' X-Git-Url: http://git.nguyen.vg/gitweb/?a=commitdiff_plain;h=HEAD;hp=4de8e95b17adf047c7789f44ec0ba64fd02b0b5a;p=SXSI%2Fxpathcomp.git Merge branch 'handle-stdout' Allows to pass - as stdout. --- diff --git a/include/utils.ml b/include/utils.ml index 4a844f4..2d66352 100644 --- a/include/utils.ml +++ b/include/utils.ml @@ -103,18 +103,19 @@ let stop_perf () = 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 diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 6f27e4e..6121130 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -20,7 +20,7 @@ let link_flags = [ A"-linkpkg" ] 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 diff --git a/src/ata.ml b/src/ata.ml index 591fab1..272e8e0 100644 --- a/src/ata.ml +++ b/src/ata.ml @@ -19,7 +19,7 @@ type t = { let print ppf a = fprintf ppf - "Automaton (%i) :@\n\ + "Unique ID: %i@\n\ States %a@\n\ Initial states: %a@\n\ Marking states: %a@\n\ @@ -48,7 +48,7 @@ let print ppf a = 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 = diff --git a/src/common_stub.cpp b/src/common_stub.cpp index 85be940..781d079 100644 --- a/src/common_stub.cpp +++ b/src/common_stub.cpp @@ -71,7 +71,7 @@ value alloc_custom_(char* name) } -extern "C" value sxsi_cpp_init(value unit) +ML_BINDING value sxsi_cpp_init(value unit) { struct rlimit rlim; init_exception(); diff --git a/src/common_stub.hpp b/src/common_stub.hpp index 45aa0ca..ae672da 100644 --- a/src/common_stub.hpp +++ b/src/common_stub.hpp @@ -18,6 +18,13 @@ extern "C" { #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, @@ -58,8 +65,7 @@ sxsi_alloc_custom(void (*finalize)(value) = sxsi_finalize_custom) void sxsi_raise_msg(const char * msg); -extern "C" value sxsi_cpp_init(value unit); - +ML_BINDING value sxsi_cpp_init(value unit); #endif diff --git a/src/config.ml b/src/config.ml new file mode 100644 index 0000000..67ec6d4 --- /dev/null +++ b/src/config.ml @@ -0,0 +1,21 @@ +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 diff --git a/src/l2JIT.ml b/src/l2JIT.ml index 8e623e0..c3f212e 100644 --- a/src/l2JIT.ml +++ b/src/l2JIT.ml @@ -219,7 +219,7 @@ let memo = Memo.create 1024 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 @@ -267,7 +267,7 @@ let compile cache2 auto tree tag states = | 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 diff --git a/src/logger.ml b/src/logger.ml index c213b43..05fbc83 100644 --- a/src/logger.ml +++ b/src/logger.ml @@ -40,23 +40,19 @@ let log t l fmt = 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 diff --git a/src/logger.mli b/src/logger.mli index 1ee96d5..15b28e9 100644 --- a/src/logger.mli +++ b/src/logger.mli @@ -13,3 +13,7 @@ val available : unit -> string list 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 diff --git a/src/main.ml b/src/main.ml index 2030452..69bd091 100644 --- a/src/main.ml +++ b/src/main.ml @@ -21,60 +21,67 @@ let tuned_gc = { default_gc with 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 @[ {"; + 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 @["; + 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 () ;; @@ -85,35 +92,37 @@ let _ = 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); diff --git a/src/options.ml b/src/options.ml index d537d78..fbbd73e 100644 --- a/src/options.ml +++ b/src/options.ml @@ -1,27 +1,5 @@ -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 @@ -43,13 +21,13 @@ let set_logger s = 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()); diff --git a/src/options.mli b/src/options.mli index 4626e57..bf18180 100644 --- a/src/options.mli +++ b/src/options.mli @@ -1,21 +1 @@ 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 diff --git a/src/profile.ml b/src/profile.ml index c43dda6..a0be76b 100644 --- a/src/profile.ml +++ b/src/profile.ml @@ -1,11 +1,14 @@ let table = Hashtbl.create 103 let summary fmt = + Logger.start_msg fmt "[Stats] Function profiling:"; + Logger.msg fmt "@\n @["; 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" + diff --git a/src/runtime.ml b/src/runtime.ml index 0ba08a2..669fb4a 100644 --- a/src/runtime.ml +++ b/src/runtime.ml @@ -73,10 +73,17 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t = 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 = @@ -151,7 +158,7 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t = 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 diff --git a/src/tree.ml b/src/tree.ml index 84de829..b7b8566 100644 --- a/src/tree.ml +++ b/src/tree.ml @@ -81,7 +81,7 @@ struct 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; @@ -125,7 +125,8 @@ struct 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 @@ -133,7 +134,7 @@ struct 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 @@ -146,7 +147,7 @@ struct 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 @@ -158,7 +159,8 @@ struct | 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 @@ -543,7 +545,7 @@ let node_of_t t = 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 diff --git a/src/utils.ml b/src/utils.ml index c5547aa..7e3bb4b 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -22,3 +22,129 @@ struct 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 @[[" 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 diff --git a/src/xml-tree-builder_stub.cpp b/src/xml-tree-builder_stub.cpp index 6fc1c60..89442da 100644 --- a/src/xml-tree-builder_stub.cpp +++ b/src/xml-tree-builder_stub.cpp @@ -8,7 +8,7 @@ static xml_tree_builder*& OBJ_VAL(value v) return Obj_val(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); @@ -18,7 +18,7 @@ extern "C" value caml_xml_tree_builder_create(value unit) 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) @@ -47,7 +47,9 @@ extern "C" value caml_xml_tree_builder_open_document(value vbuilder, 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); @@ -59,7 +61,7 @@ extern "C" value caml_xml_tree_builder_close_document(value vbuilder) 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); @@ -67,7 +69,7 @@ extern "C" value caml_xml_tree_builder_open_tag(value vbuilder, value 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); @@ -75,7 +77,7 @@ extern "C" value caml_xml_tree_builder_close_tag(value vbuilder, value 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); diff --git a/src/xml-tree_stub.cpp b/src/xml-tree_stub.cpp index 1d52a9d..5dbdf36 100644 --- a/src/xml-tree_stub.cpp +++ b/src/xml-tree_stub.cpp @@ -19,14 +19,14 @@ static xml_tree::tag_t TAG(value i) return static_cast(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); @@ -50,188 +50,188 @@ caml_xml_tree_load(value fd, value prefix, value load_tc, value 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) @@ -241,7 +241,7 @@ NoAlloc extern "C" value caml_xml_tree_tagged_following_before(value tree, 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) @@ -253,7 +253,7 @@ NoAlloc extern "C" value caml_xml_tree_select_following_before(value tree, -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); @@ -262,17 +262,17 @@ extern "C" value caml_xml_tree_get_text_collection(value tree) 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)); @@ -280,7 +280,7 @@ extern "C" value caml_xml_tree_print(value tree, value node, value 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); @@ -289,13 +289,13 @@ extern "C" value caml_xml_tree_get_tag_name(value tree, value tag) 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; @@ -329,7 +329,7 @@ static std::vector sort_results(std::vector v, xml_tree *t) } #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; \ @@ -349,7 +349,7 @@ static std::vector sort_results(std::vector v, xml_tree *t) }; \ 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); \