Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend.ml @ fd834769

History | View | Annotate | Download (4.65 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

    
28
(** Encapsulate a pretty print function to lower case its result when applied
29
   @param pp the pretty print function
30
   @param fmt the formatter
31
   @param arg the argument of the pp function
32
**)
33
let pp_lowercase pp fmt arg =
34
  let str = asprintf "%a" pp arg in
35
  fprintf fmt "%s" (String. lowercase_ascii str)
36

    
37
(** Write a new file with formatter
38
   @param destname folder where the file shoudl be created
39
   @param pp_filename function printing the filename
40
   @param pp_file function wich pretty print the file
41
   @param arg will be given to pp_filename and pp_file
42
**)
43
let write_file destname pp_filename pp_file arg =
44
  let path = asprintf "%s%a" destname pp_filename arg in
45
  let out = open_out path in
46
  let fmt = formatter_of_out_channel out in
47
  pp_file fmt arg;
48
  pp_print_flush fmt ();
49
  close_out out;
50
  log_str_level_two 2 (path^" generated")
51

    
52

    
53
(** Print the filename of a package by lowercasing it and appending
54
  an extension.
55
   @param extension the extension to append to the package name
56
   @param fmt the formatter
57
   @param fmt the machine corresponding to the package
58
**)
59
let pp_machine_filename extension fmt machine =
60
  fprintf fmt "%a.%s"
61
    (pp_lowercase pp_package_name) machine.mname
62
    extension
63

    
64
(** Exception raised when a machine contains a feature not supported by the
65
  Ada backend*)
66
exception CheckFailed of string
67

    
68

    
69
(** Check that a machine match the requirement for an Ada compilation :
70
      - No constants.
71
   @param machine the machine to test
72
**)
73
let check machine =
74
  match machine.mconst with
75
    | [] -> ()
76
    | _ -> raise (CheckFailed "machine.mconst should be void")
77

    
78
(** Print the name of the ada project file.
79
   @param fmt the formater to print on
80
   @param main_machine the machine associated to the main node
81
**)
82
let pp_project_name fmt main_machine =
83
  fprintf fmt "%a.gpr" pp_package_name main_machine.mname
84

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

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

    
109
  let destname = !Options.dest_dir ^ "/" in
110

    
111
  log_str_level_two 1 "Checking machines";
112
  List.iter check machines;
113

    
114
  log_str_level_two 1 "Generating ads";
115
  List.iter (write_file destname (pp_machine_filename "ads") Ads.pp_file) machines;
116

    
117
  log_str_level_two 1 "Generating adb";
118
  List.iter (write_file destname (pp_machine_filename "adb") Adb.pp_file) machines;
119

    
120
  (* If a main node is given we generate a main adb file and a project file *)
121
  log_str_level_two 1 "Generating wrapper files";
122
  match main_machine with
123
    | None -> log_str_level_two 2 "File not generated(no -node argument)";
124
    | Some machine -> begin
125
        write_file destname pp_project_name Wrapper.pp_project_file machine;
126
        write_file destname pp_main_filename Wrapper.pp_main_file machine;
127
      end
128

    
129

    
130
(* Local Variables: *)
131
(* compile-command:"make -C ../../.." *)
132
(* End: *)