Finished fixing the pre-order traversal of the grammar.

diff --git a/src/OCamlDriver.cpp b/src/OCamlDriver.cpp
index 0f15f49..7a12c7f 100644 (file)
--- a/src/OCamlDriver.cpp
+++ b/src/OCamlDriver.cpp
@@ -920,7 +920,6 @@ extern "C" value caml_grammar_get_symbol_at(value grammar, value symbol, value p
 {
   CAMLparam3(grammar, symbol, preorder);
   CAMLreturn(Val_long(GRAMMAR(grammar)->getSymbolAt(Long_val(symbol), Int_val(preorder))));
-
 }
 
 extern "C" value caml_grammar_first_child(value grammar, value rule, value pos)
@@ -949,3 +948,21 @@ extern "C" value caml_grammar_get_tag(value grammar, value symbol)
   res = caml_copy_string(s);
   CAMLreturn(res);
 }
+
+extern "C" value caml_grammar_get_id1(value grammar, value rule)
+{
+  CAMLparam1(grammar);
+  CAMLreturn(Val_long(GRAMMAR(grammar)->getID1(Long_val(rule))));
+}
+
+extern "C" value caml_grammar_get_id2(value grammar, value rule)
+{
+  CAMLparam1(grammar);
+  CAMLreturn(Val_long(GRAMMAR(grammar)->getID2(Long_val(rule))));
+}
+
+extern "C" value caml_grammar_get_param_pos(value grammar, value rule)
+{
+  CAMLparam1(grammar);
+  CAMLreturn(Val_int(GRAMMAR(grammar)->getParamPos(Long_val(rule))));
+}

diff --git a/src/grammar.ml b/src/grammar.ml
index 7795150..03e9544 100644 (file)
--- a/src/grammar.ml
+++ b/src/grammar.ml
@@ -1,13 +1,24 @@
+INCLUDE "utils.ml"
+INCLUDE "debug.ml"
+INCLUDE "trace.ml"
+
+
 type t
 
 type node = [ `Grammar ] Node.t
-type symbol = [ `Terminal | `NonTerminal | `Parameter ] Node.t
 
-type p_symbol = [ `Parameter ] Node.t
-type n_symbol = [ `NonTerminal ] Node.t
-type t_symbol = [ `Terminal ] Node.t
+type p_type  = [ `Parameter ]
+type n_type = [ `NonTerminal ]
+type t_type = [ `Terminal ]
+type any_type = [ p_type | n_type | t_type ]
+type symbol = [ any_type ] Node.t
 
-type partial = Node of n_symbol * partial array | Leaf of node
+type p_symbol = p_type Node.t
+type n_symbol = n_type Node.t
+type t_symbol = t_type Node.t
+type tn_symbol = [ n_type | t_type ] Node.t
+
+type partial = Node of tn_symbol * partial array | Leaf of node
 
 
 
@@ -20,45 +31,58 @@ external first_child : t -> symbol -> node -> node = "caml_grammar_first_child"
 external next_sibling : t -> symbol -> node -> node = "caml_grammar_next_sibling"
 
 
-let is_non_terminal (n : symbol) =
+let is_non_terminal (n : [< any_type ] Node.t) =
   let n = Node.to_int n in
   n land 3 == 0
 
-let is_terminal (n : symbol) =
+let is_terminal (n : [< any_type ] Node.t) =
   let n = Node.to_int n in
   n land 3 == 1
 
-let is_parameter (n : symbol) =
+let is_parameter (n : [< any_type ] Node.t) =
   let n = Node.to_int n in
   n land 3 == 2
 
 
-external parameter : symbol -> p_symbol = "%identity"
-external terminal : symbol -> t_symbol = "%identity"
-external non_terminal : symbol -> n_symbol = "%identity"
+external parameter : [< any_type ] Node.t -> p_symbol = "%identity"
+external terminal : [< any_type ] Node.t -> t_symbol = "%identity"
+external non_terminal : [< any_type ] Node.t -> n_symbol = "%identity"
+
+external get_id1 : t -> n_symbol -> tn_symbol = "caml_grammar_get_id1"
+external get_id2 : t -> n_symbol -> tn_symbol = "caml_grammar_get_id2"
+external get_param_pos : t -> n_symbol -> int = "caml_grammar_get_param_pos"
 
 
 let num_params (n : n_symbol) =
   let n = Node.to_int n in
   (n lsr 2) land 0xf
 
-external load : Unix.file_descr -> bool -> t = "caml_grammar_load"
+let num_children (n : [< t_type | n_type ] Node.t ) =
+  if is_non_terminal n then
+    num_params (non_terminal n)
+  else
+    2
 
 
+external load : Unix.file_descr -> bool -> t = "caml_grammar_load"
 
 let traversal g =
   let start_symbol = (Node.of_int 0) in
+  let dummy_leaf = Leaf (Node.nil) in
   let rec start_loop idx =
+    TRACE("grammar", 2, __ "start_loop %a\n%!" Node.print idx);
     if idx >= Node.null then begin
       let symbol = get_symbol_at g start_symbol idx in
       if is_terminal symbol then
+       let () = ();TRACE("grammar", 2, __ "Symbol %a is terminal\n%!" Node.print symbol); in
        let ts = terminal symbol in
-       if is_nil g ts then () else
-         let str = get_tag g ts in
-         Printf.printf "<%s>%!" str;
-         start_loop (first_child g start_symbol idx);
-         start_loop (next_sibling g start_symbol idx);
-         Printf.printf "</%s>%!" str;
+       if is_nil g ts then (TRACE("grammar", 2, __ "Symbol %a is nil\n%!" Node.print symbol)) else
+(*       let str = get_tag g ts in
+         Printf.printf "<%s>%!" str; *)
+         let fs = first_child g start_symbol idx in
+         start_loop fs;
+         start_loop (next_sibling g start_symbol fs);
+(*       Printf.printf "</%s>%!" str; *)
       else
        let tn = non_terminal symbol in
        let nparam = num_params tn in
@@ -66,15 +90,62 @@ let traversal g =
        let a_param = Array.init nparam
          (fun _ -> let c = !child in
                    child := next_sibling g start_symbol c;
-                   c)
+                   Leaf c)
        in
        rule_loop tn a_param
     end
-  and rule_loop (nterm : [ `NonTerminal | `Terminal ] Node.t)  a_param =
-    let 
 
+  and rule_loop (t : n_symbol) a_param =
+    TRACE("grammar", 2, __ "rule_loop %a, (%i) \n%!" Node.print t (Array.length a_param));
+    let id1 = get_id1 g t in
+    let id2 = get_id2 g t in
+    let param_pos = get_param_pos g t in
+    let nparam1 = num_children id1 in
+    let nparam2 = if is_terminal id2 && is_nil g (terminal id2) then 0 else num_children id2 in
+    let a_param1 = Array.create nparam1 dummy_leaf in
+    let a_param2 = Array.create nparam2 dummy_leaf in
+    let i = param_pos - 2 in
+    TRACE("grammar", 2, __ "id1: %i, id2: %i, param_pos: %i, nparam1: %i, nparam2: %i, i: %i\n%!"
+      (Node.to_int id1) (Node.to_int id2) param_pos nparam1 nparam2 i);
+
+    TRACE("grammar", 2, __ "blit a(%i) %i b(%i) %i %i\n%!"
+      (Array.length a_param) 0 (Array.length a_param1) 0 (i+1));
+
+    Array.blit a_param 0 a_param1 0 (i+1);  (* Pass parameters before id2 *)
+    a_param1.(i+1) <- Node(id2, a_param2);  (* id2( ... ) *)
+
+    TRACE("grammar", 2, __ "blit a(%i) %i b(%i) %i %i\n%!"
+      (Array.length a_param) (i + nparam2 + 1) (Array.length a_param1) (i+2) (nparam1 - i - 2));
+    Array.blit a_param (i + nparam2 + 1) a_param1 (i+2) (nparam1 - i - 2); (* Pass parameters after id2 *)
+
+
+
+    TRACE("grammar", 2, __ "blit a(%i) %i b(%i) %i %i\n\n\n%!"
+      (Array.length a_param) (i + 1) (Array.length a_param2) 0 (nparam2));
+    Array.blit a_param (i + 1) a_param2 0 nparam2; (* parameters below id2 *)
+    if is_non_terminal id1 then
+      let id1 = non_terminal id1 in
+      rule_loop id1 a_param1
+    else
+      let id1 = terminal id1 in
+      terminal_loop id1 a_param1
+
+  and terminal_loop (t : t_symbol) a_param =
+    if is_nil g t then () else begin
+(*      let str = get_tag g t in *)
+(*      Printf.printf "<%s>%!" str; *)
+      partial_loop a_param.(0);
+      partial_loop a_param.(1)
+(*      Printf.printf "</%s>%!" str *)
+    end
+  and partial_loop = function
+    | Leaf id -> start_loop id
+    | Node (id, a_param) ->
+      if is_terminal id then terminal_loop (terminal id) a_param
+      else rule_loop (non_terminal id) a_param
   in
-  start_loop (Node.of_int 0)
+
+  start_loop (Node.null)
 ;;
 
 
@@ -86,6 +157,7 @@ let load filename bp =
     | e -> (Unix.close fd; raise e)
   in
   Unix.close fd;
+  traversal g;
   g