--- /dev/null
+#include <cassert>
+#include <ctime>
+#include <iostream>
+#include <vector>
+
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/memory.h>
+
+#include <libxml/parser.h>
+#include <libxml/tree.h>
+
+#include "tatoo.h"
+
+namespace ml {
+value pack(void *ptr)
+{
+ uintptr_t p = reinterpret_cast<uintptr_t>(ptr);
+ static_assert(sizeof(long) >= sizeof(uintptr_t), "We use long to store pointers");
+ assert(!(p&1));
+ return Val_long(p>>1);
+}
+
+void* unpack(value val) { return reinterpret_cast<void *>(Long_val(val) << 1); }
+
+template<typename T>
+T* unpack(value val) { return reinterpret_cast<T *>(unpack(val)); }
+}
+
+namespace xml {
+xmlNode* node_first_child(xmlNode *node)
+{
+ switch(node->type) {
+ case XML_ELEMENT_NODE:
+ if(node->properties) {
+ return reinterpret_cast<xmlNode *>(node->properties);
+ break;
+ }
+ case XML_ATTRIBUTE_NODE:
+ case XML_DOCUMENT_NODE:
+ case XML_TEXT_NODE:
+ case XML_PI_NODE:
+ case XML_COMMENT_NODE:
+ return node->children;
+ default:
+ assert(false && "Unknown node type");
+ }
+}
+xmlNode* node_next_sibling(xmlNode *node)
+{
+ if(node->next)
+ return node->next;
+ if(node->type == XML_ATTRIBUTE_NODE)
+ return node->parent->children;
+ return NULL;
+}
+} // namespace xml
+
+static value *init_document;
+static value *xpath_compile;
+static value *auto_evaluate;
+
+typedef std::vector<xmlNode *> nodelist;
+
+CAMLprim value node_getFirstChild(value node)
+{
+ CAMLparam1(node);
+ CAMLreturn(ml::pack(xml::node_first_child(ml::unpack<xmlNode>(node))));
+}
+
+CAMLprim value node_getNextSibling(value node)
+{
+ CAMLparam1(node);
+ CAMLreturn(ml::pack(xml::node_next_sibling(ml::unpack<xmlNode>(node))));
+}
+
+CAMLprim value node_getNodeType(value node)
+{
+ CAMLparam1(node);
+ CAMLreturn(Val_int(ml::unpack<xmlNode>(node)->type));
+}
+
+CAMLprim value node_getNodeName(value node)
+{
+ CAMLparam1(node);
+ const xmlChar *name = ml::unpack<xmlNode>(node)->name;
+ static const char *empty = "";
+ CAMLreturn(caml_copy_string(name ? reinterpret_cast<const char *>(name) : empty));
+}
+
+CAMLprim value node_getPreorder(value node)
+{
+ CAMLparam1(node);
+ CAMLreturn(Val_long(reinterpret_cast<uintptr_t>(ml::unpack<xmlNode>(node)->_private)));
+}
+
+CAMLprim value nodelist_getLength(value list)
+{
+ CAMLparam1(list);
+ CAMLreturn(Val_long(ml::unpack<nodelist>(list)->size()));
+}
+
+CAMLprim value nodelist_item(value list, value idx)
+{
+ CAMLparam2(list, idx);
+ CAMLreturn(ml::pack(ml::unpack<nodelist>(list)->operator[](Long_val(idx))));
+}
+
+CAMLprim value nodelist_new(value unit)
+{
+ CAMLparam1(unit);
+ CAMLreturn(ml::pack(new nodelist)); // XXX: lifetime...
+}
+
+CAMLprim value nodelist_add(value list, value node)
+{
+ CAMLparam2(list, node);
+ ml::unpack<nodelist>(list)->push_back(ml::unpack<xmlNode>(node));
+ CAMLreturn(list);
+}
+
+CAMLprim value getNull(value unit) { CAMLparam1(unit); CAMLreturn(ml::pack(NULL)); }
+
+CAMLprim value dereference_object(value obj)
+{
+ CAMLparam1(obj);
+ //jni::env().DeleteGlobalRef(reinterpret_cast<jobject>(obj));
+ CAMLreturn(Val_unit);
+}
+
+static uintptr_t decorate_(xmlNode *node, uintptr_t preorder)
+{
+ if(not node) return preorder;
+
+ assert(!node->_private && "Non-null private data encountered");
+ node->_private = reinterpret_cast<void *>(preorder++);
+
+ preorder = decorate_(xml::node_first_child(node), preorder);
+ preorder = decorate_(xml::node_next_sibling(node), preorder);
+
+ return preorder;
+}
+
+static value decorate(xmlDoc *doc)
+{
+ uintptr_t size = decorate_(reinterpret_cast<xmlNode *>(doc), 0);
+ return caml_callback2(*init_document, ml::pack(doc), Val_long(size));
+}
+
+template<typename Fn, typename... Args>
+auto time(const char *msg, const Fn &fn, Args&&... args) -> decltype(fn(args...))
+{
+ timespec start;
+ clock_gettime(CLOCK_THREAD_CPUTIME_ID, &start);
+ auto ret = fn(args...);
+ timespec end;
+ clock_gettime(CLOCK_THREAD_CPUTIME_ID, &end);
+ end.tv_nsec -= start.tv_nsec;
+ end.tv_sec -= start.tv_sec;
+ printf("\n---> %s: %.3f ms\n", msg, end.tv_sec * 1e3 + end.tv_nsec / 1e6);
+ return std::move(ret);
+}
+
+static void process(const char *file, const char *expr)
+{
+ CAMLparam0();
+ CAMLlocal3(docval, aut, res);
+
+ xmlDoc *doc = time("parse", xmlReadFile, file, nullptr, 0);
+
+ docval = time("decorate", decorate, doc);
+
+ aut = time("compile", caml_callback, *xpath_compile, caml_copy_string(expr));
+
+ nodelist nl = { reinterpret_cast<xmlNode *>(doc) };
+ res = time("evaluate", caml_callback3, *auto_evaluate, aut, docval, ml::pack(&nl));
+
+ nl = std::move(*ml::unpack<nodelist>(res));
+ printf("\n---> Number of results: %zd\n", nl.size());
+ /* for(auto node: nl)
+ printf("---> %s\n", node->name);*/
+
+ xmlFreeDoc(doc);
+ CAMLreturn0;
+}
+
+void usage(const char *program)
+{
+ fprintf(stderr,
+ "Usage:\n"
+ " %s <file> <query>\n", program);
+ exit(1);
+}
+
+int main(int argc, char *argv[])
+{
+ LIBXML_TEST_VERSION;
+
+ if(argc != 3)
+ usage(argv[0]);
+
+ caml_startup(argv);
+
+ init_document = caml_named_value("init_document"); assert(init_document);
+ xpath_compile = caml_named_value("xpath_compile"); assert(xpath_compile);
+ auto_evaluate = caml_named_value("auto_evaluate"); assert(auto_evaluate);
+
+ process(argv[1], argv[2]);
+
+ xmlCleanupParser();
+ xmlMemoryDump();
+ return 0;
+}