parse_env.ml 30.6 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
		 'Genlex.Ident "start_node"; 'Genlex.Kwd "="; 'Genlex.Int node_id  ; 
287
		 'Genlex.Kwd "," ;
288
		 'Genlex.Ident "arcs_nb"; 'Genlex.Kwd "="; 'Genlex.Int arcs_nb  ; 
289
290
291
		 'Genlex.Kwd "," ;
		 'Genlex.Ident "nodes_nb"; 'Genlex.Kwd "="; 'Genlex.Int nodes_nb ; 
		 'Genlex.Kwd "," ;
292
		 'Genlex.Ident "arcs"; 'Genlex.Kwd "="; la = parse_list_arc  ic
293
294
							       (List.append li (List.append lo (List.append ll lpre))) ;
		 'Genlex.Kwd ".";
295
	    >]
296
            -> Automata(node_id, li, lo, ll, lpre, llabel_ce, la)
297
	)
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
      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
317
318
    let tok_list = Stream.npeek 10 tok in
      try
319
320
321
322
323
324
	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 -> 
325
326
    let tok_list = Stream.npeek 10 tok in
      try
327
328
329
330
	(
	  match tok with parser  
	      [< 'Genlex.Kwd "("; 
		 'Genlex.Ident var; 
331
		 prag_var = parse_pragma_list ic; 
332
333
334
335
336
337
		 'Genlex.Kwd ",";  
		 'Genlex.Ident typ ; 
		 'Genlex.Kwd ")" >]
	      -> 
		( match typ with
		      "bool" -> (var, BoolT)
338
		    | "float" -> (var, FloatT(-.default_max_float, default_max_float))
339
340
		    | "int" -> (var, IntT(min_int / 2, max_int / 2))
			(* We divide by 2 so that domains are always smaller 
341
			   than max_int_float *)
342
343
344
		    | str -> 
			print_err_msg ic tok tok_list "parse_var" "" (str ^ " is not a valid type" );
			failwith ""
345
346
		)
	)
347
348
349
      with Failure _ -> failwith "" | e ->
	print_err_msg ic tok tok_list "parse_var"  "( <ident> , <type> )" "";
	failwith ""
350

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

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

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

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


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

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


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

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

818

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

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

920
	  | [< 'Genlex.Ident s ; pl = parse_pragma_list ic  >] -> 
921
922
923
924
925
926
927
928
929
	      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
		  
930
931
932
	  | [< '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)
933

934
935
936
937
938
	  | [< '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
939

940
      )
941
942
943
944
945
946
947
948
      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
949
    let tok_list = Stream.npeek 10 tok in
950
      try (
951
	match tok with parser  
952
953
	    [< 'Genlex.Int i;   pl = parse_pragma_list ic  >] -> Ival(-i)
	  | [< 'Genlex.Float f; pl = parse_pragma_list ic  >] -> Fval(-.f)
954
      )
955
956
957
      with Failure _ -> failwith "" | e ->
        print_err_msg ic tok tok_list "parse_minus_int_or_float"  "<int>\n\t<float>" "";
	failwith ""