From 33cc91c072d0c3ee3f17911f6484a24f55a3408b Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= Date: Tue, 10 Dec 2013 20:28:06 +0100 Subject: [PATCH] Implement the bridge to call Tatoo from java. Very slow at the moment. --- .gitignore | 2 +- src/bindings/java/HACKING | 74 ++ src/bindings/java/Makefile | 34 + src/bindings/java/TatooEngine.cc | 696 ++++++++++++++++++ src/bindings/java/TatooTest.java | 82 +++ .../java/fxslt/memory/MutableNodeList.java | 25 + .../java/fxslt/memory/TatooEngine.java | 108 +++ src/bindings/java/fxslt_memory_TatooEngine.h | 45 ++ .../java/fxslt_memory_TatooEngine_Automaton.h | 13 + .../fxslt_memory_TatooEngine_CustomBlock.h | 13 + .../java/fxslt_memory_TatooEngine_Tree.h | 13 + src/bindings/java/tatoo.h | 27 + src/bindings/java/tatoo_driver.ml | 204 +++++ src/naive_node_list.ml | 58 ++ src/naive_node_list.mli | 17 + src/node_list.ml | 25 + src/run.ml | 60 +- src/run.mli | 6 +- src/tatoo.ml | 9 +- 19 files changed, 1481 insertions(+), 30 deletions(-) create mode 100644 src/bindings/java/HACKING create mode 100644 src/bindings/java/Makefile create mode 100644 src/bindings/java/TatooEngine.cc create mode 100644 src/bindings/java/TatooTest.java create mode 100644 src/bindings/java/fxslt/memory/MutableNodeList.java create mode 100644 src/bindings/java/fxslt/memory/TatooEngine.java create mode 100644 src/bindings/java/fxslt_memory_TatooEngine.h create mode 100644 src/bindings/java/fxslt_memory_TatooEngine_Automaton.h create mode 100644 src/bindings/java/fxslt_memory_TatooEngine_CustomBlock.h create mode 100644 src/bindings/java/fxslt_memory_TatooEngine_Tree.h create mode 100644 src/bindings/java/tatoo.h create mode 100644 src/bindings/java/tatoo_driver.ml create mode 100644 src/naive_node_list.ml create mode 100644 src/naive_node_list.mli create mode 100644 src/node_list.ml diff --git a/.gitignore b/.gitignore index 6902bbf..bf1311a 100644 --- a/.gitignore +++ b/.gitignore @@ -12,7 +12,7 @@ tests/trace/*.svg configure config.status Remakefile -Makefile +./Makefile autom4te.cache config.log remake diff --git a/src/bindings/java/HACKING b/src/bindings/java/HACKING new file mode 100644 index 0000000..618f29c --- /dev/null +++ b/src/bindings/java/HACKING @@ -0,0 +1,74 @@ +* 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 diff --git a/src/bindings/java/Makefile b/src/bindings/java/Makefile new file mode 100644 index 0000000..0c8978c --- /dev/null +++ b/src/bindings/java/Makefile @@ -0,0 +1,34 @@ +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 diff --git a/src/bindings/java/TatooEngine.cc b/src/bindings/java/TatooEngine.cc new file mode 100644 index 0000000..624c2df --- /dev/null +++ b/src/bindings/java/TatooEngine.cc @@ -0,0 +1,696 @@ +#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 +#include +#include +#include + +#include +#include +#include +extern "C" { +#include +} + +namespace jni { +namespace priv { + +enum { JNI_VERSION = JNI_VERSION_1_2 }; + +JNIEnv *current_env; + +template +class Integer; + +template +struct Traits; + +#define MAKE_TRAIT(T, N) \ +template<> \ +struct Traits { \ + static T (JNIEnv::*call)(jobject, jmethodID, va_list); \ +}; \ +T (JNIEnv::* Traits::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(&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 methods; + const std::vector fields; +}; + +class Class { +public: + +private: + typedef std::vector Methods; + typedef std::vector 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(env().NewGlobalRef(c))) == NULL) + throw jint(-1); + return c; + } + + static Methods + get_methods(const jclass class_, const std::vector &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 &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 +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(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 + T call(int method_id, ...) const + { + va_list vl; + va_start(vl, method_id); + T ret = (env().*priv::Traits::call)(this_, class_->methods[method_id], vl); + va_end(vl); + return ret; + } + template + static inline T static_call(jobject j, int method_id, ...) throw () + { + va_list vl; + va_start(vl, method_id); + T ret = (env().*priv::Traits::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 +jni::Class *jni::Object::class_ = NULL; + +typedef priv::Integer Integer; +typedef priv::Integer Short; + +template<> +jni::ClassDesc jni::Object::desc = { + "java/lang/Integer", { + { "intValue", "()I" }, + { "", "(I)V" } + }, { } +}; +template<> +jni::ClassDesc jni::Object::desc = { + "java/lang/Short", { + { "shortValue", "()S" }, + }, { } +}; + +template +class priv::Integer: public Object> { + enum Methods { valueID, initID }; + typedef Object> 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(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::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 { + 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( + 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(getFirstChildID)); } + static inline jobject getFirstChildO(jobject obj) throw () { + return static_call(obj, getFirstChildID); + } + static inline jobject getNextSiblingO(jobject obj) throw () { + return static_call(obj, getNextSiblingID); + } + + Node getNextSibling() const throw() { return Node(call(getNextSiblingID)); } + jshort getNodeType() const throw() { return call(getNodeTypeID); } + + jni::String getNodeName() const throw() + { return jni::String(static_cast(call(getNodeNameID))); } + + jni::String getNodeValue() const throw() + { return jni::String(static_cast(call(getNodeValueID))); } + + + jint getPreorder() const throw() + { + jobject data = call(getUserDataID, empty_key->this_); + return *jni::Integer(data); } + static inline jobject getPreorderO(jobject obj) throw () { + return static_call(obj, getNextSiblingID); + } + void setPreorder(jint i) const throw() + { + call(setUserDataID, empty_key->this_, jni::Integer(i), NULL); + } + + NamedNodeMap getAttributes() const throw(); +}; +jni::String *Node::empty_key = NULL; + +/********** Attr *************/ +template<> +jni::ClassDesc jni::Object::desc = { + "org/w3c/dom/Attr", { + { "getOwnerElement", "()Lorg/w3c/dom/Element;" } + }, { } +}; + +class Attr: public jni::Object { + enum Methods { + getOwnerElementID + }; + +public: + + Attr(jobject this_) throw() : Base(this_) { } + + Node getOwnerElement() const throw() { return Node(call(getOwnerElementID)); } +}; + +/********** NodeList **********/ +template<> +jni::ClassDesc jni::Object::desc = { + "org/w3c/dom/NodeList", { + { "getLength", "()I" }, + { "item", "(I)Lorg/w3c/dom/Node;" } + }, { } +}; + +class NodeList: public jni::Object { + enum Methods { getLengthID, itemID }; + +public: + NodeList(jobject this_) throw() : Base(this_) { } + + jint getLength() const throw() { return call(getLengthID); } + Node item(jint i) const throw() { return Node(call(itemID, i)); } +}; + + +/********** NamedNodeMap **********/ +template<> +jni::ClassDesc jni::Object::desc = { + "org/w3c/dom/NamedNodeMap", { + { "getLength", "()I" }, + { "item", "(I)Lorg/w3c/dom/Node;" } + }, { } +}; + +class NamedNodeMap: public jni::Object { + enum Methods { getLengthID, itemID }; + +public: + NamedNodeMap(jobject this_) throw() : Base(this_) { } + + jint getLength() const throw() { return call(getLengthID); } + Node item(jint i) const throw() { return Node(call(itemID, i)); } +}; + + +template<> +jni::ClassDesc jni::Object::desc = { + "fxslt/memory/MutableNodeList", { + { "add", "(Lorg/w3c/dom/Node;)V" }, + { "", "()V" } + }, { } +}; + +class MutableNodeList: public jni::Object { + 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(addID, n.this_); } +}; + + +NamedNodeMap Node::getAttributes() const throw() +{ + return NamedNodeMap(call(getAttributesID)); +} + + + +template<> +jni::ClassDesc jni::Object::desc = { + "fxslt/memory/TatooEngine$CustomBlock", { + { "", "(J)V" } + }, { + { "value_ptr", "J" } + } +}; + +class CustomBlock: public jni::Object { + 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(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_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(val); } + +static value pack(jobject obj) +{ +// static_assert(sizeof(uintptr_t) <= sizeof(long), "We need long to hold pointers."); + +// uintptr_t p = reinterpret_cast(obj); +// assert(! (p & 1)); + return reinterpret_cast (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(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(obj)); + CAMLreturn(Val_unit); +} +} diff --git a/src/bindings/java/TatooTest.java b/src/bindings/java/TatooTest.java new file mode 100644 index 0000000..a8f77ed --- /dev/null +++ b/src/bindings/java/TatooTest.java @@ -0,0 +1,82 @@ +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 = TatooEngine.init_document (doc); + stop_timer("Initializing document"); + + mnl.add(doc); + + start_timer(); + CustomBlock 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(""); + 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(""); + stop_timer("Serializing document"); + } + System.err.println("Number of results: " + nodes.getLength()); + } catch (Exception e) { + System.err.println(e); + } + } + +} diff --git a/src/bindings/java/fxslt/memory/MutableNodeList.java b/src/bindings/java/fxslt/memory/MutableNodeList.java new file mode 100644 index 0000000..c0137fd --- /dev/null +++ b/src/bindings/java/fxslt/memory/MutableNodeList.java @@ -0,0 +1,25 @@ +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 data; + + public MutableNodeList() { + + data = new Vector(); + } + + public void add(Node n) { data.add (n); } + public int getLength() { return data.size(); } + public Node item(int i) { + return data.get(i); + } + +} diff --git a/src/bindings/java/fxslt/memory/TatooEngine.java b/src/bindings/java/fxslt/memory/TatooEngine.java new file mode 100644 index 0000000..71b2ced --- /dev/null +++ b/src/bindings/java/fxslt/memory/TatooEngine.java @@ -0,0 +1,108 @@ +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 { + // 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 init_document(Document d, int i); + public static CustomBlock init_document(Document d) + { + int i = decorate(d, 0); + return init_document(d, i); + } + + public static class Automaton {} + + public static native CustomBlock compile(String xpath); + + public static native NodeList evaluate(CustomBlock automaton, + CustomBlock 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 = init_document (doc); + + mnl.add(b); + mnl.add(d); + + CustomBlock 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()); + } +} diff --git a/src/bindings/java/fxslt_memory_TatooEngine.h b/src/bindings/java/fxslt_memory_TatooEngine.h new file mode 100644 index 0000000..378e0e3 --- /dev/null +++ b/src/bindings/java/fxslt_memory_TatooEngine.h @@ -0,0 +1,45 @@ +/* DO NOT EDIT THIS FILE - it is machine generated */ +#include +/* 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 diff --git a/src/bindings/java/fxslt_memory_TatooEngine_Automaton.h b/src/bindings/java/fxslt_memory_TatooEngine_Automaton.h new file mode 100644 index 0000000..e7856e8 --- /dev/null +++ b/src/bindings/java/fxslt_memory_TatooEngine_Automaton.h @@ -0,0 +1,13 @@ +/* DO NOT EDIT THIS FILE - it is machine generated */ +#include +/* 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 diff --git a/src/bindings/java/fxslt_memory_TatooEngine_CustomBlock.h b/src/bindings/java/fxslt_memory_TatooEngine_CustomBlock.h new file mode 100644 index 0000000..0295385 --- /dev/null +++ b/src/bindings/java/fxslt_memory_TatooEngine_CustomBlock.h @@ -0,0 +1,13 @@ +/* DO NOT EDIT THIS FILE - it is machine generated */ +#include +/* 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 diff --git a/src/bindings/java/fxslt_memory_TatooEngine_Tree.h b/src/bindings/java/fxslt_memory_TatooEngine_Tree.h new file mode 100644 index 0000000..bf54653 --- /dev/null +++ b/src/bindings/java/fxslt_memory_TatooEngine_Tree.h @@ -0,0 +1,13 @@ +/* DO NOT EDIT THIS FILE - it is machine generated */ +#include +/* 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 diff --git a/src/bindings/java/tatoo.h b/src/bindings/java/tatoo.h new file mode 100644 index 0000000..f343ca6 --- /dev/null +++ b/src/bindings/java/tatoo.h @@ -0,0 +1,27 @@ +#ifndef TATOO_H +#define TATOO_H +#pragma once + +#include + +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 diff --git a/src/bindings/java/tatoo_driver.ml b/src/bindings/java/tatoo_driver.ml new file mode 100644 index 0000000..155b912 --- /dev/null +++ b/src/bindings/java/tatoo_driver.ml @@ -0,0 +1,204 @@ +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 diff --git a/src/naive_node_list.ml b/src/naive_node_list.ml new file mode 100644 index 0000000..c148732 --- /dev/null +++ b/src/naive_node_list.ml @@ -0,0 +1,58 @@ +(***********************************************************************) +(* *) +(* 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 } diff --git a/src/naive_node_list.mli b/src/naive_node_list.mli new file mode 100644 index 0000000..e1fde9c --- /dev/null +++ b/src/naive_node_list.mli @@ -0,0 +1,17 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/src/node_list.ml b/src/node_list.ml new file mode 100644 index 0000000..2219d5b --- /dev/null +++ b/src/node_list.ml @@ -0,0 +1,25 @@ +(***********************************************************************) +(* *) +(* 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 diff --git a/src/run.ml b/src/run.ml index fb9f81d..8eb58f9 100644 --- a/src/run.ml +++ b/src/run.ml @@ -203,7 +203,7 @@ 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 = @@ -245,8 +245,8 @@ module Make (T : Tree.S) = 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 *) @@ -266,6 +266,7 @@ module Make (T : Tree.S) = 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 @@ -294,16 +295,17 @@ module Make (T : Tree.S) = 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 = @@ -316,24 +318,26 @@ module Make (T : Tree.S) = (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 @@ -346,12 +350,23 @@ module Make (T : Tree.S) = 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; @@ -359,7 +374,7 @@ module Make (T : Tree.S) = 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; @@ -375,7 +390,8 @@ module Make (T : Tree.S) = 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; diff --git a/src/run.mli b/src/run.mli index 725192e..e124e8a 100644 --- a/src/run.mli +++ b/src/run.mli @@ -19,9 +19,9 @@ type stats = { run : int; 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 diff --git a/src/tatoo.ml b/src/tatoo.ml index 9fb7045..24e212f 100644 --- a/src/tatoo.ml +++ b/src/tatoo.ml @@ -104,9 +104,10 @@ let main () = 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 -> @@ -134,10 +135,10 @@ let main () = 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; -- 2.17.1