From a31b1c91de4e8a984e85c6ca1bc917f26fd334f3 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= Date: Wed, 22 Feb 2012 10:14:21 +0100 Subject: [PATCH] Various fixes to the old grammar interface --- src/grammar.ml | 102 ++++++------------------------------------------ src/grammar.mli | 13 +++--- 2 files changed, 21 insertions(+), 94 deletions(-) diff --git a/src/grammar.ml b/src/grammar.ml index bca97aa..e209281 100644 --- 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 "%!" 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 "%!" 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 --- 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 -- 2.17.1