Various fixes to the old grammar interface

[SXSI/xpathcomp.git] / src / grammar.ml

diff --git a/src/grammar.ml b/src/grammar.ml
index 6537cb2..e209281 100644 (file)
--- a/src/grammar.ml
+++ b/src/grammar.ml
@@ -1,7 +1,96 @@
+INCLUDE "utils.ml"
+INCLUDE "debug.ml"
+INCLUDE "trace.ml"
+
+
 type t
 
+type node = [ `Grammar ] 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 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 =
+    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"
+
+
+
+let tag_operations t = {
+  Tag.tag = (fun s -> register_tag t s);
+  Tag.to_string = (fun s -> to_string t s);
+  Tag.translate = (fun s -> translate_tag t s);
+}
+
+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"
+
+
+let is_non_terminal (n : [< any_type ] Node.t) =
+  let n = Node.to_int n in
+  n land 3 == 0
+
+let is_terminal (n : [< any_type ] Node.t) =
+  let n = Node.to_int n in
+  n land 3 == 1
+
+let is_parameter (n : [< any_type ] Node.t) =
+  let n = Node.to_int n in
+  n land 3 == 2
+
+
+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"
+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 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
+  (n lsr 2) land 0xf
+
+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 load filename bp =
   let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0o600 in
   let g =
@@ -9,5 +98,7 @@ let load filename bp =
     | e -> (Unix.close fd; raise e)
   in
   Unix.close fd;
+  Tag.init (tag_operations g);
   g
 
+