Project

General

Profile

Revision a0b18d45 src/compiler_common.ml

View differences:

src/compiler_common.ml
10 10
(********************************************************************)
11 11

  
12 12
open Utils
13
open Format 
13
open Format
14 14
open Lustre_types
15 15
open Corelang
16 16

  
......
45 45
  (* Parsing *)
46 46
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. parsing header file %s@ " filename);
47 47
    try
48
      let header = Parse.header Parser_lustre.header Lexer_lustre.token lexbuf in
48
      let header = Parse.header Parser_lustre.header_main Lexer_lustre.token lexbuf in
49 49
      (*ignore (Modules.load_header ISet.empty header);*)
50 50
      close_in h_in;
51 51
      header
52 52
    with
53
    | (Parse.Error err) as exc -> 
53
    | (Parse.Error err) as exc ->
54 54
      Parse.report_error err;
55 55
      raise exc
56 56
    | Corelang.Error (loc, err) as exc -> (
......
68 68
  Location.init lexbuf source_name;
69 69

  
70 70
  (* Parsing *)
71
  Log.report ~level:1 
71
  Log.report ~level:1
72 72
    (fun fmt -> fprintf fmt ".. parsing source file %s@ " source_name);
73 73
  try
74
    let prog = Parse.prog Parser_lustre.prog Lexer_lustre.token lexbuf in
74
    let prog = Parse.prog Parser_lustre.prog_main Lexer_lustre.token lexbuf in
75 75
    (*ignore (Modules.load_program ISet.empty prog);*)
76 76
    close_in s_in;
77 77
    prog
78 78
  with
79
  | (Parse.Error err) as exc -> 
79
  | (Parse.Error err) as exc ->
80 80
    Parse.report_error err;
81 81
    raise exc
82 82
  | Corelang.Error (loc, err) as exc ->
......
115 115
      Location.pp_loc loc;
116 116
    raise exc
117 117

  
118
let type_decls env decls =  
118
let type_decls env decls =
119 119
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. typing@ ");
120
  let new_env = 
120
  let new_env =
121 121
    begin
122 122
      try
123 123
	Typing.type_prog env decls
......
126 126
	  Types.pp_error err
127 127
	  Location.pp_loc loc;
128 128
	raise exc
129
    end 
129
    end
130 130
  in
131 131
  if !Options.print_types || !Options.verbose_level > 2 then
132 132
    Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>  %a@]@ " Corelang.pp_prog_type decls);
133 133
  new_env
134
      
135
let clock_decls env decls = 
134

  
135
let clock_decls env decls =
136 136
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. clock calculus@ ");
137 137
  let new_env =
138 138
    begin
......
188 188
   (Env.initial, Env.initial)
189 189
 *)
190 190

  
191
let generate_lusic_header destname lusic_ext =	
191
let generate_lusic_header destname lusic_ext =
192 192
  match !Options.output with
193 193
  | "C" -> C_backend_lusic.print_lusic_to_h destname lusic_ext
194 194
  | _ -> ()
195
	 
196 195

  
197
    
196

  
197

  
198 198
let check_compatibility (prog, computed_types_env, computed_clocks_env) (header, declared_types_env, declared_clocks_env) =
199 199
  try
200 200
    (* checking defined types are compatible with declared types*)
......
228 228
let is_stateful topdecl =
229 229
  match topdecl.top_decl_desc with
230 230
  | Node nd -> (match nd.node_stateless with Some b -> not b | None -> not nd.node_dec_stateless)
231
  | ImportedNode nd -> not nd.nodei_stateless 
231
  | ImportedNode nd -> not nd.nodei_stateless
232 232
  | _ -> false
233 233

  
234 234

  
......
274 274
    | Node nd ->
275 275
       List.iter
276 276
	 (update_vdecl_parents nd.node_id)
277
	 (nd.node_inputs @ nd.node_outputs @ nd.node_locals )  
278
    | ImportedNode ind -> 
277
	 (nd.node_inputs @ nd.node_outputs @ nd.node_locals )
278
    | ImportedNode ind ->
279 279
       List.iter
280 280
	 (update_vdecl_parents ind.nodei_id)
281
	 (ind.nodei_inputs @ ind.nodei_outputs )  
281
	 (ind.nodei_inputs @ ind.nodei_outputs )
282 282
    | _ -> ()
283 283
  ) prog

Also available in: Unified diff