Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / Ada / ada_backend_adb.ml @ 3d85297f

History | View | Annotate | Download (3.21 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 "instruction"
26

    
27

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

    
35
(** Print the definition of a procedure
36
   @param fmt the formater to print on
37
   @param m the machine
38
   @param pp_procedure_name the procedure name printer
39
   @param pp_prototype the prototype printer
40
   @param instrs the instructions of the procedure
41
**)
42
let pp_procedure_definition fmt (m, pp_procedure_name, pp_prototype, instrs) =
43
  let pp_instr = pp_machine_instr m in
44
  fprintf fmt "%a is@,begin@,  @[<v>%a@]@,end %t"
45
    pp_prototype m
46
    (Utils.fprintf_list ~sep:";@," pp_instr) instrs
47
    pp_procedure_name
48

    
49
(** Print the definition of the init procedure from a machine.
50
   @param fmt the formater to print on
51
   @param machine the machine
52
**)
53
let pp_init_definition fmt m =
54
  pp_procedure_definition fmt
55
    (m, pp_init_procedure_name, pp_init_prototype, m.minit)
56

    
57
(** Print the definition of the step procedure from a machine.
58
   @param fmt the formater to print on
59
   @param machine the machine
60
**)
61
let pp_step_definition fmt m =
62
  pp_procedure_definition fmt
63
    (m, pp_step_procedure_name, pp_step_prototype, m.minit)
64

    
65
(** Print the definition of the reset procedure from a machine.
66
   @param fmt the formater to print on
67
   @param machine the machine
68
**)
69
let pp_reset_definition fmt m =
70
  pp_procedure_definition fmt
71
    (m, pp_reset_procedure_name, pp_reset_prototype, filter_reset m.minit)
72

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

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

    
94
end