Project

General

Profile

Revision 48a6309c

View differences:

src/backends/Ada/ada_backend.ml
10 10
(********************************************************************)
11 11

  
12 12
open Format
13
open Machine_code_types
14

  
15
let gen_ada destname print suffix machine =
16
  let path = destname ^ machine.mname.node_id ^ suffix in
17
  let out = open_out path in
18
  let fmt = formatter_of_out_channel out in
19
  print fmt machine;
20
  close_out out;
21
  Log.report ~level:2 (fun fmt -> fprintf fmt "    .. %s generated @." path)
13 22

  
14 23
let translate_to_ada basename prog machines dependencies =
15 24
  let module Ads = Ada_backend_ads.Main in
16 25
  let module Adb = Ada_backend_adb.Main in
17 26
  let module Wrapper = Ada_backend_wrapper.Main in
18
  print_endline "Ada code generated!"
27

  
28
  let destname = !Options.dest_dir ^ "/" ^ basename in
29

  
30
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating ads@,");
31

  
32
  List.iter (gen_ada destname Ads.print ".ads") machines;
33

  
34
  Log.report ~level:2 (fun fmt -> fprintf fmt "  .. Generating adb@,");
35

  
36
  List.iter (gen_ada destname Adb.print ".adb") machines
19 37

  
20 38
(* Local Variables: *)
21 39
(* compile-command:"make -C ../../.." *)
src/backends/Ada/ada_backend_adb.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
(*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
let pp_machine_instr machine fmt instr =
30
    fprintf fmt "instruction"
31

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

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