8 type node = [ `Grammar ] Node.t
10 type p_type = [ `Parameter ]
11 type n_type = [ `NonTerminal ]
12 type t_type = [ `Terminal ]
13 type any_type = [ p_type | n_type | t_type ]
14 type symbol = [ any_type ] Node.t
16 type p_symbol = p_type Node.t
17 type n_symbol = n_type Node.t
18 type t_symbol = t_type Node.t
19 type tn_symbol = [ n_type | t_type ] Node.t
21 type partial = Node of tn_symbol * partial array | Leaf of node
26 external is_nil : t -> t_symbol -> bool = "caml_grammar_is_nil"
27 external get_tag : t -> t_symbol -> string = "caml_grammar_get_tag"
29 external get_symbol_at : t -> symbol -> node -> symbol = "caml_grammar_get_symbol_at"
30 external first_child : t -> symbol -> node -> node = "caml_grammar_first_child"
31 external next_sibling : t -> symbol -> node -> node = "caml_grammar_next_sibling"
34 let is_non_terminal (n : [< any_type ] Node.t) =
35 let n = Node.to_int n in
38 let is_terminal (n : [< any_type ] Node.t) =
39 let n = Node.to_int n in
42 let is_parameter (n : [< any_type ] Node.t) =
43 let n = Node.to_int n in
47 external parameter : [< any_type ] Node.t -> p_symbol = "%identity"
48 external terminal : [< any_type ] Node.t -> t_symbol = "%identity"
49 external non_terminal : [< any_type ] Node.t -> n_symbol = "%identity"
51 external get_id1 : t -> n_symbol -> tn_symbol = "caml_grammar_get_id1"
52 external get_id2 : t -> n_symbol -> tn_symbol = "caml_grammar_get_id2"
53 external get_param_pos : t -> n_symbol -> int = "caml_grammar_get_param_pos"
56 let num_params (n : n_symbol) =
57 let n = Node.to_int n in
60 let num_children (n : [< t_type | n_type ] Node.t ) =
61 if is_non_terminal n then
62 num_params (non_terminal n)
67 external load : Unix.file_descr -> bool -> t = "caml_grammar_load"
70 let start_symbol = (Node.of_int 0) in
71 let dummy_leaf = Leaf (Node.nil) in
72 let rec start_loop idx =
73 TRACE("grammar", 2, __ "start_loop %a\n%!" Node.print idx);
74 if idx >= Node.null then begin
75 let symbol = get_symbol_at g start_symbol idx in
76 if is_terminal symbol then
77 let () = ();TRACE("grammar", 2, __ "Symbol %a is terminal\n%!" Node.print symbol); in
78 let ts = terminal symbol in
79 if is_nil g ts then (TRACE("grammar", 2, __ "Symbol %a is nil\n%!" Node.print symbol)) else
80 (* let str = get_tag g ts in
81 Printf.printf "<%s>%!" str; *)
82 let fs = first_child g start_symbol idx in
84 start_loop (next_sibling g start_symbol fs);
85 (* Printf.printf "</%s>%!" str; *)
87 let tn = non_terminal symbol in
88 let nparam = num_params tn in
89 let child = ref (first_child g start_symbol idx) in
90 let a_param = Array.init nparam
91 (fun _ -> let c = !child in
92 child := next_sibling g start_symbol c;
98 and rule_loop (t : n_symbol) a_param =
99 TRACE("grammar", 2, __ "rule_loop %a, (%i) \n%!" Node.print t (Array.length a_param));
100 let id1 = get_id1 g t in
101 let id2 = get_id2 g t in
102 let param_pos = get_param_pos g t in
103 let nparam1 = num_children id1 in
104 let nparam2 = if is_terminal id2 && is_nil g (terminal id2) then 0 else num_children id2 in
105 let a_param1 = Array.create nparam1 dummy_leaf in
106 let a_param2 = Array.create nparam2 dummy_leaf in
107 let i = param_pos - 2 in
108 TRACE("grammar", 2, __ "id1: %i, id2: %i, param_pos: %i, nparam1: %i, nparam2: %i, i: %i\n%!"
109 (Node.to_int id1) (Node.to_int id2) param_pos nparam1 nparam2 i);
111 TRACE("grammar", 2, __ "blit a(%i) %i b(%i) %i %i\n%!"
112 (Array.length a_param) 0 (Array.length a_param1) 0 (i+1));
114 Array.blit a_param 0 a_param1 0 (i+1); (* Pass parameters before id2 *)
115 a_param1.(i+1) <- Node(id2, a_param2); (* id2( ... ) *)
117 TRACE("grammar", 2, __ "blit a(%i) %i b(%i) %i %i\n%!"
118 (Array.length a_param) (i + nparam2 + 1) (Array.length a_param1) (i+2) (nparam1 - i - 2));
119 Array.blit a_param (i + nparam2 + 1) a_param1 (i+2) (nparam1 - i - 2); (* Pass parameters after id2 *)
123 TRACE("grammar", 2, __ "blit a(%i) %i b(%i) %i %i\n\n\n%!"
124 (Array.length a_param) (i + 1) (Array.length a_param2) 0 (nparam2));
125 Array.blit a_param (i + 1) a_param2 0 nparam2; (* parameters below id2 *)
126 if is_non_terminal id1 then
127 let id1 = non_terminal id1 in
128 rule_loop id1 a_param1
130 let id1 = terminal id1 in
131 terminal_loop id1 a_param1
133 and terminal_loop (t : t_symbol) a_param =
134 if is_nil g t then () else begin
135 (* let str = get_tag g t in *)
136 (* Printf.printf "<%s>%!" str; *)
137 partial_loop a_param.(0);
138 partial_loop a_param.(1)
139 (* Printf.printf "</%s>%!" str *)
141 and partial_loop = function
142 | Leaf id -> start_loop id
143 | Node (id, a_param) ->
144 if is_terminal id then terminal_loop (terminal id) a_param
145 else rule_loop (non_terminal id) a_param
148 start_loop (Node.null)
153 let load filename bp =
154 let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0o600 in
157 | e -> (Unix.close fd; raise e)