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:
parent
9db97de879
commit
899d33afb6
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue