Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend_adb.ml @ 2ddbde7d

History | View | Annotate | Download (2.96 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 Lustre_types
16
open Corelang
17
open Machine_code_common
18

    
19
open Ada_backend_common
20

    
21
module Main =
22
struct
23

    
24
let pp_machine_instr machine fmt instr =
25
    fprintf fmt "NULL"
26

    
27
(** Keep only the MReset from an instruction list.
28
  @param list to filter
29
**)
30
let filter_reset instr_list = List.map
31
  (fun i -> match get_instr_desc i with MReset i -> i | _ -> assert false)
32
  instr_list
33

    
34
(** Print the definition of the init procedure from a machine.
35
   @param fmt the formater to print on
36
   @param machine the machine
37
**)
38
let pp_init_definition fmt m = pp_procedure_definition
39
      pp_init_procedure_name
40
      (pp_init_prototype m)
41
      pp_var_decl
42
      (pp_machine_instr m)
43
      fmt
44
      ([], m.minit)
45

    
46
(** Print the definition of the step procedure from a machine.
47
   @param fmt the formater to print on
48
   @param machine the machine
49
**)
50
let pp_step_definition fmt m = pp_procedure_definition
51
      pp_step_procedure_name
52
      (pp_step_prototype m)
53
      pp_var_decl
54
      (pp_machine_instr m)
55
      fmt
56
      ([], m.mstep.step_instrs)
57

    
58
(** Print the definition of the reset procedure from a machine.
59
   @param fmt the formater to print on
60
   @param machine the machine
61
**)
62
let pp_reset_definition fmt m = pp_procedure_definition
63
      pp_reset_procedure_name
64
      (pp_reset_prototype m)
65
      pp_var_decl
66
      (pp_machine_instr m)
67
      fmt
68
      ([], m.minit)
69

    
70
(** Print the definition of the clear procedure from a machine.
71
   @param fmt the formater to print on
72
   @param machine the machine
73
**)
74
let pp_clear_definition fmt m = pp_procedure_definition
75
      pp_clear_procedure_name
76
      (pp_clear_prototype m)
77
      pp_var_decl
78
      (pp_machine_instr m)
79
      fmt
80
      ([], filter_reset m.minit)
81

    
82
(** Print the package definition(adb) of a machine.
83
   @param fmt the formater to print on
84
   @param machine the machine
85
**)
86
let pp_file fmt machine =
87
  fprintf fmt "%a@,  @[<v>@,%a;@,@,%a;@,@,%a;@,@,%a;@,@]@,%a;@."
88
    (pp_begin_package true) machine (*Begin the package*)
89
    pp_init_definition machine (*Define the init procedure*)
90
    pp_step_definition machine (*Define the step procedure*)
91
    pp_reset_definition machine (*Define the reset procedure*)
92
    pp_clear_definition machine (*Define the clear procedure*)
93
    pp_end_package machine  (*End the package*)
94

    
95
end