Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend_wrapper.ml @ 903317e7

History | View | Annotate | Download (3.04 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
    let pp_name = pp_main_procedure_name machine in
28
    pp_procedure_definition
29
      pp_name
30
      (pp_simple_prototype pp_name)
31
      (fun fmt local -> fprintf fmt "%t" local)
32
      (fun fmt instr -> fprintf fmt "%t" instr)
33
      fmt
34
      (locals, instrs)
35

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

    
47
(** Print the main file calling in a loop the step function of the main machine.
48
   @param fmt the formater to print on
49
   @param machine the main machine
50
**)
51
let pp_main_file fmt machine =
52
  let stateVar = "state" in
53
  let step_parameters = machine.mstep.step_inputs@machine.mstep.step_outputs in
54
  let pp_local_state_var_decl fmt = pp_node_state_decl stateVar fmt machine.mname in
55
  let apply_pp_var_decl var fmt = pp_machine_var_decl NoMode fmt var in
56
  let locals = List.map apply_pp_var_decl step_parameters in
57
  let locals = pp_local_state_var_decl::locals in
58
  let pp_reset fmt =
59
    fprintf fmt "%a.reset(%s)"
60
      pp_package_name machine.mname
61
      stateVar in
62
  let pp_loop fmt =
63
    fprintf fmt "while true loop@,  %a.step(@[%s,@ %a@]);@,end loop"
64
      pp_package_name machine.mname
65
      stateVar
66
      (Utils.fprintf_list ~sep:",@ " pp_var_name) step_parameters
67
      in
68
  let instrs = [pp_reset; pp_loop] in
69
  fprintf fmt "@[<v>%a;@,@,%a;@]"
70
    pp_with_node machine.mname
71
    (pp_main_procedure_definition machine) (locals, instrs)
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