Merge first class modules: svn merge -r 9369:9396 $caml/branches/fstclassmod.

Adapt the Changes file. Bump magic numbers. Bootstrap.



git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9397 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

18 files changed, 163 insertions, 24 deletions

diff --git a/typing/btype.ml b/typing/btype.ml
index 77960afb64..13c7998178 100644
--- a/typing/btype.ml
+++ b/typing/btype.ml
@@ -195,6 +195,7 @@ let iter_type_expr f ty =
   | Tsubst ty           -> f ty
   | Tunivar             -> ()
   | Tpoly (ty, tyl)     -> f ty; List.iter f tyl
+  | Tpackage (_, _, l)  -> List.iter f l
 
 let rec iter_abbrev f = function
     Mnil                   -> ()
@@ -256,7 +257,7 @@ let rec copy_type_desc f = function
   | Tpoly (ty, tyl)     ->
       let tyl = List.map (fun x -> norm_univar (f x)) tyl in
       Tpoly (f ty, tyl)
-
+  | Tpackage (p, n, l)  -> Tpackage (p, n, List.map f l)
 
 (* Utilities for copying *)
 
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 3647f89edc..441b777af1 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -616,6 +616,8 @@ let rec update_level env level ty =
           (* +++ Levels should be restored... *)
           raise (Unify [(ty, newvar2 level)])
         end
+    | Tpackage (p, _, _) when level < Path.binding_time p ->
+        raise (Unify [(ty, newvar2 level)])
     | Tobject(_, ({contents=Some(p, tl)} as nm))
       when level < Path.binding_time p ->
         set_name nm None;
@@ -657,6 +659,8 @@ let rec generalize_expansive env var_level ty =
               if ct then update_level env var_level t
               else generalize_expansive env var_level t)
             variance tyl
+      | Tpackage (_, _, tyl) ->
+          List.iter (update_level env var_level) tyl
       | Tarrow (_, t1, t2, _) ->
           update_level env var_level t1;
           generalize_expansive env var_level t2
@@ -953,7 +957,7 @@ let rec copy_sep fixed free bound visited ty =
     let t = newvar() in          (* Stub *)
     let visited =
       match ty.desc with
-        Tarrow _ | Ttuple _ | Tvariant _ | Tconstr _ | Tobject _ ->
+        Tarrow _ | Ttuple _ | Tvariant _ | Tconstr _ | Tobject _ | Tpackage _ ->
           (ty,(t,bound)) :: visited
       | _ -> visited in
     let copy_rec = copy_sep fixed free bound visited in
@@ -1653,6 +1657,8 @@ and unify3 env t1 t1' t2 t2' =
         unify env t1 t2
     | (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
         enter_poly env univar_pairs t1 tl1 t2 tl2 (unify env)
+    | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) when Path.same p1 p2 && n1 = n2 ->
+        unify_list env tl1 tl2
     | (_, _) ->
         raise (Unify [])
     end;
@@ -2053,6 +2059,8 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
           | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
                 when Path.same p1 p2 ->
               moregen_list inst_nongen type_pairs env tl1 tl2
+          | Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2) when Path.same p1 p2 && n1 = n2 ->
+              moregen_list inst_nongen type_pairs env tl1 tl2
           | (Tvariant row1, Tvariant row2) ->
               moregen_row inst_nongen type_pairs env row1 row2
           | (Tobject (fi1, nm1), Tobject (fi2, nm2)) ->
@@ -2312,6 +2320,8 @@ let rec eqtype rename type_pairs subst env t1 t2 =
           | (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
                 when Path.same p1 p2 ->
               eqtype_list rename type_pairs subst env tl1 tl2
+          | Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2) when Path.same p1 p2 && n1 = n2 ->
+              eqtype_list rename type_pairs subst env tl1 tl2
           | (Tvariant row1, Tvariant row2) ->
               eqtype_row rename type_pairs subst env row1 row2
           | (Tobject (fi1, nm1), Tobject (fi2, nm2)) ->
@@ -2918,7 +2928,7 @@ let rec build_subtype env visited loops posi level t =
       let (t1', c) = build_subtype env visited loops posi level t1 in
       if c > Unchanged then (newty (Tpoly(t1', tl)), c)
       else (t, Unchanged)
-  | Tunivar ->
+  | Tunivar | Tpackage _ ->
       (t, Unchanged)
 
 let enlarge_type env ty =
diff --git a/typing/oprint.ml b/typing/oprint.ml
index e1c617ef1d..2344436b91 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -209,6 +209,16 @@ and print_simple_out_type ppf =
   | Otyp_alias _ | Otyp_poly _ | Otyp_arrow _ | Otyp_tuple _ as ty ->
       fprintf ppf "@[<1>(%a)@]" print_out_type ty
   | Otyp_abstract | Otyp_sum _ | Otyp_record _ | Otyp_manifest (_, _) -> ()
+  | Otyp_module (p, n, tyl) ->
+      fprintf ppf "@[<1>(module %s" p;
+      let first = ref true in
+      List.iter2
+        (fun s t ->
+          let sep = if !first then (first := false; "with") else "and" in
+          fprintf ppf " %s type %s = %a" sep s print_out_type t
+        )
+        n tyl;
+      fprintf ppf ")@]"
 and print_fields rest ppf =
   function
     [] ->
diff --git a/typing/outcometree.mli b/typing/outcometree.mli
index 852a9ee15a..80c28ea085 100644
--- a/typing/outcometree.mli
+++ b/typing/outcometree.mli
@@ -60,6 +60,8 @@ type out_type =
   | Otyp_variant of
       bool * out_variant * bool * (string list) option
   | Otyp_poly of string list * out_type
+  | Otyp_module of string * string list * out_type list
+
 and out_variant =
   | Ovar_fields of (string * bool * out_type list) list
   | Ovar_name of out_ident * out_type list
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 48465c23ae..2134afb568 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -153,6 +153,9 @@ and raw_type_desc ppf = function
           match row.row_name with None -> fprintf ppf "None"
           | Some(p,tl) ->
               fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
+  | Tpackage (p, _, tl) ->
+      fprintf ppf "@[<hov1>Tpackage(@,%a@,%a)@]" path p
+        raw_type_list tl
 
 and raw_field ppf = function
     Rpresent None -> fprintf ppf "Rpresent None"
@@ -234,7 +237,7 @@ let rec mark_loops_rec visited ty =
     | Tarrow(_, ty1, ty2, _) ->
         mark_loops_rec visited ty1; mark_loops_rec visited ty2
     | Ttuple tyl -> List.iter (mark_loops_rec visited) tyl
-    | Tconstr(_, tyl, _) ->
+    | Tconstr(_, tyl, _) | Tpackage (_, _, tyl) ->
         List.iter (mark_loops_rec visited) tyl
     | Tvariant row ->
         if List.memq px !visited_objects then add_alias px else
@@ -383,6 +386,8 @@ let rec tree_of_typexp sch ty =
         end
     | Tunivar ->
         Otyp_var (false, name_of_type ty)
+    | Tpackage (p, n, tyl) ->
+        Otyp_module (Path.name p, n, tree_of_typlist sch tyl)
   in
   if List.memq px !delayed then delayed := List.filter ((!=) px) !delayed;
   if is_aliased px && aliasable ty then begin
diff --git a/typing/subst.ml b/typing/subst.ml
index 833b3634aa..e31ac16c5a 100644
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -45,6 +45,18 @@ let rec module_path s = function
   | Papply(p1, p2) ->
       Papply(module_path s p1, module_path s p2)
 
+let rec modtype_path s = function
+    Pident id as p ->
+      begin try
+        match Tbl.find id s.modtypes with
+          | Tmty_ident p -> p
+          | _ -> fatal_error "Subst.modtype_path"
+      with Not_found -> p end
+  | Pdot(p, n, pos) ->
+      Pdot(module_path s p, n, pos)
+  | Papply(p1, p2) ->
+      fatal_error "Subst.modtype_path"
+
 let type_path s = function
     Pident id as p ->
       begin try Tbl.find id s.types with Not_found -> p end
@@ -88,6 +100,8 @@ let rec typexp s ty =
       begin match desc with
       | Tconstr(p, tl, abbrev) ->
           Tconstr(type_path s p, List.map (typexp s) tl, ref Mnil)
+      | Tpackage(p, n, tl) ->
+          Tpackage(modtype_path s p, n, List.map (typexp s) tl)
       | Tobject (t1, name) ->
           Tobject (typexp s t1,
                  ref (match !name with
diff --git a/typing/typecore.ml b/typing/typecore.ml
index ab7eb596fa..750c4e807c 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -966,6 +966,13 @@ let generalizable level ty =
 (* Hack to allow coercion of self. Will clean-up later. *)
 let self_coercion = ref ([] : (Path.t * Location.t list ref) list)
 
+(* Helpers for packaged modules. *)
+let create_package_type loc env (p, l) =
+  let s = !Typetexp.transl_modtype_longident loc env p in
+  newty (Tpackage (s,
+                   List.map fst l,
+                   List.map (Typetexp.transl_simple_type env false) (List.map snd l)))
+
 (* Typing of expressions *)
 
 let unify_exp env exp expected_ty =
@@ -1650,6 +1657,18 @@ let rec type_exp env sexp =
          any new extra node in the typed AST. *)
       re { body with exp_loc = sexp.pexp_loc; exp_type = ety }
 
+  | Pexp_pack (m, (p, l)) ->
+      let loc = sexp.pexp_loc in
+      let l, mty = Typetexp.create_package_mty loc env (p, l) in
+      let m = {pmod_desc = Pmod_constraint (m, mty); pmod_loc = loc} in
+      let context = Typetexp.narrow () in
+      let modl = !type_module env m in
+      Typetexp.widen context;
+      re {
+        exp_desc = Texp_pack modl;
+        exp_loc = loc;
+        exp_type = create_package_type loc env (p, l);
+        exp_env = env }
 
 and type_argument env sarg ty_expected' =
   (* ty_expected' may be generic *)
diff --git a/typing/typecore.mli b/typing/typecore.mli
index d4cfb85671..c6c12f5736 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -113,3 +113,5 @@ val type_module: (Env.t -> Parsetree.module_expr -> Typedtree.module_expr) ref
 val type_object:
   (Env.t -> Location.t -> Parsetree.class_structure ->
    Typedtree.class_structure * class_signature * string list) ref
+
+val create_package_type: Location.t -> Env.t -> Parsetree.package_type -> type_expr
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index f8635162ee..016a2a2263 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -456,6 +456,8 @@ let compute_variance env tvl nega posi cntr ty =
       | Tpoly (ty, _) ->
           compute_same ty
       | Tvar | Tnil | Tlink _ | Tunivar -> ()
+      | Tpackage (_, _, tyl) ->
+          List.iter (compute_variance_rec true true true) tyl
     end
   in
   compute_variance_rec nega posi cntr ty;
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 486eea346d..e2b7e285e9 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -79,6 +79,7 @@ and expression_desc =
   | Texp_assertfalse
   | Texp_lazy of expression
   | Texp_object of class_structure * class_signature * string list
+  | Texp_pack of module_expr
 
 and meth =
     Tmeth_name of string
@@ -127,6 +128,7 @@ and module_expr_desc =
   | Tmod_functor of Ident.t * module_type * module_expr
   | Tmod_apply of module_expr * module_expr * module_coercion
   | Tmod_constraint of module_expr * module_type * module_coercion
+  | Tmod_unpack of expression * module_type
 
 and structure = structure_item list
 
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index a8700b469d..a7ea525d98 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -78,6 +78,7 @@ and expression_desc =
   | Texp_assertfalse
   | Texp_lazy of expression
   | Texp_object of class_structure * class_signature * string list
+  | Texp_pack of module_expr
 
 and meth =
     Tmeth_name of string
@@ -129,6 +130,7 @@ and module_expr_desc =
   | Tmod_functor of Ident.t * module_type * module_expr
   | Tmod_apply of module_expr * module_expr * module_coercion
   | Tmod_constraint of module_expr * module_type * module_coercion
+  | Tmod_unpack of expression * module_type
 
 and structure = structure_item list
 
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 21e4f2a024..b9b93a9e2e 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -39,6 +39,7 @@ type error =
   | Non_generalizable_module of module_type
   | Implementation_is_required of string
   | Interface_not_compiled of string
+  | Not_allowed_in_functor_body
 
 exception Error of Location.t * error
 
@@ -265,15 +266,17 @@ let check_sig_item type_names module_names modtype_names loc = function
 
 (* Check and translate a module type expression *)
 
+let transl_modtype_longident loc env lid =
+  try
+    let (path, info) = Env.lookup_modtype lid env in
+    path
+  with Not_found ->
+    raise(Error(loc, Unbound_modtype lid))
+
 let rec transl_modtype env smty =
   match smty.pmty_desc with
     Pmty_ident lid ->
-      begin try
-        let (path, info) = Env.lookup_modtype lid env in
-        Tmty_ident path
-      with Not_found ->
-        raise(Error(smty.pmty_loc, Unbound_modtype lid))
-      end
+      Tmty_ident (transl_modtype_longident smty.pmty_loc env lid)
   | Pmty_signature ssg ->
       Tmty_signature(transl_signature env ssg)
   | Pmty_functor(param, sarg, sres) ->
@@ -573,7 +576,7 @@ let check_recmodule_inclusion env bindings =
 
 (* Type a module value expression *)
 
-let rec type_module anchor env smod =
+let rec type_module funct_body anchor env smod =
   match smod.pmod_desc with
     Pmod_ident lid ->
       let (path, mty) = type_module_path env smod.pmod_loc lid in
@@ -582,7 +585,7 @@ let rec type_module anchor env smod =
            mod_env = env;
            mod_loc = smod.pmod_loc }
   | Pmod_structure sstr ->
-      let (str, sg, finalenv) = type_structure anchor env sstr smod.pmod_loc in
+      let (str, sg, finalenv) = type_structure funct_body anchor env sstr smod.pmod_loc in
       rm { mod_desc = Tmod_structure str;
            mod_type = Tmty_signature sg;
            mod_env = env;
@@ -590,14 +593,14 @@ let rec type_module anchor env smod =
   | Pmod_functor(name, smty, sbody) ->
       let mty = transl_modtype env smty in
       let (id, newenv) = Env.enter_module name mty env in
-      let body = type_module None newenv sbody in
+      let body = type_module true None newenv sbody in
       rm { mod_desc = Tmod_functor(id, mty, body);
            mod_type = Tmty_functor(id, mty, body.mod_type);
            mod_env = env;
            mod_loc = smod.pmod_loc }
   | Pmod_apply(sfunct, sarg) ->
-      let funct = type_module None env sfunct in
-      let arg = type_module None env sarg in
+      let funct = type_module funct_body None env sfunct in
+      let arg = type_module funct_body None env sarg in
       begin match Mtype.scrape env funct.mod_type with
         Tmty_functor(param, mty_param, mty_res) as mty_functor ->
           let coercion =
@@ -625,7 +628,7 @@ let rec type_module anchor env smod =
           raise(Error(sfunct.pmod_loc, Cannot_apply funct.mod_type))
       end
   | Pmod_constraint(sarg, smty) ->
-      let arg = type_module anchor env sarg in
+      let arg = type_module funct_body anchor env sarg in
       let mty = transl_modtype env smty in
       let coercion =
         try
@@ -637,7 +640,17 @@ let rec type_module anchor env smod =
            mod_env = env;
            mod_loc = smod.pmod_loc }
 
-and type_structure anchor env sstr scope =
+  | Pmod_unpack (sexp, (p, l)) ->
+      if funct_body then raise (Error (smod.pmod_loc, Not_allowed_in_functor_body));
+      let l, mty = Typetexp.create_package_mty smod.pmod_loc env (p, l) in
+      let mty = transl_modtype env mty in
+      let exp = Typecore.type_expect env sexp (Typecore.create_package_type smod.pmod_loc env (p, l)) in
+      rm { mod_desc = Tmod_unpack(exp, mty);
+           mod_type = mty;
+           mod_env = env;
+           mod_loc = smod.pmod_loc }
+
+and type_structure funct_body anchor env sstr scope =
   let type_names = ref StringSet.empty
   and module_names = ref StringSet.empty
   and modtype_names = ref StringSet.empty in
@@ -705,7 +718,7 @@ and type_structure anchor env sstr scope =
          final_env)
     | {pstr_desc = Pstr_module(name, smodl); pstr_loc = loc} :: srem ->
         check "module" loc module_names name;
-        let modl = type_module  (anchor_submodule name anchor) env smodl in
+        let modl = type_module funct_body (anchor_submodule name anchor) env smodl in
         let mty = enrich_module_type anchor name modl.mod_type env in
         let (id, newenv) = Env.enter_module name mty env in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
@@ -723,7 +736,7 @@ and type_structure anchor env sstr scope =
           List.map2
             (fun (id, mty) (name, smty, smodl) ->
               let modl =
-                type_module (anchor_recmodule id anchor) newenv smodl in
+                type_module funct_body (anchor_recmodule id anchor) newenv smodl in
               let mty' =
                 enrich_module_type anchor (Ident.name id) modl.mod_type newenv in
               (id, mty, modl, mty'))
@@ -795,7 +808,7 @@ and type_structure anchor env sstr scope =
               classes [sig_rem]),
          final_env)
     | {pstr_desc = Pstr_include smodl; pstr_loc = loc} :: srem ->
-        let modl = type_module None env smodl in
+        let modl = type_module funct_body None env smodl in
         (* Rename all identifiers bound by this signature to avoid clashes *)
         let sg = Subst.signature Subst.identity
                    (extract_sig_open env smodl.pmod_loc modl.mod_type) in
@@ -811,12 +824,14 @@ and type_structure anchor env sstr scope =
   then List.iter (function {pstr_loc = l} -> Stypes.record_phrase l) sstr;
   type_struct env sstr
 
-let type_module = type_module None
-let type_structure = type_structure None
+let type_module = type_module false None
+let type_structure = type_structure false None
 
 (* Fill in the forward declaration *)
-let _ =
-  Typecore.type_module := type_module
+let () =
+  Typecore.type_module := type_module;
+  Typetexp.transl_modtype_longident := transl_modtype_longident;
+  Typetexp.transl_modtype := transl_modtype
 
 (* Normalize types in a signature *)
 
@@ -1005,3 +1020,6 @@ let report_error ppf = function
   | Interface_not_compiled intf_name ->
       fprintf ppf
         "@[Could not find the .cmi file for interface@ %s.@]" intf_name
+  | Not_allowed_in_functor_body ->
+      fprintf ppf
+        "This kind of expression is not allowed within the body of a functor."
diff --git a/typing/typemod.mli b/typing/typemod.mli
index 2f452d3ea3..8a1d28b91f 100644
--- a/typing/typemod.mli
+++ b/typing/typemod.mli
@@ -51,6 +51,7 @@ type error =
   | Non_generalizable_module of module_type
   | Implementation_is_required of string
   | Interface_not_compiled of string
+  | Not_allowed_in_functor_body
 
 exception Error of Location.t * error
 
diff --git a/typing/types.ml b/typing/types.ml
index cbfb30220f..5996719d4d 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -37,6 +37,7 @@ and type_desc =
   | Tvariant of row_desc
   | Tunivar
   | Tpoly of type_expr * type_expr list
+  | Tpackage of Path.t * string list * type_expr list
 
 and row_desc =
     { row_fields: (label * row_field) list;
diff --git a/typing/types.mli b/typing/types.mli
index 1c9162b831..2f57df3473 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -36,6 +36,7 @@ and type_desc =
   | Tvariant of row_desc
   | Tunivar
   | Tpoly of type_expr * type_expr list
+  | Tpackage of Path.t * string list * type_expr list
 
 and row_desc =
     { row_fields: (label * row_field) list;
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 8f1c8245cf..60b24c3826 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -39,11 +39,40 @@ type error =
   | Variant_tags of string * string
   | Invalid_variable_name of string
   | Cannot_quantify of string * type_expr
+  | Multiple_constraints_on_type of string
 
 exception Error of Location.t * error
 
 type variable_context = int * (string, type_expr) Tbl.t
 
+(* Support for first-class modules. *)
+
+let transl_modtype_longident = ref (fun _ -> assert false)
+let transl_modtype = ref (fun _ -> assert false)
+
+let create_package_mty fake loc env (p, l) =
+  let l =
+    List.sort
+      (fun (s1, t1) (s2, t2) ->
+         if s1 = s2 then raise (Error (loc, Multiple_constraints_on_type s1));
+         compare s1 s2)
+      l
+  in
+  l,
+  List.fold_left
+    (fun mty (s, t) ->
+      let d = {ptype_params = [];
+               ptype_cstrs = [];
+               ptype_kind = Ptype_abstract;
+               ptype_private = Asttypes.Public;
+               ptype_manifest = if fake then None else Some t;
+               ptype_variance = [];
+               ptype_loc = loc} in
+      {pmty_desc=Pmty_with (mty, [ Longident.Lident s, Pwith_type d ]); pmty_loc=loc}
+    )
+    {pmty_desc=Pmty_ident p; pmty_loc=loc}
+    l
+
 (* Translation of type expressions *)
 
 let type_variables = ref (Tbl.empty : (string, type_expr) Tbl.t)
@@ -383,6 +412,14 @@ let rec transl_type env policy styp =
       let ty' = Btype.newgenty (Tpoly(ty, List.rev ty_list)) in
       unify_var env (newvar()) ty';
       ty'
+  | Ptyp_package (p, l) ->
+      let l, mty = create_package_mty true styp.ptyp_loc env (p, l) in
+      let z = narrow () in
+      ignore (!transl_modtype env mty);
+      widen z;
+      newty (Tpackage (!transl_modtype_longident styp.ptyp_loc env p,
+                       List.map fst l,
+                       List.map (transl_type env policy) (List.map snd l)))
 
 and transl_fields env policy =
   function
@@ -421,6 +458,8 @@ let make_fixed_univars ty =
   make_fixed_univars ty;
   Btype.unmark_type ty
 
+let create_package_mty = create_package_mty false
+
 let globalize_used_variables env fixed =
   let r = ref [] in
   Tbl.iter
@@ -558,3 +597,5 @@ let report_error ppf = function
         (if v.desc = Tvar then "it escapes this scope" else
          if v.desc = Tunivar then "it is aliased to another variable"
          else "it is not a variable")
+  | Multiple_constraints_on_type s ->
+      fprintf ppf "Multiple constraints for type %s" s
diff --git a/typing/typetexp.mli b/typing/typetexp.mli
index ba3abaa412..47b6fef261 100644
--- a/typing/typetexp.mli
+++ b/typing/typetexp.mli
@@ -54,7 +54,13 @@ type error =
   | Variant_tags of string * string
   | Invalid_variable_name of string
   | Cannot_quantify of string * Types.type_expr
+  | Multiple_constraints_on_type of string
 
 exception Error of Location.t * error
 
 val report_error: formatter -> error -> unit
+
+(* Support for first-class modules. *)
+val transl_modtype_longident: (Location.t -> Env.t -> Longident.t -> Path.t) ref  (* from Typemod *)
+val transl_modtype: (Env.t -> Parsetree.module_type -> Types.module_type) ref (* from Typemod *)
+val create_package_mty: Location.t -> Env.t -> Parsetree.package_type -> (string * Parsetree.core_type) list * Parsetree.module_type
diff --git a/typing/unused_var.ml b/typing/unused_var.ml
index 633de59643..589941d992 100644
--- a/typing/unused_var.ml
+++ b/typing/unused_var.ml
@@ -174,6 +174,7 @@ and expression ppf tbl e =
   | Pexp_poly (e, _) -> expression ppf tbl e;
   | Pexp_object cs -> class_structure ppf tbl cs;
   | Pexp_newtype (_, e) -> expression ppf tbl e
+  | Pexp_pack (me, _) -> module_expr ppf tbl me
 
 and expression_option ppf tbl eo =
   match eo with
@@ -222,6 +223,7 @@ and module_expr ppf tbl me =
       module_expr ppf tbl me1;
       module_expr ppf tbl me2;
   | Pmod_constraint (me, _) -> module_expr ppf tbl me
+  | Pmod_unpack (e, _) -> expression ppf tbl e
 
 and class_declaration ppf tbl cd = class_expr ppf tbl cd.pci_expr