always associate a scope to a type (previously it was optional)

Previously, not having a scope meant the type was used in every context,
now we set the scope to "Btype.lowest_level" to mean the same thing.
The equivalence was made obvious by the recent changes to identifiers
scoping.

14 files changed, 42 insertions, 58 deletions

diff --git a/typing/btype.ml b/typing/btype.ml
index afdc280928..3bc07b0789 100644
--- a/typing/btype.ml
+++ b/typing/btype.ml
@@ -44,7 +44,7 @@ let pivot_level = 2 * lowest_level - 1
 let new_id = ref (-1)
 
 let newty2 level desc  =
-  incr new_id; { desc; level; scope = None; id = !new_id }
+  incr new_id; { desc; level; scope = lowest_level; id = !new_id }
 let newgenty desc      = newty2 generic_level desc
 let newgenvar ?name () = newgenty (Tvar name)
 (*
@@ -72,7 +72,7 @@ type change =
     Ctype of type_expr * type_desc
   | Ccompress of type_expr * type_desc * type_desc
   | Clevel of type_expr * int
-  | Cscope of type_expr * int option
+  | Cscope of type_expr * int
   | Cname of
       (Path.t * type_expr list) option ref * (Path.t * type_expr list) option
   | Crow of row_field option ref * row_field option
diff --git a/typing/btype.mli b/typing/btype.mli
index b5931108e2..ad3086d117 100644
--- a/typing/btype.mli
+++ b/typing/btype.mli
@@ -200,7 +200,7 @@ val link_type: type_expr -> type_expr -> unit
         (* Set the desc field of [t1] to [Tlink t2], logging the old
            value if there is an active snapshot *)
 val set_level: type_expr -> int -> unit
-val set_scope: type_expr -> int option -> unit
+val set_scope: type_expr -> int -> unit
 val set_name:
     (Path.t * type_expr list) option ref ->
     (Path.t * type_expr list) option -> unit
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 0fd2bbf1cd..1ce8ae6a69 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -683,12 +683,10 @@ let check_scope_escape level ty =
     let ty = repr ty in
     if ty.level >= lowest_level then begin
       ty.level <- pivot_level - ty.level;
-      begin match ty.scope with
-        Some lv ->
+      if level < ty.scope then (
         let var = newvar2 level in
-        if level < lv then raise (Unify [(ty,ty); (var, var)])
-      | None -> ()
-      end;
+        raise (Unify [(ty,ty); (var, var)])
+      );
       iter_type_expr aux ty
     end
   in
@@ -700,17 +698,10 @@ let check_scope_escape level ty =
     raise (Unify ((ty, ty) :: (var, var) :: trace))
 
 let update_scope scope ty =
-  match scope with
-  | None -> ()
-  | Some lvl ->
-    let ty = repr ty in
-    let scope =
-      match ty.scope with
-      | None -> lvl
-      | Some lvl' -> max lvl lvl'
-    in
-    if ty.level < scope then raise (Unify [(ty, newvar2 ty.level)]);
-    set_scope ty (Some scope)
+  let ty = repr ty in
+  let scope = max scope ty.scope in
+  if ty.level < scope then raise (Unify [(ty, newvar2 ty.level)]);
+  set_scope ty scope
 
 (* Note: the level of a type constructor must be greater than its binding
     time. That way, a type constructor cannot escape the scope of its
@@ -723,10 +714,7 @@ let update_scope scope ty =
 let rec update_level env level expand ty =
   let ty = repr ty in
   if ty.level > level then begin
-    begin match ty.scope with
-      Some lv -> if level < lv then raise (Unify [(ty, newvar2 level)])
-    | None -> ()
-    end;
+    if level < ty.scope then raise (Unify [(ty, newvar2 level)]);
     match ty.desc with
       Tconstr(p, _tl, _abbrev) when level < Path.scope p ->
         (* Try first to replace an abbreviation by its expansion. *)
@@ -1131,7 +1119,7 @@ let instance_constructor ?in_pattern cstr =
   | None -> ()
   | Some (env, expansion_scope) ->
       let process existential =
-        let decl = new_declaration (Some expansion_scope) None in
+        let decl = new_declaration expansion_scope None in
         let name = existential_name cstr existential in
         let path =
           Path.Pident
@@ -1439,12 +1427,10 @@ let expand_abbrev_gen kind find_type_expansion env ty =
             (* For gadts, remember type as non exportable *)
             (* The ambiguous level registered for ty' should be the highest *)
             if !trace_gadt_instances then begin
-              match max lv ty.scope with
-                None -> ()
-              | Some lv ->
-                  if level < lv then raise (Unify [(ty, newvar2 level)]);
-                  set_scope ty (Some lv);
-                  set_scope ty' (Some lv)
+              let scope = max lv ty.scope in
+              if level < scope then raise (Unify [(ty, newvar2 level)]);
+              set_scope ty scope;
+              set_scope ty' scope
             end;
             ty'
       end
@@ -1951,7 +1937,7 @@ let reify env t =
         (Ident.create_scoped ~scope:fresh_constr_scope
            (get_new_abstract_name name))
     in
-    let decl = new_declaration (Some fresh_constr_scope) None in
+    let decl = new_declaration fresh_constr_scope None in
     let new_env = Env.add_local_type path decl !env in
     let t = newty2 lev (Tconstr (path,[],ref Mnil))  in
     env := new_env;
@@ -1995,7 +1981,7 @@ let reify env t =
 let is_newtype env p =
   try
     let decl = Env.find_type p env in
-    decl.type_expansion_scope <> None &&
+    decl.type_expansion_scope <> Btype.lowest_level &&
     decl.type_kind = Type_abstract &&
     decl.type_private = Public
   with Not_found -> false
@@ -2246,9 +2232,7 @@ let find_lowest_level ty =
   in find ty; unmark_type ty; !lowest
 
 let find_expansion_scope env path =
-  match (Env.find_type path env).type_expansion_scope with
-  | Some x -> x
-  | None -> assert false
+  (Env.find_type path env).type_expansion_scope
 
 let add_gadt_equation env source destination =
   (* Format.eprintf "@[add_gadt_equation %s %a@]@."
@@ -2258,7 +2242,7 @@ let add_gadt_equation env source destination =
     let expansion_scope =
       max (Path.scope source) (get_gadt_equations_level ())
     in
-    let decl = new_declaration (Some expansion_scope) (Some destination) in
+    let decl = new_declaration expansion_scope (Some destination) in
     env := Env.add_local_type source decl !env;
     cleanup_abbrev ()
   end
@@ -4491,7 +4475,7 @@ let nondep_type_decl env mid is_covariant decl =
       type_private = priv;
       type_variance = decl.type_variance;
       type_is_newtype = false;
-      type_expansion_scope = None;
+      type_expansion_scope = Btype.lowest_level;
       type_loc = decl.type_loc;
       type_attributes = decl.type_attributes;
       type_immediate = decl.type_immediate;
diff --git a/typing/datarepr.ml b/typing/datarepr.ml
index 7bef64c9f2..bae3bd8bd6 100644
--- a/typing/datarepr.ml
+++ b/typing/datarepr.ml
@@ -86,7 +86,7 @@ let constructor_args priv cd_args cd_res path rep =
           type_manifest = None;
           type_variance = List.map (fun _ -> Variance.full) type_params;
           type_is_newtype = false;
-          type_expansion_scope = None;
+          type_expansion_scope = Btype.lowest_level;
           type_loc = Location.none;
           type_attributes = [];
           type_immediate = false;
@@ -177,7 +177,7 @@ let extension_descr path_ext ext =
       cstr_inlined;
     }
 
-let none = {desc = Ttuple []; level = -1; scope = None; id = -1}
+let none = {desc = Ttuple []; level = -1; scope = Btype.generic_level; id = -1}
                                         (* Clearly ill-formed type *)
 let dummy_label =
   { lbl_name = ""; lbl_res = none; lbl_arg = none; lbl_mut = Immutable;
diff --git a/typing/env.mli b/typing/env.mli
index 678ef6773b..8b627d5e0c 100644
--- a/typing/env.mli
+++ b/typing/env.mli
@@ -69,9 +69,9 @@ val find_class: Path.t -> t -> class_declaration
 val find_cltype: Path.t -> t -> class_type_declaration
 
 val find_type_expansion:
-    Path.t -> t -> type_expr list * type_expr * int option
+    Path.t -> t -> type_expr list * type_expr * int
 val find_type_expansion_opt:
-    Path.t -> t -> type_expr list * type_expr * int option
+    Path.t -> t -> type_expr list * type_expr * int
 (* Find the manifest type information associated to a type for the sake
    of the compiler's type-based optimisations. *)
 val find_modtype_expansion: Path.t -> t -> module_type
diff --git a/typing/predef.ml b/typing/predef.ml
index f05b1744bf..5399656d54 100644
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -125,7 +125,7 @@ let decl_abstr =
    type_manifest = None;
    type_variance = [];
    type_is_newtype = false;
-   type_expansion_scope = None;
+   type_expansion_scope = lowest_level;
    type_attributes = [];
    type_immediate = false;
    type_unboxed = unboxed_false_default_false;
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index aae9b7a6e1..6ed17cbf8a 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -1483,7 +1483,7 @@ let filter_rem_sig item rem =
 let dummy =
   { type_params = []; type_arity = 0; type_kind = Type_abstract;
     type_private = Public; type_manifest = None; type_variance = [];
-    type_is_newtype = false; type_expansion_scope = None;
+    type_is_newtype = false; type_expansion_scope = Btype.lowest_level;
     type_loc = Location.none;
     type_attributes = [];
     type_immediate = false;
diff --git a/typing/subst.ml b/typing/subst.ml
index ce3e31a3fc..b4889d82c9 100644
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -136,7 +136,7 @@ let reset_for_saving () = new_id := -1
 
 let newpersty desc =
   decr new_id;
-  { desc = desc; level = generic_level; scope = None; id = !new_id }
+  { desc; level = generic_level; scope = Btype.lowest_level; id = !new_id }
 
 (* ensure that all occurrences of 'Tvar None' are physically shared *)
 let tvar_none = Tvar None
@@ -305,7 +305,7 @@ let type_declaration s decl =
       type_private = decl.type_private;
       type_variance = decl.type_variance;
       type_is_newtype = false;
-      type_expansion_scope = None;
+      type_expansion_scope = Btype.lowest_level;
       type_loc = loc s decl.type_loc;
       type_attributes = attrs s decl.type_attributes;
       type_immediate = decl.type_immediate;
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index d4068d1d1c..09b042b557 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -1290,7 +1290,7 @@ let temp_abbrev loc env id arity =
        type_manifest = Some ty;
        type_variance = Misc.replicate_list Variance.full arity;
        type_is_newtype = false;
-       type_expansion_scope = None;
+       type_expansion_scope = Btype.lowest_level;
        type_loc = loc;
        type_attributes = []; (* or keep attrs from the class decl? *)
        type_immediate = false;
@@ -1541,7 +1541,7 @@ let class_infos define_class kind
      type_manifest = Some obj_ty;
      type_variance = List.map (fun _ -> Variance.full) obj_params;
      type_is_newtype = false;
-     type_expansion_scope = None;
+     type_expansion_scope = Btype.lowest_level;
      type_loc = cl.pci_loc;
      type_attributes = []; (* or keep attrs from cl? *)
      type_immediate = false;
@@ -1561,7 +1561,7 @@ let class_infos define_class kind
      type_manifest = Some cl_ty;
      type_variance = List.map (fun _ -> Variance.full) cl_params;
      type_is_newtype = false;
-     type_expansion_scope = None;
+     type_expansion_scope = Btype.lowest_level;
      type_loc = cl.pci_loc;
      type_attributes = []; (* or keep attrs from cl? *)
      type_immediate = false;
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 5a04ecdc1f..1b2c7ca8e6 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -3137,7 +3137,7 @@ and type_expect_
         type_manifest = None;
         type_variance = [];
         type_is_newtype = true;
-        type_expansion_scope = None;
+        type_expansion_scope = Btype.lowest_level;
         type_loc = loc;
         type_attributes = [];
         type_immediate = false;
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index b00e3fb811..48804374cf 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -111,7 +111,7 @@ let enter_type rec_flag env sdecl id =
         | Some _ -> Some(Ctype.newvar ()) end;
       type_variance = List.map (fun _ -> Variance.full) sdecl.ptype_params;
       type_is_newtype = false;
-      type_expansion_scope = None;
+      type_expansion_scope = Btype.lowest_level;
       type_loc = sdecl.ptype_loc;
       type_attributes = sdecl.ptype_attributes;
       type_immediate = false;
@@ -520,7 +520,7 @@ let transl_declaration env sdecl id =
         type_manifest = man;
         type_variance = List.map (fun _ -> Variance.full) params;
         type_is_newtype = false;
-        type_expansion_scope = None;
+        type_expansion_scope = Btype.lowest_level;
         type_loc = sdecl.ptype_loc;
         type_attributes = sdecl.ptype_attributes;
         type_immediate = false;
@@ -1872,7 +1872,7 @@ let transl_with_constraint env id row_path orig_decl sdecl =
       type_manifest = man;
       type_variance = [];
       type_is_newtype = false;
-      type_expansion_scope = None;
+      type_expansion_scope = Btype.lowest_level;
       type_loc = sdecl.ptype_loc;
       type_attributes = sdecl.ptype_attributes;
       type_immediate = false;
@@ -1921,7 +1921,7 @@ let abstract_type_decl arity =
       type_manifest = None;
       type_variance = replicate_list Variance.full arity;
       type_is_newtype = false;
-      type_expansion_scope = None;
+      type_expansion_scope = Btype.lowest_level;
       type_loc = Location.none;
       type_attributes = [];
       type_immediate = false;
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 4055c628a0..19d5625e9f 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -465,7 +465,7 @@ let merge_constraint initial_env remove_aliases loc sg constr =
                 sdecl.ptype_params;
             type_loc = sdecl.ptype_loc;
             type_is_newtype = false;
-            type_expansion_scope = None;
+            type_expansion_scope = Btype.lowest_level;
             type_attributes = [];
             type_immediate = false;
             type_unboxed = unboxed_false_default_false;
diff --git a/typing/types.ml b/typing/types.ml
index ea4efd3b14..baa8a83986 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -22,7 +22,7 @@ open Asttypes
 type type_expr =
   { mutable desc: type_desc;
     mutable level: int;
-    mutable scope: int option;
+    mutable scope: int;
     id: int }
 
 and type_desc =
@@ -149,7 +149,7 @@ type type_declaration =
     type_manifest: type_expr option;
     type_variance: Variance.t list;
     type_is_newtype: bool;
-    type_expansion_scope: int option;
+    type_expansion_scope: int;
     type_loc: Location.t;
     type_attributes: Parsetree.attributes;
     type_immediate: bool;
diff --git a/typing/types.mli b/typing/types.mli
index c903f92dc3..bd1e344b75 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -58,7 +58,7 @@ open Asttypes
 type type_expr =
   { mutable desc: type_desc;
     mutable level: int;
-    mutable scope: int option;
+    mutable scope: int;
     id: int }
 
 and type_desc =
@@ -296,7 +296,7 @@ type type_declaration =
     type_variance: Variance.t list;
     (* covariant, contravariant, weakly contravariant, injective *)
     type_is_newtype: bool;
-    type_expansion_scope: int option;
+    type_expansion_scope: int;
     type_loc: Location.t;
     type_attributes: Parsetree.attributes;
     type_immediate: bool; (* true iff type should not be a pointer *)