Corrected a bug in generation of C records.

Corrected a somewhat unnoticeable but ugly bug in the generation of C
records, that could mess up the field names when they were not
assigned in the same order as in the declaration of the type.
This commit is contained in:
Nicolas Berthier 2013-03-15 09:31:19 +01:00
parent 9db97de879
commit 899d33afb6

View file

@ -27,7 +27,6 @@
(* *) (* *)
(***********************************************************************) (***********************************************************************)
open Format
open List open List
open Misc open Misc
open Names open Names
@ -77,7 +76,7 @@ struct
raise Errors.Error raise Errors.Error
end end
let rec struct_name ty = let struct_name ty =
match ty with match ty with
| Cty_id n -> n | Cty_id n -> n
| _ -> assert false | _ -> assert false
@ -254,11 +253,11 @@ let rec cexpr_of_static_exp se =
| Srecord fl -> | Srecord fl ->
let ty_name = let ty_name =
match Modules.unalias_type se.se_ty with match Modules.unalias_type se.se_ty with
| Types.Tid n -> cname_of_qn n | Types.Tid n -> n
| _ -> assert false | _ -> assert false
in in
Cstructlit (ty_name, let cexps_assoc = List.rev_map (fun (f, e) -> f, cexpr_of_static_exp e) fl in
List.map (fun (_, se) -> cexpr_of_static_exp se) fl) cexpr_of_struct ty_name cexps_assoc
| Sarray_power(c,n_list) -> | Sarray_power(c,n_list) ->
(List.fold_left (fun cc n -> Carraylit (repeat_list cc (int_of_static_exp n))) (List.fold_left (fun cc n -> Carraylit (repeat_list cc (int_of_static_exp n)))
(cexpr_of_static_exp c) n_list) (cexpr_of_static_exp c) n_list)
@ -274,21 +273,27 @@ let rec cexpr_of_static_exp se =
cexpr_of_static_exp se' cexpr_of_static_exp se'
| Stuple _ -> Misc.internal_error "cgen: static tuple" | Stuple _ -> Misc.internal_error "cgen: static tuple"
(** [cexpr_of_exp exp] translates the Obj action [exp] to a C expression. *) (** [cexpr_of_exp exp] translates the Obj action [exp] to a C expression. *)
let rec cexpr_of_exp out_env var_env exp = and cexpr_of_exp out_env var_env exp =
match exp.e_desc with match exp.e_desc with
| Eextvalue w -> cexpr_of_ext_value out_env var_env w | Eextvalue w -> cexpr_of_ext_value out_env var_env w
(** Operators *) (** Operators *)
| Eop(op, exps) -> cop_of_op out_env var_env op exps | Eop(op, exps) -> cop_of_op out_env var_env op exps
(** Structure literals. *) (** Structure literals. *)
| Estruct (tyn, fl) -> | Estruct (tyn, fl) ->
let cexps = List.map (fun (_,e) -> cexpr_of_exp out_env var_env e) fl in let cexpr = cexpr_of_exp out_env var_env in
let ctyn = cname_of_qn tyn in let cexps_assoc = List.rev_map (fun (f, e) -> f, cexpr e) fl in
Cstructlit (ctyn, cexps) cexpr_of_struct tyn cexps_assoc
| Earray e_list -> | Earray e_list ->
Carraylit (cexprs_of_exps out_env var_env e_list) Carraylit (cexprs_of_exps out_env var_env e_list)
and cexpr_of_struct tyn cexps_assoc =
let cexps = List.fold_left
(fun cexps { Signature.f_name = f } -> List.assoc f cexps_assoc :: cexps)
[] (find_struct tyn) in
(* Reverse `cexps' here because of the previous use of `List.fold_left'. *)
Cstructlit (cname_of_qn tyn, List.rev cexps)
and cexprs_of_exps out_env var_env exps = and cexprs_of_exps out_env var_env exps =
List.map (cexpr_of_exp out_env var_env) exps List.map (cexpr_of_exp out_env var_env) exps