summaryrefslogtreecommitdiffstats
path: root/parsing
diff options
context:
space:
mode:
Diffstat (limited to 'parsing')
-rw-r--r--parsing/ast_helper.mli6
-rw-r--r--parsing/ast_mapper.ml6
-rw-r--r--parsing/parser.mly19
-rw-r--r--parsing/parsetree.mli4
-rw-r--r--parsing/pprintast.ml11
-rw-r--r--parsing/printast.ml4
6 files changed, 35 insertions, 15 deletions
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index 995b1ca64..441e420d1 100644
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -145,7 +145,8 @@ module Mty:
val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type
val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type
- val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_type -> module_type
+ val functor_: ?loc:loc -> ?attrs:attrs ->
+ str -> module_type option -> module_type -> module_type
val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type
val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type
val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type
@@ -159,7 +160,8 @@ module Mod:
val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr
val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr
- val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_expr -> module_expr
+ val functor_: ?loc:loc -> ?attrs:attrs ->
+ str -> module_type option -> module_expr -> module_expr
val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr
val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr
val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index f6edb55f4..dac9cbe28 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -161,7 +161,8 @@ module MT = struct
| Pmty_ident s -> ident ~loc ~attrs (map_loc sub s)
| Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg)
| Pmty_functor (s, mt1, mt2) ->
- functor_ ~loc ~attrs (map_loc sub s) (sub.module_type sub mt1)
+ functor_ ~loc ~attrs (map_loc sub s)
+ (Misc.may_map (sub.module_type sub) mt1)
(sub.module_type sub mt2)
| Pmty_with (mt, l) ->
with_ ~loc ~attrs (sub.module_type sub mt)
@@ -213,7 +214,8 @@ module M = struct
| Pmod_ident x -> ident ~loc ~attrs (map_loc sub x)
| Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str)
| Pmod_functor (arg, arg_ty, body) ->
- functor_ ~loc ~attrs (map_loc sub arg) (sub.module_type sub arg_ty)
+ functor_ ~loc ~attrs (map_loc sub arg)
+ (Misc.may_map (sub.module_type sub) arg_ty)
(sub.module_expr sub body)
| Pmod_apply (m1, m2) ->
apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2)
diff --git a/parsing/parser.mly b/parsing/parser.mly
index f08afc21d..7f23730f3 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -541,9 +541,13 @@ module_expr:
| STRUCT structure error
{ unclosed "struct" 1 "end" 3 }
| FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
- { mkmod(Pmod_functor(mkrhs $3 3, $5, $8)) }
+ { mkmod(Pmod_functor(mkrhs $3 3, Some $5, $8)) }
+ | FUNCTOR LPAREN RPAREN MINUSGREATER module_expr
+ { mkmod(Pmod_functor(mkrhs "()" 3, None, $5)) }
| module_expr LPAREN module_expr RPAREN
{ mkmod(Pmod_apply($1, $3)) }
+ | module_expr LPAREN RPAREN
+ { mkmod(Pmod_apply($1, mkmod (Pmod_structure []))) }
| module_expr LPAREN module_expr error
{ unclosed "(" 2 ")" 4 }
| LPAREN module_expr COLON module_type RPAREN
@@ -640,7 +644,9 @@ module_binding_body:
| COLON module_type EQUAL module_expr
{ mkmod(Pmod_constraint($4, $2)) }
| LPAREN UIDENT COLON module_type RPAREN module_binding_body
- { mkmod(Pmod_functor(mkrhs $2 2, $4, $6)) }
+ { mkmod(Pmod_functor(mkrhs $2 2, Some $4, $6)) }
+ | LPAREN RPAREN module_binding_body
+ { mkmod(Pmod_functor(mkrhs "()" 1, None, $3)) }
;
module_bindings:
module_binding { [$1] }
@@ -662,7 +668,10 @@ module_type:
{ unclosed "sig" 1 "end" 3 }
| FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
%prec below_WITH
- { mkmty(Pmty_functor(mkrhs $3 3, $5, $8)) }
+ { mkmty(Pmty_functor(mkrhs $3 3, Some $5, $8)) }
+ | FUNCTOR LPAREN RPAREN MINUSGREATER module_type
+ %prec below_WITH
+ { mkmty(Pmty_functor(mkrhs "()" 2, None, $5)) }
| module_type WITH with_constraints
{ mkmty(Pmty_with($1, List.rev $3)) }
| MODULE TYPE OF module_expr %prec below_LBRACKETAT
@@ -724,7 +733,9 @@ module_declaration:
COLON module_type
{ $2 }
| LPAREN UIDENT COLON module_type RPAREN module_declaration
- { mkmty(Pmty_functor(mkrhs $2 2, $4, $6)) }
+ { mkmty(Pmty_functor(mkrhs $2 2, Some $4, $6)) }
+ | LPAREN RPAREN module_declaration
+ { mkmty(Pmty_functor(mkrhs "()" 1, None, $3)) }
;
module_rec_declarations:
module_rec_declaration { [$1] }
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index df0dd47ab..57f4ae7f3 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -543,7 +543,7 @@ and module_type_desc =
(* S *)
| Pmty_signature of signature
(* sig ... end *)
- | Pmty_functor of string loc * module_type * module_type
+ | Pmty_functor of string loc * module_type option * module_type
(* functor(X : MT1) -> MT2 *)
| Pmty_with of module_type * with_constraint list
(* MT with ... *)
@@ -637,7 +637,7 @@ and module_expr_desc =
(* X *)
| Pmod_structure of structure
(* struct ... end *)
- | Pmod_functor of string loc * module_type * module_expr
+ | Pmod_functor of string loc * module_type option * module_expr
(* functor(X : MT1) -> ME *)
| Pmod_apply of module_expr * module_expr
(* ME1(ME2) *)
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index cf218f2a8..050c9fe1c 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -834,7 +834,9 @@ class printer ()= object(self:'self)
| Pmty_signature (s) ->
pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
(self#list self#signature_item ) s (* FIXME wrong indentation*)
- | Pmty_functor (s, mt1, mt2) ->
+ | 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
| Pmty_with (mt, l) ->
@@ -940,7 +942,9 @@ class printer ()= object(self:'self)
self#module_type mt
| Pmod_ident (li) ->
pp f "%a" self#longident_loc li;
- | Pmod_functor (s, mt, me) ->
+ | Pmod_functor (_, None, me) ->
+ pp f "functor ()@;->@;%a" self#module_expr me
+ | Pmod_functor (s, Some mt, me) ->
pp f "functor@ (%s@ :@ %a)@;->@;%a"
s.txt self#module_type mt self#module_expr me
| Pmod_apply (me1, me2) ->
@@ -1025,7 +1029,8 @@ class printer ()= object(self:'self)
| Pstr_module x ->
let rec module_helper me = match me.pmod_desc with
| Pmod_functor(s,mt,me) ->
- pp f "(%s:%a)" s.txt self#module_type mt ;
+ if mt = None then pp f "()"
+ else Misc.may (pp f "(%s:%a)" s.txt self#module_type) mt;
module_helper me
| _ -> me in
pp f "@[<hov2>module %s%a@]"
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 7c6fd9a22..5f396e784 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -577,7 +577,7 @@ and module_type i ppf x =
signature i ppf s;
| Pmty_functor (s, mt1, mt2) ->
line i ppf "Pmty_functor %a\n" fmt_string_loc s;
- module_type i ppf mt1;
+ Misc.may (module_type i ppf) mt1;
module_type i ppf mt2;
| Pmty_with (mt, l) ->
line i ppf "Pmty_with\n";
@@ -671,7 +671,7 @@ and module_expr i ppf x =
structure i ppf s;
| Pmod_functor (s, mt, me) ->
line i ppf "Pmod_functor %a\n" fmt_string_loc s;
- module_type i ppf mt;
+ Misc.may (module_type i ppf) mt;
module_expr i ppf me;
| Pmod_apply (me1, me2) ->
line i ppf "Pmod_apply\n";
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-25 00:21:22 +0000