Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend_ads.ml @ bdc471f3

History | View | Annotate | Download (4.74 KB)

1
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT - ISAE-SUPAERO     *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11

    
12
open Format
13

    
14
open Machine_code_types
15
open Lustre_types
16
open Corelang
17
open Machine_code_common
18

    
19
open Ada_backend_common
20

    
21
module Main =
22
struct
23

    
24
(** Print the name of a variable.
25
   @param fmt the formater to print on
26
   @param id the variable
27
*)
28
let pp_var_name fmt id =
29
  fprintf fmt "%s" id.var_id
30

    
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
37
    | Types.Tbasic Types.Basic.Tint -> "int"
38
    | Types.Tbasic Types.Basic.Treal -> "double"
39
    | Types.Tbasic Types.Basic.Tbool -> "bool"
40
    | _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*)
41
  )
42

    
43
type prototype_modifiers = In | Out
44

    
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
*)
58
let pp_var_decl fmt id =
59
  fprintf fmt "type %a is %a;"
60
    pp_var_name id
61
    pp_var_type id
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
*)
120
let print fmt machine =
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
127
    pp_end_package machine
128
    (*(Utils.fprintf_list ~sep:"@," pp_var_decl) machine.mmemory*)
129

    
130
end
131

    
132
(*
133
package Example is
134
     type Number is range 1 .. 11;
135
     procedure Print_and_Increment (j: in out Number);
136
end Example;
137

    
138
Package body (example.adb)
139

    
140
with Ada.Text_IO;
141
package body Example is
142

    
143
  i : Number := Number'First;
144

    
145
  procedure Print_and_Increment (j: in out Number) is
146

    
147
    function Next (k: in Number) return Number is
148
    begin
149
      return k + 1;
150
    end Next;
151

    
152
  begin
153
    Ada.Text_IO.Put_Line ( "The total is: " & Number'Image(j) );
154
    j := Next (j);
155
  end Print_and_Increment;
156

    
157
-- package initialization executed when the package is elaborated
158
begin
159
  while i < Number'Last loop
160
    Print_and_Increment (i);
161
  end loop;
162
end Example;
163
*)