src/xml-tree_stub.cpp

   1 #include "xml-tree.hpp"
   2 #include "utils_stub.hpp"
   3 #include <cstdio>
   4
   5 using namespace SXSI;
   6
   7 static xml_tree*& XMLTREE(value v)
   8 {
   9   return Obj_val<xml_tree*>(v);
  10 }
  11
  12 static xml_tree::node_t TREENODE(value i)
  13 {
  14   return static_cast<xml_tree::node_t>(Int_val(i));
  15 }
  16
  17 static xml_tree::tag_t TAG(value i)
  18 {
  19   return static_cast<xml_tree::tag_t>(Int_val(i));
  20 }
  21
  22 extern "C"  value caml_xml_tree_save(value tree, value fd, value prefix)
  23 {
  24   CAMLparam3(tree, fd, prefix);
  25   XMLTREE(tree)->save(Int_val(fd), String_val(prefix));
  26   CAMLreturn (Val_unit);
  27 }
  28
  29 extern "C" value
  30 caml_xml_tree_load(value fd, value prefix, value load_tc, value sf)
  31 {
  32   CAMLparam4(fd, prefix, load_tc, sf);
  33   CAMLlocal1(result);
  34   xml_tree * tree;
  35   try {
  36
  37     tree = xml_tree::load(Int_val(fd),
  38                           String_val(prefix),
  39                           Bool_val(load_tc),
  40                           Int_val(sf));
  41
  42     result = sxsi_alloc_custom<xml_tree*>();
  43     XMLTREE(result) = tree;
  44     CAMLreturn(result);
  45   }
  46   catch (const std::exception& e){ sxsi_raise_msg(e.what()); }
  47   catch (std::string msg){ sxsi_raise_msg(msg.c_str()); }
  48   catch (char const * msg){ sxsi_raise_msg(msg);  };
  49   //never reached
  50   return (Val_unit);
  51 }
  52
  53 NoAlloc extern "C"  value caml_xml_tree_root(value tree)
  54 {
  55   return (Val_int(XMLTREE(tree)->root()));
  56 }
  57
  58 NoAlloc extern "C"  value caml_xml_tree_size(value tree)
  59 {
  60   return (Val_int(XMLTREE(tree)->size()));
  61 }
  62
  63 NoAlloc extern "C"  value caml_xml_tree_num_tags(value tree)
  64 {
  65   return (Val_int(XMLTREE(tree)->num_tags()));
  66 }
  67
  68 NoAlloc extern "C"  value caml_xml_tree_subtree_size(value tree, value node)
  69 {
  70   return (Val_int(XMLTREE(tree)->subtree_size(TREENODE(node))));
  71 }
  72
  73 NoAlloc extern "C" value
  74 caml_xml_tree_subtree_tags(value tree, value node, value tag)
  75 {
  76   return (Val_int(XMLTREE(tree)->subtree_tags(TREENODE(node),
  77                                               TAG(tag))));
  78 }
  79
  80 NoAlloc extern "C" value caml_xml_tree_subtree_elements(value tree, value node,
  81                                                         value atts)
  82 {
  83   return (Val_int(XMLTREE(tree)->subtree_elements(TREENODE(node),
  84                                                   TAGLIST(atts))));
  85 }
  86
  87 NoAlloc extern "C" value caml_xml_tree_is_leaf(value tree, value node){
  88   return (Val_bool(XMLTREE(tree)->is_leaf(TREENODE(node))));
  89 }
  90
  91 NoAlloc extern "C" value
  92 caml_xml_tree_is_ancestor(value tree, value node1, value node2)
  93 {
  94   return (Val_bool(XMLTREE(tree)->is_ancestor(TREENODE(node1),
  95                                               TREENODE(node2))));
  96 }
  97
  98 NoAlloc extern "C" value
  99 caml_xml_tree_is_child(value tree, value node1, value node2)
 100 {
 101   return (Val_bool(XMLTREE(tree)->is_child(TREENODE(node1),
 102                                            TREENODE(node2))));
 103 }
 104
 105 NoAlloc extern "C" value caml_xml_tree_is_first_child(value tree, value node)
 106 {
 107   return (Val_bool(XMLTREE(tree)->is_first_child(TREENODE(node))));
 108 }
 109
 110 NoAlloc extern "C" value
 111 caml_xml_tree_is_right_descendant(value tree, value x, value y)
 112 {
 113   return (Val_bool(XMLTREE(tree)->is_right_descendant(TREENODE(x),
 114                                                       TREENODE(y))));
 115 }
 116
 117 NoAlloc extern "C"  value caml_xml_tree_num_children(value tree, value node)
 118 {
 119   return (Val_int(XMLTREE(tree)->num_children(TREENODE(node))));
 120 }
 121
 122 NoAlloc extern "C"  value caml_xml_tree_child_pos(value tree, value node)
 123 {
 124   return (Val_int(XMLTREE(tree)->child_pos(TREENODE(node))));
 125 }
 126
 127 NoAlloc extern "C"  value caml_xml_tree_depth(value tree, value node)
 128 {
 129   return (Val_int(XMLTREE(tree)->depth(TREENODE(node))));
 130 }
 131
 132 NoAlloc extern "C"  value caml_xml_tree_preorder(value tree, value node)
 133 {
 134   return (Val_int(XMLTREE(tree)->preorder(TREENODE(node))));
 135 }
 136
 137 NoAlloc extern "C"  value caml_xml_tree_postorder(value tree, value node)
 138 {
 139   return (Val_int(XMLTREE(tree)->postorder(TREENODE(node))));
 140 }
 141
 142 NoAlloc extern "C"  value caml_xml_tree_tag(value tree, value node)
 143 {
 144   return (Val_int(XMLTREE(tree)->tag(TREENODE(node))));
 145 }
 146
 147 NoAlloc extern "C"  value caml_xml_tree_parent(value tree, value node)
 148 {
 149   return (Val_int(XMLTREE(tree)->parent(TREENODE(node))));
 150 }
 151
 152 NoAlloc extern "C"  value caml_xml_tree_child(value tree, value node, value idx)
 153 {
 154   return (Val_int(XMLTREE(tree)->child(TREENODE(node), Int_val(idx))));
 155 }
 156
 157 NoAlloc extern "C"  value caml_xml_tree_first_child(value tree, value node)
 158 {
 159   return (Val_int(XMLTREE(tree)->first_child(TREENODE(node))));
 160 }
 161
 162 NoAlloc extern "C"  value caml_xml_tree_first_element(value tree, value node)
 163 {
 164   return (Val_int(XMLTREE(tree)->first_element(TREENODE(node))));
 165 }
 166
 167 NoAlloc extern "C"  value caml_xml_tree_last_child(value tree, value node)
 168 {
 169   return (Val_int(XMLTREE(tree)->last_child(TREENODE(node))));
 170 }
 171
 172 NoAlloc extern "C"  value caml_xml_tree_next_sibling(value tree, value node)
 173 {
 174   return (Val_int(XMLTREE(tree)->next_sibling(TREENODE(node))));
 175 }
 176
 177 NoAlloc extern "C" value caml_xml_tree_next_element(value tree, value node)
 178 {
 179   return (Val_int(XMLTREE(tree)->next_element(TREENODE(node))));
 180 }
 181
 182 NoAlloc extern "C" value caml_xml_tree_prev_sibling(value tree, value node)
 183 {
 184   return (Val_int(XMLTREE(tree)->prev_sibling(TREENODE(node))));
 185 }
 186
 187 NoAlloc extern "C" value
 188 caml_xml_tree_tagged_child(value tree, value node, value tag)
 189 {
 190   return (Val_int(XMLTREE(tree)->tagged_child(TREENODE(node),
 191                                               TAG(tag))));
 192 }
 193
 194 NoAlloc extern "C" value
 195 caml_xml_tree_select_child(value tree, value node, value tags)
 196 {
 197   return (Val_int(XMLTREE(tree)->select_child(TREENODE(node), TAGLIST(tags))));
 198 }
 199
 200 NoAlloc extern "C" value
 201 caml_xml_tree_tagged_sibling(value tree, value node, value tag)
 202 {
 203   return (Val_int(XMLTREE(tree)->tagged_sibling(TREENODE(node),
 204                                                 TAG(tag))));
 205 }
 206
 207 NoAlloc extern "C" value
 208 caml_xml_tree_select_sibling(value tree, value node, value tags)
 209 {
 210   return (Val_int(XMLTREE(tree)->select_sibling(TREENODE(node),
 211                                                 TAGLIST(tags))));
 212 }
 213
 214 NoAlloc extern "C" value
 215 caml_xml_tree_tagged_descendant(value tree, value node, value tag)
 216 {
 217   return (Val_int(XMLTREE(tree)->tagged_descendant(TREENODE(node),
 218                                                    TAG(tag))));
 219 }
 220
 221 NoAlloc extern "C" value
 222 caml_xml_tree_tagged_next(value tree, value node, value tag)
 223 {
 224   return (Val_int(XMLTREE(tree)->tagged_next(TREENODE(node),
 225                                              TAG(tag))));
 226 }
 227
 228 NoAlloc extern "C" value
 229 caml_xml_tree_select_descendant(value tree, value node, value tags)
 230 {
 231   return (Val_int(XMLTREE(tree)->select_descendant(TREENODE(node),
 232                                                    TAGLIST(tags))));
 233 }
 234
 235 NoAlloc extern "C" value caml_xml_tree_tagged_following_before(value tree,
 236                                                                value node,
 237                                                                value tag,
 238                                                                value closing)
 239 {
 240   return (Val_int(XMLTREE(tree)->tagged_following_before(TREENODE(node),
 241                                                          TAG(tag),
 242                                                          TREENODE(closing))));
 243 }
 244
 245 NoAlloc extern "C"  value caml_xml_tree_select_following_before(value tree,
 246                                                                 value node,
 247                                                                 value tags,
 248                                                                 value closing)
 249 {
 250   return (Val_int(XMLTREE(tree)->select_following_before(TREENODE(node),
 251                                                          TAGLIST(tags),
 252                                                          TREENODE(closing))));
 253 }
 254
 255
 256
 257 extern "C" value caml_xml_tree_get_text_collection(value tree)
 258 {
 259   CAMLparam1(tree);
 260   CAMLlocal1(text);
 261   text = sxsi_alloc_custom<TextCollection*>();
 262   Obj_val<TextCollection*>(text) = XMLTREE(tree)->get_text_collection();
 263   CAMLreturn (text);
 264 }
 265
 266 NoAlloc extern "C" value caml_xml_tree_closing(value tree, value node)
 267 {
 268   return (Val_int(XMLTREE(tree)->closing(TREENODE(node))));
 269 }
 270
 271 NoAlloc extern "C"  value caml_xml_tree_nullt(value unit){
 272   return (Val_int(xml_tree::NIL));
 273 }
 274
 275
 276 extern "C" value caml_xml_tree_print(value tree, value node, value fd)
 277 {
 278   CAMLparam3(tree, node, fd);
 279   XMLTREE(tree)->print(TREENODE(node), Int_val(fd));
 280   CAMLreturn(Val_unit);
 281 }
 282
 283
 284 extern "C" value caml_xml_tree_get_tag_name(value tree, value tag)
 285 {
 286   CAMLparam2(tree, tag);
 287   CAMLlocal1(res);
 288   const char* s = XMLTREE(tree)->get_tag_name_by_ref(TAG(tag));
 289   res = caml_copy_string(s);
 290   CAMLreturn(res);
 291 }
 292
 293 NoAlloc extern "C" value caml_xml_tree_flush(value tree, value fd)
 294 {
 295   XMLTREE(tree)->flush(Int_val(fd));
 296   return Val_unit;
 297 }
 298
 299 extern "C" value caml_xml_tree_register_tag(value tree, value str)
 300 {
 301   CAMLparam2(tree, str);
 302   value res;
 303   res = Val_int(XMLTREE(tree)->register_tag(String_val(str)));
 304   CAMLreturn(res);
 305 }
 306
 307
 308 /** Full reporting into a bit vector
 309  */
 310 static void pr_vector(std::vector<int32_t> v)
 311 {
 312   for(auto i = v.begin(); i!= v.end(); ++i)
 313     fprintf(stderr, "%i ", *i);
 314   fprintf(stderr, "\n");
 315 }
 316 static std::vector<int32_t> sort_results(std::vector<int32_t> v, xml_tree *t)
 317 {
 318   std::vector<int32_t> res;
 319   std::sort(v.begin(), v.end());
 320   int32_t prev = -1;
 321   for(auto i = v.begin(); i != v.end(); ++i){
 322     while (prev == *i){
 323       ++i;
 324       if (i == v.end()) return res;
 325     };
 326     prev = *i;
 327     res.push_back(t->parent_node(prev));
 328   };
 329   return res;
 330 }
 331
 332 #define BV_QUERY(pref, Pref) \
 333   extern "C" value caml_text_collection_## pref ##_bv(value tree, value str, value dobvv){ \
 334     CAMLparam3(tree, str, dobvv);                                       \
 335     CAMLlocal3(res, res_bv, res_array);                                 \
 336     int j;                                                              \
 337     uchar * cstr = (uchar *) strdup(String_val(str));                   \
 338     std::vector<int32_t> uresults = XMLTREE(tree)->Pref(cstr);          \
 339     std::vector<int32_t> results = sort_results(uresults, XMLTREE(tree)); \
 340     bool dobv = Bool_val(dobvv);                                        \
 341     res_bv = caml_alloc_string(dobv ? ((XMLTREE(tree)->size() / 4) + 2) : 0); \
 342     unsigned long slen = caml_string_length(res_bv);                    \
 343     if (dobv)                                                           \
 344       memset(&(Byte(res_bv,0)), 0, slen);                               \
 345     res_array = caml_alloc_shr(results.size(), 0);                      \
 346     for (unsigned int i = 0; i < results.size(); ++i) {                 \
 347       j = results[i];                                                   \
 348       if (dobv) {                                                       \
 349         Byte(res_bv, j >> 3) |=   (1 << (j & 7));                       \
 350       };                                                                \
 351       caml_initialize(&Field(res_array, i), Val_int(j));                \
 352     };                                                                  \
 353     fprintf(stderr, "Raw results: %lu, Sorted reulsts %lu\n", uresults.size(), results.size()); \
 354     free(cstr);                                                         \
 355     res = caml_alloc(2, 0);                                             \
 356     Store_field(res, 0, res_bv);                                        \
 357     Store_field(res, 1, res_array);                                     \
 358     CAMLreturn(res);                                                    \
 359   }                                                                     \
 360
 361
 362 BV_QUERY(prefix, prefix)
 363 BV_QUERY(suffix, suffix)
 364 BV_QUERY(equals, equals)
 365 BV_QUERY(contains, contains)
 366 BV_QUERY(lessthan, less_than)