Project

General

Profile

« Previous | Next » 

Revision fd834769

Added by Guillaume DAVY over 5 years ago

Ada: Add the generation of the wrapper file : the main ada file and the project. It is called
only if the main node option is given to lustrec. This feature implied some refactoring. Also
added some OCaml Doc to undocummented functions.

View differences:

src/backends/Ada/ada_backend_ads.ml
22 22
module Main =
23 23
struct
24 24

  
25
(** Print name of a node associated to an instance.
25
(** Print a with statement to include an instance.
26 26
   @param fmt the formater to print on
27 27
   @param instance the instance
28 28
**)
29
let pp_instance_node_name fmt instance =
30
  let (_, (node, _)) = instance in
31
  let node = match node.top_decl_desc with 
32
              | Node nd         -> nd
33
              | _ -> assert false (*TODO*) in
34
  pp_package_name fmt node
29
let pp_with_subinstance fmt instance =
30
  pp_with_node fmt (extract_node instance)
35 31

  
36 32
(** Print the declaration of a state element of a subinstance of a machine.
37 33
   @param fmt the formater to print on
38 34
   @param instance the instance
39 35
**)
40 36
let pp_machine_subinstance_state_decl fmt instance =
41
  let (name, (node, static)) = instance in
42
  let pp_package fmt = pp_instance_node_name fmt instance in
43
  let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in
44
  let pp_name fmt = print_clean_ada_identifier fmt name in
45
  pp_var_decl fmt (NoMode, pp_name, pp_type)
37
  pp_node_state_decl (fst instance) fmt (extract_node instance)
46 38

  
47 39
(** Print the state record for a machine.
48 40
   @param fmt the formater to print on
......
55 47
    (Utils.fprintf_list ~sep:";@;" (pp_machine_var_decl NoMode)) var_list
56 48
    (Utils.pp_final_char_if_non_empty ";" var_list)
57 49

  
58
(** Print a with statement to include an instance.
59
   @param fmt the formater to print on
60
   @param instance the instance
61
**)
62
let pp_with_subinstance fmt instance =
63
  fprintf fmt "private with %a" pp_instance_node_name instance
64

  
65 50
(** Print the package declaration(ads) of a machine.
66 51
   @param fmt the formater to print on
67
   @param machine the machine
52
   @param m the machine
68 53
**)
69
let print fmt machine =
54
let pp_file fmt m =
70 55
  (* Take apart the arrow instance from the instance list and transform them
71 56
     into simple boolean variable *)
72 57
  let extract (instances, arrows) instance =
......
75 60
      (instances, (dummy_var_decl name Type_predef.type_bool)::arrows)
76 61
    else
77 62
      (instance::instances, arrows) in
78
  let instances, arrows = List.fold_left extract ([], []) machine.minstances in
63
  let instances, arrows = List.fold_left extract ([], []) m.minstances in
79 64
  (* Add the boolean variable reated for arrow instance to the list of all variable *)
80
  let var_list = arrows@machine.mmemory in
65
  let var_list = arrows@m.mmemory in
81 66
  let pp_record fmt = pp_state_record_definition fmt (var_list, instances) in
82 67
  fprintf fmt "@[<v>%a%t@,%a@,  @[<v>@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,private@,@,%a;@,@]@,%a;@.@]"
83
    (Utils.fprintf_list ~sep:";@," pp_with_subinstance) instances (* Include all the subinstance*)
68
    
69
    (* Include all the subinstance*)
70
    (Utils.fprintf_list ~sep:";@," pp_with_subinstance) instances
84 71
    (Utils.pp_final_char_if_non_empty ";@," instances)
85
    (pp_begin_package false) machine (*Begin the package*)
86
    pp_private_type_decl pp_state_type (*Declare the state type*)
87
    pp_init_prototype machine (*Declare the init procedure*)
88
    pp_step_prototype machine (*Declare the step procedure*)
89
    pp_reset_prototype machine (*Declare the reset procedure*)
90
    pp_clear_prototype machine (*Declare the clear procedure*)
91
    pp_type_decl (pp_state_type, pp_record) (*Define the state type*)
92
    pp_end_package machine  (*End the package*)
72
    
73
    (*Begin the package*)
74
    (pp_begin_package false) m
75
    
76
    (*Declare the state type*)
77
    pp_private_type_decl pp_state_type
78
    
79
    (*Declare the init procedure*)
80
    (pp_init_prototype m) pp_init_procedure_name
81
    
82
    (*Declare the step procedure*)
83
    (pp_step_prototype m) pp_step_procedure_name
84
    
85
    (*Declare the reset procedure*)
86
    (pp_reset_prototype m) pp_reset_procedure_name
87
    
88
    (*Declare the clear procedure*)
89
    (pp_clear_prototype m) pp_clear_procedure_name
90
    
91
    (*Define the state type*)
92
    pp_type_decl (pp_state_type, pp_record)
93
    
94
    (*End the package*)
95
    pp_end_package m
93 96

  
94 97
end

Also available in: Unified diff