OCamlStorageInterface.cpp

   1 /*******************************************
   2  * OCamlStorageInterface.cpp
   3  * ------------------------
   4  *
   5  *
   6  * Author: Kim Nguyen
   7  * Date: 04/11/08
   8  */
   9
  10
  11 #include "OCamlStorageInterface.h"
  12 #include "Utils.h"
  13
  14 /* see caml/mlvalues.h
  15  */
  16 /* tags */
  17 #define NODE 0
  18 #define STRING 1
  19
  20 /* fields */
  21 #define PCDATA 0
  22 #define ID 0
  23 #define TAG 1
  24 #define LEFT 2
  25 #define RIGHT 3
  26 #define FATHER 4
  27
  28 #define NIL (Val_unit)
  29
  30 /* The OCaml function which computes the hash value of a tag */
  31 static value *caml_hash_tag = NULL;
  32
  33 OCamlStorageInterface::OCamlStorageInterface()
  34 {
  35   CAMLparam0();
  36   CAMLlocal4(node,nodeptr,dummytag,father);
  37   nodeid=1;
  38   if (caml_hash_tag == NULL) {
  39     /* First time around, look up by name */
  40     caml_hash_tag = caml_named_value("caml_hash_tag");
  41
  42   }
  43
  44   dummytag = caml_callback(*caml_hash_tag, caml_copy_string(""));
  45
  46   // Atomic block, initialize must be called for every field
  47   // Before any other allocation takes place. In particular,
  48   // One should NOT place the call to caml_callback as an argument to
  49   // caml_initialize but rather store its result in a variable.
  50   father = caml_alloc_shr(1,0);
  51   caml_initialize(&Field(father,0),NIL);
  52
  53   node = caml_alloc_shr(5,0);
  54   caml_initialize(&Field(node,ID),Val_int(nodeid++));
  55   caml_initialize(&Field(node,TAG),dummytag);
  56   caml_initialize(&Field(node,LEFT),NIL);
  57   caml_initialize(&Field(node,RIGHT),NIL);
  58   caml_initialize(&Field(node,FATHER),father);
  59
  60   nodeptr = caml_alloc_shr(1,LEFT);
  61   caml_initialize(&Field(nodeptr,0),node);
  62
  63   stack.push_front(nodeptr);
  64   caml_register_global_root(&stack.front());
  65
  66   CAMLreturn0;
  67 }
  68
  69 OCamlStorageInterface::~OCamlStorageInterface()
  70 {
  71   caml_remove_global_root(&stack.back());
  72 }
  73
  74 void OCamlStorageInterface::newChild(string name)
  75 {
  76   CAMLparam0();
  77   CAMLlocal5(nnode,onode,tag,taghash,id);
  78   CAMLlocal3(father,nnodeptr,onodeptr);
  79   DPRINT("newChild " << name <<"\n")
  80   onode = stack.front();
  81   /* Allocate the new Node(tag,l,r) */
  82
  83   /* Compute the new tag hash and store it in the new block */
  84   tag = caml_copy_string(name.c_str());
  85   taghash = caml_callback(*caml_hash_tag, tag);
  86   id = Val_int(nodeid++);
  87
  88   /* Again, initialization must be atomic */
  89   father=caml_alloc_shr(1,0);
  90   caml_initialize(&Field(father,0),onode);
  91
  92   nnode = caml_alloc_shr(5,0);
  93   caml_initialize(&Field(nnode,ID),id);
  94   caml_initialize(&Field(nnode,TAG),taghash);
  95   caml_initialize(&Field(nnode,LEFT),NIL);
  96   caml_initialize(&Field(nnode,RIGHT),NIL);
  97   caml_initialize(&Field(nnode,FATHER),father);
  98
  99   nnodeptr = caml_alloc_shr(1,LEFT);
 100   caml_initialize(&Field(nnodeptr,0),nnode);
 101
 102   switch (Tag_val(onode)){
 103   case LEFT:
 104     caml_modify(&Field(Field(onode,0),LEFT),nnodeptr);
 105     Tag_val(onode) = RIGHT;
 106     break;
 107
 108   case RIGHT:
 109     caml_modify(&Field(Field(onode,0),RIGHT),nnodeptr);
 110     Tag_val(onode) = NODE;
 111     break;
 112   };
 113
 114   stack.push_front(nnodeptr);
 115
 116   CAMLreturn0;
 117 }
 118
 119
 120
 121 void OCamlStorageInterface::newText(string text)
 122 {
 123   CAMLparam0();
 124   CAMLlocal3(pcdata,snode,node);
 125   DPRINT("newText " << text <<"\n")
 126
 127   pcdata = caml_copy_string(text.c_str());
 128   snode = caml_alloc_shr(1,STRING);
 129   caml_initialize(&(Field(snode,PCDATA)),pcdata);
 130   node = stack.front();
 131
 132   switch (Tag_val(node)){
 133   case LEFT:
 134     caml_modify(&Field(Field(node,0),LEFT),snode);
 135     Tag_val(node) = RIGHT;
 136     break;
 137   case RIGHT:
 138     caml_modify(&Field(Field(node,0),RIGHT),snode);
 139     Tag_val(node) = NODE;
 140     break;
 141
 142
 143   };
 144
 145   CAMLreturn0;
 146 }
 147
 148
 149
 150 void OCamlStorageInterface::nodeFinished()
 151 {
 152
 153   CAMLparam0();
 154   CAMLlocal1(node);
 155   DPRINT("nodeFinished\n")
 156   node = stack.front();
 157
 158   switch (Tag_val(node)){
 159   case LEFT:
 160     DPRINT("Tagged left\n")
 161     Tag_val(node) = RIGHT;
 162     break;
 163
 164   case RIGHT:
 165     DPRINT("Tagged right\n")
 166     Tag_val(node) = NODE;
 167
 168   case NODE:
 169     DPRINT("Under NODE\n");
 170     while (Tag_val(node) == NODE){
 171       stack.pop_front();
 172       node = stack.front();
 173     };
 174     break;
 175   };
 176
 177   CAMLreturn0;
 178 }
 179
 180   void OCamlStorageInterface::parsingFinished()
 181 {
 182   CAMLparam0();
 183   CAMLlocal1(rnode);
 184   caml_register_global_root(&document);
 185   document = stack.front();
 186
 187   stack.pop_front(); /* removes the root */
 188   rnode = stack.front();
 189
 190   DPRINT ("Stack size is "<< stack.size() <<"\n")
 191   /* reinitializes the stack */
 192   caml_modify(&Field(Field(rnode,0),ID),Val_int(nodeid=1));
 193   caml_modify(&Field(Field(rnode,0),LEFT),NIL);
 194   caml_modify(&Field(Field(rnode,0),RIGHT),NIL);
 195   caml_modify(&Field(Field(Field(rnode,0),FATHER),0),NIL);
 196   Tag_val(rnode) = LEFT;
 197
 198
 199   caml_modify(&Field(Field(Field(document,0),FATHER),0),NIL);
 200   Tag_val(document) = NODE;
 201
 202   CAMLreturn0;
 203
 204
 205 }
 206 value OCamlStorageInterface::getDocument (){
 207   CAMLparam0();
 208   CAMLlocal1(doc);
 209   doc = document;
 210   caml_remove_global_root(&document);
 211   CAMLreturn(doc);
 212 }
 213 void *OCamlStorageInterface::returnDocument(){
 214
 215   return ((void *) getDocument());
 216
 217 }