Project

General

Profile

« Previous | Next » 

Revision a7062da6

Added by LĂ©lio Brun over 3 years ago

another step towards refactoring

View differences:

src/backends/Ada/ada_printer.ml
1
open Utils
1 2
open Format
2 3

  
3 4
(** Represent the possible mode for a type of a procedure parameter **)
......
78 79
(** Print the boolean type name. @param fmt the formater to print on **)
79 80
let pp_boolean_type fmt = fprintf fmt "Boolean"
80 81

  
81
let pp_group ~sep pp_list fmt =
82
let pp_group ~pp_sep pp_list fmt =
82 83
  assert (pp_list != []);
83
  fprintf fmt "@[%a@]" (Utils.fprintf_list ~sep (fun fmt pp -> pp fmt)) pp_list
84
  fprintf fmt "@[%a@]" (pp_print_list ~pp_sep (fun fmt pp -> pp fmt)) pp_list
84 85

  
85
let pp_args ~sep fmt = function
86
let pp_args ~pp_sep fmt = function
86 87
  | [] ->
87 88
    fprintf fmt ""
88 89
  | args ->
89 90
    fprintf fmt " (@[<v>%a)@]"
90
      (Utils.fprintf_list ~sep (fun fmt pp -> pp fmt))
91
      (pp_print_list ~pp_sep (fun fmt pp -> pp fmt))
91 92
      args
92 93

  
93 94
let pp_block fmt pp_item_list =
94
  fprintf fmt "%t@[<v>%a@]%t"
95
    (Utils.pp_final_char_if_non_empty "  " pp_item_list)
96
    (Utils.fprintf_list ~sep:";@," (fun fmt pp -> pp fmt))
95
  pp_print_list
96
    ~pp_open_box:pp_open_vbox0
97
    ~pp_prologue:(fun fmt () -> pp_print_string fmt "   ")
98
    ~pp_epilogue:pp_print_semicolon
99
    ~pp_sep:pp_print_semicolon (fun fmt pp -> pp fmt)
100
    fmt
97 101
    pp_item_list
98
    (Utils.pp_final_char_if_non_empty ";@," pp_item_list)
99 102

  
100
let pp_and l fmt = fprintf fmt "(%t)" (pp_group ~sep:"@ and then " l)
103
let pp_and l fmt =
104
  fprintf fmt "(%t)" (pp_group ~pp_sep:(fun fmt () -> fprintf fmt "@ and then ") l)
101 105

  
102
let pp_or l fmt = fprintf fmt "(%t)" (pp_group ~sep:"@ or " l)
106
let pp_or l fmt =
107
  fprintf fmt "(%t)" (pp_group ~pp_sep:(fun fmt () -> fprintf fmt "@ or ") l)
103 108

  
104 109
let pp_ada_with fmt = function
105 110
  | None ->
......
117 122
    let pp_import fmt =
118 123
      if not import then fprintf fmt ""
119 124
      else
120
        fprintf fmt " Import%t"
121
          (Utils.pp_final_char_if_non_empty ",@," contract)
125
        fprintf fmt " Import%a"
126
          (if contract = [] then pp_print_nothing else pp_print_comma) ()
122 127
    in
123 128
    let pp_aspect aspect fmt pps =
124 129
      if pps = [] then fprintf fmt ""
......
184 189
    fprintf fmt " is@,  @[<v 2>(%t)@]" pp_content
185 190
  | AdaProcedureContent (local_list, pp_instr_list) ->
186 191
    fprintf fmt " is@,%abegin@,%aend %t" pp_block
187
      (List.map (fun l -> pp_group ~sep:";@;" (List.map pp_local l)) local_list)
192
      (List.map (fun l -> pp_group ~pp_sep:pp_print_semicolon (List.map pp_local l)) local_list)
188 193
      pp_block pp_instr_list pp_name
189 194
  | AdaRecord var_list ->
190 195
    assert (var_list != []);
191 196
    let pp_lists = apply_var_decl_lists var_list in
192 197
    fprintf fmt " is@,  @[<v>record@,  @[<v>%a@]@,end record@]" pp_block
193
      (List.map (pp_group ~sep:";@;") pp_lists)
198
      (List.map (pp_group ~pp_sep:pp_print_semicolon) pp_lists)
194 199
  | AdaPackageInstanciation (pp_name, instanciations) ->
195
    fprintf fmt " is new %t%a" pp_name (pp_args ~sep:",@,")
200
    fprintf fmt " is new %t%a" pp_name (pp_args ~pp_sep:pp_print_comma)
196 201
      (List.map pp_generic_instanciation instanciations)
197 202

  
198 203
and pp_def fmt
199 204
    (pp_generics, kind_def, pp_name, args, pp_type_opt, content, pp_with_opt) =
200 205
  let pp_arg_lists = apply_var_decl_lists args in
201 206
  fprintf fmt "%a%a %t%a%a%a%a" pp_generic pp_generics pp_kind_def kind_def
202
    pp_name (pp_args ~sep:";@,")
203
    (List.map (pp_group ~sep:";@,") pp_arg_lists)
207
    pp_name (pp_args ~pp_sep:pp_print_semicolon)
208
    (List.map (pp_group ~pp_sep:pp_print_semicolon) pp_arg_lists)
204 209
    (pp_opt "return") pp_type_opt (pp_content pp_name) content pp_ada_with
205 210
    pp_with_opt
206 211

  
......
387 392
  fprintf fmt "-- %s@," s
388 393

  
389 394
let pp_call fmt (pp_name, args) =
390
  fprintf fmt "%t%a" pp_name (pp_args ~sep:",@ ")
391
    (List.map (pp_group ~sep:",@,") args)
395
  fprintf fmt "%t%a" pp_name (pp_args ~pp_sep:pp_print_comma)
396
    (List.map (pp_group ~pp_sep:pp_print_comma) args)
392 397

  
393 398
(** Print the complete name of variable. @param m the machine to check if it is
394 399
    memory @param fmt the formater to print on @param var the variable **)

Also available in: Unified diff