Project

General

Profile

Revision bdc471f3

View differences:

src/backends/Ada/ada_backend_adb.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
(*TODO: Copied from ./ada_backend_ads.ml *)
22
let pp_package_name fmt machine =
23
  fprintf fmt "%s" machine.mname.node_id
24
let pp_begin_package fmt machine =
25
  fprintf fmt "package body %a is" pp_package_name machine
26
let pp_end_package fmt machine =
27
  fprintf fmt "end %a;" pp_package_name machine
28

  
29 24
let pp_machine_instr machine fmt instr =
30 25
    fprintf fmt "instruction"
31 26

  
32 27
let print fmt machine =
33 28
  let pp_instr = pp_machine_instr machine in
34 29
  fprintf fmt "@[<v 2>%a@,%a@]@,%a@."
35
    pp_begin_package machine
30
    (pp_begin_package true) machine
36 31
    (Utils.fprintf_list ~sep:"@," pp_instr) machine.mstep.step_instrs
37 32
    pp_end_package machine
38 33

  
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
*)
src/backends/Ada/ada_backend_common.ml
1
open Format
2

  
3
open Machine_code_types
4
open Lustre_types
5
open Corelang
6
open Machine_code_common
7

  
8
(** Print the name of a package associated to a machine.
9
   @param fmt the formater to print on
10
   @param machine the machine
11
*)
12
let pp_package_name fmt machine =
13
  fprintf fmt "%s" machine.mname.node_id
14

  
15

  
16
(** Print the ada package introduction sentence it can be used for body and
17
declaration. Boolean parameter body should be true if it is a body delcaration.
18
   @param fmt the formater to print on
19
   @param fmt the formater to print on
20
   @param machine the machine
21
*)
22
let pp_begin_package body fmt machine =
23
  fprintf fmt "package %s %a is"
24
    (if body then "body" else "")
25
    pp_package_name machine
26

  
27
(** Print the ada package conclusion sentence.
28
   @param fmt the formater to print on
29
   @param machine the machine
30
*)
31
let pp_end_package fmt machine =
32
  fprintf fmt "end %a;" pp_package_name machine

Also available in: Unified diff