parse_env.ml 11.9 KB
Newer Older
1
(*pp camlp4o *)
2
(*-----------------------------------------------------------------------
3
** Copyright (C) 2001, 2002 - Verimag.
4
5
6
7
8
9
10
11
12
13
** 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

14
15

let debug_parsing = true
16
17
18
19
  
type read_arc = Arc of node * arc_info * node

type read_automata = Automata of 
20
  node        (* Initial node *)
21
22
23
  * vnt list  (* Input var list *)
  * vnt list  (* Output var list *)
  * vnt list  (* Local var list *)
24
  * vnt list  (* pre var list *)
25
26
27
  * read_arc list  (* Transition list *)

(* Keywords of the automata format *)
28
29
30
31
let lexer = Genlex.make_lexer ["("; ")"; ","; ";"; ".";
			       "&&"; "||"; "!"; "true"; "false"; 
			       "IfThenElseExpr";"IfThenElse";
			       "="; ">"; ">="; "<"; "<="; 
32
33
34
35
			       "+"; "-"; "*"; "/"; "mod"; "%"]

type aut_token = Genlex.token Stream.t

36
37
38
39
let print_genlex_token = 
  fun tok -> 
    let _ =
      match tok with
40
41
42
43
44
45
	  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)"
46
    in
47
      print_string "\n\t"
48

49
50
51
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
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
68
69
70
	  | [< 'Genlex.Kwd "," >] -> [] (* empty list *)   
	  | [< 'Genlex.Kwd "." >] -> [] (* empty list *) 
          | [< vnt = parse ; tail = (parse_list_var_tail (parse)) >]
71
72
73
74
	    -> vnt :: tail  
	with e ->
	  print_err_msg tok_list "parse_list";
	  raise e
75
76
and (parse_list_var_tail: (aut_token -> 'a) -> aut_token -> 'a list) = 
  fun parse tok -> 
77
78
79
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser 
80
81
	  | [< 'Genlex.Kwd ",">] -> [] (* end of the list *)  
	  | [< 'Genlex.Kwd ".">] -> [] (* end of the list *)  
82
83
84
85
86
87
	  | [< 'Genlex.Kwd ";" ; a = parse ;
	       tail = (parse_list_var_tail (parse)) >]
	    -> a :: tail  
	with e ->
	  print_err_msg tok_list "parse_list_var_tail";
	  raise e
88
89
90



91
92
let rec (parse_automata: aut_token -> read_automata) = 
  fun tok -> 
93
    let tok_list = Stream.npeek 20 tok in
94
95
      try
	match tok with parser  
96
97
98
99
100
	    [< 'Genlex.Ident "inputs"; 'Genlex.Kwd "="; li = parse_list_var ;
	       'Genlex.Ident "outputs"; 'Genlex.Kwd "="; lo = parse_list_genvar ;
	       'Genlex.Ident "locals"; 'Genlex.Kwd "="; ll = parse_list_genvar ;
	       'Genlex.Ident "pre"; 'Genlex.Kwd "="; lpre = parse_list_var ;
	       'Genlex.Ident "start_node"; 'Genlex.Kwd "="; 'Genlex.Int node_id ; 
101
	       'Genlex.Kwd "," ;
102
103
	       'Genlex.Ident "arcs"; 'Genlex.Kwd "="; la = parse_list_arc 
		      (List.append li (List.append lo (List.append ll lpre))) 
104
105
	    >]
            -> Automata(node_id, li, lo, ll, lpre, la)
106
107
108
109
	with e ->
	  print_err_msg tok_list "parse_automata";
	  raise e
	    
110

111
112
113
114
115
116
117
118
119
120
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
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
	    

171
172
and (parse_list_var: aut_token -> vnt list) = 
  fun tok -> 
173
174
175
176
177
178
    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
179
180
and (parse_var: aut_token -> vnt) = 
  fun tok -> 
181
182
183
184
185
    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 ")" >]
186
187
	    -> 
	      ( match typ with
188
		  "bool" -> (var, BoolT)
189
		| "float" -> (var, FloatT(-.max_float, max_float))
190
		| "int" -> (var, IntT(min_int, max_int))
191
192
		| str -> failwith ("*** Bad type in .env: " ^ str )
	      )
193
194
195
	with e ->
	  print_err_msg tok_list "parse_var" ;
	  raise e
196

197
198
and (parse_list_arc: vnt list -> aut_token -> read_arc list) = 
  fun vars tok -> 
199
200
    let tok_list = Stream.npeek 10 tok in
      try
201
	parse_list (parse_arc vars) tok
202
203
204
      with e ->
	print_err_msg tok_list "parse_list_arc" ;
	raise e
205
206
and (parse_arc: vnt list -> aut_token -> read_arc) = 
  fun vars tok -> 
207
208
209
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
210
211
212
	    [< 'Genlex.Ident "From"; 'Genlex.Int node_from ; 
	       'Genlex.Ident "To"; 'Genlex.Int node_to ; 
	       'Genlex.Ident "With"; arc_info = parse_arc_info vars  >]
213
214
215
216
	    -> Arc(node_from, arc_info, node_to)
	with e ->
	  print_err_msg tok_list "parse_arc" ;
	  raise e
217
218
and (parse_arc_info: vnt list -> aut_token -> arc_info) = 
  fun vars tok -> 
219
220
221
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
222
	    [< 'Genlex.Int weigth ; 'Genlex.Ident ":"; expr = parse_formula_eps vars >] 
223
224
225
226
	    -> (weigth, expr)
	with e ->
	  print_err_msg tok_list "parse_arc_info" ;
	  raise e
227

228
229
and (parse_formula_eps: vnt list -> aut_token -> formula_eps) = 
  fun vars tok -> 
230
231
232
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser   
233
234
	  | [< 'Genlex.Ident "eps" >] -> Eps
	  | [< 'Genlex.Ident "("; 'Genlex.Ident "eps"; 'Genlex.Ident ")" >] -> Eps
235
	  | [< f = parse_formula vars >] -> Form(f)
236
237
238
239
	with e ->
	  print_err_msg tok_list "parse_formula_eps" ;
	  raise e
	    
240
241
and (parse_formula: vnt list -> aut_token -> formula) = 
  fun vars tok -> 
242
243
244
    let tok_list = Stream.npeek 10 tok in
      try
	match tok with parser  
245
	    [< 'Genlex.Kwd "!"; f1 = parse_formula vars; 
246
	       f = parse_more_formula (Not(f1)) vars >] -> f  
247
	  | [< 'Genlex.Kwd "IfThenElse"; f1 = parse_formula vars; f2 = parse_formula vars; 
248
249
250
251
252
253
254
255
256
	       f3 = parse_formula vars >] -> IteB(f1, f2, f3)
	  | [< 'Genlex.Kwd "("; f1 = parse_formula vars ; 'Genlex.Kwd ")" ; 
	       f = parse_more_formula f1 vars >] -> f 
	  | [< 'Genlex.Kwd "true" ; f = parse_more_formula True vars>] -> f
	  | [< 'Genlex.Kwd "false" ; f = parse_more_formula False vars>] -> f
	  | [< 'Genlex.Ident id ; f1 = parse_expr_or_bool_ident id vars; 
	       f = parse_more_formula f1 vars>] -> f
	  | [< e1 = parse_expr vars ; f1 = parse_expr_right e1 vars ; 
	       f = parse_more_formula f1 vars >] -> f
257
258
259
	with e ->
	  print_err_msg tok_list "parse_formula" ;
	  raise e
260

261
262
and (parse_expr_or_bool_ident: string -> vnt list -> aut_token -> formula) = 
  fun id vars tok -> 
263
    let tok_list = Stream.npeek 10 tok in
264
265
266
267
268
269
270
    let (_, vt) = List.find (fun (vn,vt) -> vn = id) vars in
    let var =
      match vt with
	  BoolT -> Ivar("XXX")
	| IntT(_,_) -> Ivar(id)
	| FloatT(_,_) -> Fvar(id)
    in
271
272
      try
	match tok with parser  
273
274
275
276
277
278
	    [< 'Genlex.Kwd "=";  e2 = parse_expr vars >] -> Eq(var, e2) 
	  | [< 'Genlex.Kwd ">";  e2 = parse_expr vars >] -> Sup(var, e2) 
	  | [< 'Genlex.Kwd ">="; e2 = parse_expr vars >] -> SupEq(var, e2)
	  | [< 'Genlex.Kwd "<";  e2 = parse_expr vars >] -> Inf(var, e2) 
	  | [< 'Genlex.Kwd "<="; e2 = parse_expr vars >] -> InfEq(var, e2)
	  | [< f = parse_more_formula (Bvar(id)) vars >] -> f 
279
280
281
282
	with e ->
	  print_err_msg tok_list "parse_expr_or_bool_ident" ;
	  raise e

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

(* 
310
311
312
 ** The following is copy-paste-adapted from sec 1.8 of the ocaml ref man 
 ** untitled ``pretty printing and parsing''.
 *)
313
314
and (parse_expr: vnt list -> aut_token -> expr) = 
  fun vars tok -> 
315
    match tok with parser  
316
317
318
	[< e1 = parse_mult vars; e = parse_more_adds e1 vars >] -> e
and (parse_more_adds: expr -> vnt list -> aut_token -> expr) = 
  fun e1 vars tok -> 
319
    match tok with parser  
320
321
322
323
	[< 'Genlex.Kwd "+"; e2 = parse_mult vars; 
	   e = parse_more_adds (Sum(e1, e2)) vars >] -> e
      | [< 'Genlex.Kwd "-"; e2 = parse_mult vars; 
	   e = parse_more_adds (Diff(e1, e2)) vars >] -> e
324
      | [<  >] -> e1
325
326
and (parse_mult: vnt list -> aut_token -> expr) = 
  fun vars tok -> 
327
    match tok with parser  
328
329
330
	[< e1 = parse_simple vars; e = parse_more_mults e1 vars >] -> e
and (parse_more_mults: expr -> vnt list -> aut_token -> expr) = 
  fun e1 vars tok -> 
331
    match tok with parser  
332
333
334
335
336
337
	[< 'Genlex.Kwd "*";   e2 = parse_simple vars; 
	   e = parse_more_mults (Prod(e1, e2)) vars >] -> e
      | [< 'Genlex.Kwd "/";   e2 = parse_simple vars; 
	   e = parse_more_mults (Quot(e1, e2)) vars >] -> e
      | [< 'Genlex.Kwd "mod"; e2 = parse_simple vars; 
	   e = parse_more_mults (Mod(e1, e2)) vars >] -> e
338
      | [<  >] -> e1
339
340
and (parse_simple: vnt list -> aut_token -> expr) = 
  fun vars tok -> 
341
    match tok with parser  
342
343
344
345
346
347
348
349
350
	[< 'Genlex.Ident s >] -> 
	  let (_, vt) = List.find (fun (vn,vt) -> vn = s) vars in
	  let var =
	    match vt with
		 BoolT -> assert false 
	      | IntT(_,_) -> Ivar(s)
	      | FloatT(_,_) -> Fvar(s)
	  in
	    var
351
352
      | [< 'Genlex.Int i >]   -> Ival(i)
      | [< 'Genlex.Float f >] -> Fval(f)
353
      | [< 'Genlex.Kwd "IfThenElseExpr"; f1 = parse_formula vars; e2 = parse_expr vars; 
354
355
	   e3 = parse_expr vars >] -> Ite(f1, e2, e3) 
      | [< 'Genlex.Kwd "("; e = parse_expr vars; 'Genlex.Kwd ")" >] -> e
356