Project

General

Profile

Revision 5fccce23 src/modules.ml

View differences:

src/modules.ml
23 23
 then raise (Error (loc, Error.Unbound_symbol msg))
24 24
 else ()
25 25

  
26

  
26 27
let add_imported_node name value =
27 28
(*Format.eprintf "add_imported_node %s %a (owner=%s)@." name Printers.pp_imported_node (imported_node_of_top value) value.top_decl_owner;*)
28 29
  try
......
122 123
    lusic
123 124
  with
124 125
  | Sys_error msg ->
125
    begin
126
      (*Format.eprintf "Error: %s@." msg;*)
127 126
      raise (Error (loc, Error.Unknown_library basename))
128
    end
129
  | Corelang.Error (_, msg) -> raise (Corelang.Error (loc, msg))
130

  
127
    
131 128
let import_dependency loc (local, dep) =
132 129
  try
133 130
    import_dependency_aux loc (local, dep)
......
139 136
    raise exc
140 137
  )
141 138

  
142
let check_dependency lusic basename =
143
  try
144
    Lusic.check_obsolete lusic basename
145
  with
146
  | Corelang.Error (loc, err) as exc -> (
147
    Format.eprintf "Import error: %a%a@."
148
      Error.pp_error_msg err
149
      Location.pp_loc loc;
150
    raise exc
139
let get_lusic decl =
140
  match decl.top_decl_desc with
141
  | Open (local, dep) -> (
142
    let loc = decl.top_decl_loc in
143
    let basename = Options_management.name_dependency (local, dep) in
144
    let extension = ".lusic" in 
145
    try
146
      let lusic = Lusic.read_lusic basename extension in
147
      Lusic.check_obsolete lusic basename;
148
      lusic
149
    with
150
    | Sys_error msg ->
151
       raise (Error (loc, Error.Unknown_library basename))
151 152
  )
153
  | _ -> assert false (* should not happen *)
154

  
152 155

  
156
let get_envs_from_const const_decl (ty_env, ck_env) =
157
  (Env.add_value ty_env const_decl.const_id const_decl.const_type,
158
   Env.add_value ck_env const_decl.const_id (Clocks.new_var true))
153 159

  
154
let rec load_rec ~is_header imported program =
155
  List.fold_left (fun imported decl ->
156
    match decl.top_decl_desc with
157
    | Node nd -> if is_header then
158
                   raise (Error(decl.top_decl_loc,
159
                                LoadError ("node " ^ nd.node_id ^ " declared in a header file")))  
160
                 else
161
                   (add_node nd.node_id decl; imported)
162
    | ImportedNode ind ->
163
       if is_header then
164
         (add_imported_node ind.nodei_id decl; imported)
165
       else
166
         raise (Error(decl.top_decl_loc,
167
                      LoadError ("imported node " ^ ind.nodei_id ^ " declared in a regular Lustre file")))  
168
    | Const c -> (add_const is_header c.const_id decl; imported)
169
    | TypeDef tdef -> (add_type is_header tdef.tydef_id decl; imported)
170
    | Open (local, dep) ->
171
       let basename = Options_management.name_dependency (local, dep) in
172
       if ISet.mem basename imported then imported else
173
	 let lusic = import_dependency_aux decl.top_decl_loc (local, dep)
174
	 in load_rec ~is_header:true (ISet.add basename imported) lusic.Lusic.contents
175
  ) imported program
160
let get_envs_from_consts const_decls (ty_env, ck_env) =
161
  List.fold_right get_envs_from_const const_decls (ty_env, ck_env)
162

  
163
let rec get_envs_from_top_decl (ty_env, ck_env) top_decl =
164
  match top_decl.top_decl_desc with
165
  | Node nd          -> (Env.add_value ty_env nd.node_id nd.node_type,
166
			 Env.add_value ck_env nd.node_id nd.node_clock)
167
  | ImportedNode ind -> (Env.add_value ty_env ind.nodei_id ind.nodei_type,
168
			 Env.add_value ck_env ind.nodei_id ind.nodei_clock)
169
  | Const c          -> get_envs_from_const c (ty_env, ck_env)
170
  | TypeDef _        -> List.fold_left get_envs_from_top_decl (ty_env, ck_env) (consts_of_enum_type top_decl)
171
  | Open _           -> (ty_env, ck_env)
172

  
173
(* get type and clock environments from a header *)
174
let get_envs_from_top_decls header =
175
  List.fold_left get_envs_from_top_decl (Env.initial, Env.initial) header
176

  
177
  let is_stateful topdecl =
178
  match topdecl.top_decl_desc with
179
  | Node nd -> (match nd.node_stateless with Some b -> not b | None -> not nd.node_dec_stateless)
180
  | ImportedNode nd -> not nd.nodei_stateless 
181
  | _ -> false
182

  
183
let rec load_rec ~is_header accu program =
184
  List.fold_left (fun ((accu_prog, accu_dep, typ_env, clk_env) as accu) decl ->
185
      (* Precompute the updated envs, will not be used in the Open case *)
186
      let typ_env', clk_env' = get_envs_from_top_decl (typ_env, clk_env) decl in
187
      match decl.top_decl_desc with
188
      | Open (local, dep) ->
189
         (* loading the dep *)
190
         let basename = Options_management.name_dependency (local, dep) in
191
         if List.exists
192
              (fun dep -> basename = Options_management.name_dependency (dep.local, dep.name))
193
              accu_dep
194
         then
195
           (* Library already imported. Just skip *)
196
           accu
197
         else (
198
           Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@ Library %s@ " basename);
199
           let lusic = get_lusic decl in
200
           (* Recursive call with accumulator on lusic *)
201
           let (accu_prog, accu_dep, typ_env, clk_env) =
202
             load_rec ~is_header:true accu lusic.Lusic.contents in
203
           (* Building the dep *)
204
           let is_stateful = List.exists is_stateful lusic.Lusic.contents in
205
           let new_dep = { local = local;
206
                           name = dep;
207
                           content = lusic.Lusic.contents;
208
                           is_stateful = is_stateful } in
209
           
210
           (* Returning the prog without the Open, the deps with the new
211
            one and the updated envs *)
212
           accu_prog, (new_dep::accu_dep), typ_env, clk_env
213
         )
214
      (*    | Include xxx -> TODO
215
                     load the lus file
216
                     call load_rec ~is_header:false accu on the luscontent
217
       *)                     
218

  
219
      | Node nd ->
220
         if is_header then
221
           raise (Error(decl.top_decl_loc,
222
                        LoadError ("node " ^ nd.node_id ^ " declared in a header file")))  
223
         else (
224
           (* Registering node *)
225
           add_node nd.node_id decl;
226
           (* Updating the type/clock env *)
227
           decl::accu_prog, accu_dep, typ_env', clk_env'                   
228
         )
229
        
230
      | ImportedNode ind ->
231
         if is_header then (
232
           add_imported_node ind.nodei_id decl;
233
           decl::accu_prog, accu_dep, typ_env', clk_env'                   
234
         )
235
         else
236
           raise (Error(decl.top_decl_loc,
237
                        LoadError ("imported node " ^ ind.nodei_id ^
238
                                     " declared in a regular Lustre file")))  
239
      | Const c -> (
240
        add_const is_header c.const_id decl;
241
        decl::accu_prog, accu_dep, typ_env', clk_env' 
242
      )
243
      | TypeDef tdef -> (
244
        add_type is_header tdef.tydef_id decl;
245
        decl::accu_prog, accu_dep, typ_env', clk_env'
246
      )
247
    ) accu program
176 248

  
177 249
(* Iterates through lusi definitions and records them in the hashtbl. Open instructions are evaluated and update these hashtbl as well. node_table/type/table/consts_table *)
250
let load ~is_header program =
178 251
  
179
let load ~is_header imported program =
180 252
  try
181
    load_rec ~is_header imported program
253
    let prog, deps, typ_env, clk_env =  
254
      load_rec ~is_header
255
        ([], (* accumulator for program elements *)
256
         [], (* accumulator for dependencies *)
257
         Env.initial, (* empty type env *)
258
         Env.initial  (* empty clock env *)
259
        ) program
260
    in
261
    List.rev prog, List.rev deps, (typ_env, clk_env)
182 262
  with
183 263
    Corelang.Error (loc, err) as exc -> (
184
      Format.eprintf "Import error: %a%a@."
185
	Error.pp_error_msg err
186
	Location.pp_loc loc;
187
      raise exc
188
    );;
264
    Format.eprintf "Import error: %a%a@."
265
      Error.pp_error_msg err
266
      Location.pp_loc loc;
267
    raise exc
268
  );;

Also available in: Unified diff