parse_env.ml 9 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
(*-----------------------------------------------------------------------
** Copyright (C) 2001 - Verimag.
** This file may only be copied under the terms of the GNU Library General
** Public License 
**-----------------------------------------------------------------------
**
** File: parse_env.ml
** Main author: jahier@imag.fr
*)

open Formula

  
type read_arc = Arc of node * arc_info * node

type read_automata = Automata of 
17
  node        (* Initial node *)
18
19
20
  * vnt list  (* Input var list *)
  * vnt list  (* Output var list *)
  * vnt list  (* Local var list *)
21
22
  * vne list  (* pre var list of expression *)
  * vnf list  (* pre var list of formula *)
23
24
25
26
27
28
29
30
31
32
33
  * read_arc list  (* Transition list *)

(* Keywords of the automata format *)
let lexer = Genlex.make_lexer ["automata"; "["; "]"; "("; ")"; ","; ":"; ";";
			       "arc"; "eps"; "pre";
			       "And"; "Or"; "Not"; "true"; "false";
			       "="; ">"; ">=";
			       "+"; "-"; "*"; "/"; "mod"; "%"]

type aut_token = Genlex.token Stream.t

34
35
36
37
38
39
40
41
42
43
44
45
let print_genlex_token = 
  fun tok -> 
    let _ =
      match tok with
	  Genlex.Kwd(str)    -> print_string str
	| Genlex.Ident(str)  -> print_string str
	| Genlex.Int(i)      -> print_int i
	| Genlex.Float(f)    -> print_float f
	| Genlex.String(str) -> print_string str
	| Genlex.Char(c)     -> print_char c  
    in
      print_string " "
46

47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
let debug_parsing = false

let print_err_msg tok_list func =
  if debug_parsing then
    begin
      print_string ("* Parse error in " ^ func ^ ".\n\t\t\t\t");
      print_string ("The next 10 tokens are:\t``");
      List.iter (print_genlex_token) tok_list ;
      print_string ("''\n");
      flush stdout
    end 
  else ()
  

(** Parsing lists *)
62
63
64
let rec
  (parse_list: (aut_token -> 'a) -> aut_token -> 'a list) = 
  fun parse tok -> 
65
66
67
68
69
70
71
72
73
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
            [< vnt = parse ; tail = (parse_list_var_tail (parse)) >]
	    -> vnt :: tail  
	  | [< >] -> [] (* empty list *)
	with e ->
	  print_err_msg tok_list "parse_list";
	  raise e
74
75
and (parse_list_var_tail: (aut_token -> 'a) -> aut_token -> 'a list) = 
  fun parse tok -> 
76
77
78
79
80
81
82
83
84
85
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser 
	  | [< 'Genlex.Kwd ";" ; a = parse ;
	       tail = (parse_list_var_tail (parse)) >]
	    -> a :: tail  
	  | [< >] -> [] (* end of the list *)
	with e ->
	  print_err_msg tok_list "parse_list_var_tail";
	  raise e
86
87
88



89
90
let rec (parse_automata: aut_token -> read_automata) = 
  fun tok -> 
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd "automata" ;
	       'Genlex.Kwd "(" ; 
	       'Genlex.Int node_id ; 'Genlex.Kwd "," ;
	       'Genlex.Kwd "[" ; li = parse_list_var ; 'Genlex.Kwd "]" ; 
	       'Genlex.Kwd "," ;
	       'Genlex.Kwd "[" ; lo = parse_list_var ; 'Genlex.Kwd "]" ; 
	       'Genlex.Kwd "," ;
	       'Genlex.Kwd "[" ; ll = parse_list_var ; 'Genlex.Kwd "]" ; 
	       'Genlex.Kwd "," ;
	       'Genlex.Kwd "[" ; lpe = parse_list_pre_expr ; 'Genlex.Kwd "]" ; 
	       'Genlex.Kwd "," ;
	       'Genlex.Kwd "[" ; lpf = parse_list_pre_form ; 'Genlex.Kwd "]" ; 
	       'Genlex.Kwd "," ;
	       'Genlex.Kwd "[" ; la = parse_list_arc ; 'Genlex.Kwd "]" ;
	       'Genlex.Kwd ")" >] 
            -> Automata(node_id, li, lo, ll, lpe, lpf, la)
	with e ->
	  print_err_msg tok_list "parse_automata";
	  raise e
	    
114

115
116
and (parse_list_var: aut_token -> vnt list) = 
  fun tok -> 
117
118
119
120
121
122
    let tok_list = Stream.npeek 10 tok in
      try
	parse_list (parse_var) tok
      with e ->
	print_err_msg tok_list "parse_list_var" ;
	raise e
123
124
and (parse_var: aut_token -> vnt) = 
  fun tok -> 
125
126
127
128
129
130
131
132
133
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd "("; 'Genlex.Ident var; 'Genlex.Kwd ","; 
	       'Genlex.Ident typ ; 'Genlex.Kwd ")" >]
	    -> (var, typ)
	with e ->
	  print_err_msg tok_list "parse_var" ;
	  raise e
134

135
and (parse_list_pre_expr: aut_token -> vne list) = 
136
  fun tok -> 
137
138
139
140
141
142
    let tok_list = Stream.npeek 10 tok in
      try
	parse_list (parse_pre_expr) tok
      with e ->
	print_err_msg tok_list "parse_list_pre_expr" ;
	raise e
143
and (parse_pre_expr: aut_token -> vne) = 
144
  fun tok -> 
145
146
147
148
149
150
151
152
153
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd "("; 'Genlex.Ident var; 'Genlex.Kwd ","; 
	       e = parse_expr ; 'Genlex.Kwd ","; init = parse_expr ; 'Genlex.Kwd ")" >]
	    -> (var, (e, init))
	with e ->
	  print_err_msg tok_list "parse_pre_expr" ;
	  raise e
154
155
156

and (parse_list_pre_form: aut_token -> vnf list) = 
  fun tok -> 
157
158
159
160
161
162
    let tok_list = Stream.npeek 10 tok in
      try
	parse_list (parse_pre_form) tok
      with e ->
	  print_err_msg tok_list "parse_list_pre_form" ;
	raise e
163
164
and (parse_pre_form: aut_token -> vnf) = 
  fun tok -> 
165
166
167
168
169
170
171
172
173
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd "("; 'Genlex.Ident var; 'Genlex.Kwd ","; 
	       f = parse_formula ; 'Genlex.Kwd ","; init = parse_formula; 'Genlex.Kwd ")" >]
	    -> (var, (f, init))
	with e ->
	  print_err_msg tok_list "parse_pre_form" ;
	  raise e
174
175
176
177


and (parse_list_arc: aut_token -> read_arc list) = 
  fun tok -> 
178
179
180
181
182
183
    let tok_list = Stream.npeek 10 tok in
      try
	parse_list (parse_arc) tok
      with e ->
	print_err_msg tok_list "parse_list_arc" ;
	raise e
184
185
and (parse_arc: aut_token -> read_arc) = 
  fun tok -> 
186
187
188
189
190
191
192
193
194
195
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd "arc"; 'Genlex.Kwd "("; 'Genlex.Int node_from ; 
	       'Genlex.Kwd ","; arc_info = parse_arc_info ; 
	       'Genlex.Kwd "," ; 'Genlex.Int node_to ; 'Genlex.Kwd ")";  >]
	    -> Arc(node_from, arc_info, node_to)
	with e ->
	  print_err_msg tok_list "parse_arc" ;
	  raise e
196
197
and (parse_arc_info: aut_token -> arc_info) = 
  fun tok -> 
198
199
200
201
202
203
204
205
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Int weigth ; 'Genlex.Kwd ":"; expr = parse_formula_eps >] 
	    -> (weigth, expr)
	with e ->
	  print_err_msg tok_list "parse_arc_info" ;
	  raise e
206
207
208

and (parse_formula_eps: aut_token -> formula_eps) = 
  fun tok -> 
209
210
211
212
213
214
215
216
217
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser   
	    [< 'Genlex.Kwd "eps" >] -> Eps
	  | [< f = parse_formula >] -> Form(f)
	with e ->
	  print_err_msg tok_list "parse_formula_eps" ;
	  raise e
	    
218
219
and (parse_formula: aut_token -> formula) = 
  fun tok -> 
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd "Not"; f1 = parse_formula ; 
	       f = parse_more_formula (Not(f1)) >] -> f  
	  | [< 'Genlex.Kwd "("; f1 = parse_formula; 'Genlex.Kwd ")" ; 
	       f = parse_more_formula f1 >] -> f 
	  | [< 'Genlex.Kwd "true" ; f = parse_more_formula True >] -> f
	  | [< 'Genlex.Kwd "false" ; f = parse_more_formula False >] -> f
	  | [< 'Genlex.Ident b ; f = parse_more_formula (Bvar(b)) >] -> f
	  | [< e1 = parse_expr; f1 = parse_expr_right e1 ; 
	       f = parse_more_formula f1 >] -> f
	with e ->
	  print_err_msg tok_list "parse_formula" ;
	  raise e
235
236
237

and (parse_more_formula: formula -> aut_token -> formula) = 
  fun f1 tok -> 
238
239
240
241
242
243
244
245
246
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd "Or";  f2 = parse_formula >] -> Or(f1, f2)
	  | [< 'Genlex.Kwd "And"; f2 = parse_formula >] -> And(f1, f2) 
	  | [< >] -> f1
	with e ->
	  print_err_msg tok_list "parse_more_formula" ;
	  raise e
247
248
and (parse_expr_right : expr -> aut_token -> formula) = 
  fun e1 tok -> 
249
250
251
252
253
254
255
256
257
258
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser
	    [< 'Genlex.Kwd "=";  e2 = parse_expr >] -> Eq(e1, e2) 
	  | [< 'Genlex.Kwd ">";  e2 = parse_expr >] -> G(e1, e2) 
	  | [< 'Genlex.Kwd ">="; e2 = parse_expr >] -> Ge(e1, e2)
	with e ->
	  print_err_msg tok_list "parse_expr_rigth" ;
	  raise e
	    
259
260

(* 
261
262
263
 ** The following is copy-paste-adapted from sec 1.8 of the ocaml ref man 
 ** untitled ``pretty printing and parsing''.
 *)
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
and (parse_expr: aut_token -> expr) = 
  fun tok -> 
    match tok with parser  
	[< e1 = parse_mult; e = parse_more_adds e1 >] -> e
and (parse_more_adds: expr -> aut_token -> expr) = 
  fun e1 tok -> 
    match tok with parser  
	[< 'Genlex.Kwd "+"; e2 = parse_mult; 
	   e = parse_more_adds (Sum(e1, e2)) >] -> e
      | [< 'Genlex.Kwd "-"; e2 = parse_mult; 
	   e = parse_more_adds (Diff(e1, e2)) >] -> e
      | [<  >] -> e1
and (parse_mult: aut_token -> expr) = 
  fun tok -> 
    match tok with parser  
	[< e1 = parse_simple; e = parse_more_mults e1 >] -> e
and (parse_more_mults: expr -> aut_token -> expr) = 
  fun e1 tok -> 
    match tok with parser  
	[< 'Genlex.Kwd "*";   e2 = parse_simple; 
	   e = parse_more_mults (Prod(e1, e2)) >] -> e
      | [< 'Genlex.Kwd "/";   e2 = parse_simple; 
	   e = parse_more_mults (Quot(e1, e2)) >] -> e
      | [< 'Genlex.Kwd "mod"; e2 = parse_simple; 
	   e = parse_more_mults (Mod(e1, e2)) >] -> e
      | [<  >] -> e1
and (parse_simple: aut_token -> expr) = 
  fun tok -> 
    match tok with parser  
293
294
295
	[< 'Genlex.Ident s >] -> Nvar(s)
      | [< 'Genlex.Int i >]   -> Ival(i)
      | [< 'Genlex.Float f >] -> Fval(f)
296
297
      | [< 'Genlex.Kwd "("; e = parse_expr; 'Genlex.Kwd ")" >] -> e