configure
config.status
Remakefile
-Makefile
+./Makefile
autom4te.cache
config.log
remake
--- /dev/null
+* Memory Management
+
+Both GC need to live in harmony:
+
+- OCaml values that are stored on the Java side must but registered on
+ the OCaml side with caml_register_generational_global_root(),
+ otherwise, they can be reclaimed when they become unreachable from
+ OCaml. If these are still reachable from Java, the java reference is
+ now dangling.
+
+- Java Objects that are stored on the OCaml side must be registered
+ with jni::env().NewGlobalRef() for the same reason (if the become
+ unreachable from Java, their reference becomes dangling in the OCaml
+ code).
+
+- When Java code is done with an OCaml value,
+ it should call caml_unregister_generational_global_root()
+
+- When OCaml code is done with a Java value, it should call
+ env().DeleteGlobalRef()
+
+Registering global references is costly (in both cases) so we avoid
+doing that for every node. We must do it on the Java side:
+- for the automaton
+- for the tree (i.e. an OCaml value holding a pointer to the root of
+ the document
+And on the OCaml side:
+
+- for the pointer to the Document node (root) held in an OCaml block.
+ When the latter is reclamed we delete the GlobalRef associated to
+ the pointer.
+
+- for every MutableNodeList as well as the original NodeList, since
+ they hold pointers to the document. In particular, MutableNodeList
+ are created purely on the OCaml side and only returned as a final
+ result.
+
+
+**** TODO: At the end of the evaluation of the automaton, no OCaml code
+runs anymore, so the OCaml GC does not get a chance to run. One way to
+ensure that OCaml's GC runs one last time, is to call Gc.{minor,
+major, full_major}, either explicitely or when the automaton is
+reclaimed by Java.
+
+* Signals
+
+The JVM uses straps signals (e.g. to raise exceptions instead of
+segfaulting etc.). However the OCaml runtime also installs a signal
+handler and sometime gets signal targetted at the JVM. The solution to that
+is 'Signal chaining'
+
+http://docs.oracle.com/javase/7/docs/technotes/guides/vm/signal-chaining.html
+
+**** TODO: link against -ljsig instead of relying on LD_PRELOAD
+
+
+* Exceptions
+
+Java exceptions are never checked for in the JNI code.
+
+**** TODO:
+We should perform:
+ if (env().ExceptionCheck()) { ... }
+in the JNI code. However doing so for every call to Java might kill performances
+
+
+* Makefile
+The makefile is buggy and sometimes need to be run twice
+**** TODO: fix
+
+* Stack Size
+The OCaml code is heavily recursive. It might cause stack overflows of the JVM stack,
+and if signal are not handled properly, a segfault instead of an exception. In case of
+segfault, first increase the stack size with -Xss100m or so.
\ No newline at end of file
--- /dev/null
+CXX = g++
+ASMRUN = asmrun_shared
+
+all: libtatoo-java.so
+# cp $< ../../bin
+
+
+%.class: %.java
+ javac -cp . $<
+
+fxslt_memory_Tree.stamp: fxslt/memory/TatooEngine.class fxslt/memory/MutableNodeList.class
+ javah -jni fxslt.memory.TatooEngine
+ touch fxslt_memory_Tree.stamp
+
+fxslt_memory_TatooEngine.h: fxslt/memory/TatooEngine.class fxslt/memory/MutableNodeList.class
+
+TatooEngine.o: TatooEngine.cc fxslt_memory_Tree.stamp tatoo.h
+ $(CXX) -I `ocamlc -where` -DNDEBUG=1 -I $(JAVA_HOME)/include -I $(JAVA_HOME)/include/linux -fPIC \
+ -DPIC -std=c++0x -c -O3 -o $@ $< -Wall -Wextra -Wno-unused-parameter -g3
+
+libtatoo-java.so: TatooEngine.o tatoo-java.o
+ $(CXX) -shared -o $@ -O3 tatoo-java.o TatooEngine.o `ocamlc -where`/libasmrun.a `ocamlc -where`/libunix.a `ocamlc -where`/libbigarray.a -Wl,-soname,libtatoo-java.so
+tatoo_driver.depx tatoo_driver.cmx: tatoo_driver.ml
+ ../../../remake $@
+
+tatoo-java.o: tatoo_driver.cmx tatoo_driver.depx
+ ocamlfind ocamlopt -output-obj -o $@ -I ../.. -cc g++ -linkall -linkpkg -package bigarray,ulex,unix $(shell cat tatoo_driver.depx | sed -e 's:src:../..:g' | sed -e 's:depx:cmx:g' ) $<
+
+test: TatooTest.class libtatoo-java.so
+ java -cp . -Xss80m -Djava.library.path=. TatooTest ../../../tests/xmark_0.50.xml '/descendant::keyword[ancestor::listitem]/*'
+
+clean:
+ rm -f $(GEN_HEADERS) fxslt/memory/*.class
+ rm -f *.cm* *.depx *.o TatooTest.class *.so
--- /dev/null
+#include "fxslt_memory_TatooEngine.h"
+#include "fxslt_memory_TatooEngine_Automaton.h"
+#include "fxslt_memory_TatooEngine_Tree.h"
+#include "fxslt_memory_TatooEngine_CustomBlock.h"
+#include "tatoo.h"
+
+#include <cassert>
+#include <cstdint>
+#include <memory>
+#include <vector>
+
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/memory.h>
+extern "C" {
+#include <caml/threads.h>
+}
+
+namespace jni {
+namespace priv {
+
+enum { JNI_VERSION = JNI_VERSION_1_2 };
+
+JNIEnv *current_env;
+
+template<typename T>
+class Integer;
+
+template<typename T>
+struct Traits;
+
+#define MAKE_TRAIT(T, N) \
+template<> \
+struct Traits<T> { \
+ static T (JNIEnv::*call)(jobject, jmethodID, va_list); \
+}; \
+T (JNIEnv::* Traits<T>::call)(jobject, jmethodID, va_list) = &JNIEnv::Call ## N ## MethodV
+
+MAKE_TRAIT(jobject, Object);
+MAKE_TRAIT(jint, Int);
+MAKE_TRAIT(jshort, Short);
+MAKE_TRAIT(jboolean, Boolean);
+
+}
+
+JNIEnv &env() throw() {
+ assert(priv::current_env);
+ return *priv::current_env;
+}
+
+class scoped_env {
+public:
+ scoped_env(JNIEnv *env) throw()
+ {
+ assert(not priv::current_env);
+ priv::current_env = env;
+ }
+
+ scoped_env(JavaVM *vm) throw(jint)
+ {
+ assert(not priv::current_env);
+ if(vm->GetEnv(reinterpret_cast<void **>(&priv::current_env), priv::JNI_VERSION) != JNI_OK)
+ throw jint(-1);
+ }
+
+ ~scoped_env() throw()
+ {
+ assert(priv::current_env);
+ priv::current_env = NULL;
+ }
+};
+
+
+
+struct MemberDesc {
+ const char *name;
+ const char *signature;
+};
+
+struct ClassDesc {
+ const char *name;
+ const std::vector<MemberDesc> methods;
+ const std::vector<MemberDesc> fields;
+};
+
+class Class {
+public:
+
+private:
+ typedef std::vector<jmethodID> Methods;
+ typedef std::vector<jfieldID> Fields;
+
+ static jclass get_class(const char *name) throw(jint)
+ {
+ jclass c;
+ if((c = env().FindClass(name)) == NULL)
+ throw jint(-1);
+ if((c = static_cast<jclass>(env().NewGlobalRef(c))) == NULL)
+ throw jint(-1);
+ return c;
+ }
+
+ static Methods
+ get_methods(const jclass class_, const std::vector<MemberDesc> &methods) throw()
+ {
+ Methods ret(methods.size());
+ size_t i = 0;
+ for(auto it = methods.begin(); it != methods.end(); ++it, ++i)
+ ret[i] = env().GetMethodID(class_, it->name, it->signature);
+ return ret;
+ }
+
+ static Fields
+ get_fields(const jclass class_, const std::vector<MemberDesc> &fields) throw()
+ {
+ Fields ret(fields.size());
+ size_t i = 0;
+ for(auto it = fields.begin(); it != fields.end(); ++it, ++i)
+ ret[i] = env().GetFieldID(class_, it->name, it->signature);
+ return ret;
+ }
+
+public:
+ const jclass class_;
+ const Methods methods;
+ const Fields fields;
+
+ Class(const ClassDesc &desc) throw(jint)
+ : class_(get_class(desc.name)), methods(get_methods(class_, desc.methods)),
+ fields(get_fields(class_, desc.fields))
+ { }
+
+ ~Class() throw() { env().DeleteGlobalRef(class_); }
+
+ jboolean IsInstanceOf(jobject obj) const throw()
+ { return env().IsInstanceOf(obj, class_); }
+};
+
+template<typename C>
+class Object {
+protected:
+ typedef Object Base;
+ static ClassDesc desc;
+ static Class *class_;
+
+ Object(jobject this_) throw() : this_(this_) {
+ assert(class_->IsInstanceOf(this_));
+#if 0
+ if (!class_->IsInstanceOf(this_)) {
+
+ jclass object = env().FindClass("java/lang/Object");
+ jmethodID getClass_id = env().GetMethodID(object, "getClass", "()Ljava/lang/Class;");
+ jobject oclass = env().CallObjectMethod(this_, getClass_id);
+ jclass cls = env().FindClass("java/lang/Class");
+ jmethodID getName_id = env().GetMethodID(cls, "getName", "()Ljava/lang/String;");
+ jstring name = static_cast<jstring>(env().CallObjectMethod(oclass, getName_id));
+ fprintf(stderr, "ERROR: class: %s is not an instance of %s\n", desc.name, jni::env().GetStringUTFChars(name, NULL));
+
+
+ assert(class_->IsInstanceOf(this_));
+ };
+#endif
+ }
+ template<typename T>
+ T call(int method_id, ...) const
+ {
+ va_list vl;
+ va_start(vl, method_id);
+ T ret = (env().*priv::Traits<T>::call)(this_, class_->methods[method_id], vl);
+ va_end(vl);
+ return ret;
+ }
+ template<typename T>
+ static inline T static_call(jobject j, int method_id, ...) throw ()
+ {
+ va_list vl;
+ va_start(vl, method_id);
+ T ret = (env().*priv::Traits<T>::call)(j, class_->methods[method_id], vl);
+ va_end(vl);
+ return ret;
+ }
+public:
+ const jobject this_;
+
+ static void initialize() throw(jint) { class_ = new Class(desc); }
+ static void finalize() throw() { delete class_; class_ = NULL; }
+
+ static const Class& get_class() { return *class_; }
+};
+template<typename C>
+jni::Class *jni::Object<C>::class_ = NULL;
+
+typedef priv::Integer<jint> Integer;
+typedef priv::Integer<jshort> Short;
+
+template<>
+jni::ClassDesc jni::Object<Integer>::desc = {
+ "java/lang/Integer", {
+ { "intValue", "()I" },
+ { "<init>", "(I)V" }
+ }, { }
+};
+template<>
+jni::ClassDesc jni::Object<Short>::desc = {
+ "java/lang/Short", {
+ { "shortValue", "()S" },
+ }, { }
+};
+
+template<typename T>
+class priv::Integer: public Object<Integer<T>> {
+ enum Methods { valueID, initID };
+ typedef Object<Integer<T>> Base;
+public:
+ Integer(jobject this_) throw() : Base(this_) { }
+ Integer(jint i) throw()
+ : Base(jni::env().NewObject(Base::class_->class_, Base::class_->methods[initID], i))
+ { }
+ T operator*() const throw() { return Base::template call<T>(valueID); }
+};
+
+class String {
+private:
+ String(const String &) = delete;
+ String& operator=(const String &) = delete;
+
+ mutable const char *c_str_;
+public:
+ const jstring this_;
+
+ String(jstring this_) throw() : c_str_(NULL), this_(this_) { }
+ String(String &&rhs) throw() : c_str_(rhs.c_str_), this_(rhs.this_) { rhs.c_str_ = NULL; }
+ ~String() throw() {
+ if(c_str_)
+ env().ReleaseStringUTFChars(this_, c_str_);
+ }
+
+ const char* c_str() const throw()
+ {
+ if(c_str_)
+ return c_str_;
+
+ return c_str_ = env().GetStringUTFChars(this_, NULL);
+ }
+};
+
+} // namespace jni
+
+class Node;
+class Attr;
+class NodeList;
+class NamedNodeMap;
+class MutableNodeList;
+class CustomBlock;
+
+template<>
+jni::ClassDesc jni::Object<Node>::desc = {
+ "org/w3c/dom/Node", {
+ { "getFirstChild", "()Lorg/w3c/dom/Node;" },
+ { "getNextSibling", "()Lorg/w3c/dom/Node;" },
+ { "getNodeName", "()Ljava/lang/String;" },
+ { "getNodeValue", "()Ljava/lang/String;" },
+ { "getUserData", "(Ljava/lang/String;)Ljava/lang/Object;" },
+ { "setUserData", "(Ljava/lang/String;Ljava/lang/Object;Lorg/w3c/dom/UserDataHandler;)Ljava/lang/Object;" },
+ { "getNodeType", "()S" },
+ { "getAttributes", "()Lorg/w3c/dom/NamedNodeMap;" }
+ }, { }
+};
+
+class Node: public jni::Object<Node> {
+ enum Methods {
+ getFirstChildID, getNextSiblingID, getNodeNameID, getNodeValueID, getUserDataID, setUserDataID, getNodeTypeID,
+ getAttributesID
+ };
+
+ static jni::String *empty_key;
+public:
+ static void initialize() throw(jint)
+ {
+ Base::initialize();
+ empty_key = new jni::String(static_cast<jstring>(
+ jni::env().NewGlobalRef(jni::env().NewStringUTF("")) ));
+ }
+ static void finalize() throw()
+ {
+ jni::env().DeleteGlobalRef(empty_key->this_);
+ delete empty_key;
+ empty_key = NULL;
+ Base::finalize();
+ }
+
+ Node(jobject this_) throw() : Base(this_) { }
+
+ Node getFirstChild() const throw() { return Node(call<jobject>(getFirstChildID)); }
+ static inline jobject getFirstChildO(jobject obj) throw () {
+ return static_call<jobject>(obj, getFirstChildID);
+ }
+ static inline jobject getNextSiblingO(jobject obj) throw () {
+ return static_call<jobject>(obj, getNextSiblingID);
+ }
+
+ Node getNextSibling() const throw() { return Node(call<jobject>(getNextSiblingID)); }
+ jshort getNodeType() const throw() { return call<jshort>(getNodeTypeID); }
+
+ jni::String getNodeName() const throw()
+ { return jni::String(static_cast<jstring>(call<jobject>(getNodeNameID))); }
+
+ jni::String getNodeValue() const throw()
+ { return jni::String(static_cast<jstring>(call<jobject>(getNodeValueID))); }
+
+
+ jint getPreorder() const throw()
+ {
+ jobject data = call<jobject>(getUserDataID, empty_key->this_);
+ return *jni::Integer(data); }
+ static inline jobject getPreorderO(jobject obj) throw () {
+ return static_call<jobject>(obj, getNextSiblingID);
+ }
+ void setPreorder(jint i) const throw()
+ {
+ call<jobject>(setUserDataID, empty_key->this_, jni::Integer(i), NULL);
+ }
+
+ NamedNodeMap getAttributes() const throw();
+};
+jni::String *Node::empty_key = NULL;
+
+/********** Attr *************/
+template<>
+jni::ClassDesc jni::Object<Attr>::desc = {
+ "org/w3c/dom/Attr", {
+ { "getOwnerElement", "()Lorg/w3c/dom/Element;" }
+ }, { }
+};
+
+class Attr: public jni::Object<Attr> {
+ enum Methods {
+ getOwnerElementID
+ };
+
+public:
+
+ Attr(jobject this_) throw() : Base(this_) { }
+
+ Node getOwnerElement() const throw() { return Node(call<jobject>(getOwnerElementID)); }
+};
+
+/********** NodeList **********/
+template<>
+jni::ClassDesc jni::Object<NodeList>::desc = {
+ "org/w3c/dom/NodeList", {
+ { "getLength", "()I" },
+ { "item", "(I)Lorg/w3c/dom/Node;" }
+ }, { }
+};
+
+class NodeList: public jni::Object<NodeList> {
+ enum Methods { getLengthID, itemID };
+
+public:
+ NodeList(jobject this_) throw() : Base(this_) { }
+
+ jint getLength() const throw() { return call<jint>(getLengthID); }
+ Node item(jint i) const throw() { return Node(call<jobject>(itemID, i)); }
+};
+
+
+/********** NamedNodeMap **********/
+template<>
+jni::ClassDesc jni::Object<NamedNodeMap>::desc = {
+ "org/w3c/dom/NamedNodeMap", {
+ { "getLength", "()I" },
+ { "item", "(I)Lorg/w3c/dom/Node;" }
+ }, { }
+};
+
+class NamedNodeMap: public jni::Object<NamedNodeMap> {
+ enum Methods { getLengthID, itemID };
+
+public:
+ NamedNodeMap(jobject this_) throw() : Base(this_) { }
+
+ jint getLength() const throw() { return call<jint>(getLengthID); }
+ Node item(jint i) const throw() { return Node(call<jobject>(itemID, i)); }
+};
+
+
+template<>
+jni::ClassDesc jni::Object<MutableNodeList>::desc = {
+ "fxslt/memory/MutableNodeList", {
+ { "add", "(Lorg/w3c/dom/Node;)V" },
+ { "<init>", "()V" }
+ }, { }
+};
+
+class MutableNodeList: public jni::Object<MutableNodeList> {
+ enum Methods { addID, initID };
+
+public:
+ MutableNodeList(jobject this_) throw() : Base(this_) { }
+ MutableNodeList() throw()
+ : Base(jni::env().NewObject(class_->class_, class_->methods[initID]))
+ { }
+
+ void add(Node n) throw() { call<jobject>(addID, n.this_); }
+};
+
+
+NamedNodeMap Node::getAttributes() const throw()
+{
+ return NamedNodeMap(call<jobject>(getAttributesID));
+}
+
+
+
+template<>
+jni::ClassDesc jni::Object<CustomBlock>::desc = {
+ "fxslt/memory/TatooEngine$CustomBlock", {
+ { "<init>", "(J)V" }
+ }, {
+ { "value_ptr", "J" }
+ }
+};
+
+class CustomBlock: public jni::Object<CustomBlock> {
+ enum Methods { initID };
+ enum Fields { valueID };
+
+ static_assert(sizeof(jlong) <= sizeof(value *), "We use jlong to store pointers.");
+
+ value* get() const throw()
+ { return reinterpret_cast<value *>(jni::env().GetLongField(this_, class_->fields[valueID])); }
+public:
+ CustomBlock(jobject this_) throw() : Base(this_) { }
+
+ CustomBlock(value val) throw()
+ : Base(jni::env().NewObject(class_->class_, class_->methods[initID], new value(val)))
+ { caml_register_generational_global_root(get()); }
+
+ value getValue() const throw() { return *get(); }
+};
+
+JNIEXPORT void JNICALL
+Java_fxslt_memory_TatooEngine_unregister (JNIEnv *env, jclass cls, jlong value_ptr)
+{
+ value * vptr = reinterpret_cast<value *>(value_ptr);
+ caml_remove_generational_global_root(vptr);
+ delete vptr;
+}
+
+static value *init_document;
+static value *xpath_compile;
+static value *auto_evaluate;
+
+JNIEXPORT jint JNICALL JNI_OnLoad(JavaVM *vm, void *)
+{
+ try {
+ jni::scoped_env se(vm);
+ jni::Integer::initialize();
+ Attr::initialize();
+ Node::initialize();
+ NodeList::initialize();
+ NamedNodeMap::initialize();
+ MutableNodeList::initialize();
+ CustomBlock::initialize();
+
+ char *argv[] = { NULL };
+ 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);
+ caml_release_runtime_system();
+ }
+ catch(jint e) {
+ return e;
+ }
+
+ return jni::priv::JNI_VERSION;
+}
+
+JNIEXPORT void JNICALL JNI_OnUnload(JavaVM *vm, void *)
+{
+ try {
+ jni::scoped_env se(vm);
+ MutableNodeList::finalize();
+ NamedNodeMap::finalize();
+ NodeList::finalize();
+ Node::finalize();
+ Attr::finalize();
+ jni::Integer::finalize();
+ }
+ catch(jint e) {
+ fprintf(stderr, "Critical error unloading shared library.\n");
+ }
+}
+
+static jobject extract(const value &val)
+{ return reinterpret_cast<jobject>(val); }
+
+static value pack(jobject obj)
+{
+// static_assert(sizeof(uintptr_t) <= sizeof(long), "We need long to hold pointers.");
+
+// uintptr_t p = reinterpret_cast<uintptr_t>(obj);
+// assert(! (p & 1));
+ return reinterpret_cast<value> (obj);
+}
+
+
+JNIEXPORT jobject JNICALL
+Java_fxslt_memory_TatooEngine_init_1document(JNIEnv *env, jclass TatooEngine, jobject node, jint i)
+{
+ CAMLparam0();
+ CAMLlocal1(val);
+ try {
+ jni::scoped_env se(env);
+ node = jni::env().NewGlobalRef(node);
+ val = caml_callback2(*init_document, pack(node), Val_int(i));
+ auto t = jni::env().NewGlobalRef(CustomBlock(val).this_);
+ CAMLreturnT(auto, t);
+ } catch(jint e) {
+ fprintf(stderr, "Critical error while initializing the document.\n");
+ CAMLreturnT(jobject, NULL);
+ }
+
+}
+
+
+JNIEXPORT jobject JNICALL
+Java_fxslt_memory_TatooEngine_compile(JNIEnv *env, jclass TatooEngine, jstring xpath)
+{
+ CAMLparam0();
+ CAMLlocal1(val);
+
+ try {
+ jni::scoped_env se(env);
+
+ val = caml_callback(*xpath_compile, caml_copy_string(jni::String(xpath).c_str()));
+ auto a = CustomBlock(val).this_;
+ a = jni::env().NewGlobalRef(a);
+ CAMLreturnT(auto, a);
+ }
+ catch(jint e) {
+ fprintf(stderr, "Critical error while compiling.\n");
+ CAMLreturnT(jobject, NULL);
+ }
+}
+
+JNIEXPORT jobject JNICALL
+Java_fxslt_memory_TatooEngine_evaluate(JNIEnv *env, jclass TatooEngine,
+ jobject automaton, jobject tree, jobject node_list)
+{
+ CAMLparam0();
+ CAMLlocal4(res, vauto, vtree, vnl);
+
+ try {
+ jni::scoped_env se(env);
+ vauto = CustomBlock(automaton).getValue();
+ vtree = CustomBlock(tree).getValue();
+ vnl = pack(node_list);
+
+ res = caml_callback3(*auto_evaluate, vauto, vtree, vnl);
+ CAMLreturnT(auto, extract(res));
+ } catch(jint e) {
+ fprintf(stderr, "Critical error while evaluating.\n");
+ CAMLreturnT(jobject, NULL);
+ }
+}
+
+#define GR (node) (jni::env().NewGlobalRef((node)))
+
+#if 0
+#define CHECK_EXCEPTION() do { \
+ if (jni::env().ExceptionCheck() == JNI_TRUE) { \
+ jni::env().ExceptionDescribe(); \
+ assert(false); \
+ } \
+ } while (0)
+#else
+#define CHECK_EXCEPTION()
+#endif
+
+extern "C" {
+CAMLprim value node_getFirstChild(value node)
+{ CAMLparam1(node);
+ CHECK_EXCEPTION();
+
+ CAMLreturn(pack(Node::getFirstChildO(extract(node))));
+ //CAMLreturn(pack(Node(extract(node)).getFirstChild().this_));
+}
+
+CAMLprim value node_getNextSibling(value node)
+{ CAMLparam1(node);
+ CHECK_EXCEPTION();
+ CAMLreturn(pack(Node::getNextSiblingO(extract(node))));
+ //CAMLreturn(pack(Node(extract(node)).getNextSibling().this_));
+}
+
+CAMLprim value node_getNodeType(value node)
+{ CAMLparam1(node);
+ CHECK_EXCEPTION();
+ CAMLreturn(Val_int(Node(extract(node)).getNodeType())); }
+
+CAMLprim value node_getNodeName(value node)
+{ CAMLparam1(node);
+ CHECK_EXCEPTION();
+ jstring obj = Node(extract(node)).getNodeName().this_;
+ value cstr = caml_copy_string(jni::env().GetStringUTFChars(obj, NULL));
+ CAMLreturn(cstr);
+}
+
+CAMLprim value node_getPreorder(value node)
+{ CAMLparam1(node);
+ CHECK_EXCEPTION();
+ CAMLreturn(Val_int(Node(extract(node)).getPreorder()));
+ }
+
+CAMLprim value node_setPreorder(value node, value i)
+{
+ CAMLparam1(node);
+ CHECK_EXCEPTION();
+ Node(extract(node)).setPreorder(Int_val(i));
+ CAMLreturn(Val_unit);
+}
+
+CAMLprim value print_runtime_class(value o)
+{
+ CAMLparam1(o);
+ CHECK_EXCEPTION();
+ jclass object = jni::env().FindClass("java/lang/Object");
+ jmethodID getClass_id = jni::env().GetMethodID(object, "getClass", "()Ljava/lang/Class;");
+ jobject oclass = jni::env().CallObjectMethod(extract(o), getClass_id);
+ jclass cls = jni::env().FindClass("java/lang/Class");
+ jmethodID getName_id = jni::env().GetMethodID(cls, "getName", "()Ljava/lang/String;");
+ jstring name = static_cast<jstring>(jni::env().CallObjectMethod(oclass, getName_id));
+ fprintf(stderr, "CLASS OF ATTTRIBUTE IS %s \n", jni::env().GetStringUTFChars(name, NULL));
+ fflush(stderr);
+ CAMLreturn(Val_unit);
+}
+CAMLprim value attr_getOwnerElement(value node)
+{
+ CAMLparam1(node);
+ CHECK_EXCEPTION();
+ auto attr = Attr(extract(node));
+ CAMLreturn(pack(attr.getOwnerElement().this_));
+ }
+
+CAMLprim value node_getAttributes(value node)
+{ CAMLparam1(node);
+ CHECK_EXCEPTION();
+ CAMLreturn(pack(Node(extract(node)).getAttributes().this_)); }
+
+CAMLprim value nodelist_getLength(value list)
+{ CAMLparam1(list);
+ CHECK_EXCEPTION();
+ CAMLreturn(Val_int(NodeList(extract(list)).getLength())); }
+
+CAMLprim value nodelist_item(value list, value idx)
+{
+ CAMLparam2(list, idx);
+ CHECK_EXCEPTION();
+ CAMLreturn(pack(NodeList(extract(list)).item(Long_val(idx)).this_));
+}
+
+CAMLprim value nodelist_new(value list)
+{ CAMLparam1(list);
+ auto l = jni::env().NewGlobalRef(MutableNodeList().this_);
+ CAMLreturn(pack(l));
+}
+
+CAMLprim value nodelist_add(value list, value node)
+{
+ CAMLparam2(list, node);
+ MutableNodeList(extract(list)).add(Node(extract(node)));
+ CAMLreturn(list);
+}
+
+CAMLprim value namednodemap_getLength(value list)
+{ CAMLparam1(list); CAMLreturn(Val_int(NamedNodeMap(extract(list)).getLength())); }
+
+CAMLprim value namednodemap_item(value list, value idx)
+{
+ CAMLparam2(list, idx);
+ CAMLreturn(pack(NamedNodeMap(extract(list)).item(Long_val(idx)).this_));
+}
+
+CAMLprim value getNull(value unit) { CAMLparam1(unit); CAMLreturn((value) NULL); }
+
+CAMLprim value dereference_object (value obj)
+{
+ CAMLparam1(obj);
+ jni::env().DeleteGlobalRef(reinterpret_cast<jobject>(obj));
+ CAMLreturn(Val_unit);
+}
+}
--- /dev/null
+import javax.xml.parsers.DocumentBuilderFactory;
+import org.w3c.dom.Document;
+import org.w3c.dom.Node;
+import org.w3c.dom.NodeList;
+import fxslt.memory.TatooEngine;
+import fxslt.memory.TatooEngine.CustomBlock;
+import fxslt.memory.TatooEngine.Tree;
+import fxslt.memory.TatooEngine.Automaton;
+import fxslt.memory.MutableNodeList;
+
+import javax.xml.transform.*;
+import javax.xml.transform.dom.*;
+import javax.xml.transform.stream.*;
+
+
+public class TatooTest {
+ static long timer;
+ public static void start_timer() {
+ timer = System.nanoTime();
+ }
+ public static void stop_timer (String msg) {
+ long time = System.nanoTime() - timer;
+ System.err.println(msg + " " + time/1000000 + "ms");
+ System.err.flush();
+ }
+
+ public static void main(String args[])
+ {
+
+ try {
+
+ DocumentBuilderFactory dbf = DocumentBuilderFactory.newInstance();
+ dbf.setCoalescing(true);
+ dbf.setNamespaceAware(true);
+
+ start_timer();
+ Document doc = dbf.newDocumentBuilder().parse(args[0]);
+ stop_timer("Parsing document");
+
+ MutableNodeList mnl = new MutableNodeList();
+ start_timer();
+ CustomBlock<Tree> tree = TatooEngine.init_document (doc);
+ stop_timer("Initializing document");
+
+ mnl.add(doc);
+
+ start_timer();
+ CustomBlock<Automaton> auto = TatooEngine.compile(args[1]);
+ stop_timer("Compiling query");
+
+ start_timer();
+ NodeList nodes = TatooEngine.evaluate(auto, tree, mnl);
+ stop_timer("Evaluating query");
+
+ if (args.length >= 3 && args[2] == "print" ) {
+ start_timer ();
+ Transformer serializer = TransformerFactory.newInstance().newTransformer();
+ serializer.setOutputProperty(OutputKeys.OMIT_XML_DECLARATION, "yes");
+ StreamResult o = new StreamResult(System.out);
+ System.out.println("<xml_result num=\"1\">");
+ for(int i = 0; i < nodes.getLength(); i++){
+ Node n = nodes.item(i);
+ switch (n.getNodeType()) {
+ case Node.ATTRIBUTE_NODE:
+ System.out.print (n.getNodeName() + "=" + n.getNodeValue());
+ break;
+ default:
+ serializer.transform(new DOMSource(nodes.item(i)), o);
+ break;
+ };
+ System.out.println();
+ };
+ System.out.println("</xml_result>");
+ stop_timer("Serializing document");
+ }
+ System.err.println("Number of results: " + nodes.getLength());
+ } catch (Exception e) {
+ System.err.println(e);
+ }
+ }
+
+}
--- /dev/null
+package fxslt.memory;
+
+import javax.xml.parsers.DocumentBuilderFactory;
+
+import org.w3c.dom.Node;
+import org.w3c.dom.NodeList;
+import java.util.Vector;
+
+
+public class MutableNodeList implements NodeList {
+
+ private Vector<Node> data;
+
+ public MutableNodeList() {
+
+ data = new Vector<Node>();
+ }
+
+ public void add(Node n) { data.add (n); }
+ public int getLength() { return data.size(); }
+ public Node item(int i) {
+ return data.get(i);
+ }
+
+}
--- /dev/null
+package fxslt.memory;
+
+import javax.xml.parsers.DocumentBuilderFactory;
+
+import org.w3c.dom.Document;
+import org.w3c.dom.Node;
+import org.w3c.dom.NodeList;
+import org.w3c.dom.NamedNodeMap;
+import java.util.Vector;
+
+
+public class TatooEngine {
+ static {
+ System.loadLibrary("tatoo-java");
+ }
+ private static native void unregister(long v);
+
+ public static class CustomBlock<T> {
+ // Stores a pointer to a C++ heap allocated pointer
+ // to an OCaml value. Once this object becomes unreachable on the
+ // Java side, we can de-register the value pointer in the OCaml
+ // runtime
+ // T is a phantom type denoting the type of values on the OCaml side.
+ private long value_ptr;
+ private CustomBlock(long value_ptr)
+ {
+ this.value_ptr = value_ptr;
+ }
+ protected void finalise() {
+ System.err.println("Finalizing a CustomBlock!");
+ unregister (value_ptr);
+ value_ptr = 0;
+ }
+
+ }
+ public static int decorate(Node n, int preorder)
+ {
+ if (n == null) return preorder ;
+
+ n.setUserData("", new Integer (preorder), null);
+ preorder++;
+ NamedNodeMap att = n.getAttributes();
+ if (att != null) {
+ for(int i = 0; i < att.getLength(); i++) {
+ att.item(i).setUserData("", new Integer (preorder), null);
+ preorder++;
+ att.item(i).getFirstChild().setUserData("", new Integer (preorder), null);
+ preorder++;
+ }
+ };
+ for (Node c = n.getFirstChild(); c != null; c = c.getNextSibling())
+ preorder = decorate(c, preorder);
+ return preorder;
+ }
+
+ public static class Tree {}
+ static native CustomBlock<Tree> init_document(Document d, int i);
+ public static CustomBlock<Tree> init_document(Document d)
+ {
+ int i = decorate(d, 0);
+ return init_document(d, i);
+ }
+
+ public static class Automaton {}
+
+ public static native CustomBlock<Automaton> compile(String xpath);
+
+ public static native NodeList evaluate(CustomBlock<Automaton> automaton,
+ CustomBlock<Tree> tree,
+ NodeList start);
+
+
+ public static void main(String[] args) throws Exception {
+ DocumentBuilderFactory dbf = DocumentBuilderFactory.newInstance();
+ dbf.setCoalescing(true);
+ dbf.setNamespaceAware(true);
+ Document doc = dbf.newDocumentBuilder().newDocument();
+
+ MutableNodeList mnl = new MutableNodeList();
+ Node a, b, c, d;
+ a = doc.createElement("a");
+ b = doc.createElement("b");
+ c = doc.createElement("c");
+ d = doc.createElement("d");
+ c.appendChild(d);
+ a.appendChild(b);
+ a.appendChild(c);
+ doc.appendChild(a);
+ CustomBlock<Tree> tree = init_document (doc);
+
+ mnl.add(b);
+ mnl.add(d);
+
+ CustomBlock<Automaton> aut = compile("descendant-or-self::*");
+ System.err.println("After compilation");
+ System.err.println(aut.getClass().getName());
+ System.err.println(tree.getClass().getName());
+ System.err.println(mnl.getClass().getName());
+ NodeList nl = evaluate(aut, tree, mnl);
+ //aut.dispose();
+ System.out.println("NodeList.getLength() = " + nl.getLength());
+ for (int i = 0; i < nl.getLength(); ++i) {
+ System.out.println("NodeList.item(" + i + ").getNodeName() = "
+ + (nl.item(i) != null ? nl.item(i).getNodeName() : null));
+ }
+ System.out.println(doc.getNodeName());
+ }
+}
--- /dev/null
+/* DO NOT EDIT THIS FILE - it is machine generated */
+#include <jni.h>
+/* Header for class fxslt_memory_TatooEngine */
+
+#ifndef _Included_fxslt_memory_TatooEngine
+#define _Included_fxslt_memory_TatooEngine
+#ifdef __cplusplus
+extern "C" {
+#endif
+/*
+ * Class: fxslt_memory_TatooEngine
+ * Method: unregister
+ * Signature: (J)V
+ */
+JNIEXPORT void JNICALL Java_fxslt_memory_TatooEngine_unregister
+ (JNIEnv *, jclass, jlong);
+
+/*
+ * Class: fxslt_memory_TatooEngine
+ * Method: init_document
+ * Signature: (Lorg/w3c/dom/Document;I)Lfxslt/memory/TatooEngine/CustomBlock;
+ */
+JNIEXPORT jobject JNICALL Java_fxslt_memory_TatooEngine_init_1document
+ (JNIEnv *, jclass, jobject, jint);
+
+/*
+ * Class: fxslt_memory_TatooEngine
+ * Method: compile
+ * Signature: (Ljava/lang/String;)Lfxslt/memory/TatooEngine/CustomBlock;
+ */
+JNIEXPORT jobject JNICALL Java_fxslt_memory_TatooEngine_compile
+ (JNIEnv *, jclass, jstring);
+
+/*
+ * Class: fxslt_memory_TatooEngine
+ * Method: evaluate
+ * Signature: (Lfxslt/memory/TatooEngine/CustomBlock;Lfxslt/memory/TatooEngine/CustomBlock;Lorg/w3c/dom/NodeList;)Lorg/w3c/dom/NodeList;
+ */
+JNIEXPORT jobject JNICALL Java_fxslt_memory_TatooEngine_evaluate
+ (JNIEnv *, jclass, jobject, jobject, jobject);
+
+#ifdef __cplusplus
+}
+#endif
+#endif
--- /dev/null
+/* DO NOT EDIT THIS FILE - it is machine generated */
+#include <jni.h>
+/* Header for class fxslt_memory_TatooEngine_Automaton */
+
+#ifndef _Included_fxslt_memory_TatooEngine_Automaton
+#define _Included_fxslt_memory_TatooEngine_Automaton
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __cplusplus
+}
+#endif
+#endif
--- /dev/null
+/* DO NOT EDIT THIS FILE - it is machine generated */
+#include <jni.h>
+/* Header for class fxslt_memory_TatooEngine_CustomBlock */
+
+#ifndef _Included_fxslt_memory_TatooEngine_CustomBlock
+#define _Included_fxslt_memory_TatooEngine_CustomBlock
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __cplusplus
+}
+#endif
+#endif
--- /dev/null
+/* DO NOT EDIT THIS FILE - it is machine generated */
+#include <jni.h>
+/* Header for class fxslt_memory_TatooEngine_Tree */
+
+#ifndef _Included_fxslt_memory_TatooEngine_Tree
+#define _Included_fxslt_memory_TatooEngine_Tree
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __cplusplus
+}
+#endif
+#endif
--- /dev/null
+#ifndef TATOO_H
+#define TATOO_H
+#pragma once
+
+#include <caml/mlvalues.h>
+
+extern "C" {
+
+CAMLprim value node_getFirstChild(value node);
+CAMLprim value node_getNextSibling(value node);
+CAMLprim value node_getKind(value node);
+CAMLprim value node_getNodeName(value node);
+CAMLprim value node_getPreorder(value node);
+CAMLprim value node_getAttributes(value node);
+
+CAMLprim value nodelist_getLength(value list);
+CAMLprim value nodelist_item(value list, value idx);
+CAMLprim value nodelist_new(value list);
+CAMLprim value nodelist_add(value list, value node);
+
+CAMLprim value namednodemap_getLength(value list);
+CAMLprim value namednodemap_item(value list, value idx);
+
+CAMLprim value getNull(value unit);
+}
+
+#endif
--- /dev/null
+type +'a jvm_pointer
+
+external dereference_object : 'a jvm_pointer -> unit = "dereference_object"
+external get_null : unit -> 'a jvm_pointer = "getNull"
+
+let null = get_null ()
+
+module Java_tree : sig
+ include Tree.S
+ val init_document : node -> int -> t
+end =
+ struct
+
+ type node = [`Node] jvm_pointer
+
+ type named_node_map = [`NamedNodeMap] jvm_pointer
+
+
+
+ external dereference_node : node -> unit = "dereference_object"
+ external dereference_named_node_map : named_node_map -> unit = "dereference_object"
+
+ external node_get_preorder : node -> int = "node_getPreorder"
+
+
+ external node_set_preorder : node -> int -> unit = "node_setPreorder"
+
+
+ external node_get_owner_element : node -> node = "attr_getOwnerElement"
+
+
+ external node_get_attributes : node -> named_node_map = "node_getAttributes"
+
+
+ external named_node_map_get_length : named_node_map -> int = "namednodemap_getLength"
+
+
+
+
+
+ external named_node_map_item : named_node_map -> int -> node = "namednodemap_item"
+
+
+
+
+ type t = {
+ root : node;
+ size : int;
+ tag_cache : QName.t array
+ }
+
+ let nil = get_null ()
+
+ let dummy = get_null ()
+
+ let size t = t.size
+
+ let load_xml_file _ = assert false
+ let load_xml_string _ = assert false
+ let print_xml _ _ _ = assert false
+ let root t = t.root
+
+
+
+ external node_get_node_type : node -> int = "node_getNodeType"
+
+ let node_kind_of_int i =
+ Tree.NodeKind.(
+ match i with
+ | 1 -> Element
+ | 2 -> Attribute
+ | 3 | 4 -> Text
+ | 7 -> ProcessingInstruction
+ | 8 -> Comment
+ | 9 -> Document
+ | _ -> failwith ("Unimplemented document kind, please report " ^ string_of_int i)
+ )
+
+
+ external node_get_node_name : node -> string = "node_getNodeName"
+
+ let kind _ node =
+ assert (node != null);
+ node_kind_of_int (node_get_node_type node)
+
+ external node_get_first_child : node -> node = "node_getFirstChild"
+
+ external print_runtime_class : 'a jvm_pointer -> unit = "print_runtime_class"
+ let first_child _ node =
+ if node == nil then nil else
+ let attrs = node_get_attributes node in
+ if attrs == null then
+ node_get_first_child node
+ else
+ let len = named_node_map_get_length attrs in
+ if len == 0 (* possible ? *) then node_get_first_child node else
+ let at = named_node_map_item attrs 0 in
+ at
+
+ external node_get_next_sibling : node -> node = "node_getNextSibling"
+
+
+ let next_sibling tree node =
+
+ if node == nil then nil else
+ if (kind tree node) == Tree.NodeKind.Attribute then
+ begin
+
+ let owner = node_get_owner_element node in
+ let own_pre = node_get_preorder owner in
+ let node_pre = node_get_preorder node in
+ let attrs = node_get_attributes owner in
+ let len = named_node_map_get_length attrs in
+ let i = node_pre - own_pre / 2 in
+ if i < len then named_node_map_item attrs i else
+ node_get_first_child owner
+ end
+ else node_get_next_sibling node
+
+ let parent _ _ = assert false
+
+ let data _ _ = assert false
+
+ let tag tree node =
+ if node == nil then QName.nil else
+ let pre = node_get_preorder node in
+ let label = tree.tag_cache.(pre) in
+ if label != QName.nil then label else
+ let label = node_get_node_name node in
+ let rlabel =
+ Tree.NodeKind.(
+ match kind tree node with
+ | Document -> QName.document
+ | Text -> QName.text
+ | Attribute -> QName.attribute (QName.of_string label)
+ | ProcessingInstruction ->
+ QName.processing_instruction (QName.of_string label)
+ | _ -> QName.of_string label
+ )
+ in
+ tree.tag_cache.(pre) <- rlabel; rlabel
+
+ let preorder tree node =
+ if node == nil then -1 else
+ node_get_preorder node
+
+ let finalize t =
+ dereference_object (t.root)
+
+ let init_document node i =
+ let s = { size = i;
+ root = node;
+ tag_cache = Array.create i QName.nil
+ }
+ in
+ Gc.finalise (finalize) s;
+ s
+
+
+ let print_node _ _ = assert false
+ let by_preorder _ _ = assert false
+ end
+
+
+module Java_node_list : Node_list.S with type node = Java_tree.node
+ =
+ struct
+ type node = Java_tree.node
+ type node_list = [`NodeList] jvm_pointer
+ type t = node_list
+ external length : node_list -> int = "nodelist_getLength"
+ external create : unit -> node_list = "nodelist_new"
+ external add : node_list -> node -> node_list = "nodelist_add"
+ external item : node_list -> int -> node = "nodelist_item"
+
+ let add n l =
+ add l n
+
+ let iter f l =
+ for i = 0 to length l - 1 do
+ f (item l i)
+ done
+
+ end
+
+module Runtime = Run.Make(Java_tree)(Java_node_list)
+
+let _ = Callback.register "init_document" Java_tree.init_document
+
+let xpath_compile p =
+ let auto =
+ Xpath.Compile.path
+ (Xpath.Parser.parse (Ulexing.from_utf8_string p))
+ in
+ Ata.print Format.err_formatter auto;
+ Format.pp_print_flush Format.err_formatter ();
+ auto
+
+let _ = Callback.register "xpath_compile" xpath_compile
+
+let auto_evaluate auto tree list =
+ Runtime.eval auto tree list
+
+let _ = Callback.register "auto_evaluate" auto_evaluate
--- /dev/null
+(***********************************************************************)
+(* *)
+(* TAToo *)
+(* *)
+(* Kim Nguyen, LRI UMR8623 *)
+(* Université Paris-Sud & CNRS *)
+(* *)
+(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
+(* Recherche Scientifique. All rights reserved. This file is *)
+(* distributed under the terms of the GNU Lesser General Public *)
+(* License, with the special exception on linking described in file *)
+(* ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+
+type node = Naive_tree.node
+type cell = { node : node;
+ mutable next : cell }
+
+
+type t = { mutable length : int;
+ mutable head : cell;
+ mutable last : cell; }
+
+let rec nil = { node = Naive_tree.nil;
+ next = nil }
+
+let create () = { length = 0;
+ head = nil;
+ last = nil }
+
+let iter f l =
+ let rec loop c =
+ if c != nil then begin
+ f c.node;
+ loop c.next
+ end
+ in
+ loop l.head
+
+
+let length l = l.length
+
+
+let add n l =
+ let ncell = { node = n;
+ next = nil }
+ in
+ if l.last == nil then
+ { length = 1;
+ head = ncell;
+ last = ncell }
+ else
+ let () = l.last.next <- ncell in
+ { length = l.length + 1;
+ head = l.head;
+ last = ncell }
--- /dev/null
+(***********************************************************************)
+(* *)
+(* TAToo *)
+(* *)
+(* Kim Nguyen, LRI UMR8623 *)
+(* Université Paris-Sud & CNRS *)
+(* *)
+(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
+(* Recherche Scientifique. All rights reserved. This file is *)
+(* distributed under the terms of the GNU Lesser General Public *)
+(* License, with the special exception on linking described in file *)
+(* ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+
+include Node_list.S with type node = Naive_tree.node
--- /dev/null
+(***********************************************************************)
+(* *)
+(* TAToo *)
+(* *)
+(* Kim Nguyen, LRI UMR8623 *)
+(* Université Paris-Sud & CNRS *)
+(* *)
+(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
+(* Recherche Scientifique. All rights reserved. This file is *)
+(* distributed under the terms of the GNU Lesser General Public *)
+(* License, with the special exception on linking described in file *)
+(* ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+module type S =
+ sig
+ type node
+ type t
+
+ val create : unit -> t
+ val add : node -> t -> t
+ val iter : (node -> unit) -> t -> unit
+ val length : t -> int
+ end
new_sat
-module Make (T : Tree.S) =
+module Make (T : Tree.S) (L : Node_list.S with type node = T.node) =
struct
let make auto tree =
if s != 0 then s else
let s =
NodeSummary.make
- (node == T.first_child tree parent) (*is_left *)
- (node == T.next_sibling tree parent)(*is_right *)
+ (node_id == T.preorder tree (T.first_child tree parent)) (*is_left *)
+ (node_id == T.preorder tree (T.next_sibling tree parent))(*is_right *)
(fc != T.nil) (* has_left *)
(ns != T.nil) (* has_right *)
(T.kind tree node) (* kind *)
parent_sat
status0 td_todo
in
+
(* update the cache if the status of the node changed
unsafe_set run.sat node_id status1 status0;*)
let fcs1 = loop_td_and_bu fc node status1 in
let auto = run.auto in
let tree = run.tree in
let sel_states = Ata.get_selecting_states auto in
- let rec loop node acc =
- if node == T.nil then acc
- else
- let acc0 = loop (T.next_sibling tree node) acc in
- let acc1 = loop (T.first_child tree node) acc0 in
- if StateSet.intersect cache.(T.preorder tree node)
- sel_states then node::acc1
- else acc1
+ let res = ref (L.create ()) in
+ let rec loop node =
+ if node != T.nil then begin
+ if StateSet.intersect sel_states cache.(T.preorder tree node) then
+ res := L.add node !res;
+ loop (T.first_child tree node);
+ loop (T.next_sibling tree node)
+ end
in
- loop (T.root tree) []
+ loop (T.root tree);
+ !res
let get_full_results run =
(fun q -> Hashtbl.add res_mapper q [])
(Ata.get_selecting_states auto)
in
- let dummy = [ T.nil ] in
+ let dummy = L.create () in
+
let res_mapper = Cache.N1.create dummy in
let () =
StateSet.iter
- (fun q -> Cache.N1.add res_mapper (q :> int) [])
+ (fun q -> Cache.N1.add res_mapper (q :> int) (L.create()))
(Ata.get_selecting_states auto)
in
let rec loop node =
- if node != T.nil then
- let () = loop (T.next_sibling tree node) in
- let () = loop (T.first_child tree node) in
+ if node != T.nil then begin
StateSet.iter
(fun q ->
let res = Cache.N1.find res_mapper (q :> int) in
if res != dummy then
- Cache.N1.add res_mapper (q :> int) (node::res)
+ Cache.N1.add res_mapper (q :> int) (L.add node res)
)
- cache.(T.preorder tree node)
+ cache.(T.preorder tree node);
+ loop (T.first_child tree node);
+ loop (T.next_sibling tree node)
+ end
in
loop (T.root tree);
(StateSet.fold_right
let auto = run.auto in
let sat = IFHTML((List.hd run.sat), run.sat) in
let sat0 = Ata.get_starting_states auto in
- List.iter (fun node ->
+ L.iter (fun node ->
let node_id = T.preorder tree node in
sat.(node_id) <- sat0) list
let tree_size = ref 0
let pass = ref 0
+
+let time f arg msg =
+ let t1 = Unix.gettimeofday () in
+ let r = f arg in
+ let t2 = Unix.gettimeofday () in
+ let time = (t2 -. t1) *. 1000. in
+ Printf.eprintf "%s: %fms%!" msg time;
+ r
+
+
+
let compute_run auto tree nodes =
pass := 0;
tree_size := T.size tree;
prepare_run run nodes;
let rank = Ata.get_max_rank auto in
while run.pass <= rank do
- top_down run;
+ time top_down run ("Timing run number " ^ string_of_int run.pass ^ "/" ^ string_of_int (Ata.get_max_rank auto + 1));
IFHTML((run.sat <- (Array.copy (List.hd run.sat)) :: run.sat), ());
run.td_cache <- Cache.N6.create dummy_set;
run.bu_cache <- Cache.N6.create dummy_set;
let eval auto tree nodes =
let r = compute_run auto tree nodes in
- get_results r
+ let nl = get_results r in
+ nl
let stats () = {
tree_size = !tree_size;
eval_trans_cache_access : int;
eval_trans_cache_hit : int;
}
-module Make (T : Tree.S) :
+module Make (T : Tree.S) (L : Node_list.S with type node = T.node) :
sig
- val eval : Ata.t -> T.t -> T.node list -> T.node list
- val full_eval : Ata.t -> T.t -> T.node list -> (State.t * T.node list) list
+ val eval : Ata.t -> T.t -> L.t -> L.t
+ val full_eval : Ata.t -> T.t -> L.t -> (State.t * L.t) list
val stats : unit -> stats
end
Logger.msg `STATS "@[Automaton: @\n%a@]" Ata.print auto) auto_list;
end;
- let module Naive = Run.Make(Naive_tree) in
+ let module Naive = Run.Make(Naive_tree)(Naive_node_list) in
let result_list =
- let root = [ Naive_tree.root doc] in
+
+ let root = Naive_node_list.(add (Naive_tree.root doc) (create())) in
let f, msg =
match !Options.parallel, !Options.compose with
true, true ->
output_string output (string_of_int !count);
output_string output "\" >\n";
if !Options.count then begin
- output_string output (string_of_int (List.length results));
+ output_string output (string_of_int (Naive_node_list.length results));
output_char output '\n';
end else
- List.iter (fun n ->
+ Naive_node_list.iter (fun n ->
Naive_tree.print_xml output doc n;
output_char output '\n'
) results;
projects / tatoo.git / commitdiff