Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend.ml @ 3de9f6e4

History | View | Annotate | Download (4.92 KB)

1
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT - ISAE-SUPAERO     *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11

    
12
open Format
13
open Machine_code_types
14

    
15
open Ada_backend_common
16

    
17
let indent_size = 2
18

    
19
(** Log at level 2 a string message with some indentation.
20
   @param indent the indentation level
21
   @param info the message
22
**)
23
let log_str_level_two indent info =
24
  let str_indent = String.make (indent*indent_size) ' ' in
25
  let pp_message fmt = fprintf fmt "%s.. %s@." str_indent info in
26
  Log.report ~level:2 pp_message;
27
  Format.pp_print_flush Format.err_formatter ()
28

    
29
(** Write a new file with formatter
30
   @param destname folder where the file shoudl be created
31
   @param pp_filename function printing the filename
32
   @param pp_file function wich pretty print the file
33
   @param arg will be given to pp_filename and pp_file
34
**)
35
let write_file destname pp_filename pp_file arg =
36
  let path = asprintf "%s%a" destname pp_filename arg in
37
  let out = open_out path in
38
  let fmt = formatter_of_out_channel out in
39
  log_str_level_two 2 ("generating "^path);
40
  pp_file fmt arg;
41
  pp_print_flush fmt ();
42
  close_out out
43

    
44

    
45
(** Print the filename of a machine package.
46
   @param extension the extension to append to the package name
47
   @param fmt the formatter
48
   @param machine the machine corresponding to the package
49
**)
50
let pp_machine_filename extension fmt machine =
51
  pp_filename extension fmt (function fmt -> pp_package_name fmt machine)
52

    
53
(** Exception raised when a machine contains a feature not supported by the
54
  Ada backend*)
55
exception CheckFailed of string
56

    
57

    
58
(** Check that a machine match the requirement for an Ada compilation :
59
      - No constants.
60
   @param machine the machine to test
61
**)
62
let check machine =
63
  match machine.mconst with
64
    | [] -> ()
65
    | _ -> raise (CheckFailed "machine.mconst should be void")
66

    
67
(** Print the name of the ada project file.
68
   @param fmt the formater to print on
69
   @param main_machine the machine associated to the main node
70
**)
71
let pp_project_name fmt main_machine =
72
  fprintf fmt "%a.gpr" pp_package_name main_machine
73

    
74

    
75
let get_typed_instances machines m =
76
  let submachines = List.map (get_machine machines) m.minstances in
77
  List.map2
78
    (fun instance submachine ->
79
      let ident = (fst instance) in
80
      ident, (get_substitution m ident submachine, submachine))
81
    m.minstances submachines
82

    
83
(** Main function of the Ada backend. It calls all the subfunction creating all
84
the file and fill them with Ada code representing the machines list given.
85
   @param basename useless
86
   @param prog useless
87
   @param prog list of machines to translate
88
   @param dependencies useless
89
**)
90
let translate_to_ada basename prog machines dependencies =
91
  let module Ads = Ada_backend_ads.Main in
92
  let module Adb = Ada_backend_adb.Main in
93
  let module Wrapper = Ada_backend_wrapper.Main in
94

    
95
  let typed_instances_machines =
96
    List.map (get_typed_instances machines) machines in
97

    
98
  let _machines = List.combine typed_instances_machines machines in
99

    
100
  let _pp_filename ext fmt (typed_instances, machine) =
101
    pp_machine_filename ext fmt machine in
102

    
103
  (* Extract the main machine if there is one *)
104
  let main_machine = (match !Options.main_node with
105
  | "" -> None
106
  | main_node -> (
107
    match Machine_code_common.get_machine_opt machines main_node with
108
    | None -> begin
109
      Format.eprintf "Ada Code generation error: %a@." Error.pp_error_msg Error.Main_not_found;
110
      raise (Corelang.Error (Location.dummy_loc, Error.Main_not_found))
111
    end
112
    | Some m -> Some m
113
  )) in
114

    
115
  let destname = !Options.dest_dir ^ "/" in
116

    
117
  log_str_level_two 1 "Checking machines";
118
  List.iter check machines;
119

    
120
  log_str_level_two 1 "Generating ads";
121
  List.iter (write_file destname (_pp_filename "ads") Ads.pp_file) _machines;
122

    
123
  log_str_level_two 1 "Generating adb";
124
  List.iter (write_file destname (_pp_filename "adb") Adb.pp_file) _machines;
125

    
126
  (* If a main node is given we generate a main adb file and a project file *)
127
  log_str_level_two 1 "Generating wrapper files";
128
  match main_machine with
129
    | None -> log_str_level_two 2 "File not generated(no -node argument)";
130
    | Some machine ->
131
begin
132
  let pp_main_filename fmt _ =
133
    pp_filename "adb" fmt pp_main_procedure_name in
134
  write_file destname pp_project_name Wrapper.pp_project_file machine;
135
  write_file destname pp_main_filename Wrapper.pp_main_adb machine;
136
end
137

    
138

    
139
(* Local Variables: *)
140
(* compile-command:"make -C ../../.." *)
141
(* End: *)