src/xml-tree_stub.cpp

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