Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (3 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 machine)
29
      pp_simple_prototype
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_init_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_file fmt machine =
51
  let stateVar = "state" in
52
  let step_parameters = machine.mstep.step_inputs@machine.mstep.step_outputs in
53
  let pp_local_state_var_decl fmt = pp_node_state_decl stateVar fmt machine.mname in
54
  let apply_pp_var_decl var fmt = pp_machine_var_decl NoMode fmt var in
55
  let locals = List.map apply_pp_var_decl step_parameters in
56
  let locals = pp_local_state_var_decl::locals in
57
  let pp_init fmt =
58
    fprintf fmt "%a.init(%s)"
59
      pp_package_name machine.mname
60
      stateVar in
61
  let pp_loop fmt =
62
    fprintf fmt "while true loop@,  %a.step(@[%s,@ %a@]);@,end loop"
63
      pp_package_name machine.mname
64
      stateVar
65
      (Utils.fprintf_list ~sep:",@ " pp_var_name) step_parameters
66
      in
67
  let instrs = [pp_init; pp_loop] in
68
  fprintf fmt "@[<v>%a;@,@,%a;@]"
69
    pp_with_node machine.mname
70
    (pp_main_procedure_definition machine) (locals, instrs)
71

    
72

    
73
(** Print the gpr project file.
74
   @param fmt the formater to print on
75
   @param machine the main machine
76
**)
77
let pp_project_file fmt machine =
78
    fprintf fmt "project %a is@.  for Main use (\"%a\");@.end %a;"
79
      pp_package_name machine.mname
80
      pp_main_filename machine
81
      pp_package_name machine.mname
82

    
83
end