Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend_ads.ml @ 48a6309c

History | View | Annotate | Download (2.62 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
open Machine_code_types
14
open Lustre_types
15
open Corelang
16
open Machine_code_common
17

    
18
module Main =
19
struct
20

    
21
let pp_package_name fmt machine =
22
  fprintf fmt "%s" machine.mname.node_id
23

    
24
let pp_var_name fmt id =
25
  fprintf fmt "var_name"
26

    
27
let pp_var_type fmt id = fprintf fmt "var_type"
28
(*)  (match id.var_type.tdesc with
29
    | Types.Tbasic Types.Basic.Tint -> "int"
30
    | Types.Tbasic Types.Basic.Treal -> "double"
31
    | Types.Tbasic Types.Basic.Tbool -> "bool"
32
    | Types.Tbasic _ -> eprintf "Basic type error : %a@." Types.print_ty id.var_type; assert false (*TODO*)
33
    | _ -> eprintf "Type error : %a@." Types.print_ty id.var_type; assert false (*TODO*)
34
  )*)
35

    
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
*)
41

    
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
46
let pp_var_decl fmt id =
47
  fprintf fmt "type %a is %a;"
48
    pp_var_name id
49
    pp_var_type id
50

    
51
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
55
    pp_end_package machine
56

    
57
end
58

    
59
(*
60

    
61
package Example is
62
     type Number is range 1 .. 11;
63
     procedure Print_and_Increment (j: in out Number);
64
end Example;
65

    
66
Package body (example.adb)
67

    
68
with Ada.Text_IO;
69
package body Example is
70

    
71
  i : Number := Number'First;
72

    
73
  procedure Print_and_Increment (j: in out Number) is
74

    
75
    function Next (k: in Number) return Number is
76
    begin
77
      return k + 1;
78
    end Next;
79

    
80
  begin
81
    Ada.Text_IO.Put_Line ( "The total is: " & Number'Image(j) );
82
    j := Next (j);
83
  end Print_and_Increment;
84

    
85
-- package initialization executed when the package is elaborated
86
begin
87
  while i < Number'Last loop
88
    Print_and_Increment (i);
89
  end loop;
90
end Example;
91

    
92

    
93
*)