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

open Formula

14
15

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

19
20
type label_ce = (string * Control.expr) 

21
type read_automata = Automata of 
22
  node        (* Initial node *)
23
24
25
  * vnt list  (* Input var list *)
  * vnt list  (* Output var list *)
  * vnt list  (* Local var list *)
26
  * vnt list  (* pre var list *)
27
  * label_ce list  (* Definition of labels representing control expressions *)
28
29
30
  * read_arc list  (* Transition list *)

(* Keywords of the automata format *)
31
let lexer = Genlex.make_lexer ["("; ")"; ","; ";"; ".";
32
			       "&&"; "||"; "#"; "!"; "true"; "false"; 
33
			       "IfThenElseNum";"IfThenElse"; "==";
34
			       "="; ">"; ">="; "<"; "<="; "<>"; 
35
			       "+"; "-"; "*"; "/"; "%"]
36
37
38

type aut_token = Genlex.token Stream.t

39

40
41
42
43
44
45
46
let default_max_float = 10. ** 11.
(* Should not be bigger that max_float/2 so that the whole domain is
   not bigger than max_float 

   XXX What should be that default value by the way ?
*)

47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
let print_err_msg ic tok tok_list func msg msg2 =

  (* Try to guess the char number from the tok number. *)
  let n = Stream.count tok in
  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_string "`"; print_int i; print_string "' "
	  | Genlex.Float(f)    -> print_string "`"; Util.my_print_float f; print_string "' "
	  | Genlex.String(str) -> print_string ("`" ^ str ^ "' ")
	  | Genlex.Char(c)     -> print_string "`"; print_char c ; print_string "' "
      in
	print_string " "
  in

  let  remove_sep str =
    let blank_str = "[\010\|\013\|\009\|\026\|\012\|\"\| ]" in
    let blank_reg =  Str.regexp blank_str in
      Str.global_replace blank_reg "" str
  in
  let add_quotes str =
    let str2 = ("`" ^ (Str.global_replace (Str.regexp "[ ]") "' `" str) ^ "'") in
    let str3 = Str.global_replace (Str.regexp "[\n]") "'\n" str2 in
    let str4 = Str.global_replace (Str.regexp "[\t]") "\t`" str3 in
      str4
 (*     let str5 =  Str.global_replace (Str.regexp "`<") "<" str4 in *)
(*       Str.global_replace (Str.regexp ">'") ">" str5 *)
  in  
  let string_of_genlex_token = 
    fun tok -> 
80
      match tok with
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
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
	  Genlex.Kwd(str)    -> str
	| Genlex.Ident(str)  -> str
	| Genlex.Int(i)      -> string_of_int i
	| Genlex.Float(f)    -> string_of_float f
	| Genlex.String(str) -> remove_sep str
	| Genlex.Char(c)     -> Char.escaped c
  in
  let rec skip_n_non_sep_char n s =
    if n = 0
    then 
      try
	let c = Stream.next s in
	  ( match c with
		('\"' | ' ' | '\010' | '\013' | '\009' | '\026' | '\012') -> 
		  skip_n_non_sep_char n s
	      | _ -> 
		  ()
	  );
      with _ -> ()
    else
      try
	let c = Stream.next s in
	  ( match c with
		('\"' | ' ' | '\010' | '\013' | '\009' | '\026' | '\012') -> 
		  skip_n_non_sep_char n s
	      | _ -> 
		  skip_n_non_sep_char (n-1) s
	  );
      with _ -> ()
  in
  let _ = seek_in ic 0 in
  let new_tok = lexer (Stream.of_channel ic) in
  let first_n_toks = Stream.npeek n new_tok in
  let str = String.concat "" (List.map (string_of_genlex_token) first_n_toks) in
  let s = String.length str in
  let _ = seek_in ic 0 in
  let char_stream = Stream.of_channel ic in
  let char_pos =
    skip_n_non_sep_char s char_stream;
    (Stream.count char_stream) 
  in

    print_string ("\n*** Parse error (" ^ func ^ ") ");
    print_string ("around character " ^ (string_of_int char_pos) ^ ". ");
    print_string ("\n*** The next 10 tokens are: ");
    List.iter (print_genlex_token) tok_list ;
    print_string ("\n" ^ 
		  (if msg = "" 
		   then "" 
		   else ("*** whereas either one of the following token(s) was (were) expected:\n\t" ^ 
			 (add_quotes msg) ^ " \n")) ^
		  (if msg2 = "" 
		   then "" 
		   else ("*** " ^ msg2) 
		  )
		 );
    flush stdout
		 	
let print_debug ic msg =
140
  if debug_parsing then
141
    (
142
      print_string (string_of_int (pos_in ic) ^ ": " ^ msg);
143
      flush stdout
144
    )
145

146
147

(** Parsing lists *)
148
let rec
149
150
151
  (parse_list: in_channel -> (in_channel -> aut_token -> 'a) -> aut_token -> 'a list) = 
  fun ic parse tok -> 
    let _ = print_debug ic ("parse_list \n") in
152
153
154
155
156
157
158
159
160
161
162
163
    let tok_list = Stream.npeek 10 tok in
      try
	(
	  match tok_list with  
	    | (Genlex.Kwd ";")::(Genlex.Kwd ",")::_ ->  Stream.junk tok; [] (* empty list *)   
	    | (Genlex.Kwd ";")::(Genlex.Kwd ".")::_ ->  Stream.junk tok; [] (* empty list *)   
	    | (Genlex.Kwd "," )::_ -> [] (* empty list *)   
	    | (Genlex.Kwd "." )::_ -> [] (* empty list *) 
	    | (Genlex.Kwd "%" )::_ -> [] (* empty list *)  
	    | (Genlex.Kwd ")" )::_ -> [] (* empty list *)  
	    | _ -> (
		match tok with parser
164
		  | [< vnt = parse ic; tail = (parse_list_var_tail ic (parse)) >]
165
166
167
		    -> vnt :: tail  
	      )
	)
168
169
170
171
172
173
174
175
      with 
	  Failure _ -> failwith "" 
	| e ->
	    print_err_msg ic tok tok_list "parse_list" ",\n\t; .\n\t; ,\n\t.\n\t)\n\t%" "";
	    failwith "" 
and (parse_list_var_tail: in_channel -> (in_channel -> aut_token -> 'a) -> aut_token -> 'a list) = 
  fun ic parse tok -> 
    let _ = print_debug ic ("parse_list_var_t \n") in
176
177
178
179
180
181
182
183
184
185
186
187
    let tok_list = Stream.npeek 10 tok in
      try
	(
	  match tok_list with 
	    | (Genlex.Kwd ";")::(Genlex.Kwd ",")::_ ->  Stream.junk tok; [] (* end of the list *)
	    | (Genlex.Kwd ";")::(Genlex.Kwd ".")::_ ->  Stream.junk tok; [] (* end of the list *)
	    | (Genlex.Kwd "," )::_ -> [] (* end of the list *)  
	    | (Genlex.Kwd "." )::_ -> [] (* end of the list *)  
	    | (Genlex.Kwd "%" )::_ -> [] (* end of the list *)  
	    | (Genlex.Kwd ")" )::_ -> [] (* end of the list *)  
	    | _ -> (
		match tok with parser
188
		    [< 'Genlex.Kwd ";" ;  tail = (parse_list_var_tail2 ic (parse)) >]
189
190
191
		    -> tail  
	      )
	)
192
193
194
195
196
197
198
199
200
      with Failure 
	  _ -> failwith "" 
	| e ->
	    print_err_msg ic tok tok_list "parse_list_var_tail" ",\n\t; .\n\t; ,\n\t.\n\t)\n\t%" "";
	    failwith ""

and (parse_list_var_tail2: in_channel -> (in_channel -> aut_token -> 'a) -> aut_token -> 'a list) = 
  fun ic parse tok -> 
    let _ = print_debug ic ("parse_list_var_tail2 \n") in
201
    (* This function is introduced to allow lists to be ended by a `;'... *)
202
203
    let tok_list = Stream.npeek 10 tok in
      try
204
205
	(
	  match tok with parser 
206
	    | [< 'Genlex.Kwd ";"; _ = (parse_list_var_tail3 ic (parse)) >] -> [] 
207
208
	    | [< 'Genlex.Kwd "," >] -> [] 
	    | [< 'Genlex.Kwd "." >] -> [] 
209
	    | [< a = parse ic ; tail = (parse_list_var_tail ic (parse)) >]
210
211
	      -> a :: tail  
	)
212
213
214
215
216
217
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_list_var_tail2" "" "";
	failwith ""
and (parse_list_var_tail3: in_channel -> (in_channel -> aut_token -> 'a) -> aut_token -> 'a list) = 
  fun ic parse tok -> 
    let _ = print_debug ic ("parse_list_var_tail3 \n") in
218
219
220
    (* This function is also introduced to allow lists to be ended by a `;'... *)
    let tok_list = Stream.npeek 10 tok in
      try
221
222
223
224
225
	(
	  match tok with parser 
	    | [< 'Genlex.Kwd "." >] -> [] 
	    | [< 'Genlex.Kwd "," >] -> []
	)
226
227
228
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_list_var_tail3" "" "";
	failwith ""
229

230

231
232
233
234
(** Parsing pragmas *)

type pragma = string * string

235
236
237
let rec (parse_pragma: in_channel -> aut_token -> pragma) =
  fun ic tok -> 
    let _ = print_debug ic ("parse_pragma \n") in
238
239
    let tok_list = Stream.npeek 10 tok in
      try
240
241
242
243
244
	(
	  match tok with parser  
	      [< 'Genlex.String label ; 'Genlex.Ident ":"; 
		 'Genlex.String pragma  >] -> (label, pragma)
	)
245
246
247
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_pragma"  "<string>" "";
	failwith ""
248
and
249
250
251
  (parse_pragma_list: in_channel -> aut_token -> pragma list) =
  fun ic tok -> 
    let _ = print_debug ic ("parse_pragma_list \n") in
252
253
254
255
256
    let tok_list = Stream.npeek 10 tok in
      try
	( match (Stream.npeek 1 tok) with 
	      [Genlex.Kwd "%"] -> 
		( match tok with parser  
257
		      [< 'Genlex.Kwd "%" ; 
258
			 pl = (parse_list ic (parse_pragma));
259
260
261
			 'Genlex.Kwd "%" 
		      >] 
		      -> pl
262
263
264
		)
	    | _ -> []
	)
265
266
267
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_pragma_list"  "" "";
	failwith ""
268

269
270
271
let rec (parse_automata: in_channel -> aut_token -> read_automata) = 
  fun ic tok -> 
    let _ = print_debug ic ("parse_automata \n") in
272
    let tok_list = Stream.npeek 20 tok in
273
      try
274
275
	(
	  match tok with parser  
276
	      [< 'Genlex.Ident "inputs"; 'Genlex.Kwd "="; li = parse_list_var ic; 
277
		 'Genlex.Kwd ",";
278
		 'Genlex.Ident "outputs"; 'Genlex.Kwd "="; lo = parse_list_genvar ic ;
279
		 'Genlex.Kwd ",";
280
		 'Genlex.Ident "locals"; 'Genlex.Kwd "="; ll = parse_list_genvar ic ;
281
		 'Genlex.Kwd ",";
282
		 'Genlex.Ident "pre"; 'Genlex.Kwd "="; lpre = parse_list_prevar ic ;
283
		 'Genlex.Kwd ",";
284
		 'Genlex.Ident "ctrl_expr"; 'Genlex.Kwd "="; llabel_ce = parse_list_label_ce ic ;
285
		 'Genlex.Kwd ",";
286
287
(* 		 'Genlex.Ident "formula"; 'Genlex.Kwd "="; fl = parse_list_formuladef ic ;  *)
(* 		 'Genlex.Kwd "," ; *)
288
		 'Genlex.Ident "start_node"; 'Genlex.Kwd "="; 'Genlex.Int node_id  ; 
289
		 'Genlex.Kwd "," ;
290
		 'Genlex.Ident "arcs_nb"; 'Genlex.Kwd "="; 'Genlex.Int arcs_nb  ; 
291
292
293
		 'Genlex.Kwd "," ;
		 'Genlex.Ident "nodes_nb"; 'Genlex.Kwd "="; 'Genlex.Int nodes_nb ; 
		 'Genlex.Kwd "," ;
294
		 'Genlex.Ident "arcs"; 'Genlex.Kwd "="; la = parse_list_arc  ic
295
296
							       (List.append li (List.append lo (List.append ll lpre))) ;
		 'Genlex.Kwd ".";
297
	    >]
298
            -> Automata(node_id, li, lo, ll, lpre, llabel_ce, la)
299
	)
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
      with Failure 
	  _ -> failwith "" 
	| e ->
	    print_err_msg ic tok tok_list "parse_automata" 
	    ("inputs = <var list> ,\n\t" ^ 
	     "outputs = <var list> ,\n\t" ^
	     "locals = <var list> ,\n\t" ^
	     "pre = <pre var list> ,\n\t" ^
	     "ctrl_expr = <ctrl expr list> ,\n\t" ^
	     "start_node = <int> ,\n\t" ^
	     "arc_nb = <int> ,\n\t" ^
	     "node_nb = <int> ,\n\t" ^
	     "arcs = <arc list> .") "" ;
	    failwith ""
	      

and (parse_list_var: in_channel -> aut_token -> vnt list) = 
  fun ic tok -> 
    let _ = print_debug ic ("parse_list_var \n") in
319
320
    let tok_list = Stream.npeek 10 tok in
      try
321
322
323
324
325
326
	parse_list ic (parse_var) tok
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_list_var"  "" "" ;
	failwith ""
and (parse_var: in_channel -> aut_token -> vnt) = 
  fun ic tok -> 
327
328
    let tok_list = Stream.npeek 10 tok in
      try
329
330
331
332
	(
	  match tok with parser  
	      [< 'Genlex.Kwd "("; 
		 'Genlex.Ident var; 
333
		 prag_var = parse_pragma_list ic; 
334
335
336
337
338
339
		 'Genlex.Kwd ",";  
		 'Genlex.Ident typ ; 
		 'Genlex.Kwd ")" >]
	      -> 
		( match typ with
		      "bool" -> (var, BoolT)
340
		    | "float" -> (var, FloatT(-.default_max_float, default_max_float))
341
342
		    | "int" -> (var, IntT(min_int / 2, max_int / 2))
			(* We divide by 2 so that domains are always smaller 
343
			   than max_int_float *)
344
345
346
		    | str -> 
			print_err_msg ic tok tok_list "parse_var" "" (str ^ " is not a valid type" );
			failwith ""
347
348
		)
	)
349
350
351
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_var"  "( <ident> , <type> )" "";
	failwith ""
352

353
354
and (parse_list_genvar: in_channel -> aut_token -> vnt list) = 
  fun ic tok -> 
355
356
    let tok_list = Stream.npeek 10 tok in
      try
357
358
359
360
361
362
	parse_list ic (parse_genvar) tok
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_list_genvar"  "" "";
	failwith ""
and (parse_genvar: in_channel -> aut_token -> vnt) = 
  fun ic tok -> 
363
364
    let tok_list = Stream.npeek 10 tok in
      try
365
366
	(
	  match tok with parser  
367
	      [< 'Genlex.Kwd "("; 'Genlex.Ident var; pl = parse_pragma_list ic;
368
		 'Genlex.Kwd ","; 'Genlex.Ident typ ;
369
		 vnt = parse_type ic var typ >]
370
371
	      -> vnt
	)
372
373
374
375
376
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_genvar"  "( or ," "";
	failwith ""
and (parse_type: in_channel ->  string -> string -> aut_token -> vnt) =
  fun ic var typ tok -> 
377
378
    let tok_list = Stream.npeek 10 tok in
      try
379
380
381
382
383
	(
	  match tok with parser  
	      [< 'Genlex.Kwd ")" >] -> 
		( match typ with
		      "bool" -> (var, BoolT)
384
		    | "float" -> (var, FloatT(-.default_max_float, default_max_float))
385
		    | "int" -> (var, IntT(min_int / 2, max_int / 2))
386
387
388
		    | str -> 
			print_err_msg ic tok tok_list "parse_type" "" (str ^ " is not a valid type");
			failwith ""
389
		)
390
	    | [< 'Genlex.Kwd ","; vnt = parse_type_more ic var typ >] -> vnt
391
	)
392
393
394
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_type"  "<bool> \n\t<float> \n\t<int>" "";
	failwith ""
395
	    
396
397
and (parse_type_more: in_channel ->  string -> string -> aut_token -> vnt) =
  fun ic var typ tok -> 
398
399
    let tok_list = Stream.npeek 10 tok in
      try
400
401
402
403
	(
	  match tok with parser  
	      [< 'Genlex.Int min; 'Genlex.Kwd ","; 'Genlex.Int max;  'Genlex.Kwd ")" >] -> 
		( match typ with
404
405
406
407
408
409
		      "bool" -> 
			print_err_msg ic tok tok_list "parse_type_more" "" ("*** int expected" );
			failwith ""
		    | "float" -> 
			print_err_msg ic tok tok_list "parse_type_more" "" ("*** int expected " );
			failwith ""
410
		    | "int" -> (var, IntT(min, max))
411
412
413
		    | str -> 
			print_err_msg ic tok tok_list "parse_type_more" "" (str ^ " is not a valid type");
			failwith ""
414
415
416
		)
	    | [< 'Genlex.Float min; 'Genlex.Kwd ","; 'Genlex.Float max;  'Genlex.Kwd ")" >] -> 
		( match typ with
417
418
419
		      "bool" -> 
			print_err_msg ic tok tok_list "parse_type_more" "" ("*** float expected in .luc " );
			failwith ""
420
		    | "float" -> (var, FloatT(min, max))
421
422
423
424
425
426
		    | "int" -> 
			print_err_msg ic tok tok_list "parse_type_more" "" ("*** float expected in .luc " );
			failwith ""
		    | str -> 
			print_err_msg ic tok tok_list "parse_type_more" "" (str ^ " is not a valid type" );
			failwith ""
427
428
		)
	)
429
430
431
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_type_more"  "<bool> \n\t<float> \n\t<int>" "";
	failwith ""
432
433
	    

434
435
and (parse_list_prevar: in_channel -> aut_token -> vnt list) = 
  fun ic tok -> 
436
437
    let tok_list = Stream.npeek 10 tok in
      try
438
439
440
441
442
443
444
	parse_list ic (parse_prevar) tok
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_list_prevar"  "" "";
	failwith ""
and (parse_prevar: in_channel -> aut_token -> vnt) = 
  fun ic tok -> 
    let _ = print_debug ic ("parse_prevar \n") in
445
    let tok_list = Stream.npeek 10 tok in
446
      try (
447
	match tok with parser  
448
449
	    [< 'Genlex.Kwd "("; 'Genlex.Ident "pre"; 'Genlex.Kwd "("; 
	       'Genlex.Int i ; 'Genlex.Kwd "," ; 'Genlex.Ident var;  
450
	       'Genlex.Kwd ")"; pl = parse_pragma_list ic ; 
451
	       'Genlex.Kwd ","; 'Genlex.Ident typ ; 'Genlex.Kwd ")" >]
452
	    -> 
453
	      let pre_var = Prevar.create_prevar_name i var in
454
	      ( match typ with
455
		  "bool" -> (pre_var, BoolT)
456
		| "float" -> (pre_var, FloatT(-.default_max_float, default_max_float))
457
		| "int" -> (pre_var, IntT(min_int / 2, max_int / 2))
458
459
460
		| str -> 
		    print_err_msg ic tok tok_list "" "" (str ^ " is not a valid type" );
		    failwith ""
461
	      )
462
      )
463
464
465
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_prevar"  "" "";
	failwith ""
466

467
468
469
and (parse_list_label_ce: in_channel -> aut_token -> label_ce list) =
  fun ic tok -> 
    let _ = print_debug ic ("parse_list_label_ce \n") in
470
471
    let tok_list = Stream.npeek 10 tok in
      try
472
473
474
475
476
477
478
	parse_list ic (parse_ce) tok
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_list_label_ce"  "" "";
	failwith ""
and (parse_ce: in_channel -> aut_token -> label_ce) = 
  fun ic tok -> 
    let _ = print_debug ic ("parse_ce \n") in
479
    let tok_list = Stream.npeek 10 tok in
480
      try (
481
482
483
484
	match tok with parser  
	    [< 'Genlex.Kwd "(" ; 
	       'Genlex.Ident label ;	 
	       'Genlex.Kwd "," ; 
485
	       expr = parse_list_ctrl_expr ic  ; 
486
487
488
489
	       'Genlex.Kwd ")" 
	    >]
	    -> 
	      (label, expr)
490
      )
491
492
493
494
495
496
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_ce"  "" "";
	failwith ""
and (parse_list_ctrl_expr : in_channel -> aut_token -> Control.expr) =
  fun ic tok -> 
    let _ = print_debug ic ("parse_list_ctrl_expr  \n") in
497
498
499
    let tok_list = Stream.npeek 10 tok in
    let ce_list =
      try
500
501
502
503
	parse_list ic (parse_ctrl_expr) tok
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_list_ctrl_expr"  "" "";
	failwith ""
504
    in
505
506
507
508
509
510
      if ce_list = [] then (fun x -> x)
      else
	List.fold_left 
	  (fun ce1 ce2 -> (fun st -> ce2 (ce1 st)))
	  (List.hd ce_list) 
	  (List.tl ce_list)
511
512
513
and (parse_ctrl_expr: in_channel -> aut_token -> Control.expr) = 
  fun ic tok -> 
    let _ = print_debug ic ("parse_ctrl_expr \n") in
514
    let tok_list = Stream.npeek 10 tok in
515
      try (
516
517
518
519
	match tok with parser  
	    [< 'Genlex.Ident "Set" ; 'Genlex.Ident varname ; 'Genlex.Int i 
	    >] ->
	      (Control.set varname i)
520
521
522
523
	  | [< 'Genlex.Ident "Set_between" ; 'Genlex.Ident varname ;
	       'Genlex.Int i ; 'Genlex.Int min ; 'Genlex.Int max 
	    >] -> 
	      (Control.set_between varname i min max)
524
525
526
527
	  | [< 'Genlex.Ident "Draw_between" ; 'Genlex.Ident varname ;
	       'Genlex.Int min ; 'Genlex.Int max 
	    >] -> 
	      (Control.draw_between varname min max)
528
	  | [< 'Genlex.Ident "Draw_gauss" ; 'Genlex.Ident varname ; 
529
	       m = parse_float ic  ; dev = parse_float ic  
530
531
532
533
534
	    >] -> 
	      (Control.draw_gauss varname m dev)
	  | [< 'Genlex.Ident "Dec" ; 'Genlex.Ident varname 
	    >] -> 
	      (Control.dec varname)
535
	  | [< 'Genlex.Kwd "IfThenElse" ; test = parse_test_expr ic  ; 
536
	       'Genlex.Kwd "(" ;  
537
	       cel_then = parse_list_ctrl_expr ic  ; 
538
539
	       'Genlex.Kwd ")" ;  
	       'Genlex.Kwd "(" ;  
540
	       cel_else = parse_list_ctrl_expr ic  ; 
541
542
543
	       'Genlex.Kwd ")" 
	    >] ->  
	      Control.ite test cel_then cel_else
544
      )
545
546
547
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_ctrl_expr"  "Set\n\tSet_between\n\tDraw_gauss\n\tDec\n\tIfThenElse ( <ctrl expr> ) ( <ctrl expr> )" "";
	failwith ""
548

549
550
551
and (parse_float: in_channel -> aut_token -> float) =
  fun ic tok -> 
    let _ = print_debug ic ("parse_float \n") in
552
    let tok_list = Stream.npeek 10 tok in
553
      try (
554
555
556
	match tok with parser  
	    [< 'Genlex.Float f >] -> f
	  | [< 'Genlex.Int i >] -> (float_of_int i)
557
      )
558
559
560
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_float"  "<int> or <float>" "";
	failwith ""
561
562


563
564
565
and (parse_int_or_var: in_channel -> aut_token -> Control.number) =
  fun ic tok -> 
    let _ = print_debug ic ("parse_int_or_var \n") in
566
    let tok_list = Stream.npeek 10 tok in
567
      try (
568
569
570
	match tok with parser  
	    [< 'Genlex.Int i >] -> Control.IntExpr(i)
	  | [< 'Genlex.Ident id >] -> Control.VarExpr(id)
571
      )
572
573
574
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_int_or_var"  "<int> or <ident>" "";
	failwith ""
575
	    
576
577
578
and (parse_test_expr: in_channel -> aut_token -> Control.test) =
  fun ic tok -> 
    let _ = print_debug ic ("parse_test_expr \n") in
579
    let tok_list = Stream.npeek 10 tok in
580
      try (
581
	match tok with parser
582
	    [< 'Genlex.Kwd "(" ; ct = parse_test_expr ic  ; 'Genlex.Kwd ")" >]
583
584
585
	    ->
	      ct
	  |
586
	    [< 'Genlex.Kwd op ; n1 = parse_int_or_var ic ; n2 = parse_int_or_var ic>]
587
588
589
590
591
592
593
	    -> 
	      match op with
		| "<"  -> Control.GtExpr(n2, n1)
		| "<=" -> Control.GeExpr(n2, n1)
		| ">"  -> Control.GtExpr(n1, n2)
		| ">=" -> Control.GeExpr(n1, n2)
		| "="  -> Control.EqExpr(n1, n2)
594
		| "=="  -> Control.EqExpr(n1, n2)
595
		| _ -> assert false
596
      )
597
598
599
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_test_expr"  ">\n\t<\n\t<=\n\t>=\n\t=\n\t==" "";
	failwith ""
600
601
	    

602
603
604
and (parse_list_arc: in_channel -> vnt list -> aut_token -> read_arc list) = 
  fun ic vars tok -> 
    let _ = print_debug ic ("parse_list_arc \n") in
605
606
    let tok_list = Stream.npeek 10 tok in
      try
607
608
609
610
611
612
613
	parse_list ic (fun ic -> parse_arc ic vars) tok
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_list_arc"  "" "";
	failwith ""
and (parse_arc: in_channel -> vnt list -> aut_token -> read_arc) = 
  fun ic vars tok -> 
    let _ = print_debug ic ("parse_arc \n") in
614
    let tok_list = Stream.npeek 10 tok in
615
      try (
616
	match tok with parser  
617
618
619
620
621
	    [< 'Genlex.Ident "From"; 
	       'Genlex.Int node_from ; 
	       'Genlex.Ident "To"; 
	       'Genlex.Int node_to ; 
	       'Genlex.Ident "With"; 
622
	       arc_info = parse_arc_info ic vars
623
	    >]
624
	    -> Arc(node_from, arc_info, node_to)
625
      ) 
626
627
628
629
630
631
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_arc" "From <int> To <int> With <arc_label>"  "";
	failwith ""
and (parse_arc_info: in_channel -> vnt list -> aut_token -> arc_info) = 
  fun ic vars tok -> 
    let _ = print_debug ic ("parse_arc_info \n") in
632
    let tok_list = Stream.npeek 10 tok in
633
      try (
634
	match tok with parser  
635
	    [< weight = (parse_weight ic vars) ; 
636
	       'Genlex.Ident ":"; 
637
638
	       expr = parse_formula_eps ic vars ; 
	       pc = parse_post_cond_id ic
639
	    >] 
640
	    -> (weight, expr, pc)
641
      ) 
642
643
644
645
646
647
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_arc_info" "<weigth> :" "";
	failwith ""
and (parse_post_cond_id: in_channel -> aut_token -> string) =
  fun ic tok -> 
    let _ = print_debug ic ("parse_post_cond_id \n") in
648
     let tok_list = Stream.npeek 10 tok in
649
      try (
650
651
652
653
654
655
	match (Stream.npeek 2 tok) with
	    [ Genlex.Ident ":"; Genlex.Ident label ] -> 
	      Stream.junk tok;
	      Stream.junk tok;
	      label
	  | _ -> "identity"
656
      )
657
658
659
660
661
662
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_post_cond_id"  "" "";
	failwith ""
and (parse_weight: in_channel -> vnt list -> aut_token -> weight) = 
  fun ic vars tok -> 
    let _ = print_debug ic ("parse_weight \n") in
663
    let tok_list = Stream.npeek 10 tok in
664
      try (
665
	match tok with parser  
666
667
668
669
670
	    [< 'Genlex.Int w >] -> Wint(w)
	  | [< 'Genlex.Kwd "!" ; 
	       'Genlex.Ident lbl >] 
	    -> Wident_not_sig(lbl)
	  | [< 'Genlex.Ident lbl >] -> Wident(lbl)
671
      )
672
673
674
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_weight"  "[!] <weigth_ident> or <int>" "";
	failwith ""
675
676


677
678
and (parse_formula_eps: in_channel -> vnt list -> aut_token -> formula_eps) = 
  fun ic vars tok -> 
679
    let tok_list = Stream.npeek 10 tok in
680
      try (
681
	match tok with parser   
682
683
684
	  | 
	    [< 'Genlex.Ident "eps" >] -> Eps
	  | 
685
	    [< 'Genlex.Ident "("; fe = parse_formula_eps ic vars ; 
686
687
688
689
	       'Genlex.Ident ")" 
	    >] 
	    -> fe
	  | 
690
	    [< f = parse_formula ic vars >] -> Form(f)
691
      )
692
693
694
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_formula_eps"  "eps or (" "";
	failwith ""
695
	    
696
697
and (parse_formula: in_channel -> vnt list -> aut_token -> formula) = 
  fun ic vars tok -> 
698
699
    let tok_list = Stream.npeek 10 tok in
      try
700
	(
701
	match tok with parser  
702
703
	    [< 'Genlex.Kwd "!"; pl = parse_pragma_list ic  ;
	       f = parse_formula ic vars
704
	    >] -> Not(f)
705
	  | 
706
707
708
709
	    [< 'Genlex.Kwd "IfThenElse";  pl = parse_pragma_list ic  ;
	       f1 = parse_formula ic vars; 
	       f2 = parse_formula ic vars; 
	       f3 = parse_formula ic vars           
710
711
712
	    >] 
	    -> IteB(f1, f2, f3)
	  | 
713
714
715
	    [< 'Genlex.Kwd "==";  pl = parse_pragma_list ic  ;
	       f1 = parse_formula ic vars; 
	       f2 = parse_formula ic vars
716
	    >] 
717
718
719
	    -> 
	      EqB(f1, f2) 
(* 	      Or(And(f1, f2), And(Not(f1), Not(f2)))  *)
720
	  | 
721
	    [< 'Genlex.Kwd "true" ; pl = parse_pragma_list ic 
722
	    >] 
723
	    -> True
724
	  | 
725
	    [< 'Genlex.Kwd "false" ; pl = parse_pragma_list ic 
726
	    >] 
727
	    -> False
728
	  | 
729
	    [< 'Genlex.Kwd "("; f = parse_formula ic vars ; 'Genlex.Kwd ")"
730
731
732
	    >]
	    -> f 
	  |  
733
734
735
	    [< 'Genlex.Kwd "||"; pl = parse_pragma_list ic  ;
	       f1 = parse_formula ic vars ;
	       f2 = parse_formula ic vars 
736
	    >] 
737
	    -> Or(f1, f2)
738
	  | 
739
740
741
	    [< 'Genlex.Kwd "&&"; pl = parse_pragma_list ic  ;
	       f1 = parse_formula ic vars ; 
	       f2 = parse_formula ic vars 
742
	    >] 
743
744
	    -> 
	      And(f1, f2)
745
	  | 
746
747
748
	    [< 'Genlex.Kwd "#"; pl = parse_pragma_list ic  ; 
	       f1 = parse_formula ic vars ;
	       f2 = parse_formula ic vars 
749
	    >] 
750
	    -> And(Or(f1, f2), Not(And(f1, f2))) (* xor *)
751

752
	  | 
753
754
	    [< 'Genlex.Kwd "=";  pl = parse_pragma_list ic  ; 
	       e1 = parse_expr ic vars ; e2 = parse_expr ic vars 
755
756
	    >] 
	    -> Eq(e1, e2) 
757
	  | 
758
759
	    [< 'Genlex.Kwd "<>";  pl = parse_pragma_list ic  ; 
	       e1 = parse_expr ic vars ; e2 = parse_expr ic vars 
760
761
	    >] 
	    -> Neq(e1, e2) 
762
	  | 
763
764
	    [< 'Genlex.Kwd ">";  pl = parse_pragma_list ic  ; 
	       e1 = parse_expr ic vars ;e2 = parse_expr ic vars 
765
766
767
	    >] 
	    -> Sup(e1, e2) 
	  | 
768
769
	    [< 'Genlex.Kwd ">="; pl = parse_pragma_list ic  ; 
	       e1 = parse_expr ic vars ;e2 = parse_expr ic vars 
770
771
772
	    >] 
	    -> SupEq(e1, e2)
	  | 
773
774
	    [< 'Genlex.Kwd "<";  pl = parse_pragma_list ic  ; 
	       e1 = parse_expr ic vars ; e2 = parse_expr ic vars 
775
776
777
	    >] 
	    -> Inf(e1, e2) 
	  | 
778
779
	    [< 'Genlex.Kwd "<="; pl = parse_pragma_list ic  ; 
	       e1 = parse_expr ic vars ;e2 = parse_expr ic vars 
780
781
782
783
784
	    >] 
	    -> InfEq(e1, e2)
	  | 
	    [< 'Genlex.Ident "pre"; 'Genlex.Kwd "("; 'Genlex.Int i ; 
	       'Genlex.Kwd "," ; 'Genlex.Ident id; 'Genlex.Kwd ")"; 
785
	       pl = parse_pragma_list ic 
786
787
	    >]
	    ->
788
	      let pre_id = Prevar.create_prevar_name  i id in
789
790
791
792
793
	      (* Ditto *)
	      let (_, vt) = List.find (fun (vn,vt) -> vn = pre_id) vars in
		( match vt with
		    BoolT -> Bvar(pre_id)
		  | _  -> 
794
795
796
797
		      print_err_msg ic tok tok_list "parse_formula" "" 
		      (pre_id ^ " is declared as a" ^
		       " boolean and is used as a numeric. ");
		      failwith ""
798
799
		)
	  | 
800
	    [< 'Genlex.Ident id ; pl = parse_pragma_list ic  >] 
801
802
803
804
805
806
	    -> 
	      (* When an ident is encountered, it can be a numeric one *)
	      let (_, vt) = List.find (fun (vn,vt) -> vn = id) vars in
		( match vt with
		    BoolT -> Bvar(id)
		  | _  -> 
807
808
809
810
		      print_err_msg  ic tok tok_list "parse_formula" "" 
		       (id ^ " is declared as a" ^
				" boolean and is used as a numeric.\n ");
		      failwith ""
811
812
		)
	)
813
814
815
816
817
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_formula"  
	("!\n\tIfThenElse\n\t==\n\ttrue\n\tfalse\n\t(\n\t||\n\t&&\n\t#\n\t=\n\t<>\n\t<\n\t>\n\t" ^
	 "<=\n\t>=\n\tpre") "";
	failwith ""
818
	    
819

820

821
(* 
822
823
824
 ** The following is copy-paste-adapted from sec 1.8 of the ocaml ref man 
 ** untitled ``pretty printing and parsing''.
 *)
825
826
827
and (parse_expr: in_channel -> vnt list -> aut_token -> expr) = 
  fun ic vars tok -> 
    let _ = print_debug ic ("parse_expr ic \n") in
828
    let tok_list = Stream.npeek 10 tok in
829
      try (
830
	match tok with parser  
831
	    [< e1 = parse_mult ic vars; e = parse_more_adds ic e1 vars >] -> e
832
      )
833
834
835
836
837
838
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_expr"  "" "";
	failwith ""
and (parse_more_adds: in_channel -> expr -> vnt list -> aut_token -> expr) = 
  fun ic e1 vars tok -> 
    let _ = print_debug ic ("parse_more_adds \n") in
839
    let tok_list = Stream.npeek 10 tok in
840
      try (
841
842
	match tok with parser  
	    [< 'Genlex.Kwd "+"; 
843
844
845
	       pl = parse_pragma_list ic  ;
	       e2 = parse_mult ic vars; 
	       e = parse_more_adds ic (Sum(e1, e2)) vars 
846
847
848
	    >] 
	    -> e
	  | [< 'Genlex.Kwd "-"; 
849
850
851
	       pl = parse_pragma_list ic  ;
	       e2 = parse_mult ic vars; 
	       e = parse_more_adds ic (Diff(e1, e2)) vars 
852
853
854
855
	    >] 
	    -> e
	  | [< >] 
	    -> e1
856
      )
857
858
859
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_more_adds"  "+ or -" "";
	failwith ""
860

861
862
863
and (parse_mult: in_channel -> vnt list -> aut_token -> expr) = 
  fun ic vars tok -> 
    let _ = print_debug ic ("parse_mult \n") in
864
    let tok_list = Stream.npeek 10 tok in
865
      try (
866
	match tok with parser  
867
	    [< e1 = parse_simple ic vars; e = parse_more_mults ic e1 vars >] -> e
868
      )
869
870
871
872
873
874
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_more_adds"  "" "";
	failwith ""
and (parse_more_mults: in_channel -> expr -> vnt list -> aut_token -> expr) = 
  fun ic e1 vars tok -> 
    let _ = print_debug ic ("parse_more_mults \n") in
875
    let tok_list = Stream.npeek 10 tok in
876
      try (
877
878
	match tok with parser  
	    [< 'Genlex.Kwd "*"; 
879
880
881
	       pl = parse_pragma_list ic  ;  
	       e2 = parse_simple ic vars; 
	       e = parse_more_mults ic (Prod(e1, e2)) vars 
882
883
884
	    >] 
	    -> e
	  | [< 'Genlex.Kwd "/"; 
885
886
887
	       pl = parse_pragma_list ic  ;  
	       e2 = parse_simple ic vars; 
	       e = parse_more_mults ic (Quot(e1, e2)) vars 
888
889
890
	    >] 
	    -> e
	  | [< 'Genlex.Ident "mod"; 
891
892
893
	       pl = parse_pragma_list ic  ; 
	       e2 = parse_simple ic vars; 
	       e = parse_more_mults ic (Mod(e1, e2)) vars 
894
895
896
897
	    >] 
	    -> e
	  | [<  >] 
	    -> e1
898
      )
899
900
901
902
903
904
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_more_mults"  "*\n\t/\n\t mod" "";
	failwith ""
and (parse_simple: in_channel -> vnt list -> aut_token -> expr) = 
  fun ic vars tok -> 
    let _ = print_debug ic ("parse_simple \n") in
905
    let tok_list = Stream.npeek 10 tok in
906
      try (
907
908
909
910
	match tok with parser  
	    
	  | [< 'Genlex.Ident "pre"; 'Genlex.Kwd "(";  
	       'Genlex.Int i ; 'Genlex.Kwd "," ; 'Genlex.Ident id;   
911
	       'Genlex.Kwd ")"; pl = parse_pragma_list ic   >] -> 
912
	      let s = Prevar.create_prevar_name i id in 
913
914
915
916
917
918
919
920
921
	      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 

922
	  | [< 'Genlex.Ident s ; pl = parse_pragma_list ic  >] -> 
923
924
925
926
927
928
929
930
931
	      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
		  
932
933
934
	  | [< 'Genlex.Kwd "-"; e = parse_minus_int_or_float ic vars >] -> e
	  | [< 'Genlex.Int i;   pl = parse_pragma_list ic  >] -> Ival(i)
	  | [< 'Genlex.Float f; pl = parse_pragma_list ic  >] -> Fval(f)
935

936
937
938
939
940
	  | [< 'Genlex.Kwd "IfThenElseNum";  pl = parse_pragma_list ic  ; 
	       f1 = parse_formula ic vars; 
	       e2 = parse_expr ic vars; 
	       e3 = parse_expr ic vars >] -> Ite(f1, e2, e3) 
	  | [< 'Genlex.Kwd "("; e = parse_expr ic vars; 'Genlex.Kwd ")" >] -> e
941

942
      )
943
944
945
946
947
948
949
950
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list 
	"parse_simple"  "pre ( <int> , <ident> )\n\t<ident>\n\t( <expr> )\n\t[-] <int>\n\t[-] <float>\n\tIfThenElseNum <formula> <expr> <expr>" 
	"";
	failwith ""
and (parse_minus_int_or_float: in_channel -> vnt list -> aut_token -> expr) = 
  fun ic vars tok -> 
    let _ = print_debug ic ("parse_minus_int_or_float \n") in
951
    let tok_list = Stream.npeek 10 tok in
952
      try (
953
	match tok with parser  
954
955
	    [< 'Genlex.Int i;   pl = parse_pragma_list ic  >] -> Ival(-i)
	  | [< 'Genlex.Float f; pl = parse_pragma_list ic  >] -> Fval(-.f)
956
      )
957
958
959
      with Failure _ -> failwith "" | e ->
        print_err_msg ic tok tok_list "parse_minus_int_or_float"  "<int>\n\t<float>" "";
	failwith ""