8f841945b40c9c91d03b85a164fc9ce145e95ffb
[SXSI/xpathcomp.git] / OCamlDriver.cpp
1 /**************************************
2  * OCamlDriver.cpp
3  * -------------------
4  * An Ocaml Driver which calls the C++ methods and
5  * adds a C wrapper interface with OCaml code.
6  * 
7  * Author: Kim Nguyen
8  * Date: 04/11/08
9  */
10
11 /***
12  *  Conventions:
13  *  functions never doing any allocation (non caml_alloc*, caml_copy_string,...)
14  *  have NOALLOC in the comment and their external declaration can have "noalloc"
15  */
16
17
18 #include <unordered_set>
19 #include <algorithm>
20 #include "XMLDocShredder.h"
21 #include "XMLTree.h"
22 #include "Utils.h"
23
24 extern "C" {
25 /* OCaml memory managment */
26 #include <caml/mlvalues.h>
27 #include <caml/alloc.h>
28 #include <caml/memory.h>
29 #include <caml/callback.h>
30 #include <caml/fail.h>
31 #include <caml/custom.h>
32 #include "results.h"
33 #include <stdio.h>
34
35 #define CAMLRAISEMSG(msg) (caml_raise_with_string(*cpp_exception,(msg) ))
36 #define NOT_IMPLEMENTED(s)  (caml_failwith(s))
37 #define XMLTREE(x) ((XMLTree *)(* (XMLTree**) Data_custom_val(x)))
38 #define HSET(x) ((TagIdSet*)((* (TagIdSet**) Data_custom_val(x))))
39 #define TEXTCOLLECTION(x)
40 #define TREENODEVAL(i) ((treeNode) (Int_val(i)))
41 #define TAGVAL(i) ((TagType) (Int_val(i)))
42 #define XMLTREE_ROOT 0
43 #define NoAlloc
44
45   
46   static struct custom_operations ops;
47   static struct custom_operations set_ops;
48   static value * cpp_exception = NULL;
49   static bool ops_initialized = false;
50   
51 }
52
53 extern "C" void caml_xml_tree_finalize(value tree){
54   delete XMLTREE(tree);
55   return;
56 }
57
58 extern "C" void caml_hset_finalize(value hblock){
59   delete HSET(hblock);
60   return;
61 }
62
63 extern "C"  value caml_init_lib (value unit) {
64   CAMLparam1(unit);
65   if (!ops_initialized){
66     
67   
68   ops.identifier = (char*) "XMLTree";
69   ops.finalize = caml_xml_tree_finalize;
70   set_ops.identifier = (char*) "unordered_set";
71   set_ops.finalize = caml_hset_finalize;
72   
73   cpp_exception = caml_named_value("CPlusPlusError");
74   if (cpp_exception == NULL){
75     string s = "FATAL: Unregistered exception ";
76     s += "CPlusPlusError";
77     caml_failwith(s.c_str());
78   };
79   
80   ops_initialized = true;
81   
82   };
83   CAMLreturn(Val_unit);
84   
85 }
86 extern "C"  value caml_shredder_parse(XMLDocShredder *shredder){
87   CAMLparam0();
88   CAMLlocal1(doc);
89   XMLTree * tree;
90   shredder->processStartDocument("");  
91   shredder->parse();  
92   shredder->processEndDocument();
93   doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
94   tree = (XMLTree *) shredder->getXMLTree();
95   memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
96   CAMLreturn(doc);
97   
98 }
99
100 extern "C"  value caml_call_shredder_uri(value uri,value sf, value iet, value dtc){
101   CAMLparam1(uri);
102   CAMLlocal1(doc);
103   char *fn = String_val(uri);
104   XMLDocShredder * shredder;
105   try {
106     shredder = new XMLDocShredder(fn,Int_val(sf),Bool_val(iet),Bool_val(dtc));
107     doc = caml_shredder_parse(shredder);
108     delete shredder;
109   }
110   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
111   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
112   catch (char const * msg){ CAMLRAISEMSG(msg);  };
113   CAMLreturn (doc);
114   
115 }
116 extern "C"  value caml_call_shredder_string(value data,value sf, value iet, value dtc){
117   CAMLparam1(data);
118   CAMLlocal1(doc);
119   XMLDocShredder * shredder;
120   unsigned int ln = string_length(data);
121   unsigned char *fn = (unsigned char*) String_val(data);
122   try {
123     shredder = new  XMLDocShredder (fn,ln,Int_val(sf),Bool_val(iet),Bool_val(dtc));  
124     doc = caml_shredder_parse(shredder);
125     delete shredder;
126   }
127   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
128   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
129   catch (char const * msg){ CAMLRAISEMSG(msg);  };
130   CAMLreturn(doc);
131 }
132
133 extern "C"  value caml_xml_tree_save(value tree,value fd){
134   CAMLparam2(tree,fd);
135   XMLTREE(tree)->Save(Int_val(fd));
136   CAMLreturn (Val_unit);
137 }
138
139 extern "C"  value caml_xml_tree_load(value fd, value load_tc,value sf){
140   CAMLparam3(fd,load_tc,sf);
141   CAMLlocal1(doc);
142   XMLTree * tree;
143   try {
144     tree = XMLTree::Load(Int_val(fd),Bool_val(load_tc),Int_val(sf));
145     printf("Pointer to tree is %p\n", (void*) tree);
146     doc = caml_alloc_custom(&ops,sizeof(XMLTree*),1,2);
147     memcpy(Data_custom_val(doc),&tree,sizeof(XMLTree*));
148     CAMLreturn(doc);
149   }
150   catch (const xmlpp::internal_error& e){ CAMLRAISEMSG(e.what()); }
151   catch (const std::exception& e){ CAMLRAISEMSG(e.what()); }
152   catch (string  msg){  CAMLRAISEMSG(msg.c_str()); }
153   catch (char const * msg){ CAMLRAISEMSG(msg);  };
154 }
155
156
157 /**
158  *  Interface to the TextCollection
159  */
160
161 /**
162  *  Utility functions
163  */
164
165 extern "C"  value caml_text_collection_get_text(value tree, value id){
166   CAMLparam2(tree,id);
167   CAMLlocal1(str);
168   uchar* txt = XMLTREE(tree)->GetText((DocID) Int_val(id));
169   str = caml_copy_string((const char*)txt);
170   CAMLreturn (str);
171 }
172
173
174 extern "C"  value caml_text_collection_empty_text(value tree,value id){
175   CAMLparam2(tree,id);
176   CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
177 }
178
179 bool docId_comp(DocID x, DocID y) { return x < y; };
180
181 /**
182  * Existential queries
183  */
184
185 extern "C"  value caml_text_collection_is_prefix(value tree,value str){
186   CAMLparam2(tree,str);
187   uchar * cstr = (uchar *) String_val(str);  
188   CAMLreturn (Val_bool((int) XMLTREE(tree)->IsPrefix(cstr)));
189 }
190
191 extern "C"  value caml_text_collection_is_suffix(value tree,value str){
192   CAMLparam2(tree,str);
193   uchar * cstr = (uchar *) String_val(str);  
194   CAMLreturn (Val_bool((int) XMLTREE(tree)->IsSuffix(cstr)));
195 }
196 extern "C"  value caml_text_collection_is_equal(value tree,value str){
197   CAMLparam2(tree,str);
198   uchar * cstr = (uchar *) String_val(str);  
199   CAMLreturn (Val_bool((int) XMLTREE(tree)->IsEqual(cstr)));
200 }
201 extern "C"  value caml_text_collection_is_contains(value tree,value str){
202   CAMLparam2(tree,str);
203   uchar * cstr = (uchar *) String_val(str);  
204   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsContains(cstr)));
205 }
206
207 extern "C"  value caml_text_collection_is_lessthan(value tree,value str){
208   CAMLparam2(tree,str);
209   uchar * cstr = (uchar *) String_val(str);  
210   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsLessThan(cstr)));
211 }
212
213
214 /**
215  * Count Queries
216  */
217
218 /**
219  *  Global counting
220  */
221 extern "C"  value caml_text_collection_count(value tree,value str){
222   CAMLparam2(tree,str);
223   uchar * cstr = (uchar *) String_val(str);
224   CAMLreturn (Val_int((XMLTREE(tree)->Count(cstr))));
225 }
226
227 extern "C"  value caml_text_collection_count_prefix(value tree,value str){
228   CAMLparam2(tree,str);
229   uchar * cstr = (uchar *) String_val(str);
230   CAMLreturn (Val_int((XMLTREE(tree)->CountPrefix(cstr))));
231 }
232
233 extern "C"  value caml_text_collection_count_suffix(value tree,value str){
234   CAMLparam2(tree,str);
235   uchar * cstr = (uchar *) String_val(str);
236   CAMLreturn (Val_int((XMLTREE(tree)->CountSuffix(cstr))));
237 }
238
239 extern "C"  value caml_text_collection_count_equal(value tree,value str){
240   CAMLparam2(tree,str);
241   uchar * cstr = (uchar *) String_val(str);
242   CAMLreturn (Val_int((XMLTREE(tree)->CountEqual(cstr))));
243 }
244
245 extern "C"  value caml_text_collection_count_contains(value tree,value str){
246   CAMLparam2(tree,str);
247   uchar * cstr = (uchar *) String_val(str);  
248   CAMLreturn (Val_int((XMLTREE(tree)->CountContains(cstr)))); 
249 }
250
251 extern "C"  value caml_text_collection_count_lessthan(value tree,value str){
252   CAMLparam2(tree,str);
253   uchar * cstr = (uchar *) String_val(str);  
254   CAMLreturn (Val_int((XMLTREE(tree)->CountLessThan(cstr)))); 
255 }
256
257 static value sort_alloc_array(std::vector<DocID> results, value resarray){
258     std::sort(results.begin(), results.end(), docId_comp);
259     size_t s = results.size();
260     resarray = caml_alloc_tuple(s);
261     for (size_t i = 0; i < s ;i++){
262       caml_initialize(&Field(resarray,i),Val_int(results[i]));
263     };
264     return resarray;
265 }
266
267 /**
268  * Full reporting queries
269  */
270
271 extern "C"  value caml_text_collection_prefix(value tree,value str){
272   CAMLparam2(tree,str);
273   CAMLlocal1(resarray);
274   uchar * cstr = (uchar *) String_val(str);  
275   std::vector<DocID> results = XMLTREE(tree)->Prefix(cstr);
276   CAMLreturn (sort_alloc_array(results,resarray));  
277 }
278
279 extern "C"  value caml_text_collection_suffix(value tree,value str){
280   CAMLparam2(tree,str);
281   CAMLlocal1(resarray);
282   uchar * cstr = (uchar *) String_val(str);  
283   std::vector<DocID> results = XMLTREE(tree)->Suffix(cstr);
284   CAMLreturn (sort_alloc_array(results,resarray));  
285 }
286
287 extern "C"  value caml_text_collection_equals(value tree,value str){
288   CAMLparam2(tree,str);
289   CAMLlocal1(resarray);
290   uchar * cstr = (uchar *) strdup(String_val(str));  
291   std::vector<DocID> results = XMLTREE(tree)->Equals(cstr);
292   free(cstr);
293   CAMLreturn (sort_alloc_array(results,resarray));  
294 }
295
296 extern "C"  value caml_text_collection_contains(value tree,value str){
297   CAMLparam2(tree,str);
298   CAMLlocal1(resarray);
299   uchar * cstr = (uchar *) String_val(str);  
300   std::vector<DocID> results = XMLTREE(tree)->Contains(cstr);
301   CAMLreturn (sort_alloc_array(results,resarray));  
302 }
303
304 extern "C"  value caml_text_collection_lessthan(value tree,value str){
305   CAMLparam2(tree,str);
306   CAMLlocal1(resarray);
307   uchar * cstr = (uchar *) String_val(str);  
308   std::vector<DocID> results = XMLTREE(tree)->LessThan(cstr);
309   CAMLreturn (sort_alloc_array(results,resarray));  
310 }
311
312 /** Full reporting into a bit vector
313  */
314
315 extern "C"  value caml_text_collection_prefix_bv(value tree,value str){
316   CAMLparam2(tree,str);
317   uchar * cstr = (uchar *) strdup(String_val(str));
318   std::vector<DocID> results = XMLTREE(tree)->Prefix(cstr);
319   std::vector<bool> *bv = new std::vector<bool>(XMLTREE(tree)->Size(),false);
320   for (unsigned int i=0; i < results.size(); i++)
321     bv->at(XMLTREE(tree)->ParentNode(results[i]))=true;
322   free(cstr);
323   CAMLreturn ((value) bv);
324 }
325
326 extern "C"  value caml_text_collection_suffix_bv(value tree,value str){
327   CAMLparam2(tree,str);
328   uchar * cstr = (uchar *) strdup(String_val(str));
329   std::vector<DocID> results = XMLTREE(tree)->Suffix(cstr);
330   std::vector<bool> *bv = new std::vector<bool>(XMLTREE(tree)->Size(),false);
331   for (unsigned int i=0; i < results.size(); i++)
332     bv->at(XMLTREE(tree)->ParentNode(results[i]))=true;
333   free(cstr);
334   CAMLreturn ((value) bv);
335 }
336
337 extern "C"  value caml_text_collection_equals_bv(value tree,value str){
338   CAMLparam2(tree,str);
339   uchar * cstr = (uchar *) strdup(String_val(str));
340   XMLTree* xt = XMLTREE(tree);
341   std::vector<DocID> results = xt->Equals(cstr);
342   std::vector<bool> *bv = new std::vector<bool>(xt->Size(),false);
343   for (unsigned int i=0; i < results.size(); i++)
344     bv->at(xt->Parent(xt->ParentNode(results[i])))=true;
345   free(cstr);
346   CAMLreturn ((value) bv);
347 }
348
349
350 extern "C"  value caml_text_collection_contains_bv(value tree,value str){
351   CAMLparam2(tree,str);
352   uchar * cstr = (uchar *) strdup(String_val(str));
353   XMLTree* xt = XMLTREE(tree);
354   std::vector<DocID> results = xt->Contains(cstr);
355   std::vector<bool> *bv = new std::vector<bool>(xt->Size(),false);
356   for (unsigned int i=0; i < results.size(); i++){
357     bv->at(xt->Parent(xt->ParentNode(results[i])))=true;
358   }
359   free(cstr);
360   CAMLreturn ((value) bv);
361 }
362
363 extern "C" value caml_text_collection_contains_bv_update(value tree,value str,value vbv){
364   CAMLparam3(tree,str,vbv);
365   uchar * cstr = (uchar *) strdup(String_val(str));
366   XMLTree* xt = XMLTREE(tree);
367   std::vector<DocID> results = xt->Contains(cstr);
368   std::vector<bool> *bv = (std::vector<bool> *) vbv;
369   for (unsigned int i=0; i < results.size(); i++){
370     /** Hack for the Techfest demo */
371     (*bv)[xt->Parent(xt->Parent(xt->ParentNode(results[i])))]=true;   
372   }
373   free(cstr);
374   CAMLreturn ((value) bv);
375 }
376 extern "C" value caml_text_collection_contains_bv_update_list(value tree,value str,value acc,value vbv,value count){
377   CAMLparam4(tree,str,acc,vbv);
378   CAMLlocal1(head);
379   uchar * cstr = (uchar *) strdup(String_val(str));
380   XMLTree* xt = XMLTREE(tree);
381   std::vector<DocID> results = xt->Contains(cstr);
382   std::vector<bool> *bv = (std::vector<bool> *) vbv;
383   treeNode idx;
384   int acc_count = Int_val(count);
385   for (unsigned int i=0; i < results.size(); i++){
386     idx = xt->Parent(xt->Parent(xt->ParentNode(results[i])));
387     if (!(*bv)[idx]) {
388         (*bv)[idx]=true;
389         head = caml_alloc_tuple(2);
390         caml_initialize(&Field(head,0),Val_int(idx));
391         caml_initialize(&Field(head,1),acc);
392         acc=head;
393         acc_count++;
394     };
395   };
396   free(cstr);
397   head = caml_alloc_tuple(3);
398   caml_initialize(&Field(head,0),acc);
399   caml_initialize(&Field(head,1),(value) bv);
400   caml_initialize(&Field(head,2),Val_int(acc_count));
401   CAMLreturn (head);
402 }
403
404 extern "C"  value caml_text_collection_lessthan_bv(value tree,value str){
405   CAMLparam2(tree,str);
406   uchar * cstr = (uchar *) strdup(String_val(str));
407   std::vector<DocID> results = XMLTREE(tree)->LessThan(cstr);
408   std::vector<bool> *bv = new std::vector<bool>(XMLTREE(tree)->Size(),false);
409   for (unsigned int i=0; i < results.size(); i++)
410     bv->at(XMLTREE(tree)->ParentNode(results[i]))=true;
411   free(cstr);
412   CAMLreturn ((value) bv);
413 }
414
415 /*************************************************************************/
416
417 /**
418  *  XMLTree bindings
419  *  All of the functions here call the _unsafe version and implement the logics themselves
420  *  (test for NULLT and so on). This avoids one indirection + one call when the tests fails.
421  */
422
423
424 NoAlloc extern "C"  value caml_xml_tree_root(value tree){
425   return (Val_int(XMLTREE_ROOT));
426 }
427
428 NoAlloc extern "C"  value caml_xml_tree_size(value tree){
429   return (Val_int(XMLTREE(tree)->Size()));
430 }
431
432 NoAlloc extern "C"  value caml_xml_tree_subtree_size(value tree, value node){
433   return (Val_int(XMLTREE(tree)->SubtreeSize(TREENODEVAL(node))));
434 }
435
436 NoAlloc extern "C"  value caml_xml_tree_subtree_tags(value tree, value node, value tag){
437   return (Val_int(XMLTREE(tree)->SubtreeTags(TREENODEVAL(node), TAGVAL(tag))));
438 }
439
440 NoAlloc extern "C"  value caml_xml_tree_subtree_elements(value tree, value node){
441   return (Val_int(XMLTREE(tree)->SubtreeElements(TREENODEVAL(node))));
442 }
443
444 NoAlloc extern "C"  value caml_xml_tree_is_leaf(value tree, value node){
445   return (Val_bool(XMLTREE(tree)->IsLeaf(TREENODEVAL(node))));
446 }
447
448 NoAlloc extern "C"  value caml_xml_tree_is_ancestor(value tree, value node1,value node2){
449   return (Val_bool(XMLTREE(tree)->IsAncestor(TREENODEVAL(node1),TREENODEVAL(node2))));
450 }
451
452 NoAlloc extern "C"  value caml_xml_tree_is_child(value tree, value node1,value node2){
453   return (Val_bool(XMLTREE(tree)->IsChild(TREENODEVAL(node1),TREENODEVAL(node2))));
454 }
455
456 NoAlloc extern "C"  value caml_xml_tree_is_first_child(value tree, value node){
457   return (Val_bool(XMLTREE(tree)->IsFirstChild(TREENODEVAL(node))));
458 }
459
460 NoAlloc extern "C"  value caml_xml_tree_num_children(value tree, value node){
461   return (Val_int(XMLTREE(tree)->NumChildren(TREENODEVAL(node))));
462 }
463
464 NoAlloc extern "C"  value caml_xml_tree_child_number(value tree, value node){
465   return (Val_int(XMLTREE(tree)->ChildNumber(TREENODEVAL(node))));
466 }
467
468 NoAlloc extern "C"  value caml_xml_tree_depth(value tree, value node){
469   return (Val_int(XMLTREE(tree)->Depth(TREENODEVAL(node))));
470 }
471
472 NoAlloc extern "C"  value caml_xml_tree_preorder(value tree, value node){
473   return (Val_int(XMLTREE(tree)->Preorder(TREENODEVAL(node))));
474 }
475
476 NoAlloc extern "C"  value caml_xml_tree_postorder(value tree, value node){
477   return (Val_int(XMLTREE(tree)->Postorder(TREENODEVAL(node))));
478 }
479
480 NoAlloc extern "C"  value caml_xml_tree_tag(value tree, value node){
481   return (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(node))));
482 }
483
484 extern "C"  value caml_xml_tree_doc_ids(value tree, value node){
485   CAMLparam2(tree,node);
486   CAMLlocal1(tuple);
487   range ids;
488   tuple = caml_alloc(2,0);
489   ids = XMLTREE(tree)->DocIds(Int_val(node));
490   Store_field(tuple,0,Val_int(ids.min));
491   Store_field(tuple,1,Val_int(ids.max));
492   CAMLreturn (tuple);
493 }
494
495 NoAlloc extern "C"  value caml_xml_tree_parent(value tree, value node){
496   return (Val_int(XMLTREE(tree)->Parent(TREENODEVAL(node))));
497 }
498
499 NoAlloc extern "C"  value caml_xml_tree_child(value tree, value node,value idx){
500   return (Val_int(XMLTREE(tree)->Child(TREENODEVAL(node),Int_val(idx))));
501 }
502
503 NoAlloc extern "C"  value caml_xml_tree_first_child(value tree, value node){
504   return (Val_int(XMLTREE(tree)->FirstChild(TREENODEVAL(node))));
505 }
506
507 NoAlloc extern "C"  value caml_xml_tree_first_element(value tree, value node){
508   return (Val_int(XMLTREE(tree)->FirstElement(TREENODEVAL(node))));
509 }
510
511 NoAlloc extern "C"  value caml_xml_tree_last_child(value tree, value node){
512   return (Val_int(XMLTREE(tree)->LastChild(TREENODEVAL(node))));
513 }
514
515 NoAlloc extern "C"  value caml_xml_tree_next_sibling(value tree, value node){
516   return (Val_int(XMLTREE(tree)->NextSibling(TREENODEVAL(node))));
517 }
518
519 NoAlloc extern "C"  value caml_xml_tree_next_element(value tree, value node){
520   return (Val_int(XMLTREE(tree)->NextElement(TREENODEVAL(node))));
521 }
522
523 NoAlloc extern "C"  value caml_xml_tree_prev_sibling(value tree, value node){
524   return (Val_int(XMLTREE(tree)->PrevSibling(TREENODEVAL(node))));
525 }
526
527 NoAlloc extern "C"  value caml_xml_tree_tagged_child(value tree, value node,value tag){
528   return (Val_int(XMLTREE(tree)->TaggedChild(TREENODEVAL(node),TAGVAL(tag))));
529 }
530
531 NoAlloc extern "C"  value caml_xml_tree_select_child(value tree, value node,value tags){
532   return (Val_int(XMLTREE(tree)->SelectChild(TREENODEVAL(node), HSET(tags))));
533 }
534
535 NoAlloc extern "C"  value caml_xml_tree_tagged_following_sibling(value tree, value node,value tag){
536   return (Val_int(XMLTREE(tree)->TaggedFollowingSibling(TREENODEVAL(node),TAGVAL(tag))));
537 }
538
539 NoAlloc extern "C"  value caml_xml_tree_select_following_sibling(value tree, value node,value tags){
540   return (Val_int(XMLTREE(tree)->SelectFollowingSibling(TREENODEVAL(node), HSET(tags))));
541 }
542
543 NoAlloc extern "C"  value caml_xml_tree_tagged_descendant(value tree, value node, value tag){
544   return (Val_int(XMLTREE(tree)->TaggedDescendant(TREENODEVAL(node), TAGVAL(tag))));
545 }
546
547 NoAlloc extern "C"  value caml_xml_tree_select_descendant(value tree, value node, value tags){
548   return (Val_int(XMLTREE(tree)->SelectDescendant(TREENODEVAL(node), HSET(tags))));
549 }
550
551 NoAlloc extern "C"  value caml_xml_tree_tagged_preceding(value tree, value node, value tag){
552   return (Val_int(XMLTREE(tree)->TaggedPreceding(TREENODEVAL(node), TAGVAL(tag))));
553 }
554
555 NoAlloc extern "C"  value caml_xml_tree_tagged_following(value tree, value node, value tag){
556   return (Val_int(XMLTREE(tree)->TaggedFollowing(TREENODEVAL(node), TAGVAL(tag))));
557 }
558
559 NoAlloc extern "C"  value caml_xml_tree_tagged_following_below(value tree, value node, value tag, value ancestor){
560   return (Val_int(XMLTREE(tree)->TaggedFollowingBelow(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(ancestor))));
561 }
562
563 NoAlloc extern "C"  value caml_xml_tree_select_following_below(value tree, value node, value tags, value ancestor){
564   return (Val_int(XMLTREE(tree)->SelectFollowingBelow(TREENODEVAL(node), HSET(tags), TREENODEVAL(ancestor))));
565 }
566
567 NoAlloc extern "C"  value caml_xml_tree_tagged_following_before(value tree, value node, value tag, value closing){
568   return (Val_int(XMLTREE(tree)->TaggedFollowingBefore(TREENODEVAL(node), TAGVAL(tag), TREENODEVAL(closing))));
569 }
570
571 NoAlloc extern "C"  value caml_xml_tree_select_following_before(value tree, value node, value tags, value closing){
572   return (Val_int(XMLTREE(tree)->SelectFollowingBefore(TREENODEVAL(node), HSET(tags), TREENODEVAL(closing))));
573 }
574
575 NoAlloc extern "C"  value caml_xml_tree_tagged_ancestor(value tree, value node, value tag){
576   return (Val_int(XMLTREE(tree)->TaggedAncestor(TREENODEVAL(node), TAGVAL(tag))));
577 }
578
579 NoAlloc extern "C"  value caml_xml_tree_my_text(value tree, value node){
580   return (Val_int(XMLTREE(tree)->MyText(TREENODEVAL(node))));
581 }
582
583 NoAlloc extern "C"  value caml_xml_tree_my_text_unsafe(value tree, value node){
584   return (Val_int(XMLTREE(tree)->MyTextUnsafe(TREENODEVAL(node))));
585 }
586
587 NoAlloc extern "C"  value caml_xml_tree_text_xml_id(value tree, value docid){
588   return (Val_int(XMLTREE(tree)->TextXMLId(Int_val(docid))));
589 }
590
591 NoAlloc extern "C"  value caml_xml_tree_node_xml_id(value tree, value node){
592   return (Val_int(XMLTREE(tree)->NodeXMLId(TREENODEVAL(node))));
593 }
594
595 NoAlloc extern "C"  value caml_xml_tree_parent_node(value tree, value docid){
596   return (Val_int(XMLTREE(tree)->ParentNode(Int_val(docid))));
597 }
598 /*
599 NoAlloc extern "C"  value caml_xml_tree_prev_node(value tree, value docid){
600   return (Val_int(XMLTREE(tree)->PrevNode(Int_val(docid))));
601 }
602 */
603 extern "C"  value caml_xml_tree_get_tag_id(value tree, value tagname){
604   CAMLparam2(tree,tagname);
605   CAMLlocal1(res);
606   unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
607   res = Val_int(XMLTREE(tree)->GetTagId(ctagname));
608   free(ctagname);
609   CAMLreturn(res);
610 }
611
612 extern "C"  value caml_xml_tree_get_tag_name(value tree, value tag){
613   CAMLparam2(tree,tag);
614   CAMLlocal1(res);
615   res = caml_copy_string((const char*) XMLTREE(tree)->GetTagNameByRef(TAGVAL(tag)));
616   CAMLreturn(res);
617 }
618
619 extern "C"  value caml_xml_tree_register_tag(value tree, value tagname){
620   CAMLparam2(tree,tagname);
621   CAMLlocal1(res);
622   unsigned char* ctagname = (unsigned char*) strdup(String_val(tagname));
623   res = Val_int(XMLTREE(tree)->RegisterTag(ctagname));
624   free(ctagname);
625   CAMLreturn(res);
626 }
627
628
629 NoAlloc extern "C"  value caml_xml_tree_get_text_collection(value tree){
630   return((value) XMLTREE(tree)->getTextCollection());
631 }
632
633 NoAlloc extern "C"  value caml_xml_tree_closing(value tree, value node){
634   return (Val_int(XMLTREE(tree)->Closing(TREENODEVAL(node))));
635 }
636
637 NoAlloc extern "C"  value caml_xml_tree_is_open(value tree, value node){
638   return (Val_bool(XMLTREE(tree)->IsOpen(TREENODEVAL(node))));
639 }
640
641
642
643 NoAlloc extern "C"  value caml_xml_tree_nullt(value unit){
644   return (NULLT);
645 }
646
647 NoAlloc extern "C"  value caml_unordered_set_length(value hset){
648   return (Val_int((HSET(hset))->size()));
649 }
650
651 extern "C"  value caml_unordered_set_alloc(value unit){
652   CAMLparam1(unit);
653   CAMLlocal1(hset);
654   hset = caml_alloc_custom(&set_ops,sizeof(TagIdSet*),1,2);
655   TagIdSet* ht = new TagIdSet();
656   memcpy(Data_custom_val(hset),&ht,sizeof(TagIdSet*));
657   CAMLreturn (hset);
658 }
659
660 NoAlloc extern "C"  value caml_unordered_set_set(value set, value v){  
661   HSET(set)->insert((int) Int_val(v));
662   return (Val_unit);
663 }
664
665 NoAlloc extern "C" value caml_result_set_create(value size){  
666   results* res = (results*) malloc(sizeof(results));
667   results r = createResults (Int_val(size));  
668   res->n = r.n;
669   res->lgn = r.lgn;
670   res->tree = r.tree;
671   return ((value) (res));
672 }
673
674 NoAlloc extern "C"  value caml_result_set_set(value result,value p){
675   setResult (  *((results*) result), Int_val(p));
676   return (Val_unit);
677 }
678
679 NoAlloc extern "C"  value caml_result_set_clear(value result,value p1,value p2){
680   clearRange ( *((results*) result), Int_val(p1), Int_val(p2));
681   return (Val_unit);
682 }
683
684 NoAlloc extern "C"  value caml_result_set_next(value result,value p){
685   results r;
686   r = *( (results *) result);
687   return (Val_int(nextResult(r, Int_val(p))));
688 }
689
690 NoAlloc extern "C" value caml_result_set_count(value result){
691   results r;
692   r = *( (results *) result);
693   return (Val_int(countResult(r)));
694 }
695
696 NoAlloc extern "C"  value caml_xml_tree_print(value tree,value node,value fd){
697   CAMLparam3(tree,node,fd);
698   XMLTREE(tree)->Print(Int_val(fd),TREENODEVAL(node));
699   CAMLreturn(Val_unit);
700 }
701
702 NoAlloc extern "C" value caml_set_tag_bits(value result, value tag, value tree, value node)
703 {
704   results r;
705   XMLTree *t = XMLTREE(Field(tree,0));
706   treeNode opening = TREENODEVAL(node);
707   treeNode closing = t->Closing(opening);
708   TagType target_tag = Int_val(tag);
709   treeNode first = t->TaggedDescendant(opening,target_tag);
710   r = *( (results *) result);
711   opening = first;
712   while (opening != NULLT){
713     setResult(r,opening);
714     opening = t->TaggedFollowingBefore(opening,target_tag,closing);
715   };
716   return(Val_int(first));
717 }
718     
719
720 NoAlloc extern "C" value caml_bit_vector_create(value size){
721   return (value) (new vector<bool>(Int_val(size),false));     
722 }
723
724 NoAlloc extern "C" value caml_bit_vector_free(value vect){
725   delete ((vector<bool>*) vect);
726   return Val_unit;
727 }
728
729 NoAlloc extern "C" value caml_bit_vector_get(value vect,value idx){
730   return Val_bool (((vector<bool>*)vect)->at(Int_val(idx)));
731 }
732
733 NoAlloc extern "C" value caml_bit_vector_set(value vect,value idx,value b){
734   (((vector<bool>*)vect)->at(Int_val(idx))) = (bool) Bool_val(b);
735   return Val_unit;
736 }
737
738 NoAlloc extern "C" value caml_bit_vector_next(value vect,value idx){
739   vector<bool>* bv = (vector<bool>*) vect;
740   int i = Int_val(idx);
741   int l = bv->size();
742   while (i < l && !((*bv)[i]))
743     i++;
744   return Val_int(i);
745 }
746 NoAlloc extern "C" value caml_bit_vector_prev(value vect,value idx){
747   int i = Int_val(idx);
748   while (i >= 0 && !((*((vector<bool>*) vect))[i]))
749     i--;
750   return Val_int(i);
751 }
752
753 extern "C" value caml_bit_vector_node_array(value vect){
754   CAMLparam0();
755   CAMLlocal1(res);
756   vector<bool>* bv = (vector<bool>*) vect;
757   vector<treeNode> vr;
758   int l = bv->size();
759   int i = 0;
760   while (i < l){
761     if ((*bv)[i]) vr.push_back(i);
762     i++;
763   };
764   l = vr.size();
765   res = caml_alloc_tuple(l);
766   for(i=0;i<l;i++)
767     caml_initialize(&Field(res,i),Val_int(vr[i]));
768   CAMLreturn (res);
769 }
770
771
772 int iterjump(XMLTree* tree, treeNode node, TagType tag, treeNode anc){
773   if (node == NULLT)
774     return 0;
775   else {
776     return /*1+iterjump(tree,tree->TaggedDescendant(node,tag),tag,node)
777              +*/ iterjump(tree,tree->TaggedFollowingBelow(node,tag,anc),tag,anc);
778   };
779 }
780
781 extern "C" value caml_benchmark_jump(value tree,value tag){
782   int count;
783   treeNode root = XMLTREE(tree)->FirstChild(0);
784   root = XMLTREE(tree)->FirstChild(root);
785   count = iterjump(XMLTREE(tree), root , Int_val(tag),0);
786   return Val_unit;
787 }
788
789 int iterfcns(XMLTree* tree, treeNode node){
790   if (node == NULLT)
791     return 0;
792   else {
793     return /*1+ iterfcns(tree,tree->FirstChild(node)) +*/
794      iterfcns(tree,tree->NextSibling(node));    
795   };
796 }
797 /*
798 extern "C" value caml_benchmark_fcns(value tree){
799   int i = iterfcns(XMLTREE(tree),0);
800   return Val_unit;
801
802 }
803 */
804 extern "C" value caml_benchmark_fcns(value tree){
805    treeNode root = XMLTREE(tree)->FirstChild(0);
806   root = XMLTREE(tree)->FirstChild(root);
807   iterfcns(XMLTREE(tree),root);
808   return Val_unit;
809
810 }
811 int iterlcps(XMLTree* tree, treeNode node){
812   if (node == NULLT)
813     return 0;
814   else {
815     int x = tree->Tag(node);
816     x += iterlcps(tree,tree->LastChild(node));
817     x += iterlcps(tree,tree->PrevSibling(node));
818     return x;
819   };
820 }
821
822 extern "C" value caml_benchmark_lcps(value tree){  
823   iterlcps(XMLTREE(tree),0);
824   return Val_unit;
825
826 }
827
828 extern "C" {
829
830   typedef struct dummy_node_ {
831     struct dummy_node_* first;
832     struct dummy_node_* next;
833   } dummy_node;
834   
835   
836   dummy_node * new_dummy_node () {
837     
838     dummy_node * node = (dummy_node*) malloc(sizeof(dummy_node));
839     if (!node)
840       printf("%s","Cannot allocate memory\n");
841     
842     return node;
843   }
844
845   void free_tree(dummy_node * node){
846     if (node){
847       free_tree(node->first);
848       free_tree(node->next);
849       free(node);
850     };
851     return;
852   }
853
854   dummy_node * create_tree(XMLTree* tree, treeNode i){
855     if (i == NULLT)
856        return NULL;
857     else {
858       dummy_node * f, *n, *r;
859       f = create_tree(tree,tree->FirstChild(i));
860       n = create_tree(tree,tree->NextSibling(i));
861       r = new_dummy_node();
862       r->first = f;
863       r->next = n;
864       return r;
865     };
866   }
867       
868   int iter_tree(dummy_node * n){
869     if (n == NULL)
870       return 0;
871     else {
872       return (1+ iter_tree(n->first) + iter_tree(n->next));
873     };
874   }
875
876 }
877 extern "C" value caml_build_pointers(value tree){
878   return ((value) create_tree(XMLTREE(Field(tree,0)),0));
879 }
880
881 extern "C" value caml_iter_pointers (value node){
882   return Val_int(iter_tree((dummy_node*) node));
883
884 }
885
886 extern "C" value caml_free_pointers(value node){
887   free_tree((dummy_node*) node);
888   return Val_unit;
889 }