Project

General

Profile

« Previous | Next » 

Revision 9e5f8085

Added by Guillaume DAVY over 4 years ago

Ada: Add support for arrows as an independent generic package, instantiated in each
package using it. It required a lot of refactoring.

View differences:

src/backends/Ada/ada_backend.ml
25 25 
  let pp_message fmt = fprintf fmt "%s.. %s@." str_indent info in
26 26 
  Log.report ~level:2 pp_message
27 27 

  		




  28
  
  
    
(** Encapsulate a pretty print function to lower case its result when applied


  		




  29
  
  
    
   @param pp the pretty print function


  		




  30
  
  
    
   @param fmt the formatter


  		




  31
  
  
    
   @param arg the argument of the pp function


  		




  32
  
  
    
**)


  		




  33
  
  
    
let pp_lowercase pp fmt arg =


  		




  34
  
  
    
  let str = asprintf "%a" pp arg in


  		




  35
  
  
    
  fprintf fmt "%s" (String. lowercase_ascii str)


  		




  36
  
  
    

  		




  37
  28
  
    
(** Write a new file with formatter


  		




  38
  29
  
    
   @param destname folder where the file shoudl be created


  		




  39
  30
  
    
   @param pp_filename function printing the filename


  		




  ......




  50
  41
  
    
  log_str_level_two 2 (path^" generated")


  		




  51
  42
  
    

  		




  52
  43
  
    

  		




  53
  
  
    
(** Print the filename of a package by lowercasing it and appending


  		




  54
  
  
    
  an extension.


  		




  
  44
  
    
(** Print the filename of a machine package.


  		




  55
  45
  
    
   @param extension the extension to append to the package name


  		




  56
  46
  
    
   @param fmt the formatter


  		




  57
  
  
    
   @param fmt the machine corresponding to the package


  		




  
  47
  
    
   @param machine the machine corresponding to the package


  		




  58
  48
  
    
**)


  		




  59
  49
  
    
let pp_machine_filename extension fmt machine =


  		




  60
  
  
    
  fprintf fmt "%a.%s"


  		




  61
  
  
    
    (pp_lowercase pp_package_name) machine.mname


  		




  62
  
  
    
    extension


  		




  
  50
  
    
  pp_filename extension fmt (function fmt -> pp_package_name fmt machine)


  		




  63
  51
  
    

  		




  64
  52
  
    
(** Exception raised when a machine contains a feature not supported by the


  		




  65
  53
  
    
  Ada backend*)


  		




  ......




  80
  68
  
    
   @param main_machine the machine associated to the main node


  		




  81
  69
  
    
**)


  		




  82
  70
  
    
let pp_project_name fmt main_machine =


  		




  83
  
  
    
  fprintf fmt "%a.gpr" pp_package_name main_machine.mname


  		




  
  71
  
    
  fprintf fmt "%a.gpr" pp_package_name main_machine


  		




  84
  72
  
    

  		




  85
  73
  
    
(** Main function of the Ada backend. It calls all the subfunction creating all


  		




  86
  74
  
    
the file and fill them with Ada code representing the machines list given.


  		




  ......




  112
  100
  
    
  List.iter check machines;


  		




  113
  101
  
    

  		




  114
  102
  
    
  log_str_level_two 1 "Generating ads";


  		




  115
  
  
    
  List.iter (write_file destname (pp_machine_filename "ads") Ads.pp_file) machines;


  		




  
  103
  
    
  List.iter (write_file destname (pp_machine_filename "ads") (Ads.pp_file machines) ) machines;


  		




  116
  104
  
    

  		




  117
  105
  
    
  log_str_level_two 1 "Generating adb";


  		




  118
  106
  
    
  List.iter (write_file destname (pp_machine_filename "adb") Adb.pp_file) machines;


  		




  ......




  121
  109
  
    
  log_str_level_two 1 "Generating wrapper files";


  		




  122
  110
  
    
  match main_machine with


  		




  123
  111
  
    
    | None -> log_str_level_two 2 "File not generated(no -node argument)";


  		




  124
  
  
    
    | Some machine -> begin


  		




  125
  
  
    
        write_file destname pp_project_name Wrapper.pp_project_file machine;


  		




  126
  
  
    
        write_file destname pp_main_filename Wrapper.pp_main_file machine;


  		




  127
  
  
    
      end


  		




  
  112
  
    
    | Some machine ->


  		




  
  113
  
    
begin


  		




  
  114
  
    
  let pp_main_filename fmt _ =


  		




  
  115
  
    
    pp_filename "adb" fmt pp_main_procedure_name in


  		




  
  116
  
    
  write_file destname pp_project_name Wrapper.pp_project_file machine;


  		




  
  117
  
    
  write_file destname pp_main_filename Wrapper.pp_main_adb machine;


  		




  
  118
  
    
end


  		




  128
  119
  
    

  		




  129
  120
  
    

  		




  130
  121
  
    
(* Local Variables: *)


  		












Also available in:  Unified diff