Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend_wrapper.ml @ 03143434

History | View | Annotate | Download (4.56 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 Ada_backend_common
16

    
17
module Main =
18
struct
19

    
20
(** Print the main procedure
21
   @param fmt the formater to print on
22
   @param machine the main machine
23
   @param locals list of local variable printers
24
   @param instrs list of instructions printer
25
**)
26
let pp_main_procedure_definition machine fmt (locals, instrs) =
27
    pp_procedure_definition
28
      pp_main_procedure_name
29
      (pp_simple_prototype pp_main_procedure_name)
30
      (fun fmt local -> fprintf fmt "%t" local)
31
      (fun fmt instr -> fprintf fmt "%t" instr)
32
      fmt
33
      (locals, instrs)
34

    
35
(** Print call to machine procedure on state.
36
   @param instance name of the variable
37
   @param fmt the formater to print on
38
   @param instance node
39
**)
40
let pp_node_reset_call name fmt node =
41
  let pp_package fmt = pp_package_name fmt node in
42
  let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in
43
  let pp_name fmt = pp_clean_ada_identifier fmt name in
44
  pp_var_decl fmt (NoMode, pp_name, pp_type)
45

    
46
(** Print the main file calling in a loop the step function of the main machine.
47
   @param fmt the formater to print on
48
   @param machine the main machine
49
**)
50
let pp_main_adb fmt machine =
51
  let pp_str str fmt = fprintf fmt "%s"str in
52
  (* Dependances *)
53
  let text_io = "Ada.Text_IO" in
54
  
55
  (* Locals *)
56
  let stateVar = "state" in
57
  let step_parameters = machine.mstep.step_inputs@machine.mstep.step_outputs in
58
  let pp_local_state_var_decl fmt = pp_node_state_decl [] stateVar fmt machine in
59
  let apply_pp_var_decl var fmt = pp_machine_var_decl NoMode fmt var in
60
  let locals = List.map apply_pp_var_decl step_parameters in
61
  let locals = pp_local_state_var_decl::locals in
62

    
63
  (* Node instructions *)
64
  let pp_reset fmt =
65
    fprintf fmt "%a.reset(%s)"
66
      pp_package_name machine
67
      stateVar in
68
  let pp_step fmt =
69
    fprintf fmt "%a.step(@[%s,@ %a@])"
70
      pp_package_name machine
71
      stateVar
72
      (Utils.fprintf_list ~sep:",@ " pp_var_name) step_parameters in
73

    
74
  (* Stream instructions *)
75
  let pp_stdin fmt = fprintf fmt "Ada.Text_IO.Standard_Input" in
76
  let pp_stdout fmt = fprintf fmt "Ada.Text_IO.Standard_Output" in
77
  let pp_read fmt var =
78
    fprintf fmt "%a := %a'Value(Ada.Text_IO.Get_Line(%t))"
79
      pp_var_name var
80
      pp_var_type var
81
      pp_stdin in
82
  let pp_write fmt var =
83
    fprintf fmt "Ada.Text_IO.Put_Line(%t, %a'Image(%a))"
84
      pp_stdout
85
      pp_var_type var
86
      pp_var_name var in
87

    
88
  (* Loop instructions *)
89
  let pp_loop fmt =
90
    fprintf fmt "while not Ada.Text_IO.End_Of_File (%t) loop@,  @[<v>%a;@,%t;@,%a;@]@,end loop"
91
      pp_stdin
92
      (Utils.fprintf_list ~sep:";@," pp_read) machine.mstep.step_inputs
93
      pp_step
94
      (Utils.fprintf_list ~sep:";@," pp_write) machine.mstep.step_outputs in
95
  
96
  (* Print the file *)
97
  let instrs = [ pp_reset;
98
                 pp_loop] in
99
  fprintf fmt "@[<v>%a;@,%a;@,@,%a;@]"
100
    pp_private_with (pp_str text_io)
101
    pp_with_machine machine
102
    (pp_main_procedure_definition machine) (locals, instrs)
103

    
104

    
105

    
106
(*
107
with Ada.Text_IO;
108
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
109

    
110
procedure Show_Float_Stream is
111
   F         : File_Type;
112
   S         : Stream_Access;
113
   File_Name : constant String := "float_file.bin";
114
begin
115
   Create (F, Out_File, File_Name);
116
   S := Stream (F);
117

    
118
   Float'Write (S, 1.5);
119
   Float'Write (S, 2.4);
120
   Float'Write (S, 6.7);
121

    
122
   Close (F);
123

    
124
   declare
125
      Value : Float;
126
   begin
127
      Open (F, In_File, File_Name);
128
      S := Stream (F);
129

    
130
      while not End_Of_File (F) loop
131
         Float'Read (S, Value);
132
         Ada.Text_IO.Put_Line (Float'Image (Value));
133
      end loop;
134
      Close (F);
135
*)
136

    
137

    
138

    
139
(** Print the gpr project file.
140
   @param fmt the formater to print on
141
   @param machine the main machine
142
**)
143
let pp_project_file fmt machine =
144
    fprintf fmt "project %a is@.  for Main use (\"%a\");@.end %a;"
145
      pp_package_name machine
146
      (pp_filename "adb") pp_main_procedure_name
147
      pp_package_name machine
148

    
149
end