Project

General

Profile

Revision 521e2a6b src/backends/C/c_backend_src.ml

View differences:

src/backends/C/c_backend_src.ml
141 141

  
142 142
(* Prints a [value] of type [var_type] indexed by the suffix list [loop_vars] *)
143 143
let rec pp_value_suffix self var_type loop_vars pp_value fmt value =
144
 (*Format.eprintf "pp_value_suffix: %a %a %a@." Types.print_ty var_type Machine_code.pp_val value pp_suffix loop_vars;*)
145
 match loop_vars, value.value_desc with
146
 | (x, LAcc i) :: q, _ when is_const_index i ->
147
   let r = ref (Dimension.size_const_dimension (Machine_code.dimension_of_value i)) in
148
   pp_value_suffix self var_type ((x, LInt r)::q) pp_value fmt value
149
 | (_, LInt r) :: q, Cst (Const_array cl) ->
150
   let var_type = Types.array_element_type var_type in
151
   pp_value_suffix self var_type q pp_value fmt (mk_val (Cst (List.nth cl !r)) Type_predef.type_int)
152
 | (_, LInt r) :: q, Array vl      ->
153
   let var_type = Types.array_element_type var_type in
154
   pp_value_suffix self var_type q pp_value fmt (List.nth vl !r)
155
 | loop_var    :: q, Array vl      ->
156
   let var_type = Types.array_element_type var_type in
157
   Format.fprintf fmt "(%a[]){%a }%a" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix self var_type q pp_value)) vl pp_suffix [loop_var]
158
 | []              , Array vl      ->
159
   let var_type = Types.array_element_type var_type in
160
   Format.fprintf fmt "(%a[]){%a }" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix self var_type [] pp_value)) vl
161
 | _           :: q, Power (v, n)  ->
162
   pp_value_suffix self var_type q pp_value fmt v
163
 | _               , Fun (n, vl)   ->
164
   Basic_library.pp_c n (pp_value_suffix self var_type loop_vars pp_value) fmt vl
165
 | _               , Access (v, i) ->
166
   let var_type = Type_predef.type_array (Dimension.mkdim_var ()) var_type in
167
   pp_value_suffix self var_type ((Dimension.mkdim_var (), LAcc i) :: loop_vars) pp_value fmt v
168
 | _               , LocalVar v    -> Format.fprintf fmt "%a%a" pp_value v pp_suffix loop_vars
169
 | _               , StateVar v    ->
170
    (* array memory vars are represented by an indirection to a local var with the right type,
171
       in order to avoid casting everywhere. *)
172
   if Types.is_array_type v.var_type
173
   then Format.fprintf fmt "%a%a" pp_value v pp_suffix loop_vars
174
   else Format.fprintf fmt "%s->_reg.%a%a" self pp_value v pp_suffix loop_vars
175
 | _               , Cst cst       -> pp_c_const_suffix var_type fmt cst
176
 | _               , _             -> (Format.eprintf "internal error: C_backend_src.pp_value_suffix %a %a %a@." Types.print_ty var_type Machine_code.pp_val value pp_suffix loop_vars; assert false)
177

  
144
  (*Format.eprintf "pp_value_suffix: %a %a %a@." Types.print_ty var_type Machine_code.pp_val value pp_suffix loop_vars;*)
145
  (
146
    match loop_vars, value.value_desc with
147
    | (x, LAcc i) :: q, _ when is_const_index i ->
148
       let r = ref (Dimension.size_const_dimension (Machine_code.dimension_of_value i)) in
149
       pp_value_suffix self var_type ((x, LInt r)::q) pp_value fmt value
150
    | (_, LInt r) :: q, Cst (Const_array cl) ->
151
       let var_type = Types.array_element_type var_type in
152
       pp_value_suffix self var_type q pp_value fmt (mk_val (Cst (List.nth cl !r)) Type_predef.type_int)
153
    | (_, LInt r) :: q, Array vl      ->
154
       let var_type = Types.array_element_type var_type in
155
       pp_value_suffix self var_type q pp_value fmt (List.nth vl !r)
156
    | loop_var    :: q, Array vl      ->
157
       let var_type = Types.array_element_type var_type in
158
       Format.fprintf fmt "(%a[]){%a }%a" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix self var_type q pp_value)) vl pp_suffix [loop_var]
159
    | []              , Array vl      ->
160
       let var_type = Types.array_element_type var_type in
161
       Format.fprintf fmt "(%a[]){%a }" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix self var_type [] pp_value)) vl
162
    | _           :: q, Power (v, n)  ->
163
       pp_value_suffix self var_type q pp_value fmt v
164
    | _               , Fun (n, vl)   ->
165
       Basic_library.pp_c n (pp_value_suffix self var_type loop_vars pp_value) fmt vl
166
    | _               , Access (v, i) ->
167
       let var_type = Type_predef.type_array (Dimension.mkdim_var ()) var_type in
168
       pp_value_suffix self var_type ((Dimension.mkdim_var (), LAcc i) :: loop_vars) pp_value fmt v
169
    | _               , LocalVar v    -> Format.fprintf fmt "%a%a" pp_value v pp_suffix loop_vars
170
    | _               , StateVar v    ->
171
       (* array memory vars are represented by an indirection to a local var with the right type,
172
	  in order to avoid casting everywhere. *)
173
       if Types.is_array_type v.var_type
174
       then Format.fprintf fmt "%a%a" pp_value v pp_suffix loop_vars
175
       else Format.fprintf fmt "%s->_reg.%a%a" self pp_value v pp_suffix loop_vars
176
    | _               , Cst cst       -> pp_c_const_suffix var_type fmt cst
177
    | _               , _             -> (Format.eprintf "internal error: C_backend_src.pp_value_suffix %a %a %a@." Types.print_ty var_type Machine_code.pp_val value pp_suffix loop_vars; assert false)
178
  )
179
   
178 180
(* Subsumes C_backend_common.pp_c_val to cope with aggressive substitution
179 181
   which may yield constant arrays in expressions.
180 182
   Type is needed to correctly print constant arrays.

Also available in: Unified diff