Project

General

Profile

« Previous | Next » 

Revision fd834769

Added by Guillaume DAVY almost 3 years ago

Ada: Add the generation of the wrapper file : the main ada file and the project. It is called
only if the main node option is given to lustrec. This feature implied some refactoring. Also
added some OCaml Doc to undocummented functions.

View differences:

src/backends/Ada/ada_backend.ml
12 12
open Format
13 13
open Machine_code_types
14 14

  
15
let gen_ada destname print suffix machine =
16
  (* Next line permit to get the final package name mostly to clean the
17
    identifier for Ada *)
18
  let name = asprintf "%a" Ada_backend_common.pp_package_name machine.mname in
19
  let name = String.lowercase_ascii name in
20
  let path = destname ^ name ^ suffix in
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
21 45
  let out = open_out path in
22 46
  let fmt = formatter_of_out_channel out in
23
  print fmt machine;
47
  pp_file fmt arg;
48
  pp_print_flush fmt ();
24 49
  close_out out;
25
  Log.report ~level:2 (fun fmt -> fprintf fmt "    .. %s generated @." path)
50
  log_str_level_two 2 (path^" generated")
51

  
26 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*)
27 66
exception CheckFailed of string
28 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
**)
29 73
let check machine =
30 74
  match machine.mconst with
31 75
    | [] -> ()
32 76
    | _ -> raise (CheckFailed "machine.mconst should be void")
33 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
**)
34 92
let translate_to_ada basename prog machines dependencies =
35 93
  let module Ads = Ada_backend_ads.Main in
36 94
  let module Adb = Ada_backend_adb.Main in
37 95
  let module Wrapper = Ada_backend_wrapper.Main in
38 96

  
39
  let destname = !Options.dest_dir ^ "/" in
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
40 108

  
41
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Checking machines@.");
109
  let destname = !Options.dest_dir ^ "/" in
42 110

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

  
45
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating ads@.");
114
  log_str_level_two 1 "Generating ads";
115
  List.iter (write_file destname (pp_machine_filename "ads") Ads.pp_file) machines;
46 116

  
47
  List.iter (gen_ada destname Ads.print ".ads") machines;
117
  log_str_level_two 1 "Generating adb";
118
  List.iter (write_file destname (pp_machine_filename "adb") Adb.pp_file) machines;
48 119

  
49
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating adb@.");
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
50 128

  
51
  List.iter (gen_ada destname Adb.print ".adb") machines
52 129

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

Also available in: Unified diff