Implicit scope

bytecomp/translmod.ml

@@ -216,7 +216,7 @@ let init_shape modl =
         init_shape_struct (Env.add_type ~check:false id tdecl env) rem
     | Sig_typext(id, ext, _) :: rem ->
         raise Not_found
-    | Sig_module(id, md, _) :: rem ->
+    | Sig_module(id, md, _, _) :: rem ->
         init_shape_mod env md.md_type ::
         init_shape_struct (Env.add_module_declaration id md env) rem
     | Sig_modtype(id, minfo) :: rem ->
@@ -226,6 +226,8 @@ let init_shape modl =
         :: init_shape_struct env rem
     | Sig_class_type(id, ctyp, _) :: rem ->
         init_shape_struct env rem
+    | Sig_implicit _ :: rem ->
+        init_shape_struct env rem
   in
   try
     Some(undefined_location modl.mod_loc,
@@ -316,7 +318,7 @@ let rec bound_value_identifiers = function
   | Sig_value(id, {val_kind = Val_reg}) :: rem ->
       id :: bound_value_identifiers rem
   | Sig_typext(id, ext, _) :: rem -> id :: bound_value_identifiers rem
-  | Sig_module(id, mty, _) :: rem -> id :: bound_value_identifiers rem
+  | Sig_module(id, mty, _, _) :: rem -> id :: bound_value_identifiers rem
   | Sig_class(id, decl, _) :: rem -> id :: bound_value_identifiers rem
   | _ :: rem -> bound_value_identifiers rem
 
@@ -396,8 +398,8 @@ and transl_structure fields cc rootpath = function
           fatal_error "Translmod.transl_structure"
       end
   | item :: rem ->
-      match item.str_desc with
-      | Tstr_eval (expr, _) ->
+  match item.str_desc with
+  | Tstr_eval (expr, _) ->
       Lsequence(transl_exp expr, transl_structure fields cc rootpath rem)
   | Tstr_value(rec_flag, pat_expr_list) ->
       let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
@@ -456,6 +458,7 @@ and transl_structure fields cc rootpath = function
   | Tstr_modtype _
   | Tstr_open _
   | Tstr_class_type _
+  | Tstr_implicit _
   | Tstr_attribute _ ->
       transl_structure fields cc rootpath rem
 
@@ -506,7 +509,8 @@ let rec defined_idents = function
     | Tstr_class_type cl_list -> defined_idents rem
     | Tstr_include incl ->
       bound_value_identifiers incl.incl_type @ defined_idents rem
-    | Tstr_attribute _ -> defined_idents rem
+    | Tstr_attribute _ | Tstr_implicit _ ->
+      defined_idents rem
 
 (* second level idents (module M = struct ... let id = ... end),
    and all sub-levels idents *)
@@ -530,6 +534,7 @@ let rec more_idents = function
         all_idents str.str_items @ more_idents rem
     | Tstr_module _ -> more_idents rem
     | Tstr_attribute _ -> more_idents rem
+    | Tstr_implicit _ -> more_idents rem
 
 and all_idents = function
     [] -> []
@@ -557,6 +562,7 @@ and all_idents = function
         mb_id :: all_idents str.str_items @ all_idents rem
     | Tstr_module mb -> mb.mb_id :: all_idents rem
     | Tstr_attribute _ -> all_idents rem
+    | Tstr_implicit _ -> all_idents rem
 
 
 (* A variant of transl_structure used to compile toplevel structure definitions
@@ -673,6 +679,7 @@ let transl_store_structure glob map prims str =
   | Tstr_modtype _
   | Tstr_open _
   | Tstr_class_type _
+  | Tstr_implicit _
   | Tstr_attribute _ ->
       transl_store rootpath subst rem
 
@@ -870,6 +877,7 @@ let transl_toplevel_item item =
   | Tstr_primitive _
   | Tstr_type _
   | Tstr_class_type _
+  | Tstr_implicit _
   | Tstr_attribute _ ->
       lambda_unit
 

ocamldoc/odoc_ast.ml

@@ -114,6 +114,7 @@ module Typedtree_search =
           Hashtbl.add table (P (Name.from_ident vd.val_id)) tt
       | Typedtree.Tstr_open _ -> ()
       | Typedtree.Tstr_include _ -> ()
+      | Typedtree.Tstr_implicit _ -> ()
       | Typedtree.Tstr_eval _ -> ()
       | Typedtree.Tstr_attribute _ -> ()
 
@@ -951,7 +952,7 @@ module Analyser =
         let f = match ele with
           Element_module m ->
             (function
-                Types.Sig_module (ident,md,_) ->
+                Types.Sig_module (ident,md,_,_) ->
                   let n1 = Name.simple m.m_name
                   and n2 = Ident.name ident in
                   (
@@ -1088,6 +1089,7 @@ module Analyser =
           (* don't care *)
           (0, env, [])
       | Parsetree.Pstr_attribute _
+      | Parsetree.Pstr_implicit _
       | Parsetree.Pstr_extension _ ->
           (0, env, [])
       | Parsetree.Pstr_value (rec_flag, pat_exp_list) ->

ocamldoc/odoc_env.ml

@@ -53,7 +53,7 @@ let rec add_signature env root ?rel signat =
       Types.Sig_value (ident, _) -> { env with env_values = (rel_name ident, qualify ident) :: env.env_values }
     | Types.Sig_type (ident,_,_) -> { env with env_types = (rel_name ident, qualify ident) :: env.env_types }
     | Types.Sig_typext (ident, _, _) -> { env with env_extensions = (rel_name ident, qualify ident) :: env.env_extensions }
-    | Types.Sig_module (ident, md, _) ->
+    | Types.Sig_module (ident, md, _, _) ->
         let env2 =
           match md.Types.md_type with (* A VOIR : le cas ou c'est un identificateur, dans ce cas on n'a pas de signature *)
             Types.Mty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s
@@ -74,6 +74,7 @@ let rec add_signature env root ?rel signat =
         { env2 with env_module_types = (rel_name ident, qualify ident) :: env2.env_module_types }
     | Types.Sig_class (ident, _, _) -> { env with env_classes = (rel_name ident, qualify ident) :: env.env_classes }
     | Types.Sig_class_type (ident, _, _) -> { env with env_class_types = (rel_name ident, qualify ident) :: env.env_class_types }
+    | Types.Sig_implicit (path,arity) -> env
   in
   List.fold_left f env signat
 

ocamldoc/odoc_sig.ml

@@ -56,10 +56,12 @@ module Signature_search =
           Hashtbl.add table (C (Name.from_ident ident)) signat
       | Types.Sig_class_type (ident, _, _) ->
           Hashtbl.add table (CT (Name.from_ident ident)) signat
-      | Types.Sig_module (ident, _, _) ->
+      | Types.Sig_module (ident, _, _, _) ->
           Hashtbl.add table (M (Name.from_ident ident)) signat
       | Types.Sig_modtype (ident,_) ->
           Hashtbl.add table (MT (Name.from_ident ident)) signat
+      | Types.Sig_implicit _ ->
+          ()
 
     let table signat =
       let t = Hashtbl.create 13 in
@@ -93,7 +95,7 @@ module Signature_search =
 
     let search_module table name =
       match Hashtbl.find table (M name) with
-      | (Types.Sig_module (ident, md, _)) -> md.Types.md_type
+      | (Types.Sig_module (ident, md, _, _)) -> md.Types.md_type
       | _ -> assert false
 
     let search_module_type table name =
@@ -327,6 +329,7 @@ module Analyser =
         | Parsetree.Psig_exception _
         | Parsetree.Psig_open _
         | Parsetree.Psig_include _
+        | Parsetree.Psig_implicit _
         | Parsetree.Psig_class _
         | Parsetree.Psig_class_type _ as tp -> take_item tp
         | Parsetree.Psig_type types ->
@@ -1186,7 +1189,7 @@ module Analyser =
               f ~first: true 0 pos_start_ele class_type_declaration_list
             in
             (maybe_more, new_env, eles)
-        | Parsetree.Psig_attribute _
+        | Parsetree.Psig_attribute _ | Parsetree.Psig_implicit _
         | Parsetree.Psig_extension _ ->
             (0, env, [])
 

parsing/ast_helper.ml

@@ -114,6 +114,7 @@ module Exp = struct
   let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b))
   let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
   let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c))
+  let implicit_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_implicit (a, b))
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
 
   let case lhs ?guard rhs =
@@ -165,6 +166,7 @@ module Sig = struct
   let rec_module ?loc a = mk ?loc (Psig_recmodule a)
   let modtype ?loc a = mk ?loc (Psig_modtype a)
   let open_ ?loc a = mk ?loc (Psig_open a)
+  let implicit_ ?loc a = mk ?loc (Psig_implicit a)
   let include_ ?loc a = mk ?loc (Psig_include a)
   let class_ ?loc a = mk ?loc (Psig_class a)
   let class_type ?loc a = mk ?loc (Psig_class_type a)
@@ -185,6 +187,7 @@ module Str = struct
   let rec_module ?loc a = mk ?loc (Pstr_recmodule a)
   let modtype ?loc a = mk ?loc (Pstr_modtype a)
   let open_ ?loc a = mk ?loc (Pstr_open a)
+  let implicit_ ?loc a = mk ?loc (Pstr_implicit a)
   let class_ ?loc a = mk ?loc (Pstr_class a)
   let class_type ?loc a = mk ?loc (Pstr_class_type a)
   let include_ ?loc a = mk ?loc (Pstr_include a)
@@ -318,10 +321,21 @@ module Opn = struct
     }
 end
 
+module Imp = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) kind lid =
+    {
+      pimp_lid = lid;
+      pimp_kind = kind;
+      pimp_loc = loc;
+      pimp_attributes = attrs;
+    }
+end
+
 module Incl = struct
-  let mk ?(loc = !default_loc) ?(attrs = []) mexpr =
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(flag = Include_all) mexpr =
     {
      pincl_mod = mexpr;
+     pincl_flag = flag;
      pincl_loc = loc;
      pincl_attributes = attrs;
     }

parsing/ast_helper.mli

@@ -138,6 +138,8 @@ module Exp:
     val newtype: ?loc:loc -> ?attrs:attrs -> string -> expression -> expression
     val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression
     val open_: ?loc:loc -> ?attrs:attrs -> open_flag -> lid -> expression -> expression
+    val implicit_:
+      ?loc:loc -> ?attrs:attrs -> implicit_description -> expression -> expression
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression
 
     val case: pattern -> ?guard:expression -> expression -> case
@@ -217,6 +219,7 @@ module Sig:
     val rec_module: ?loc:loc -> module_declaration list -> signature_item
     val modtype: ?loc:loc -> module_type_declaration -> signature_item
     val open_: ?loc:loc -> open_description -> signature_item
+    val implicit_: ?loc:loc -> implicit_description -> signature_item
     val include_: ?loc:loc -> include_description -> signature_item
     val class_: ?loc:loc -> class_description list -> signature_item
     val class_type: ?loc:loc -> class_type_declaration list -> signature_item
@@ -239,6 +242,7 @@ module Str:
     val rec_module: ?loc:loc -> module_binding list -> structure_item
     val modtype: ?loc:loc -> module_type_declaration -> structure_item
     val open_: ?loc:loc -> open_description -> structure_item
+    val implicit_: ?loc:loc -> implicit_description -> structure_item
     val class_: ?loc:loc -> class_declaration list -> structure_item
     val class_type: ?loc:loc -> class_type_declaration list -> structure_item
     val include_: ?loc:loc -> include_declaration -> structure_item
@@ -270,10 +274,17 @@ module Opn:
     val mk: ?loc: loc -> ?attrs:attrs -> ?flag:open_flag -> lid -> open_description
   end
 
+(* Implicit bindings *)
+module Imp:
+  sig
+    val mk: ?loc: loc -> ?attrs:attrs -> implicit_kind -> lid -> implicit_description
+  end
+
 (* Includes *)
 module Incl:
   sig
-    val mk: ?loc: loc -> ?attrs:attrs -> 'a -> 'a include_infos
+    val mk:
+      ?loc: loc -> ?attrs:attrs -> ?flag:include_flag -> 'a -> 'a include_infos
   end
 
 (** Value bindings *)

parsing/ast_mapper.ml

@@ -47,6 +47,7 @@ type mapper = {
                          -> extension_constructor;
   include_declaration: mapper -> include_declaration -> include_declaration;
   include_description: mapper -> include_description -> include_description;
+  implicit_description: mapper -> implicit_description -> implicit_description;
   label_declaration: mapper -> label_declaration -> label_declaration;
   location: mapper -> Location.t -> Location.t;
   module_binding: mapper -> module_binding -> module_binding;
@@ -259,6 +260,8 @@ module MT = struct
     | Psig_extension (x, attrs) ->
         extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs)
     | Psig_attribute x -> attribute ~loc (sub.attribute sub x)
+    | Psig_implicit x -> implicit_ ~loc (sub.implicit_description sub x)
+
 end
 
 
@@ -315,6 +318,7 @@ module M = struct
     | Pstr_extension (x, attrs) ->
         extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs)
     | Pstr_attribute x -> attribute ~loc (sub.attribute sub x)
+    | Pstr_implicit x -> implicit_ ~loc (sub.implicit_description sub x)
 end
 
 module E = struct
@@ -386,6 +390,7 @@ module E = struct
     | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
     | Pexp_open (ovf, lid, e) ->
         open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
+    | Pexp_implicit (imp, e) -> implicit_ ~loc ~attrs imp e
     | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x)
 end
 
@@ -565,19 +570,27 @@ let default_mapper =
 
 
     include_description =
-      (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+      (fun this {pincl_mod; pincl_flag; pincl_attributes; pincl_loc} ->
          Incl.mk (this.module_type this pincl_mod)
+           ~flag:pincl_flag
            ~loc:(this.location this pincl_loc)
            ~attrs:(this.attributes this pincl_attributes)
       );
 
     include_declaration =
-      (fun this {pincl_mod; pincl_attributes; pincl_loc} ->
+      (fun this {pincl_mod; pincl_flag; pincl_attributes; pincl_loc} ->
          Incl.mk (this.module_expr this pincl_mod)
+           ~flag:pincl_flag
            ~loc:(this.location this pincl_loc)
            ~attrs:(this.attributes this pincl_attributes)
       );
 
+    implicit_description =
+      (fun this {pimp_lid; pimp_kind; pimp_attributes; pimp_loc} ->
+         Imp.mk pimp_kind (map_loc this pimp_lid)
+           ~loc:(this.location this pimp_loc)
+           ~attrs:(this.attributes this pimp_attributes)
+      );
 
     value_binding =
       (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->

parsing/ast_mapper.mli

@@ -39,6 +39,7 @@ type mapper = {
                          -> extension_constructor;
   include_declaration: mapper -> include_declaration -> include_declaration;
   include_description: mapper -> include_description -> include_description;
+  implicit_description: mapper -> implicit_description -> implicit_description;
   label_declaration: mapper -> label_declaration -> label_declaration;
   location: mapper -> Location.t -> Location.t;
   module_binding: mapper -> module_binding -> module_binding;

parsing/asttypes.mli

@@ -35,6 +35,8 @@ type override_flag = Override | Fresh
 
 type open_flag = Open_all of override_flag | Open_implicit
 
+type include_flag = Include_all | Include_implicit
+
 type closed_flag = Closed | Open
 
 type implicit_flag = Nonimplicit | Implicit

parsing/lexer.mll

@@ -45,13 +45,15 @@ let keyword_table =
     "else", ELSE;
     "end", END;
     "exception", EXCEPTION;
+    "explicit", EXPLICIT;
     "external", EXTERNAL;
     "false", FALSE;
     "for", FOR;
     "fun", FUN;
     "function", FUNCTION;
     "functor", FUNCTOR;
     "if", IF;
+    "implicit", IMPLICIT;
     "in", IN;
     "include", INCLUDE;
     "inherit", INHERIT;
@@ -61,7 +63,6 @@ let keyword_table =
     "match", MATCH;
     "method", METHOD;
     "module", MODULE;
-    "implicit", IMPLICIT;
     "mutable", MUTABLE;
     "new", NEW;
     "object", OBJECT;

parsing/longident.ml

@@ -39,3 +39,11 @@ let parse s =
     [] -> Lident ""  (* should not happen, but don't put assert false
                         so as not to crash the toplevel (see Genprintval) *)
   | hd :: tl -> List.fold_left (fun p s -> Ldot(p, s)) (Lident hd) tl
+
+let rec to_string = function
+  | Lident s -> s
+  | Ldot (t,s) -> to_string t ^ "." ^ s
+  | Lapply (t1,t2, Asttypes.Nonimplicit) ->
+      to_string t1 ^ "(" ^ to_string t2 ^ ")"
+  | Lapply (t1,t2, Asttypes.Implicit) ->
+      to_string t1 ^ "{" ^ to_string t2 ^ "}"

parsing/longident.mli

@@ -20,3 +20,5 @@ type t =
 val flatten: t -> string list
 val last: t -> string
 val parse: string -> t
+
+val to_string: t -> string