Project

General

Profile

Revision 48a6309c src/backends/Ada/ada_backend_ads.ml

View differences:

src/backends/Ada/ada_backend_ads.ml
9 9
(*                                                                  *)
10 10
(********************************************************************)
11 11

  
12
open Format
13
open Machine_code_types
14
open Lustre_types
15
open Corelang
16
open Machine_code_common
17

  
12 18
module Main =
13 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

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

Also available in: Unified diff