Revision bdc471f3 src/backends/Ada/ada_backend_ads.ml
| src/backends/Ada/ada_backend_ads.ml | ||
|---|---|---|
| 10 | 10 |
(********************************************************************) |
| 11 | 11 |
|
| 12 | 12 |
open Format |
| 13 |
|
|
| 13 | 14 |
open Machine_code_types |
| 14 | 15 |
open Lustre_types |
| 15 | 16 |
open Corelang |
| 16 | 17 |
open Machine_code_common |
| 17 | 18 |
|
| 19 |
open Ada_backend_common |
|
| 20 |
|
|
| 18 | 21 |
module Main = |
| 19 | 22 |
struct |
| 20 | 23 |
|
| 21 |
let pp_package_name fmt machine = |
|
| 22 |
fprintf fmt "%s" machine.mname.node_id |
|
| 23 |
|
|
| 24 |
(** Print the name of a variable. |
|
| 25 |
@param fmt the formater to print on |
|
| 26 |
@param id the variable |
|
| 27 |
*) |
|
| 24 | 28 |
let pp_var_name fmt id = |
| 25 |
fprintf fmt "var_name"
|
|
| 29 |
fprintf fmt "%s" id.var_id
|
|
| 26 | 30 |
|
| 27 |
let pp_var_type fmt id = fprintf fmt "var_type" |
|
| 28 |
(*) (match id.var_type.tdesc with |
|
| 31 |
(** Print the type of a variable. |
|
| 32 |
@param fmt the formater to print on |
|
| 33 |
@param id the variable |
|
| 34 |
*) |
|
| 35 |
let pp_var_type fmt id = fprintf fmt |
|
| 36 |
(match (Types.repr id.var_type).Types.tdesc with |
|
| 29 | 37 |
| Types.Tbasic Types.Basic.Tint -> "int" |
| 30 | 38 |
| Types.Tbasic Types.Basic.Treal -> "double" |
| 31 | 39 |
| Types.Tbasic Types.Basic.Tbool -> "bool" |
| 32 |
| Types.Tbasic _ -> eprintf "Basic type error : %a@." Types.print_ty id.var_type; assert false (*TODO*) |
|
| 33 | 40 |
| _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*) |
| 34 |
)*)
|
|
| 41 |
) |
|
| 35 | 42 |
|
| 36 |
(* |
|
| 37 |
if Types.is_array_type id.var_type |
|
| 38 |
then pp_c_type (sprintf "(*%s)" id.var_id) fmt (Types.array_base_type id.var_type) |
|
| 39 |
else pp_c_type id.var_id fmt id.var_type |
|
| 40 |
*) |
|
| 43 |
type prototype_modifiers = In | Out |
|
| 41 | 44 |
|
| 42 |
let pp_begin_package fmt machine = |
|
| 43 |
fprintf fmt "package %a is" pp_package_name machine |
|
| 44 |
let pp_end_package fmt machine = |
|
| 45 |
fprintf fmt "end %a;" pp_package_name machine |
|
| 45 |
(** Print a prototype_modifiers. |
|
| 46 |
@param fmt the formater to print on |
|
| 47 |
@param modifier the modifier |
|
| 48 |
*) |
|
| 49 |
let pp_prototype_modifiers fmt modifier = |
|
| 50 |
fprintf fmt "%s" (match modifier with |
|
| 51 |
| In -> "in" |
|
| 52 |
| Out -> "out") |
|
| 53 |
|
|
| 54 |
(** Print a variable declaration. |
|
| 55 |
@param fmt the formater to print on |
|
| 56 |
@param id the variable |
|
| 57 |
*) |
|
| 46 | 58 |
let pp_var_decl fmt id = |
| 47 | 59 |
fprintf fmt "type %a is %a;" |
| 48 | 60 |
pp_var_name id |
| 49 | 61 |
pp_var_type id |
| 50 | 62 |
|
| 63 |
(** Print the parameter of a prototype, a list of modifier(eg. in or out) |
|
| 64 |
can be given to specify the type. |
|
| 65 |
@param modifiers list of the modifiers for this parameter |
|
| 66 |
@param fmt the formater to print on |
|
| 67 |
@param id the variable |
|
| 68 |
*) |
|
| 69 |
let pp_parameter modifiers fmt id = |
|
| 70 |
fprintf fmt "%a: %a %a" |
|
| 71 |
pp_var_name id |
|
| 72 |
(Utils.fprintf_list ~sep:"@ " pp_prototype_modifiers) modifiers |
|
| 73 |
pp_var_type id |
|
| 74 |
|
|
| 75 |
(** Print the prototype of a procedure |
|
| 76 |
@param fmt the formater to print on |
|
| 77 |
@param name the name of the procedure |
|
| 78 |
@param input list of the input parameter of the procedure |
|
| 79 |
@param output list of the output parameter of the procedure |
|
| 80 |
*) |
|
| 81 |
let pp_simple_prototype fmt (name, input, output) = |
|
| 82 |
fprintf fmt "procedure %s(@[<v>@[%a%t%a@])@]" |
|
| 83 |
name |
|
| 84 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [In])) input |
|
| 85 |
(Utils.pp_final_char_if_non_empty ",@," input) |
|
| 86 |
(Utils.fprintf_list ~sep:",@ " (pp_parameter [Out])) output |
|
| 87 |
|
|
| 88 |
(** Print the prototype of the init procedure of a machine. |
|
| 89 |
@param fmt the formater to print on |
|
| 90 |
@param m the machine |
|
| 91 |
*) |
|
| 92 |
let pp_init_prototype fmt m = |
|
| 93 |
pp_simple_prototype fmt ("init", m.mstatic, [])
|
|
| 94 |
|
|
| 95 |
(** Print the prototype of the step procedure of a machine. |
|
| 96 |
@param fmt the formater to print on |
|
| 97 |
@param m the machine |
|
| 98 |
*) |
|
| 99 |
let pp_step_prototype fmt m = |
|
| 100 |
pp_simple_prototype fmt ("step", m.mstep.step_inputs, m.mstep.step_outputs)
|
|
| 101 |
|
|
| 102 |
(** Print the prototype of the reset procedure of a machine. |
|
| 103 |
@param fmt the formater to print on |
|
| 104 |
@param m the machine |
|
| 105 |
*) |
|
| 106 |
let pp_reset_prototype fmt m = |
|
| 107 |
pp_simple_prototype fmt ("reset", m.mstatic, [])
|
|
| 108 |
|
|
| 109 |
(** Print the prototype of the clear procedure of a machine. |
|
| 110 |
@param fmt the formater to print on |
|
| 111 |
@param m the machine |
|
| 112 |
*) |
|
| 113 |
let pp_clear_prototype fmt m = |
|
| 114 |
pp_simple_prototype fmt ("clear", m.mstatic, [])
|
|
| 115 |
|
|
| 116 |
(** Print the package declaration(ads) of a lustre node. |
|
| 117 |
@param fmt the formater to print on |
|
| 118 |
@param machine the machine |
|
| 119 |
*) |
|
| 51 | 120 |
let print fmt machine = |
| 52 |
fprintf fmt "@[<v 2>%a@,%a@]@,%a@." |
|
| 53 |
pp_begin_package machine |
|
| 54 |
(Utils.fprintf_list ~sep:"@," pp_var_decl) machine.mmemory |
|
| 121 |
fprintf fmt "@[<v 2>%a;@,%a;@,%a;@,%a;@,%a;@]@,%a@." |
|
| 122 |
(pp_begin_package false) machine |
|
| 123 |
pp_init_prototype machine |
|
| 124 |
pp_step_prototype machine |
|
| 125 |
pp_reset_prototype machine |
|
| 126 |
pp_clear_prototype machine |
|
| 55 | 127 |
pp_end_package machine |
| 128 |
(*(Utils.fprintf_list ~sep:"@," pp_var_decl) machine.mmemory*) |
|
| 56 | 129 |
|
| 57 | 130 |
end |
| 58 | 131 |
|
| 59 | 132 |
(* |
| 60 |
|
|
| 61 | 133 |
package Example is |
| 62 | 134 |
type Number is range 1 .. 11; |
| 63 | 135 |
procedure Print_and_Increment (j: in out Number); |
| ... | ... | |
| 88 | 160 |
Print_and_Increment (i); |
| 89 | 161 |
end loop; |
| 90 | 162 |
end Example; |
| 91 |
|
|
| 92 |
|
|
| 93 | 163 |
*) |
Also available in: Unified diff