Project

General

Profile

Revision b1655a21 src/parser_lustre.mly

View differences:

src/parser_lustre.mly
10 10
/********************************************************************/
11 11

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

  
18 19
let get_loc () = Location.symbol_rloc ()
19 20
let mktyp x = mktyp (get_loc ()) x
......
35 36

  
36 37
let mkannots annots = { annots = annots; annot_loc = get_loc () }
37 38

  
38
let add_node loc own msg hashtbl name value =
39
  try
40
    match (Hashtbl.find hashtbl name).top_decl_desc, value.top_decl_desc with
41
    | Node _        , ImportedNode _ when own   -> ()
42
    | ImportedNode _, _                         -> Hashtbl.add hashtbl name value
43
    | Node _        , _                         -> raise (Error (loc, Already_bound_symbol msg))
44
    | _                                         -> assert false
45
  with
46
    Not_found                                   -> Hashtbl.add hashtbl name value
47

  
48

  
49
let add_symbol loc msg hashtbl name value =
50
 if Hashtbl.mem hashtbl name
51
 then raise (Error (loc, Already_bound_symbol msg))
52
 else Hashtbl.add hashtbl name value
53

  
54
let check_symbol loc msg hashtbl name =
55
 if not (Hashtbl.mem hashtbl name)
56
 then raise (Error (loc, Unbound_symbol msg))
57
 else ()
58

  
59
let check_node_symbol msg name value =
60
 if Hashtbl.mem node_table name
61
 then () (* TODO: should we check the types here ? *)
62
 else Hashtbl.add node_table name value
63

  
64 39
%}
65 40

  
66 41
%token <int> INT
......
128 103
%%
129 104

  
130 105
prog:
131
 open_list typ_def_list top_decl_list EOF { $1 @ (List.rev $3) }
106
 open_list typ_def_prog top_decl_list EOF { $1 @ $2 @ (List.rev $3) }
107

  
108
typ_def_prog:
109
 typ_def_list { $1 true }
132 110

  
133 111
header:
134
 open_list typ_def_list top_decl_header_list EOF { (fun own -> ($1 @ (List.rev ($3 own)))) }
112
 open_list typ_def_list top_decl_header_list EOF { (fun own -> ($1 @ let typs = $2 own in typs @ (List.rev ($3 own)))) }
135 113

  
136 114
open_list:
137 115
  { [] }
......
142 120
| OPEN LT IDENT GT { mktop_decl (Open (false, $3)) }
143 121

  
144 122
top_decl_list:
145
  top_decl {[$1]}
123
   {[]}
146 124
| top_decl_list top_decl {$2::$1}
147 125

  
148 126

  
149 127
top_decl_header_list:
150
  top_decl_header {(fun own -> [$1 own]) }
151
| top_decl_header_list top_decl_header {(fun own -> ($2 own)::($1 own)) }
128
   {(fun own -> []) }
129
| top_decl_header_list top_decl_header {(fun own -> let h1 = $1 own in ($2 own)::h1) }
152 130

  
153 131
state_annot:
154 132
  FUNCTION { true }
......
168 146
			     nodei_prototype = $13;
169 147
			     nodei_in_lib = $14;})
170 148
    in
171
     check_node_symbol ("node " ^ $3) $3 nd; 
172
     let loc = get_loc () in
173
     (fun own -> add_node loc own ("node " ^ $3) node_table $3 nd; nd) }
149
     (fun own -> add_node own $3 nd; nd) }
174 150

  
175 151
prototype_opt:
176 152
 { None }
......
200 176
			     node_spec = $1;
201 177
			     node_annot = annots})
202 178
     in
203
     let loc = Location.symbol_rloc () in
204
     add_node loc true ("node " ^ $3) node_table $3 nd; nd}
179
     add_node true $3 nd; nd}
205 180

  
206 181
nodespec_list:
207 182
 { None }
......
211 186
  | Some s2 -> (fun s1 -> Some (merge_node_annot s1 s2))) $2 $1 }
212 187

  
213 188
typ_def_list:
214
    /* empty */ {}
215
| typ_def SCOL typ_def_list {$1;$3}
189
    /* empty */             { (fun own -> []) }
190
| typ_def SCOL typ_def_list { (fun own -> let ty1 = ($1 own) in ty1 :: ($3 own)) }
216 191

  
217 192
typ_def:
218
  TYPE IDENT EQ typeconst {
219
    try
220
      let loc = Location.symbol_rloc () in
221
      add_symbol loc ("type " ^ $2) type_table (Tydec_const $2) (get_repr_type $4)
222
    with Not_found-> assert false }
223
| TYPE IDENT EQ ENUM LCUR tag_list RCUR { Hashtbl.add type_table (Tydec_const $2) (Tydec_enum ($6 (Tydec_const $2))) }
224
| TYPE IDENT EQ STRUCT LCUR field_list RCUR { Hashtbl.add type_table (Tydec_const $2) (Tydec_struct ($6 (Tydec_const $2))) }
193
  TYPE IDENT EQ typ_def_rhs { let typ = mktop_decl (Type { ty_def_id = $2;
194
							   ty_def_desc = $4
195
							 })
196
			      in (fun own -> add_type own $2 typ; typ) }
197

  
198
typ_def_rhs:
199
  typeconst                   { $1 }
200
| ENUM LCUR tag_list RCUR     { Tydec_enum (List.rev $3) }
201
| STRUCT LCUR field_list RCUR { Tydec_struct (List.rev $3) }
225 202

  
226 203
array_typ_decl:
227 204
                            { fun typ -> typ }
228 205
 | POWER dim array_typ_decl { fun typ -> $3 (Tydec_array ($2, typ)) }
229 206

  
230 207
typeconst:
231
  TINT array_typ_decl  { $2 Tydec_int }
232
| TBOOL array_typ_decl { $2 Tydec_bool  }
233
| TREAL array_typ_decl { $2 Tydec_real  }
208
  TINT array_typ_decl   { $2 Tydec_int }
209
| TBOOL array_typ_decl  { $2 Tydec_bool  }
210
| TREAL array_typ_decl  { $2 Tydec_real  }
234 211
| TFLOAT array_typ_decl { $2 Tydec_float }
235
| IDENT array_typ_decl { 
236
        let loc = Location.symbol_rloc () in
237
	check_symbol loc ("type " ^ $1) type_table (Tydec_const $1); $2 (Tydec_const $1) }
238
| TBOOL TCLOCK  { Tydec_clock Tydec_bool }
239
| IDENT TCLOCK  { Tydec_clock (Tydec_const $1) }
212
| IDENT array_typ_decl  { $2 (Tydec_const $1) }
213
| TBOOL TCLOCK          { Tydec_clock Tydec_bool }
214
| IDENT TCLOCK          { Tydec_clock (Tydec_const $1) }
240 215

  
241 216
tag_list:
242
  IDENT
243
  { let loc = Location.symbol_rloc () in 
244
    (fun t -> 
245
      add_symbol loc ("tag " ^ $1) tag_table $1 t; $1 :: []) }
246
| tag_list COMMA IDENT
247
      {       
248
	let loc = Location.symbol_rloc () in
249
	(fun t -> add_symbol loc ("tag " ^ $3)tag_table $3 t; $3 :: ($1 t)) 
250
      }
217
  IDENT                { $1 :: [] }
218
| tag_list COMMA IDENT { $3 :: $1 }
251 219
      
252
field_list:
253
  { (fun t -> []) }
254
| field_list IDENT COL typeconst SCOL
255
      {
256
	let loc = Location.symbol_rloc () in
257
	(fun t -> add_symbol loc ("field " ^ $2) field_table $2 t; ($1 t) @ [ ($2, $4) ]) }
220
field_list:                           { [] }
221
| field_list IDENT COL typeconst SCOL { ($2, $4) :: $1 }
258 222
      
259 223
eq_list:
260 224
  { [], [], [] }

Also available in: Unified diff