Project

General

Profile

« Previous | Next » 

Revision c85c2e3d

Added by Christophe Garion almost 3 years ago

Ada: pretty printing functions for values and assignments in adb

View differences:

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

  
25
  (* Printing functions for basic operations *)
25
  (* Printing functions for basic operations and expressions *)
26
  (* TODO: refactor code -> use let rec and for basic pretty printing
27
     function *)
28
  (** Printing function for Ada tags, mainly booleans.
29

  
30
      @param fmt the formater to use
31
      @param t the tag to print
32
   **)
33
  let pp_ada_tag fmt t =
34
    pp_print_string fmt
35
      (if t = tag_true then "True" else if t = tag_false then "Flase" else t)
36

  
37
  (** Printing function for machine type constants. For the moment,
38
      arrays are not supported.
39

  
40
      @param fmt the formater to use
41
      @param c the constant to print
42
   **)
43
  let pp_ada_const fmt c =
44
    match c with
45
    | Const_int i                     -> pp_print_int fmt i
46
    | Const_real (c, e, s)            -> pp_print_string fmt s
47
    | Const_tag t                     -> pp_ada_tag fmt t
48
    | Const_string _ | Const_modeid _ ->
49
      (Format.eprintf
50
         "internal error: Ada_backend_adb.pp_ada_const cannot print string or modeid.";
51
       assert false)
52
    | _                               ->
53
      raise (Ada_not_supported "unsupported: Ada_backend_adb.pp_ada_const does not
54
      support this constant")
26 55

  
27 56
  (** Printing function for expressions [v1 modulo v2]. Depends
28 57
      on option [integer_div_euclidean] to choose between mathematical
29 58
      modulo or remainder ([rem] in Ada).
30 59

  
31
      @param pp_val pretty printer for values
60
      @param pp_value pretty printer for values
32 61
      @param v1 the first value in the expression
33 62
      @param v2 the second value in the expression
34 63
      @param fmt the formater to print on
35 64
   **)
36
  let pp_mod pp_val v1 v2 fmt =
65
  let pp_mod pp_value v1 v2 fmt =
37 66
    if !Options.integer_div_euclidean then
38 67
      (* (a rem b) + (a rem b < 0 ? abs(b) : 0) *)
39 68
      Format.fprintf fmt
40 69
        "((%a rem %a) + (if (%a rem %a) < 0 then abs(%a) else 0))"
41
        pp_val v1 pp_val v2
42
        pp_val v1 pp_val v2
43
        pp_val v2
70
        pp_value v1 pp_value v2
71
        pp_value v1 pp_value v2
72
        pp_value v2
44 73
    else (* Ada behavior for rem *)
45
      Format.fprintf fmt "(%a rem %a)" pp_val v1 pp_val v2
74
      Format.fprintf fmt "(%a rem %a)" pp_value v1 pp_value v2
46 75

  
47 76
  (** Printing function for expressions [v1 div v2]. Depends on
48 77
      option [integer_div_euclidean] to choose between mathematic
49 78
      division or Ada division.
50 79

  
51
      @param pp_val pretty printer for values
80
      @param pp_value pretty printer for values
52 81
      @param v1 the first value in the expression
53 82
      @param v2 the second value in the expression
54 83
      @param fmt the formater to print in
55 84
   **)
56
  let pp_div pp_val v1 v2 fmt =
85
  let pp_div pp_value v1 v2 fmt =
57 86
    if !Options.integer_div_euclidean then
58 87
      (* (a - ((a rem b) + (if a rem b < 0 then abs (b) else 0))) / b) *)
59 88
      Format.fprintf fmt "(%a - %t) / %a"
60
        pp_val v1
61
        (pp_mod pp_val v1 v2)
62
        pp_val v2
63
    else (* Ada behovior for / *)
64
      Format.fprintf fmt "(%a / %a)" pp_val v1 pp_val v2
89
        pp_value v1
90
        (pp_mod pp_value v1 v2)
91
        pp_value v2
92
    else (* Ada behavior for / *)
93
      Format.fprintf fmt "(%a / %a)" pp_value v1 pp_value v2
65 94

  
66 95
  (** Printing function for basic lib functions.
67 96

  
68
      @param is_int boolean to choose between integer
69
                    division (resp. remainder) or Ada division
70
                    (resp. remainder)
97
      @param pp_value pretty printer for values
71 98
      @param i a string representing the function
72
      @param pp_val the pretty printer for values
73 99
      @param fmt the formater to print on
74 100
      @param vl the list of operands
75 101
   **)
76
  let pp_basic_lib_fun is_int i pp_val fmt vl =
77
    match i, vl with
78
    | "uminus", [v] -> Format.fprintf fmt "(- %a)" pp_val v
79
    | "not", [v] -> Format.fprintf fmt "(not %a)" pp_val v
80
    | "impl", [v1; v2] -> Format.fprintf fmt "(not %a or else %a)" pp_val v1 pp_val v2
81
    | "=", [v1; v2] -> Format.fprintf fmt "(%a = %a)" pp_val v1 pp_val v2
82
    | "mod", [v1; v2] ->
83
      if is_int then
84
        pp_mod pp_val v1 v2 fmt
85
      else
86
        Format.fprintf fmt "(%a rem %a)" pp_val v1 pp_val v2
87
    | "equi", [v1; v2] -> Format.fprintf fmt "((not %a) = (not %a))" pp_val v1 pp_val v2
88
    | "xor", [v1; v2] -> Format.fprintf fmt "((not %a) \\= (not %a))" pp_val v1 pp_val v2
89
    | "/", [v1; v2] ->
90
      if is_int then
91
        pp_div pp_val v1 v2 fmt
92
      else
93
        Format.fprintf fmt "(%a / %a)" pp_val v1 pp_val v2
94
    | _, [v1; v2] -> Format.fprintf fmt "(%a %s %a)" pp_val v1 i pp_val v2
95
    | _ -> (Format.eprintf "internal compilation error: basic function %s@." i; assert false)
102
  let pp_basic_lib_fun pp_value ident fmt vl =
103
    match ident, vl with
104
    | "uminus", [v]    ->
105
      Format.fprintf fmt "(- %a)" pp_value v
106
    | "not", [v]       ->
107
      Format.fprintf fmt "(not %a)" pp_value v
108
    | "impl", [v1; v2] ->
109
      Format.fprintf fmt "(not %a or else %a)" pp_value v1 pp_value v2
110
    | "=", [v1; v2]    ->
111
      Format.fprintf fmt "(%a = %a)" pp_value v1 pp_value v2
112
    | "mod", [v1; v2]  -> pp_mod pp_value v1 v2 fmt
113
    | "equi", [v1; v2] ->
114
      Format.fprintf fmt "((not %a) = (not %a))" pp_value v1 pp_value v2
115
    | "xor", [v1; v2]  ->
116
      Format.fprintf fmt "((not %a) \\= (not %a))" pp_value v1 pp_value v2
117
    | "/", [v1; v2]    -> pp_div pp_value v1 v2 fmt
118
    | op, [v1; v2]     ->
119
      Format.fprintf fmt "(%a %s %a)" pp_value v1 op pp_value v2
120
    | fun_name, _      ->
121
      (Format.eprintf "internal compilation error: basic function %s@." fun_name; assert false)
122

  
123
  (** Printing function for values.
124

  
125
      @param fmt the formater to use
126
      @param value the value to print. Should be a
127
             {!type:Machine_code_types.value_t} value
128
   **)
129
  let rec pp_value fmt value =
130
    match value.value_desc with
131
    | Cst c             -> pp_ada_const fmt c
132
    | Var var_name      -> pp_var_name fmt var_name
133
    | Fun (f_ident, vl) -> pp_basic_lib_fun pp_value f_ident fmt vl
134
    | _                 ->
135
      raise (Ada_not_supported
136
               "unsupported: Ada_backend.adb.pp_value does not support this value type")
96 137

  
97 138
  (** Printing function for basic assignement [var_name := value;].
98 139

  
99
      @param pp_var pretty printer for variables
100 140
      @param fmt the formater to print on
101 141
      @param var_name the name of the variable
102 142
      @param value the value to be assigned
103 143
   **)
104
  (* TODO remove pp_var *)
105
  let pp_basic_assign pp_var fmt var_name value =
106
    fprintf fmt "%a := %a;"
107
      pp_var var_name
108
      pp_var value
144
  let pp_basic_assign fmt var_name value =
145
    fprintf fmt "%a := %a"
146
      pp_var_name var_name
147
      pp_value value
109 148

  
110 149
  (** Printing function for assignement. For the moment, only use
111 150
      [pp_basic_assign] function.
......
139 178
      try
140 179
        List.assoc instance machine.minstances
141 180
      with Not_found -> (Format.eprintf "internal error: pp_machine_reset %s %s:@." machine.mname.node_id instance; raise Not_found) in
142
    fprintf fmt "%a(state.%s);"
181
    fprintf fmt "%a(state.%s)"
143 182
      pp_machine_reset_name (instance, (node, static))
144 183
      instance
145 184

  
......
156 195
    (* no reset *)
157 196
    | MNoReset _ -> ()
158 197
    (* reset  *)
159
    | MReset i ->
160
      pp_machine_reset machine fmt i
161
    | MLocalAssign (i,v) ->
162
      fprintf fmt "MLocalAssign @"
163
      (* pp_basic_assign pp_var_name fmt i v *)
164
      (* pp_assign
165
       *   machine self (pp_c_var_read m) fmt
166
       *   i.var_type (mk_val (Var i) i.var_type) v *)
198
    | MReset ident ->
199
      pp_machine_reset machine fmt ident
200
    | MLocalAssign (ident, value) ->
201
      pp_basic_assign fmt ident value
167 202
    | MStateAssign (i,v) ->
168 203
      fprintf fmt "MStateAssign"
169 204
    (* pp_assign
src/backends/Ada/ada_backend_common.ml
5 5
open Corelang
6 6
open Machine_code_common
7 7

  
8
(** All the pretty print functions common to the ada backend **)
8
(** Exception for unsupported features in Ada backend **)
9
exception Ada_not_supported of string
9 10

  
11
(** All the pretty print functions common to the ada backend **)
10 12

  
11 13
(* Misc pretty print functions *)
12 14

  

Also available in: Unified diff