Project

General

Profile

« Previous | Next » 

Revision 230b168e

Added by Guillaume DAVY almost 3 years ago

Ada: Refactor Ada Backend to reduce redundancy, make it more modular and
more simple.

View differences:

src/backends/Ada/ada_backend_wrapper.ml
12 12
open Format
13 13

  
14 14
open Machine_code_types
15
open Ada_backend_common
16 15
open Lustre_types
17 16

  
17
open Misc_printer
18
open Misc_lustre_function
19
open Ada_printer
20
open Ada_backend_common
21

  
18 22
module Main =
19 23
struct
20 24

  
21
  (** Print the main procedure
22
     @param fmt the formater to print on
23
     @param machine the main machine
24
     @param locals list of local variable printers
25
     @param instrs list of instructions printer
26
  **)
27
  let pp_main_procedure_definition machine fmt (locals, instrs) =
28
      pp_procedure_definition
29
        pp_main_procedure_name
30
        (pp_simple_prototype pp_main_procedure_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)
25
  let build_text_io_package_local typ =
26
    AdaLocalPackage (
27
      (fun fmt -> fprintf fmt "%s_IO" typ),
28
      (fun fmt -> fprintf fmt "Ada.Text_IO.%s_IO" typ),
29
      [((fun fmt -> fprintf fmt "Num"), (fun fmt -> fprintf fmt "%s" typ))])
46 30

  
47 31
  (** Print the main file calling in a loop the step function of the main machine.
48 32
     @param fmt the formater to print on
......
50 34
  **)
51 35
  let pp_main_adb typed_submachines fmt machine =
52 36
    let statefull = is_machine_statefull machine in
53
    let pp_str str fmt = fprintf fmt "%s" str in
37
    
38
    let pp_package = pp_package_name_with_polymorphic [] machine in
54 39
    
55 40
    (* Dependances *)
56 41
    let text_io = "Ada.Text_IO" in
57
    let float_io = "package Float_IO is new Ada.Text_IO.Float_IO(Float)" in
58
    let integer_io = "package Integer_IO is new Ada.Text_IO.Integer_IO(Integer)" in
59 42
    
60 43
    (* Locals *)
61
    let stateVar = asprintf "%t" pp_state_name in
62
    let pp_local_state_var_decl fmt = pp_node_state_decl [] stateVar fmt machine in
63
    let apply_pp_var_decl var fmt = pp_machine_var_decl NoMode fmt var in
64
    let step_parameters = machine.mstep.step_inputs@machine.mstep.step_outputs in
65
    let locals = List.map apply_pp_var_decl step_parameters in
66
    let locals = [pp_str integer_io;pp_str float_io]@(if statefull then [pp_local_state_var_decl] else [])@locals in
67

  
68
    (* Node instructions *)
69
    let pp_reset fmt =
70
      pp_package_call
71
        pp_reset_procedure_name
72
        fmt
73
        ([], machine, pp_state_name, None)
74
    in
75
    let pp_args fmt =
76
      fprintf fmt "@[%a@]"
77
        (Utils.fprintf_list ~sep:",@ " pp_var_name) step_parameters
78
    in
79
    let pp_step fmt =
80
          pp_package_call
81
            pp_step_procedure_name
82
            fmt
83
            ([], machine, pp_state_name, Some pp_args)
44
    let locals =
45
      [[build_text_io_package_local "Integer";build_text_io_package_local "Float"]]
46
      @(if statefull then [[AdaLocalVar (build_pp_state_decl_from_subinstance (asprintf "%t" pp_state_name, ([], machine)))]] else [])
47
      @(if machine.mstep.step_inputs != [] then [List.map build_pp_var_decl_local machine.mstep.step_inputs] else [])
48
      @(if machine.mstep.step_outputs != [] then [List.map build_pp_var_decl_local machine.mstep.step_outputs] else [])
84 49
    in
85 50

  
86 51
    (* Stream instructions *)
......
115 80

  
116 81
    (* Loop instructions *)
117 82
    let pp_loop fmt =
118
      fprintf fmt "while not Ada.Text_IO.End_Of_File loop@,  @[<v>%a;@,%t;@,%a;@]@,end loop"
83
      let args = pp_state_name::(List.map (fun x fmt -> pp_var_name fmt x) (machine.mstep.step_inputs@machine.mstep.step_outputs)) in
84
      fprintf fmt "while not Ada.Text_IO.End_Of_File loop@,  @[<v>%a;@,%a;@,%a;@]@,end loop"
119 85
        (Utils.fprintf_list ~sep:";@," pp_read) machine.mstep.step_inputs
120
        pp_step
86
        pp_call (pp_package_access (pp_package, pp_step_procedure_name), [args])
121 87
        (Utils.fprintf_list ~sep:";@," pp_write) machine.mstep.step_outputs in
122 88
    
123 89
    (* Print the file *)
124
    let instrs = (if statefull then [pp_reset] else [])@[pp_loop] in
90
    let instrs = (if statefull then [fun fmt -> pp_call fmt (pp_package_access (pp_package, pp_reset_procedure_name), [[pp_state_name]])] else [])@[pp_loop] in
125 91
    fprintf fmt "@[<v>%a;@,%a;@,@,%a;@]"
126
      pp_private_with (pp_str text_io)
127
      pp_with_machine machine
128
      (pp_main_procedure_definition machine) (locals, instrs)
92
      (pp_with AdaPrivate) (pp_str text_io)
93
      (pp_with AdaPrivate) (pp_package_name machine)
94
      (pp_procedure pp_main_procedure_name [] None) (AdaProcedureContent (locals, instrs))
129 95

  
130 96
  (** Print the name of the ada project configuration file.
131 97
     @param fmt the formater to print on

Also available in: Unified diff