Project

General

Profile

Revision 3769b712 src/modules.ml

View differences:

src/modules.ml
9 9
(*                                                                  *)
10 10
(********************************************************************)
11 11

  
12
open Utils
13
open Lustre_types
14
open Corelang
12
open Lustrec.Utils
13
open Lustrec.Lustre_types
14
open Lustrec.Corelang
15 15

  
16 16
let name_dependency loc (local, dep) ext =
17 17
  try
18
    Options_management.name_dependency (local, dep) ext 
18
    Lustrec.Options_management.name_dependency (local, dep) ext 
19 19
  with Not_found ->
20
    (* Error.pp_error loc (fun fmt -> Format.fprintf fmt "Unknown library %s" dep); *)
21
    raise (Error.Error (loc, Error.Unknown_library dep))
20
    (*Lustrec.Error.pp_error loc (fun fmt -> Format.fprintf fmt "Unknown library %s" dep); *)
21
    raise (Lustrec.Error.Error (loc,Lustrec.Error.Unknown_library dep))
22 22

  
23 23
  
24 24
let add_symbol loc msg hashtbl name value =
25 25
 if Hashtbl.mem hashtbl name
26
 then raise (Error.Error (loc, Error.Already_bound_symbol msg))
26
 then raise (Lustrec.Error.Error (loc,Lustrec.Error.Already_bound_symbol msg))
27 27
 else Hashtbl.add hashtbl name value
28 28

  
29 29
let check_symbol loc msg hashtbl name =
30 30
 if not (Hashtbl.mem hashtbl name)
31
 then raise (Error.Error (loc, Error.Unbound_symbol msg))
31
 then raise (Lustrec.Error.Error (loc,Lustrec.Error.Unbound_symbol msg))
32 32
 else ()
33 33

  
34 34

  
35 35
let add_imported_node name value =
36
(*Format.eprintf "add_imported_node %s %a (owner=%s)@." name Printers.pp_imported_node (imported_node_of_top value) value.top_decl_owner;*)
36
(*Format.eprintf "add_imported_node %s %a (owner=%s)@." name Lustrec.Printers.pp_imported_node (imported_node_of_top value) value.top_decl_owner;*)
37 37
  try
38 38
    let value' = node_from_name name in
39 39
    let owner' = value'.top_decl_owner in
......
42 42
    let itf = value.top_decl_itf in
43 43
    match value'.top_decl_desc, value.top_decl_desc with
44 44
    | Node _        , ImportedNode _  when owner = owner' && itf' && (not itf) -> update_node name value
45
    | ImportedNode _, ImportedNode _            -> raise (Error.Error (value.top_decl_loc, Error.Already_bound_symbol ("node " ^ name)))
45
    | ImportedNode _, ImportedNode _            -> raise (Lustrec.Error.Error (value.top_decl_loc,Lustrec.Error.Already_bound_symbol ("node " ^ name)))
46 46
    | _                                         -> assert false
47 47
  with
48 48
    Not_found                                   -> update_node name value
49 49

  
50 50
let add_node name value =
51
(*Format.eprintf "add_node %s %a (owner=%s)@." name Printers.pp_imported_node (get_node_interface (node_of_top value)) value.top_decl_owner;*)
51
(*Format.eprintf "add_node %s %a (owner=%s)@." name Lustrec.Printers.pp_imported_node (get_node_interface (node_of_top value)) value.top_decl_owner;*)
52 52
  try
53 53
    let value' = node_from_name name in
54 54
    let owner' = value'.top_decl_owner in
......
57 57
    let itf = value.top_decl_itf in
58 58
    match value'.top_decl_desc, value.top_decl_desc with
59 59
    | ImportedNode _, Node _          when owner = owner' && itf' && (not itf) -> ()
60
    | Node _        , Node _                    -> raise (Error.Error (value.top_decl_loc, Error.Already_bound_symbol ("node " ^ name)))
60
    | Node _        , Node _                    -> raise (Lustrec.Error.Error (value.top_decl_loc,Lustrec.Error.Already_bound_symbol ("node " ^ name)))
61 61
    | _                                         -> assert false
62 62
  with
63 63
    Not_found                                   -> update_node name value
......
65 65

  
66 66
let add_tag loc name typ =
67 67
  if Hashtbl.mem tag_table name then
68
    raise (Error.Error (loc, Error.Already_bound_symbol ("enum tag " ^ name)))
68
    raise (Lustrec.Error.Error (loc,Lustrec.Error.Already_bound_symbol ("enum tag " ^ name)))
69 69
  else Hashtbl.add tag_table name typ
70 70

  
71 71
let add_field loc name typ =
72 72
  if Hashtbl.mem field_table name then
73
    raise (Error.Error (loc, Error.Already_bound_symbol ("struct field " ^ name)))
73
    raise (Lustrec.Error.Error (loc,Lustrec.Error.Already_bound_symbol ("struct field " ^ name)))
74 74
  else Hashtbl.add field_table name typ
75 75

  
76 76
let import_typedef name tydef =
......
84 84
    | Tydec_clock ty      -> import ty
85 85
    | Tydec_const c       ->
86 86
       if not (Hashtbl.mem type_table (Tydec_const c))
87
       then raise (Error.Error (loc, Error.Unbound_symbol ("type " ^ c)))
87
       then raise (Lustrec.Error.Error (loc,Lustrec.Error.Unbound_symbol ("type " ^ c)))
88 88
       else ()
89 89
    | Tydec_array (c, ty) -> import ty
90 90
    | _                   -> ()
91 91
  in import ((typedef_of_top tydef).tydef_desc)
92 92

  
93 93
let add_type itf name value =
94
(*Format.eprintf "Modules.add_type %B %s %a (owner=%s)@." itf name Printers.pp_typedef (typedef_of_top value) value.top_decl_owner;*)
94
(*Format.eprintf "Modules.add_type %B %s %a (owner=%s)@." itf name Lustrec.Printers.pp_typedef (typedef_of_top value) value.top_decl_owner;*)
95 95
  try
96 96
    let value' = Hashtbl.find type_table (Tydec_const name) in
97 97
    let owner' = value'.top_decl_owner in
......
100 100
    let itf = value.top_decl_itf in
101 101
    match value'.top_decl_desc, value.top_decl_desc with
102 102
    | TypeDef ty', TypeDef ty when coretype_equal ty'.tydef_desc ty.tydef_desc && owner' = owner && itf' && (not itf) -> ()
103
    | TypeDef ty', TypeDef ty -> raise (Error.Error (value.top_decl_loc, Error.Already_bound_symbol ("type " ^ name)))
103
    | TypeDef ty', TypeDef ty -> raise (Lustrec.Error.Error (value.top_decl_loc,Lustrec.Error.Already_bound_symbol ("type " ^ name)))
104 104
    | _       -> assert false
105 105
  with Not_found -> (import_typedef name value; Hashtbl.add type_table (Tydec_const name) value)
106 106

  
107 107
let check_type loc name =
108 108
 if not (Hashtbl.mem type_table (Tydec_const name))
109
 then raise (Error.Error (loc, Error.Unbound_symbol ("type " ^ name)))
109
 then raise (Lustrec.Error.Error (loc,Lustrec.Error.Unbound_symbol ("type " ^ name)))
110 110
 else ()
111 111

  
112 112
let add_const itf name value =
......
118 118
    let itf = value.top_decl_itf in
119 119
    match value'.top_decl_desc, value.top_decl_desc with
120 120
    | Const c', Const c when c.const_value = c'.const_value && owner' = owner && itf' && (not itf) -> ()
121
    | Const c', Const c -> raise (Error.Error (value.top_decl_loc, Error.Already_bound_symbol ("const " ^ name)))
121
    | Const c', Const c -> raise (Lustrec.Error.Error (value.top_decl_loc,Lustrec.Error.Already_bound_symbol ("const " ^ name)))
122 122
    | _       -> assert false
123 123
  with Not_found -> Hashtbl.add consts_table name value
124 124

  
125 125
(* let import_dependency_aux loc (local, dep) =
126
 *   let basename = Options_management.name_dependency (local, dep) in
126
 *   let basename = Lustrec.Options_management.name_dependency (local, dep) in
127 127
 *   let extension = ".lusic" in 
128 128
 *   try
129 129
 *     let lusic = Lusic.read_lusic basename extension in
......
131 131
 *     lusic
132 132
 *   with
133 133
 *   | Sys_error msg ->
134
 *       raise (Error (loc, Error.Unknown_library basename))
134
 *       raise (Error (loc,Lustrec.Error.Unknown_library basename))
135 135
 *     
136 136
 * let import_dependency loc (local, dep) =
137 137
 *   try
138 138
 *     import_dependency_aux loc (local, dep)
139 139
 *   with
140
 *   | Corelang.Error (_, err) as exc -> (
140
 *   | Lustrec.Corelang.Error (_, err) as exc -> (
141 141
 *     Format.eprintf "Import error: %a%a@."
142
 *       Error.pp_error_msg err
143
 *       Location.pp_loc loc;
142
 *      Lustrec.Error.pp_error_msg err
143
 *       Lustrec.Location.pp_loc loc;
144 144
 *     raise exc
145 145
 *   ) *)
146 146

  
......
156 156
      lusic
157 157
    with
158 158
    | Sys_error _  ->
159
       raise (Error.Error (loc, Error.Unknown_library basename))
159
       raise (Lustrec.Error.Error (loc,Lustrec.Error.Unknown_library basename))
160 160
  )
161 161
  | _ -> assert false (* should not happen *)
162 162

  
163 163

  
164 164
let get_envs_from_const const_decl (ty_env, ck_env) =
165
  (Env.add_value ty_env const_decl.const_id const_decl.const_type,
166
   Env.add_value ck_env const_decl.const_id (Clocks.new_var true))
165
  (Lustrec.Env.add_value ty_env const_decl.const_id const_decl.const_type,
166
   Lustrec.Env.add_value ck_env const_decl.const_id (Lustrec.Clocks.new_var true))
167 167

  
168 168
let get_envs_from_consts const_decls (ty_env, ck_env) =
169 169
  List.fold_right get_envs_from_const const_decls (ty_env, ck_env)
170 170

  
171 171
let rec get_envs_from_top_decl (ty_env, ck_env) top_decl =
172 172
  match top_decl.top_decl_desc with
173
  | Node nd          -> (Env.add_value ty_env nd.node_id nd.node_type,
174
			 Env.add_value ck_env nd.node_id nd.node_clock)
175
  | ImportedNode ind -> (Env.add_value ty_env ind.nodei_id ind.nodei_type,
176
			 Env.add_value ck_env ind.nodei_id ind.nodei_clock)
173
  | Node nd          -> (Lustrec.Env.add_value ty_env nd.node_id nd.node_type,
174
			 Lustrec.Env.add_value ck_env nd.node_id nd.node_clock)
175
  | ImportedNode ind -> (Lustrec.Env.add_value ty_env ind.nodei_id ind.nodei_type,
176
			 Lustrec.Env.add_value ck_env ind.nodei_id ind.nodei_clock)
177 177
  | Const c          -> get_envs_from_const c (ty_env, ck_env)
178 178
  | TypeDef _        -> List.fold_left get_envs_from_top_decl (ty_env, ck_env) (consts_of_enum_type top_decl)
179 179
  | Include _ | Open _           -> (ty_env, ck_env)
180 180

  
181 181
(* get type and clock environments from a header *)
182 182
let get_envs_from_top_decls header =
183
  List.fold_left get_envs_from_top_decl (Env.initial, Env.initial) header
183
  List.fold_left get_envs_from_top_decl (Lustrec.Env.initial, Lustrec.Env.initial) header
184 184

  
185 185
  let is_stateful topdecl =
186 186
  match topdecl.top_decl_desc with
......
204 204
              (* Library already imported. Just skip *)
205 205
              accu
206 206
            else (
207
              Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@ .. Library %s@ " basename);
207
              Lustrec.Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@ .. Library %s@ " basename);
208 208
              let lusic = get_lusic decl in
209 209
              (* Recursive call with accumulator on lusic *)
210 210
              let (accu_prog, accu_dep, typ_env, clk_env) =
......
223 223
          with
224 224
          | Not_found ->
225 225
             let loc = decl.top_decl_loc in
226
             Error.pp_error loc (fun fmt -> Format.fprintf fmt "Unknown library %s" dep);
227
             raise (Error.Error (loc, Error.Unknown_library dep (*basename*)))
226
            Lustrec.Error.pp_error loc (fun fmt -> Format.fprintf fmt "Unknown library %s" dep);
227
             raise (Lustrec.Error.Error (loc,Lustrec.Error.Unknown_library dep (*basename*)))
228 228
        )
229 229
        | Include name ->
230 230
           let basename = name_dependency decl.top_decl_loc (true, name) "" in
231 231
           if Filename.check_suffix basename ".lus" then
232
             let include_src = Compiler_common.parse basename ".lus" in
232
             let include_src = Lustrec.Compiler_common.parse basename ".lus" in
233 233
             let (accu_prog, accu_dep, typ_env, clk_env) =
234 234
               load_rec ~is_header:false accu include_src
235 235
             in
236 236
             decl::accu_prog, accu_dep, typ_env, clk_env
237 237
           else
238
             raise (Error.Error (decl.top_decl_loc, LoadError("include requires a lustre file")))
238
             raise (Lustrec.Error.Error (decl.top_decl_loc, LoadError("include requires a lustre file")))
239 239
           
240 240
        | Node nd ->
241 241
           if is_header then
242
             raise (Error.Error(decl.top_decl_loc,
242
             raise (Lustrec.Error.Error(decl.top_decl_loc,
243 243
                          LoadError ("node " ^ nd.node_id ^ " declared in a header file")))  
244 244
           else (
245 245
             (* Registering node *)
......
254 254
             decl::accu_prog, accu_dep, typ_env', clk_env'                   
255 255
           )
256 256
           else
257
             raise (Error.Error(decl.top_decl_loc,
257
             raise (Lustrec.Error.Error(decl.top_decl_loc,
258 258
                          LoadError ("imported node " ^ ind.nodei_id ^
259 259
                                       " declared in a regular Lustre file")))  
260 260
        | Const c -> (
......
275 275
      load_rec ~is_header
276 276
        ([], (* accumulator for program elements *)
277 277
         [], (* accumulator for dependencies *)
278
         Env.initial, (* empty type env *)
279
         Env.initial  (* empty clock env *)
278
         Lustrec.Env.initial, (* empty type env *)
279
         Lustrec.Env.initial  (* empty clock env *)
280 280
        ) program
281 281
    in
282 282
    List.rev prog, List.rev deps, (typ_env, clk_env)
283 283
  with
284
    Error.Error (loc, err) as exc -> (
284
   Lustrec.Error.Error (loc, err) as exc -> (
285 285
    (* Format.eprintf "Import error: %a%a@."
286
     *   Error.pp_error_msg err
287
     *   Location.pp_loc loc; *)
286
     *  Lustrec.Error.pp_error_msg err
287
     *   Lustrec.Location.pp_loc loc; *)
288 288
    Format.eprintf "Import error: %a@."
289
      Error.pp_error_msg err
289
     Lustrec.Error.pp_error_msg err
290 290
      ;
291 291
    raise exc
292 292
  );;

Also available in: Unified diff