|
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
|