Project

General

Profile

« Previous | Next » 

Revision c419ca44

Added by Guillaume DAVY almost 3 years ago

Ada: Changed type name for states and normalized variable name to match ada requirements.

View differences:

src/backends/Ada/ada_backend.ml
20 20
  close_out out;
21 21
  Log.report ~level:2 (fun fmt -> fprintf fmt "    .. %s generated @." path)
22 22

  
23
exception CheckFailed of string
24

  
25
let check machine =
26
  match machine.mconst with
27
    | [] -> ()
28
    | _ -> raise (CheckFailed "machine.mconst should be void")
29

  
23 30
let translate_to_ada basename prog machines dependencies =
24 31
  let module Ads = Ada_backend_ads.Main in
25 32
  let module Adb = Ada_backend_adb.Main in
26 33
  let module Wrapper = Ada_backend_wrapper.Main in
27 34

  
28
  let destname = !Options.dest_dir ^ "/" ^ basename in
35
  let destname = !Options.dest_dir ^ "/" in
36

  
37
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Checking machines@.");
38

  
39
  List.iter check machines;
29 40

  
30
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating ads@,");
41
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating ads@.");
31 42

  
32 43
  List.iter (gen_ada destname Ads.print ".ads") machines;
33 44

  
34
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating adb@,");
45
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating adb@.");
35 46

  
36 47
  List.iter (gen_ada destname Adb.print ".adb") machines
37 48

  
src/backends/Ada/ada_backend_adb.ml
41 41
**)
42 42
let pp_procedure_definition fmt (m, pp_procedure_name, pp_prototype, instrs) =
43 43
  let pp_instr = pp_machine_instr m in
44
  fprintf fmt "%a is@,begin@,  @[<v>%a@]@,end %t"
44
  fprintf fmt "%a is@,begin@,  @[<v>%a%t@]@,end %t"
45 45
    pp_prototype m
46 46
    (Utils.fprintf_list ~sep:";@," pp_instr) instrs
47
    (Utils.pp_final_char_if_non_empty ";" instrs)
47 48
    pp_procedure_name
48 49

  
49 50
(** Print the definition of the init procedure from a machine.
src/backends/Ada/ada_backend_ads.ml
22 22
module Main =
23 23
struct
24 24

  
25
(** Print a record definition.
26
   @param fmt the formater to print on
27
   @param var_list list of machine variable
28
*)
29
let pp_record_definition fmt var_list =
30
  fprintf fmt "@,  @[<v>record@,  @[<v>%a%t@]@,end record@]"
31
    (Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) var_list
32
    (Utils.pp_final_char_if_non_empty ";" var_list)
33

  
25 34
(** Print the package declaration(ads) of a machine.
26 35
   @param fmt the formater to print on
27 36
   @param machine the machine
src/backends/Ada/ada_backend_common.ml
57 57
   @param fmt the formater to print on
58 58
*)
59 59
let pp_state_type fmt =
60
  fprintf fmt "State"
60
  fprintf fmt "TState"
61 61

  
62 62
(** Print the type of a variable.
63 63
   @param fmt the formater to print on
......
99 99
   @param id the variable
100 100
*)
101 101
let pp_var_name fmt id =
102
  fprintf fmt "%s" id.var_id
102
  let base_size = String.length id.var_id in
103
  assert(base_size > 0);
104
  let rec remove_double_underscore s = function
105
    | i when i == String.length s - 1 -> s
106
    | i when String.get s i == '_' && String.get s (i+1) == '_' ->
107
        remove_double_underscore (sprintf "%s%s" (String.sub s 0 i) (String.sub s (i+1) (String.length s-i-1))) i
108
    | i -> remove_double_underscore s (i+1)
109
  in
110
  let name = remove_double_underscore id.var_id 0 in
111
  let prefix = if String.length name == base_size
112
                  || String.get id.var_id 0 == '_' then
113
                  "ada"
114
               else
115
                  ""
116
  in
117
  fprintf fmt "%s%s" prefix name
103 118

  
104 119
(** Print a variable declaration
105 120
   @param mode input/output mode of the parameter
......
133 148
  let pp_type = pp_state_type in
134 149
  pp_var_decl fmt (mode, pp_name, pp_type)
135 150

  
136
(** Print a record definition.
137
   @param fmt the formater to print on
138
   @param var_list list of machine variable
139
*)
140
let pp_record_definition fmt var_list =
141
  fprintf fmt "@,  @[<v>record@,  @[<v>%a%t@]@,end record@]"
142
    (Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) var_list
143
    (Utils.pp_final_char_if_non_empty "," var_list)
144

  
145 151

  
146 152
(* Prototype pretty print functions *)
147 153

  
......
170 176
  fprintf fmt "procedure %t(@[<v>%a%t@[%a@]%t@[%a@])@]"
171 177
    pp_name
172 178
    pp_state_var_decl state_mode
173
    (Utils.pp_final_char_if_non_empty ",@," input)
174
    (Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl In)) input
175
    (Utils.pp_final_char_if_non_empty ",@," output)
176
    (Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl Out)) output
179
    (Utils.pp_final_char_if_non_empty ";@," input)
180
    (Utils.fprintf_list ~sep:";@ " (pp_machine_var_decl In)) input
181
    (Utils.pp_final_char_if_non_empty ";@," output)
182
    (Utils.fprintf_list ~sep:";@ " (pp_machine_var_decl Out)) output
177 183

  
178 184
(** Print the prototype of the init procedure of a machine.
179 185
   @param fmt the formater to print on
src/compiler_stages.ml
264 264
     end
265 265
  | "Ada" ->
266 266
    begin
267
      Log.report ~level:1 (fun fmt -> fprintf fmt ".. Ada code generation@,");
267
      Log.report ~level:1 (fun fmt -> fprintf fmt ".. Ada code generation@.");
268 268
      Ada_backend.translate_to_ada
269 269
	basename prog machine_code dependencies
270 270
    end

Also available in: Unified diff