Revision fd834769 src/backends/Ada/ada_backend_wrapper.ml
src/backends/Ada/ada_backend_wrapper.ml | ||
---|---|---|
9 | 9 |
(* *) |
10 | 10 |
(********************************************************************) |
11 | 11 |
|
12 |
open Format |
|
13 |
|
|
14 |
open Machine_code_types |
|
15 |
open Ada_backend_common |
|
16 |
|
|
12 | 17 |
module Main = |
13 | 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 |
|
|
14 | 83 |
end |
Also available in: Unified diff