parse_env.ml 11.1 KB
Newer Older
1
(*pp camlp4o *)
2
(*-----------------------------------------------------------------------
3
** Copyright (C) 2001, 2002 - Verimag.
4
5
6
7
8
9
10
11
12
13
14
15
16
17
** 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 
18
  node        (* Initial node *)
19
20
21
  * vnt list  (* Input var list *)
  * vnt list  (* Output var list *)
  * vnt list  (* Local var list *)
22
  * vnt list  (* pre var list *)
23
24
25
  * read_arc list  (* Transition list *)

(* Keywords of the automata format *)
26
let lexer = Genlex.make_lexer ["["; "]"; "("; ")"; ","; ":"; ";";
27
			       "And"; "Or"; "Not"; "true"; "false";
28
			       "="; ">"; ">="; "<"; "<=";
29
30
31
32
			       "+"; "-"; "*"; "/"; "mod"; "%"]

type aut_token = Genlex.token Stream.t

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

46
(* false by default because it produces outputs even if everything is fine *)
47
48
49
50
51
let debug_parsing = false

let print_err_msg tok_list func =
  if debug_parsing then
    begin
52
53
      print_string ("* Parse error in " ^ func ^ ". ");
      print_string ("The next 10 tokens are:\n\t");
54
      List.iter (print_genlex_token) tok_list ;
55
      print_string ("\n");
56
57
58
59
60
61
      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
    let tok_list = Stream.npeek 20 tok in
92
93
      try
	match tok with parser  
94
	    [< 'Genlex.Ident "start"; 'Genlex.Ident "node"; 'Genlex.Kwd "="; 
95
	       'Genlex.Int node_id ; 'Genlex.Kwd "," ;
96
97

	       'Genlex.Ident "input"; 'Genlex.Ident "vars"; 'Genlex.Kwd "="; 
98
99
	       'Genlex.Kwd "[" ; li = parse_list_var ; 'Genlex.Kwd "]" ; 
	       'Genlex.Kwd "," ;
100
101

	       'Genlex.Ident "output"; 'Genlex.Ident "vars"; 'Genlex.Kwd "="; 
102
	       'Genlex.Kwd "[" ; lo = parse_list_genvar ; 'Genlex.Kwd "]" ; 
103
	       'Genlex.Kwd "," ;
104
105

	       'Genlex.Ident "local"; 'Genlex.Ident "vars"; 'Genlex.Kwd "=";  
106
	       'Genlex.Kwd "[" ; ll = parse_list_genvar ; 'Genlex.Kwd "]" ; 
107
	       'Genlex.Kwd "," ;
108
109
110

	       'Genlex.Ident "pre"; 'Genlex.Ident "vars"; 'Genlex.Kwd "=";  
	       'Genlex.Kwd "[" ; lpre = parse_list_var ; 'Genlex.Kwd "]" ; 
111
	       'Genlex.Kwd "," ;
112
113
114
115
116

	       'Genlex.Ident "arcs"; 'Genlex.Kwd "="; 
	       'Genlex.Kwd "[" ; la = parse_list_arc ; 'Genlex.Kwd "]"
	    >]
            -> Automata(node_id, li, lo, ll, lpre, la)
117
118
119
120
	with e ->
	  print_err_msg tok_list "parse_automata";
	  raise e
	    
121

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
and (parse_list_genvar: aut_token -> vnt list) = 
  fun tok -> 
    let tok_list = Stream.npeek 10 tok in
      try
	parse_list (parse_genvar) tok
      with e ->
	print_err_msg tok_list "parse_list_genvar" ;
	raise e
and (parse_genvar: aut_token -> vnt) = 
  fun tok -> 
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd "("; 'Genlex.Ident var; 'Genlex.Kwd ","; 'Genlex.Ident typ ;
	       vnt = parse_type var typ >]
	    -> vnt
	with e ->
	  print_err_msg tok_list "parse_genvar" ;
	  raise e
and (parse_type:  string -> string -> aut_token -> vnt) =
  fun var typ tok -> 
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd ")" >] -> 
	      ( match typ with
		    "bool" -> (var, BoolT)
		  | "float" -> (var, FloatT(-.max_float, max_float))
		  | "int" -> (var, IntT(min_int, max_int))
		  | str -> failwith ("*** Bad type in .env: " ^ str )
	      )
	  | [< 'Genlex.Kwd ","; vnt = parse_type_more var typ >] -> vnt
	with e ->
	  print_err_msg tok_list "parse_type" ;
	  raise e
	    
and (parse_type_more:  string -> string -> aut_token -> vnt) =
  fun var typ tok -> 
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Int min; 'Genlex.Kwd ","; 'Genlex.Int max;  'Genlex.Kwd ")" >] -> 
	      ( match typ with
		    "bool" -> failwith ("*** int expected in .env" )
		  | "float" -> failwith ("*** int expected in .env " )
		  | "int" -> (var, IntT(min, max))
		  | str -> failwith ("*** Bad type in .env: " ^ str )
	      )
	  | [< 'Genlex.Float min; 'Genlex.Kwd ","; 'Genlex.Float max;  'Genlex.Kwd ")" >] -> 
	      ( match typ with
		    "bool" -> failwith ("*** float expected in .env " )
		  | "float" -> (var, FloatT(min, max))
		  | "int" -> failwith ("*** float expected in .env " )
		  | str -> failwith ("*** Bad type in .env: " ^ str )
	      )
	with e ->
	  print_err_msg tok_list "parse_type_more" ;
	  raise e
	    

182
183
and (parse_list_var: aut_token -> vnt list) = 
  fun tok -> 
184
185
186
187
188
189
    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
190
191
and (parse_var: aut_token -> vnt) = 
  fun tok -> 
192
193
194
195
196
    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 ")" >]
197
198
	    -> 
	      ( match typ with
199
		  "bool" -> (var, BoolT)
200
		| "float" -> (var, FloatT(-.max_float, max_float))
201
		| "int" -> (var, IntT(min_int, max_int))
202
203
		| str -> failwith ("*** Bad type in .env: " ^ str )
	      )
204
205
206
	with e ->
	  print_err_msg tok_list "parse_var" ;
	  raise e
207

208
209
and (parse_list_arc: aut_token -> read_arc list) = 
  fun tok -> 
210
211
212
213
214
215
    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
216
217
and (parse_arc: aut_token -> read_arc) = 
  fun tok -> 
218
219
220
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
221
	    [< 'Genlex.Kwd "("; 'Genlex.Int node_from ; 
222
223
224
225
226
227
	       '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
228
229
and (parse_arc_info: aut_token -> arc_info) = 
  fun tok -> 
230
231
232
233
234
235
236
237
    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
238
239
240

and (parse_formula_eps: aut_token -> formula_eps) = 
  fun tok -> 
241
242
243
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser   
244
	    [< 'Genlex.Ident "eps" >] -> Eps
245
246
247
248
249
	  | [< f = parse_formula >] -> Form(f)
	with e ->
	  print_err_msg tok_list "parse_formula_eps" ;
	  raise e
	    
250
251
and (parse_formula: aut_token -> formula) = 
  fun tok -> 
252
253
254
255
256
257
258
259
260
    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
261
262
	  | [< 'Genlex.Ident id ; f1 = parse_expr_or_bool_ident id ; 
	       f = parse_more_formula f1>] -> f
263
264
265
266
267
	  | [< 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
268

269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
and (parse_expr_or_bool_ident: string -> aut_token -> formula) = 
  fun id tok -> 
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
	    [< 'Genlex.Kwd "=";  e2 = parse_expr >] -> Eq(Nvar(id), e2) 
	  | [< 'Genlex.Kwd ">";  e2 = parse_expr >] -> Sup(Nvar(id), e2) 
	  | [< 'Genlex.Kwd ">="; e2 = parse_expr >] -> SupEq(Nvar(id), e2)
	  | [< 'Genlex.Kwd "<";  e2 = parse_expr >] -> Inf(Nvar(id), e2) 
	  | [< 'Genlex.Kwd "<="; e2 = parse_expr >] -> InfEq(Nvar(id), e2)
	  | [< f = parse_more_formula (Bvar(id)) >] -> f 
	with e ->
	  print_err_msg tok_list "parse_expr_or_bool_ident" ;
	  raise e

284
285
and (parse_more_formula: formula -> aut_token -> formula) = 
  fun f1 tok -> 
286
287
288
289
290
291
292
293
294
    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
295
296
and (parse_expr_right : expr -> aut_token -> formula) = 
  fun e1 tok -> 
297
298
299
300
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser
	    [< 'Genlex.Kwd "=";  e2 = parse_expr >] -> Eq(e1, e2) 
301
302
303
304
	  | [< 'Genlex.Kwd ">";  e2 = parse_expr >] -> Sup(e1, e2) 
	  | [< 'Genlex.Kwd ">="; e2 = parse_expr >] -> SupEq(e1, e2)
	  | [< 'Genlex.Kwd "<";  e2 = parse_expr >] -> Inf(e1, e2) 
	  | [< 'Genlex.Kwd "<="; e2 = parse_expr >] -> InfEq(e1, e2)
305
306
307
308
	with e ->
	  print_err_msg tok_list "parse_expr_rigth" ;
	  raise e
	    
309
310

(* 
311
312
313
 ** The following is copy-paste-adapted from sec 1.8 of the ocaml ref man 
 ** untitled ``pretty printing and parsing''.
 *)
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
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  
343
344
345
	[< 'Genlex.Ident s >] -> Nvar(s)
      | [< 'Genlex.Int i >]   -> Ival(i)
      | [< 'Genlex.Float f >] -> Fval(f)
346
347
      | [< 'Genlex.Kwd "("; e = parse_expr; 'Genlex.Kwd ")" >] -> e