Project

General

Profile

Revision fd834769 src/backends/Ada/ada_backend_adb.ml

View differences:

src/backends/Ada/ada_backend_adb.ml
22 22 
struct
23 23 

  		




  24
  24
  
    
let pp_machine_instr machine fmt instr =


  		




  25
  
  
    
    fprintf fmt "instruction"


  		




  26
  
  
    

  		




  
  25
  
    
    fprintf fmt "NULL"


  		




  27
  26
  
    

  		




  28
  27
  
    
(** Keep only the MReset from an instruction list.


  		




  29
  28
  
    
  @param list to filter


  		




  ......




  32
  31
  
    
  (fun i -> match get_instr_desc i with MReset i -> i | _ -> assert false)


  		




  33
  32
  
    
  instr_list


  		




  34
  33
  
    

  		




  35
  
  
    
(** Print the definition of a procedure


  		




  36
  
  
    
   @param fmt the formater to print on


  		




  37
  
  
    
   @param m the machine


  		




  38
  
  
    
   @param pp_procedure_name the procedure name printer


  		




  39
  
  
    
   @param pp_prototype the prototype printer


  		




  40
  
  
    
   @param instrs the instructions of the procedure


  		




  41
  
  
    
**)


  		




  42
  
  
    
let pp_procedure_definition fmt (m, pp_procedure_name, pp_prototype, instrs) =


  		




  43
  
  
    
  let pp_instr = pp_machine_instr m in


  		




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


  		




  45
  
  
    
    pp_prototype m


  		




  46
  
  
    
    (Utils.fprintf_list ~sep:";@," pp_instr) instrs


  		




  47
  
  
    
    (Utils.pp_final_char_if_non_empty ";" instrs)


  		




  48
  
  
    
    pp_procedure_name


  		




  49
  
  
    

  		




  50
  34
  
    
(** Print the definition of the init procedure from a machine.


  		




  51
  35
  
    
   @param fmt the formater to print on


  		




  52
  36
  
    
   @param machine the machine


  		




  53
  37
  
    
**)


  		




  54
  
  
    
let pp_init_definition fmt m =


  		




  55
  
  
    
  pp_procedure_definition fmt


  		




  56
  
  
    
    (m, pp_init_procedure_name, pp_init_prototype, m.minit)


  		




  
  38
  
    
let pp_init_definition fmt m = pp_procedure_definition


  		




  
  39
  
    
      pp_init_procedure_name


  		




  
  40
  
    
      (pp_init_prototype m)


  		




  
  41
  
    
      pp_var_decl


  		




  
  42
  
    
      (pp_machine_instr m)


  		




  
  43
  
    
      fmt


  		




  
  44
  
    
      ([], m.minit)


  		




  57
  45
  
    

  		




  58
  46
  
    
(** Print the definition of the step procedure from a machine.


  		




  59
  47
  
    
   @param fmt the formater to print on


  		




  60
  48
  
    
   @param machine the machine


  		




  61
  49
  
    
**)


  		




  62
  
  
    
let pp_step_definition fmt m =


  		




  63
  
  
    
  pp_procedure_definition fmt


  		




  64
  
  
    
    (m, pp_step_procedure_name, pp_step_prototype, m.minit)


  		




  
  50
  
    
let pp_step_definition fmt m = pp_procedure_definition


  		




  
  51
  
    
      pp_step_procedure_name


  		




  
  52
  
    
      (pp_step_prototype m)


  		




  
  53
  
    
      pp_var_decl


  		




  
  54
  
    
      (pp_machine_instr m)


  		




  
  55
  
    
      fmt


  		




  
  56
  
    
      ([], m.minit)


  		




  65
  57
  
    

  		




  66
  58
  
    
(** Print the definition of the reset procedure from a machine.


  		




  67
  59
  
    
   @param fmt the formater to print on


  		




  68
  60
  
    
   @param machine the machine


  		




  69
  61
  
    
**)


  		




  70
  
  
    
let pp_reset_definition fmt m =


  		




  71
  
  
    
  pp_procedure_definition fmt


  		




  72
  
  
    
    (m, pp_reset_procedure_name, pp_reset_prototype, filter_reset m.minit)


  		




  
  62
  
    
let pp_reset_definition fmt m = pp_procedure_definition


  		




  
  63
  
    
      pp_reset_procedure_name


  		




  
  64
  
    
      (pp_reset_prototype m)


  		




  
  65
  
    
      pp_var_decl


  		




  
  66
  
    
      (pp_machine_instr m)


  		




  
  67
  
    
      fmt


  		




  
  68
  
    
      ([], m.minit)


  		




  73
  69
  
    

  		




  74
  70
  
    
(** Print the definition of the clear procedure from a machine.


  		




  75
  71
  
    
   @param fmt the formater to print on


  		




  76
  72
  
    
   @param machine the machine


  		




  77
  73
  
    
**)


  		




  78
  
  
    
let pp_clear_definition fmt m =


  		




  79
  
  
    
  pp_procedure_definition fmt


  		




  80
  
  
    
    (m, pp_clear_procedure_name, pp_clear_prototype, filter_reset m.minit)


  		




  
  74
  
    
let pp_clear_definition fmt m = pp_procedure_definition


  		




  
  75
  
    
      pp_clear_procedure_name


  		




  
  76
  
    
      (pp_clear_prototype m)


  		




  
  77
  
    
      pp_var_decl


  		




  
  78
  
    
      (pp_machine_instr m)


  		




  
  79
  
    
      fmt


  		




  
  80
  
    
      ([], filter_reset m.minit)


  		




  81
  81
  
    

  		




  82
  82
  
    
(** Print the package definition(adb) of a machine.


  		




  83
  83
  
    
   @param fmt the formater to print on


  		




  84
  84
  
    
   @param machine the machine


  		




  85
  85
  
    
**)


  		




  86
  
  
    
let print fmt machine =


  		




  
  86
  
    
let pp_file fmt machine =


  		




  87
  87
  
    
  fprintf fmt "%a@,  @[<v>@,%a;@,@,%a;@,@,%a;@,@,%a;@,@]@,%a;@."


  		




  88
  88
  
    
    (pp_begin_package true) machine (*Begin the package*)


  		




  89
  89
  
    
    pp_init_definition machine (*Define the init procedure*)


  		












Also available in:  Unified diff