From 2a796f3d419475123173fd1333b48974c65526ba Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 4 Aug 2024 15:57:41 -0700 Subject: [PATCH] feat: support modtype subst (#2785) --- src/reason-parser/reason_parser.mly | 10 ++++- src/reason-parser/reason_pprint_ast.ml | 57 ++++++++++++++++---------- test/modules.t/input.re | 12 ++++++ test/modules.t/run.t | 20 +++++++++ 4 files changed, 76 insertions(+), 23 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index ae7a2f993..6ef21ad45 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -1981,6 +1981,10 @@ signature_item: { let loc = mklocation $symbolstartpos $endpos in Psig_modtype (Ast_helper.Mtd.mk $4 ~typ:$5 ~loc ~attrs:$1) } + | item_attributes MODULE TYPE as_loc(ident) COLONEQUAL module_type + { let loc = mklocation $symbolstartpos $endpos in + Psig_modtypesubst (Ast_helper.Mtd.mk $4 ~typ:$6 ~loc ~attrs:$1) + } | open_description { $1 } | item_attributes INCLUDE module_type { let loc = mklocation $symbolstartpos $endpos in @@ -4382,7 +4386,11 @@ with_constraint: { Pwith_module ($2, $4) } | MODULE as_loc(UIDENT) COLONEQUAL as_loc(mod_ext_longident) { let lident = {$2 with txt=Longident.Lident $2.txt} in - Ppxlib.Parsetree.Pwith_modsubst (lident, $4) } + Pwith_modsubst (lident, $4) } + | MODULE TYPE as_loc(mty_longident) EQUAL module_type + { Ppxlib.Pwith_modtype ($3, $5) } + | MODULE TYPE as_loc(mty_longident) COLONEQUAL module_type + { Ppxlib.Pwith_modtypesubst ($3, $5) } ; (* Polymorphic types *) diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 356d030e0..1c3c2b397 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -7416,6 +7416,26 @@ let printer = object(self:'self) ~layout () + method modtype x ~delim = + let name = atom x.pmtd_name.txt in + let letPattern = makeList ~postSpace:true [atom "module type"; name; atom delim] in + let main = match x.pmtd_type with + | None -> makeList ~postSpace:true [atom "module type"; name] + | Some mt -> self#module_type letPattern mt + in + let {Reason_attributes.stdAttrs; docAttrs} = + Reason_attributes.partitionAttributes ~partDoc:true x.pmtd_attributes + in + let layout = + self#attach_std_item_attrs stdAttrs main + in + self#attachDocAttrsToLayout + ~stdAttrs + ~docAttrs + ~loc:x.pmtd_name.loc + ~layout + () + method signature_item' x : Layout.t = let item: Layout.t = match x.psig_desc with @@ -7479,25 +7499,7 @@ let printer = object(self:'self) ~loc:incl.pincl_mod.pmty_loc ~layout () - | Psig_modtype x -> - let name = atom x.pmtd_name.txt in - let letPattern = makeList ~postSpace:true [atom "module type"; name; atom "="] in - let main = match x.pmtd_type with - | None -> makeList ~postSpace:true [atom "module type"; name] - | Some mt -> self#module_type letPattern mt - in - let {Reason_attributes.stdAttrs; docAttrs} = - Reason_attributes.partitionAttributes ~partDoc:true x.pmtd_attributes - in - let layout = - self#attach_std_item_attrs stdAttrs main - in - self#attachDocAttrsToLayout - ~stdAttrs - ~docAttrs - ~loc:x.pmtd_name.loc - ~layout - () + | Psig_modtype x -> self#modtype x ~delim:"=" | Psig_class_type l -> self#class_type_declaration_list l | Psig_recmodule decls -> self#psig_recmodule decls | Psig_attribute a -> self#floating_attribute a @@ -7533,7 +7535,7 @@ let printer = object(self:'self) () | Psig_typesubst l -> self#type_def_list ~eq_symbol:":=" (Recursive, l) - | Psig_modtypesubst _ -> assert false + | Psig_modtypesubst x -> self#modtype x ~delim:":=" in source_map ~loc:x.psig_loc item @@ -7638,7 +7640,17 @@ let printer = object(self:'self) atm; atom token; self#longident_loc li2 - ] in + ] + in + let modtypeSub atm li modtype = + label + (makeList ~break:IfNeed ~sep:(Sep " ") [ + atom "module type"; + (self#longident li); + atm; + ]) + (self#module_type (atom "") modtype) + in let typeAtom = atom "type" in let eqAtom = atom "=" in let destrAtom = atom ":=" in @@ -7658,7 +7670,8 @@ let printer = object(self:'self) destrAtom td | Pwith_modsubst (s, li2) -> modSub (self#longident s.txt) li2 ":=" - | Pwith_modtype (_, _)|Pwith_modtypesubst (_, _) -> assert false + | Pwith_modtype (s, modtype) -> modtypeSub eqAtom s.txt modtype + | Pwith_modtypesubst (s, modtype) -> modtypeSub destrAtom s.txt modtype in (match l with | [] -> self#module_type ~space letPattern mt diff --git a/test/modules.t/input.re b/test/modules.t/input.re index 3e7e4314b..703259539 100644 --- a/test/modules.t/input.re +++ b/test/modules.t/input.re @@ -559,4 +559,16 @@ open { let x = 1; }; +module X : { + module Z := Y; + module type Foo := y; +} = {}; + +module type t' = t with module type x = x + +module type t3 = t with module type x = { type t } + +module type t' = t with module type x := x + +module type t4 = t with module type x := { type t } diff --git a/test/modules.t/run.t b/test/modules.t/run.t index badd4f15d..30978c3e3 100644 --- a/test/modules.t/run.t +++ b/test/modules.t/run.t @@ -732,4 +732,24 @@ Format modules open { let x = 1; }; + + module X: { + module Z := Y; + + module type Foo := y; + } = {}; + + module type t' = t with module type x = x; + + module type t3 = + t with module type x = { + type t; + }; + + module type t' = t with module type x := x; + + module type t4 = + t with module type x := { + type t; + }; /* From http://stackoverflow.com/questions/1986374/ higher-order-type-constructors-and-functors-in-ocaml */