Factor "package" loading in first class mod and functors

panglesd · panglesd · commit 75a359e591a0 · 2026-04-07T16:24:58.000+02:00
diff --git a/src/loader/cmi.ml b/src/loader/cmi.ml
@@ -518,17 +518,8 @@ let rec read_type_expr env typ =
       | Tpackage(p, frags, tyl) ->
         let eqs = List.combine frags tyl in
 #endif
-        let open TypeExpr.Package in
-        let path = Env.Path.read_module_type env.ident_env p in
-        let substitutions =
-          List.map
-            (fun (frag,typ) ->
-               let frag = Env.Fragment.read_type frag in
-               let typ = read_type_expr env typ in
-                 (frag, typ))
-            eqs
-        in
-        Package {path; substitutions}
+        let package = read_package env eqs p in
+        Package package
 #if OCAML_VERSION<(4,13,0)
       | Tsubst typ -> read_type_expr env typ
 #else
@@ -545,7 +536,10 @@ let rec read_type_expr env typ =
     in
     let env = {env with ident_env = e'} in
     let ret = read_type_expr env ret_type in
-    let package = read_package env pkg in
+    let eqs =
+      List.filter_map (fun (l,ty) -> Option.map (fun x -> x, ty) (Longident.unflatten l)) pkg.pack_constraints
+    in
+    let package = read_package env eqs pkg.pack_path in
     Arrow_functor(lbl, {id ; package}, ret)
 
 #endif
@@ -556,14 +550,7 @@ let rec read_type_expr env typ =
       | Some name -> Alias(typ, name)
   end
 
-and read_package env pkg =
-  let pack_constraints = pkg.pack_constraints in
-  let p = pkg.pack_path in
-  let eqs =
-    List.filter_map
-      (fun (l,ty) -> Option.map (fun x -> x, ty) (Longident.unflatten l))
-      pack_constraints
-  in
+and read_package env eqs p =
   let open TypeExpr in
   let open TypeExpr.Package in
   let path = Env.Path.read_module_type env.ident_env p in
diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml
@@ -150,17 +150,8 @@ let rec read_core_type env container ctyp =
 #else
     | Ttyp_package {pack_path; pack_fields; _} ->
 #endif
-        let open TypeExpr.Package in
-        let path = Env.Path.read_module_type env.ident_env pack_path in
-        let substitutions =
-          List.map
-            (fun (frag, typ) ->
-               let frag = Env.Fragment.read_type frag.Location.txt in
-               let typ = read_core_type env container typ in
-               (frag, typ))
-            pack_fields
-        in
-          Package {path; substitutions}
+        let pkg = read_package env container pack_path pack_fields in
+        Package pkg
 #if OCAML_VERSION >= (5,2,0)
     | Ttyp_open (_p,_l,t) ->
       (* TODO: adjust model *)
@@ -176,19 +167,11 @@ let rec read_core_type env container ctyp =
     in
       let env = {env with ident_env = e'} in
       let ret = read_core_type env container ret_type in
-      let package = read_package env container pkg in
+      let package = read_package env container pkg.tpt_path pkg.tpt_constraints in
     Arrow_functor(lbl, {id ; package}, ret)
-      (* let ctyp_desc = Ttyp_package pkg in *)
-      (* let pkg = {ctyp with ctyp_desc} in *)
-      (* let ctyp_desc = Ttyp_arrow (lbl, pkg, ret_type) in *)
-      (* let ctyp = {ctyp with ctyp_desc} in *)
-      (* (\* TODO: adjust model *\) *)
-      (* let e' = Env.add_parameter (Identifier.Mk.root (None, ModuleName.of_ident id.txt)) id.txt (ModuleName.of_ident id.txt) env.ident_env in *)
-      (* let env = {env with ident_env = e'} in *)
-      (* read_core_type env container ctyp *)
 #endif
 
-and read_package env container {tpt_path = pack_path; tpt_constraints=pack_fields; _} =
+and read_package env container pack_path pack_fields =
   let open TypeExpr.Package in
   let path = Env.Path.read_module_type env.ident_env pack_path in
   let substitutions =
