Merge pull request #2175 from lpw25/pack-subst-all
Apply substitution to all modules when packingmaster
commit
3d288aef35
2
Changes
2
Changes
|
@ -706,6 +706,8 @@ Working version
|
||||||
- GPR#2131: fix wrong calls to Env.normalize_path on non-module paths
|
- GPR#2131: fix wrong calls to Env.normalize_path on non-module paths
|
||||||
(Alain Frisch, review by Jacques Garrigue)
|
(Alain Frisch, review by Jacques Garrigue)
|
||||||
|
|
||||||
|
- GPR#2175: Apply substitution to all modules when packing
|
||||||
|
(Leo White, review by Gabriel Scherer)
|
||||||
|
|
||||||
OCaml 4.07.1 (4 October 2018)
|
OCaml 4.07.1 (4 October 2018)
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
|
@ -2484,18 +2484,31 @@ let type_interface sourcefile env ast =
|
||||||
(* "Packaging" of several compilation units into one unit
|
(* "Packaging" of several compilation units into one unit
|
||||||
having them as sub-modules. *)
|
having them as sub-modules. *)
|
||||||
|
|
||||||
let rec package_signatures subst = function
|
let package_signatures units =
|
||||||
[] -> []
|
let units_with_ids =
|
||||||
| (name, sg) :: rem ->
|
List.map
|
||||||
let sg' = Subst.signature subst sg in
|
(fun (name, sg) ->
|
||||||
let oldid = Ident.create_persistent name
|
let oldid = Ident.create_persistent name in
|
||||||
and newid = Ident.create_local name in
|
let newid = Ident.create_local name in
|
||||||
Sig_module(newid, Mp_present, {md_type=Mty_signature sg';
|
(oldid, newid, sg))
|
||||||
|
units
|
||||||
|
in
|
||||||
|
let subst =
|
||||||
|
List.fold_left
|
||||||
|
(fun acc (oldid, newid, _) ->
|
||||||
|
Subst.add_module oldid (Pident newid) acc)
|
||||||
|
Subst.identity units_with_ids
|
||||||
|
in
|
||||||
|
List.map
|
||||||
|
(fun (_, newid, sg) ->
|
||||||
|
let sg = Subst.signature subst sg in
|
||||||
|
let md =
|
||||||
|
{ md_type=Mty_signature sg;
|
||||||
md_attributes=[];
|
md_attributes=[];
|
||||||
md_loc=Location.none;
|
md_loc=Location.none; }
|
||||||
},
|
in
|
||||||
Trec_not, Exported) ::
|
Sig_module(newid, Mp_present, md, Trec_not, Exported))
|
||||||
package_signatures (Subst.add_module oldid (Pident newid) subst) rem
|
units_with_ids
|
||||||
|
|
||||||
let package_units initial_env objfiles cmifile modulename =
|
let package_units initial_env objfiles cmifile modulename =
|
||||||
(* Read the signatures of the units *)
|
(* Read the signatures of the units *)
|
||||||
|
@ -2513,7 +2526,7 @@ let package_units initial_env objfiles cmifile modulename =
|
||||||
objfiles in
|
objfiles in
|
||||||
(* Compute signature of packaged unit *)
|
(* Compute signature of packaged unit *)
|
||||||
Ident.reinit();
|
Ident.reinit();
|
||||||
let sg = package_signatures Subst.identity units in
|
let sg = package_signatures units in
|
||||||
(* See if explicit interface is provided *)
|
(* See if explicit interface is provided *)
|
||||||
let prefix = Filename.remove_extension cmifile in
|
let prefix = Filename.remove_extension cmifile in
|
||||||
let mlifile = prefix ^ !Config.interface_suffix in
|
let mlifile = prefix ^ !Config.interface_suffix in
|
||||||
|
|
Loading…
Reference in New Issue