Add implicit statement

bytecomp/translmod.ml

@@ -220,6 +220,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,
@@ -378,8 +380,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
@@ -438,6 +440,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
 
@@ -488,7 +491,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 *)
@@ -512,6 +516,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
     [] -> []
@@ -539,6 +544,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
@@ -655,6 +661,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
 
@@ -852,6 +859,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 _ -> ()
 
@@ -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

@@ -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

@@ -60,6 +60,8 @@ module Signature_search =
           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
@@ -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

@@ -164,6 +164,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)
@@ -184,6 +185,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)
@@ -331,6 +333,16 @@ module Opn = struct
     }
 end
 
+module Imp = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(arity = 0) lid =
+    {
+      pimp_lid = lid;
+      pimp_loc = loc;
+      pimp_attributes = attrs;
+      pimp_arity = arity;
+    }
+end
+
 module Incl = struct
   let mk ?(loc = !default_loc) ?(attrs = []) mexpr =
     {

parsing/ast_helper.mli

@@ -216,6 +216,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
@@ -238,6 +239,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
@@ -271,6 +273,12 @@ 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 -> ?arity:int -> lid -> implicit_description
+  end
+
 (* Includes *)
 module Incl:
   sig

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;
@@ -252,6 +253,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
 
 
@@ -299,6 +302,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
@@ -562,6 +566,13 @@ let default_mapper =
            ~attrs:(this.attributes this pincl_attributes)
       );
 
+    implicit_description =
+      (fun this {pimp_lid; pimp_arity; pimp_attributes; pimp_loc} ->
+         Imp.mk (map_loc this pimp_lid)
+           ~arity:pimp_arity
+           ~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/longident.ml

@@ -39,3 +39,8 @@ 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) -> 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

parsing/parser.mly

@@ -660,6 +660,7 @@ structure_item:
       { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3)
                               ~typ:$5 ~attrs:$6 ~loc:(symbol_rloc()))) }
   | open_statement { mkstr(Pstr_open $1) }
+  | implicit_statement { mkstr(Pstr_implicit $1) }
   | IMPLICIT implicit_binding
       { mkstr(Pstr_module $2) }
   | CLASS class_declarations
@@ -690,6 +691,14 @@ module_binding:
     { Mb.mk (mkrhs $1 1) $2 ~attrs:$3 ~loc:(symbol_rloc ()) }
 ;
 
+implicit_statement:
+  | IMPLICIT mod_longident implicit_statement_arity post_item_attributes
+      { Imp.mk (mkrhs $2 2) ~arity:$3 ~attrs:$4 ~loc:(symbol_rloc()) }
+;
+implicit_statement_arity:
+  | /* empty */ { 0 }
+  | implicit_statement_arity LPAREN UNDERSCORE RPAREN { 1 + $1 }
+;
 
 implicit_parameter:
   | LPAREN functor_arg_name COLON module_type RPAREN
@@ -799,6 +808,8 @@ signature_item:
                               ~attrs:$6)) }
   | open_statement
       { mksig(Psig_open $1) }
+  | implicit_statement
+      { mksig(Psig_implicit $1) }
   | INCLUDE module_type post_item_attributes %prec below_WITH
       { mksig(Psig_include (Incl.mk $2 ~attrs:$3 ~loc:(symbol_rloc()))) }
   | CLASS class_descriptions

parsing/parsetree.mli

@@ -681,6 +681,8 @@ and signature_item_desc =
         (* [@@@id] *)
   | Psig_extension of extension * attributes
         (* [%%id] *)
+  | Psig_implicit of implicit_description
+        (* implicit Path *)
 
 and module_declaration =
     {
@@ -715,6 +717,14 @@ and open_description =
    open  X - popen_override = Fresh
  *)
 
+and implicit_description =
+  {
+    pimp_lid: Longident.t loc;
+    pimp_loc: Location.t;
+    pimp_attributes: attributes;
+    pimp_arity: int;
+  }
+
 and 'a include_infos =
     {
      pincl_mod: 'a;
@@ -808,6 +818,8 @@ and structure_item_desc =
         (* [@@@id] *)
   | Pstr_extension of extension * attributes
         (* [%%id] *)
+  | Pstr_implicit of implicit_description
+        (* implicit Path.t *)
 
 and value_binding =
   {

parsing/pprintast.ml

@@ -1056,6 +1056,12 @@ class printer  ()= object(self:'self)
     | Psig_extension(e, a) ->
         self#item_extension f e;
         self#item_attributes f a
+    | Psig_implicit id ->
+        (*FIXME Arity*)
+        pp f "@[<hov2>implicit@ %a@]%a"
+          self#longident_loc id.pimp_lid
+          self#item_attributes id.pimp_attributes
+
   end
   method module_expr f x =
     if x.pmod_attributes <> [] then begin
@@ -1272,6 +1278,10 @@ class printer  ()= object(self:'self)
     | Pstr_extension(e, a) ->
         self#item_extension f e;
         self#item_attributes f a
+    | Pstr_implicit id ->
+        pp f "@[<hov2>implicit@ %a@]%a"
+          self#longident_loc id.pimp_lid
+          self#item_attributes id.pimp_attributes
   end
   method type_param f (ct, a) =
     pp f "%s%a" (type_variance a) self#core_type ct

parsing/printast.ml

@@ -707,6 +707,10 @@ and signature_item i ppf x =
   | Psig_attribute (s, arg) ->
       line i ppf "Psig_attribute \"%s\"\n" s.txt;
       payload i ppf arg
+  | Psig_implicit id ->
+      line i ppf "Psig_implicit %a %d\n"
+        fmt_longident_loc id.pimp_lid id.pimp_arity;
+      attributes i ppf id.pimp_attributes
 
 and modtype_declaration i ppf = function
   | None -> line i ppf "#abstract"
@@ -814,6 +818,10 @@ and structure_item i ppf x =
   | Pstr_attribute (s, arg) ->
       line i ppf "Pstr_attribute \"%s\"\n" s.txt;
       payload i ppf arg
+  | Pstr_implicit id ->
+      line i ppf "Pstr_implicit %a %d\n"
+        fmt_longident_loc id.pimp_lid id.pimp_arity;
+      attributes i ppf id.pimp_attributes
 
 and module_declaration i ppf pmd =
   string_loc i ppf pmd.pmd_name;

tools/depend.ml

@@ -267,6 +267,8 @@ and add_sig_item bv item =
       List.iter (add_class_description bv) cdl; bv
   | Psig_class_type cdtl ->
       List.iter (add_class_type_declaration bv) cdtl; bv
+  | Psig_implicit id ->
+      addmodule bv id.pimp_lid; bv
   | Psig_attribute _ | Psig_extension _ ->
       bv
 
@@ -328,6 +330,8 @@ and add_struct_item bv item =
       List.iter (add_class_type_declaration bv) cdtl; bv
   | Pstr_include incl ->
       add_module bv incl.pincl_mod; bv
+  | Pstr_implicit od ->
+      addmodule bv od.pimp_lid; bv
   | Pstr_attribute _ | Pstr_extension _ ->
       bv