Fix a bug in the structure expanser: default values of structure were ignored.

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 (