Fix stupid bug with Tag indices
[SXSI/xpathcomp.git] / OCamlDriver.cpp
1 /**************************************
2  * OCamlDriver.cpp
3  * -------------------
4  * A Test 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 /* OCaml memory managment */
12 extern "C" {
13 #include <caml/mlvalues.h>
14 #include <caml/alloc.h>
15 #include <caml/memory.h>
16 #include <caml/callback.h>
17 #include <caml/fail.h>
18 } //extern C
19
20 //#include "TextCollection/TextCollection.h"
21 #include "XMLDocShredder.h"
22 #include "XMLTree.h"
23 #include "Utils.h"
24
25 #define CAMLRAISECPP(e) (caml_failwith( ((e).what())))
26 #define NOT_IMPLEMENTED(s)  (caml_failwith(s))
27 #define XMLTREE(x) ((XMLTree *)(x))
28 #define TEXTCOLLECTION(x)
29 #define TREENODEVAL(i) ((treeNode) (Int_val(i)))
30
31 extern "C" CAMLprim value caml_call_shredder_uri(value uri){
32   CAMLparam1(uri);
33   CAMLlocal1(doc);
34   char *fn = String_val(uri);
35   try {
36   XMLDocShredder shredder(fn);  
37   shredder.processStartDocument(fn);  
38   shredder.parse();  
39   shredder.processEndDocument();
40   doc = (value) shredder.storageIfc_->returnDocument();
41
42   CAMLreturn(doc);
43   }
44   catch (const std::exception& e){
45     CAMLRAISECPP(e);
46   };
47   
48 }
49
50 extern "C" CAMLprim value caml_call_shredder_string(value data){
51   CAMLparam1(data);
52   CAMLlocal1(doc);
53   unsigned int ln = string_length(data);
54   unsigned char *fn = (unsigned char*) String_val(data);
55   
56   try {
57     XMLDocShredder shredder(fn,ln);  
58     shredder.processStartDocument("");  
59     shredder.parse();  
60     shredder.processEndDocument();
61     doc = (value) shredder.storageIfc_->returnDocument();
62     
63     CAMLreturn(doc);
64   }
65   catch (const std::exception& e) {
66     CAMLRAISECPP(e);
67   };
68 }
69
70 void traversal_rec(XMLTree* tree, treeNode id){
71  DocID tid; 
72   if (id == NULLT)
73     return;
74   //  int tag = tree->Tag(id);
75    if (id) {
76         tid = tree->PrevText(id);
77         char * data = (char *) (tree->getTextCollection())->GetText(tid);
78         if (tree->IsLeaf(id)){
79           tid = tree->MyText(id);
80
81           data = (char*) (tree->getTextCollection())->GetText(tid);
82         };
83   
84         if (tree->NextSibling(id) == NULLT){
85           tid = tree->NextText(id);
86           data = (char*) (tree->getTextCollection())->GetText(tid);
87         }; 
88    };
89    traversal_rec(tree,tree->FirstChild(id));
90    traversal_rec(tree,tree->NextSibling(id));
91    return;
92 }
93
94 extern "C" CAMLprim value caml_cpp_traversal(value tree){
95   CAMLparam1(tree);
96   traversal_rec(XMLTREE(tree),XMLTREE(tree)->Root());
97   CAMLreturn(Val_unit);
98 }
99
100 extern "C" CAMLprim value caml_text_collection_get_text(value tree, value id){
101   CAMLparam2(tree,id);  
102   const char* txt = (const char*) (XMLTREE(tree)->GetText((DocID) Int_val(id))); 
103   CAMLreturn (caml_copy_string(txt));
104 }
105 extern "C" CAMLprim value caml_text_collection_empty_text(value tree,value id){
106   CAMLparam2(tree,id);
107   CAMLreturn ( Val_int((XMLTREE(tree))->EmptyText((DocID) Int_val(id))));
108 }
109
110 extern "C" CAMLprim value caml_text_collection_is_contains(value tree,value str){
111   CAMLparam2(tree,str);
112   uchar * cstr = (uchar *) String_val(str);  
113   CAMLreturn ( Val_bool((int) XMLTREE(tree)->IsContains(cstr)));
114 }
115
116 extern "C" CAMLprim value caml_text_collection_count_contains(value tree,value str){
117   CAMLparam2(tree,str);
118   uchar * cstr = (uchar *) String_val(str);  
119   CAMLreturn (Val_int((XMLTREE(tree)->CountContains(cstr))));
120   
121 }
122
123 extern "C" CAMLprim value caml_text_collection_contains(value tree,value str){
124   CAMLparam2(tree,str);
125   CAMLlocal1(resarray);
126   uchar * cstr = (uchar *) String_val(str);  
127   std::vector<DocID> results;
128   results = XMLTREE(tree)->Contains(cstr);
129
130   resarray = caml_alloc_tuple(results.size());
131
132   for (unsigned int i=0; i<results.size();i++){
133     caml_initialize(&Field(resarray,i),Val_int(results[i]));
134   };
135   CAMLreturn (resarray);  
136 }
137
138
139 extern "C" CAMLprim value caml_xml_tree_root(value tree){
140   CAMLparam1(tree);
141   CAMLreturn (TREENODEVAL(XMLTREE(tree)->Root()));
142 }
143 extern "C" CAMLprim value caml_xml_tree_text_collection(value tree){
144   CAMLparam1(tree);
145   CAMLreturn((value) XMLTREE(tree)->getTextCollection());
146 }
147 extern "C" CAMLprim value caml_xml_tree_parent(value tree, value id){
148   CAMLparam2(tree,id);
149   CAMLreturn(Val_int (XMLTREE(tree)->Parent(TREENODEVAL(id))));
150 }
151 extern "C" CAMLprim value caml_xml_tree_parent_doc(value tree, value id){
152   CAMLparam2(tree,id);
153   CAMLreturn(Val_int (XMLTREE(tree)->ParentNode(TREENODEVAL(id))));
154 }
155
156 extern "C" CAMLprim value caml_xml_tree_is_ancestor(value tree,value id1, value id2) {
157   CAMLparam3(tree,id1,id2);
158   CAMLreturn(Val_bool (XMLTREE(tree)->IsAncestor(TREENODEVAL(id1),TREENODEVAL(id2))));
159 }
160
161 extern "C" CAMLprim value caml_xml_tree_serialize(value tree, value filename){
162   CAMLparam2(tree,filename);
163   NOT_IMPLEMENTED("caml_xml_tree_serialize");
164   CAMLreturn(Val_unit);
165 }
166
167 extern "C" CAMLprim value caml_xml_tree_unserialize(value filename){
168   CAMLparam1(filename);
169   NOT_IMPLEMENTED("caml_xml_tree_unserialize");
170   CAMLreturn(Val_unit);
171 }
172
173
174 extern "C" CAMLprim value caml_xml_tree_first_child(value tree, value id){
175   CAMLparam2(tree,id);
176   CAMLreturn(Val_int (XMLTREE(tree)->FirstChild(TREENODEVAL(id))));
177 }
178
179 extern "C" CAMLprim value caml_xml_tree_is_leaf(value tree, value id){
180   CAMLparam2(tree,id);
181   CAMLreturn(Val_bool (XMLTREE(tree)->IsLeaf(TREENODEVAL(id))));
182 }
183
184 extern "C" CAMLprim value caml_xml_tree_next_sibling(value tree, value id){
185   CAMLparam2(tree,id);
186   CAMLreturn(Val_int (XMLTREE(tree)->NextSibling(TREENODEVAL(id))));
187 }
188
189 extern "C" CAMLprim value caml_xml_tree_prev_text(value tree, value id){
190   CAMLparam2(tree,id);
191   CAMLlocal1(res);
192   CAMLreturn(Val_int((XMLTREE(tree)->PrevText(TREENODEVAL(id)))));
193   CAMLreturn(res);
194 }
195 extern "C" CAMLprim value caml_xml_tree_next_text(value tree, value id){
196   CAMLparam2(tree,id);
197   CAMLreturn(Val_int((XMLTREE(tree)->NextText(TREENODEVAL(id)))));
198 }
199 extern "C" CAMLprim value caml_xml_tree_my_text(value tree, value id){
200   CAMLparam2(tree,id);
201   CAMLreturn(Val_int((XMLTREE(tree)->MyText(TREENODEVAL(id)))));
202 }
203
204 extern "C" CAMLprim value caml_xml_tree_text_xml_id(value tree, value id){
205   CAMLparam2(tree,id);
206   CAMLreturn(Val_int((XMLTREE(tree)->TextXMLId(TREENODEVAL(id)))));
207 }
208 extern "C" CAMLprim value caml_xml_tree_node_xml_id(value tree, value id){
209   CAMLparam2(tree,id);
210   CAMLreturn(Val_int((XMLTREE(tree)->NodeXMLId(TREENODEVAL(id)))));
211 }
212 extern "C" CAMLprim value caml_xml_tree_tag(value tree, value id){
213   CAMLparam2(tree,id);
214   const char* tag;
215   tag =(const char*) XMLTREE(tree)->GetTagName(XMLTREE(tree)->Tag(TREENODEVAL(id)));
216
217   CAMLreturn (caml_copy_string(tag));
218 }
219 extern "C" CAMLprim value caml_xml_tree_tag_name(value tree, value tagid){
220   CAMLparam2(tree,tagid);
221   const char* tag;
222   tag = (const char*) XMLTREE(tree)->GetTagName((TagType) (Int_val(tagid)));
223
224   CAMLreturn (caml_copy_string(tag));
225 }
226
227
228 extern "C" CAMLprim value caml_xml_tree_tag_id(value tree,value id){
229   CAMLparam2(tree,id);  
230   CAMLreturn (Val_int(XMLTREE(tree)->Tag(TREENODEVAL(id))));
231 }
232
233 extern "C" CAMLprim value caml_xml_tree_register_tag(value tree,value str){
234   CAMLparam2(tree,str);
235   CAMLlocal1(id);
236   unsigned char* tag;
237   tag = (unsigned char*) (String_val(str));
238   id = Val_int(XMLTREE(tree)->RegisterTag(tag));
239   CAMLreturn (id);
240 }
241
242 extern "C" CAMLprim value caml_xml_tree_nullt(value unit){
243   CAMLparam1(unit);
244   CAMLreturn (NULLT);
245 }