Various fixes to the old grammar interface

diff --git a/src/grammar.ml b/src/grammar.ml
index bca97aa..e209281 100644 (file)
--- a/src/grammar.ml
+++ b/src/grammar.ml
@@ -18,12 +18,13 @@ 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
-
-
+type partial =
+    Leaf of node
+  | Node of tn_symbol * partial array
 
 
 external is_nil : t -> t_symbol -> bool = "caml_grammar_is_nil"
+external nil_symbol : t -> t_symbol = "caml_grammar_nil_id"
 external translate_tag : t -> Tag.t -> Tag.t = "caml_grammar_translate_tag"
 external to_string : t -> Tag.t -> string = "caml_grammar_get_tag"
 external register_tag : t -> string -> Tag.t = "caml_grammar_register_tag"
@@ -40,6 +41,9 @@ external get_symbol_at : t -> symbol -> node -> symbol = "caml_grammar_get_symbo
 external first_child : t -> symbol -> node -> node = "caml_grammar_first_child"
 external next_sibling : t -> symbol -> node -> node = "caml_grammar_next_sibling"
 
+external start_first_child : t -> node -> node = "caml_grammar_start_first_child"
+external start_next_sibling : t -> node -> node = "caml_grammar_start_next_sibling"
+
 
 let is_non_terminal (n : [< any_type ] Node.t) =
   let n = Node.to_int n in
@@ -58,7 +62,8 @@ let symbol_tag (n : t_symbol) = (Node.to_int n) lsr 2
 ;;
 let tag = symbol_tag
 let get_tag g (n : t_symbol) = to_string g (symbol_tag n)
-
+let symbol (n : n_symbol) = ((Node.to_int n) lsr 10) land 0x7ffffff
+;;
 
 
 external parameter : [< any_type ] Node.t -> p_symbol = "%identity"
@@ -67,8 +72,10 @@ 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"
-
+(*external get_param_pos : t -> n_symbol -> int = "caml_grammar_get_param_pos" *)
+let get_param_pos (n : n_symbol) =
+  let n = Node.to_int n in
+  (n lsr 6) land 0xf
 
 let num_params (n : n_symbol) =
   let n = Node.to_int n in
@@ -83,89 +90,6 @@ let num_children (n : [< t_type | n_type ] Node.t ) =
 
 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 (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
-       let child = ref (first_child g start_symbol idx) in
-       let a_param = Array.init nparam
-         (fun _ -> let c = !child in
-                   child := next_sibling g start_symbol c;
-                   Leaf c)
-       in
-       rule_loop tn a_param
-    end
-
-  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.null)
-;;
-
-
 
 let load filename bp =
   let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0o600 in

diff --git a/src/grammar.mli b/src/grammar.mli
index 5d5e8ab..dcf0067 100644 (file)
--- a/src/grammar.mli
+++ b/src/grammar.mli
@@ -13,9 +13,9 @@ 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
-
-
+type partial =
+ | Leaf of node
+ | Node of tn_symbol * partial array
 
 
 val is_terminal : [< any_type ] Node.t -> bool
@@ -25,19 +25,22 @@ val is_parameter : [< any_type ] Node.t -> bool
 external get_symbol_at : t -> symbol -> node -> symbol = "caml_grammar_get_symbol_at"
 external first_child : t -> symbol -> node -> node = "caml_grammar_first_child"
 external next_sibling : t -> symbol -> node -> node = "caml_grammar_next_sibling"
+external start_first_child : t -> node -> node = "caml_grammar_start_first_child"
+external start_next_sibling : t -> node -> node = "caml_grammar_start_next_sibling"
 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"
+val get_param_pos : n_symbol -> int
+external nil_symbol : t -> t_symbol = "caml_grammar_nil_id"
 val num_params : n_symbol -> int
 val num_children : [< t_type | n_type ] Node.t -> int
 external is_nil : t -> t_symbol -> bool = "caml_grammar_is_nil"
 
 val tag : t_symbol -> Tag.t
+val symbol : n_symbol -> int
 val tag_operations : t -> Tag.operations
 
 
-
 val load : string -> bool -> t