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