src/xml-tree_stub.cpp

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