Revision c06b3b47 src/backends/Ada/ada_backend_common.ml
| src/backends/Ada/ada_backend_common.ml | ||
|---|---|---|
| 35 | 35 |
fprintf fmt "end %a;" pp_package_name machine |
| 36 | 36 |
|
| 37 | 37 |
|
| 38 |
(* Variable pretty print functions *)
|
|
| 38 |
(* Type pretty print functions *)
|
|
| 39 | 39 |
|
| 40 |
(** Print the name of a variable.
|
|
| 40 |
(** Print a type declaration
|
|
| 41 | 41 |
@param fmt the formater to print on |
| 42 |
@param id the variable |
|
| 42 |
@param pp_name a format printer which print the type name |
|
| 43 |
@param pp_value a format printer which print the type definition |
|
| 43 | 44 |
*) |
| 44 |
let pp_var_name fmt id = |
|
| 45 |
fprintf fmt "%s" id.var_id |
|
| 45 |
let pp_type_decl fmt (pp_name, pp_definition) = |
|
| 46 |
fprintf fmt "type %t is %t" pp_name pp_definition |
|
| 47 |
|
|
| 48 |
(** Print a private type declaration |
|
| 49 |
@param fmt the formater to print on |
|
| 50 |
@param pp_name a format printer which print the type name |
|
| 51 |
*) |
|
| 52 |
let pp_private_type_decl fmt pp_name = |
|
| 53 |
let pp_definition fmt = fprintf fmt "private" in |
|
| 54 |
pp_type_decl fmt (pp_name, pp_definition) |
|
| 55 |
|
|
| 56 |
(** Print the type of the state variable. |
|
| 57 |
@param fmt the formater to print on |
|
| 58 |
*) |
|
| 59 |
let pp_state_type fmt = |
|
| 60 |
fprintf fmt "State" |
|
| 46 | 61 |
|
| 47 | 62 |
(** Print the type of a variable. |
| 48 | 63 |
@param fmt the formater to print on |
| ... | ... | |
| 50 | 65 |
*) |
| 51 | 66 |
let pp_var_type fmt id = fprintf fmt |
| 52 | 67 |
(match (Types.repr id.var_type).Types.tdesc with |
| 53 |
| Types.Tbasic Types.Basic.Tint -> "int"
|
|
| 54 |
| Types.Tbasic Types.Basic.Treal -> "double"
|
|
| 55 |
| Types.Tbasic Types.Basic.Tbool -> "bool"
|
|
| 68 |
| Types.Tbasic Types.Basic.Tint -> "Integer"
|
|
| 69 |
| Types.Tbasic Types.Basic.Treal -> "Float"
|
|
| 70 |
| Types.Tbasic Types.Basic.Tbool -> "Boolean"
|
|
| 56 | 71 |
| _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*) |
| 57 | 72 |
) |
| 73 |
|
|
| 58 | 74 |
|
| 75 |
(* Variable pretty print functions *) |
|
| 59 | 76 |
|
| 60 |
(* Prototype pretty print functions *) |
|
| 61 |
|
|
| 62 |
type prototype_modifiers = In | Out |
|
| 77 |
(** Represent the possible mode for a type of a procedure parameter **) |
|
| 78 |
type parameter_mode = NoMode | In | Out | InOut |
|
| 63 | 79 |
|
| 64 |
(** Print a prototype_modifiers. |
|
| 80 |
(** Print a parameter_mode. |
|
| 81 |
@param fmt the formater to print on |
|
| 82 |
@param mode the modifier |
|
| 83 |
*) |
|
| 84 |
let pp_parameter_mode fmt mode = |
|
| 85 |
fprintf fmt "%s" (match mode with |
|
| 86 |
| NoMode -> "" |
|
| 87 |
| In -> "in" |
|
| 88 |
| Out -> "out" |
|
| 89 |
| InOut -> "in out") |
|
| 90 |
|
|
| 91 |
(** Print the name of the state variable. |
|
| 65 | 92 |
@param fmt the formater to print on |
| 66 |
@param modifier the modifier |
|
| 67 | 93 |
*) |
| 68 |
let pp_prototype_modifiers fmt modifier = |
|
| 69 |
fprintf fmt "%s" (match modifier with |
|
| 70 |
| In -> "in" |
|
| 71 |
| Out -> "out") |
|
| 94 |
let pp_state_name fmt = |
|
| 95 |
fprintf fmt "state" |
|
| 72 | 96 |
|
| 73 |
(** Print a variable declaration.
|
|
| 97 |
(** Print the name of a variable.
|
|
| 74 | 98 |
@param fmt the formater to print on |
| 75 | 99 |
@param id the variable |
| 76 | 100 |
*) |
| 77 |
let pp_var_decl fmt id = |
|
| 78 |
fprintf fmt "type %a is %a;" |
|
| 79 |
pp_var_name id |
|
| 80 |
pp_var_type id |
|
| 101 |
let pp_var_name fmt id = |
|
| 102 |
fprintf fmt "%s" id.var_id |
|
| 81 | 103 |
|
| 82 |
(** Print the parameter of a prototype, a list of modifier(eg. in or out) |
|
| 83 |
can be given to specify the type. |
|
| 84 |
@param modifiers list of the modifiers for this parameter |
|
| 104 |
(** Print a variable declaration |
|
| 105 |
@param mode input/output mode of the parameter |
|
| 106 |
@param pp_name a format printer wich print the variable name |
|
| 107 |
@param pp_type a format printer wich print the variable type |
|
| 108 |
@param fmt the formater to print on |
|
| 109 |
@param id the variable |
|
| 110 |
*) |
|
| 111 |
let pp_var_decl fmt (mode, pp_name, pp_type) = |
|
| 112 |
fprintf fmt "%t: %a %t" |
|
| 113 |
pp_name |
|
| 114 |
pp_parameter_mode mode |
|
| 115 |
pp_type |
|
| 116 |
|
|
| 117 |
(** Print variable declaration for machine variable |
|
| 118 |
@param mode input/output mode of the parameter |
|
| 85 | 119 |
@param fmt the formater to print on |
| 86 | 120 |
@param id the variable |
| 87 | 121 |
*) |
| 88 |
let pp_parameter modifiers fmt id = |
|
| 89 |
fprintf fmt "%a: %a %a" |
|
| 90 |
pp_var_name id |
|
| 91 |
(Utils.fprintf_list ~sep:"@ " pp_prototype_modifiers) modifiers |
|
| 92 |
pp_var_type id |
|
| 122 |
let pp_machine_var_decl mode fmt id = |
|
| 123 |
let pp_name = function fmt -> pp_var_name fmt id in |
|
| 124 |
let pp_type = function fmt -> pp_var_type fmt id in |
|
| 125 |
pp_var_decl fmt (mode, pp_name, pp_type) |
|
| 126 |
|
|
| 127 |
(** Print variable declaration for state variable |
|
| 128 |
@param fmt the formater to print on |
|
| 129 |
@param mode input/output mode of the parameter |
|
| 130 |
*) |
|
| 131 |
let pp_state_var_decl fmt mode = |
|
| 132 |
let pp_name = pp_state_name in |
|
| 133 |
let pp_type = pp_state_type in |
|
| 134 |
pp_var_decl fmt (mode, pp_name, pp_type) |
|
| 135 |
|
|
| 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 |
|
|
| 146 |
(* Prototype pretty print functions *) |
|
| 93 | 147 |
|
| 94 |
(** Print the prototype of a procedure |
|
| 148 |
(** Print the prototype of a machine procedure. The first parameter is always |
|
| 149 |
the state, state_modifier specify the modifier applying to it. The next |
|
| 150 |
parameters are inputs and the last parameters are the outputs. |
|
| 95 | 151 |
@param fmt the formater to print on |
| 96 | 152 |
@param name the name of the procedure |
| 153 |
@param state_mode the input/output mode for the state parameter |
|
| 97 | 154 |
@param input list of the input parameter of the procedure |
| 98 | 155 |
@param output list of the output parameter of the procedure |
| 99 | 156 |
*) |
| 100 |
let pp_simple_prototype fmt (name, input, output) = |
|
| 101 |
fprintf fmt "procedure %s(@[<v>@[%a%t%a@])@]"
|
|
| 157 |
let pp_simple_prototype fmt (name, state_mode, input, output) =
|
|
| 158 |
fprintf fmt "procedure %s(@[<v>%a%t@[%a@]%t@[%a@])@]"
|
|
| 102 | 159 |
name |
| 103 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [In])) input
|
|
| 160 |
pp_state_var_decl state_mode
|
|
| 104 | 161 |
(Utils.pp_final_char_if_non_empty ",@," input) |
| 105 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [Out])) output |
|
| 162 |
(Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl In)) input |
|
| 163 |
(Utils.pp_final_char_if_non_empty ",@," output) |
|
| 164 |
(Utils.fprintf_list ~sep:",@ " (pp_machine_var_decl Out)) output |
|
| 106 | 165 |
|
| 107 | 166 |
(** Print the prototype of the init procedure of a machine. |
| 108 | 167 |
@param fmt the formater to print on |
| 109 | 168 |
@param m the machine |
| 110 | 169 |
*) |
| 111 | 170 |
let pp_init_prototype fmt m = |
| 112 |
pp_simple_prototype fmt ("init", m.mstatic, [])
|
|
| 171 |
pp_simple_prototype fmt ("init", Out, m.mstatic, [])
|
|
| 113 | 172 |
|
| 114 | 173 |
(** Print the prototype of the step procedure of a machine. |
| 115 | 174 |
@param fmt the formater to print on |
| 116 | 175 |
@param m the machine |
| 117 | 176 |
*) |
| 118 | 177 |
let pp_step_prototype fmt m = |
| 119 |
pp_simple_prototype fmt ("step", m.mstep.step_inputs, m.mstep.step_outputs)
|
|
| 178 |
pp_simple_prototype fmt ("step", InOut, m.mstep.step_inputs, m.mstep.step_outputs)
|
|
| 120 | 179 |
|
| 121 | 180 |
(** Print the prototype of the reset procedure of a machine. |
| 122 | 181 |
@param fmt the formater to print on |
| 123 | 182 |
@param m the machine |
| 124 | 183 |
*) |
| 125 | 184 |
let pp_reset_prototype fmt m = |
| 126 |
pp_simple_prototype fmt ("reset", m.mstatic, [])
|
|
| 185 |
pp_simple_prototype fmt ("reset", InOut, m.mstatic, [])
|
|
| 127 | 186 |
|
| 128 | 187 |
(** Print the prototype of the clear procedure of a machine. |
| 129 | 188 |
@param fmt the formater to print on |
| 130 | 189 |
@param m the machine |
| 131 | 190 |
*) |
| 132 | 191 |
let pp_clear_prototype fmt m = |
| 133 |
pp_simple_prototype fmt ("clear", m.mstatic, [])
|
|
| 192 |
pp_simple_prototype fmt ("clear", InOut, m.mstatic, [])
|
|
Also available in: Unified diff