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