Project

General

Profile

Revision 903317e7

View differences:

src/backends/Ada/ada_backend_ads.ml
64 64 
  (* Add the boolean variable reated for arrow instance to the list of all variable *)
65 65 
  let var_list = arrows@m.mmemory in
66 66 
  let pp_record fmt = pp_state_record_definition fmt (var_list, instances) in
67 
  fprintf fmt "@[<v>%a%t@,%a@,  @[<v>@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,%a;@,@,private@,@,%a;@,@]@,%a;@.@]"
67 
  fprintf fmt "@[<v>%a%t@,%a@,  @[<v>@,%a;@,@,%t;@,@,%t;@,@,private@,@,%a;@,@]@,%a;@.@]"
68 68
69 69 
    (* Include all the subinstance*)
70 70 
    (Utils.fprintf_list ~sep:";@," pp_with_subinstance) instances
......
76 76 
    (*Declare the state type*)
77 77 
    pp_private_limited_type_decl pp_state_type
78 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 79 
    (*Declare the reset procedure*)
86 
    (pp_reset_prototype m) pp_reset_procedure_name
80 
    (pp_reset_prototype m)
87 81
88 
    (*Declare the clear procedure*)
89 
    (pp_clear_prototype m) pp_clear_procedure_name
82 
    (*Declare the step procedure*)
83 
    (pp_step_prototype m)
90 84
91 85 
    (*Define the state type*)
92 86 
    pp_type_decl (pp_state_type, pp_record)
src/backends/Ada/ada_backend_common.ml
230 230 

  		




  231
  231
  
    
(* Prototype pretty print functions *)


  		




  232
  232
  
    

  		




  233
  
  
    
(** Print the name of the init procedure **)


  		




  234
  
  
    
let pp_init_procedure_name fmt = fprintf fmt "init"


  		




  
  233
  
    
(** Print the reset of the init procedure **)


  		




  
  234
  
    
let pp_reset_procedure_name fmt = fprintf fmt "reset"


  		




  235
  235
  
    

  		




  236
  236
  
    
(** Print the step of the init procedure **)


  		




  237
  237
  
    
let pp_step_procedure_name fmt = fprintf fmt "step"


  		




  238
  238
  
    

  		




  239
  
  
    
(** Print the reset of the init procedure **)


  		




  240
  
  
    
let pp_reset_procedure_name fmt = fprintf fmt "reset"


  		




  
  239
  
    
(** Print the name of the init procedure **)


  		




  
  240
  
    
let pp_init_procedure_name fmt = fprintf fmt "init"


  		




  241
  241
  
    

  		




  242
  242
  
    
(** Print the clear of the init procedure **)


  		




  243
  243
  
    
let pp_clear_procedure_name fmt = fprintf fmt "clear"


  		




  ......




  246
  246
  
    
   @param fmt the formater to print on


  		




  247
  247
  
    
   @param name the name of the procedure


  		




  248
  248
  
    
**)


  		




  249
  
  
    
let pp_simple_prototype fmt pp_name =


  		




  
  249
  
    
let pp_simple_prototype pp_name fmt =


  		




  250
  250
  
    
  fprintf fmt "procedure %t" pp_name


  		




  251
  251
  
    

  		




  252
  252
  
    
(** Print the prototype of a machine procedure. The first parameter is always


  		




  ......




  267
  267
  
    
    (Utils.pp_final_char_if_non_empty ";@," output)


  		




  268
  268
  
    
    (Utils.fprintf_list ~sep:";@ " (pp_machine_var_decl Out)) output


  		




  269
  269
  
    

  		




  270
  
  
    
(** Print the prototype of the init procedure of a machine.


  		




  
  270
  
    
(** Print the prototype of the step procedure of a machine.


  		




  271
  271
  
    
   @param m the machine


  		




  272
  272
  
    
   @param fmt the formater to print on


  		




  273
  273
  
    
   @param pp_name name function printer


  		




  274
  274
  
    
**)


  		




  275
  
  
    
let pp_init_prototype m fmt pp_name =


  		




  276
  
  
    
  pp_base_prototype Out m.mstatic [] fmt pp_name


  		




  
  275
  
    
let pp_step_prototype m fmt =


  		




  
  276
  
    
  pp_base_prototype InOut m.mstep.step_inputs m.mstep.step_outputs fmt pp_step_procedure_name


  		




  277
  277
  
    

  		




  278
  
  
    
(** Print the prototype of the step procedure of a machine.


  		




  
  278
  
    
(** Print the prototype of the reset procedure of a machine.


  		




  279
  279
  
    
   @param m the machine


  		




  280
  280
  
    
   @param fmt the formater to print on


  		




  281
  281
  
    
   @param pp_name name function printer


  		




  282
  282
  
    
**)


  		




  283
  
  
    
let pp_step_prototype m fmt pp_name =


  		




  284
  
  
    
  pp_base_prototype InOut m.mstep.step_inputs m.mstep.step_outputs fmt pp_name


  		




  
  283
  
    
let pp_reset_prototype m fmt =


  		




  
  284
  
    
  pp_base_prototype InOut m.mstatic [] fmt pp_reset_procedure_name


  		




  285
  285
  
    

  		




  286
  
  
    
(** Print the prototype of the reset procedure of a machine.


  		




  
  286
  
    
(** Print the prototype of the init procedure of a machine.


  		




  287
  287
  
    
   @param m the machine


  		




  288
  288
  
    
   @param fmt the formater to print on


  		




  289
  289
  
    
   @param pp_name name function printer


  		




  290
  290
  
    
**)


  		




  291
  
  
    
let pp_reset_prototype m fmt pp_name =


  		




  292
  
  
    
  pp_base_prototype InOut m.mstatic [] fmt pp_name


  		




  
  291
  
    
let pp_init_prototype m fmt =


  		




  
  292
  
    
  pp_base_prototype Out m.mstatic [] fmt pp_init_procedure_name


  		




  293
  293
  
    

  		




  294
  294
  
    
(** Print the prototype of the clear procedure of a machine.


  		




  295
  295
  
    
   @param m the machine


  		




  296
  296
  
    
   @param fmt the formater to print on


  		




  297
  297
  
    
   @param pp_name name function printer


  		




  298
  298
  
    
**)


  		




  299
  
  
    
let pp_clear_prototype m fmt pp_name =


  		




  300
  
  
    
  pp_base_prototype InOut m.mstatic [] fmt pp_name


  		




  
  299
  
    
let pp_clear_prototype m fmt =


  		




  
  300
  
    
  pp_base_prototype InOut m.mstatic [] fmt pp_clear_procedure_name


  		




  301
  301
  
    

  		




  302
  302
  
    

  		




  303
  303
  
    
(* Procedure pretty print functions *)


  		




  ......




  312
  312
  
    
   @param instrs instructions list


  		




  313
  313
  
    
**)


  		




  314
  314
  
    
let pp_procedure_definition pp_name pp_prototype pp_local pp_instr fmt (locals, instrs) =


  		




  315
  
  
    
  fprintf fmt "@[<v>%a is%t@[<v>%a%t@]@,begin@,  @[<v>%a%t@]@,end %t@]"


  		




  316
  
  
    
    pp_prototype pp_name


  		




  
  315
  
    
  fprintf fmt "@[<v>%t is%t@[<v>%a%t@]@,begin@,  @[<v>%a%t@]@,end %t@]"


  		




  
  316
  
    
    pp_prototype


  		




  317
  317
  
    
    (Utils.pp_final_char_if_non_empty "@,  " locals)


  		




  318
  318
  
    
    (Utils.fprintf_list ~sep:";@," pp_local) locals


  		




  319
  319
  
    
    (Utils.pp_final_char_if_non_empty ";" locals)


  		












  

    
      src/backends/Ada/ada_backend_wrapper.ml
    
  





  24
  24
  
    
   @param instrs list of instructions printer


  		




  25
  25
  
    
**)


  		




  26
  26
  
    
let pp_main_procedure_definition machine fmt (locals, instrs) =


  		




  
  27
  
    
    let pp_name = pp_main_procedure_name machine in


  		




  27
  28
  
    
    pp_procedure_definition


  		




  28
  
  
    
      (pp_main_procedure_name machine)


  		




  29
  
  
    
      pp_simple_prototype


  		




  
  29
  
    
      pp_name


  		




  
  30
  
    
      (pp_simple_prototype pp_name)


  		




  30
  31
  
    
      (fun fmt local -> fprintf fmt "%t" local)


  		




  31
  32
  
    
      (fun fmt instr -> fprintf fmt "%t" instr)


  		




  32
  33
  
    
      fmt


  		




  ......




  37
  38
  
    
   @param fmt the formater to print on


  		




  38
  39
  
    
   @param instance node


  		




  39
  40
  
    
**)


  		




  40
  
  
    
let pp_node_init_call name fmt node =


  		




  
  41
  
    
let pp_node_reset_call name fmt node =


  		




  41
  42
  
    
  let pp_package fmt = pp_package_name fmt node in


  		




  42
  43
  
    
  let pp_type fmt = pp_package_access fmt (pp_package, pp_state_type) in


  		




  43
  44
  
    
  let pp_name fmt = pp_clean_ada_identifier fmt name in


  		




  ......




  54
  55
  
    
  let apply_pp_var_decl var fmt = pp_machine_var_decl NoMode fmt var in


  		




  55
  56
  
    
  let locals = List.map apply_pp_var_decl step_parameters in


  		




  56
  57
  
    
  let locals = pp_local_state_var_decl::locals in


  		




  57
  
  
    
  let pp_init fmt =


  		




  58
  
  
    
    fprintf fmt "%a.init(%s)"


  		




  
  58
  
    
  let pp_reset fmt =


  		




  
  59
  
    
    fprintf fmt "%a.reset(%s)"


  		




  59
  60
  
    
      pp_package_name machine.mname


  		




  60
  61
  
    
      stateVar in


  		




  61
  62
  
    
  let pp_loop fmt =


  		




  ......




  64
  65
  
    
      stateVar


  		




  65
  66
  
    
      (Utils.fprintf_list ~sep:",@ " pp_var_name) step_parameters


  		




  66
  67
  
    
      in


  		




  67
  
  
    
  let instrs = [pp_init; pp_loop] in


  		




  
  68
  
    
  let instrs = [pp_reset; pp_loop] in


  		




  68
  69
  
    
  fprintf fmt "@[<v>%a;@,@,%a;@]"


  		




  69
  70
  
    
    pp_with_node machine.mname


  		




  70
  71
  
    
    (pp_main_procedure_definition machine) (locals, instrs)


  		












Also available in:  Unified diff