Project

General

Profile

Download (22.1 KB) Statistics
| Branch: | Tag: | Revision:
1
/********************************************************************/
2
/*                                                                  */
3
/*  The LustreC compiler toolset   /  The LustreC Development Team  */
4
/*  Copyright 2012 -    --   ONERA - CNRS - INPT                    */
5
/*                                                                  */
6
/*  LustreC is free software, distributed WITHOUT ANY WARRANTY      */
7
/*  under the terms of the GNU Lesser General Public License        */
8
/*  version 2.1.                                                    */
9
/*                                                                  */
10
/********************************************************************/
11

    
12
%{
13
open Utils
14
open Lustre_types
15
open Corelang
16
open Dimension
17
open Parse
18

    
19
let get_loc () = Location.symbol_rloc ()
20

    
21
let mkident x = x, get_loc ()
22
let mktyp x = mktyp (get_loc ()) x
23
let mkclock x = mkclock (get_loc ()) x
24
let mkvar_decl x loc = mkvar_decl loc ~orig:true x
25
let mkexpr x = mkexpr (get_loc ()) x
26
let mkeexpr x = mkeexpr (get_loc ()) x 
27
let mkeq x = mkeq (get_loc ()) x
28
let mkassert x = mkassert (get_loc ()) x
29
let mktop_decl itf x = mktop_decl (get_loc ()) (Location.get_module ()) itf x
30
let mkpredef_call x = mkpredef_call (get_loc ()) x
31
(*let mkpredef_unary_call x = mkpredef_unary_call (get_loc ()) x*)
32

    
33
let mkdim_int i = mkdim_int (get_loc ()) i
34
let mkdim_bool b = mkdim_bool (get_loc ()) b
35
let mkdim_ident id = mkdim_ident (get_loc ()) id
36
let mkdim_appl f args = mkdim_appl (get_loc ()) f args
37
let mkdim_ite i t e = mkdim_ite (get_loc ()) i t e
38

    
39
let mkannots annots = { annots = annots; annot_loc = get_loc () }
40

    
41
let node_stack : ident list ref = ref []
42
let debug_calls () = Format.eprintf "call stack: %a@.@?" (Utils.fprintf_list ~sep:", " Format.pp_print_string) !node_stack
43
let push_node nd =  node_stack:= nd :: !node_stack
44
let pop_node () = try node_stack := List.tl !node_stack with _ -> assert false
45
let get_current_node () = try List.hd !node_stack with _ -> assert false
46

    
47
let rec fby expr n init =
48
  if n<=1 then
49
    mkexpr (Expr_arrow (init, mkexpr (Expr_pre expr)))
50
  else
51
    mkexpr (Expr_arrow (init, mkexpr (Expr_pre (fby expr (n-1) init))))
52

    
53
 
54
%}
55

    
56
%token <int> INT
57
%token <Num.num * int * string> REAL
58

    
59
%token <string> STRING
60
%token AUTOMATON STATE UNTIL UNLESS RESTART RESUME 
61
%token ASSERT OPEN INCLUDE QUOTE POINT FUNCTION
62
%token <string> IDENT
63
%token <string> UIDENT
64
%token TRUE FALSE
65
%token <Lustre_types.expr_annot> ANNOT
66
%token <Lustre_types.spec_types> NODESPEC
67
%token LBRACKET RBRACKET LCUR RCUR LPAR RPAR SCOL COL COMMA COLCOL 
68
%token AMPERAMPER BARBAR NOT POWER
69
%token IF THEN ELSE
70
%token MERGE FBY WHEN WHENNOT EVERY
71
%token NODE LET TEL RETURNS VAR IMPORTED TYPE CONST
72
%token STRUCT ENUM
73
%token TINT TREAL TBOOL TCLOCK
74
%token EQ LT GT LTE GTE NEQ
75
%token AND OR XOR IMPL
76
%token MULT DIV MOD
77
%token MINUS PLUS UMINUS
78
%token PRE ARROW
79
%token REQUIRE ENSURE ASSUME GUARANTEES IMPORT CONTRACT
80
%token INVARIANT MODE CCODE MATLAB
81
%token EXISTS FORALL
82
%token PROTOTYPE LIB
83
%token EOF
84

    
85
%nonassoc prec_exists prec_forall
86
%nonassoc COMMA
87
%nonassoc EVERY
88
%left MERGE IF
89
%nonassoc ELSE
90
%right ARROW FBY
91
%left WHEN WHENNOT 
92
%right COLCOL
93
%right IMPL
94
%left OR XOR BARBAR
95
%left AND AMPERAMPER
96
%left NOT
97
%nonassoc INT
98
%nonassoc EQ LT GT LTE GTE NEQ
99
%left MINUS PLUS
100
%left MULT DIV MOD
101
%left UMINUS
102
%left POWER
103
%left PRE LAST
104
%nonassoc RBRACKET
105
%nonassoc LBRACKET
106

    
107
%start prog
108
%type <Lustre_types.top_decl list> prog
109

    
110
%start header
111
%type <Lustre_types.top_decl list> header
112

    
113
%start lustre_annot
114
%type <Lustre_types.expr_annot> lustre_annot
115

    
116
%start lustre_spec
117
%type <Lustre_types.spec_types> lustre_spec
118

    
119
%start signed_const
120
%type <Lustre_types.constant> signed_const
121

    
122
%start expr
123
%type <Lustre_types.expr> expr
124

    
125
%start stmt_list
126
%type <Lustre_types.statement list * Lustre_types.assert_t list * Lustre_types.expr_annot list > stmt_list
127

    
128
%start vdecl_list
129
%type <Lustre_types.var_decl list> vdecl_list
130
%%
131

    
132

    
133
module_ident:
134
  UIDENT { $1 }
135
| IDENT  { $1 }
136

    
137
file_ident:
138
module_ident { $1 } 
139
| module_ident POINT file_ident { $1 ^ "." ^ $3 } 
140

    
141
path_ident:
142
POINT DIV path_ident { "./" ^ $3 }
143
| file_ident DIV path_ident { $1 ^ "/" ^ $3 }
144
| DIV path_ident { "/" ^ $2 }
145
| file_ident { $1 }
146

    
147
tag_bool:
148
  | TRUE    { tag_true }
149
  | FALSE   { tag_false }
150

    
151
tag_ident:
152
  UIDENT  { $1 }
153
  | tag_bool { $1 }
154

    
155
node_ident:
156
  UIDENT { $1 }
157
| IDENT  { $1 }
158

    
159
node_ident_decl:
160
 node_ident { push_node $1; $1 }
161

    
162
vdecl_ident:
163
  UIDENT { mkident $1 }
164
| IDENT  { mkident $1 }
165

    
166
const_ident:
167
  UIDENT { $1 }
168
| IDENT  { $1 }
169

    
170
type_ident:
171
  IDENT { $1 }
172

    
173
prog:
174
 prefix_prog top_decl_list EOF { $1 @ (List.rev $2) }
175

    
176
prefix_prog:
177
    { [] }
178
  | open_lusi prefix_prog { $1 :: $2 }
179
  | typ_def prefix_prog   { ($1 false (* not a header *)) :: $2 }
180

    
181
prefix_header:
182
    { [] }
183
  | open_lusi prefix_header { $1 :: $2 }
184
  | typ_def prefix_header   { ($1 true (* is a header *)) :: $2 }
185

    
186
header:
187
 prefix_header top_decl_header_list EOF { $1 @ (List.rev $2) }
188

    
189

    
190
open_lusi:
191
  | OPEN QUOTE path_ident QUOTE { mktop_decl false (Open (true, $3)) }
192
  | INCLUDE QUOTE path_ident QUOTE { mktop_decl false (Include ($3)) }
193
  | OPEN LT path_ident GT { mktop_decl false (Open (false, $3))  }
194

    
195
top_decl_list:
196
   {[]}
197
| top_decl_list top_decl {$2@$1}
198

    
199

    
200
top_decl_header_list:
201
   { [] }
202
| top_decl_header_list top_decl_header { $2@$1 }
203

    
204
state_annot:
205
  FUNCTION { true }
206
| NODE { false }
207

    
208
top_decl_header:
209
| CONST cdecl_list { List.rev ($2 true) }
210
| nodespecs state_annot node_ident_decl LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR  prototype_opt in_lib_list SCOL
211
    {
212
      let inputs = List.rev $5 in
213
      let outputs = List.rev $10 in
214
      let nd = mktop_decl true (ImportedNode
215
				 {nodei_id = $3;
216
				  nodei_type = Types.new_var ();
217
				  nodei_clock = Clocks.new_var true;
218
				  nodei_inputs = inputs;
219
				  nodei_outputs = outputs;
220
				  nodei_stateless = $2;
221
				  nodei_spec = $1;
222
				  nodei_prototype = $13;
223
				  nodei_in_lib = $14;})
224
     in
225
     pop_node ();
226
     [nd] } 
227
| top_contract { [$1] }
228

    
229

    
230
prototype_opt:
231
 { None }
232
| PROTOTYPE node_ident { Some $2}
233

    
234
in_lib_list:
235
{ [] }
236
| LIB module_ident in_lib_list { $2::$3 } 
237

    
238
top_decl:
239
| CONST cdecl_list { List.rev ($2 false) }
240
| state_annot node_ident_decl LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL_opt nodespecs locals LET stmt_list TEL 
241
    {
242
     let stmts, asserts, annots = $16 in
243
      (* Declaring eqs annots *)
244
      List.iter (fun ann -> 
245
	List.iter (fun (key, _) -> 
246
	  Annotations.add_node_ann $2 key
247
	) ann.annots
248
      ) annots;
249
      (* Building the node *)
250
      let inputs = List.rev $4 in
251
      let outputs = List.rev $9 in
252
     let nd = mktop_decl false (Node
253
				  {node_id = $2;
254
				   node_type = Types.new_var ();
255
				   node_clock = Clocks.new_var true;
256
				   node_inputs = inputs;
257
				   node_outputs = outputs;
258
				   node_locals = List.rev $14;
259
				   node_gencalls = [];
260
				   node_checks = [];
261
				   node_asserts = asserts; 
262
				   node_stmts = stmts;
263
				   node_dec_stateless = $1;
264
				   node_stateless = None;
265
				   node_spec = $13;
266
				   node_annot = annots;
267
				   node_iscontract = false;
268
			       })
269
     in
270
     pop_node ();
271
     (*add_node $3 nd;*) [nd] }
272

    
273

    
274
| NODESPEC
275
    { match $1 with
276
      | LocalContract c -> assert false
277
      | TopContract c   -> c
278
			 
279
    }
280

    
281
nodespecs:
282
nodespec_list {
283
  match $1 with
284
  | None -> None 
285
  | Some c -> Some (Contract c)
286
}
287

    
288
nodespec_list:
289
 { None }
290
  | NODESPEC nodespec_list {
291
	       let extract x = match x with LocalContract c -> c | _ -> assert false in
292
	       let s1 = extract $1 in
293
	       match $2 with
294
	       | None -> Some s1
295
	       | Some s2 -> Some (merge_contracts s1 s2) }
296

    
297
typ_def_list:
298
    /* empty */             { (fun itf -> []) }
299
| typ_def typ_def_list { (fun itf -> let ty1 = ($1 itf) in ty1 :: ($2 itf)) }
300

    
301
typ_def:
302
  TYPE type_ident EQ typ_def_rhs SCOL { (fun itf ->
303
			       let typ = mktop_decl itf (TypeDef { tydef_id = $2;
304
								   tydef_desc = $4
305
							})
306
			       in (*add_type itf $2 typ;*) typ) }
307

    
308
typ_def_rhs:
309
  typeconst                   { $1 }
310
| ENUM LCUR tag_list RCUR     { Tydec_enum (List.rev $3) }
311
| STRUCT LCUR field_list RCUR { Tydec_struct (List.rev $3) }
312

    
313
array_typ_decl:
314
 %prec POWER                { fun typ -> typ }
315
 | POWER dim array_typ_decl { fun typ -> $3 (Tydec_array ($2, typ)) }
316

    
317
typeconst:
318
  TINT array_typ_decl   { $2 Tydec_int }
319
| TBOOL array_typ_decl  { $2 Tydec_bool  }
320
| TREAL array_typ_decl  { $2 Tydec_real  }
321
/* | TFLOAT array_typ_decl { $2 Tydec_float } */
322
| type_ident array_typ_decl  { $2 (Tydec_const $1) }
323
| TBOOL TCLOCK          { Tydec_clock Tydec_bool }
324
| IDENT TCLOCK          { Tydec_clock (Tydec_const $1) }
325

    
326
tag_list:
327
  UIDENT                { $1 :: [] }
328
| tag_list COMMA UIDENT { $3 :: $1 }
329
      
330
field_list:                           { [] }
331
| field_list IDENT COL typeconst SCOL { ($2, $4) :: $1 }
332
      
333
stmt_list:
334
  { [], [], [] }
335
| eq stmt_list {let eql, assertl, annotl = $2 in ((Eq $1)::eql), assertl, annotl}
336
| assert_ stmt_list {let eql, assertl, annotl = $2 in eql, ($1::assertl), annotl}
337
| ANNOT stmt_list {let eql, assertl, annotl = $2 in eql, assertl, $1::annotl}
338
| automaton stmt_list {let eql, assertl, annotl = $2 in ((Aut $1)::eql), assertl, annotl}
339

    
340
automaton:
341
 AUTOMATON type_ident handler_list { Automata.mkautomata (get_loc ()) $2 $3 }
342

    
343
handler_list:
344
     { [] }
345
| handler handler_list { $1::$2 }
346

    
347
handler:
348
 STATE UIDENT COL unless_list locals LET stmt_list TEL until_list { Automata.mkhandler (get_loc ()) $2 $4 $9 $5 $7 }
349

    
350
unless_list:
351
    { [] }
352
| unless unless_list { $1::$2 }
353

    
354
until_list:
355
    { [] }
356
| until until_list { $1::$2 }
357

    
358
unless:
359
  UNLESS expr RESTART UIDENT { (get_loc (), $2, true, $4)  }
360
| UNLESS expr RESUME UIDENT  { (get_loc (), $2, false, $4) }
361

    
362
until:
363
  UNTIL expr RESTART UIDENT { (get_loc (), $2, true, $4)  }
364
| UNTIL expr RESUME UIDENT  { (get_loc (), $2, false, $4) }
365

    
366
assert_:
367
| ASSERT expr SCOL {mkassert ($2)}
368

    
369
eq:
370
       ident_list      EQ expr SCOL {mkeq (List.rev (List.map fst $1), $3)}
371
| LPAR ident_list RPAR EQ expr SCOL {mkeq (List.rev (List.map fst $2), $5)}
372

    
373
lustre_spec:
374
| top_contracts EOF     { TopContract $1 }
375
| contract_content EOF { LocalContract $1}
376

    
377
top_contracts:
378
| top_contract { [$1] }
379
| top_contract top_contracts { $1::$2 }
380

    
381
top_contract:
382
| CONTRACT node_ident_decl LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR SCOL_opt LET contract_content TEL 
383
    {
384
      let nd = mktop_decl true (Node
385
				 {node_id = $2;
386
				  node_type = Types.new_var ();
387
				  node_clock = Clocks.new_var true;
388
				  node_inputs = List.rev $4;
389
				  node_outputs = List.rev $9;
390
				  node_locals = []; (* will be filled later *)
391
				  node_gencalls = [];
392
				  node_checks = [];
393
				  node_asserts = [];
394
				  node_stmts = []; (* will be filled later *)
395
				  node_dec_stateless = false;
396
				  (* By default we assume contracts as stateful *)
397
				  node_stateless = None;
398
				  node_spec = Some (Contract $14);
399
				  node_annot = [];
400
				  node_iscontract = true;
401
				 }
402
			       )
403
     in
404
     pop_node ();
405
     (*add_imported_node $3 nd;*)
406
     nd }
407

    
408
contract_content:
409
{ empty_contract }
410
| CONTRACT contract_content { $2 }
411
| CONST IDENT EQ expr SCOL contract_content
412
    { merge_contracts (mk_contract_var $2 true None $4 (get_loc())) $6 }
413
| CONST IDENT COL typeconst EQ expr SCOL contract_content
414
    { merge_contracts (mk_contract_var $2 true (Some(mktyp $4)) $6 (get_loc())) $8 }
415
| VAR IDENT COL typeconst EQ expr SCOL contract_content
416
    { merge_contracts (mk_contract_var $2 false (Some(mktyp $4)) $6 (get_loc())) $8 }
417
| ASSUME qexpr SCOL contract_content
418
    { merge_contracts (mk_contract_assume $2) $4 }
419
| ASSUME STRING qexpr SCOL contract_content
420
    { merge_contracts (mk_contract_assume ~name:$2 $3) $5 }
421
| GUARANTEES qexpr SCOL contract_content	
422
    { merge_contracts (mk_contract_guarantees $2) $4 }
423
| GUARANTEES STRING qexpr SCOL contract_content	
424
    { merge_contracts (mk_contract_guarantees ~name:$2 $3) $5 }
425
| MODE IDENT LPAR mode_content RPAR SCOL contract_content
426
	{ merge_contracts (
427
	  let r, e = $4 in 
428
	  mk_contract_mode $2 r e (get_loc())) $7 }	
429
| IMPORT IDENT LPAR tuple_expr RPAR RETURNS LPAR tuple_expr RPAR SCOL contract_content
430
    { merge_contracts (mk_contract_import $2  (mkexpr (Expr_tuple (List.rev $4)))  (mkexpr (Expr_tuple (List.rev $8))) (get_loc())) $11 }
431
| IMPORT IDENT LPAR expr RPAR RETURNS LPAR tuple_expr RPAR SCOL contract_content
432
    { merge_contracts (mk_contract_import $2  $4  (mkexpr (Expr_tuple (List.rev $8))) (get_loc())) $11 }
433
| IMPORT IDENT LPAR tuple_expr RPAR RETURNS LPAR expr RPAR SCOL contract_content
434
    { merge_contracts (mk_contract_import $2  (mkexpr (Expr_tuple (List.rev $4)))  $8 (get_loc())) $11 }
435
| IMPORT IDENT LPAR expr RPAR RETURNS LPAR expr RPAR SCOL contract_content
436
    { merge_contracts (mk_contract_import $2  $4  $8 (get_loc())) $11 }
437

    
438
mode_content:
439
{ [], [] }
440
| REQUIRE qexpr SCOL mode_content { let (r,e) = $4 in $2::r, e }
441
| REQUIRE STRING qexpr SCOL mode_content { let (r,e) = $5 in {$3 with eexpr_name = Some $2}::r, e }
442
| ENSURE qexpr SCOL mode_content { let (r,e) = $4 in r, $2::e }
443
| ENSURE STRING qexpr SCOL mode_content { let (r,e) = $5 in r, {$3 with eexpr_name = Some $2}::e }
444

    
445
/* WARNING: UNUSED RULES */
446
tuple_qexpr:
447
| qexpr COMMA qexpr {[$3;$1]}
448
| tuple_qexpr COMMA qexpr {$3::$1}
449

    
450
qexpr:
451
| expr { mkeexpr $1 }
452
  /* Quantifiers */
453
| EXISTS vdecl SCOL qexpr %prec prec_exists { extend_eexpr [Exists, $2] $4 } 
454
| FORALL vdecl SCOL qexpr %prec prec_forall { extend_eexpr [Forall, $2] $4 }
455

    
456

    
457
tuple_expr:
458
    expr COMMA expr {[$3;$1]}
459
| tuple_expr COMMA expr {$3::$1}
460

    
461
// Same as tuple expr but accepting lists with single element
462
array_expr:
463
  expr {[$1]}
464
| expr COMMA array_expr {$1::$3}
465

    
466
dim_list:
467
  dim RBRACKET { fun base -> mkexpr (Expr_access (base, $1)) }
468
| dim RBRACKET LBRACKET dim_list { fun base -> $4 (mkexpr (Expr_access (base, $1))) }
469

    
470
expr:
471
/* constants */
472
  INT {mkexpr (Expr_const (Const_int $1))}
473
| REAL {let c,e,s = $1 in mkexpr (Expr_const (Const_real (c,e,s)))}
474
| STRING {mkexpr (Expr_const (Const_string $1))}
475
| COLCOL IDENT {mkexpr (Expr_const (Const_modeid $2))} 
476
    
477
/* | FLOAT {mkexpr (Expr_const (Const_float $1))}*/
478
/* Idents or type enum tags */
479
| IDENT { mkexpr (Expr_ident $1) }
480
| UIDENT { mkexpr (Expr_ident $1) (* TODO we will differenciate enum constants from variables later *) }
481
| tag_bool {
482
	(* on sept 2014, X chenged the Const to 
483
	mkexpr (Expr_ident $1)
484
	reverted back to const on july 2019 *)
485
	mkexpr (Expr_const (Const_tag $1)) }
486
| LPAR ANNOT expr RPAR
487
    {update_expr_annot (get_current_node ()) $3 $2}
488
| LPAR expr RPAR
489
    {$2}
490
| LPAR tuple_expr RPAR
491
    {mkexpr (Expr_tuple (List.rev $2))}
492

    
493
/* Array expressions */
494
| LBRACKET array_expr RBRACKET { mkexpr (Expr_array $2) }
495
| expr POWER dim { mkexpr (Expr_power ($1, $3)) }
496
| expr LBRACKET dim_list { $3 $1 }
497

    
498
/* Temporal operators */
499
| PRE expr 
500
    {mkexpr (Expr_pre $2)}
501
| expr ARROW expr 
502
    {mkexpr (Expr_arrow ($1,$3))}
503
| expr FBY expr 
504
    {(*mkexpr (Expr_fby ($1,$3))*)
505
      mkexpr (Expr_arrow ($1, mkexpr (Expr_pre $3)))}
506
| expr WHEN vdecl_ident
507
    {mkexpr (Expr_when ($1,fst $3,tag_true))}
508
| expr WHENNOT vdecl_ident
509
    {mkexpr (Expr_when ($1,fst $3,tag_false))}
510
| expr WHEN tag_ident LPAR vdecl_ident RPAR
511
    {mkexpr (Expr_when ($1, fst $5, $3))}
512
| MERGE vdecl_ident handler_expr_list
513
    {mkexpr (Expr_merge (fst $2,$3))}
514

    
515
/* Applications */
516
| node_ident LPAR expr RPAR
517
    {mkexpr (Expr_appl ($1, $3, None))}
518
| node_ident LPAR expr RPAR EVERY expr
519
    {mkexpr (Expr_appl ($1, $3, Some $6))}
520
| node_ident LPAR tuple_expr RPAR
521
    {
522
      let id=$1 in
523
      let args=List.rev $3 in
524
      match id, args with
525
      | "fbyn", [expr;n;init] ->
526
	let n = match n.expr_desc with
527
	  | Expr_const (Const_int n) -> n
528
	  | _ -> assert false
529
	in
530
	fby expr n init
531
      | _ -> mkexpr (Expr_appl ($1, mkexpr (Expr_tuple args), None))
532
    }
533
| node_ident LPAR tuple_expr RPAR EVERY expr
534
    {
535
      let id=$1 in
536
      let args=List.rev $3 in
537
      let clock=$6 in
538
      if id="fby" then
539
	assert false (* TODO Ca veut dire quoi fby (e,n,init) every c *)
540
      else
541
	mkexpr (Expr_appl (id, mkexpr (Expr_tuple args), Some clock)) 
542
    }
543

    
544
/* Boolean expr */
545
| expr AND expr 
546
    {mkpredef_call "&&" [$1;$3]}
547
| expr AMPERAMPER expr 
548
    {mkpredef_call "&&" [$1;$3]}
549
| expr OR expr 
550
    {mkpredef_call "||" [$1;$3]}
551
| expr BARBAR expr 
552
    {mkpredef_call "||" [$1;$3]}
553
| expr XOR expr 
554
    {mkpredef_call "xor" [$1;$3]}
555
| NOT expr 
556
    {mkpredef_call "not" [$2]}
557
| expr IMPL expr 
558
    {mkpredef_call "impl" [$1;$3]}
559

    
560
/* Comparison expr */
561
| expr EQ expr 
562
    {mkpredef_call "=" [$1;$3]}
563
| expr LT expr 
564
    {mkpredef_call "<" [$1;$3]}
565
| expr LTE expr 
566
    {mkpredef_call "<=" [$1;$3]}
567
| expr GT expr 
568
    {mkpredef_call ">" [$1;$3]}
569
| expr GTE  expr 
570
    {mkpredef_call ">=" [$1;$3]}
571
| expr NEQ expr 
572
    {mkpredef_call "!=" [$1;$3]}
573

    
574
/* Arithmetic expr */
575
| expr PLUS expr 
576
    {mkpredef_call "+" [$1;$3]}
577
| expr MINUS expr 
578
    {mkpredef_call "-" [$1;$3]}
579
| expr MULT expr 
580
    {mkpredef_call "*" [$1;$3]}
581
| expr DIV expr 
582
    {mkpredef_call "/" [$1;$3]}
583
| MINUS expr %prec UMINUS
584
  {mkpredef_call "uminus" [$2]}
585
| expr MOD expr 
586
    {mkpredef_call "mod" [$1;$3]}
587

    
588
/* If */
589
| IF expr THEN expr ELSE expr
590
    {mkexpr (Expr_ite ($2, $4, $6))}
591

    
592
handler_expr_list:
593
   { [] }
594
| handler_expr handler_expr_list { $1 :: $2 }
595

    
596
handler_expr:
597
 LPAR tag_ident ARROW expr RPAR { ($2, $4) }
598

    
599
signed_const_array:
600
| signed_const { [$1] }
601
| signed_const COMMA signed_const_array { $1 :: $3 }
602

    
603
signed_const_struct:
604
| IDENT EQ signed_const { [ ($1, $3) ] }
605
| IDENT EQ signed_const COMMA signed_const_struct { ($1, $3) :: $5 }
606

    
607
signed_const:
608
  INT {Const_int $1}
609
| REAL {let c,e,s =$1 in Const_real (c,e,s)}
610
/* | FLOAT {Const_float $1} */
611
| tag_ident {Const_tag $1}
612
| MINUS INT {Const_int (-1 * $2)}
613
| MINUS REAL {let c,e,s = $2 in Const_real (Num.minus_num c, e, "-" ^ s)}
614
/* | MINUS FLOAT {Const_float (-1. *. $2)} */
615
| LCUR signed_const_struct RCUR { Const_struct $2 }
616
| LBRACKET signed_const_array RBRACKET { Const_array $2 }
617

    
618
dim:
619
   INT { mkdim_int $1 }
620
| LPAR dim RPAR { $2 }
621
| UIDENT { mkdim_ident $1 }
622
| IDENT { mkdim_ident $1 }
623
| dim AND dim 
624
    {mkdim_appl "&&" [$1;$3]}
625
| dim AMPERAMPER dim 
626
    {mkdim_appl "&&" [$1;$3]}
627
| dim OR dim 
628
    {mkdim_appl "||" [$1;$3]}
629
| dim BARBAR dim 
630
    {mkdim_appl "||" [$1;$3]}
631
| dim XOR dim 
632
    {mkdim_appl "xor" [$1;$3]}
633
| NOT dim 
634
    {mkdim_appl "not" [$2]}
635
| dim IMPL dim 
636
    {mkdim_appl "impl" [$1;$3]}
637

    
638
/* Comparison dim */
639
| dim EQ dim 
640
    {mkdim_appl "=" [$1;$3]}
641
| dim LT dim 
642
    {mkdim_appl "<" [$1;$3]}
643
| dim LTE dim 
644
    {mkdim_appl "<=" [$1;$3]}
645
| dim GT dim 
646
    {mkdim_appl ">" [$1;$3]}
647
| dim GTE  dim 
648
    {mkdim_appl ">=" [$1;$3]}
649
| dim NEQ dim 
650
    {mkdim_appl "!=" [$1;$3]}
651

    
652
/* Arithmetic dim */
653
| dim PLUS dim 
654
    {mkdim_appl "+" [$1;$3]}
655
| dim MINUS dim 
656
    {mkdim_appl "-" [$1;$3]}
657
| dim MULT dim 
658
    {mkdim_appl "*" [$1;$3]}
659
| dim DIV dim 
660
    {mkdim_appl "/" [$1;$3]}
661
| MINUS dim %prec UMINUS
662
  {mkdim_appl "uminus" [$2]}
663
| dim MOD dim 
664
    {mkdim_appl "mod" [$1;$3]}
665
/* If */
666
| IF dim THEN dim ELSE dim
667
    {mkdim_ite $2 $4 $6}
668

    
669
locals:
670
  {[]}
671
| VAR local_vdecl_list SCOL {$2}
672

    
673
vdecl_list:
674
  vdecl {$1}
675
| vdecl_list SCOL vdecl {$3 @ $1}
676

    
677
vdecl:
678
  ident_list COL typeconst clock 
679
    { List.map (fun (id, loc) -> mkvar_decl (id, mktyp $3, $4, false, None, None) loc) $1 }
680
| CONST ident_list /* static parameters don't have clocks */
681
    { List.map (fun (id, loc) -> mkvar_decl (id, mktyp Tydec_any, mkclock Ckdec_any, true, None, None) loc) $2 }
682
| CONST ident_list COL typeconst /* static parameters don't have clocks */
683
    { List.map (fun (id, loc) -> mkvar_decl (id, mktyp $4, mkclock Ckdec_any, true, None, None) loc) $2 }
684

    
685
local_vdecl_list:
686
  local_vdecl {$1}
687
| local_vdecl_list SCOL local_vdecl {$3 @ $1}
688

    
689
local_vdecl:
690
/* Useless no ?*/    ident_list
691
    { List.map (fun (id, loc) -> mkvar_decl (id, mktyp Tydec_any, mkclock Ckdec_any, false, None, None) loc) $1 }
692
| ident_list COL typeconst clock 
693
    { List.map (fun (id, loc) -> mkvar_decl (id, mktyp $3, $4, false, None, None) loc) $1 }
694
| CONST vdecl_ident EQ expr /* static parameters don't have clocks */
695
    { let (id, loc) = $2 in [ mkvar_decl (id, mktyp Tydec_any, mkclock Ckdec_any, true, Some $4, None) loc] }
696
| CONST vdecl_ident COL typeconst EQ expr /* static parameters don't have clocks */
697
    { let (id, loc) = $2 in [ mkvar_decl (id, mktyp $4, mkclock Ckdec_any, true, Some $6, None) loc] }
698

    
699
cdecl_list:
700
  cdecl SCOL { (fun itf -> [$1 itf]) }
701
| cdecl cdecl_list SCOL { (fun itf -> let c1 = ($1 itf) in c1::($2 itf)) }
702

    
703
cdecl:
704
    const_ident EQ signed_const {
705
      (fun itf -> 
706
       let c = mktop_decl itf (Const {
707
				   const_id = $1;
708
				   const_loc = Location.symbol_rloc ();
709
				   const_type = Types.new_var ();
710
				   const_value = $3})
711
       in
712
       (*add_const itf $1 c;*) c)
713
    }
714

    
715
clock:
716
    {mkclock Ckdec_any}
717
| when_list
718
    {mkclock (Ckdec_bool (List.rev $1))}
719

    
720
when_cond:
721
  WHEN IDENT {($2, tag_true)}
722
| WHENNOT IDENT {($2, tag_false)}
723
| WHEN tag_ident LPAR IDENT RPAR {($4, $2)}
724

    
725
when_list:
726
    when_cond {[$1]}
727
| when_list when_cond {$2::$1}
728

    
729
ident_list:
730
  vdecl_ident {[$1]}
731
| ident_list COMMA vdecl_ident {$3::$1}
732

    
733
SCOL_opt:
734
    SCOL {} | {}
735

    
736

    
737
lustre_annot:
738
lustre_annot_list EOF { { annots = $1; annot_loc = get_loc () } }
739

    
740
lustre_annot_list:
741
  { [] } 
742
| kwd COL qexpr SCOL lustre_annot_list { ($1,$3)::$5 }
743
| IDENT COL qexpr SCOL lustre_annot_list { ([$1],$3)::$5 }
744
| INVARIANT COL qexpr SCOL lustre_annot_list{ (["invariant"],$3)::$5 }
745
// (* | OBSERVER COL qexpr SCOL lustre_annot_list { (["observer"],$3)::$5 } *)
746
| CCODE COL qexpr SCOL lustre_annot_list{ (["c_code"],$3)::$5 }
747
| MATLAB COL qexpr SCOL lustre_annot_list{ (["matlab"],$3)::$5 }
748

    
749

    
750
kwd:
751
DIV { [] }
752
| DIV IDENT kwd { $2::$3}
753

    
754
%%
755
(* Local Variables: *)
756
(* compile-command:"make -C .." *)
757
(* End: *)
758

    
759

    
(7-7/7)