+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 partial = Node of n_symbol * partial array | Leaf of node
+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 get_tag : t -> t_symbol -> string = "caml_grammar_get_tag"
+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 : 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"
+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
-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
-let traversal g =
- let start_symbol = (Node.of_int 0) in
- let rec start_loop idx =
- if idx >= Node.null then begin
- let symbol = get_symbol_at g start_symbol idx in
- if is_terminal symbol then
- 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;
- 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;
- c)
- in
- rule_loop tn a_param
- end
- and rule_loop (nterm : [ `NonTerminal | `Terminal ] Node.t) a_param =
- let
-
- in
- start_loop (Node.of_int 0)
-;;
+external load : Unix.file_descr -> bool -> t = "caml_grammar_load"
let load filename bp =
| e -> (Unix.close fd; raise e)
in
Unix.close fd;
+ Tag.init (tag_operations g);
g