Project

General

Profile

Revision 080a6d0b src/backends/C/c_backend_src.ml

View differences:

src/backends/C/c_backend_src.ml
44 44
 | Access (v, i) -> max 0 (expansion_depth v - 1)
45 45
 | Power (v, n)  -> 0 (*1 + expansion_depth v*)
46 46

  
47
type loop_index = LVar of ident | LInt of int ref
48

  
47
let rec merge_static_loop_profiles lp1 lp2 =
48
  match lp1, lp2 with
49
  | []      , _        -> lp2
50
  | _       , []       -> lp1
51
  | p1 :: q1, p2 :: q2 -> (p1 || p2) :: merge_static_loop_profiles q1 q2
52

  
53
(* Returns a list of bool values, indicating whether the indices must be static or not *)
54
let rec static_loop_profile v =
55
 match v with
56
 | Cst (Const_array cl) ->
57
   List.fold_right (fun c lp -> merge_static_loop_profiles lp (static_loop_profile (Cst c))) cl []
58
 | Cst _
59
 | LocalVar _
60
 | StateVar _  -> []
61
 | Fun (_, vl) -> List.fold_right (fun v lp -> merge_static_loop_profiles lp (static_loop_profile v)) vl []
62
 | Array vl    -> true :: List.fold_right (fun v lp -> merge_static_loop_profiles lp (static_loop_profile v)) vl []
63
 | Access (v, i) -> (match (static_loop_profile v) with [] -> [] | _ :: q -> q)
64
 | Power (v, n)  -> false :: static_loop_profile v
65

  
66
let rec is_const_index v =
67
  match v with
68
  | Cst (Const_int _) -> true
69
  | Fun (_, vl)       -> List.for_all is_const_index vl
70
  | _                 -> false
71

  
72
type loop_index = LVar of ident | LInt of int ref | LAcc of value_t
73
(*
74
let rec value_offsets v offsets =
75
 match v, offsets with
76
 | _                        , []          -> v
77
 | Power (v, n)             , _ :: q      -> value_offsets v q
78
 | Array vl                 , LInt r :: q -> value_offsets (List.nth vl !r) q
79
 | Cst (Const_array cl)     , LInt r :: q -> value_offsets (Cst (List.nth cl !r)) q
80
 | Fun (f, vl)              , _           -> Fun (f, List.map (fun v -> value_offsets v offsets) vl)
81
 | _                        , LInt r :: q -> value_offsets (Access (v, Cst (Const_int !r))) q
82
 | _                        , LVar i :: q -> value_offsets (Access (v, LocalVar i)) q
83
*)
49 84
(* Computes the list of nested loop variables together with their dimension bounds.
50 85
   - LInt r stands for loop expansion (no loop variable, but int loop index)
51 86
   - LVar v stands for loop variable v
......
72 107
 match snd lv with
73 108
 | LVar v -> fprintf fmt "[%s]" v
74 109
 | LInt r -> fprintf fmt "[%d]" !r
110
 | LAcc i -> fprintf fmt "[%a]" pp_val i
75 111

  
76 112
(* Prints a suffix of loop variables for arrays *)
77 113
let pp_suffix fmt loop_vars =
......
80 116
(* Prints a [value] indexed by the suffix list [loop_vars] *)
81 117
let rec pp_value_suffix self loop_vars pp_value fmt value =
82 118
 match loop_vars, value with
83
 | (_, LInt r) :: q, Array vl     ->
119
 | (_, LInt r) :: q, Array vl      ->
84 120
   pp_value_suffix self q pp_value fmt (List.nth vl !r)
85
 | _           :: q, Power (v, n) ->
86
   pp_value_suffix self loop_vars pp_value fmt v
87
 | _               , Fun (n, vl)  ->
121
 | _           :: q, Power (v, n)  ->
122
   pp_value_suffix self q pp_value fmt v
123
 | _               , Fun (n, vl)   ->
88 124
   Basic_library.pp_c n (pp_value_suffix self loop_vars pp_value) fmt vl
89
 | _               , _            ->
125
 | _               , Access (v, i) ->
126
   pp_value_suffix self ((Dimension.mkdim_var (), LAcc i) :: loop_vars) pp_value fmt v
127
 | _               , _             ->
90 128
   let pp_var_suffix fmt v = fprintf fmt "%a%a" pp_value v pp_suffix loop_vars in
91 129
   pp_c_val self pp_var_suffix fmt value
92 130

  
......
96 134
   - [value]: assigned value
97 135
   - [pp_var]: printer for variables
98 136
*)
137
(*
138
let pp_assign_rec pp_var var_type var_name value =
139
  match (Types.repr var_type).Types.tdesc, value with
140
  | Types.Tarray (d, ty'), Array vl     ->
141
    let szl = Utils.enumerate (Dimension.size_const_dimension d) in
142
    fprintf fmt "@[<v 2>{@,%a@]@,}"
143
      (Utils.fprintf_list ~sep:"@," (fun fmt i -> r := i; aux fmt q)) szl
144
  | Types.Tarray (d, ty'), Power (v, _) -> 
145
  | Types.Tarray (d, ty'), _            ->
146
  | _                    , _            ->
147
    fprintf fmt "%a = %a;" 
148
      pp_var var_name
149
      (pp_value_suffix self loop_vars pp_var) value
150
*)
99 151
let pp_assign m self pp_var fmt var_type var_name value =
100 152
  let depth = expansion_depth value in
101 153
(*eprintf "pp_assign %a %a %d@." Types.print_ty var_type pp_val value depth;*)
......
117 169
      let szl = Utils.enumerate (Dimension.size_const_dimension d) in
118 170
      fprintf fmt "@[<v 2>{@,%a@]@,}"
119 171
	(Utils.fprintf_list ~sep:"@," (fun fmt i -> r := i; aux fmt q)) szl
172
    | _ -> assert false
120 173
  in
121 174
  begin
122 175
    reset_loop_counter ();

Also available in: Unified diff