Project

General

Profile

Revision 990210f3

View differences:

src/backends/C/c_backend_header.ml
40 40
	fprintf fmt "#include <mpfr.h>@."
41 41
      end;
42 42
  if !Options.cpp then
43
    fprintf fmt "#include \"%s/arrow.hpp\"@.@." !Options.include_dir
43
    fprintf fmt "#include \"%s/arrow.hpp\"@.@." arrow_top_decl.top_decl_owner 
44 44
  else
45
    fprintf fmt "#include \"%s/arrow.h\"@.@." !Options.include_dir
45
    fprintf fmt "#include \"%s/arrow.h\"@.@." arrow_top_decl.top_decl_owner 
46 46

  
47 47
  end
48 48

  
src/backends/C/c_backend_main.ml
178 178

  
179 179
let print_main_header fmt =
180 180
  fprintf fmt (if !Options.cpp then "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.hpp\"@." else "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.h\"@.")
181
    !Options.include_dir
181
    (Options.core_dependency "io_frontend")
182 182

  
183 183
let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) =
184 184
  print_main_header main_fmt;
src/backends/Horn/horn_backend.ml
85 85
  List.iter
86 86
    (fun dep ->
87 87
      let (local, s) = Corelang.dependency_of_top dep in
88
      let basename = ((if local then !Options.dest_dir else !Options.include_dir)) ^ s ^ ".smt2" in
88
      let basename = (Options.name_dependency (local, s)) ^ ".smt2" in
89 89
      Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@[<v 0> Horn Library %s@," basename);
90 90
      let horn = load_file basename in
91 91
      fprintf fmt "@.%s@." horn;
src/compiler_common.ml
232 232
  List.fold_left
233 233
    (fun (compilation_dep, type_env, clock_env) dep ->
234 234
      let (local, s) = Corelang.dependency_of_top dep in
235
      let basename = Modules.name_dependency (local, s) in
235
      let basename = Options.name_dependency (local, s) in
236 236
      Log.report ~level:1 (fun fmt -> Format.fprintf fmt "  Library %s@ " basename);
237 237
      let lusic = Modules.import_dependency dep.top_decl_loc (local, s) in
238 238
      (*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "");*)
......
249 249
    deps
250 250
  end
251 251

  
252
let track_exception () =
253
  if !Options.track_exceptions
254
  then (Printexc.print_backtrace stdout; flush stdout)
255
  else ()
256

  
257

  
252 258

  
src/corelang.ml
241 241

  
242 242
(* alias and type definition table *)
243 243

  
244
let mktop = mktop_decl Location.dummy_loc !Options.include_dir false
244
let mktop = mktop_decl Location.dummy_loc !Options.dest_dir false
245 245

  
246 246
let top_int_type = mktop (TypeDef {tydef_id = "int"; tydef_desc = Tydec_int})
247 247
let top_bool_type = mktop (TypeDef {tydef_id = "bool"; tydef_desc = Tydec_bool})
src/lusic.ml
31 31
(* extracts a header from a program representing module owner = dirname/basename *)
32 32
let extract_header dirname basename prog =
33 33
  let owner = dirname ^ "/" ^ basename in
34
 List.fold_right
35
   (fun decl header ->
36
     (*Format.eprintf "Lusic.extract_header: header = %B, owner = %s, decl_owner = %s@." decl.top_decl_itf owner decl.top_decl_owner;*)
37
     if decl.top_decl_itf || decl.top_decl_owner <> owner then header else
38
    match decl.top_decl_desc with
39
    | Node nd        -> { decl with top_decl_desc = ImportedNode (Corelang.get_node_interface nd) } :: header 
40
    | ImportedNode _ -> header
41
    | Const _
42
    | TypeDef _
43
    | Open _         -> decl :: header)
44
   prog []
34
  List.fold_right
35
    (fun decl header ->
36
      (*Format.eprintf "Lusic.extract_header: header = %B, owner = %s, decl_owner = %s@." decl.top_decl_itf owner decl.top_decl_owner;*)
37
      if decl.top_decl_itf || decl.top_decl_owner <> owner then header else
38
	match decl.top_decl_desc with
39
	| Node nd        -> { decl with top_decl_desc = ImportedNode (Corelang.get_node_interface nd) } :: header 
40
	| ImportedNode _ -> header
41
	| Const _
42
	| TypeDef _
43
	| Open _         -> decl :: header)
44
    prog []
45 45

  
46 46
let check_obsolete lusic basename =
47 47
  if lusic.obsolete then raise (Error (Location.dummy_loc, Wrong_number basename))
src/machine_code.ml
181 181
let arrow_top_decl =
182 182
  {
183 183
    top_decl_desc = Node arrow_desc;
184
    top_decl_owner = !Options.include_dir;
184
    top_decl_owner = (Options.core_dependency "arrow");
185 185
    top_decl_itf = false;
186 186
    top_decl_loc = Location.dummy_loc
187 187
  }
src/main_lustre_compiler.ml
473 473
  | Corelang.Error _ (*| Task_set.Error _*)
474 474
  | Causality.Error _ -> exit 1
475 475
  | Sys_error msg -> (eprintf "Failure: %s@." msg)
476
  | exc -> (Utils.track_exception (); raise exc)
476
  | exc -> (track_exception (); raise exc)
477 477

  
478 478
(* Local Variables: *)
479 479
(* compile-command:"make -C .." *)
src/main_lustre_testgen.ml
172 172
  | Corelang.Error _ (*| Task_set.Error _*)
173 173
  | Causality.Error _ -> exit 1
174 174
  | Sys_error msg -> (eprintf "Failure: %s@." msg)
175
  | exc -> (Utils.track_exception (); raise exc)
175
  | exc -> (track_exception (); raise exc)
176 176

  
177 177
(* Local Variables: *)
178 178
(* compile-command:"make -C .." *)
src/modules.ml
113 113
    | _       -> assert false
114 114
  with Not_found -> Hashtbl.add consts_table name value
115 115

  
116
let name_dependency (local, dep) =
117
  ((if local then !Options.dest_dir else !Options.include_dir) ^ "/") ^ dep
118

  
119 116
let import_dependency_aux loc (local, dep) =
120
  let basename = name_dependency (local, dep) in
117
  let basename = Options.name_dependency (local, dep) in
121 118
  let extension = ".lusic" in 
122 119
  try
123 120
    let lusic = Lusic.read_lusic basename extension in
......
161 158
    | Const c -> (add_const true c.const_id decl; imported)
162 159
    | TypeDef tdef -> (add_type true tdef.tydef_id decl; imported)
163 160
    | Open (local, dep) ->
164
       let basename = name_dependency (local, dep) in
161
       let basename = Options.name_dependency (local, dep) in
165 162
       if ISet.mem basename imported then imported else
166 163
	 let lusic = import_dependency_aux decl.top_decl_loc (local, dep)
167 164
	 in load_header_rec (ISet.add basename imported) lusic.Lusic.contents
......
186 183
    | Const c -> (add_const false c.const_id decl; imported)
187 184
    | TypeDef tdef -> (add_type false tdef.tydef_id decl; imported)
188 185
    | Open (local, dep) ->
189
       let basename = name_dependency (local, dep) in
186
       let basename = Options.name_dependency (local, dep) in
190 187
       if ISet.mem basename imported then imported else
191 188
	 let lusic = import_dependency_aux decl.top_decl_loc (local, dep)
192 189
	 in load_header_rec (ISet.add basename imported) lusic.Lusic.contents
src/options.ml
11 11

  
12 12
let version = Version.number
13 13
let codename = Version.codename
14
let include_dir = ref "."
15
let include_path =
16
if (!include_dir != ".") then Version.prefix ^ !include_dir
17
else Version.include_path
14
let include_dirs = ref ["."]
15
(* let include_path = *)
16
(* if (!include_dir <> ".") then Version.prefix ^ !include_dir *)
17
(* else Version.include_path *)
18 18

  
19 19

  
20 20

  
21 21

  
22 22
let print_version () =
23 23
  Format.printf "Lustrec compiler, version %s (%s)@." version codename;
24
  Format.printf "Include directory: %s@." include_path;
25
  Format.printf "User selected include directory: %s@." !include_dir
24
  Format.printf "Standard lib: %s@." Version.include_path;
25
  Format.printf "User provided include directory: @[<h>%a@]@."
26
    (Utils.fprintf_list ~sep:"@ " Format.pp_print_string) !include_dirs
26 27

  
27 28
let main_node = ref ""
28 29
let static_mem = ref true
......
61 62
let gen_mcdc = ref false
62 63
let no_mutation_suffix = ref false
63 64

  
65
let add_include_dir dir =
66
  let removed_slash_suffix =
67
    let len = String.length dir in
68
    if dir.[len-1] = '/' then
69
      String.sub dir 0 (len - 1) 
70
    else
71
      dir
72
  in
73
  include_dirs := removed_slash_suffix :: !include_dirs
74

  
75
    
76
(** Solving the path of required library:
77
    If local: look in the folders described in !Options.include_dirs
78
    If non local: look first as a local, then in Version.include_path:
79
    ie. in Version.include_path::!Options.include_dirs
80
    Note that in options.ml, include folder are added as heads. One need to
81
    perform a fold_right to respect the order
82
*)
83
let search_lib_path (local, full_file_name) =
84
  let paths = (if local then !include_dirs else Version.include_path::!include_dirs) in
85
  let name =
86
    List.fold_right (fun dir res ->
87
      match res with Some _ -> res
88
      | None ->
89
	 let path_to_lib = dir ^ "/" ^ full_file_name in 
90
	 if Sys.file_exists path_to_lib then
91
	   Some dir
92
	 else
93
	   None
94
    )
95
      paths
96
      None
97
  in
98
  match name with
99
  | None -> Format.eprintf "Unable to find library %s in paths %a@.@?" full_file_name (Utils.fprintf_list ~sep:", " Format.pp_print_string) paths;raise Not_found
100
  | Some s -> s
101

  
102
(* Search for path of core libs (without lusic: arrow and io_frontend *)
103
let core_dependency lib_name =
104
  search_lib_path (false, lib_name ^ ".h")
105
    
106
let name_dependency (local, dep) =
107
  let dir = search_lib_path (false, dep ^ ".lusic") in
108
  dir ^ "/" ^ dep
109
  
64 110
let set_mpfr prec =
65 111
  if prec > 0 then (
66 112
    mpfr := true;
......
72 118

  
73 119
let common_options =
74 120
  [ "-d", Arg.Set_string dest_dir, "uses the specified \x1b[4mdirectory\x1b[0m as root for generated/imported object and C files <default: .>";
75
    "-I", Arg.Set_string include_dir, "sets include \x1b[4mdirectory\x1b[0m";
121
    "-I", Arg.String add_include_dir, "sets include \x1b[4mdirectory\x1b[0m";
76 122
    "-node", Arg.Set_string main_node, "specifies the \x1b[4mmain\x1b[0m node";
77 123
    "-print-types", Arg.Set print_types, "prints node types";
78 124
    "-print-clocks", Arg.Set print_clocks, "prints node clocks";
src/utils.ml
347 347
let get_new_id () = incr var_id_cpt;!var_id_cpt
348 348

  
349 349

  
350
let track_exception () =
351
 if !Options.track_exceptions
352
 then (Printexc.print_backtrace stdout; flush stdout)
353
 else ()
354

  
355

  
356 350
(* for lexing purposes *)
357 351

  
358 352
(* Update line number for location info *)

Also available in: Unified diff