Project

General

Profile

Revision 51768260

View differences:

src/c_backend.ml
130 130
     as it is the case for generics
131 131
*)
132 132
let pp_c_decl_input_var fmt id =
133
  if !Options.ansi && Types.is_array_type id.var_type
133
  if !Options.ansi && Types.is_address_type id.var_type
134 134
  then pp_c_type (sprintf "(*%s)" id.var_id) fmt (Types.array_base_type id.var_type)
135 135
  else pp_c_type id.var_id fmt id.var_type
136 136

  
137 137
(* Declaration of an output variable:
138 138
   - if its type is scalar, then pass its address
139
   - if its type is array/matrix/etc, then declare it as a mere pointer,
139
   - if its type is array/matrix/struct/etc, then declare it as a mere pointer,
140 140
     in order to cope with unknown/parametric array dimensions, 
141 141
     as it is the case for generics
142 142
*)
143 143
let pp_c_decl_output_var fmt id =
144
  if (not !Options.ansi) && Types.is_array_type id.var_type
144
  if (not !Options.ansi) && Types.is_address_type id.var_type
145 145
  then pp_c_type                  id.var_id  fmt id.var_type
146 146
  else pp_c_type (sprintf "(*%s)" id.var_id) fmt (Types.array_base_type id.var_type)
147 147

  
......
175 175
   - moreover, cast arrays variables into their original array type.
176 176
*)
177 177
let pp_c_var_read m fmt id =
178
  if Types.is_array_type id.var_type
178
  if Types.is_address_type id.var_type
179 179
  then
180 180
    fprintf fmt "%s" id.var_id
181 181
  else
......
189 189
     despite its scalar Lustre type)
190 190
*)
191 191
let pp_c_var_write m fmt id =
192
  if Types.is_array_type id.var_type
192
  if Types.is_address_type id.var_type
193 193
  then
194 194
    fprintf fmt "%s" id.var_id
195 195
  else
......
861 861
let print_main_header fmt =
862 862
  fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/include/lustrec/io_frontend.h\"@." Version.prefix
863 863

  
864
let rec pp_c_struct_type_field filename cpt var fmt (label, tdesc) =
865
  fprintf fmt "%a %a" (pp_c_type_decl filename cpt var) tdesc pp_print_string label
864
let rec pp_c_struct_type_field filename cpt fmt (label, tdesc) =
865
  fprintf fmt "%a;" (pp_c_type_decl filename cpt label) tdesc
866 866
and pp_c_type_decl filename cpt var fmt tdecl =
867 867
  match tdecl with
868 868
  | Tydec_any           -> assert false
......
881 881
  | Tydec_struct fl ->
882 882
    begin
883 883
      incr cpt;
884
      fprintf fmt "struct _struct_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:"; " (pp_c_struct_type_field filename cpt var)) fl var
884
      fprintf fmt "struct _struct_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:" " (pp_c_struct_type_field filename cpt)) fl var
885 885
    end
886 886

  
887 887
let print_type_definitions fmt filename =
src/parser_lustre.mly
255 255
| field_list IDENT COL typeconst SCOL
256 256
  { (fun t -> if Hashtbl.mem field_table $2
257 257
              then raise (Corelang.Already_bound_label ($2, t, Location.symbol_rloc ()))
258
              else (Hashtbl.add field_table $2 t; ($2, $4) :: ($1 t))) }
258
              else (Hashtbl.add field_table $2 t; ($1 t) @ [ ($2, $4) ])) }
259 259

  
260 260
eq_list:
261 261
  { [], [], [] }
src/types.ml
216 216
  match ty.tdesc with
217 217
  | (Ttuple ty_list) -> { ty with tdesc = Ttuple (List.map f ty_list) }
218 218
  | _                -> f ty
219

  
220
let rec is_struct_type ty =
221
 match (repr ty).tdesc with
222
 | Tstruct _        -> true
223
 | _                -> false
224

  
219 225
let rec is_array_type ty =
220 226
 match (repr ty).tdesc with
221 227
 | Tarray _         -> true
222
 | Tstatic (_, ty') -> is_array_type ty'
228
 | Tstatic (_, ty') -> is_array_type ty' (* looks strange !? *)
223 229
 | _                -> false
224 230

  
225 231
let array_type_dimension ty =
......
244 250
  | Tstatic (_, ty') -> array_base_type ty'
245 251
  | _                -> ty
246 252

  
253
let is_address_type ty =
254
  is_array_type ty || is_struct_type ty
255

  
247 256
let rec is_generic_type ty =
248 257
 match (dynamic_type ty).tdesc with
249 258
  | Tarray (d, ty') ->
src/typing.ml
187 187
      let def_t = get_type_definition t in
188 188
      unify t1 def_t
189 189
    | Tenum tl, Tenum tl' when tl == tl' -> ()
190
    | Tstruct fl, Tstruct fl' when fl == fl' -> ()
190 191
    | Tstatic (e1, t1'), Tstatic (e2, t2')
191 192
    | Tarray (e1, t1'), Tarray (e2, t2') ->
192 193
      begin

Also available in: Unified diff