summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Changes4
-rw-r--r--parsing/parser.mly45
-rw-r--r--testsuite/tests/typing-gadts/pr6241.ml.principal.reference5
-rw-r--r--testsuite/tests/typing-gadts/pr6241.ml.reference5
-rw-r--r--testsuite/tests/typing-modules/aliases.ml.reference3
-rw-r--r--testsuite/tests/typing-modules/generative.ml7
-rw-r--r--testsuite/tests/typing-modules/generative.ml.reference4
-rw-r--r--testsuite/tests/typing-signatures/els.ml3
-rw-r--r--testsuite/tests/typing-signatures/els.ml.reference2
-rw-r--r--typing/oprint.ml17
10 files changed, 71 insertions, 24 deletions
diff --git a/Changes b/Changes
index 9c6479a05..ddcfcb86d 100644
--- a/Changes
+++ b/Changes
@@ -94,7 +94,9 @@ Features wishes:
- PR#6166: document -ocamldoc option of ocamlbuild
- PR#6246: allow wilcard _ as for-loop index
- ocamllex: user-definable refill action
- (patch by Frédéric Bour)
+ (patch by Frédéric Bour, review by Gabriel Scherer and Luc Maranget)
+- shorten syntax for functor signatures: "functor (M1:S1) (M2:S2) .. -> .."
+ (patch by Thomas Gazagnaire, review by Gabriel Scherer)
OCaml 4.01.1:
-------------
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 4cc5d9b77..f709eb98e 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -535,6 +535,22 @@ parse_pattern:
/* Module expressions */
+module_expr_functor_arg:
+ LPAREN RPAREN
+ { mkrhs "()" 2, None }
+ | LPAREN UIDENT COLON module_type RPAREN
+ { mkrhs $2 2, Some $4 }
+ | LPAREN UNDERSCORE COLON module_type RPAREN
+ { mkrhs "_" 2 , Some $4 }
+;
+
+module_expr_functor_args:
+ module_expr_functor_args module_expr_functor_arg
+ { $2 :: $1 }
+ | module_expr_functor_arg
+ { [ $1 ] }
+;
+
module_expr:
mod_longident
{ mkmod(Pmod_ident (mkrhs $1 1)) }
@@ -542,10 +558,8 @@ module_expr:
{ mkmod(Pmod_structure($2)) }
| STRUCT structure error
{ unclosed "struct" 1 "end" 3 }
- | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
- { mkmod(Pmod_functor(mkrhs $3 3, Some $5, $8)) }
- | FUNCTOR LPAREN RPAREN MINUSGREATER module_expr
- { mkmod(Pmod_functor(mkrhs "()" 3, None, $5)) }
+ | FUNCTOR module_expr_functor_args MINUSGREATER module_expr
+ { List.fold_left (fun acc (n, t) -> mkmod(Pmod_functor(n, t, acc))) $4 $2 }
| module_expr LPAREN module_expr RPAREN
{ mkmod(Pmod_apply($1, $3)) }
| module_expr LPAREN RPAREN
@@ -665,6 +679,22 @@ module_binding:
/* Module types */
+module_type_functor_arg:
+ LPAREN RPAREN
+ { mkrhs "()" 1, None }
+ | LPAREN UIDENT COLON module_type RPAREN
+ { mkrhs $2 2, Some $4 }
+ | LPAREN UNDERSCORE COLON module_type RPAREN
+ { mkrhs "_" 2, Some $4 }
+;
+
+module_type_functor_args:
+ module_type_functor_args module_type_functor_arg
+ { $2 :: $1 }
+ | module_type_functor_arg
+ { [ $1 ] }
+;
+
module_type:
mty_longident
{ mkmty(Pmty_ident (mkrhs $1 1)) }
@@ -672,12 +702,9 @@ module_type:
{ mkmty(Pmty_signature $2) }
| SIG signature error
{ unclosed "sig" 1 "end" 3 }
- | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
- %prec below_WITH
- { mkmty(Pmty_functor(mkrhs $3 3, Some $5, $8)) }
- | FUNCTOR LPAREN RPAREN MINUSGREATER module_type
+ | FUNCTOR module_type_functor_args MINUSGREATER module_type
%prec below_WITH
- { mkmty(Pmty_functor(mkrhs "()" 2, None, $5)) }
+ { List.fold_left (fun acc (n, t) -> mkmty(Pmty_functor(n, t, acc))) $4 $2 }
| module_type WITH with_constraints
{ mkmty(Pmty_with($1, List.rev $3)) }
| MODULE TYPE OF module_expr %prec below_LBRACKETAT
diff --git a/testsuite/tests/typing-gadts/pr6241.ml.principal.reference b/testsuite/tests/typing-gadts/pr6241.ml.principal.reference
index 65ea143c8..cb3095a01 100644
--- a/testsuite/tests/typing-gadts/pr6241.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/pr6241.ml.principal.reference
@@ -7,9 +7,8 @@ Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
A
module M :
- functor (A : sig module type T end) ->
- functor (B : sig module type T end) ->
- sig val f : ((module A.T), (module B.T)) t -> string end
+ functor (A : sig module type T end) (B : sig module type T end) ->
+ sig val f : ((module A.T), (module B.T)) t -> string end
# module A : sig module type T = sig end end
# module N : sig val f : ((module A.T), (module A.T)) t -> string end
# Exception: Match_failure ("//toplevel//", 7, 52).
diff --git a/testsuite/tests/typing-gadts/pr6241.ml.reference b/testsuite/tests/typing-gadts/pr6241.ml.reference
index 65ea143c8..cb3095a01 100644
--- a/testsuite/tests/typing-gadts/pr6241.ml.reference
+++ b/testsuite/tests/typing-gadts/pr6241.ml.reference
@@ -7,9 +7,8 @@ Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
A
module M :
- functor (A : sig module type T end) ->
- functor (B : sig module type T end) ->
- sig val f : ((module A.T), (module B.T)) t -> string end
+ functor (A : sig module type T end) (B : sig module type T end) ->
+ sig val f : ((module A.T), (module B.T)) t -> string end
# module A : sig module type T = sig end end
# module N : sig val f : ((module A.T), (module A.T)) t -> string end
# Exception: Match_failure ("//toplevel//", 7, 52).
diff --git a/testsuite/tests/typing-modules/aliases.ml.reference b/testsuite/tests/typing-modules/aliases.ml.reference
index baeaf641e..730252b58 100644
--- a/testsuite/tests/typing-modules/aliases.ml.reference
+++ b/testsuite/tests/typing-modules/aliases.ml.reference
@@ -258,8 +258,7 @@ module M :
type t = Y.t
end
module F :
- functor (Y : sig type t end) ->
- functor (M : sig type t = Y.t end) -> sig end
+ functor (Y : sig type t end) (M : sig type t = Y.t end) -> sig end
# module G : functor (M : sig type t = M.Y.t end) -> sig end
# * module A1 : sig end
module A2 : sig end
diff --git a/testsuite/tests/typing-modules/generative.ml b/testsuite/tests/typing-modules/generative.ml
index 8463c0a8c..2768aba61 100644
--- a/testsuite/tests/typing-modules/generative.ml
+++ b/testsuite/tests/typing-modules/generative.ml
@@ -24,3 +24,10 @@ module F1 (X : sig end) = struct end;;
module F2 : functor () -> sig end = F1;; (* fail *)
module F3 () = struct end;;
module F4 : functor (X : sig end) -> sig end = F3;; (* fail *)
+
+(* tests for shortened functor notation () *)
+module X (X: sig end) (Y: sig end) = functor (Z: sig end) -> struct end;;
+module Y = functor (X: sig end) (Y:sig end) -> functor (Z: sig end) -> struct end;;
+module Z = functor (_: sig end) (_:sig end) (_: sig end) -> struct end;;
+module GZ : functor (X: sig end) () (Z: sig end) -> sig end
+ = functor (X: sig end) () (Z: sig end) -> struct end;;
diff --git a/testsuite/tests/typing-modules/generative.ml.reference b/testsuite/tests/typing-modules/generative.ml.reference
index d9d0f1a9c..19aaa1284 100644
--- a/testsuite/tests/typing-modules/generative.ml.reference
+++ b/testsuite/tests/typing-modules/generative.ml.reference
@@ -37,4 +37,8 @@ Error: Signature mismatch:
functor () -> sig end
is not included in
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 GZ : functor (X : sig end) () (Z : sig end) -> sig end
#
diff --git a/testsuite/tests/typing-signatures/els.ml b/testsuite/tests/typing-signatures/els.ml
index 3713b64e5..dfc2e0745 100644
--- a/testsuite/tests/typing-signatures/els.ml
+++ b/testsuite/tests/typing-signatures/els.ml
@@ -90,3 +90,6 @@ module type WEAPON_LIB = sig
module Make :
functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F
end;;
+
+module type X = functor (X: CORE) -> BARECODE;;
+module type X = functor (_: CORE) -> BARECODE;;
diff --git a/testsuite/tests/typing-signatures/els.ml.reference b/testsuite/tests/typing-signatures/els.ml.reference
index 91b4a32f1..407ced1d1 100644
--- a/testsuite/tests/typing-signatures/els.ml.reference
+++ b/testsuite/tests/typing-signatures/els.ml.reference
@@ -90,4 +90,6 @@
end) ->
USERCODE(TV).F
end
+# module type X = functor (X : CORE) -> BARECODE
+# module type X = functor (_ : CORE) -> BARECODE
#
diff --git a/typing/oprint.ml b/typing/oprint.ml
index 49deb3456..47a0c04a5 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -341,14 +341,19 @@ let out_module_type = ref (fun _ -> failwith "Oprint.out_module_type")
let out_sig_item = ref (fun _ -> failwith "Oprint.out_sig_item")
let out_signature = ref (fun _ -> failwith "Oprint.out_signature")
-let rec print_out_module_type ppf =
+let rec print_out_functor 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
+and print_out_module_type ppf =
function
Omty_abstract -> ()
- | Omty_functor (_, None, mty_res) ->
- fprintf ppf "@[<2>functor@ () ->@ %a@]" print_out_module_type mty_res
- | Omty_functor (name, Some mty_arg, mty_res) ->
- fprintf ppf "@[<2>functor@ (%s : %a) ->@ %a@]" name
- print_out_module_type mty_arg print_out_module_type mty_res
+ | Omty_functor _ as t ->
+ fprintf ppf "@[<2>functor@ %a@]" print_out_functor 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
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-19 03:19:52 +0000