GPR#42: Add simpler functor type syntax

(Leo White)

Add support for simple functor types of the form:

    S -> T

equivalent to:

    functor (_ : S) -> T

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

Changes

@@ -19,6 +19,8 @@ Language features:
   (Peter Zotov)
 - GPR#26: support for "(type a b)" as syntactic sugar for "(type a) (type b)"
   (Gabriel Scherer)
+- GPR#42: short functor type syntax: "S -> T" for "functor (_ : S) -> T"
+  (Leo White)
 * GPR#69: Custom index operators: ( .() ), ( .[] ), ( .{} ) etc.
   (Florian Angeletti)
   The syntax "foo.(bar) <- baz" now desugars into "( .()<- ) foo bar baz"; this

parsing/parser.mly

@@ -823,8 +823,13 @@ module_type:
       { unclosed "sig" 1 "end" 3 }
   | FUNCTOR functor_args MINUSGREATER module_type
       %prec below_WITH
-      { List.fold_left (fun acc (n, t) -> mkmty(Pmty_functor(n, t, acc)))
-                       $4 $2 }
+      { List.fold_left
+          (fun acc (n, t) ->
+           mkmty(Pmty_functor(n, t, acc)))
+        $4 $2 }
+  | module_type MINUSGREATER module_type
+      %prec below_WITH
+      { mkmty(Pmty_functor(mknoloc "_", Some $1, $3)) }
   | module_type WITH with_constraints
       { mkmty(Pmty_with($1, List.rev $3)) }
   | MODULE TYPE OF module_expr %prec below_LBRACKETAT
@@ -2009,7 +2014,7 @@ core_type:
       { Typ.attr $1 $2 }
 ;
 core_type_no_attr:
-    core_type2
+    core_type2 %prec MINUSGREATER
       { $1 }
   | core_type2 AS QUOTE ident
       { mktyp(Ptyp_alias($1, $4)) }

parsing/pprintast.ml

@@ -915,8 +915,12 @@ class printer  ()= object(self:'self)
     | Pmty_functor (_, None, mt2) ->
         pp f "@[<hov2>functor () ->@ %a@]" self#module_type mt2
     | Pmty_functor (s, Some mt1, mt2) ->
-        pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
-          self#module_type mt1  self#module_type mt2
+        if s.txt = "_" then
+          pp f "@[<hov2>%a@ ->@ %a@]"
+             self#module_type mt1  self#module_type mt2
+        else
+          pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
+             self#module_type mt1  self#module_type mt2
     | Pmty_with (mt, l) ->
         let with_constraint f = function
           | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->

testsuite/tests/typing-modules/generative.ml.reference

@@ -39,6 +39,6 @@ Error: Signature mismatch:
          functor (X : sig  end) -> sig  end
 #     module X : functor (X : sig  end) (Y : sig  end) (Z : sig  end) -> sig  end
 #   module Y : functor (X : sig  end) (Y : sig  end) (Z : sig  end) -> sig  end
-# module Z : functor (_ : sig  end) (_ : sig  end) (_ : sig  end) -> sig  end
+# module Z : sig  end -> sig  end -> sig  end -> sig  end
 #   module GZ : functor (X : sig  end) () (Z : sig  end) -> sig  end
 # 

testsuite/tests/typing-signatures/els.ml.reference

@@ -91,5 +91,5 @@
         USERCODE(TV).F
   end
 #   module type X = functor (X : CORE) -> BARECODE
-# module type X = functor (_ : CORE) -> BARECODE
+# module type X = CORE -> BARECODE
 # 

typing/oprint.ml

@@ -352,19 +352,35 @@ let out_sig_item = ref (fun _ -> failwith "Oprint.out_sig_item")
 let out_signature = ref (fun _ -> failwith "Oprint.out_signature")
 let out_type_extension = ref (fun _ -> failwith "Oprint.out_type_extension")
 
-let rec print_out_functor ppf =
+let rec print_out_functor funct ppf =
   function
     Omty_functor (_, None, mty_res) ->
-      fprintf ppf "() %a" print_out_functor mty_res
-  | Omty_functor (name , Some mty_arg, mty_res) ->
-      fprintf ppf "(%s : %a) %a" name
-        print_out_module_type mty_arg print_out_functor mty_res
-  | m -> fprintf ppf "->@ %a" print_out_module_type m
+      if funct then fprintf ppf "() %a" (print_out_functor true) mty_res
+      else fprintf ppf "functor@ () %a" (print_out_functor true) mty_res
+  | Omty_functor (name, Some mty_arg, mty_res) -> begin
+      match name, funct with
+      | "_", true ->
+          fprintf ppf "->@ %a ->@ %a"
+            print_out_module_type mty_arg (print_out_functor false) mty_res
+      | "_", false ->
+          fprintf ppf "%a ->@ %a"
+            print_out_module_type mty_arg (print_out_functor false) mty_res
+      | name, true ->
+          fprintf ppf "(%s : %a) %a" name
+            print_out_module_type mty_arg (print_out_functor true) mty_res
+      | name, false ->
+            fprintf ppf "functor@ (%s : %a) %a" name
+              print_out_module_type mty_arg (print_out_functor true) mty_res
+    end
+  | m ->
+      if funct then fprintf ppf "->@ %a" print_out_module_type m
+      else print_out_module_type ppf m
+
 and print_out_module_type ppf =
   function
     Omty_abstract -> ()
   | Omty_functor _ as t ->
-      fprintf ppf "@[<2>functor@ %a@]" print_out_functor t
+      fprintf ppf "@[<2>%a@]" (print_out_functor false) t
   | Omty_ident id -> fprintf ppf "%a" print_ident id
   | Omty_signature sg ->
       fprintf ppf "@[<hv 2>sig@ %a@;<1 -2>end@]" !out_signature sg