diff --git a/src/structArrayExpand.ml b/src/structArrayExpand.ml
index 1e97215a3a29a01bc8b6118fc34b97872f8cb26c..6f5d423d4dc2e88b8b6e12bcf1ca8b0d6dd7a1f6 100644
--- a/src/structArrayExpand.ml
+++ b/src/structArrayExpand.ml
@@ -86,46 +86,6 @@ let rec (is_a_basic_type : Eff.type_ -> bool) =
let soi = string_of_int
-(* [expand_var "toto" acc type]
- adds in [acc] all the strings corresponding to the set of atomic variables
- defined by "toto". For instance, if "toto" is of type "s^2" where s is a structure
- with two integer fields f1 and f2, expand var returns :
-
- ["toto_0_f1",int ; "toto_0_f2",int ;"toto_1_f1",int ; "toto_1_f2",int ] @ acc
-
- This function is used to expand left val_exp expressions.
-
-*)
-let (expand_var : string -> Eff.type_ -> (string * Eff.type_) list) =
- fun prefix teff ->
- let rec aux prefix acc teff =
- match teff with
- | Any | Overload ->
- let teff = Polymorphism.get_type () in
- (prefix,teff)::acc
- | Bool_type_eff
- | Int_type_eff
- | Real_type_eff
- | External_type_eff _
- | Enum_type_eff(_) -> (prefix,teff)::acc
- | Array_type_eff(teff_elt,i) ->
- let rec unfold acc cpt =
- if cpt = i then acc else
- let acc = aux (prefix^"_"^(soi cpt)) acc teff_elt in
- unfold acc (cpt+1)
- in
- unfold acc 0
- | Struct_type_eff(l, fl) ->
- List.fold_left
- (fun acc (fn, (teff_elt,opt)) ->
- aux (prefix^"_"^(Ident.to_string fn)) acc teff_elt)
- acc
- fl
- in
- List.rev (aux prefix [] teff)
-
-
-
let (index_list_of_slice_info : Eff.slice_info -> int list) =
fun si ->
let rec aux acc cpt =
@@ -196,13 +156,12 @@ let rec (gen_var_trees :
| Struct_type_eff(_, fl) ->
S (List.map
- (fun (fn, (steff,_)) ->
+ (fun (fn, (steff, _const_opt)) ->
let prefix = prefix^"_"^(Ident.to_string fn) in
- (fn, gen_var_trees make_leave prefix steff)
+ (fn, gen_var_trees make_leave prefix steff )
)
fl)
-
let (expand_left : Eff.local_env -> left -> left list) =
fun nenv left ->
let rec (var_trees_of_left : left -> left var_tree) =
@@ -238,6 +197,8 @@ let (expand_left : Eff.local_env -> left -> left list) =
in
flatten_var_tree vt
+
+
(********************************************************************************)
(** build a new loc that will alias ve, and add its definition in the
@@ -408,17 +369,33 @@ and (expand_val_exp: Eff.local_env -> Eff.id_solver -> acc -> val_exp ->
in
CallByPosEff(Lxm.flagit by_pos_op lxm, OperEff vel), acc
- | CallByNameEff(by_name_op, fl) ->
- let lxm = by_name_op.src in
- let vel,acc = List.fold_left
- (fun (vel,acc) (id,ve) ->
- let ve,acc = expand_val_exp n_env id_solver acc ve in
- ve::vel, acc
- )
- ([],acc)
- fl
- in
- CallByPosEff({ src = lxm ; it = TUPLE }, OperEff (List.rev vel)), acc
+ | CallByNameEff(by_name_op, fl_val) ->
+ (* we want to print fields in the order of the type.
+ Moreover, we have to deal with default value.
+ *)
+ let teff = EvalType.val_exp_eff ve in
+
+ match teff with
+ | [Struct_type_eff(_,fl)] ->
+ let lxm = by_name_op.src in
+ let vel,acc =
+ List.fold_left
+ (fun (vel,acc) (id,(_,const_opt)) ->
+ try
+ let _,ve = List.find (fun (id2,_) -> id2.it = id) fl_val in
+ let ve,acc = expand_val_exp n_env id_solver acc ve in
+ ve::vel, acc
+ with Not_found ->
+ match const_opt with
+ | None -> assert false (* ougth to have been checked before *)
+ | Some const ->
+ (Eff.const_to_val_eff lxm const)::vel,acc
+ )
+ ([],acc)
+ fl
+ in
+ CallByPosEff({ src = lxm ; it = TUPLE }, OperEff (List.rev vel)), acc
+ | _ -> assert false
and (expand_val_exp_flag: Eff.local_env -> Eff.id_solver -> acc ->
val_exp srcflagged -> val_exp srcflagged * acc) =
@@ -440,7 +417,7 @@ and (expand_var_info: Eff.local_env -> Eff.id_solver -> var_info list * acc ->
| Any | Overload -> aux (Polymorphism.get_type ())
| Struct_type_eff (name, fl) ->
List.fold_left
- (fun (vil,acc) (fn, (ft,_)) ->
+ (fun (vil,acc) (fn, (ft,_const_opt)) ->
let new_var = clone_var nenv vi ("_" ^ Ident.to_string fn) ft in
let new_vil, new_acc = expand_var_info nenv id_solver (vil,acc) new_var in
if new_vil = new_var::vil then (