Project

General

Profile

Revision c06b3b47

View differences:

src/backends/Ada/ada_backend_ads.ml
27 27
   @param machine the machine
28 28
*)
29 29
let print fmt machine =
30
  fprintf fmt "@[<v 2>%a;@,%a;@,%a;@,%a;@,%a;@]@,%a@."
31
    (pp_begin_package false) machine
32
    pp_init_prototype machine
33
    pp_step_prototype machine
34
    pp_reset_prototype machine
35
    pp_clear_prototype machine
36
    pp_end_package machine
30
  let pp_record fmt = pp_record_definition fmt machine.mmemory in
31
  fprintf fmt "@[<v 2>%a;@,@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,private@,@,%a;@,@]@,%a@."
32
    (pp_begin_package false) machine (*Begin the package*)
33
    pp_private_type_decl pp_state_type (*Declare the state type*)
34
    pp_init_prototype machine (*Declare the init procedure*)
35
    pp_step_prototype machine (*Declare the step procedure*)
36
    pp_reset_prototype machine (*Declare the reset procedure*)
37
    pp_clear_prototype machine (*Declare the clear procedure*)
38
    pp_type_decl (pp_state_type, pp_record) (*Define the state type*)
39
    pp_end_package machine  (*End the package*)
37 40
    (*(Utils.fprintf_list ~sep:"@," pp_var_decl) machine.mmemory*)
38 41

  
39 42
end
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