-/*******************************************
- * OCamlStorageInterface.cpp
- * ------------------------
- *
- *
- * Author: Kim Nguyen
- * Date: 04/11/08
- */
-
-
-#include "OCamlStorageInterface.h"
-#include "Utils.h"
-
-/* see caml/mlvalues.h
- */
-/* tags */
-#define NODE 0
-#define STRING 1
-
-/* fields */
-#define PCDATA 0
-#define ID 0
-#define TAG 1
-#define LEFT 2
-#define RIGHT 3
-#define FATHER 4
-
-#define NIL (Val_unit)
-
-/* The OCaml function which computes the hash value of a tag */
-static value *caml_hash_tag = NULL;
-
-OCamlStorageInterface::OCamlStorageInterface()
-{
- CAMLparam0();
- CAMLlocal4(node,nodeptr,dummytag,father);
- nodeid=1;
- if (caml_hash_tag == NULL) {
- /* First time around, look up by name */
- caml_hash_tag = caml_named_value("caml_hash_tag");
-
- }
-
- dummytag = caml_callback(*caml_hash_tag, caml_copy_string(""));
-
- // Atomic block, initialize must be called for every field
- // Before any other allocation takes place. In particular,
- // One should NOT place the call to caml_callback as an argument to
- // caml_initialize but rather store its result in a variable.
- father = caml_alloc_shr(1,0);
- caml_initialize(&Field(father,0),NIL);
-
- node = caml_alloc_shr(5,0);
- caml_initialize(&Field(node,ID),Val_int(nodeid++));
- caml_initialize(&Field(node,TAG),dummytag);
- caml_initialize(&Field(node,LEFT),NIL);
- caml_initialize(&Field(node,RIGHT),NIL);
- caml_initialize(&Field(node,FATHER),father);
-
- nodeptr = caml_alloc_shr(1,LEFT);
- caml_initialize(&Field(nodeptr,0),node);
-
- stack.push_front(nodeptr);
- caml_register_global_root(&stack.front());
-
- CAMLreturn0;
-}
-
-OCamlStorageInterface::~OCamlStorageInterface()
-{
- caml_remove_global_root(&stack.back());
-}
-
-void OCamlStorageInterface::newChild(string name)
-{
- CAMLparam0();
- CAMLlocal5(nnode,onode,tag,taghash,id);
- CAMLlocal3(father,nnodeptr,onodeptr);
- DPRINT("newChild " << name <<"\n")
- onode = stack.front();
- /* Allocate the new Node(tag,l,r) */
-
- /* Compute the new tag hash and store it in the new block */
- tag = caml_copy_string(name.c_str());
- taghash = caml_callback(*caml_hash_tag, tag);
- id = Val_int(nodeid++);
-
- /* Again, initialization must be atomic */
- father=caml_alloc_shr(1,0);
- caml_initialize(&Field(father,0),onode);
-
- nnode = caml_alloc_shr(5,0);
- caml_initialize(&Field(nnode,ID),id);
- caml_initialize(&Field(nnode,TAG),taghash);
- caml_initialize(&Field(nnode,LEFT),NIL);
- caml_initialize(&Field(nnode,RIGHT),NIL);
- caml_initialize(&Field(nnode,FATHER),father);
-
- nnodeptr = caml_alloc_shr(1,LEFT);
- caml_initialize(&Field(nnodeptr,0),nnode);
-
- switch (Tag_val(onode)){
- case LEFT:
- caml_modify(&Field(Field(onode,0),LEFT),nnodeptr);
- Tag_val(onode) = RIGHT;
- break;
-
- case RIGHT:
- caml_modify(&Field(Field(onode,0),RIGHT),nnodeptr);
- Tag_val(onode) = NODE;
- break;
- };
-
- stack.push_front(nnodeptr);
-
- CAMLreturn0;
-}
-
-
-
-void OCamlStorageInterface::newText(string text)
-{
- CAMLparam0();
- CAMLlocal3(pcdata,snode,node);
- DPRINT("newText " << text <<"\n")
-
- pcdata = caml_copy_string(text.c_str());
- snode = caml_alloc_shr(1,STRING);
- caml_initialize(&(Field(snode,PCDATA)),pcdata);
- node = stack.front();
-
- switch (Tag_val(node)){
- case LEFT:
- caml_modify(&Field(Field(node,0),LEFT),snode);
- Tag_val(node) = RIGHT;
- break;
- case RIGHT:
- caml_modify(&Field(Field(node,0),RIGHT),snode);
- Tag_val(node) = NODE;
- break;
-
-
- };
-
- CAMLreturn0;
-}
-
-
-
-void OCamlStorageInterface::nodeFinished()
-{
-
- CAMLparam0();
- CAMLlocal1(node);
- DPRINT("nodeFinished\n")
- node = stack.front();
-
- switch (Tag_val(node)){
- case LEFT:
- DPRINT("Tagged left\n")
- Tag_val(node) = RIGHT;
- break;
-
- case RIGHT:
- DPRINT("Tagged right\n")
- Tag_val(node) = NODE;
-
- case NODE:
- DPRINT("Under NODE\n");
- while (Tag_val(node) == NODE){
- stack.pop_front();
- node = stack.front();
- };
- break;
- };
-
- CAMLreturn0;
-}
-
- void OCamlStorageInterface::parsingFinished()
-{
- CAMLparam0();
- CAMLlocal1(rnode);
- caml_register_global_root(&document);
- document = stack.front();
-
- stack.pop_front(); /* removes the root */
- rnode = stack.front();
-
- DPRINT ("Stack size is "<< stack.size() <<"\n")
- /* reinitializes the stack */
- caml_modify(&Field(Field(rnode,0),ID),Val_int(nodeid=1));
- caml_modify(&Field(Field(rnode,0),LEFT),NIL);
- caml_modify(&Field(Field(rnode,0),RIGHT),NIL);
- caml_modify(&Field(Field(Field(rnode,0),FATHER),0),NIL);
- Tag_val(rnode) = LEFT;
-
-
- caml_modify(&Field(Field(Field(document,0),FATHER),0),NIL);
- Tag_val(document) = NODE;
-
- CAMLreturn0;
-
-
-}
-value OCamlStorageInterface::getDocument (){
- CAMLparam0();
- CAMLlocal1(doc);
- doc = document;
- caml_remove_global_root(&document);
- CAMLreturn(doc);
-}
-void *OCamlStorageInterface::returnDocument(){
-
- return ((void *) getDocument());
-
-}